main.pas

delphi 字模软件 分析汉字

{*******************************************************************}
{                                                                   }
{       Chinese Lattices 16*16 Demo                                 }
{       Version 1.0                                                 }
{                                                                   }
{       Develop by 诸葛白痴、xwing、cqbaobao                        }
{                                                                   }
{       Support: [e-mail]                                    }
{       如果您有更新这个版本，别忘了给我一份                        }
{*******************************************************************}

unit Main;
{
字模简介：

字模现有分成汇编字模和C格式字模之分，在此仅有C格式字模，根据点阵大小可分成12*12、
16*16、24*24等，在此仅讨论16*16

16*16的点阵中，格子大小为16*16，共有16行和16列，每一行一列总共有16个点，
每个点表示一个bit，一行共有16个位，共2位字节，一个16*16点阵的汉字用32个字节表示，
传统的取字模从hzk16等字库中直接取得其中的字模，但此种方法较为生硬，如遇到简繁体
中文问题就得换个字库文件，现用最方便是的在一个背景上画出文字，然后扫描其阵格，并
记录转换成字节；
取模又可分成横向、纵向取模，并且有左高位，右高位及上或下高位等分别
横向取模是指从阵格的左至右，从上至下取点，将每一行生成相邻的两个字节

 _____X___X______

 0000010001000000 如果是右高位的话排列将是0010 0000(左字节) 0000 0010(右字节)，组合
                  字节就是$2002(字模的第一字节为20，第二字节为02)
                  如果是左高位的话排列将是0000 0100(左字节) 0100 0000(右字节)，组合
                  字节就是$0440


纵向取模是指从阵格的上至下，从左至右取点，将每一列生成两个对称的字节

  _
  _    0000010000000000 如果是下高位的排列将是0010 0000(上字节) 0000 0000(下字节)，
  _                     此处的字节不再向横向取模是相连的，字模的第一个字节为20，第17位字节为00
  _                     如果是上高位的排列将是0000 0100(上字节) 0000 0000(下字节),
  _                     此处的字节不再向横向取模是相连的，字模的第一个字节为04，第17位字节为00
  X
  _
  _
  _
  _
  _
  _
  _
  _
  _
  _

以上的横纵取模是从下面这个文字中取得的：
0x04,0x40,	_____X___X______
0x04,0x40,	_____X___X______
0x7F,0xFC,	_XXXXXXXXXXXXX__
0x04,0x40,	_____X___X______
0x04,0x40,	_____X___X______
0xFF,0xFE,	XXXXXXXXXXXXXXX_
0x01,0x00,	_______X________
0x1F,0xF0,	___XXXXXXXXX____
0x11,0x10,	___X___X___X____
0x1F,0xF0,	___XXXXXXXXX____
0x11,0x10,	___X___X___X____
0x11,0x10,	___X___X___X____
0x1F,0xF0,	___XXXXXXXXX____
0x08,0x20,	____X_____X_____
0x10,0x18,	___X_______XX___
0x60,0x08,	_XX_________X___
}

interface

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

type
  Tfrm_Main = class(TForm)
    Memo1: TMemo;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    PaintBox1: TPaintBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    ComboBox1: TComboBox;
    Label3: TLabel;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    procedure DrawHZ(const buf: array of Char; ca:TCanvas);
    procedure DrawHZZ(const buf: array of Char; ca:TCanvas);
    function ConvertByte(inByte: Byte): Byte;
    function ConvertByteEx(inByte: Byte): Byte;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_Main: Tfrm_Main;
  function GetChineseLattice(ChineseText: String; out LatticeData: array of char; Style: Integer): Boolean; stdcall;far;external 'Lattices.dll'
implementation

{$R *.dfm}

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

{此函数由cabaobao提供}
//高低位转换
function Tfrm_Main.ConvertByte(inByte: Byte): Byte;
var
  i: Integer;
  b: Byte;
begin
  Result := 0;
  for i := 0 to 3 do
  begin
    b := (inByte shr i) and 1;
    Result := Result or (b shl (3 - i));
  end;
end;

function Tfrm_Main.ConvertByteEx(inByte: Byte): Byte;
var
  b1: Byte;
begin
  b1 := inByte and $F;
  b1 := ConvertByte(b1);
  Result := b1;
  b1 := inByte shr 4;
  b1 := ConvertByte(b1);
  Result := b1 shl 4 or Result;
end;

{此函数由xwings提供}
//横向取模显示汉字
procedure Tfrm_Main.DrawHZ(const buf: array of Char; ca:TCanvas);
const
    Size = 5;
    mask =$8000;
var
    i,j:Integer;
    b:Word;
    b1,b2,b_conver,b_conver1: Byte;
    arect:TRect;
begin
    arect := rect(0,0,Size - 1,Size - 1);
    for i := 0 to 15 do
    begin
        //一个word是一行象素
        {转换高低位}
        b1 := Byte(buf[i * 2]);
        b_conver := b1 and $0F;
        b_conver1 := b1 shr 4;
        b1 := b_conver1 or (b_conver shl 4);
        b1 := ConvertByteEx(b1);
        b2 := Byte(buf[i * 2 + 1]);
        b_conver := b2 and $0F;
        b_conver1 := b2 shr 4;
        b2 := b_conver1 or (b_conver shl 4);
        b2 := ConvertByteEx(b2);
        b:= b2 or (b1 shl 8);
        for j := 0 to 15 do
        begin
            if (b and mask) = mask then
            begin
                ca.Pen.Color := clBlack;
                ca.Brush.Color := clBlack;
            end
            else begin
                ca.Pen.Color := clWhite;
                ca.Brush.Color := clWhite;
            end;
            ca.Rectangle(arect);
            OffsetRect(arect,Size,0);
            b := b shl 1;
        end;
        OffsetRect(arect,- Size * 16 ,Size);
    end;
end;

//纵向取模显示汉字
procedure Tfrm_Main.DrawHZZ(const buf: array of Char; ca: TCanvas);
const
    Size = 5;
    mask =$8000;
var
    i,j:Integer;
    b:Word;
    arect:TRect;
    b1,b2,b_conver,b_conver1: Byte;
begin
    arect := rect(0,0,Size - 1,Size - 1);
    for i := 0 to 15 do
    begin
        //一个word是一列象素
        {转换高低位}
        b1 := Byte(buf[i]);
        b_conver := b1 and $0F;
        b_conver1 := b1 shr 4;
        b1 := b_conver1 or (b_conver shl 4);
        b1 := ConvertByteEx(b1);
        b2 := Byte(buf[16 + i]);
        b_conver := b2 and $0F;
        b_conver1 := b2 shr 4;
        b2 := b_conver1 or (b_conver shl 4);
        b2 := ConvertByteEx(b2);
        b:= b2 or (b1 shl 8);
        for j := 0 to 15 do
        begin
            if (b and mask) = mask then
            begin
                ca.Pen.Color := clBlack;
                ca.Brush.Color := clBlack;
            end
            else begin
                ca.Pen.Color := clWhite;
                ca.Brush.Color := clWhite;
            end;
            ca.Rectangle(arect);
            OffsetRect(arect,0,Size);
            b := b shl 1;
        end;
        OffsetRect(arect,Size,- Size * 16);
    end;
end;

procedure Tfrm_Main.BitBtn1Click(Sender: TObject);
var
	LatticeData: array[1..32] of char;
    i: Integer;
begin
	Memo1.Lines.Clear;
	GetChineseLattice(Edit1.Text,LatticeData,ComboBox1.ItemIndex);
    for i := 1 to 16 do
    	Memo1.Lines.Text := Memo1.Lines.Text + Format('0x%.2x',[ord(LatticeData[i])]) + ',';
	Memo1.Lines.Text := Memo1.Lines.Text + #13#10;
    for i := 17 to 32 do
    	Memo1.Lines.Text := Memo1.Lines.Text + Format('0x%.2x',[ord(LatticeData[i])]) + ',';
    if ComboBox1.ItemIndex = 0 then
	    DrawHZ(LatticeData,PaintBox1.Canvas)
    else
    	DrawHZZ(LatticeData,PaintBox1.Canvas);
end;

procedure Tfrm_Main.PaintBox1Paint(Sender: TObject);
begin
	PaintBox1.Canvas.Brush.Color := clLime;
    PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);
end;

end.