hwsearch.pas.svn-base

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

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

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ExtCtrls, StdCtrls, Buttons, Grids, DBGrids, ADODB,
  dxCntner, dxEditor, dxExEdtr, dxEdLib;

type
  THwSearchForm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    cbFieldName: TComboBox;
    Label2: TLabel;
    cbOperator: TComboBox;
    Label3: TLabel;
    edtFieldValue: TEdit;
    bbtnSearch: TBitBtn;
    bbtnAdd: TBitBtn;
    bbtnDelete: TBitBtn;
    bbtnExit: TBitBtn;
    bbtnDelAll: TBitBtn;
    DBGrid1: TDBGrid;
    ADODataSet1: TADODataSet;
    DataSource1: TDataSource;
    ADODataSet1FieldName: TStringField;
    ADODataSet1DisplayLabel: TStringField;
    ADODataSet1Operator: TStringField;
    ADODataSet1FieldValue: TStringField;
    dxDateEdit1: TdxDateEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure bbtnSearchClick(Sender: TObject);
    procedure bbtnAddClick(Sender: TObject);
    procedure bbtnDeleteClick(Sender: TObject);
    procedure bbtnDelAllClick(Sender: TObject);
    procedure bbtnExitClick(Sender: TObject);
    procedure cbFieldNameChange(Sender: TObject);
    procedure edtFieldValueKeyPress(Sender: TObject; var Key: Char);
  private
    FDataSet:TDataSet;
    AFields:TStringList;
    procedure FDataSetFilterRecord(DataSet: TDataSet; var Accept: Boolean);
    { Private declarations }
  public
    procedure OpenSearch(ADataSet:TDataSet);
    { Public declarations }
  end;

var
  HwSearchForm: THwSearchForm;

implementation

uses CommFun;

{$R *.dfm}

procedure THwSearchForm.OpenSearch(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;
  cbOperator.ItemIndex:=0;
  cbFieldNameChange(cbFieldName);
end;

procedure THwSearchForm.FDataSetFilterRecord(DataSet: TDataSet; var Accept: Boolean);
var
  AField,AOperator,AFieldValue:string;
  ABool:array [0..6] of boolean;
begin
  try
    ABool[0]:=True;  ABool[1]:=True;  ABool[2]:=True;
    ABool[3]:=True;  ABool[4]:=True;  ABool[5]:=True;  ABool[6]:=True;
    ADODataSet1.First;
    while not ADODataSet1.Eof do
    begin
      AField:=FDataSet.FindField(ADODataSet1.FieldByName('FieldName').AsString).Value;
      AFieldValue:=trim(ADODataSet1.FieldByName('FieldValue').AsString);
      AOperator:=trim(ADODataSet1.FieldByName('Operator').AsString);
      if AOperator='=' then ABool[0]:=(ABool[0]) and (Uppercase(AField)=Uppercase(AFieldValue))
      else if AOperator='>' then ABool[1]:=(ABool[1]) and (Uppercase(AField)>Uppercase(AFieldValue))
      else if AOperator='>=' then ABool[2]:=(ABool[2]) and (Uppercase(AField)>=Uppercase(AFieldValue))
      else if AOperator='<' then ABool[3]:=(ABool[3]) and (Uppercase(AField)<Uppercase(AFieldValue))
      else if AOperator='<=' then ABool[4]:=(ABool[4]) and (Uppercase(AField)<=Uppercase(AFieldValue))
      else if AOperator='<>' then ABool[5]:=(ABool[5]) and (Uppercase(AField)<>Uppercase(AFieldValue))
      else if AOperator='like' then ABool[6]:=(ABool[6]) and (Pos(Uppercase(AFieldValue),Uppercase(AField))<>0);
      ADODataSet1.Next;
    end;
    Accept:=(ABool[0]) and (ABool[1]) and (ABool[2]) and
            (ABool[3]) and (ABool[4]) and (ABool[5]) and (ABool[6])
  except
  end;
end;

procedure THwSearchForm.FormCreate(Sender: TObject);
begin
//
  ADODataSet1.FieldDefs.Clear;
  ADODataSet1.FieldDefs.Add('FieldName',ftString,20);
  ADODataSet1.FieldDefs.Add('DisplayLabel',ftString,50);
  ADODataSet1.FieldDefs.Add('Operator',ftString,10);
  ADODataSet1.FieldDefs.Add('FieldValue',ftString,50);
  ADODataSet1.CreateDataSet;
end;

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

procedure THwSearchForm.bbtnSearchClick(Sender: TObject);
begin
//执行查询(&S)
  try
    Screen.Cursor:=crHourGlass;
    if ADODataSet1.IsEmpty then
    begin
      FDataSet.Filtered:=False;
      FDataSet.Close;
      FDataSet.Open;
    end else
    begin
      FDataSet.DisableControls;
      FDataSet.Filtered:=False;
      FDataSet.Filtered:=True;
      FDataSet.OnFilterRecord:=FDataSetFilterRecord;
      FDataSet.Close;
      FDataSet.Open;
    end;
    ModalResult:=mrOK;
  finally
    FDataSet.EnableControls;
    Screen.Cursor:=crDefault;
  end;
end;

procedure THwSearchForm.bbtnAddClick(Sender: TObject);
begin
//加入条件(&A)
  if dxDateEdit1.Visible then
  begin
    if dxDateEdit1.Text='    -  -  ' then
    begin
      ShowMsg('字段值不能为空，请输入字段的值');
      dxDateEdit1.SetFocus;
      Abort;
    end;
  end
  else if edtFieldValue.Visible then
  begin
    if trim(edtFieldValue.Text)='' then
    begin
      ShowMsg('字段值不能为空，请输入字段的值');
      edtFieldValue.SetFocus;
      Abort;
    end;
  end;
  ADODataSet1.Append;
  ADODataSet1.FieldByName('FieldName').Value:=AFields[cbFieldName.ItemIndex];
  ADODataSet1.FieldByName('DisplayLabel').Value:=cbFieldName.Text;
  ADODataSet1.FieldByName('Operator').Value:=cbOperator.Text;
  if edtFieldValue.Visible then
    ADODataSet1.FieldByName('FieldValue').Value:=edtFieldValue.Text
  else if dxDateEdit1.Visible then
    ADODataSet1.FieldByName('FieldValue').Value:=dxDateEdit1.Text;
  ADODataSet1.Post;
  bbtnDelete.Enabled:=not ADODataSet1.IsEmpty;
  bbtnDelAll.Enabled:=not ADODataSet1.IsEmpty;
  edtFieldValue.Text:='';
  dxDateEdit1.Text:='';
  if edtFieldValue.Visible then edtFieldValue.SetFocus;
  if dxDateEdit1.Visible then dxDateEdit1.SetFocus;
end;

procedure THwSearchForm.bbtnDeleteClick(Sender: TObject);
begin
//移除条件(&D)
  ADODataSet1.Delete;
  bbtnDelete.Enabled:=not ADODataSet1.IsEmpty;
  bbtnDelAll.Enabled:=not ADODataSet1.IsEmpty;
end;

procedure THwSearchForm.bbtnDelAllClick(Sender: TObject);
begin
//清除条件(&L)
  ADODataSet1.First;
  while not ADODataSet1.Eof do
  begin
    ADODataSet1.Delete;
  end;
  bbtnDelete.Enabled:=not ADODataSet1.IsEmpty;
  bbtnDelAll.Enabled:=not ADODataSet1.IsEmpty;
end;

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

procedure THwSearchForm.cbFieldNameChange(Sender: TObject);
begin
  case FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).DataType of
    ftDate, ftTime, ftDateTime:
      begin
        edtFieldValue.Visible:=False;
        dxDateEdit1.Visible:=True;
      end;
  else
    edtFieldValue.Visible:=True;
    dxDateEdit1.Visible:=False;
  end;
end;

procedure THwSearchForm.edtFieldValueKeyPress(Sender: TObject;
  var Key: Char);
begin
  case FDataSet.FieldByName(AFields[cbFieldName.ItemIndex]).DataType of
    ftSmallint, ftInteger, ftWord: ValidInteger(Sender, Key);
    ftFloat, ftCurrency, ftBCD: ValidFloat(Sender, Key);
  end;
end;

end.