lazarus 显示（中文）点阵字符

今天将原delphi的代码改到Lazarus，移植后支持中文/字符/放大倍数及字体颜色，并支持linux使用。
注意：要带中文点阵字库：Hzk16.bin和ASC点阵字库：ASC16.bin

通过网盘分享的文件：点阵字体
链接: https://pan.baidu.com/s/105ai8OsG-7NOJ2dELxr14w?pwd=aj2h 提取码: aj2h

直接上代码:

Unit1.pas

unit Unit1;

{$MODE Delphi}

interface

uses
  LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ColorBox,LazUTF8,LConvEncoding;

type
  { TForm1 }
  TForm1 = class(TForm)
    ColorBox1: TColorBox;
    ComboBox1: TComboBox;
    Image1: TImage;
    Label2: TLabel;
    Label1: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
   private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure DispDotMatrix(Images:TImage;str:string;TextColor:TColor;bs,Width,Height,wordGap:Integer);
var
  strChar: String;
  i, n: integer;
  Image: TImage;
  f,fasc: file;
  x1:Integer;

  procedure MakeChar(Image:TImage;HZ: String;Chinese:Boolean;xs,wordGap:Integer);
  var
    h:AnsiString;
    OffSet: integer;
    GetStr: array [0..31] of byte;
    temp,dis:byte;
    x, y, i, j: integer;
    Q, W,dz,wd: word;
  begin
    if Chinese then
    begin
      dz:=31;
      wd:=15;
      h:=UTF8ToCP936(HZ);
      Q := Byte(H[1]) - $A0;
      W := Byte(H[2]) - $A0;
      OffSet := (94*(Q-1)+(W-1))*32;
      Seek(f, OffSet);
      BlockRead(f, GetStr, SizeOf(GetStr));
    end
    else
    begin
      dz:=15;
      wd:=7;
      W := Byte(Hz[1]);
      OffSet := W*16;
      Seek(fasc, OffSet);
      BlockRead(fasc, GetStr, SizeOf(GetStr));
    end;
    x:=0;
    y:=0;
    i:=0;
    j:=0;
    while(i<=dz) do
    begin
      temp:=getstr[i];
      for j:=0 to 7 do
      begin
        dis:=temp and 128;
        dis:=dis shr 7;
        if dis=1 then
        begin
          Image.Canvas.Rectangle(x1+(x+1)*xs-1,(y+1)*xs-1,x1+(x+1)*xs-1+xs,(y+1)*xs-1+xs);
        end;
        inc(x);
        if x>wd then
        begin
          x:=0;
          inc(y);
        end;
        temp:=temp shl 1;
      end;
      inc(i);
    end;
    if wordGap<0 then wordGap:=5;
    x1:=x1+wd+wd*(xs-1)+wordGap;
  end;
begin
  x1:=0;
  bs:=bs*3;
  if bs<3 then bs:=3;
  Image:=TImage.Create(nil);
  Image.Width:=Width;
  Image.Height:=Height;
  Image.Canvas.Brush.Color := clBlack;
  Image.Canvas.FillRect(rect(0,0,Width,Height));
  Image.Canvas.Brush.Color :=TextColor;
  Image.Canvas.Pen.Color := clBlack;
  if Length(str) > 0 then begin
    AssignFile(f, 'Hzk16.bin');
    reset(f, 1);
    AssignFile(fasc, 'ASC16.bin');
    reset(fasc, 1);
    for i := 0 to utf8Length(str) - 1 do begin
       strChar := utf8Copy(str, i+1, 1);
      if ord(strChar[1])>127 then
        MakeChar(Image,strChar,true,bs,wordGap)
      else
        MakeChar(Image,strChar,false,bs,wordGap);
    end;
    Images.Picture.Assign(Image.Picture);
    CloseFile(f);
    CloseFile(fasc);
  end;
  FreeAndNil(image);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  DispDotMatrix(Image1,Edit1.Text,ColorBox1.Selected,ComboBox1.ItemIndex+1,Image1.Width,Image1.Height,5);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BitBtn1Click(Self);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  BitBtn1Click(Self);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  {$ifdef linux}
  BitBtn1.Height:=ComboBox1.Height;
  {$endif}
end;

end.

Unit1.lfm:

object Form1: TForm1
  Left = 276
  Height = 343
  Top = 229
  Width = 1386
  Caption = '字符(包含中文)点阵显示（16X16）'
  ClientHeight = 343
  ClientWidth = 1386
  Color = clBtnFace
  DesignTimePPI = 192
  Font.CharSet = GB2312_CHARSET
  Font.Color = clBlack
  Font.Height = -28
  Font.Name = '宋体'
  Font.Pitch = fpVariable
  Font.Quality = fqDraft
  Position = poDesktopCenter
  OnCreate = FormCreate
  OnResize = FormResize
  OnShow = FormShow
  object Label1: TLabel
    Left = 24
    Height = 28
    Top = 13
    Width = 140
    Caption = '输入字符：'
  end
  object Edit1: TEdit
    AnchorSideTop.Control = Label1
    AnchorSideTop.Side = asrBottom
    Left = 24
    Height = 36
    Top = 51
    Width = 1312
    Anchors = [akTop, akLeft, akRight]
    BorderSpacing.Top = 10
    TabOrder = 0
    Text = '点阵字符测试'
  end
  object BitBtn1: TBitBtn
    AnchorSideTop.Control = Edit1
    AnchorSideTop.Side = asrBottom
    AnchorSideBottom.Side = asrBottom
    Left = 24
    Height = 50
    Top = 96
    Width = 238
    BorderSpacing.Top = 9
    Caption = '显示点阵字符'
    Default = True
    Kind = bkOK
    ModalResult = 1
    TabOrder = 1
    OnClick = BitBtn1Click
  end
  object ComboBox1: TComboBox
    AnchorSideTop.Control = BitBtn1
    Left = 424
    Height = 36
    Top = 96
    Width = 96
    ItemHeight = 28
    ItemIndex = 1
    Items.Strings = (
      '1'
      '2'
      '3'
      '4'
      '5'
      '6'
      '7'
      '8'
      '9'
      '10'
    )
    Style = csDropDownList
    TabOrder = 2
    Text = '2'
    OnChange = BitBtn1Click
  end
  object Label2: TLabel
    AnchorSideTop.Control = ComboBox1
    AnchorSideTop.Side = asrCenter
    Left = 293
    Height = 28
    Top = 100
    Width = 126
    Caption = '放大倍数:'
  end
  object ColorBox1: TColorBox
    AnchorSideTop.Control = BitBtn1
    Left = 584
    Height = 26
    Top = 96
    Width = 177
    DefaultColorColor = clRed
    NoneColorColor = clRed
    Selected = clRed
    ItemHeight = 20
    TabOrder = 3
    OnChange = BitBtn1Click
  end
  object Image1: TImage
    AnchorSideTop.Control = ComboBox1
    AnchorSideTop.Side = asrBottom
    Left = 24
    Height = 172
    Top = 152
    Width = 1320
    Anchors = [akTop, akLeft, akRight, akBottom]
    BorderSpacing.Top = 20
  end
end