unit1.~pas

将汉字串自动生成助记码的delphi源代码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//获取一个汉字的拼音第一字母(一级汉字)
function getpychar(var word:ShortString):char;
var
  MacCode : Integer;
begin
  MacCode:=Ord(word[1]) shl 8 + Ord(word[2]); //汉字内码
  word:=IntToHex(MacCode,4);     //for test
  case MacCode of
    $B0A1..$B0C4                          :Result:= 'A';
    $B0C5..$B1FE,$B2A1..$B2C0             :Result:= 'B';
    $B2C1..$B2FE,$B3A1..$B3FE,$B4A1..$B4ED:Result:= 'C';
    $B4EE..$B4FE,$B5A1..$B5FE,$B6A1..$B6E9:Result:= 'D';
    $B6EA..$B6FE,$B7A1                    :Result:= 'E';
    $B7A2..$B7FE,$B8A1..$B8C0             :Result:= 'F';
    $B8C1..$B8FE,$B9A1..$B9FD             :Result:= 'G';
           $B9FE,$BAA1..$BAFE,$BBA1..$BBF6:Result:= 'H';
    $BBF7..$BBFE,$BCA1..$BCFE,$BDA1..$BDFE:Result:= 'J';
    $BEA1..$BEFE,$BFA1..$BFA5             :Result:= 'J';
    $BFA6..$BFFE,$C0A1..$C0AB             :Result:= 'K';
    $C0AC..$C0FE,$C1A1..$C1FE,$C2A1..$C2E7:Result:= 'L';
    $C2E8..$C2FE,$C3A1..$C3FE,$C4A1..$C4C2:Result:= 'M';
    $C4C3..$C4FE,$C5A1..$C5B5             :Result:= 'N';
    $C5B6..$C5BD                          :Result:= 'O';
    $C5BE..$C5FE,$C6A1..$C6D9             :Result:= 'P';
    $C6DA..$C6FE,$C7A1..$C7FE,$C8A1..$C8BA:Result:= 'Q';
    $C8BB..$C8F5                          :Result:= 'R';
    $C8F6..$C8FE,$C9A1..$C9FE,$CAA1..$CAFE:Result:= 'S';
    $CBA1..$CBF9                          :Result:= 'S';
    $CBFA..$CBFE,$CDA1..$CDD9             :Result:= 'T';
    $CDDA..$CDFE,$CEA1..$CEF3             :Result:= 'W';
    $CEF4..$CEFE,$CFA1..$CFFE,$D0A1..$D0FE,$D1A1..$D1B8:Result:= 'X';
    $D1B9..$D1FE,$D2A1..$D2FE,$D3A1..$D3FE,$D4A1..$D4D0:Result:= 'Y';
    $D4D1..$D4FE,$D5A1..$D5FE,$D6A1..$D6FE,$D7A1..$D7F9:Result:= 'Z';
  else
    Result:= '?';
  end;
end;

//汉字串->首字母串(一级汉字简拼助记码)
function GetJPCodeByChinese(chinese: string):string;
var
  c1:char;
  word:string[4];
begin
  Result:='';
  chinese:=UpperCase(chinese);
  while length(chinese)>1 do
  begin
    if Ord(chinese[1])>$7F then  //>$7F的不是字母了，但也不全是汉字
    begin
      word:=copy(chinese,1,2);
       Result:=Result+word;  //for test
      delete(chinese,1,2);
      c1:=getpychar(word);
    end
    else
    begin
      c1:=chinese[1];
      delete(chinese,1,1);
    end;
    //Result:=Result+c1;
    Result:=Result+'('+word+')'+c1+'  ';//for test
  end;
  if length(chinese)>0 then
    Result:=Result+chinese;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  edit2.Text:=GetJPCodeByChinese(edit1.Text);
end;

end.