www.pudn.com > 200611743011276_daimaz.com.rar > Main.pas
{*******************************************************************}
{ }
{ Chinese Lattices 16*16 Demo }
{ Version 1.0 }
{ }
{ Develop by 诸葛白痴、xwing、cqbaobao }
{ }
{ Support: hzg115@sina.com }
{ 如果您有更新这个版本，别忘了给我一份 }
{*******************************************************************}
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.