{-------------------------------------------------------------------------------
Handle BDF Files
BDFfont is a library to handle BDF font (Bitmap Distribution Format file)
font with Delphi.
This library will solve the lack of support for bitmap font on MS-Windows.
A complete documentation and few examples are also available.
Get last revision at : http://sourceforge.net/projects/bdffont/
Copyright TridenT 2003 - Under GNU GPL licence
@Author TridenT
@Version 2003/08/16 TridenT v0.1 Initial revision
@Version 2003/08/18 TridenT v0.2 Added Transparency and Space char cap.
@Version 2003/08/24 TridenT v0.3 Added a message when loading a font.
@Version 2003/09/02 TridenT v0.4 New storage method (fast and tiny)
@Todo
-------------------------------------------------------------------------------}
unit u_BDFfont;
interface
uses SysUtils, Windows, Classes, Graphics, Forms, Controls, Menus,
Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, StdActns,
ActnList, ToolWin, u_CSV_File, contnrs, math;
type
TBDF_Font = class;
// font loading Progess MEssage
TOnProgressLoading = procedure(Sender: TObject; Value: integer) of object;
// Font Character picture
TGlyph = class
private
ParentFont: TBDF_Font; // Font holding the glyph
Height, Width, YOffset: integer;
WidthBytes: integer;
XPosInFont: integer;
DataSize: integer;
procedure ConvertToBitmap(const DataStream: TMemoryStream; const Dest: TBitmap);
public
constructor Create(const Font: TBDF_Font; const dx, dy, dyoff: integer);
destructor Destroy; override;
end;
// Font for all charset
TBDF_Font = class
private
Description: string; // Description
FileName: TFileName; // Font FileName
SharePalette: hPalette; // Palette of the Font
List_Glyph: TObjectList;// of DIB
FontYOffset, Height: integer;
FPixelSpaceChar: integer; //pixel space between character property
FIsTransparent: boolean; // transparent font
FOnProgressLoading: TOnProgressLoading; // Message with percents loaded
FullBitmap: TBitmap; // a bitmap with all glyphs inside
procedure SetPixelSpaceChar(const pscValue: integer);
procedure AddGlyphToFullBitmap(Glyph: TGlyph; GlyphBitmap: TBitmap);
procedure InitFullBitmap;
published
property PixelSpaceChar: integer read FPixelSpaceChar write SetPixelSpaceChar;
property IsTransparent: boolean read FIsTransparent write FIsTransparent;
property OnFontLoading: TOnProgressLoading
read FOnProgressLoading write FOnProgressLoading;
public
constructor Create;
destructor Destroy; override;
function LoadFromFile(const Name: TFileName): integer;
procedure DrawText(const X, Y: integer; const Dest: TCanvas; Text: string);
procedure SaveToBitmap(fn: TFilename);
end;
implementation
// Create a new monochrome palette
function GetTwoColorPalette: hPalette;
var
Palette: TMaxLogPalette;
begin
Palette.palVersion := $300;
Palette.palNumEntries := 2;
with Palette.palPalEntry[0] do
begin
peRed := 255;
peGreen := 255;
peBlue := 255;
peFlags := 0
end;
with Palette.palPalEntry[1] do
begin
peRed := 0;
peGreen := 0;
peBlue := 0;
peFlags := 0;
end;
Result := CreatePalette(pLogPalette(@Palette)^)
end {GetTwoColorPalette};
// ############################ TBDF_Font ######################################
// Creates and initializes a TBDF_Font.
constructor TBDF_Font.Create;
begin
inherited Create;
List_Glyph := TObjectList.Create(True);
SharePalette := GetTwoColorPalette;
FPixelSpaceChar := 1;
FIsTransparent := True;
InitFullBitmap;
end;
// Destroys an instance of TBDF_Font.
destructor TBDF_Font.Destroy;
begin
FreeAndNil(List_Glyph);
FreeAndNil(FullBitmap);
inherited Destroy;
end;
{-------------------------------------------------------------------------------
Change pixel space between two char (glyph)
When the font is created, the value is set by default at 2 pixels, but
can be changed with this method. A negative value will be converted to 0.
@param pscValue: integer pixel space between two char
-------------------------------------------------------------------------------}
procedure TBDF_Font.SetPixelSpaceChar(const pscValue: integer);
begin
if pscValue < 0 then FPixelSpaceChar := 0
else
FPixelSpaceChar := pscValue;
end;
{-------------------------------------------------------------------------------
Draw a string on the Canvas at position (X,Y)
To call the Draw method, the BDFfont must be initialized, by LoadFromFile
method. Canvas drawing method can be configured as standard canvas routine.
Beware that some character may not be defined ih the BDF font file you load !
@param X, Y: integer (X,Y) coordinates on the canvas client.
Dest: TCanvas Destination Canvas.
Text: string Text to display
-------------------------------------------------------------------------------}
procedure TBDF_Font.DrawText(const X, Y: integer; const Dest: TCanvas; Text: string);
var
IndexChar: integer;
IconPos, CharPos: integer;
Tmp_Glyph: TGlyph;
begin
if Length(Text) <= 0 then exit;
if IsTransparent then
begin
FullBitmap.TransparentMode := tmAuto;
FullBitmap.Transparent := True;
Dest.CopyMode := cmSrcAnd;
end
else
Dest.CopyMode := cmSrcCopy;
CharPos := 0;
for IndexChar := 1 to Length(Text) do
begin
// Verify if char is in the font
if integer(Text[IndexChar]) < List_Glyph.Count then
IconPos := integer(Text[IndexChar]) - 32
else
IconPos := 0;
Tmp_Glyph := List_Glyph.Items[IconPos] as TGlyph;
// Verify if character is handle by font, if not, assign SPACE char.
if Tmp_Glyph = nil then Tmp_Glyph := List_Glyph.First as TGlyph;
assert(Tmp_Glyph <> nil);
Dest.CopyRect(Bounds(CharPos + X, Y, Tmp_Glyph.Width, Self.Height), FullBitmap.Canvas
, Bounds(Tmp_Glyph.XPosInFont, 0,Tmp_Glyph.Width, Self.Height));
Inc(CharPos, Tmp_Glyph.Width + FPixelSpaceChar);
end;
end;
{-------------------------------------------------------------------------------
Add a glyph to the font system
AddGlyphToFullBitmap simply add the glyph in the internal representation
of the font.
@param Glyph: TGlyph; Glyph to add
@param GlyphBitmap: TBitmap Bitmap to add
-------------------------------------------------------------------------------}
procedure TBDF_Font.AddGlyphToFullBitmap(Glyph: TGlyph; GlyphBitmap: TBitmap);
var
NextGlyphPos: integer;
begin
if Assigned(Glyph) then
begin
// Draw glyph on the new Bitmap
NextGlyphPos := FullBitmap.Width + 1;
FullBitmap.Width := FullBitmap.Width + Glyph.Width + 1;
Glyph.XPosInFont := NextGlyphPos;
FullBitmap.Canvas.Draw(NextGlyphPos, 0,GlyphBitmap);
end;
end;
{-------------------------------------------------------------------------------
Save the font to BMP file
The BDF font is export in BMP file, 1bit for color.
All the glyphs are inside, from left to right
@param fn: TFilename Filename to create
-------------------------------------------------------------------------------}
procedure TBDF_Font.SaveToBitmap(fn: TFilename);
begin
FullBitmap.SaveToFile(fn);
end;
{-------------------------------------------------------------------------------
Load a BDF font from a file
The file is load as CSV file (in fact, a text file separated by space).
When loading very large file, use OnProgressLoading to be aware of progress
loading.
@param Name: TFileName BDFfont filename to load.
@return integer 0 if succesfull, -1 otherwise
-------------------------------------------------------------------------------}
function TBDF_Font.LoadFromFile(const Name: TFileName): integer;
// Define information's order in CVS file
const
vlDescription = 1;
vlHeight = 2;
vlFontYOffset = 4;
vlGlyphTotal = 1;
vlGlyphX = 1;
vlGlyphY = 2;
vlGlyphYoff = 4;
vlCharLine = 0;
vlGlyphNumber = 1;
type
TDD = array[0..3] of byte;
var
FCSV: TCSV_File; // File to load from, in CSV format
GlyphTotal, Delta, IndexDelta: integer;
GlyphNumber, GlyphNumberOld, GlyphIndex: integer;
GlyphX, GlyphY, IndexY, IndexX, GlyphYoff: integer;
Line: DWORD;
Glyph: TGlyph;
PByteLine: PByteArray;
RawDataStream: TMemoryStream; // Glyph are stored in raw data
Tmp_GlyphBitmap: TBitmap;
begin
// Initalize list properties
FileName := Name;
RawDataStream := TMemoryStream.Create;
// Init CSV file
FCSV := TCSV_File.Create;
FCSV.Open(Name);
FCSV.Separator := ' ';
// Read FONT file as CSV file
FCSV.Find('FONT'); // Font name/type/CharSet/Description
Description := FCSV.ValueList[vlDescription];
FCSV.Find('FONTBOUNDINGBOX'); // Chars number
Height := StrToInt(FCSV.ValueList[vlHeight]);
FontYOffset := StrToInt(FCSV.ValueList[vlFontYOffset]);
FullBitmap.Height := Height;
FCSV.Find('CHARS'); // Chars number
GlyphTotal := StrToInt(FCSV.ValueList[vlGlyphTotal]);
GlyphNumberOld := 31;
for GlyphIndex := 0 to (GlyphTotal - 1) do
begin
// Send message
if assigned(FOnProgressLoading) then FOnProgressLoading(self
, (GlyphIndex + 1) * 100 div GlyphTotal);
FCSV.Find('STARTCHAR'); // Chars number
FCSV.Find('ENCODING');
GlyphNumber := StrToInt(FCSV.ValueList[vlGlyphNumber]);
// Compute number of bypassed glyph
Delta := GlyphNumber - GlyphNumberOld;
// fill bypassed glyph with first glyph (space glyph)
if Delta > 1 then
for IndexDelta := 1 to (Delta - 1) do
List_Glyph.Add(nil);
// load glyph coordinate
FCSV.Find('BBX');
GlyphX := StrToInt(FCSV.ValueList[vlGlyphX]);
GlyphY := StrToInt(FCSV.ValueList[vlGlyphY]);
GlyphYoff := StrToInt(FCSV.ValueList[vlGlyphYoff]);
// new Glyph
Glyph := TGlyph.Create(Self, GlyphX, GlyphY, GlyphYoff);
FCSV.Find('BITMAP');
RawDataStream.Clear;
RawDataStream.SetSize(Glyph.DataSize);
// Fill glyph with value from file
for IndexY := 0 to GlyphY - 1 do
begin
FCSV.ReadNextLine;
Line := DWORD(StrToInt64('0x' + FCSV.ValueList[vlCharLine]));
PByteLine := PByteArray(@Line);
if (Line >= $00000100) then Line := swap(Line);
for IndexX := 0 to (Glyph.WidthBytes - 1) do
begin
RawDataStream.Seek(IndexY * Glyph.WidthBytes + IndexX, 0);
RawDataStream.Write(PByteLine[IndexX], 1)
end;
end;
Tmp_GlyphBitmap := TBitmap.Create;
// Convert to bitmap
Glyph.ConvertToBitmap(RawDataStream, Tmp_GlyphBitmap);
// Add to the FullBitmap
AddGlyphToFullBitmap(Glyph, Tmp_GlyphBitmap);
FreeAndNil(Tmp_GlyphBitmap);
// Add this glyph to the list
List_Glyph.Add(Glyph);
GlyphNumberOld := GlyphNumber;
end;
// End
FCSV.Close;
FCSV.Free;
Result := 0;
end;
// ############################ TGlyph ######################################
{-------------------------------------------------------------------------------
Creates and initializes a TGlyph.
@param Font: TBDF_Font Parent's owner (TBDFfont) of the Glyph
dx, dy, dyoff: integer Coordinates and offset of the Glyph
-------------------------------------------------------------------------------}
constructor TGlyph.Create(const Font: TBDF_Font; const dx, dy, dyoff: integer);
begin
// Copy value
Width := dx;
Height := dy;
YOffset := dyoff;
// Calculate XRes Bytes
WidthBytes := ceil(dx / 8);
// Compute size of glyph
DataSize := WidthBytes * dy;
// Allocate memory for glyph bitmap - 1 bit format
ParentFont := Font;
end;
// Destroys an instance of TGlyph.
destructor TGlyph.Destroy;
begin
//
end;
{-------------------------------------------------------------------------------
Convert a glyph into a Bitmap
When a font is loaded, all glyphs are stored and raw data, not bitmap, because
bitmap is very memory expensive.
So, in order to display a glyph (when writing a text), it must be converted
into a bitmap to be draw.
@param var Dest: TBitmap ParameterDescription
@return None 0 if succesfull, -1 otherwise
-------------------------------------------------------------------------------}
procedure TGlyph.ConvertToBitmap(const DataStream: TMemoryStream; const Dest: TBitmap);
var
IndexY, IndexX, GlyphLine: integer;
PByteA: PByteArray;
begin
Dest.HandleType := bmDIB;
Dest.Height := ParentFont.Height;
Dest.Width := Width;
Dest.PixelFormat := pf1bit;
Dest.Palette := GetTwoColorPalette;//ParentFont.SharePalette #NOT WORKING;
Dest.TransparentColor := clBlack;
for IndexY := (Dest.Height - 1) downto (0) do
begin
Assert(IndexY >= 0);
Assert(IndexY < Dest.Height);
PByteA := Dest.ScanLine[IndexY];
GlyphLine := IndexY - Dest.Height + Height - ParentFont.FontYOffset + YOffset;
for IndexX := 0 to WidthBytes - 1 do
begin
if (GlyphLine <= (Height - 1)) and (GlyphLine >= 0) then
begin
DataStream.Position := IndexX + GlyphLine * WidthBytes;
DataStream.Read(PByteA[IndexX], 1)
end
else
PByteA[IndexX] := $00;
end;
end;
end;
// ############################ --------- ######################################
procedure TBDF_Font.InitFullBitmap;
begin
// Force bitmap to monochrome, 1 bit per pixel
FullBitmap := TBitmap.Create;
FullBitmap.HandleType := bmDIB;
FullBitmap.Height := self.Height;
FullBitmap.Width := 1;
FullBitmap.PixelFormat := pf1bit;
end;
initialization
finalization
end.