{******************************************************************************}
{ FontGen Unit - Create a Font from any Windowsfont }
{ __ }
{ ...by / /_____ }
{ / __/ __ \ }
{ / /_/ /_/ / }
{ \__/ ___/ }
{ /_/ }
{ }
{*********************************[ 14.07.2006 ]*******************************}
///// Sample: //////////////////////////////////////////////////////////////////
//
// var
// AnyFontMap: TFontMap; // Base Display List For The Font Set
//
// BEGIN
// BuildFont(DC, 'Arial', AnyFontMap, -14, [fsBold]);
// ...
// glGoto2D;
// glPrintXY(10, 20, 'Sample', AnyFontMap);
// glExit2D;
// ...
// glPrint3D(10,-10,10, 'Hallo', AnyFontMap);
// ...
// KillFont(AnyFontMap);
// END.
//
unit FontGen;
interface
uses
Windows,
OpenGL;
const
GenListsCount = 256;
type
TFontMap =
Record
Map: GLuint;
CharWidth:
array [0..GenListsCount-1]
of Integer;
CharHight: Integer;
end;
TGLFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut);
TGLFontStyles =
set of TGLFontStyle;
procedure glCreateFont(
DC: HDC;
const FontName:
string;
var FontMap: TFontMap;
const Size: Integer = 8; FontStyle: TGLFontStyles = []);
procedure glKillFont(FontMap: TFontMap);
procedure glPrint3D(X,Y, Z: Single; Text:
String; FontMap: TFontMap);
procedure glPrintXY(X,Y: Single; Text:
String; FontMap: TFontMap);
overload;
procedure glPrintXY(X,Y: Single; Text: PChar; FontMap: TFontMap);
overload;
procedure glPrint(text: PChar; FontMap: TFontMap);
function glGetTextLength(Text:
String; FontMap: TFontMap): integer;
implementation
function TextExtent(
DC: HDC; X: Char): TSize;
begin
GetTextExtentPoint(
DC, @X, 1, Result);
end;
procedure glCreateFont(
DC: HDC;
const FontName:
string;
var FontMap: TFontMap;
const Size: Integer = 8; FontStyle: TGLFontStyles = []);
var
font, oldfont: HFONT;
nBold, n: Integer;
function isTrue(Value: TGLFontStyle): Byte;
begin
if Value
in FontStyle
then Result := 1
else Result := 0;
end;
begin
if fsBold
in FontStyle
then nBold := FW_BOLD
else nBold := FW_NORMAL;
FontMap.Map := glGenLists(GenListsCount);
// Storage For X Characters
font := CreateFont(-MulDiv(Size, GetDeviceCaps(
DC, LOGPIXELSY), 72),
// Height Of Font
0,
// Width Of Font
0,
// Angle Of Escapement
0,
// Orientation Angle
nBold,
// Font Weight
isTrue(fsItalic),
// Italic
isTrue(fsUnderline),
// Underline
isTrue(fsStrikeOut),
// 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
PChar(FontName));
// Font Name
oldfont := SelectObject(
DC, font);
// Selects The previous font
wglUseFontBitmaps(
DC, 0, GenListsCount-1, FontMap.Map);
// Builds X Characters Starting At Character 32
for n := 0
to GenListsCount-1
do
FontMap.CharWidth[n] := TextExtent(
DC, Chr(n)).cx;
FontMap.CharHight := TextExtent(
DC, '
X').cy;
SelectObject(
DC, oldfont);
// Put back the old font
DeleteObject(font);
// Delete the font we just created
end;
// (we already have it in the Display list)
procedure glKillFont(FontMap: TFontMap);
// Delete The Font
begin
glDeleteLists(FontMap.Map, GenListsCount);
// Delete the X Characters
end;
procedure glPrint3D(X, Y, Z: Single; Text:
String; FontMap: TFontMap);
begin
glPushMatrix;
glDisable(GL_LIGHTING);
glDisable(GL_TEXTURE_2D);
glRasterPos3d(X, Y, Z);
glPrint(PChar(Text), FontMap);
glEnable(GL_TEXTURE_2D);
glEnable(GL_LIGHTING);
glPopMatrix;
end;
procedure glPrintXY(X,Y: Single; Text:
String; FontMap: TFontMap);
overload;
begin
glRasterPos2f(X, Y);
//This function is to position the text!!!
glPrint(PChar(Text), FontMap);
end;
procedure glPrintXY(X,Y: Single; Text: PChar; FontMap: TFontMap);
overload;
begin
glRasterPos2f(X, Y);
//This function is to position the text!!!
glPrint(Text, FontMap);
end;
procedure glPrint(text : pchar; FontMap: TFontMap);
// Custom GL "Print" Routine
begin
if (text = '
')
then // If There's No Text
Exit;
// just exit
glPushAttrib(GL_LIST_BIT);
// Pushes The Display List Bits
glListBase(FontMap.Map);
// Sets The Base Character
glCallLists(length(text), GL_UNSIGNED_BYTE, text);
// Draws The Display List Text
glPopAttrib();
// Pops The Display List Bits
end;
function glGetTextLength(Text:
String; FontMap: TFontMap): integer;
var i, w: Integer;
begin
w := 0;
for i := 1
to length(Text)
do
w := w + FontMap.CharWidth[ord(Text[i])];
Result := w;
end;
end.