autofind.pas
来自「delphi编程控件」· PAS 代码 · 共 211 行
PAS
211 行
unit AutoFind;
(*
COPYRIGHT (c) RSD software 1997 - 98
All Rights Reserved.
*)
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, StdCtrls, ExtCtrls, Forms,
DB, DBTables, DBCtrls, Controls, Buttons, Graphics;
type
TAutoFind = class;
TAutoFindForm = class(TForm)
ListBox1: TListBox;
Edit1: TEdit;
Label1: TLabel;
BOk: TButton;
BCancel: TButton;
procedure Edit1Change(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
BookMark : TBookMark;
List : TList;
public
fFindField : String;
DataSet : TDataSet;
end;
TAutoFind = class(TComponent)
private
FActive : Boolean;
FDataSet : TDataSet;
FDataField : String;
FFont : TFont;
procedure SetActive(Value : Boolean);
procedure SetFont(value : TFont);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Execute;
published
property Active : Boolean read FActive write SetActive;
property DataSet : TDataSet read FDataSet write FDataSet;
property DataField : String read FDataField write FDataField;
property Font : TFont read FFont write SetFont;
end;
procedure FindFieldValue(ADataSet : TDataSet; AFindField : String; Font : TFont);
implementation
uses autostrs, audbstrs;
{$R *.DFM}
procedure FindFieldValue(ADataSet : TDataSet; AFindField : String; Font : TFont);
Var
AForm : TAutoFindForm;
begin
if ADataSet.FindField(AFindField).FieldKind = fkLookup then Exit;
AForm := TAutoFindForm.Create(nil);
AForm.DataSet := ADataSet;
AForm.fFindField := AFindField;
AForm.Label1.Font.Assign(Font);
AForm.Edit1.Font.Assign(Font);
AForm.ListBox1.Font.Assign(Font);
AForm.BOk.Font.Assign(Font);
AForm.BCancel.Font.Assign(Font);
AForm.ShowModal;
AForm.Free;
end;
procedure TAutoFindForm.Edit1Change(Sender: TObject);
Var
Count : Longint;
LenSt : Integer;
CompSt : String;
begin
if(Edit1.Text = '') then begin
ListBox1.ItemIndex := 0;
Exit;
end;
LenSt := Length(Edit1.Text);
For Count := 0 To ListBox1.Items.Count - 1 do begin
CompSt := Copy(ListBox1.Items[Count], 1, LenSt);
if(AnsiCompareText(Edit1.Text, CompSt) = 0) then begin
ListBox1.ItemIndex := Count;
Exit;
end;
end;
end;
procedure TAutoFindForm.ListBox1DblClick(Sender: TObject);
begin
ModalResult := mrOk;
end;
type
TPLongInt = ^LongInt;
procedure TAutoFindForm.FormShow(Sender: TObject);
Var
Count : Longint;
PValue : TPLongInt;
begin
List := TList.Create;
if(DataSet.EOF and DataSet.BOF) then begin
BOk.Enabled := False;
exit;
end;
BookMark := DataSet.GetBookMark;
DataSet.DisableControls;
DataSet.First;
ListBox1.Items.Clear;
Edit1.Text :='';
Count := 0;
While Not DataSet.EOF do begin
if(DataSet.FindField(fFindField).AsString <> '') then begin
ListBox1.Items.Add( Format('%s%7d',[DataSet.FindField(fFindField).AsString, Count]));
Inc(Count);
end;
DataSet.Next;
end;
For Count := 0 to ListBox1.Items.Count - 1 do begin
New(PValue);
PValue^ := StrToInt(Copy(ListBox1.Items[Count], Length(ListBox1.Items[Count]) - 6, 7));
List.Add(PValue);
ListBox1.Items[Count] := Copy(ListBox1.Items[Count], 1, Length(ListBox1.Items[Count]) - 7);
end;
ListBox1.ItemIndex := 0;
BOk.Enabled := True;
Edit1.SetFocus;
end;
procedure TAutoFindForm.FormDestroy(Sender: TObject);
Var
PValue : TPLongInt;
i : LongInt;
begin
if Not (DataSet.EOF) Or Not (DataSet.BOF) then begin
if(ModalResult <> mrOK) then
DataSet.GoToBookMark(BookMark)
else begin
PValue := List.List^[ListBox1.ItemIndex];
DataSet.MoveBy(PValue^ - ListBox1.Items.Count + 1);
end;
DataSet.FreeBookMark(BookMark);
for i := 0 to List.Count - 1 do Dispose(List.List^[i]);
List.Free;
end;
DataSet.EnableControls;
end;
{TAutoFind}
constructor TAutoFind.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FFont := TFont.Create;
end;
destructor TAutoFind.Destroy;
begin
FFont.Free;
inherited;
end;
procedure TAutoFind.SetActive(Value : Boolean);
Var
i : SmallInt;
begin
if(Not Value) then exit;
FActive := True;
if(csDesigning in ComponentState) then
Application.ProcessMessages;
if(FDataSet <> Nil) And (FDataSet.Active) then
for i := 0 to FDataSet.FieldCount - 1 do
if(CompareText(FDataSet.Fields[i].FieldName, FDataField) = 0) then
FindFieldValue(FDataSet, FDataField, FFont);
FActive := False;
end;
procedure TAutoFind.Execute;
begin
Active := True;
end;
procedure TAutoFind.SetFont(Value : TFont);
begin
if(Value <> Nil) then
FFont.Assign(Value);
end;
procedure TAutoFindForm.FormCreate(Sender: TObject);
begin
BOK.Caption := LoadStr(ACB_OK);
BCancel.Caption := LoadStr(ACB_CANCEL);
Label1.Caption := LoadStr(ACL_SELECTFROMLIST);
Caption := LoadStr(ACL_FIND);
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?