findform.~pa

一个很好用的万能查询控件。部分代码经过更改。

{*******************************************************}
{       查询基类     Unit                               }
{                                                       }
{       Copyright (c) 2001-2001, 广东亿康公司           }
{       实现Form中通用查询功能                          }
{       Athor:乔有钢                                    }
{*******************************************************}
unit FindForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBGridEh, DBGrids, FindSelect, ComCtrls;
type
  TfrmFind = class(TForm)
    GroupBox3: TGroupBox;
    cmbYSF: TComboBox;
    edtValue: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    rbtJJ: TRadioButton;
    lbAnd: TListBox;
    rbtAnd: TRadioButton;
    rbtOR: TRadioButton;
    GroupBox4: TGroupBox;
    rbtBJ: TRadioButton;
    lbOR: TListBox;
    Button2: TButton;
    Button3: TButton;
    cmbIndex: TComboBox;
    btnAdd: TButton;
    dtpTime: TDateTimePicker;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure edtValueKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button1Click(Sender: TObject);
    procedure rbtJJClick(Sender: TObject);
    procedure rbtBJClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure cmbYSFKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure dtpTimeKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cmbIndexKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cmbIndexChange(Sender: TObject);
  private
    function GetYSF(sStr: string): string;
  protected
    procedure load; virtual; //可以在子类中重载
    function GetFildName(sTitle: string): string; virtual;
  public
    slList: TStringList; { Public declarations }
  end;

var
  frmFind: TfrmFind;

implementation

uses FindClass;
var
  bIsTime: Boolean;
  sSqlText,sSqlTextAnd,sSqlTextOr:string;
  {$R *.DFM}

procedure TfrmFind.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) or (Key = VK_DOWN) then //按回车键或向下键自动跳到下一输入控件
    SendMessage(Handle, WM_NEXTDLGCTL, 0, 0);
  if Key = VK_UP then //按向上键自动跳到上一输入控件
    SendMessage(Handle, WM_NEXTDLGCTL, 1, 0);
  if Key = VK_ESCAPE then
    Close;
end;

procedure TfrmFind.FormShow(Sender: TObject);
begin
  load;
  // bIsOk := True;
  if cmbIndex.Items.Count > 0 then
    cmbIndex.ItemIndex := 0;
  gsSQLText := '';
  sSQLTextAnd := '';
  sSQLTextOr := '';
  lbAnd.Items.Clear;
  lbOR.Items.Clear;
  ShortDateFormat := 'YYYY-MM-DD';
  dtpTime.DateTime := Date;
  bIsTime := (Pos('时间', cmbIndex.Text) > 0) or (Pos('日期', cmbIndex.Text) > 0);
  dtpTime.Visible := bIsTime;
end;

procedure TfrmFind.load;
var
  i: integer;
begin
  cmbIndex.Items.Clear;
  if slList.Count > 0 then
    for i := 0 to slList.Count - 1 do
      cmbIndex.Items.Add(slList[i]);
end;

procedure TfrmFind.Button3Click(Sender: TObject);
begin
  lbAnd.Items.Clear;
  lbOR.Items.Clear;
  sSQLTextAnd := '';
  sSqlTextOr := '';
  sSqlText := '';
end;

procedure TfrmFind.Button2Click(Sender: TObject);
begin
  gsSqlText := ''; //取消
  Close;
end;

procedure TfrmFind.edtValueKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_Return then begin
      BtnAdd.Click;
    end;
end;

function TfrmFind.GetFildName(sTitle: string): string;
var
  i, j: integer;
  sIndex: string;
begin
  with gFForm do begin //取得列头相对应的字段名
      if FDBGridEh <> nil then
        for i := 0 to FDBGridEh.Columns.Count - 1 do begin
            if FDBGridEh.Columns[i].Title.Caption = sTitle then begin
                sIndex := FDBGridEh.Columns[i].FieldName;
                Result := sIndex;
                Exit;
              end;

          end;
      if FDBGrid <> nil then
        for i := 0 to FDBGrid.Columns.Count - 1 do begin
            if FDBGrid.Columns[i].Title.Caption = sTitle then begin
                sIndex := FDBGrid.Columns[i].FieldName;
                Result := sIndex;
                Exit;
              end;
          end;
    end;

end;

function TfrmFind.GetYSF(sStr: string): string;
begin
  case cmbYSF.ItemIndex of
    0: Result := '=';
    1: Result := '>';
    2: Result := '<';
    3: Result := '>=';
    4: Result := '<=';
    5: Result := '<>';
  end;
end;

procedure TfrmFind.Button1Click(Sender: TObject);

begin
  if (lbAnd.Items.Count > 0) and (lbOr.Items.Count > 0) then begin
      if rbtAnd.Checked then
        sSqlText := '(' + sSqlTextAnd + ') And (' + sSqlTextOr + ')'
      else
        sSqlText := '(' + sSqlTextAnd + ') or (' + sSqlTextOr + ')'
    end else begin
      if sSqlTextAnd <> '' then
        sSqlText := sSqlTextAnd;
      if sSqlTextOr <> '' then
        sSqlText := sSqlTextOr;
    end;
    gsSQLText:=sSqlText;
  Close;
end;

procedure TfrmFind.rbtJJClick(Sender: TObject);
begin
  rbtBJ.Checked := False;
end;

procedure TfrmFind.rbtBJClick(Sender: TObject);
begin
  rbtJJ.Checked := False;
end;

procedure TfrmFind.btnAddClick(Sender: TObject);
begin
  if bIsTime then
    edtValue.Text := FormatDateTime('YYYY-MM-DD', dtpTime.Date);
  if rbtJJ.Checked then begin //交集
      lbAnd.Items.Add(Trim(cmbIndex.Text) + ' ' + Trim(cmbYSF.Text) + ' ' + Trim(edtValue.Text));
      if sSqlTextAnd = '' then begin
          if bIsTime then
            sSqlTextAnd := 'convert(char(10),' + GetFildName(Trim(cmbIndex.Text)) + ',121)' + GetYSF(Trim(cmbYSF.Text)) + QuotedStr(Trim(edtValue.Text))
          else
            sSqlTextAnd := 'convert(char(50),' + GetFildName(Trim(cmbIndex.Text)) + ')' + GetYSF(Trim(cmbYSF.Text)) + QuotedStr(Trim(edtValue.Text));
        end else begin
          if bIsTime then
            sSqlTextAnd := sSqlTextAnd + ' and ' + 'convert(char(10),' + GetFildName(Trim(cmbIndex.Text)) + ',121)' + GetYSF(Trim(cmbYSF.Text)) + QuotedStr(Trim(edtValue.Text))
          else
            sSqlTextAnd := sSqlTextAnd + ' and ' + 'convert(char(50),' + GetFildName(Trim(cmbIndex.Text)) + ')' + GetYSF(Trim(cmbYSF.Text)) + QuotedStr(Trim(edtValue.Text));
        end;
    end;
  if rbtBJ.Checked then begin //并集
      lbOr.Items.Add(Trim(cmbIndex.Text) + ' ' + Trim(cmbYSF.Text) + ' ' + Trim(edtValue.Text));
      if sSqlTextOr = '' then begin //sql为空
          if bIsTime then
            sSqlTextOr := 'convert(char(10),' + GetFildName(Trim(cmbIndex.Text)) + ',121)' + GetYSF(Trim(cmbYSF.Text)) + QuotedStr(Trim(edtValue.Text))
          else
            sSqlTextOr := 'convert(char(50),' + GetFildName(Trim(cmbIndex.Text)) + ')' + GetYSF(Trim(cmbYSF.Text)) + QuotedStr(Trim(edtValue.Text));
        end else begin
          if bIsTime then
            sSqlTextOr := sSqlTextOr + ' or ' + 'convert(char(10),' + GetFildName(Trim(cmbIndex.Text)) + ',121)' + GetYSF(Trim(cmbYSF.Text)) + QuotedStr(Trim(edtValue.Text))
          else
            sSqlTextOr := sSqlTextOr + ' or ' + 'convert(char(50),' + GetFildName(Trim(cmbIndex.Text)) + ')' + GetYSF(Trim(cmbYSF.Text)) + QuotedStr(Trim(edtValue.Text));
        end;
    end;
  edtValue.Text := '';
end;

procedure TfrmFind.cmbYSFKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_RETURN then
    if bIsTime then
      dtpTime.SetFocus
    else
      edtValue.SetFocus;
  if Key = VK_UP then //按向上键自动跳到上一输入控件
    cmbIndex.SetFocus;
end;

procedure TfrmFind.dtpTimeKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_RETURN then
    btnAddClick(Self);
  if (Key = VK_UP) or (Key = VK_LEFT) then //按向上键自动跳到上一输入控件
    cmbYSF.SetFocus;
end;

procedure TfrmFind.cmbIndexKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_RETURN then
    cmbYSF.SetFocus;
end;

procedure TfrmFind.cmbIndexChange(Sender: TObject);
begin
  bIsTime := (Pos('时间', cmbIndex.Text) > 0) or (Pos('日期', cmbIndex.Text) > 0);
  dtpTime.Visible := bIsTime;

end;

end.