汉字转拼音/五笔编码的例子 亲测通过

bugxiong

以下代码均在winxp+lazarus 1.0.14下测试通过
感谢欧文
测试程序如下：


wb单元：

1. //*************************************
   
2. //汉字转五笔编码单元
   
3. //作者：孙晓刚
   
4. // 2013-12-24
   
5. //=====================================
   
6. 
   
7. unit uWuBi;
   
8. 
   
9. {$mode objfpc}{$H+}
   
10. 
    
11. interface
    
12. 
    
13. uses
    
14.   Classes, SysUtils ,windows;
    
15. 
    
16. //参数AType =0 86版本 ==1 98版  AStr 要转换的字符串 (GBK编码) ,返回ASCII 五笔编码
    
17. function GetWuBi(AType:integer;AStr:string):string;
    
18. 
    
19. implementation
    
20. 
    
21. 
    
22. {$R WBSearch.res}
    
23. 
    
24. Function SwapByte(AiChinese : String) : Integer;
    
25. Var
    
26.   ch, cl : Integer;
    
27. Begin
    
28.   ch := Ord(AiChinese[1]);
    
29.   cl := Ord(AiChinese[2]);
    
30.   Result := (ch shl 8) + cl;
    
31. end;
    
32. 
    
33. function IsChinese(Code: Integer): Boolean;
    
34. Const
    
35.   SPOS=$8140;
    
36.   EPOS=$FEA0;
    
37. begin
    
38.    Result := ((Code>=SPOS) And (Code<=EPOS))
    
39. end;
    
40. 
    
41. //0--1
    
42. function InnerFind(FWBType:integer;Code: Integer): String;
    
43. Const
    
44.   BaseCode=$8140;
    
45.   RESNAME:Array[0..1] of String=('WB86','WB98');
    
46. var
    
47.   RS:TResourceStream;
    
48.   nPos:DWord;
    
49.   Keys:array[0..4] of Char;
    
50. begin
    
51. 
    
52.   RS := TResourceStream.Create(Hinstance,RESNAME[FWBType],RT_RCDATA);
    
53.   IF RS.Size>0 then
    
54.   begin
    
55.     nPos := (Code-BaseCode)*5;
    
56. 
    
57.     RS.Seek(nPos,soBeginning);
    
58.     RS.Read(Keys,5);
    
59.     IF Keys[4]='' then
    
60.     Result := Format('%s%s%s%s',[Keys[0],Keys[1],Keys[2],Keys[3]])
    
61.     else Result := Format('%s%s%s%s  %s',[Keys[0],Keys[1],Keys[2],Keys[3],Keys[4]]);
    
62.     RS.Free;
    
63.   end;
    
64. end;
    
65. 
    
66. function GetWuBi(AType:integer;AStr:string):string;
    
67. var
    
68.   aChar:WideChar;
    
69.   wStr:WideString;
    
70.   Code,nLen:Integer;
    
71. begin
    
72.   If Length(AStr)>0 then
    
73.   begin
    
74.     wStr := AStr;
    
75.     nLen := Length(wStr);
    
76.     aChar := wStr[nLen];
    
77.     Code := SwapByte(aChar);
    
78.     If IsChinese(Code) then
    
79.     result := UpperCase(InnerFind(AType,Code))
    
80.     else result  := '';
    
81.   end
    
82.   else result := '';
    
83. end;
    
84. 
    
85. end.
    

复制代码

py单元 方式1：

1. //=============================================================================
   
2. //汉语拼音单元
   
3. //应用场景: 助记符，人名拼音等
   
4. //开发环境: delphi 7
   
5. //          windows xp sp3
   
6. //字符编码: GBK / CP936
   
7. //功能:     将给出的中、英文字符串，查表得到其汉语拼音 以及 英文的 混合字符串
   
8. //          中文可以得到其汉语拼音首字母串，或者全拼音字符串
   
9. //限制:     没有实现音调，只限于 GBK 编码，没有支持 unicode, hz码等,
   
10. //          修改代码，使其可以在任意版本delphi执行
    
11. //          没有实现多音字自动使用正确的(如果要那样，就需要很大的词语库)
    
12. //原始版本：某人写的 V4.1
    
13. //修改：去类化，修改命名
    
14. //编写：孙晓刚
    
15. //日期: 2013-11-20
    
16. //=============================================================================
    
17. 
    
18. unit HanyuPinyin;
    
19. 
    
20. {$IFDEF FPC}
    
21.   {$MODE Delphi}
    
22. {$ENDIF}
    
23. 
    
24. interface
    
25. 
    
26. uses
    
27. {$IFNDEF FPC}
    
28.   Windows,
    
29. {$ELSE}
    
30. {$ENDIF}
    
31.   Messages, SysUtils, Classes;
    
32. 
    
33. //函数1:GetHanyuPinyinByChar
    
34. //功能：获得一个非中文字符或者1个中文字符的汉语拼音全拼串
    
35. //参数:AValue  -- 1字节 英文/其他单字节字符
    
36. //             -- 2字节 中文，GBK/Cp936编码
    
37. //返回：1个字符(1字节/2字节）的全拼字符串
    
38. function GetHanyuPinyinByChar(AValue: pAnsiChar; Len: Integer): AnsiString;
    
39. 
    
40. //函数2:getHanyuPinyinFull
    
41. //功能：获得一个中英文混合字符串的各个字符的拼音码+英文混合字符串，是全拼音
    
42. //参数：avalue -- 中英文混合字符串
    
43. //返回：1个字符串的全拼字符串
    
44. function getHanyuPinyinFull(AValue: AnsiString): AnsiString;
    
45. 
    
46. //函数2:getHanyuPinyinShort
    
47. //功能：获得一个中英文混合字符串的各个字符的拼音码+英文混合字符串，是全拼音
    
48. //参数：avalue -- 中英文混合字符串
    
49. //返回：1个字符串的拼音首字母串(英文取本身，希腊字母，罗马数字都转换成响应的英文表示)
    
50. function GetHanyuPinyinShort(AValue: AnsiString): AnsiString;
    
51. 
    
52. //这个实际上只用在内部,得到首个字节的字符
    
53. //function GetFirstLetter(AValue: pAnsiChar; Len: Integer): AnsiString;
    
54. 
    
55. implementation
    
56. 
    
57. {$I HanyuPinyin.set}
    
58. {$I HanyuPinyin.inc}
    
59. 
    
60. 
    
61. function GetHanyuPinyinByChar(AValue: pAnsiChar; Len: Integer): AnsiString;
    
62. var
    
63.   C: AnsiChar;
    
64.   Index: Integer;
    
65. begin
    
66.   Result := '';
    
67.   if (Len > 1) and (AValue[0] >= #129) and (AValue[1] >= #64) then
    
68.   begin
    
69.     //是否为 GBK 字符
    
70.     case AValue[0] of
    
71.       #163:  // 全角 ASCII
    
72.       begin
    
73.         C := AnsiChar(Ord(AValue[1]) - 128);
    
74.         if C in ['a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']'] then
    
75.           Result := C
    
76.         else
    
77.           Result := '';
    
78.       end;
    
79.       #162: // 罗马数字
    
80.       begin
    
81.         if AValue[1] > #160 then
    
82.           Result := CharIndex[Ord(AValue[1]) - 160]
    
83.         else
    
84.           Result := '';
    
85.       end;
    
86.       #166: // 希腊字母
    
87.       begin
    
88.         if AValue[1] in [#$A1..#$B8] then
    
89.           Result := CharIndex2[Ord(AValue[1]) - $A0]
    
90.         else if AValue[1] in [#$C1..#$D8] then
    
91.           Result := CharIndex2[Ord(AValue[1]) - $C0]
    
92.         else
    
93.           Result := '';
    
94.       end;
    
95.       else
    
96.       begin  // 获得拼音索引
    
97.         Index := hanyu_pinyin_gbk_index[Ord(AValue[0]) - 128, Ord(AValue[1]) - 63];
    
98.         if Index = 0 then
    
99.           Result := ''
    
100.         else
     
101.           Result := hanyu_pinyin_index[Index];
     
102.       end;
     
103.     end;
     
104.   end
     
105.   else if Len > 0 then
     
106.   begin
     
107.     //在 GBK 字符集外, 即半角字符
     
108.     if AValue[0] in ['a'..'z', 'A'..'Z', '0'..'9'{$ifdef NEEDSymbols}, '(', ')', '[', ']',
     
109.       '.', '!', '@', '#', 'py单元2：
     
110. [code]unit py;
     
111. 
     
112. {$mode objfpc}{$H+}
     
113. 
     
114. interface
     
115. 
     
116. uses
     
117.   Classes, SysUtils;
     
118. 
     
119. function GetHzPy(HzChar: PAnsiChar; Len: Integer): string;
     
120. function GetHzPyFull(HzChar: string): string;
     
121. function GetPyChars(HzChar: string): string;
     
122. function GetHzPyHead(HzChar: PAnsiChar; Len: Integer): String;
     
123. function CheckIsGB2312(AChar: WideChar): Boolean;
     
124. function StrIsCanShow(const WS: WideString): Boolean;
     
125. 
     
126. function HZ2PY(const HZ: string; ISPYHead: Boolean = True): string;
     
127. 
     
128. implementation
     
129. 
     
130. {$i HzSpDat2.inc}
     
131. 
     
132. function GetHzPy(HzChar: PAnsiChar; Len: Integer): string;
     
133. var
     
134.   C: Char;
     
135.   Index: Integer;
     
136. begin
     
137.   Result := '';
     
138.   if (Len > 1) and (HzChar[0] >= #129) and (HzChar[1] >= #64) then
     
139.   begin
     
140.     //是否为 GBK 字符
     
141.     case HzChar[0] of
     
142.       #163:  // 全角 ASCII
     
143.       begin
     
144.         C := Chr(Ord(HzChar[1]) - 128);
     
145.         if C in ['a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']'] then
     
146.           Result := C
     
147.         else
     
148.           Result := '';
     
149.       end;
     
150.       #162: // 罗马数字
     
151.       begin
     
152.         if HzChar[1] > #160 then
     
153.           Result := CharIndex[Ord(HzChar[1]) - 160]
     
154.         else
     
155.           Result := '';
     
156.       end;
     
157.       #166: // 希腊字母
     
158.       begin
     
159.         if HzChar[1] in [#$A1..#$B8] then
     
160.           Result := CharIndex2[Ord(HzChar[1]) - $A0]
     
161.         else if HzChar[1] in [#$C1..#$D8] then
     
162.           Result := CharIndex2[Ord(HzChar[1]) - $C0]
     
163.         else
     
164.           Result := '';
     
165.       end;
     
166.       else
     
167.       begin  // 获得拼音索引
     
168.         Index := PyCodeIndex[Ord(HzChar[0]) - 128, Ord(HzChar[1]) - 63];
     
169.         if Index = 0 then
     
170.           Result := ''
     
171.         else
     
172.           Result := PyMusicCode[Index];
     
173.       end;
     
174.     end;
     
175.   end
     
176.   else if Len > 0 then
     
177.   begin
     
178.     //在 GBK 字符集外, 即半角字符
     
179.     if HzChar[0] in ['a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']',
     
180.       '.', '!', '@', '#', '
     
181. 以上方式均在winxp+lazarus 1.0.14下测试通过
     
182. 感谢欧文
     
183. 测试程序如下：
     
184. 
     
185. , '%', '^', '&', '*', '-', '+',
     
186.       '<', '>', '?', ':', '"'{$endif}] then
     
187.       Result := AValue[0]
     
188.     else
     
189.       Result := '';
     
190.   end;
     
191. end;
     
192. 
     
193. function getHanyuPinyinFull(AValue: AnsiString): AnsiString;
     
194. var
     
195.   i, len: Integer;
     
196.   Py: AnsiString;
     
197.   function IsLeadCharOfGBK(C: AnsiChar): Boolean;
     
198.   begin
     
199.     Result := C >= #129;
     
200.   end;
     
201. begin
     
202.   Result := '';
     
203.   i := 1;
     
204.   while i <= Length(AValue) do
     
205.   begin
     
206.     if IsLeadCharOfGBK(AValue[i]) and (Length(AValue) - i > 0) then
     
207.       len := 2
     
208.     else
     
209.       len := 1;
     
210.     Py := GetHanyuPinyinByChar(@AValue[i], len);
     
211.     Inc(i, len);
     
212.     if (Result <> '') and (Py <> '') then
     
213.       Result := Result + ' ' + Py
     
214.     else
     
215.       Result := Result + Py;
     
216.   end;
     
217. end;
     
218. 
     
219. function GetFirstLetter(AValue: pAnsiChar; Len: Integer): AnsiString;
     
220. begin
     
221.   Result := Copy(GetHanyuPinyinByChar(AValue, Len), 1, 1);
     
222. end;
     
223. 
     
224. function GetHanyuPinyinShort(AValue: AnsiString): AnsiString;
     
225. var
     
226.   i, len: Integer;
     
227.   Py: AnsiString;
     
228.   function IsLeadCharOfGBK(C: AnsiChar): Boolean;
     
229.   begin
     
230.     Result := C >= #129;
     
231.   end;
     
232. begin
     
233.   Result := '';
     
234.   i := 1;
     
235.   while i <= Length(AValue) do
     
236.   begin
     
237.     if IsLeadCharOfGBK(AValue[i]) and (Length(AValue) - i > 0) then
     
238.       len := 2
     
239.     else
     
240.       len := 1;
     
241.     Py := GetFirstLetter(@AValue[i], len);
     
242.     Inc(i, len);
     
243.     Result := Result + Py;
     
244.   end;
     
245. end;
     
246. 
     
247. end.
     

复制代码

py单元 方式2：

1. unit py;
   
2. 
   
3. {$mode objfpc}{$H+}
   
4. 
   
5. interface
   
6. 
   
7. uses
   
8.   Classes, SysUtils;
   
9. 
   
10. function GetHzPy(HzChar: PAnsiChar; Len: Integer): string;
    
11. function GetHzPyFull(HzChar: string): string;
    
12. function GetPyChars(HzChar: string): string;
    
13. function GetHzPyHead(HzChar: PAnsiChar; Len: Integer): String;
    
14. function CheckIsGB2312(AChar: WideChar): Boolean;
    
15. function StrIsCanShow(const WS: WideString): Boolean;
    
16. 
    
17. function HZ2PY(const HZ: string; ISPYHead: Boolean = True): string;
    
18. 
    
19. implementation
    
20. 
    
21. {$i HzSpDat2.inc}
    
22. 
    
23. function GetHzPy(HzChar: PAnsiChar; Len: Integer): string;
    
24. var
    
25.   C: Char;
    
26.   Index: Integer;
    
27. begin
    
28.   Result := '';
    
29.   if (Len &gt; 1) and (HzChar[0] &gt;= #129) and (HzChar[1] &gt;= #64) then
    
30.   begin
    
31.     //是否为 GBK 字符
    
32.     case HzChar[0] of
    
33.       #163:  // 全角 ASCII
    
34.       begin
    
35.         C := Chr(Ord(HzChar[1]) - 128);
    
36.         if C in ['a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']'] then
    
37.           Result := C
    
38.         else
    
39.           Result := '';
    
40.       end;
    
41.       #162: // 罗马数字
    
42.       begin
    
43.         if HzChar[1] &gt; #160 then
    
44.           Result := CharIndex[Ord(HzChar[1]) - 160]
    
45.         else
    
46.           Result := '';
    
47.       end;
    
48.       #166: // 希腊字母
    
49.       begin
    
50.         if HzChar[1] in [#$A1..#$B8] then
    
51.           Result := CharIndex2[Ord(HzChar[1]) - $A0]
    
52.         else if HzChar[1] in [#$C1..#$D8] then
    
53.           Result := CharIndex2[Ord(HzChar[1]) - $C0]
    
54.         else
    
55.           Result := '';
    
56.       end;
    
57.       else
    
58.       begin  // 获得拼音索引
    
59.         Index := PyCodeIndex[Ord(HzChar[0]) - 128, Ord(HzChar[1]) - 63];
    
60.         if Index = 0 then
    
61.           Result := ''
    
62.         else
    
63.           Result := PyMusicCode[Index];
    
64.       end;
    
65.     end;
    
66.   end
    
67.   else if Len &gt; 0 then
    
68.   begin
    
69.     //在 GBK 字符集外, 即半角字符
    
70.     if HzChar[0] in ['a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']',
    
71.       '.', '!', '@', '#', '
    
72. 以上方式均在winxp+lazarus 1.0.14下测试通过
    
73. 感谢欧文
    
74. 测试程序如下：
    
75. 
    
76. , '%', '^', '&', '*', '-', '+',
    
77.       '<', '>', '?', ':', '"'] then
    
78.       Result := HzChar[0]
    
79.     else
    
80.       Result := '';
    
81.   end;
    
82. end;
    
83. 
    
84. function GetHzPyFull(HzChar: string): string;
    
85. var
    
86.   i, len: Integer;
    
87.   Py: String;
    
88.   function IsDouByte(C: Char): Boolean;
    
89.   begin
    
90.     Result := C >= #129;
    
91.   end;
    
92. begin
    
93.   Result := '';
    
94.   i := 1;
    
95.   while i <= Length(HzChar) do
    
96.   begin
    
97.     if IsDouByte(HzChar[i]) and (Length(HzChar) - i > 0) then
    
98.       len := 2
    
99.     else
    
100.       len := 1;
     
101.     Py := GetHzPy(@HzChar[i], len);
     
102.     Inc(i, len);
     
103.     if (Result <> '') and (Py <> '') then
     
104.       Result := Result + ' ' + Py
     
105.     else
     
106.       Result := Result + Py;
     
107.   end;
     
108. end;
     
109. 
     
110. function GetPyChars(HzChar: string): string;
     
111. var
     
112.   i, len: Integer;
     
113.   Py: String;
     
114.   function IsDouByte(C: Char): Boolean;
     
115.   begin
     
116.     Result := C >= #129;
     
117.   end;
     
118. begin
     
119.   Result := '';
     
120.   i := 1;
     
121.   while i <= Length(HzChar) do
     
122.   begin
     
123.     if IsDouByte(HzChar[i]) and (Length(HzChar) - i > 0) then
     
124.       len := 2
     
125.     else
     
126.       len := 1;
     
127.     Py := GetHzPyHead(@HzChar[i], len);
     
128.     Inc(i, len);
     
129.     Result := Result + Py;
     
130.   end;
     
131. end;
     
132. 
     
133. function GetHzPyHead(HzChar: PAnsiChar; Len: Integer): String;
     
134. begin
     
135.   Result := Copy(GetHzPy(HzChar, Len), 1, 1);
     
136. end;
     
137. 
     
138. function CheckIsGB2312(AChar: WideChar): Boolean;
     
139. var
     
140.   S: AnsiString;
     
141. begin
     
142.   S := AChar;
     
143.   Result := (PByte(integer(S)+1)^>=$A1) and (PByte(integer(S)+1)^<=$FE) and
     
144.     (PByte(S)^>=$B0) and (PByte(S)^<=$F7);
     
145. end;
     
146. 
     
147. function StrIsCanShow(const WS: WideString): Boolean;
     
148. var
     
149.   i: integer;
     
150.   P: PWideChar;
     
151. begin
     
152.   Result := True;
     
153.   P := Pointer(WS);
     
154.   for i:=1 to Length(WS) do begin
     
155.     if not (
     
156.              ((PWord(P)^>=$20) and (PWord(P)^<=$7E)) //Ansi 可见字符
     
157.              or CheckIsGB2312(P^)                    //GB2312汉字及符号
     
158.            ) then  begin
     
159.       Result := False;
     
160.       Break;
     
161.     end;
     
162.     Inc(P);
     
163.   end;
     
164. end;
     
165. 
     
166. function HZ2PY(const HZ: string; ISPYHead: Boolean): string;
     
167. begin
     
168.   if ISPYHead then Result := Trim(GetPyChars(Trim(HZ)))
     
169.   else Result := Trim(GetHzPyFull(Trim(HZ)));
     
170.   if not StrIsCanShow(Result) then Result := '';
     
171. end;
     
172. 
     
173. end.

复制代码

lhxzui

谢谢分享。

1234567

谢谢分享.请问是什么许可的,可以使用吗?