如何提取汉字的点阵信息，从DOS的HZK16提取的点阵信息不理想！
要做一个电子显示屏，需要提取Windows下任意字体的点阵信息，如何才能做到？ 问题点数：100、回复次数：6Top
1 楼gzmhero（hihihi）回复于 2006-03-09 09:30:13 得分 40
在内存建立一个Canvas，然后在Canvas上面写这个字，再把Canvas上的点的颜色取出来，就能得到点阵的信息了。Top
2 楼gzmhero（hihihi）回复于 2006-03-09 09:47:41 得分 0
举个例子：
procedure TForm1.BitBtn1Click(Sender: TObject);
var
bm:TBitMap;
i,j:integer;
begin
bm:=TBitMap.Create;
bm.Canvas.Brush.Color:=clWhite;
bm.Canvas.Pen.Color:=clBlack;
bm.Width:=20;//应该按照字体大小来设置宽，高
bm.Height:=20;
bm.Canvas.TextOut(0,0,'啊');
for i:=0 to 19 do
for j:=0 to 19 do
begin
// 判断bm.Cnavas.Pixels[i,j]就是点阵信息=clBlack为1，=clWhite为0
// Image1.Canvas.Pixels[i,j]:=bm.Canvas.Pixels[i,j];
end;
bm.Free;
end;
Top
3 楼hexenzhou（甲骨文）回复于 2006-03-09 16:02:15 得分 0
这个方法不错，还有其他方法吗？以前看到直接调用Windows的API函数就可以得到任意字体的点阵信息，现在忘了是什么函数了。Top
4 楼zhuminghua（）回复于 2006-03-09 17:14:53 得分 0
GetFontDataTop
5 楼skertone（）回复于 2006-03-14 16:26:27 得分 60
哈，我有现成的程序给你点关键代码吧
生成标准字库文件，一般硬件开发的直接烧到芯片中去就行了
procedure TForm1.btnOKClick(Sender: TObject);
const
strText1 = '存放在字库路径的文件“';
strText2 = '”已经存在，是否替换原有文件？'+#13#13+'强烈建议不替换，另建有表达意义的文件名！';
var
dd: HDC; //Panel句柄
count,number,address: Integer;
//count 扫描点的序数, number 扫描点的序数，用于合成字节, address 汉字库中离起点的偏移位置
p,k,i,j,n,m: Integer; //p,k 扫描循环, i,j 全部汉字扫描循环, n 32个字节循环, m 改变字节为char类型循环
str: String; //str 中文内码
Byte1,Byte2: Byte; //合成字节的二位
Point: array[0..1023] of Integer; //扫描到的点
Buf16: array[0..127] of byte; //生成点阵字节
wStr: array[0..127] of char; //char型生成点阵字节
PositionX,PositionY,settype: Integer;
f: TFont; //设置字体
begin
if edtFile.Text = ExtractFilePath(Application.ExeName) then
begin
Application.MessageBox('请输入生成字库文件名！','操作提示',MB_ICONINFORMATION+MB_OK);
edtFile.SetFocus;
edtFile.SelStart := Length(edtFile.Text);
Exit;
end;
if FileExists(edtFile.Text) = True then
begin
if Application.MessageBox(PChar(strText1+ExtractFileName(edtFile.Text)+strText2),'操作提示',MB_ICONWARNING+MB_YESNO+MB_DEFBUTTON2) = IDYES then
DeleteFile(edtFile.Text)
else
begin
edtFile.SetFocus;
Exit;
end;
end;
dd := GetDC(Panel1.Handle); //取得Panel句柄
f := TFont.Create;
f.Name := Trim(cboFont.Text);
f.Size := StrToInt(Trim(cboSize.Text));
if chkBold.Checked = True then //是否选择粗体
f.Style := [fsBold]
else
f.Style := [];
SelectObject(dd,f.Handle);
for i := 1 to 126 do //循环取得所有中文
for j := 0 to 190 do
begin
Str := Char(i+ $D80)+Char((j)+$40); //取得当前的中文内码
if cboAlign.Text = '居中' then
begin
PositionX := Trunc((StrTofloat(Trim(cboPoint.Text))-PosPoint)/2); //画图X轴开始坐标
PositionY := Trunc((StrToFloat(Trim(cboPoint.Text))-PosPoint)/2); //画图Y轴开始坐标
end;
if cboAlign.Text = '左上' then
begin
PositionX := 0;
PositionY := 0;
end;
if cboAlign.Text = '左下' then
begin
PositionX := 0;
PositionY := Trunc(StrToFloat(Trim(cboPoint.Text))-PosPoint);
end;
if cboAlign.Text = '右上' then
begin
PositionX := Trunc(StrTofloat(Trim(cboPoint.Text))-PosPoint);
PositionY := 0;
end;
if cboAlign.Text = '右下' then
begin
PositionX := Trunc(StrTofloat(Trim(cboPoint.Text))-PosPoint);
PositionY := Trunc(StrToFloat(Trim(cboPoint.Text))-PosPoint);
end;
TextOut(dd,PositionX,PositionY,pchar(str),2); //画出字符
settype := Trunc((StrTofloat(Trim(cboPoint.Text))/8)*StrTofloat(Trim(cboPoint.Text)));
// 转换后字的字节数
wStr[0] := #$FA;
wStr[1] := Char(StrToInt(cboPoint.Text));
wStr[2] := wStr[1];
wStr[3] := #$FF;
wStr[4] := wStr[3];
wStr[5] := #$02;
wStr[6] := #$48;
wStr[7] := #$5A;
wStr[8] := #$47;
wStr[9] := #$42;
wStr[10] := #$4B;
wStr[11] := #$2D;
wStr[12] := #$31;
wStr[13] := #$36;
wStr[14] := #$00;
wStr[15] := #$00;
WriteToFile(Pchar(edtFile.Text),wStr,$10,0);
//给生成字库加头
count := 0;
for p := 0 to (StrToint(Trim(cboPoint.Text))-1) do
for k := 0 to (StrToint(Trim(cboPoint.Text))-1) do
begin
if GetPixel(dd,k,p) = 0 then //扫描点
Point[count] := 1
else
Point[count] := 0;
count := count + 1; //进入下一点扫描
end;
number := 0; //从扫描的第一点开始
for n := 0 to (settype-1) do //对扫描后的点转换成字节
begin
Byte1 := Point[number]*8 + Point[number+1]*4 + Point[number+2]*2 + Point[number+3];
Byte2 := Point[number+4]*8 + Point[number+5]*4 + Point[number+6]*2 + Point[number+7];
Buf16[n] := Byte1*16 + Byte2;
number := number + 8; //每8个点为一个字节
end;
for m := 0 to (settype-1) do wStr[m] := Char(Buf16[m]); //将字节转换成char型
address := ((i-1)*191 + j) * settype + $10; //算出当前汉字在汉字库中离起点的偏移位置
WriteToFile(Pchar(edtFile.Text),wStr,settype,address ); //生成一个字体库文件
Panel1.Refresh; //刷新Panel
Gauge1.Progress := Gauge1.Progress + 1; //显示进度条
end;
Application.MessageBox('生成字库完成','字库生成',MB_ICONINFORMATION+MB_OK); //完成提示
Close; //关闭本软件
end;Top
6 楼hexenzhou（甲骨文）回复于 2006-03-14 19:29:13 得分 0
skertone兄的方法不错，谢谢了，结贴！Top
