{-------------------------------------------------------------------------------
  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.