转自：

 

编写数据库应用系统有时会用到根据汉字拼音来快速检索数据,网络上有汉字生成拼音的方法: 

代码 

function GetPYIndexChar(hzchar: Ansistring): char;

begin

  case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of

    $B0A1..$B0C4 : result := 'A';

    $B0C5..$B2C0 : result := 'B';

    $B2C1..$B4ED : result := 'C';

    $B4EE..$B6E9 : result := 'D';

    $B6EA..$B7A1 : result := 'E';

    $B7A2..$B8C0 : result := 'F';

    $B8C1..$B9FD : result := 'G';

    $B9FE..$BBF6 : result := 'H';

    $BBF7..$BFA5 : result := 'J';

    $BFA6..$C0AB : result := 'K';

    $C0AC..$C2E7 : result := 'L';

    $C2E8..$C4C2 : result := 'M';

    $C4C3..$C5B5 : result := 'N';

    $C5B6..$C5BD : result := 'O';

    $C5BE..$C6D9 : result := 'P';

    $C6DA..$C8BA : result := 'Q';

    $00C800BB..$00C800F5 : result := 'R';

    $C8F6..$CBF9 : result := 'S';

    $CBFA..$CDD9 : result := 'T';

    $CDDA..$CEF3 : result := 'W';

    $CEF4..$D188 : result := 'X';

    $D1B9..$D4D0 : result := 'Y';

    $D4D1..$D7F9 : result := 'Z';

  else

    result := char(0);

  end;

end;

 

定义一个检索函数:

 

代码 

function SearchByPYIndexStr(SourceStrs: TStrings;PYIndexStr: Ansistring): Ansistring;

label NotFound;

var

  i, j   :integer;

  hzchar :Ansistring;

begin

  for i:=0 to SourceStrs.Count-1 do

  begin

    for j:=1 to Length(PYIndexStr) do

      begin

        //hzchar:=SourceStrs[i][2*j-1]+ SourceStrs[i][2*j];

        hzchar:=SourceStrs[i][j];

        if (PYIndexStr[j]<>'?') and (UpperCase(PYIndexStr[j]) <> GetPYIndexChar(hzchar)) then

        goto NotFound;

      end;

    if result='' then

      result := SourceStrs[i]

    else

      result := result + Char(13) + SourceStrs[i];

   NotFound:

  end;

end;

 

 

 

然后就可以像这样来使用了:

 

procedure TForm1.SearchChange(Sender: TObject);

var

  ResultStr:string;

begin

  ResultStr:='';

  ResultList.Items.Text := SearchByPYIndexStr(Sourcelist.Items, Search.Text);

end;

 

 

 

下面的函数可以将汉字的字符串生成拼音简写(注:适用于D2009/D2010,D7以前版本及D2007需要修改为AnsiString方式,汉字取两个字符):

 

代码 

function GetPY(const hzchar:string):string;

var

  i: integer;

  c:Char;

begin

  i:=1;

  result:='';

  for i:=1 to length(hzchar)  do

  begin

    c:=GetPYIndexChar(hzchar[i]);

    if c='' then

      result:=result+hzchar[i]

    else

      result:=result+c;

  end;

end;

 

 然后我们定义一个可以取部分拼音匹配的函数:

 

代码 

function SearchByPYIndexStrPart(SourceStrs: TStrings;PYIndexStr: Ansistring): Ansistring;

var

  i, j   :integer;

  hzchar :Ansistring;

  s:String;

begin

  for i:=0 to SourceStrs.Count-1 do

  begin

    s:=GetPY(SourceStrs[i]);

    if Pos(UpperCase(PYIndexStr),UpperCase(s))>0 then

      result := result + Char(13) + SourceStrs[i];

  end;

end;

 

 

一个自动生成过滤参数的函数:

 

代码 

function GetDataSetFilter(SourceStrs: TStrings;PYIndexStr: Ansistring;FieldName:String): Ansistring;

var

  ResultStr,ss:string;

  s:TStrings;

begin

  ResultStr:='';

  try

    s:=TStringList.Create;

    s.Text:= SearchByPYIndexStrPart(SourceStrs, PYIndexStr);

    Result:='';

    for ss in s do

    begin

      if ss<>'' then

        Result:=Result+FieldName+' like ''%'+ss+'%'' or ';

    end;

    Result:=Copy(Result,1,Length(Result)-3);

    Exit(Result);

  finally

    s.Free;

  end;

end;

 

 

 

然后我们就可以像这样来使我们的数据支持动态的汉字拼音快速检索了:

 

代码 

//比如说TEdit的OnChange事件中:

//FieldValueListStrings:TStrings类型的数据值列表

//PYIndex:拼音索引字符串

//FieldName:筛选用的字段名称

/注意要设置aDataSet.Filtered:=True;

aDataSet.Filter:=GetDataSetFilter(FieldValueListStrings,PYIndex,FieldName);

 

 

这样我们定义好通用函数,就可以在程序的任何地方方便地使用汉字检索了.

 

注意:如果待查询数据比较到的话,这种方式效率很低,建议最好在数据表中建立一个拼音字段,在保存数据时自动生成,然后就可以根据拼音字段进行快速筛选了.