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 + -
显示快捷键?