编程实现文本文件到图像文件的转化

type
  ByteArray = Array [0 .. 0] of byte;
  PByte = ^ByteArray;

  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中写入一行汉字

procedure TMainForm.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 := Find Resource(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;

hhzk := 0;
hasc := 0;
phzk := nil;
pasc := nil;
SFile := " ";
DFile := " ";
HandleRes;
// 在FormDestroy事件中加入以下代码 ：
if hhzk <> 0 then
  FreeResource(hhzk);

if hasc <> 0 then
  FreeResource(hasc);

procedure TMainForm.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[i] = #9) or (buf[i] = #10) or (buf[i] = #13) then
        buf[i] := ' ';
    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 // 计算最长一行字符数
    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[i], 30, 30 + i * 20, bmp.Canvas);
    end;
    bmp.SaveToFile(DFile);
    // bmp文件存盘
    Image1.Picture.Bitmap.Assign(bmp); // 此句需在Form上放置Image1,查看结果
    bmp.Free;
    StrLst.Free;
  end;
end;

procedure TMainForm.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 and boolean(byte(str[i + 1]) and $80)) then
    begin
      // 计算汉字点阵偏移量
      off := ((byte(str[i]) - $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[i]) * 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;