hwseldata.pas

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

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, Buttons, DBCtrls, ExtCtrls, Db, DBTables, ADODB;

type
  THwSelDataForm = class(TForm)
    DBGrid1: TDBGrid;
    bbtnEdit: TBitBtn;
    bbtnOK: TBitBtn;
    bbtnExit: TBitBtn;
    dsSelData: TDataSource;
    gpLocateType: TGroupBox;
    cbCaseSensitive: TCheckBox;
    rbExactMatch: TRadioButton;
    rbPartialMatchStart: TRadioButton;
    rbPartialMatchAny: TRadioButton;
    Panel1: TPanel;
    gpFieldValue: TGroupBox;
    edtLocateValue: TEdit;
    btnLocate: TButton;
    gpFields: TGroupBox;
    cbFieldName: TComboBox;
    btnNext: TButton;
    procedure DBGrid1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure bbtnOKClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnLocateClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure edtLocateValueKeyPress(Sender: TObject; var Key: Char);
    procedure bbtnEditClick(Sender: TObject);
  private
    AOptions:TLocateOptions;
    AFrmClass:TFormClass;
    FDataSet:TDataSet;
    ABookmark:TBookmark;
    AFields:TStringList;
    { Private declarations }
  public
    function OpenSelData(ADataSet:TDataSet;AFormClass:TFormClass):variant;
    procedure FindMatch;
    procedure FindNextMatch;
    { Public declarations }
  end;

var
  HwSelDataForm: THwSelDataForm;

implementation

uses CommFun;

{$R *.DFM}

function THwSelDataForm.OpenSelData(ADataSet:TDataSet;AFormClass:TFormClass):variant;
var
  I:integer;
begin
  AFrmClass:=AFormClass;
  if AFrmClass=nil then bbtnEdit.Visible:=False;

  dsSelData.DataSet:=ADataSet;
  FDataSet:=ADataSet;
  if not ADataSet.Active then
  begin
    try
      ADataSet.Open;
    except
      ShowMsg('UMS10000184');  //打开数据集失败，检查您是否为数据集组件设置了正确的信息
      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;
end;

procedure THwSelDataForm.FindMatch;
var
  ACalcFields,AAfterScroll:TDataSetNotifyEvent;
begin
  ACalcFields:=FDataSet.OnCalcFields;
  AAfterScroll:=FDataSet.AfterScroll;
  FDataSet.OnCalcFields:=nil;
  FDataSet.AfterScroll:=nil;
  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('UMS10000004');  //找不到符合查找条件的记录
        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('UMS10000004');  //找不到符合查找条件的记录
        edtLocateValue.SetFocus;
        Abort;
      end;
    end;
  finally
    FDataSet.OnCalcFields:=ACalcFields;
    FDataSet.AfterScroll:=AAfterScroll;
    FDataSet.EnableControls;
    Screen.Cursor:=crDefault;
  end;
end;

procedure THwSelDataForm.FindNextMatch;
var
  ACalcFields,AAfterScroll:TDataSetNotifyEvent;
begin
  ACalcFields:=FDataSet.OnCalcFields;
  AAfterScroll:=FDataSet.AfterScroll;
  FDataSet.OnCalcFields:=nil;
  FDataSet.AfterScroll:=nil;
  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('UMS10000185');  //找不到下一个符合查找条件的记录
      Abort;
    end;
  finally
    FDataSet.OnCalcFields:=ACalcFields;
    FDataSet.AfterScroll:=AAfterScroll;
    FDataSet.EnableControls;
    Screen.Cursor:=crDefault;
  end;
end;

procedure THwSelDataForm.DBGrid1DblClick(Sender: TObject);
begin
  if FDataSet.IsEmpty then Exit;
  ModalResult:=mrOk;
end;

procedure THwSelDataForm.FormCreate(Sender: TObject);
begin
  //设置界面信息
  Aoptions:=[];
end;

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

procedure THwSelDataForm.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then ModalResult:=mrOk;
end;

procedure THwSelDataForm.bbtnOKClick(Sender: TObject);
begin
  ModalResult:=mrOk;
end;

procedure THwSelDataForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=vk_return then perform(WM_NEXTDLGCTL,0,0);
end;

procedure THwSelDataForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

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

procedure THwSelDataForm.edtLocateValueKeyPress(Sender: TObject;
  var Key: Char);
begin
  if key=#13 then btnLocate.Click;
end;

procedure THwSelDataForm.bbtnEditClick(Sender: TObject);
begin
//编辑(&E)
  AFrmClass.Create(Application).ShowModal;
  FDataSet.Close;
  FDataSet.Open;
end;

end.