Delphi获取汉字拼音以及拼音首字母

程序代码为: 

THzSpell.PyOfHz(Edit1.Text)//获取汉字的拼音

UpperCase(THzSpell.PyHeadOfHz(Edit1.Text))//获取拼音首字母

----------------------------------代码文件---------------------------------------------------------------------

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.

需要更多交流，请关注：http://weibo.com/u/2985316267?is_hot=1