OpenGL v Delphi4



3D Fonty, výpočet FPS.


Příklad a zdroják ke stažení (277k)



Příklad, jak vytvořit 3d text a jak tento text potáhnout texturou. Navíc jsem přidal výpočet FPS. Výsledná hodnota FPS se generuje do 3d textu.



Nejdříve jsem nadefinoval proměnné

//Font
base:  TGLuint;

//FPS
StartFreq: TLargeInteger;
StartCount,Count1, Count2, FPS: double;
FPSi: integer=3;



Procedura

procedure InitFont;                                     // Build Our Bitmap Font
var font: HFONT;                                        // Windows Font ID
    gmf : array [0..255] of GLYPHMETRICSFLOAT;          // Address Buffer For Font Storage
begin
  base := glGenLists(256);                              // Storage For 256 Characters
  font := CreateFont(-12,                               // Height Of Font
                     0,                                 // Width Of Font
                     0,                                 // Angle Of Escapement
                     0,                                 // Orientation Angle
                     FW_BOLD,                           // Font Weight
                     0,                                 // Italic
                     0,                                 // Underline
                     0,                                 // Strikeout
                     ANSI_CHARSET,                      // Character Set Identifier
                     OUT_TT_PRECIS,                     // Output Precision
                     CLIP_DEFAULT_PRECIS,               // Clipping Precision
                     ANTIALIASED_QUALITY,               // Output Quality
                     FF_DONTCARE or DEFAULT_PITCH,      // Family And Pitch
                     'Comic Sans MS');                  // Font Name

  SelectObject(Form1.Canvas.Handle, font);              // Selects The Font We Want

  wglUseFontOutlines(Form1.Canvas.Handle,               // Select The Current DC
                        0,                              // Starting Character
                        255,                            // Number Of Display Lists To Build
                        base,                           // Starting Display Lists
                        0.0,                            // Deviation From The True Outlines
                        0.3,                            // Font Thickness In The Z Direction
                        WGL_FONT_POLYGONS,              // Use Polygons, Not Lines
                        @gmf);                          // Address Of Buffer To Recieve Data
end;



nastavuje windowsovskej font

font := CreateFont(-12,                                 // Height Of Font
                     0,                                 // Width Of Font
                     0,                                 // Angle Of Escapement
                     0,                                 // Orientation Angle
                     FW_BOLD,                           // Font Weight
                     0,                                 // Italic
                     0,                                 // Underline
                     0,                                 // Strikeout
                     ANSI_CHARSET,                      // Character Set Identifier
                     OUT_TT_PRECIS,                     // Output Precision
                     CLIP_DEFAULT_PRECIS,               // Clipping Precision
                     ANTIALIASED_QUALITY,               // Output Quality
                     FF_DONTCARE or DEFAULT_PITCH,      // Family And Pitch
                     'Comic Sans MS');                  // Font Name

  SelectObject(Form1.Canvas.Handle, font);              // Selects The Font We Want



a převádí na 3d font

wglUseFontOutlines(Form1.Canvas.Handle,                 // Select The Current DC
                        0,                              // Starting Character
                        255,                            // Number Of Display Lists To Build
                        base,                           // Starting Display Lists
                        0.0,                            // Deviation From The True Outlines
                        0.3,                            // Font Thickness In The Z Direction
                        WGL_FONT_POLYGONS,              // Use Polygons, Not Lines
                        @gmf);                          // Address Of Buffer To Recieve Data



Procedura
 
procedure glPrint(text : pchar);                        // Custom GL "Print" Routine
begin
  if (text = '') then                                   // If There's No Text
          Exit;                                         // Do Nothing

  glPushAttrib(GL_LIST_BIT);                            // Pushes The Display List Bits
  glListBase(base);                                     // Sets The Base Character
  glCallLists(length(text), GL_UNSIGNED_BYTE, text);    // Draws The Display List Text
  glPopAttrib();                                        // Pops The Display List Bits
end;             

nastavuje display list.



Popis jednotlivých řádků procedur 'Init Font' a 'glPrint' jsem nechal v angličtině, tak jak je to v příkladu na stránkách NeHe, odkud jsem čerpal rozumy.



Výsledný text se generuje voláním příkazu

glPrint(ch);

Do proměnné 'ch' se může přiřadit jakýkoli text.
V tomto případě do proměnné 'ch' přiřazuji výslednou hodnotu FPS.

procedure DrawFont;
var
st: string;
ch: pchar;
begin
    //Call calculate FPS
    if FPSi = 2 then begin
      CalcFPS(2);
      FPSi := 3;
    end else begin
      CalcFPS(3);
      FPSi := 2;
    end;
    st := 'FPS:' +IntToStr(Round(FPS));
    Form1.Label1.Caption := st;     //show string in Label1
    ch := PChar(st);

    //Draw 3D Font
    glPrint(ch);
    glBindTexture(GL_TEXTURE_2D, TextureBin[1]);
    glEnable(GL_TEXTURE_2D);
end;



Příkazy

  glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
  glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
  glEnable(GL_TEXTURE_GEN_S);
  glEnable(GL_TEXTURE_GEN_T);

automaticky otexturují výsledný objekt (3D text).
a nacházejí se v proceduře

procedure InitTexture;
var a:word;
    f:TGluint;
begin
     UniPicture:=TPicture.Create;
     for a:=1 to 256 do begin
         glGenTextures(1, @f);TextureBin[a]:=f;
     end;
     for a:=1 to 256 do begin
         with texture[a] do begin
            rgbacolor:=nil;
            rgbcolor:=nil;
            ColorSystem:=Gl_RGB;
            glBindTexture(GL_TEXTURE_2D,TextureBin[a]);
            glTexParameterf(GL_Texture_2D,GL_Texture_Wrap_S,gl_repeat);
            glTexParameterf(GL_Texture_2D,GL_Texture_Wrap_T,gl_repeat);
            glTexParameterf(GL_Texture_2D,GL_Texture_Mag_Filter,GL_Linear);
            glTexParameterf(GL_Texture_2D,GL_Texture_Min_Filter,GL_Linear);

            glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
            glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
            glEnable(GL_TEXTURE_GEN_S);
            glEnable(GL_TEXTURE_GEN_T);

         end;
     end;
end;



FPS počítá procedura

procedure CalcFPS(CStep: integer);
var
  i: TLargeInteger;
  FrameTime: double;
begin
  //Calculate start Frequency and start Counter
  if CStep = 1 then begin
    QueryPerformanceCounter(i);
    StartCount := i;
    QueryPerformanceFrequency(i);
    StartFreq := i;
    StartCount := StartCount / StartFreq;
  end;

  //Calculate Counter before draw scene
  if CStep = 2 then begin
    QueryPerformanceCounter(i);
    Count1 := i / StartFreq;
  end;

  //Calculate Counter after draw scene
  if CStep = 3 then begin
    QueryPerformanceCounter(i);
    Count2 := i / StartFreq;
    //calculate FPS
    FrameTime := (Count2 / StartCount) - (Count1 / StartCount);
    FPS :=  1 / FrameTime;
    FPS := FPS / StartCount;
  end;
end;



První krok

  if Step = 1 then begin
    QueryPerformanceCounter(i);
    StartCount := i;
    QueryPerformanceFrequency(i);
    StartFreq := i;
    StartCount := StartCount / StartFreq;
  end;

se volá jen při načítání programu

procedure InitScene;
begin
  ...
  CalcFPS(1);               
  ...
end;

a vypočítá počáteční hodnotu počítadla 'StartCount'.
Příkaz

QueryPerformanceCounter(i);

Načte do proměnné 'i' hodnotu počítadla.


Příkaz

QueryPerformanceFrequency(i);

Načte do proměnné 'i' frekvenci procesoru.

Druhý krok

  if Step = 2 then begin
    QueryPerformanceCounter(i);
    Count1 := i / StartFreq;
  end;

se volá před renderováním prvního snímku.

procedure DrawFont;
begin
    if FPSi = 2 then begin
      CalcFPS(2);
      FPSi := 3;
    end else begin
      ...
      ...
    end;
    
    ...
    ...
    ...
end



Třetí krok

  if Step = 3 then begin
    QueryPerformanceCounter(i);
    Count2 := i / StartFreq;
    //calculate FPS
    FrameTime := (Count2 / StartCount) - (Count1 / StartCount);
    FPS :=  1 / FrameTime;
    FPS := FPS / StartCount;
  end;

se volá před renderováním druhého snímku.

procedure DrawFont;
begin
    if FPSi = 2 then begin
      ...
      ...
    end else begin
      CalcFPS(3);
      FPSi := 2;
    end;
    
    ...
    ...
    ...
end


a provede konečný výpočet

    FrameTime := (Count2 / StartCount) - (Count1 / StartCount);
    FPS :=  1 / FrameTime;
    FPS := FPS / StartCount;





Celej zdroják je tady
Font_f



Lesklé předměty Míření
Home