delphi 中如何将汉字转化成字模，急用，UP有分！

转:{*******************************************************************}
{                                                                   }
{       Chinese Lattices 16*16 Demo                                 }
{       Version 1.0                                                 }
{                                                                   }
{       Develop by 诸葛白痴、xwing、cqbaobao                        }
{                                                                   }
{       Support: [email protected]                                    }
{       如果您有更新这个版本，别忘了给我一份                        }
{*******************************************************************}unit Main;
{
字模简介：字模现有分成汇编字模和C格式字模之分，在此仅有C格式字模，根据点阵大小可分成12*12、
16*16、24*24等，在此仅讨论16*1616*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___
}interfaceuses
  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.
提取字模的dll;uses
  SysUtils,
  Classes,
  Graphics;
{$R *.res}function GetChineseLattice(ChineseText: String; out LatticeData: array of char; Style: Integer): Boolean; stdcall;
{
Style: 0表示横向取模，从左至右，从上至下，字模排列顺序为高位在右，低位在左
       1表示纵向取模，从上至下，从左至右，字模排列顺序为高位在下，低位在上
}
const
    ary_i: array[0..15] of Integer = ($01,$02,$04,$08,$10,$20,$40,$80,
                                      $100,$200,$400,$800,$1000,$2000,$4000,$8000); //存储点阵相关
var
bmp_Text: TBitmap;
    c_temp: char;
    w_temp: Word;
    i,j: Integer;
    cb:Byte;
begin
bmp_Text := TBitmap.Create; //创建背景扫描图    with bmp_Text do
    begin
        PixelFormat := pf8bit;
        Width := 16;
        Height := 16;
        Canvas.Font.Name := '宋体';
        Canvas.Font.Size := 12;
        Canvas.Font.Color := clBlack;
        Canvas.TextRect(Rect(0,0,16,16),0,0,ChineseText);
for i := 0 to 15 do //开始扫描
        begin
         w_temp := 0;
            c_temp := char(0);
         for j := 0 to 15 do
            begin
                if Style = 0 then //横向取模
                    cb := pbyte(Integer(ScanLine[i]) + j)^
                else if Style = 1 then //纵向取模
                    cb := pbyte(Integer(ScanLine[j]) + i)^;
                if cb = $00 then   //$ff 取反
                    w_temp := ord(w_temp) or ary_i[j];
            end;
            if Style = 0 then
            begin
                c_temp := char(w_temp and $FF);
                LatticeData[i * 2] := c_temp;
                c_temp := char(w_temp shr 8);
                LatticeData[i * 2 + 1] := c_temp;
            end
            else if Style = 1 then
            begin
             c_temp := char(w_temp and $FF);
            LatticeData[i] := c_temp;
                c_temp := char(w_temp shr 8);
                LatticeData[16 + i] := c_temp;
            end;
        end;
        Free;
    end;
    Result := true;
end;exports
GetChineseLattice;begin
end.

调试易

delphi 中如何将汉字转化成字模，急用，UP有分！

解决方案 »

delphi 中如何将汉字转化成字模 ，急用，UP有分！

解决方案 »

delphi 中如何将汉字转化成字模，急用，UP有分！