uform_searchdata.pas

企业进销存管理系统

unit uForm_SearchData;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, ComCtrls, StdCtrls, Buttons, {Easysize,} TSGrid, Grids_ts,
  TSDBGrid, ExtCtrls, ComObj, Variants;


type
  TForm_SearchData = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    tsDBGrid1: TtsDBGrid;
    tsGrid1: TtsGrid;
    Panel3: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Animate1: TAnimate;
    DataSource1: TDataSource;
    Query1: TQuery;
    StatusBar1: TStatusBar;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    procedure tsGrid1ButtonClick(Sender: TObject; DataCol,
      DataRow: Integer);
    procedure StartSearch(Sender: TObject);
    procedure tsGrid1ComboGetValue(Sender: TObject; Combo: TtsComboGrid;
      GridDataCol, GridDataRow, ComboDataRow: Integer; var Value: Variant);
    procedure tsGrid1ComboDropDown(Sender: TObject; Combo: TtsComboGrid;
      DataCol, DataRow: Integer);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure tsDBGrid1DblClick(Sender: TObject);
    procedure Query1AfterOpen(DataSet: TDataSet);
    procedure tsGrid1CellEdit(Sender: TObject; DataCol, DataRow: Integer;
      ByUser: Boolean);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
  private
    FDataBaseName: string; //要搜寻的资料库名称
    FDataSet: TDBDataSet; //要搜寻的资料表（有可能是TTable 或是TQuery)
    FsearchField: array of Integer; //要搜寻的栏位值
    fkeyField: integer; //所搜寻的栏位前几位是KEY值
    FSql: string; //要搜寻的ＳＱＬ语法
    FReturn: TStrings; //要回传的key值
    FFieldType: array of char; //搜寻栏位的型态
    FFieldCount: integer; //要搜寻的栏位数目
    FFieldName: array of string; //要搜寻的栏位原始名称
    FFieldDisplayName: array of string; //要显示的栏位名称
    FSelRang: array of integer;   (* 选取的列印范围 *)
    FSelR: Boolean;               (* 选取的为记录范围(True), 还是栏位范围(False) *)
    procedure GetSQL;
    procedure SetSearchGrid;
    { Private declarations }
  public
    { Public declarations }
    procedure Exec(DataSet: TDBDataset;ikeyField:integer;SearchField: array of integer);
    property sReturn: TStrings read FReturn write FReturn;
    Property sDataSet: TDBDataSet read FDataSet write FDataSet;
    property sDataBaseName: string read FDataBaseName write FDataBaseName;
    (* 确认要列印的资料范围 *)
    procedure GetSelRang;
    (* Excel 列印程式*)
    procedure ExcelPrint(const Dataset: TDataSet; Excel_ID, s_title: String; SelR: Boolean; PField: array of integer);

  end;

procedure Search_Data(const DataSet: TDBDataSet;iKeyField:integer;sField: array of Integer);

var
  Form_SearchData: TForm_SearchData;

implementation

uses uCalendar, uSeaRep;

const
  iBool_Cell = 1;
  isearchField = 2;
  isearchKind = 3;
  iSearchValue = 4;

{ iISPrint_Cell = 1;
  iBool_Cell = 2;
  isearchField = 3;
  isearchKind = 4;
  iSearchValue = 5;  }


{$R *.DFM}

{KeyField必须包在搜寻的栏位内,也就是所搜寻的栏位必须要有KEY 的栏位名称,iKeyField表示搜寻的栏位前几位是KEY栏位}
procedure Search_Data(const DataSet: TDBDataSet;iKeyField:integer;sField: array of Integer);
begin
  if DataSet=nil then begin
    MessageBoxEx(application.handle,'请输入要查询的资料表名称','错误',MB_OK,SUBLANG_CHINESE_TRADITIONAL);
    exit;
  end;
  if High(sField)=0 then begin
    MessageBoxEx(application.handle,'请输入要查询的栏位编号','错误',MB_OK,SUBLANG_CHINESE_TRADITIONAL);
    exit;
  end;

  if iKeyField=0 then begin
    MessageBoxEx(application.handle,'请输入主键的栏位编号','错误',MB_OK,SUBLANG_CHINESE_TRADITIONAL);
    exit;
  end;

  Form_SearchData := TForm_SearchData.Create(Application);
  try
    Form_SearchData.Exec(DataSet,ikeyField,sField);
  finally
    Form_SearchData.Free;
  end;
end;

{ TForm_SearchData }


procedure TForm_SearchData.GetSelRang;
var
  i, nCol : integer;
  Bk : Variant;
begin
  (* 若没有进行选取, 等同於选取了全部栏位 , 要全部列印 *)
  if (tsDBGrid1.SelectedCols.Count = 0) and (tsDBGrid1.SelectedRows.Count = 0) then begin
     FSelR := False;    // 标志选取的为栏位范围
     SetLength(FSelRang, Query1.FieldCount);
     for i := 0 to Query1.FieldCount - 1 do FSelRang[i] := i;
     Exit;
   end;
  (* 若选取栏位列印范围 *)
  if (tsDBGrid1.SelectedCols.Count <> 0) then begin
     FSelR := False; // 标志选取的为栏位范围
     SetLength(FSelRang, tsDBGrid1.SelectedCols.Count);
     nCol:= tsDBGrid1.SelectedCols.First;
     FSelRang[0] := nCol-1;
     for i := 1 to tsDBGrid1.SelectedCols.Count-1 do begin
       nCol := tsDBGrid1.Selectedcols.Next(nCol);
       FSelRang[i] := nCol-1;
     end;
  end;
  (* 若选取记录列印范围 *)
  if (tsDBGrid1.SelectedRows.Count <> 0) then begin
     FSelR := True;  // 标志选取的为记录范围
     SetLength(FSelRang, tsDBGrid1.SelectedRows.Count);
     i := 0;
     Bk := tsDBGrid1.SelectedRows.First;
     While not VarIsEmpty(Bk) do begin
       Query1.Bookmark := Bk;
       FSelRang[i] := Query1.RecNo-1;
       Inc(i);
       Bk := tsDBGrid1.SelectedRows.Next(Bk);
     end;
  end;
end;



procedure TForm_SearchData.ExcelPrint(const Dataset: TDataSet; Excel_ID, s_title: String; SelR: Boolean; PField: array of integer);
var
  i, j : integer;
  ExcelFile : Variant;
begin
  if not dataset.active then begin
     beep;
     Application.MessageBox(PChar('对不起!没有资料可以列印!'),PChar('警告'),MB_ICONWARNING+MB_OK);
     exit;
  end;
  if Dataset.recordcount = 0 then begin
     beep;
     Application.MessageBox(PChar('对不起!没有资料可以列印!'),PChar('警告'),MB_ICONWARNING+MB_OK);
     exit;
  end;
  Screen.Cursor := crHourglass;
  Try
    ExcelFile := CreateOleObject(Excel_ID);
    ExcelFile.Visible := true;
    ExcelFile.WorkBooks.Add;
  Except
    Application.MessageBox(PChar('启动 Excel 时发生错误!'#13'无法将资料投入Excel!'),PChar('警告'),MB_ICONWARNING+MB_OK);
    exit;
  End;

  ExcelFile.Cells[1,1].value := s_title;

  With Dataset do begin
    First;
    if SelR then begin     (* 若选取了列印的记录范围 *)
       // 列印全部栏位名称:
       for i := 0 to FieldCount-1 do ExcelFile.Cells[3,i+1].value := Fields[i].DisplayLabel;
       // 列印出所选记录:
       DataSet.MoveBy(PField[0]);
       for j := 0 to Dataset.FieldCount-1 do ExcelFile.Cells[4,j+1].value := Fields[j].asstring;
       for i := 1 to High(PField) do begin
         DataSet.MoveBy(PField[i] - PField[i-1]);
         for j := 0 to Dataset.FieldCount-1 do ExcelFile.Cells[i+4,j+1].value := Fields[j].asstring;
       end;
    end
    else begin             (* 若选取了列印的栏位范围 *)
       // 列印选取的栏位名称:
       for i := 0 to High(PField) do ExcelFile.Cells[3,i+1].value := Fields[PField[i]].DisplayLabel;
       // 列印出所选栏位的所有记录:
       for i := 0 to RecordCount - 1 do begin
         for j := 0 to High(PField) do ExcelFile.Cells[i+4,j+1].value := Fields[PField[j]].asstring;
         Next;
       end;
    end;  // end of else
  end;    // end of with
  Screen.Cursor := crDefault;
end;




procedure TForm_SearchData.Exec(DataSet: TDBDataset;ikeyField:integer;SearchField: array of integer);
var
  iCount: integer;
begin
  //开始执行搜寻
  sDataSet := DataSet;
  SetLength(FSearchField,high(searchfield)+1);

  FFieldCount := high(searchField)+1;
  for iCount := 0 to FFieldCount-1 do
    FsearchField[iCount] := SearchField[iCount];

  fkeyField := ikeyField;

  Query1.DatabaseName := DataSet.DatabaseName;
  GetSQL; //取得ＳＱＬ语法
  SetSearchGrid; //设定要寻找的GRID环境
  showmodal;
end;


procedure TForm_SearchData.GetSQL;
var
  iCount: integer;
  iPos: integer;
  i2Pos: integer;
  sFrom: string;
  sSelect: string;
  sOldSQL: string;
begin
  SetLength(ffieldname,FFieldCount);
  SetLength(FFieldDisplayname,FFieldCount);
  SetLength(FFieldType,FFieldCount);

  sSelect := 'SELECT ';
  if sDataSet is TTable then begin
    sFrom := ' FROM '+TTable(sDataSet).TableName;
    //产生 select 的语法
    for iCount := 0 to FFieldCount-1 do begin
      sSelect := sSelect+TTable(sDataSet).Fields[fsearchfield[iCount]].FieldName+' as '+TTable(sDataSet).Fields[fsearchfield[iCount]].DisplayName+', ';
      FFieldName[iCount] := TTable(sDataSet).Fields[fsearchfield[iCount]].FieldName;
      FFieldDisplayName[iCount] := TTable(sDataSet).Fields[fsearchfield[iCount]].DisplayName;
      case TTable(sDataSet).Fields[fsearchfield[iCount]].DataType  of
        ftdatetime :          FFieldType[iCount] := 'D';
        ftString:         FFieldType[ICount] := 'S';
        ftInteger,ftFloat:FFieldType[ICount] := 'I';
        else
          FFieldType[iCount] := 'N';
      end;//end of case
    end;
  end else
  begin
    sOldSQL := UpperCase(Trim(TQuery(sDataSet).SQL.Text));

    iPos := pos('FROM',sOldSQL);

    if iPos<0 then begin
      MessageBoxEx(application.handle,'给定的TQuery元件 SQL 语法错误','错误',MB_OK,SUBLANG_CHINESE_TRADITIONAL);
      exit;
    end;

    i2Pos := pos('ORDER',sOldSQL);