自动读取汉字的汉语拼音(100分)

阿群 · 2002-09-30

[?]各路高人!如何读取一个汉字的汉语拼音？

zhyanfeng · 2002-09-30

试一试这个： unit HzSpell; interface uses   Windows, Messages, SysUtils, Classes; type   THzSpell = class(TComponent)   protected     FHzText: String;     FSpell: String;     FSpellH: String;     procedure SetHzText(const Value: String);     function GetHzSpell: String;     function GetPyHead: String;   public     class function PyOfHz(Hz: String): String;     class function PyHeadOfHz(Hz: String): String;   published     property HzText: String read FHzText write SetHzText;     property HzSpell: String read GetHzSpell;     property PyHead: String read GetPyHead;   end; {$I HzSpDat2.inc} procedure Register; function GetHzPy(HzChar: PChar; Len: Integer): String; function GetHzPyFull(HzChar: String): String; function GetHzPyHead(HzChar: PChar; Len: Integer): String; function GetPyChars(HzChar: String): String; implementation procedure Register; begin   RegisterComponents('System', [THzSpell]); end; function GetHzPy(HzChar: PChar; Len: Integer): String; var   C: Char;   Index: Integer; begin   Result := '';   if (Len > 1) and (HzChar[0] >= #129) and (HzChar[1] >= #64) then   begin     //是否为 GBK 字符     case HzChar[0] of       #163:  // 全角 ASCII       begin         C := Chr(Ord(HzChar[1]) - 128);         if C in ['a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']'] then           Result := C         else           Result := '';       end;       #162: // 罗马数字       begin         if HzChar[1] > #160 then           Result := CharIndex[Ord(HzChar[1]) - 160]         else           Result := '';       end;       #166: // 希腊字母       begin         if HzChar[1] in [#$A1..#$B8] then           Result := CharIndex2[Ord(HzChar[1]) - $A0]         else if HzChar[1] in [#$C1..#$D8] then           Result := CharIndex2[Ord(HzChar[1]) - $C0]         else           Result := '';       end;       else       begin  // 获得拼音索引         Index := PyCodeIndex[Ord(HzChar[0]) - 128, Ord(HzChar[1]) - 63];         if Index = 0 then           Result := ''         else           Result := PyMusicCode[Index];       end;     end;   end   else if Len > 0 then   begin     //在 GBK 字符集外, 即半角字符     if HzChar[0] in ['a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']'] then       Result := HzChar[0]     else       Result := '';   end; end; function GetHzPyFull(HzChar: String): String; var   i, len: Integer;   Py: String;   function IsDouByte(C: Char): Boolean;   begin     Result := C >= #129;   end; begin   Result := '';   i := 1;   while i <= Length(HzChar) do   begin     if IsDouByte(HzChar) and (Length(HzChar) - i > 0) then       len := 2     else       len := 1;     Py := GetHzPy(@HzChar, len);     Inc(i, len);     if (Result <> '') and (Py <> '') then       Result := Result + ' ' + Py           // + ' '     else       Result := Result + Py;   end; end; function GetHzPyHead(HzChar: PChar; Len: Integer): String; begin   Result := Copy(GetHzPy(HzChar, Len), 1, 1); end; function GetPyChars(HzChar: String): String; var   i, len: Integer;   Py: String;   function IsDouByte(C: Char): Boolean;   begin     Result := C >= #129;   end; begin   Result := '';   i := 1;   while i <= Length(HzChar) do   begin     if IsDouByte(HzChar) and (Length(HzChar) - i > 0) then       len := 2     else       len := 1;     Py := GetHzPyHead(@HzChar, len);     Inc(i, len);     Result := Result + Py;   end; end; { THzSpell } function THzSpell.GetHzSpell: String; begin   if FSpell = '' then   begin     Result := GetHzPyFull(FHzText);     FSpell := Result;   end   else Result := FSpell; end; function THzSpell.GetPyHead: String; begin   if FSpellH = '' then   begin     Result := GetPyChars(FHzText);     FSpellH := Result;   end   else Result := FSpellH; end; class function THzSpell.PyHeadOfHz(Hz: String): String; begin   Result := GetPyChars(Hz); end; class function THzSpell.PyOfHz(Hz: String): String; begin   Result := GetHzPyFull(Hz); end; procedure THzSpell.SetHzText(const Value: String); begin   FHzText := Value;   FSpell := '';   FSpellH := ''; end; end.

唐佐平 · 2002-09-30

可以使用控件阿， 很方便的

xianjun · 2002-09-30

zhyanfeng:  把HzSpDat2.inc也贴上来看看

zhyanfeng · 2002-09-30

你的email是多少，这里贴不上，我email给你吧 我的是ltzyf@21cn.com

wslsoftware · 2002-09-30

To zhyanfeng 给我一份学习学习呗！（整个程序）谢谢！Mail To wslsoftware@163.com

荷塘新月 · 2002-09-30

给你一段程序，不是我写的。 unit hztopy;//汉字to拼音 interface uses Windows, Messages, SysUtils, Classes, Forms,   Controls, ComCtrls, CommCtrl, DsgnIntf, dialogs; function GetPYIndexChar(hzchar: string): string; //返回一个汉字的拼音首字符 function getpy(hzstring: string): string; //返回一个汉字串的拼单首字符串 function SearchByPYIndexStr(SourceStrs: TStrings; PYIndexStr: string): string; //从Tstrings 中找到所有拼音首字符串中有PYindexstr的字符串 implementation function getpy(hzstring: string): string; var   i: integer;   str: array[1..255] of string;   hz: string;   hzstr: string; begin   hzstr := hzstring;   i := 0;   while hzstr <> '' do   begin     if (ord(hzstr[1]) >= 33) and (ord(hzstr[1]) <= 126) then     begin       str := copy(hzstr, 0, 1);       hzstr := copy(hzstr, 2, length(hzstr) - 1);     end     else if ord(hzstr[1]) > 127 then     begin       hz := copy(hzstr, 0, 2);       hzstr := copy(hzstr, 3, length(hzstr) - 2);       str := getpyindexchar(hz);     end;     if result = '' then result := str     else result := result + str;     i := i + 1;   end; end; function GetPYIndexChar(hzchar: string): string; begin   case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of     $B0A1..$B0C4: result := 'A';     $B0C5..$B2C0: result := 'B';     $B2C1..$B4ED: result := 'C';     $B4EE..$B6E9: result := 'D';     $B6EA..$B7A1: result := 'E';     $B7A2..$B8C0: result := 'F';     $B8C1..$B9FD: result := 'G';     $B9FE..$BBF6: result := 'H';     $BBF7..$BFA5: result := 'J';     $BFA6..$C0AB: result := 'K';     $C0AC..$C2E7: result := 'L';     $C2E8..$C4C2: result := 'M';     $C4C3..$C5B5: result := 'N';     $C5B6..$C5BD: result := 'O';     $C5BE..$C6D9: result := 'P';     $C6DA..$C8BA: result := 'Q';     $C8BB..$C8F5: result := 'R';     $C8F6..$CBF9: result := 'S';     $CBFA..$CDD9: result := 'T';     $CDDA..$CEF3: result := 'W';     $CEF4..$D1B8: result := 'X';     $D1B9..$D4D0: result := 'Y';     $D4D1..$D7F9: result := 'Z';   else     result := char(0);   end; end; function SearchByPYIndexStr(SourceStrs: TStrings; PYIndexStr: string): string; label NotFound; var   i, j: integer;   hzchar: string; begin   for i := 0 to SourceStrs.Count - 1 do   begin     for j := 1 to Length(PYIndexStr) do     begin       hzchar := SourceStrs[2 * j - 1]         + SourceStrs[2 * j];       if (PYIndexStr[j] <> '?') and         (UpperCase(PYIndexStr[j]) <>         GetPYIndexChar(hzchar)) then goto NotFound;     end;     if result = '' then result := SourceStrs     else result := result + Char(13) + SourceStrs;     NotFound:   end; end; end.     来自：westboy2000, 时间：2001-10-25 19:10:00, ID：690342 上面有一行写错了，改正如下：     $CEF4..$D1B8: result := 'X';

鉴定 · 2002-09-30

我有一个现成的.在5.0下已试过,很好.   你看一下. unit MainFrm; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   StdCtrls; type   TMainForm = class(TForm)     ChineseEdt: TEdit;     PYEdt: TEdit;     btnConvert: TButton;     Label1: TLabel;     Label2: TLabel;     Label3: TLabel;     Label4: TLabel;     Label5: TLabel;     Label6: TLabel;     procedure btnConvertClick(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end; var   MainForm: TMainForm; implementation {$R *.DFM} // 获取指定汉字的拼音索引字母，如：“汉”的索引字母是“H” function GetPYIndexChar( hzchar:string):char; begin   case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of     $B0A1..$B0C4 : result := 'A';     $B0C5..$B2C0 : result := 'B';     $B2C1..$B4ED : result := 'C';     $B4EE..$B6E9 : result := 'D';     $B6EA..$B7A1 : result := 'E';     $B7A2..$B8C0 : result := 'F';     $B8C1..$B9FD : result := 'G';     $B9FE..$BBF6 : result := 'H';     $BBF7..$BFA5 : result := 'J';     $BFA6..$C0AB : result := 'K';     $C0AC..$C2E7 : result := 'L';     $C2E8..$C4C2 : result := 'M';     $C4C3..$C5B5 : result := 'N';     $C5B6..$C5BD : result := 'O';     $C5BE..$C6D9 : result := 'P';     $C6DA..$C8BA : result := 'Q';     $C8BB..$C8F5 : result := 'R';     $C8F6..$CBF9 : result := 'S';     $CBFA..$CDD9 : result := 'T';     $CDDA..$CEF3 : result := 'W';     $CEF4..$D188 : result := 'X';     $D1B9..$D4D0 : result := 'Y';     $D4D1..$D7F9 : result := 'Z';   else     result := char(32);   end; end; procedure TMainForm.btnConvertClick(Sender: TObject); var   I: Integer;   PY: string;   s: string; begin   s := '' ;   I := 1;   while I <= Length(ChineseEdt.Text) do   begin     PY := Copy(ChineseEdt.Text, I , 1);     if PY >= Chr(128) then     begin       Inc(I);       PY := PY + Copy(ChineseEdt.Text, I , 1);       s := s + GetPYIndexChar(PY);     end     else       s := s + PY;     Inc(I);   end;   PYEdt.Text := s; end; end.

aerobull · 2002-09-30

认的汉字2万多个，拼音500多个........... 读一下这贴: http://www.playicq.com/dispdoc.php?t=&id=1734

鉴定 · 2002-09-30

我给你一个现成的 unit MainFrm; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   StdCtrls; type   TMainForm = class(TForm)     ChineseEdt: TEdit;     PYEdt: TEdit;     btnConvert: TButton;     Label1: TLabel;     Label2: TLabel;     Label3: TLabel;     Label4: TLabel;     Label5: TLabel;     Label6: TLabel;     procedure btnConvertClick(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end; var   MainForm: TMainForm; implementation {$R *.DFM} // 获取指定汉字的拼音索引字母，如：“汉”的索引字母是“H” function GetPYIndexChar( hzchar:string):char; begin   case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of     $B0A1..$B0C4 : result := 'A';     $B0C5..$B2C0 : result := 'B';     $B2C1..$B4ED : result := 'C';     $B4EE..$B6E9 : result := 'D';     $B6EA..$B7A1 : result := 'E';     $B7A2..$B8C0 : result := 'F';     $B8C1..$B9FD : result := 'G';     $B9FE..$BBF6 : result := 'H';     $BBF7..$BFA5 : result := 'J';     $BFA6..$C0AB : result := 'K';     $C0AC..$C2E7 : result := 'L';     $C2E8..$C4C2 : result := 'M';     $C4C3..$C5B5 : result := 'N';     $C5B6..$C5BD : result := 'O';     $C5BE..$C6D9 : result := 'P';     $C6DA..$C8BA : result := 'Q';     $C8BB..$C8F5 : result := 'R';     $C8F6..$CBF9 : result := 'S';     $CBFA..$CDD9 : result := 'T';     $CDDA..$CEF3 : result := 'W';     $CEF4..$D188 : result := 'X';     $D1B9..$D4D0 : result := 'Y';     $D4D1..$D7F9 : result := 'Z';   else     result := char(32);   end; end; procedure TMainForm.btnConvertClick(Sender: TObject); var   I: Integer;   PY: string;   s: string; begin   s := '' ;   I := 1;   while I <= Length(ChineseEdt.Text) do   begin     PY := Copy(ChineseEdt.Text, I , 1);     if PY >= Chr(128) then     begin       Inc(I);       PY := PY + Copy(ChineseEdt.Text, I , 1);       s := s + GetPYIndexChar(PY);     end     else       s := s + PY;     Inc(I);   end;   PYEdt.Text := s; end; end.

自动读取汉字的汉语拼音(100分)

阿群

Unregistered / Unconfirmed

zhyanfeng

Unregistered / Unconfirmed

唐佐平

Unregistered / Unconfirmed

xianjun

Unregistered / Unconfirmed

zhyanfeng

Unregistered / Unconfirmed

wslsoftware

Unregistered / Unconfirmed

荷塘新月

Unregistered / Unconfirmed

鉴定

Unregistered / Unconfirmed

aerobull

Unregistered / Unconfirmed

鉴定

Unregistered / Unconfirmed

Similar threads