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
Bookmarks