fmsearchu.pas

小型库存管理,希望有帮助,小型库存管理,希望有帮助

//**********************************************
//  标准查询画面
// 输入参数说明
//   --UTableName 查询表名
//   --UFilterSQL 查询过滤条件
//   --UFieldName 查询结果的字段名
// 输出参数说明
//   --USQL       返回查询条件
//   --UValue     返回单个字段值
//
// 数据字典 Ts_Columns
// 用到字段说明
//  --fColName     字段英文说明
//  --fColCaption  字段中文说明
//  --fIsRequire   0不显示；1显示查询下拉框; 2显示查询下拉框&DBGrid;3显示DBGrid
//

unit FmSearchU;

interface

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

type
  WNField = record
    FieldName: string[255];     //字段英文
    FieldShowName: string[255]; //字段中文
    FieldType: Integer;        //字段类型
    FieldGut: string;          //字段查询值
  end;

  TFmSearch = class(TForm)
    dsSQL: TDataSource;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Panel4: TPanel;
    Notebook1: TNotebook;
    Label1: TLabel;
    Label2: TLabel;
    Label7: TLabel;
    idtFieldList: TComboBox;
    idtValue: TEdit;
    idtNormalDate: TDateTimePicker;
    idtNormalNum: TMaskEdit;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    idtWhere: TComboBox;
    idtField: TComboBox;
    idtQ: TComboBox;
    idtStr: TEdit;
    idtNum: TMaskEdit;
    idtDate: TDateTimePicker;
    GroupBox2: TGroupBox;
    ListBox_Term: TListBox;
    GroupBox3: TGroupBox;
    Panel5: TPanel;
    Panel3: TPanel;
    FDBGrid: TDBGrid;
    QrySQL: TADOQuery;
    QryCol: TADOQuery;
    QryTable: TADOQuery;
    MyTable: TADOTable;
    btnType: TBitBtn;
    btnNO: TBitBtn;
    btnOK: TBitBtn;
    btnValue: TBitBtn;
    btnAdd: TBitBtn;
    btnDel: TBitBtn;
    MsgMemo: TMemo;
    btnMsg: TBitBtn;
    procedure btnOKClick(Sender: TObject);
    procedure btnNOClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnValueClick(Sender: TObject);
    procedure btnTypeClick(Sender: TObject);
    procedure idtFieldChange(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure idtFieldListChange(Sender: TObject);
    procedure FDBGridDblClick(Sender: TObject);
    procedure idtNormalNumKeyPress(Sender: TObject; var Key: Char);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnMsgClick(Sender: TObject);
  private
    { Private declarations }
    FSQL,FFilterSQL,FValue,FTableName,FFieldName,FUser :string ;
    FField,DField,FAdvSQL,FrefSQL :TStringList;
    FFieldInf: array of WNField;
    function GetFieldType(FieldName: string): Integer;
    procedure InitAdv ;
  public
    { Public declarations }
    property  UFilterSQL :string read FFilterSQL write FFilterSQL ;  //过滤SQL语句
    property  UTableName :string read FTableName write FTableName ; //查询表名
    property  UFieldName :string read FFieldName write FFieldName ; //查询表名
    property  USQL :string read FSQL write FSQL ;  //返回查询SQL语句
    property  UUser :string read FUser write FUser ;   //当前查询用户
    property  UValue :string read FValue write FValue ;//查询返回单个值
  end;

var
  FmSearch: TFmSearch;

implementation

{$R *.DFM}

uses FMDBU ;

{取字段类型}
function TFmSearch.GetFieldType(FieldName: string): Integer;
begin
  Result :=0 ; 
  QryTable.Active :=False ;
  if QryTable.SQL.Text <> '' then
  begin
    QryTable.Open;
    try
      case QryTable.FieldByName(FieldName).DataType of
        ftString, ftMemo, ftFmtMemo, ftFixedChar, ftWideString:
          begin
            Result := 1; //字符型 1
          end;
        ftSmallint, ftInteger, ftWord,
          ftAutoInc, ftLargeInt, ftArray:
          begin
            Result := 2; //整型2
          end;
        ftFloat, ftCurrency, ftBCD:
          begin
            Result := 3; //浮点型（含货币型）3
          end;
        ftDate, ftDateTime:
          begin
            Result := 4; //日期时间型4
          end;
      else
        begin
          Result := 0; //其他未知
        end;

      end;
    except
      showmessage(Format('字段%s不存在!', [FieldName]));
    end;
  end
  else
  begin
    showmessage('表不能为空!');
  end;
  QryTable.Active :=False ; 
end;

{初始化画面}
procedure TFmSearch.InitAdv ;
var
   i:integer;
   TmpName: string;
   IsPos: Integer;
begin
   idtNormalDate.Left :=idtValue.Left ;
   idtNormalDate.Top :=idtValue.Top ;
   idtNormalNum.Left :=idtValue.Left ;
   idtNormalNum.Top :=idtValue.Top ;
   idtNum.Left :=idtStr.Left ;
   idtNum.Top :=idtStr.Top ;
   idtDate.Left :=idtStr.Left ;
   idtDate.Top :=idtStr.Top ;
   idtWhere.ItemIndex :=0 ;
   idtQ.ItemIndex :=0 ;
   FField := TStringList.Create;
   DField := TStringList.Create ;
   FAdvSQL :=TStringList.Create ;
   MyTable.TableName := FTableName ;
   MyTable.GetFieldNames(FField);
   QryCol.Active :=False ;
   QryCol.Active :=True ;
   if QryCol.Eof then
    begin
     messagedlg('数据字典为空',mtWarning,[mbOK],0);
     exit ;
    end ;
   QryTable.SQL.Clear ;
   QryTable.SQL.Text :='select * from '+FTableName ;
   for i:=0 to FField.Count -1 do
    begin
      if QryCol.Locate('fTableName;fColName',VarArrayOf([FTableName,FField.Strings[i]]),[loPartialKey]) then
       begin
          if (QryCol.fieldByName('fIsRequire').AsInteger=1) or (QryCol.fieldByName('fIsRequire').AsInteger=2) then
              DField.Add(QryCol.FieldByName('fColCaption').AsString+'#'+QryCol.FieldByName('fColName').AsString);
          if (QryCol.fieldByName('fStatus').AsInteger>=1) then
             FAdvSQL.Add(QryCol.FieldByName('fColCaption').AsString+'#'+QryCol.FieldByName('fColName').AsString);
          FrefSQL.Add(QryCol.FieldByName('fStatus').AsString);
       end ;
    end ;

   for i:=0 to FAdvSQL.Count -1 do
    begin
      TmpName :=FAdvSQL[i];
      IsPos :=pos('#',TmpName);
      FDBGrid.Columns.Add;
      FDBGrid.Columns.Items[i].FieldName:=copy(TmpName, (IsPos + 1), Length(TmpName));
      FDBGrid.Columns.Items[i].Alignment:=taLeftJustify;
      FDBGrid.Columns.Items[i].Title.Caption:=copy(TmpName, 1, (IsPos - 1));
    end ;
   FAdvSQL.Clear ;

   if DField.Count <= 0 then
    begin
     messagedlg('数据字典中没有该表:'+FTableName+'的字段定义.',mtWarning,[mbOK],0);
     exit ;
    end ;
   SetLength(FFieldInf, (DField.Count));
   idtField.Clear ;
   for i := 0 to (DField.Count - 1) do
   begin
    TmpName := DField[i];
    IsPos := pos('#', TmpName);
    if IsPos <> 0 then
    begin
      FFieldInf[i].FieldShowName := copy(TmpName, 1, (IsPos - 1));
      FFieldInf[i].FieldName := copy(TmpName, (IsPos + 1), Length(TmpName));
    end
    else
    begin
      FFieldInf[i].FieldShowName := TmpName;
      FFieldInf[i].FieldName := TmpName;
    end;
    FFieldInf[i].FieldType := GetFieldType(FFieldInf[i].FieldName);
    idtField.Items.Add (FFieldInf[i].FieldShowName);
    idtFieldList.Items.Add(FFieldInf[i].FieldShowName);
   end;
  idtField.ItemIndex :=0 ;
  idtFieldChange(nil);
  ListBox_Term.Clear ;
end ;


procedure TFmSearch.btnOKClick(Sender: TObject);
begin
  if (FFieldName<>'') and (QrySQL.Active) then
      UValue :=QrySQL.fieldByName(FFieldName).AsString ;
  ModalResult := mrOK;
end;

procedure TFmSearch.btnNOClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TFmSearch.FormShow(Sender: TObject);
begin
   FUser:='LI';
   FDBGrid.Columns.Clear;
   idtStr.Text :='';
   FrefSQL :=TStringList.Create ; 
   InitAdv ;
end;

{查询}
procedure TFmSearch.btnValueClick(Sender: TObject);
var
  i :integer;
  SQL : string ;
begin
  QrySQL.Active :=False ;
  QrySQL.SQL.Clear ;
  case Notebook1.PageIndex of
   0:begin
     SQL :='';
     if idtFieldList.Text <>'' then
      begin
       SQL :=SQL + ' and '+ FFieldInf[idtFieldList.ItemIndex].FieldName+'=' ;
       case FFieldInf[idtFieldList.ItemIndex].FieldType of
        1 :  begin
              if trim(idtValue.Text)='' then exit ;
              SQL :=SQL + #39+idtValue.Text+#39;
             end ;
        2,3: begin
              if trim(idtNormalNum.Text)='' then exit ;
              SQL :=SQL + idtNormalNum.Text ;
             end ;
        4 :  SQL :=SQL + '#'+DateToStr(idtNormalDate.Date)+'#';
       end ;
      end ;
      if FFilterSQL<>'' then SQL :=SQL + FFilterSQL ;
      QrySQL.SQL.Text :=' select * from ' + UTableName
            + ' where 1=1 ' + SQL ;
    end ;
  1:begin
     for i:=0 to FAdvSQL.Count -1 do
       SQL :=SQL + FAdvSQL.Strings[i];
     if FFilterSQL<>'' then SQL :=SQL + FFilterSQL ;
       QrySQL.SQL.Text :=' select * from ' + UTableName
             + ' where 1=1 ' + SQL ;
    end ;
  end ;
  FSQL := SQL ;
  QrySQL.Active :=True ;
end;

procedure TFmSearch.btnTypeClick(Sender: TObject);
begin
  case btnType.Tag of
   0:begin
      Notebook1.PageIndex :=1 ;
      btnType.Caption :='一般查询';
      btnType.Tag :=1 ;
     end;
   1:begin
      Notebook1.PageIndex :=0 ;
      btnType.Caption :='高级查询';
      btnType.Tag :=0 ;
     end ;
  end ;
end;

procedure TFmSearch.idtFieldChange(Sender: TObject);
begin
 if idtField.Text <>'' then
  begin
    case FFieldInf[idtField.ItemIndex].FieldType of
     1: begin
         idtStr.Visible :=True ;
         idtNum.Visible :=False ;
         idtDate.Visible :=False ;
         if idtQ.Items.IndexOf('like')=-1 then
            idtQ.Items.Add('like');
        end ;
    2,3:begin
         idtStr.Visible :=False ;
         idtNum.Visible :=True ;
         idtDate.Visible :=False ;
         if idtQ.Items.IndexOf('like')>-1 then
            idtQ.Items.Delete(idtQ.Items.IndexOf('like'));
        end ;
     4: begin
         idtStr.Visible :=False ;
         idtNum.Visible :=False ;
         idtDate.Visible :=True ;
         if idtQ.Items.IndexOf('like')>-1 then
            idtQ.Items.Delete(idtQ.Items.IndexOf('like'));
        end ;
    end ; 
  end ;
  idtField.Tag :=FFieldInf[idtField.ItemIndex].FieldType ;

  //增加注释
  MsgMemo.Lines.Clear ;
  if QryCol.Locate('fTableName;fColName',VarArrayOf([FTableName,FFieldInf[idtField.ItemIndex].FieldName]),[loPartialKey]) then
   begin
     MsgMemo.Lines.Add(QryCol.fieldByname('fMemo').AsString);
  end ;
end;

{高级查询-添加}
procedure TFmSearch.btnAddClick(Sender: TObject);
var
 strESQL,strCSQL :string ;
begin
 if idtField.Text='' then exit ; 
 //1.先验证值
 strESQL :='';
 strCSQL :='';
 case  idtWhere.ItemIndex of
  0: strESQL :=strESQL +  ' and ' ;
  1: strESQL :=strESQL +  ' or ' ;
 end ;
 strCSQL :=strCSQL+idtWhere.Text +' '+idtField.Text ;
 case idtQ.ItemIndex of
  0: strCSQL :=strCSQL + ' 等于 ';
  1: strCSQL :=strCSQL + ' 不等于 ';
  2: strCSQL :=strCSQL + ' 大于 ';
  3: strCSQL :=strCSQL + ' 大于等于 ';
  4: strCSQL :=strCSQL + ' 小于 ';
  5: strCSQL :=strCSQL + ' 小于等于 ';
  6: strCSQL :=strCSQL + ' 包含 ';
 end ; 
 strESQL :=strESQL + FFieldInf[idtField.ItemIndex].FieldName +' '+ idtQ.Text +' ';

 case idtField.Tag of
   1: begin
       if trim(idtStr.Text)='' then
        begin
         messagedlg('请输入查询字符值',mtWarning,[mbOK],0);
         exit ;
        end ;
      if idtQ.ItemIndex<>6 then
         strESQL :=strESQL + #39+idtStr.Text +#39
      else
         strESQL :=strESQL +#39+'%'+idtStr.Text+'%'+#39 ;
      strCSQL :=strCSQL +idtStr.Text ;
      end ;
  2,3: begin
       if trim(idtNum.Text)='' then
        begin
         messagedlg('请输入查询数值',mtWarning,[mbOK],0);
         exit ;
        end ;
      strESQL :=strESQL + idtNum.Text ;
      strCSQL :=strCSQL +idtNum.Text ;
      end ;
   4: begin
      strESQL :=strESQL + '#'+DateToStr(idtDate.date) +'#' ;
      strCSQL :=strCSQL +DateToStr(idtDate.Date);
      end  ;
 end ;
 //2 加入SQL语句
 ListBox_Term.Items.Add(strCSQL);
 FAdvSQL.Add(strESQL);
end;

{高级查询-删除}
procedure TFmSearch.btnDelClick(Sender: TObject);
var
  I: Integer;
begin
  for I := ListBox_Term.Items.Count - 1 downto 0 do
    if ListBox_Term.Selected[I] then
     begin
      ListBox_Term.Items.Delete(I);
      FAdvSQL.Delete(I);
     end ;
end;

{切换查询字段}
procedure TFmSearch.idtFieldListChange(Sender: TObject);
var
  SQL :string ;
begin
 if idtFieldList.Text <>'' then
  begin
    case FFieldInf[idtFieldList.ItemIndex].FieldType of
     1: begin
         idtValue.Visible :=True ;
         idtNormalNum.Visible :=False ;
         idtNormalDate.Visible :=False ;
        end ;
    2,3:begin
         idtValue.Visible :=False ;
         idtNormalNum.Visible :=True ;
         idtNormalDate.Visible :=False ;
        end ;
     4: begin
         idtValue.Visible :=False ;
         idtNormalNum.Visible :=False ;
         idtNormalDate.Visible :=True ;
        end ;
    end ;
   SQL :=FrefSQL.Strings[idtFieldList.ItemIndex] ;

   //增加注释
   MsgMemo.Lines.Clear ;
   if QryCol.Locate('fTableName;fColName',VarArrayOf([FTableName,FFieldInf[idtFieldList.ItemIndex].FieldName]),[loPartialKey]) then
    begin
      MsgMemo.Lines.Add(QryCol.fieldByname('fMemo').AsString);
    end ;
  end ;
end;

procedure TFmSearch.FDBGridDblClick(Sender: TObject);
begin
  if (FFieldName<>'') and (QrySQL.Active) then
   begin
     UValue :=QrySQL.fieldByName(FFieldName).AsString ;
     btnOKClick(self);
   end ;
end;

procedure TFmSearch.idtNormalNumKeyPress(Sender: TObject; var Key: Char);
begin
  if not(key in ['0'..'9','.','(',')','-']) AND (KEY <> #8) then
  begin
    key := #0;
  end;
end;

procedure TFmSearch.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key=27 then
  begin
    ModalResult := mrCancel;
    close ;
  end ;

end;

procedure TFmSearch.FormCreate(Sender: TObject);
begin
 idtNormalDate.Date :=Date();
 idtDate.Date :=Date();
end;

procedure TFmSearch.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  QryCol.Active :=False ;
end;

{显示注释}
procedure TFmSearch.btnMsgClick(Sender: TObject);
begin
  MsgMemo.Visible :=not MsgMemo.Visible ;
end;

end.