⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 基于HZK-16的汉字字模提取程序
💻 PAS
字号:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label2: TLabel;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  f: File;

implementation

{$R *.dfm}
procedure GetQWCode(HZ: string; var Q, W: Word);
begin
  Q := Byte(HZ[1]) - $A0;
  W := Byte(HZ[2]) - $A0;
end;

procedure MakeChar(HZ: String; n: integer);
var
  OffSet: integer;
  GetStr: array [0..31] of byte;
  temp,dis:byte;
  x, y, i, j: integer;
  Q, W: word;
begin
  GetQWCode(HZ,Q, W);
  OffSet := (94*(Q-1)+(W-1))*32;
    Seek(f, OffSet);
    BlockRead(f, GetStr, SizeOf(GetStr));
//GetStr
  x:=0;
  y:=0;
  i:=0;
  j:=0;
  while(i<=31) do
  begin
    temp:=getstr[i];
    for j:=0 to 7 do begin
      dis:=temp and 128;
      dis:=dis shr 7;
      if dis=1 then
         form1.Image1.Canvas.Rectangle(n*32+(x+1)*2-1,(y+1)*2-1,n*32+(x+1)*2-1+3,(y+1)*2-1+3);
      inc(x);
      if x>15 then begin
        x:=0;
        inc(y);
      end;
      temp:=temp shl 1;
    end;
    inc(i);
  end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  strChinese, strChar: String;
  i, n: integer;
begin
  form1.Image1.Canvas.Brush.Color := clBlack;
  form1.Image1.Canvas.FillRect(rect(0,0,324,36));
  form1.Image1.Canvas.Brush.Color := clRed;
  form1.Image1.Canvas.Pen.Color := clBlack;
  strChinese := Edit1.Text;
  if Length(strChinese) > 0 then begin
    AssignFile(f, 'Hzk16.bin');
    reset(f, 1);
     n := Length(strChinese) div 2;
     for i := 0 to n - 1 do begin
        strChar := Copy(strChinese, i*2+1, 2);
        MakeChar(strChar, i);
     end;
    CloseFile(f);
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -