www.pudn.com > racecar.zip > Font.pas

// --------------------- 
// Unit: Font.pas 
// 
// Holds Font objects which can 
// Load and display bitmap fonts. 
// 
// Author: Michael Pote 
// Date: 02 Jan 2002 
// ------------------- 
unit Font; 
 
interface 
 
Uses OpenGL; 
 
type  FontRect = Record 
                  T1,U1,T2,U2, W, H: single; 
                 end; 
      FontObj = Object 
                 F: array of FontRect; 
                 StartChar, FontLen, CharOffset: integer; 
                 TexInd: glUInt; 
                 SpaceWidth: single; 
                 Procedure Load(const Path:string); 
                 Procedure Draw(Const X,Y: single;Const Txt:string; Lev:single); 
                 Function TextLen(Const Txt: string): single; 
                end; 
implementation 
 
Uses Classes, TGATexture; 
 
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external 'opengl32.dll'; 
 
 
Procedure DrawQuadRT(X, Y, Wid, Hgt, Lev, Tu, Tu2, Tv,Tv2: single); 
begin 
  Tv := 1-Tv; 
  Tv2 := 1-Tv2; 
  glBegin(GL_QUADS); 
    glTexCoord2f(Tu,  Tv); glVertex3f(X,     Y, -lev); 
    glTexCoord2f(Tu2, Tv); glVertex3f(X+Wid, Y, -lev); 
    glTexCoord2f(Tu2,Tv2); glVertex3f(X+Wid, Y-Hgt, -lev); 
    glTexCoord2f(Tu, Tv2); glVertex3f(X,     Y-Hgt, -lev); 
  glEnd; 
end; 
 
Procedure FontObj.Load(Const Path:string); 
Var Fi: TfileStream; 
    I, Data: integer; 
    StPos: longint; 
begin 
  LoadTGA(Path, TexInd, False); 
  SpaceWidth := 5; 
  Fi := TFileStream.Create(Path, $0000); 
  Fi.Seek(-sizeof(longint), soFromEnd); 
  Fi.Read(Stpos, sizeof(longint)); 
  Fi.Seek(Stpos, soFromBeginning); 
 
  Fi.Read(Data, Sizeof(integer)); 
  FontLen := Data; 
  Fi.Read(Data, Sizeof(integer)); 
  StartChar := Data; 
  Fi.Read(Data, Sizeof(integer)); 
  CharOffset := Data; 
 
  Setlength(F, FontLen+1); 
  For I := 0 to high(F) do 
   begin 
     Fi.Read(F[I], sizeof(FontRect)); 
   end; 
  Fi.Free; 
 
end; 
 
Function FontObj.TextLen(Const Txt:string): single; 
Var I, Let: integer; 
    Len: single; 
begin 
   Len := 0; 
   For I := 0 to length(Txt) do 
   begin 
      Let := Ord(Txt[I])-StartChar; 
      if (Let <> -1) then 
      begin 
       Len := Len + F[Let].W+1-CharOffset; 
      end 
      else 
      Len := Len + SpaceWidth; 
   end; 
   Result := Len; 
end; 
 
Procedure FontObj.Draw(Const X,Y: single;Const Txt:string; Lev:single); 
Var I, Let: integer; 
    Xx: Single; 
begin 
  if txt = '' then exit; 
 
  glBindTexture(GL_TEXTURE_2D,TexInd); 
 
  Xx := X; 
  For I := 1 to length(Txt) do 
  begin 
     Let := Ord(Txt[I])-StartChar; 
     if (Let <> -1) and not (let > FontLen) then 
     begin 
      DrawQuadRT(Xx,Y, F[Let].W+1.25,F[Let].H+1.25,Lev,F[Let].T1,F[Let].T2+0.005,F[Let].U1,F[Let].U2+0.005); 
      Xx := Xx + F[Let].W+1.25-CharOffset; 
     end 
     else 
     Xx := Xx + SpaceWidth; 
  end; 
end; 
 
end.