如何将TTF字库转换成点阵信息?急!!!!!!!!!!!!!(300分)

  • 主题发起人 主题发起人 笨笨
  • 开始时间 开始时间

笨笨

Unregistered / Unconfirmed
GUEST, unregistred user!
我要做led信息牌的控制程序,需要得到16×16,32×32,64×64的点阵信息,但是我不
知道ttf文件的格式,也不知道该如何将矢量字库转换为点阵,请各位大侠指教,或者
有更好的办法解决也行啊,要是有源代码就最妙了,本想以1000大洋相送,可惜斑竹说
最多只能300大洋买答案,就先送300吧。
 
我不知道文件格式是什么样的,但是你为什么要用他们的点阵信息呢?
如果你真想用,那么可以创建一个TBitmap,将Canvas中的Font的Name设置成为
相应的ttf文件,Size设置成为你想要的16,32,64之类的东西,然后将你想要
处理的文字画道Canvas上,这样Canvas上就有了你想要的点阵信息了(判断每一
个象素的颜色),如果你想要整个字符集的,那你就将整个字符集画一遍就行了。
OK?
 
我的一个小程序,也许对你有启发。

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls;

type
TMainForm = class(TForm)
Panel1: TPanel;
SpdButtonClose: TSpeedButton;
Edit1: TEdit;
procedure FormPaint(Sender: TObject);
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpdButtonCloseClick(Sender: TObject);
private
{ Private declarations }
OldX,
OldY,
OldLeft,
OldTop : Integer;
ScreenDC : HDC;
MoveRect : TRect;
Moving : Boolean;

public
{ Public declarations }
end;

const
CharWidth = 12; //字符宽度
ZoomInLeft = 250;//放大区域位置
ZoomInTop = 75; //放大区域位置
var
MainForm: TMainForm;
CHNchar:array[0..CharWidth-1,0..CharWidth-1] of byte;
CharLeft,CharTop : integer;//原样画字符的位置


implementation

{$R *.DFM}


procedure TMainForm.FormPaint(Sender: TObject);
begin
//设置画布的画笔及刷子颜色
MainForm.Canvas.Pen.Color := $00C08000;
Canvas.Brush.Color := 13882323;
//画窗体框双线框,只是为了好看
MainForm.Canvas.Rectangle(1, Panel1.Height+1,MainForm.Width-1, MainForm.Height-1);
MainForm.Canvas.Rectangle(3, Panel1.Height+3,MainForm.Width-3, MainForm.Height-3);

MainForm.Canvas.Rectangle(Edit1.Left-3 ,Edit1.Top-3 ,Edit1.Left +Edit1.Width +3 ,Edit1.Top +Edit1.Height+3 );
MainForm.Canvas.Rectangle(Edit1.Left-1 ,Edit1.Top-1 ,Edit1.Left +Edit1.Width +1 ,Edit1.Top +Edit1.Height+1 );

end;

procedure TMainForm.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
i, j : integer;//循环变量

//读点子过程
//- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
procedure ReadPixel(width:integer);
var
i, j : integer;

begin
for i:=0 to width -1 do
for j:=0 to width -1 do
if MainForm.Canvas.Pixels[CharLeft+i+2,CharTop+j+2] = clWhite then CHNchar[i,j]:= 0
else CHNchar[i,j] := 1;
end;
//- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

begin
//判断是否为回车键
if key = 13 then
begin

MainForm.Canvas.Pen.Color := $00C08000;
MainForm.Canvas.Brush.Color := 13882323;
//画原样画字符的双线框,只是为了好看
MainForm.Canvas.Rectangle(CharLeft-2, CharTop-2, CharLeft + CharWidth+6, CharTop + CharWidth+6);
Canvas.Brush.Color := clWhite;
MainForm.Canvas.Rectangle(CharLeft, CharTop, CharLeft + CharWidth+4, CharTop + CharWidth+4 );
//设置画布的字体
MainForm.Canvas.Font := MainForm.Font ;
MainForm.Canvas.TextOut(CharLeft+2,CharTop+2,Edit1.Text);
ReadPixel(CharWidth);//读点并存入数组
//恢复刷子的颜色
MainForm.Canvas.Brush.Color := 13882323;
//画格
for i:=0 to CharWidth +1 do
for j:=0 to CharWidth +1 do
MainForm.Canvas.Rectangle(ZoomInLeft+i*10,ZoomInTop+j*10,ZoomInleft+i*10+11,ZoomInTop+j*10+11);
//设置画字符时的刷子颜色
MainForm.Canvas.Brush.Color := $00C80000;
//从数组中读出数据,画字符
for i:=1 to CharWidth do
for j:=1 to CharWidth do
if CHNchar[i-1,j-1] = 1 then
MainForm.Canvas.Rectangle(ZoomInLeft+i*10,ZoomInTop+j*10,ZoomInLeft+i*10+11,ZoomInTop+j*10+11);
end;

Edit1.Text := '';

end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
CharLeft:=Edit1.Left + Edit1.Width + 10;
CharTop:=Edit1.Top +1;

end;

procedure TMainForm.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
SetCapture(Panel1.Handle);
ScreenDC := GetDC(0);
OldX := X;
OldY := Y;
OldLeft := X;
OldTop := Y;
MoveRect := BoundsRect;
DrawFocusRect(ScreenDC,MoveRect);
Moving := True;
end;

end;

procedure TMainForm.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Moving then begin
DrawFocusRect(ScreenDC,MoveRect);
OldX := X;
OldY := Y;
MoveRect := Rect(Left+OldX-OldLeft,Top+OldY-OldTop,
Left+Width+OldX-OldLeft,Top+Height+OldY-OldTop);
DrawFocusRect(ScreenDC,MoveRect);
end;

end;

procedure TMainForm.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
ReleaseCapture;
DrawFocusRect(ScreenDC,MoveRect);
Left := Left+X-OldLeft;
Top := Top+Y-OldTop;
ReleaseDC(0,ScreenDC);
Moving := False;
end;

end;

procedure TMainForm.SpdButtonCloseClick(Sender: TObject);
begin
Close;
end;

end.

 
ttf的格式研究太麻烦,还不如将你要显示的汉字,先画在image1.canvas上按16*16、24*24、
64*64的大小显示,然后在读出点阵的响应信息。你可以将image1隐藏。
 
多人接受答案了。
 

Similar threads

后退
顶部