hwlocate.pas.svn-base

这是一个功能齐全的,代码完整的ERP企业信息管理系统,现在上传和大家分享

{***********************************************}
{                                               }
{       名    称：通用查找程序                  }
{       作    者：李洪辉                        }
{       创建日期：2003-05-02                    }
{       修改日期：2003-05-02                    }
{                                               }
{***********************************************}
unit HwLocate;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DB, DBTables;

type
  THwLocateForm = class(TForm)
    gpLocateType: TGroupBox;
    cbCaseSensitive: TCheckBox;
    rbExactMatch: TRadioButton;
    rbPartialMatchStart: TRadioButton;
    rbPartialMatchAny: TRadioButton;
    Panel1: TPanel;
    gpFields: TGroupBox;
    cbFieldName: TComboBox;
    gpFieldValue: TGroupBox;
    edtLocateValue: TEdit;
    btnLocate: TButton;
    btnNext: TButton;
    btnExit: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnLocateClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
  private
    AOptions:TLocateOptions;
    FDataSet:TDataSet;
    ABookmark:TBookmark;
    AFields:TStringList;
    { Private declarations }
  public
    procedure OpenLocate(ADataSet:TDataSet);
    procedure FindMatch;
    procedure FindNextMatch;
    { Public declarations }
  end;

var
  HwLocateForm: THwLocateForm;

implementation

uses CommFun;

{$R *.dfm}

procedure THwLocateForm.OpenLocate(ADataSet:TDataSet);
var
  I:integer;
begin
  FDataSet:=ADataSet;
  if not ADataSet.Active then
  begin
    try
      ADataSet.Open;
    except
      ShowMsg('打开数据集失败，检查您是否为数据集组件设置了正确的信息');
      Abort;
    end;
  end;
  AFields:=TStringList.Create;
  cbFieldName.Clear;
  for I:=0 to ADataSet.FieldCount-1 do
  begin
    if ADataSet.Fields[I].Visible then
    begin
      cbFieldName.Items.Add(ADataSet.Fields[I].DisplayLabel);
      AFields.Add(ADataSet.Fields[I].FieldName);
    end;
  end;
  cbFieldName.ItemIndex:=0;
  ABookmark:=FDataSet.GetBookmark;
end;

procedure THwLocateForm.FindMatch;
begin
  try
    Screen.Cursor:=crHourGlass;
    FDataSet.DisableControls;
    AOptions:=[];
    //忽略大小写
    if cbCaseSensitive.Checked then AOptions:=AOptions+[loCaseInsensitive];  //忽略大小写
    if rbExactMatch.Checked then  //精确查找
    begin
      AOptions:=AOptions-[loPartialkey]
    end else
    if rbPartialMatchStart.Checked then  //起始部份匹配查找
    begin
      AOptions:=AOptions+[loPartialkey]
    end else
    if rbPartialMatchAny.Checked then  //模糊查找
    begin
      FDataSet.First;
      while not FDataSet.Eof do
      begin
        if cbCaseSensitive.Checked then  //忽略大小写
        begin
          if Pos(Uppercase(edtLocateValue.Text),Uppercase(FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).AsString))<>0 then
          begin
            ABookmark:=FDataSet.GetBookmark;
            Break;
          end;
        end else  //区分大小写
        begin
          if Pos(edtLocateValue.Text,FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).AsString)<>0 then
          begin
            ABookmark:=FDataSet.GetBookmark;
            Break;
          end;
        end;
        FDataSet.Next;
      end;
      if FDataSet.Eof then
      begin
        FDataSet.GotoBookmark(ABookmark);
        ShowMsg('找不到符合查找条件的记录');
        edtLocateValue.SetFocus;
        Abort;
      end;
    end;

    if not rbPartialMatchAny.Checked then
    begin
      if not FDataSet.Locate(AFields[cbFieldName.ItemIndex],Variant(edtLocateValue.Text),AOptions) then
      begin
        ShowMsg('找不到符合查找条件的记录');
        edtLocateValue.SetFocus;
        Abort;
      end;
    end;
    ModalResult:=mrOK;
  finally
    FDataSet.EnableControls;
    Screen.Cursor:=crDefault;
  end;
end;

procedure THwLocateForm.FindNextMatch;
begin
  try
    Screen.Cursor:=crHourGlass;
    FDataSet.DisableControls;
    while not FDataSet.Eof do
    begin
      FDataSet.Next;
      if rbExactMatch.Checked then  //精确查找
      begin
        if cbCaseSensitive.Checked then  //忽略大小写
        begin
          if Uppercase(edtLocateValue.Text)=Uppercase(FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).AsString) then
          begin
            ABookmark:=FDataSet.GetBookmark;
            Break;
          end;
        end else  //区分大小写
        begin
          if edtLocateValue.Text=FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).AsString then
          begin
            ABookmark:=FDataSet.GetBookmark;
            Break;
          end;
        end;
      end else
      if rbPartialMatchStart.Checked then  //起始部份匹配查找
      begin
        if cbCaseSensitive.Checked then  //忽略大小写
        begin
          if Pos(Uppercase(edtLocateValue.Text),Uppercase(FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).AsString))=1 then
          begin
            ABookmark:=FDataSet.GetBookmark;
            Break;
          end;
        end else  //区分大小写
        begin
          if Pos(edtLocateValue.Text,FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).AsString)=1 then
          begin
            ABookmark:=FDataSet.GetBookmark;
            Break;
          end;
        end;
      end else
      if rbPartialMatchAny.Checked then  //模糊查找
      begin
        if cbCaseSensitive.Checked then  //忽略大小写
        begin
          if Pos(Uppercase(edtLocateValue.Text),Uppercase(FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).AsString))<>0 then
          begin
            ABookmark:=FDataSet.GetBookmark;
            Break;
          end;
        end else  //区分大小写
        begin
          if Pos(edtLocateValue.Text,FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).AsString)<>0 then
          begin
            ABookmark:=FDataSet.GetBookmark;
            Break;
          end;
        end;
      end;
    end;
    if FDataSet.Eof then
    begin
      FDataSet.GotoBookmark(ABookmark);
      ShowMsg('找不到下一个符合查找条件的记录');
      Abort;
    end;
  finally
    FDataSet.EnableControls;
    Screen.Cursor:=crDefault;
  end;
end;

procedure THwLocateForm.FormCreate(Sender: TObject);
begin
//
end;

procedure THwLocateForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
//
end;

procedure THwLocateForm.btnLocateClick(Sender: TObject);
begin
//查找(&L)
  FindMatch;
end;

procedure THwLocateForm.btnNextClick(Sender: TObject);
begin
//下一个(&N)
  FindNextMatch;
end;

procedure THwLocateForm.btnExitClick(Sender: TObject);
begin
//退出(&X)
  Close;
end;

end.