Q
qinjlin76
Unregistered / Unconfirmed
GUEST, unregistred user!
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 //是否为 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.