delphi 汉字转拼音码(下)|笨鱼技术网

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[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) do
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.