Delphi实现数据库的拼音查询

昨夜看到一篇文章可以用Delphi将汉字>拼音可是将拼音转换成汉字又该如何操作哪？我的数据库通讯录软件缺少用拼音查找功能结果搞到点还是无果！唉！

中午找到输入拼音可以检索汉字可是在数据库中怎样实现哪？个小时无果！

今天实现:

首先建立字库

检索先从数据库读出所要查询字段所有记录将其放入控件ListBox再按照拼音检索需要的数据

实现是靠的迂回策略(读取数据库汉字>转换成拼音>依据拼音检索结果>实现数据库的拼音检索)没找到直接在数据库查询然后显示结果的方法希望高人指点一二

下面附上Code:

字库Code:

{//汉字拼音码检索 对应的拼音字母}

function GetCharInd(zzchar:string):char;

begin

case WORD(zzchar[]) shl +WORD(zzchar[]) of

$BA$BC:result:=A;

$BC$BC:result:=B;

$BC$BED:result:=C;

$BEE$BE:result:=D;

$BEA$BA:result:=E;

$BA$BC:result:=F;

$BC$BFD:result:=G;

$BFE$BBF:result:=H;

$BBF$BFA:result:=J;

$BFA$CAB:result:=K;

$CAC$CE:result:=L;

$CE$CC:result:=M;

$CC$CB:result:=N;

$CB$CBD:result:=O;

$CBE$CD:result:=P;

$CDA$CBA:result:=Q;

$CBB$CF:result:=R;

$CF$CBF:result:=S;

$CBFA$CDD:result:=T;

$CDDA$CEF:result:=W;

$CEF$D:result:=X;

$DB$DD:result:=Y;

$DD$DF:result:=Z;

else

result:=#;

end;

end;

查询实现部分:

{汉字拼音码的检索}

function DisByStrInd(ListBoxStr:TListBox;StrInd:string):string;

label NotFound;

var

zzchar :string;

ij:integer;

begin

for i:= to ListBoxStrItemsCount do

begin

for j:= to Length(StrInd) do

begin

zzchar:=ListBoxStrItems[i][*j]+ListBoxStrItems[i][*j];

if (StrInd[j]<>?) and (UpperCase(StrInd[j])<>GetCharInd(zzchar))

then goto NotFound;

end;

if result= then result:=ListBoxStrItems[i]

else result:=result+#+ListBoxStrItems[i];

NotFound:

end;

end;

以下是Delphi中 Unit单元 的完整代码:

{********************************************************************}

{ *名称: SelectByPinYin 单元

*功能:本单元为此数据库程序的 通过汉字拼音查询 单元

*软件环境:Win+Delphi+AccessXp

*作者:Domain

*Email:

*制作日期: }

{********************************************************************}

unit SelectByPinYin;

interface

uses

Windows Messages SysUtils Variants Classes Graphics Controls Forms

Dialogs NEOFORM ComCtrls MenuBar ToolWin ExtCtrls StdCtrls DBCtrls

Buttons;

type

TSelectPY = class(TEDairyForm)

Panel: TPanel;

Panel: TPanel;

Panel: TPanel;

Panel: TPanel;

ListBox: TListBox;

Edit: TEdit;

Label: TLabel;

Label: TLabel;

BitBtn: TBitBtn;

BitBtn: TBitBtn;

ListBox: TListBox;

Label: TLabel;

procedure FormCreate(Sender: TObject);

procedure EditChange(Sender: TObject);

procedure ListBoxClick(Sender: TObject);

procedure ListBoxClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

SelectPY: TSelectPY;

getName:String;

{函数在这里定义}

function GetCharInd(zzchar:string):char;//汉字拼音码

function DisByStrInd(ListBoxStr:TListBox;StrInd:string):string;

implementation

uses DataMain;

{$R *dfm}

{//汉字拼音码检索 对应的拼音字母}

function GetCharInd(zzchar:string):char;

begin

case WORD(zzchar[]) shl +WORD(zzchar[]) of

$BA$BC:result:=A;

$BC$BC:result:=B;

$BC$BED:result:=C;

$BEE$BE:result:=D;

$BEA$BA:result:=E;

$BA$BC:result:=F;

$BC$BFD:result:=G;

$BFE$BBF:result:=H;

$BBF$BFA:result:=J;

$BFA$CAB:result:=K;

$CAC$CE:result:=L;

$CE$CC:result:=M;

$CC$CB:result:=N;

$CB$CBD:result:=O;

$CBE$CD:result:=P;

$CDA$CBA:result:=Q;

$CBB$CF:result:=R;

$CF$CBF:result:=S;

$CBFA$CDD:result:=T;

$CDDA$CEF:result:=W;

$CEF$D:result:=X;

$DB$DD:result:=Y;

$DD$DF:result:=Z;

else

result:=#;

end;

end;

{汉字拼音码的检索}

function DisByStrInd(ListBoxStr:TListBox;StrInd:string):string;

label NotFound;

var

zzchar :string;

ij:integer;

begin

for i:= to ListBoxStrItemsCount do

begin

for j:= to Length(StrInd) do

begin

zzchar:=ListBoxStrItems[i][*j]+ListBoxStrItems[i][*j];

if (StrInd[j]<>?) and (UpperCase(StrInd[j])<>GetCharInd(zzchar))

then goto NotFound;

end;

if result= then result:=ListBoxStrItems[i]

else result:=result+#+ListBoxStrItems[i];

NotFound:

end;

end;

{在 FormCreate 中将联系人 姓名 加入 ListBox}

procedure TSelectPYFormCreate(Sender: TObject);

var

i:integer;

begin

inherited;

with adodmPersonName do

begin

listBoxClear;

//用循环的方法加入

for i:= to adodmPersonNameRecordCount do

begin

selfListBoxItemsAdd(adodmPersonNameFieldByName(姓名)AsString);

adodmPersonNameNext;

end;

listBoxSorted:=true;

adodmPersonNameFirst;//DateSet指针指向第一条记录

end;

// editSetFocus;

end;

//实现单击选择性名

procedure TSelectPYListBoxClick(Sender: TObject);

var xIndex:integer;

begin

inherited;

xIndex:=selfListBoxItemIndex;//得到Item选项的Index

labelCaption:=selfListBoxItemsStrings[xIndex];//从Index得到 Text;

getName:=selfListBoxItemsStrings[xIndex];

end;

{输入拼音查找汉字}

procedure TSelectPYEditChange(Sender: TObject);

var

SelStr:string;

begin

inherited;

SelStr:=;

ListBoxItemsText:=DisByStrInd(listBoxEditText);

end;

{单击选择}

procedure TSelectPYListBoxClick(Sender: TObject);

var nIndex:integer;

begin

inherited;

nIndex:=ListBoxItemIndex;

ListBoxItemsText:=ListBoxItemsStrings[nIndex];

getName:=selfListBoxItemsText;

end;

end