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

From:http://tw.wingwit.com/Article/program/Delphi/201311/24657.html