frontend for emulators in opengl

**azrael11** · 07-10-2010, 04:20 AM

Code:

unit Font2;
interface
Uses dglOpenGL;
type
FontRect = Record
 T1,U1,T2,U2, W, H, KernW: single;
end;
TFontObj = class
 F: array of FontRect;
 StartChar, FontLen, CharOffset: integer;
 TexInd: glUInt;
 SpaceWidth, AverageHeight: single;
 constructor Create(filename: string); overload;
 constructor Create; overload;
 Procedure Load(const Path:string);
 Procedure Draw(Const X,Y: single;Const Txt:string; Lev:single); Overload;
 Procedure Draw(Const X,Y: single;Const Txt:string); overload;
 Procedure DrawCentered(Const X,Y: single;Const Txt:string);
 Procedure FadeIn(Const X,Y: single; Const Txt: string; Percent, Thres: single);
 Procedure FadeOut(Const X,Y: single; Const Txt: string; Percent, Thres: single);
 Function TextLen(Const Txt: string): single;
end;
Procedure DrawQuadRT(X, Y, Wid, Hgt, Lev, Tu, Tu2, Tv,Tv2: single);
implementation
Uses Classes, Windows, JPEG, Graphics, SysUtils,main;
constructor TFontObj.Create(filename: string);
begin
  Inherited Create;
  Load(filename);
end;
constructor TFontObj.Create;
begin
  inherited Create;
end;
function CreateTexture(Width, Height, Format : Word; pData : Pointer; Mipmap: boolean) : Integer;
var
  Texture : GLuint;
begin
  glGenTextures(1, @Texture);
  glBindTexture(GL_TEXTURE_2D, Texture);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
 if Mipmap then
  begin
   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); 
  end
  else
  begin
   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  end;
if Format = GL_RGBA then
    gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData)
  else
    gluBuild2DMipmaps(GL_TEXTURE_2D, format, Width, Height, format, GL_UNSIGNED_BYTE, pData);

  result :=Texture;
end;
function LoadJPGs(Filename1, Filename2: String; var Texture: GLuint): Boolean;
var
  Data : Array of Byte;
  W, Width : Integer;
  H, Height : Integer;
  BMP : TBitmap;
  JPG: TJPEGImage;
  C : LongWord;
  Line : PByteArray;

  MaxSize: integer;
  TD: Array of LongWord;
  ScaleF: single;
  OldW, OldH, X, Y, I: integer;
begin
  result :=FALSE;
  JPG:=TJPEGImage.Create;

    try
      JPG.LoadFromFile(Filename1);
    except
      MessageBox(0, PChar('Couldn''t load JPG - "'+ Filename1 +'"'), PChar('BMP Unit'), MB_OK);
      Exit;
    end;
  // Create Bitmap
  BMP:=TBitmap.Create;
  BMP.pixelformat:=pf24bit;
  BMP.width:=JPG.width;
  BMP.height:=JPG.height;
  BMP.canvas.draw(0,0,JPG);        // Copy the JPEG onto the Bitmap
  Width :=BMP.Width;
  Height :=BMP.Height;
  SetLength(Data, Width*Height*4);
  For H:=0 to Height-1 do
  Begin
    Line :=BMP.scanline[Height-H-1];   // flip JPEG
    For W:=0 to Width-1 do
    Begin
      Data[(W*4)+(H*Width*4)] := Line[W*3];
      Data[(W*4)+1+(H*Width*4)] := Line[W*3+1];
      Data[(W*4)+2+(H*Width*4)] := Line[W*3+2];
    End;
  End;
    try
      JPG.LoadFromFile(Filename2);
    except
      MessageBox(0, PChar('Couldn''t load JPG - "'+ Filename2 +'"'), PChar('BMP Unit'), MB_OK);
      Exit;
    end;
  BMP.canvas.draw(0,0,JPG);        // Copy the JPEG onto the Bitmap
  For H:=0 to Height-1 do
  Begin
    Line :=BMP.scanline[Height-H-1];   // flip JPEG
    For W:=0 to Width-1 do
    Begin
      Data[(W*4)+3+(H*Width*4)] := Line[W*3];    
    End;
  End;
  BMP.free;
  JPG.free;
 glGetIntegerv(GL_MAX_TEXTURE_SIZE, @MaxSize);
  OldW := -1;
  if width > Height then
  begin
   if width > Maxsize then
   begin
     ScaleF := MaxSize / width;
    OldW := width;
     OldH := Height;
     width := Maxsize;
     Height := round(Height*ScaleF);
   end;
  end
  else
  begin
   if height > Maxsize then
   begin
     ScaleF := MaxSize / height;
     OldW := width;
     OldH := Height;
     height := Maxsize;
     width := round(width*ScaleF);
   end;
  end;
  if OldW > -1 then
  begin
     ScaleF := 1/ScaleF;
     SetLength(TD, Width*Height);
     For X := 0 to Width-1 do
     For Y := 0 to Height-1 do
     begin
        TD[(Y*Width+X)] := data[
                        round(((Y*OldW)*ScaleF+(X*ScaleF)))];
     end;
     SetLength(Data, Width*Height);
     For Y := 0 to high(Td) do
      Data[Y] := Td[Y];
     SetLength(TD, 0);
  end;
 Texture :=CreateTexture(Width, Height, GL_RGBA, addr(Data[0]), true);
  result :=TRUE;
end;
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 TFontObj.Load(Const Path:string);
Var Fi, F2: TfileStream;
    I, Data: integer;
    StPos, CtPos: longint;
    Other: string;
begin
  Setlength(F, 1);
  FontLen := 0;
  if Not FileExists(Path) then
  begin
     MessageBox(0, pchar(Path + ' was not found.'), 'Missing File', MB_OK or MB_ICONERROR);
     exit;
  end;
  SpaceWidth := 5;
  Other := Copy(Path, 1, length(Path)-3)+'jpg';
  Fi := TFileStream.Create(Path, $0000);
  F2 := Tfilestream.Create(Other, FmCreate or $0000);
  Fi.Seek(-(sizeof(longint)*2), soFromEnd);
  Fi.Read(Ctpos, sizeof(longint));
  Fi.Read(Stpos, sizeof(longint));
  Fi.Seek(Ctpos, soFromBeginning);
  F2.CopyFrom(Fi, StPos-CtPos-1);
  F2.Free;
  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;
  Fi.Read(Data, Sizeof(integer));
  SpaceWidth := Data;
  Setlength(F, FontLen+1);
  AverageHeight := 0;
  For I := 0 to high(F) do
   begin
     Fi.Read(F[I], sizeof(FontRect));
     AverageHeight := AverageHeight + F[I].H;
   end;
  AverageHeight := AverageHEight / (FontLen+1);
  Fi.Free;
  LoadJpgs(Path, Other, TexInd);
  DeleteFile(Other);
end;

Function TFontObj.TextLen(Const Txt:string): single;
Var I, Let: integer;
    Len: single;
begin
   Len := 0;
   For I := 0 to length(Txt) do
   begin
     if Txt[I] = ' ' then
       Len := Len + SpaceWidth
     else
     begin
      Let := Ord(Txt[I])-StartChar;
      if (Let <> -1) then
      begin
       Len := Len + F[Let].KernW;
      end
      else
      Len := Len + SpaceWidth;
     end;
   end;
   Result := Len;
end;

Procedure TFontObj.DrawCentered(Const X,Y: single;Const Txt:string);
var Hw, Hh: single;
begin
   Hw := TextLen(Txt)*0.5;
   Hh := AverageHeight*0.5;
   Draw(X-Hw, Y+Hh, Txt, 0);
end;

Procedure TFontObj.FadeIn(Const X,Y: single; Const Txt: string; Percent, Thres: single);
Var I, Let, Len: integer;
    Xx, Fr, Cutoff: Single;
begin
  if txt = '' then exit;
  Len := Length(Txt);
  Percent := Percent*(1+(Thres/Len));
  if Percent < 0.001 then exit;
  Xx := X;
  Fr := Len*Percent;
  glBindTexture(GL_TEXTURE_2D, TexInd);
  For I := 1 to len do
  begin
     Cutoff := (Fr-I);
     if Cutoff >= 0 then
     begin
       if Cutoff > Thres then
         glColor4f(1,1,1,1)
       else
         glColor4f(1,1,1,Cutoff/Thres);
     end
     else
     begin
         glColor4f(1,1,1,0);
     end;

     if Txt[I] = ' ' then
       Xx := Xx + SpaceWidth
     else
     begin
      Let := Ord(Txt[I])-StartChar;
      if ((Let > -1) and not (let > FontLen)) {and (not (Let+StartChar) = 32)} then
      begin
       DrawQuadRT(Xx,Y, F[Let].W,F[Let].H,0,F[Let].T1,F[Let].T2,F[Let].U1,F[Let].U2);
       Xx := Xx + F[Let].KernW;
      end
      else
       Xx := Xx + SpaceWidth;
     end;
  end;
  glColor4f(1,1,1,1);
end;
Procedure TFontObj.FadeOut(Const X,Y: single; Const Txt: string; Percent, Thres: single);
Var I, Let, Len: integer;
    Xx, Fr, Cutoff: Single;
begin
  if txt = '' then exit;
  Len := Length(Txt);
  Percent := Percent*(1+(Thres/Len));
  Xx := X;
  Fr := Len*Percent;
  glBindTexture(GL_TEXTURE_2D, TexInd);
  For I := 1 to len do
  begin
     Cutoff := (Fr-I);
     if Cutoff >= 0 then
     begin
       if Cutoff > Thres then
         glColor4f(1,1,1,0)
       else
         glColor4f(1,1,1,1-(Cutoff/Thres));
     end
     else
     begin
         glColor4f(1,1,1,1);
     end;
     if Txt[I] = ' ' then
       Xx := Xx + SpaceWidth
     else
     begin
      Let := Ord(Txt[I])-StartChar;
      if ((Let > -1) and not (let > FontLen)) {and (not (Let+StartChar) = 32)} then
      begin
       DrawQuadRT(Xx,Y, F[Let].W,F[Let].H,0,F[Let].T1,F[Let].T2{+0.005},F[Let].U1,F[Let].U2{+0.005});
       Xx := Xx + F[Let].KernW;
      end
      else
       Xx := Xx + SpaceWidth;
     end;
  end;
end;


Procedure TFontObj.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);
  For I := 1 to length(Txt) do
  begin
     if Txt[I] = ' ' then
       Xx := Xx + SpaceWidth
     else
     begin
      Let := Ord(Txt[I])-StartChar;
      if ((Let > -1) and not (let > FontLen)) {and (not (Let+StartChar) = 32)} then
      begin
       DrawQuadRT(Xx,Y, F[Let].W,F[Let].H,Lev,F[Let].T1,F[Let].T2{-0.005},F[Let].U1,F[Let].U2{-0.005});
       Xx := Xx + F[Let].KernW;
      end
      else
       Xx := Xx + SpaceWidth;
     end;
  end;
end;

Procedure TFontObj.Draw(Const X,Y: single;Const Txt:string);
begin
  Draw(X,Y, Txt, 0);
end;
end.

and some other thing
You see in the code i try to write four lines with text the result i get is
something like this...
text
text
___text
______text
Thank you

Thread: frontend for emulators in opengl

Thread Tools

Display

Threaded View

Bookmarks

Bookmarks

Posting Permissions