umasterdetailsearch.pas

企业进销存管理系统

unit uMasterDetailSearch;

interface

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


type
  TMasterDetailSearch = 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;
    Splitter1: TSplitter;
    FormResizer1: TFormResizer;
    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);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    FDataBaseName: string; //要搜寻的资料库名称
    FDataSet: TDBDataSet; //要搜寻的资料表
    FDetailDataSet: TDBDataSet;//要搜寻的明细档资料表

    FsearchField: array of Integer; //master 资料表要搜寻的栏位值
    FDetailSearchField: array of integer;//detail 资料表要搜寻的栏位值

    FMaster_DisPlay_Field: array of integer;//master要显示出搜寻结果的栏位值
    FDetail_DisPlay_Field: array of integer;//Detail要显示出搜寻结果的栏位值

   //============================  write by JEFF  2002.10.16===================
    FLookUpData : array of string; //要LookUp的 资料表，如有原料编号就带出原料名称等--['T_Cust','T_Material'];
    FLookUpPurposeFields : array of string;  // 要LookUp的 资料表栏位;
    FLookUpVisibleFields:array of string; // 要LookUp的 资料表显示栏位;
    FLookUpVisibleName : array of string;   // 要LookUp的 资料表显示栏位名称;
    FLookUpSourceFields :array of string;//要通过来源档的哪些栏位进行查找栏位如：通过进料单的厂商编号查找厂商名称--通过主档为如：M.F01，明细 D.F01---['M.F01','D.F01,D.F02'];
  //===============================================================

    FSql: string; //要搜寻的ＳＱＬ语法
    FFieldType: array of char; //搜寻栏位的型态
    FMFieldCount: integer; //要搜寻的栏位数目
    FDFieldCount: integer;// 要搜寻的detail栏位数
    FFieldName: array of string; //要搜寻的栏位原始名称
    FFieldDisplayName: array of string; //要显示的栏位名称
    FSelRang: array of integer;   (* 选取的列印范围 *)
    FSelR: Boolean;               (* 选取的为记录范围(True), 还是栏位范围(False) *)
    FOtherWhere: string;//在做搜寻时其他的条件值
    FKeyValue: TstringList;//要将资料表取回的时,需要用到的栏位
    procedure GetSQL;
    procedure SetSearchGrid;
    procedure GetSQLEx;
    procedure InitialSearchField;
    function Get_From_Sentence: string;
    { Private declarations }
  public
    { Public declarations }
    procedure Exec(MDataSet: TDBDataset;MSearchField: array of integer;DDataSet: TDBDataset;DSearchField,iMDisField_List,iDDisField_List: array of integer;sOtherWhere: string;LookUpData,LookUpPurposeFields,LookUpVisibleFields,LookUpVisibleName,LookUpSourceFields :array of string);
    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_MasterDetailEx(const MDataSet: TDBDataSet;sMField: array of Integer;const DDataSet: TDBDataSet;sDField,iMDisField_List,iDDisField_List: array of Integer;LookUpData,LookUpPurposeFields,LookUpVisibleFields,LookUpvisibleName,LookUpSourceFields :array of string;sOtherWhere: string='');
 // procedure Search_MasterDetail(const MDataSet: TDBDataSet;sMField: array of Integer;const DDataSet: TDBDataSet;sDField: array of Integer;sOtherWhere: string='');

var
  MasterDetailSearch: TMasterDetailSearch;
  PubFieCount : integer;
implementation
{$DEFINE TEST}


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;  }
  TestSQLOutput = 'C:\WINNT\Profiles\Administrator.000\「开始」功能表\';

{$R *.DFM}
procedure Search_MasterDetailEx(const MDataSet: TDBDataSet;sMField: array of Integer;const DDataSet: TDBDataSet;sDField,iMDisField_List,iDDisField_List: array of Integer;LookUpData,LookUpPurposeFields,LookUpVisibleFields,LookUpVisibleName,LookUpSourceFields :array of string;sOtherWhere: string='');
begin
  if MDataSet=nil then begin
    MessageBoxEx(application.handle,'请输入要查询的资料表名称','错误',MB_OK,SUBLANG_CHINESE_TRADITIONAL);
    exit;
  end;
  if High(sMField)=0 then begin
    MessageBoxEx(application.handle,'请输入要查询的栏位编号','错误',MB_OK,SUBLANG_CHINESE_TRADITIONAL);
    exit;
  end;

  MasterDetailSearch := TMasterDetailSearch.Create(Application);
  try
    MasterDetailSearch.Exec(MDataSet,sMField,DDataSet,sDField,iMDisField_List,iDDisField_List,sOtherWhere,LookUpData,LookUpPurposeFields,LookUpVisibleFields,LookUpVisibleName,LookUpSourceFields);
  finally
    MasterDetailSearch.Free;
  end;

end;

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

  MasterDetailSearch := TMasterDetailSearch.Create(Application);
  try
    MasterDetailSearch.Exec(MDataSet,sMField,DDataSet,sDField,[],[],sOtherWhere);
  finally
    MasterDetailSearch.Free;
  end;
end;   }

{ TForm_SearchData }


procedure TMasterDetailSearch.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 TMasterDetailSearch.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 TMasterDetailSearch.Exec(MDataSet: TDBDataset;MSearchField: array of integer;DDataSet: TDBDataset;DSearchField,iMDisField_List,iDDisField_List: array of integer;sOtherWhere: string;LookUpData,LookUpPurposeFields,LookUpVisibleFields,LookUpVisibleName,LookUpSourceFields :array of string);
var
  iCount: integer;
begin
  //开始执行搜寻
  FOtherWhere := sOtherWhere;
  sDataSet := MDataSet;
  FDetailDataSet := DDataSet;

 //============================  write by JEFF  2002.10.17===================

  SetLength(FLookUpData,high(LookUpData)+1);   //将要LookUp的资料表储存
  for iCount := 0 to high(LookUpData) do
    FLookUpData[iCount] := LookUpData[iCount];

  SetLength(FLookUpPurposeFields,high(LookUpPurposeFields)+1);   //将要LookUp的资料表栏位储存