Delphi acquires Chinese pinyin and pinyin initials

The program code is:

Thzspell.pyofhz (Edit1.text)//Get Pinyin of Chinese characters

Uppercase (Thzspell.pyheadofhz (Edit1.text))//Get pinyin Initials

----------------------------------code file---------------------------------------------------------------------

Unit Hzspell;
{version 4.1}

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
is the GBK character
Case Hzchar[0] of
#163://full-width ASCII
Begin
C: = Chr (Ord (hzchar[1))-128);
If C in [' A ' ... ' Z ', ' A '.. ' Z ', ' 0 ' ... ' 9 ', ' (', ') ', ' [', '] ' then
Result: = C
Else
Result: = ';
End
#162://Roman Numerals
Begin
If hzchar[1] > #160 Then
Result: = Charindex[ord (hzchar[1])-160]
Else
Result: = ';
End
#166://Greek alphabet
Begin
If hzchar[1] in [# $A 1.. # $B 8] Then
Result: = Charindex2[ord (hzchar[1])-$A 0]
else if hzchar[1] in [# $C 1.. # $D 8] Then
Result: = Charindex2[ord (hzchar[1])-$C 0]
Else
Result: = ';
End
Else
Begin//Get phonetic Index
Index: = Pycodeindex[ord (Hzchar[0])-+, Ord (hzchar[1])-63];
If Index = 0 Then
Result: = '
Else
Result: = Pymusiccode[index];
End
End
End
else if Len > 0 Then
Begin
Outside the GBK character set, that is, half-width characters
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) does
Begin
If Isdoubyte (Hzchar[i]) and (Length (Hzchar)-i > 0) Then
Len: = 2
Else
Len: = 1;
Py: = Gethzpy (@HzChar [i], 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) does
Begin
If Isdoubyte (Hzchar[i]) and (Length (Hzchar)-i > 0) Then
Len: = 2
Else
Len: = 1;
Py: = Gethzpyhead (@HzChar [i], 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.

For more communication, please pay attention to: http://weibo.com/u/2985316267?is_hot=1