If they are monospaced, then just load then as a bitmap(s) and Copy it. Something like this:
unit rasterfont_U1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls;
type
TMyRasterFont = class
FontBitmap: TBitMap;
CharCount: integer;
CharWidth: integer;
CharHeight: integer;
constructor Create;
procedure LoadFont(fileName: string);
procedure SaveFont(fileName: string);
procedure CaptureFont(const srcCanvas:TCanvas; x,y,w,h:integer; count: integer);
procedure Print(const dstCanvas:TCanvas; x,y:integer; str: string);
end;
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Image1: TImage;
Image2: TImage;
ScrollBox1: TScrollBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: char);
private
{ private declarations }
public
col, line :integer;
MyRasterFont :TMyRasterFont;
{ public declarations }
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var I, w,h: integer; S: string;
begin
with Image2.Picture.Bitmap do
begin
Canvas.Font.Size:=10;
Canvas.Font.Name:='Courier';
w:=Canvas.TextWidth('W');
h:=Canvas.TextHeight('W');
Width := w*256;
Height := h;
Canvas.Brush.Color:=clWhite;
Canvas.FillRect(0,0,width,height);
for I:=0 to 255 do
Canvas.TextOut(w*I,0,chr(I));
end;
MyRasterFont := TMyRasterFont.Create;
MyRasterFont.CaptureFont(Image2.Picture.Bitmap.Canvas, 0,0, 256*w, h, 256);
col:=0;
line:=0;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Pen.Color:=clBlack;
Image1.Canvas.FillRect(0,0,Image1.width,Image1.height);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
MyRasterFont.LoadFont('myrasterfont.bmp');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
MyRasterFont.SaveFont('myrasterfont.bmp');
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
begin
MyRasterFont.Print(Image1.Canvas, col * MyRasterFont.CharWidth,
line * MyRasterFont.CharHeight, Key);
inc(col);
if Key=#10 then begin
inc(line);
col:=0;
end;
end;
constructor TMyRasterFont.Create;
begin
FontBitmap := nil;
CharCount:=0;
CharWidth:=0;
CharHeight:=0;
end;
procedure TMyRasterFont.LoadFont(fileName: string);
begin
FontBitmap := TBitmap.Create;
with FontBitmap do begin
LoadFromFile(fileName); // long bitmap 2550x12, where each letter occupies rect 10x12
Transparent := True;
TransParentColor := clWhite;
TransparentMode := tmAuto;
Self.CharWidth:=Width div 256;
Self.CharHeight:=Height;
Self.CharCount:=256;
end;
end;
procedure TMyRasterFont.SaveFont(fileName: string);
begin
FontBitmap.SaveToFile(fileName); // long bitmap 2550x12, where each letter occupies rect 10x12
end;
//just for test
procedure TMyRasterFont.CaptureFont(const srcCanvas:TCanvas; x,y,w,h:integer; count: integer);
begin
FontBitmap := TBitmap.Create;
try
with FontBitmap do begin
Width := w;
Height := h;
Canvas.Brush.Color:=clWhite;
Canvas.FillRect(0,0,w,h);
Transparent := True;
TransParentColor := clWhite;
TransparentMode := tmAuto;
Canvas.CopyRect(Rect(0,0,w,h),srcCanvas,Rect(0,0,w,h));
end;
CharWidth:=w div count;
CharHeight:=h;
CharCount:=count;
except
FontBitmap.Free;
FontBitmap := nil;
end;
end;
procedure TMyRasterFont.Print(const dstCanvas:TCanvas; x,y:integer; Str: string);
var srcRect: TRect; I, sx, c: integer;
begin
for I:=1 to Length(Str) do
begin
c := Ord(Str[I]);
sx:=c*CharWidth;
srcRect:=rect(sx,0,sx+CharWidth,CharHeight);
dstCanvas.CopyMode:=cmMergeCopy;
dstCanvas.CopyRect(Rect(x,y,x+CharWidth,y+CHarHeight), FontBitmap.Canvas, srcRect);
end;
end;
{$R *.lfm}
end.
Project
object Form1: TForm1
Left = 471
Height = 504
Top = 181
Width = 742
Caption = 'Form1'
ClientHeight = 504
ClientWidth = 742
OnCreate = FormCreate
OnKeyPress = FormKeyPress
LCLVersion = '1.4.0.2'
object Image1: TImage
Left = 38
Height = 295
Top = 140
Width = 568
end
object Button1: TButton
Left = 488
Height = 25
Top = 472
Width = 75
Caption = 'Save Font'
OnClick = Button1Click
OnKeyPress = FormKeyPress
TabOrder = 0
end
object ScrollBox1: TScrollBox
Left = 14
Height = 55
Top = 41
Width = 718
HorzScrollBar.Page = 716
VertScrollBar.Page = 6
ClientHeight = 38
ClientWidth = 716
TabOrder = 1
object Image2: TImage
Left = 0
Height = 22
Top = -1
Width = 4000
end
end
object Button2: TButton
Left = 577
Height = 25
Top = 471
Width = 75
Caption = 'Load Font'
OnClick = Button2Click
OnKeyPress = FormKeyPress
TabOrder = 2
end
end