我最后的版本
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
ByteArray = Array [0..0] of byte;
PByte = ^ByteArray;
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
hhzk : HGlOBAL; //汉字点阵资源句柄
hasc : HGLOBAL; //ASC字符点阵资源句柄
phzk : PByte; //汉字点阵资源指针
pasc : PByte; //ASC字符点阵资源指针
SFile, DFile : string; //转换的源文件和目的文件名
procedure HandleRes; //处理引入的资源
procedure Convert; //Txt2Bmp转换函数
procedure WriteLine(str: string; x,y: integer; Can: TCanvas);
//在图象的Canvas中写入一行汉字
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{$R hzk.res}
procedure TForm1.HandleRes;
var
hres : HRSRC;
begin
hres := FindResource(0,PChar(201),'HZK16'); //查找汉字点阵资源
if hres <> 0 then
begin
hhzk := LoadResource(0,hres);//载入汉字点阵资源
if hhzk <> 0 then
begin
phzk := LockResource(hhzk);//锁定，得到资源指针
end;
end;
hres := FindResource(0,PChar(202),'ASC16');//查找ASC字符资源
if hres <> 0 then
begin
hasc := LoadResource(0,hres);//载入ASC字符资源
if hasc <> 0 then
begin
pasc := LockResource(hasc);//锁定，得到资源指针
end;
end;
if (phzk = nil) or (pasc = nil) then
begin
MessageDlg('Can not load resource!'#10#13'Program stopped!',
mtWarning,[mbOk],0);
Application.Terminate;
end;
end;
procedure TForm1.WriteLine(str: string; x, y: integer; Can: TCanvas);
var
i,m,n,k : integer;//循环变量
leng : integer;//字符串长度
off : integer;//点阵偏移
begin
i := 1;
leng := Length(str);//计算字符串长度
while(i<=leng) do begin
//判断是否是汉字，汉字占两字节
if (i<leng) and boolean(byte(str) and $80)
and boolean(byte(str[i+1]) and $80) then begin
//计算汉字点阵偏移量
off := ((byte(str)-$a1) and $7f) * 94 + ((byte(str[i+1])-$a1) and $7f);
off := off * 32;
//在画布上描绘一个汉字
for m := 0 to 15 do begin
for n := 0 to 1 do begin
for k := 7 downto 0 do begin
if boolean(phzk[off+m*2+n] and (1 shl k)) then begin
Can.Pixels[x+n*8+7-k,y+m] := 1;
end;
end;
end;
end;
inc(x,16);
inc(i,2);
end else begin //不是汉字
off := byte(str)*16;//计算ASC字符点阵偏移
//在画布上描绘一个ASC字符
for m := 0 to 15 do begin
for k := 7 downto 0 do begin
if boolean(pasc[off+m] and (1 shl k)) then begin
Can.Pixels[x+7-k,y+m] := 1;
end;
end;
end;
inc(x,8);
inc(i);
end;
end;
end;
procedure TForm1.Convert;
var
tf : TextFile;
StrLst : TStringList;
buf : string;
w,h,i : integer;
bmp : TBitMap;
begin
StrLst := TStringList.Create; //用来存为文件内容
AssignFile(tf,SFile);
Reset(tf); //打开源文件
while not Eof(tf) do
begin
ReadLn(tf,buf); //循环读入文件内容
for i := 1 to Length(buf) do
begin //把TAB键、回车、换行转为空格
if (buf = #9) or (buf = #10) or (buf = #13) then
buf := ' ';
end;
StrLst.Add(buf);
end;
CloseFile(tf);
//以下代码计算bmp文件尺寸，由于是16点阵字库，
//每个字符高度为16，宽度为8，每行间距取为4
h := StrLst.Count*20; //bmp文件高度
w := 0;
for i := 0 to StrLst.Count-1 do
begin//计算最长一行字符数
if w<Length(StrLst) then w := Length(StrLst);
end;
w := w*8;//bmp文件宽度
bmp := TBitMap.Create;//创建bmp对象
bmp.Monochrome := true;//选择创建黑白图象，缩小尺寸
//设定尺寸，预留页边距
bmp.Height := h + 60;
bmp.Width := w + 60;
for i := 0 to StrLst.Count-1 do
begin//调用WriteLine写入一行
WriteLine(StrLst,30,30+i*20,bmp.Canvas);
end;
bmp.SaveToFile(DFile);//bmp文件存盘
Image1.Picture.Bitmap.Assign(bmp);//此句需在Form上放置Image1,查看结果
bmp.Free;
StrLst.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
hhzk := 0;
hasc := 0;
phzk := nil;
pasc := nil;
SFile := '';
DFile := '';
HandleRes;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if hhzk <> 0 then FreeResource(hhzk);
if hasc <> 0 then FreeResource(hasc);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SFile:='G:/liujx/txt2bmp/新建文件夹/111.txt';
DFile:='G:/liujx/txt2bmp/新建文件夹/222.bmp';
Convert;
end;
end.
