unit1.~pas

批量将汉字转换为拼音、五笔的编码

//#####################################################################
//#####################################################################
//#### 功能：得到汉字的五笔、拼音编码  （支持 7500个简体、繁体汉字）
//#### 原理：通过查询资源文件 wbtext.rec 得到编码
//#### 时间：2003-06-25
//#### 作者：阳忠华
//#### E-mail: [e-mail]
//#####################################################################
//#####################################################################
unit Unit1;


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DB, DBTables;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Edit3: TEdit;
    Label3: TLabel;
    Edit4: TEdit;
    Label4: TLabel;
    Edit5: TEdit;
    Label5: TLabel;
    Button2: TButton;
    Table1: TTable;
    DataSource1: TDataSource;
    Edit6: TEdit;
    Label6: TLabel;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure hz_py_wb(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure insbook3;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  dbname:string;
  zw:string;
  py:string;
  pyj:string;
  wb:string;
  wbj:string;
  

  
implementation

{$R *.DFM}

{$R wbtext.res} //资源文件，必须

function get_hz_pywb(hzstr: string; pytype: integer): string;
var
  I: Integer;
  allstr: string;
  hh: THandle;
  pp: pointer;
  ss: TStringList;
  
  function retturn_wbpy(tempstr: string; tqtype: integer): string;
  var
    outstr, str: string;
    i: integer;
  begin
  //################### 汉字查询电位
    i := 0;
    while i <= ss.Count - 1 do
    begin
      str := ss.Strings[i];
      if (tempstr = trim(str[1] + str[2])) or (tempstr = trim(str[3] + str[4])) then
      begin
        str := ss.Strings[i];
        Break;
      end;
      i := i + 1;
    end;
  //###################

    outstr := '';     //提取编码
    if tqtype = 1 then
    begin
      for i := pos('①', str) + 2 to pos('②', str) - 1 do
        if str[i] <> '' then if outstr = '' then outstr := str[i] else outstr := outstr + str[i];
    end;

    if tqtype = 2 then
    begin
      for i := pos('②', str) + 2 to pos('③', str) - 1 do
        if str[i] <> '' then if outstr = '' then outstr := str[i] else outstr := outstr + str[i];
    end;

    if tqtype = 3 then
    begin
      for i := pos('③', str) + 2 to pos('④', str) - 1 do
        if str[i] <> '' then if outstr = '' then outstr := str[i] else outstr := outstr + str[i];
    end;

    if tqtype = 4 then
    begin
      for i := pos('④', str) + 2 to length(str) do
        if str[i] <> '' then if outstr = '' then outstr := str[i] else outstr := outstr + str[i];
    end;
    Result := trim(outstr);
  end;

begin
  //加载资源文件,将内容赋值给 s
  ss := TStringList.Create;
  hh := FindResource(hInstance, 'mywb', 'TXT');
  hh := LoadResource(hInstance, hh);
  pp := LockResource(hh);
  ss.Text := pchar(pp);
  UnLockResource(hh);
  FreeResource(hh);

  allstr := '';
  i := 0;
  while i <= length(hzstr) do   //提取汉字字符
  begin
    if (Ord(hzstr[I]) > 127) then
    begin
      if allstr = '' then allstr := retturn_wbpy(hzstr[I] + hzstr[I + 1], pytype) else allstr := allstr + retturn_wbpy(hzstr[I] + hzstr[I + 1], pytype);
      i := i + 2;
    end
    else
    begin
      if allstr = '' then allstr := hzstr[I] else allstr := allstr + hzstr[I];
      i := i + 1;
    end;
  end;

  ss.Free;
  
  Result := trim(allstr);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
if trim(edit1.Text)='' then
  begin
  edit1.SetFocus ;
  edit2.Clear ;
  edit3.Clear ;
  edit4.Clear ;
  edit5.Clear ;
  exit;
  end
  else
  //  1: 拼音  2：五笔  3: 拼音简码  2：五笔简码
  edit2.text := get_hz_pywb(edit1.text, 1);
  edit3.text := get_hz_pywb(edit1.text, 3);
  edit4.text := get_hz_pywb(edit1.text, 2);
  edit5.text := get_hz_pywb(edit1.text, 4);
end;


procedure TForm1.hz_py_wb(Sender: TObject);
begin
if trim(edit1.Text)='' then
  begin
  edit1.SetFocus ;
  edit2.Clear ;
  edit3.Clear ;
  edit4.Clear ;
  edit5.Clear ;
  exit;
  end
  else
  //  1: 拼音  2：五笔  3: 拼音简码  2：五笔简码
  edit2.text := get_hz_pywb(edit1.text, 1);
  edit3.text := get_hz_pywb(edit1.text, 3);
  edit4.text := get_hz_pywb(edit1.text, 2);
  edit5.text := get_hz_pywb(edit1.text, 4);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
hz_py_wb(self);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
dbname:=extractfilepath(application.ExeName)+'取拼音五笔码数据库.mdb';
edit6.Text :=dbname;
//Table1.DatabaseName := dbname;
//Table1.TableName :='取拼音五笔码';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
table1.Open;
  table1.First ;
 while not table1.Eof  do

   begin
    Button4Click(self);
    edit1.Text:=table1.fieldbyname('取拼音码的内容').asstring;
    zw:=edit1.text;
    py:=edit2.text;
    pyj:=edit3.text;
    wb:=edit4.text;
    wbj:=edit5.text;
    //insbook;
    //insbook1;


    insbook3;
  table1.Next ;
  end;
  MessageDlg('汉字--拼音--五笔转换完毕！请打开“取拼音五笔码数据库.mdb”查看！',mtinformation,[mbYes],0);
end;


procedure TForm1.insbook3;
var q:tquery;
    //t:ttable;
begin
    q:=tquery.Create(nil);
    q.DatabaseName :=table1.DatabaseName ;
    //t.tablename:='已取得拼音码.db';
    q.SQL.Add('update 取拼音五笔码 set 拼音码=:py1,拼音简码=:pyj1,五笔码=:wb1,五笔简码=:wbj1 where 取拼音码的内容=:text');
    //q.SQL.Add('update 取拼音五笔码 set 拼音简码=:pyj1 where 取拼音码的内容=:text');
    //q.SQL.Add('update 取拼音五笔码 set 五笔码=:wb1 where 取拼音码的内容=:text');
    //q.SQL.Add('update 取拼音五笔码 set 五笔简码=:wbj1 where 取拼音码的内容=:text');

    {q.SQL.Add('insert into 已取得拼音码(取拼音码的内容,拼音码)'+
    ' values(:text,:py1)');}
    q.ParamByName('text').AsString :=edit1.Text ;
    q.ParamByName('py1').AsString :=edit2.Text ;
    q.ParamByName('pyj1').AsString :=edit3.Text ;
    q.ParamByName('wb1').AsString :=edit4.Text ;
    q.ParamByName('wbj1').AsString :=edit5.Text ;
    q.ExecSQL ;
    q.Close;
    q.Free ;
    Button4Click(self);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
edit1.Clear ;
edit2.Clear ;
edit3.Clear ;
edit4.Clear ;
edit5.Clear ;
end;

end.