ufrm_level4_2.pas

来自「完整的进销存系统。 设计文件及完整的源代码。 Delphi6.0」· PAS 代码 · 共 1,010 行 · 第 1/2 页

//  *******************************************
//  *    Program name: pattern ufrm_level4_2  *
//  *    AUTHOR      : Guo xuliang 郭许良     *
//  *    Date        : 2005/05/15             *
//  *    Purpose     :公共模板第四层          *
//  *******************************************


//雙檔維護模板(MASTER) 使用ROWID
//==========================================
//設置項目﹕
//1.放入for 查詢的query1.
//2.放入qy_master,ds_master;qy_detail,ds_detail,設置dbGrid的DATASOURCE.
//3.編寫,取得要操作的table的函數
//4.各個按鈕的功能
//............................

//=================================
//TABLE 的創建注意事項
//1.master file必須包含 'ID' NUMBER(6)       //KEY FIELD
//                      ACTI VARCHAR2(1)
//                      OWUS VARCHAR2(10)
//                      GRUP VARCHAR2(10)
//                      CRET DATE
//                      MODU VARCHAR2(10)
//                      MODT DATE
//2.('A','新增');
//  ('U','修改');
//  ('Y','確認');
//  ('Z','反確認');
//  ('O','列印');
//  ('R','刪除');
//  ('S','確認2');
//  ('W','反確認2');
//  ('G','發送');
//  ('I','發出還原');
//  ('F','過濾')

//3.查詢初試化(可以查詢master&detail)
//INSERT INTO CZ_FILE  VALUES ('TESTD_FILE', 'A.F01', 'MKEY1', 'C', 0,NULL,1,'Y');
//INSERT INTO CZ_FILE  VALUES ('TESTD_FILE', 'B.F01', 'DKEY1', 'C', 0,NULL,4,'Y');
//=================================
//調用注意事項:
//      1.prog           //程序名稱
//      2.master         //主表名稱
//      3.detail         //Detail table name
//      4.mpkey:array[1..10] of string;   //多層master_detail時master父表關鍵字段
//      5.mpvalue:array[1..10] of string; //master父表的關鍵字段的值
//      6.mkey:array[1..10] of string;    //master key
//      7.dkey:array[1..10] of string;    //Detail key
//      8.qtable:string;                  //查詢用的TABLE表名

//需要override的函數﹕
//    function  chk_save:boolean; virtual;  //保存前的檢查
//    function  chk_conf:boolean; virtual;  //確認前的檢查
//=================================================
    //要根據情況編寫可以再改進
//    procedure set_Focus;        virtual;  //設置焦點
//    procedure chg_canwrite;     virtual;  //設置關鍵字為可寫
//    procedure chg_Readonly;     virtual;  //設置關鍵字為只讀
//    procedure call_detail;      virtual;  //調用單身維護
//  把錯誤信息存放到 u_error中.

//另外還可以根據需要編寫另外的過程或者函數:
//    procedure before_delete;
//    function  chk_before_delete:boolean;
//    等等﹐現在沒有編寫以后需要時再編寫

//多層關聯刪除時應考慮用trigger因為程序只能刪除兩層.
//==========================================

//存在的問題使用id
//1.刷新時﹐到最后一條記錄會跑到第一條記錄.
//2.新增加記錄后馬上進行(update,confirm,detail)不能進行操作必須刷新
//  (取不到id)
//修改使用key後問題解決.


unit ufrm_level4_2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ufrm_level3_2, dxExEdtr, ImgList, dxCntner, dxTL, dxDBCtrl,
  dxDBGrid, ExtCtrls, ComCtrls, ToolWin, DB, DBTables, StdCtrls, Menus;

type
  Tfrm_level4_2 = class(Tfrm_level3_2)
    Query1: TQuery;
    qy_master: TQuery;
    ds_master: TDataSource;
    qy_detail: TQuery;
    ds_detail: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure tbExitClick(Sender: TObject);
    procedure tbAddClick(Sender: TObject);
    procedure tbEditClick(Sender: TObject);
    procedure tbDeleteClick(Sender: TObject);
    procedure tbDetailClick(Sender: TObject);
    procedure tbFirstClick(Sender: TObject);
    procedure tbPriorClick(Sender: TObject);
    procedure tbNextClick(Sender: TObject);
    procedure tbLastClick(Sender: TObject);
    procedure tbRefreshClick(Sender: TObject);
    procedure tbFilterClick(Sender: TObject);
    procedure tbQueryClick(Sender: TObject);
    procedure tbSaveClick(Sender: TObject);
    procedure tbUnsaveClick(Sender: TObject);
    procedure tbConfirmClick(Sender: TObject);
    procedure tbUnconfirmClick(Sender: TObject);
    procedure tbPrintClick(Sender: TObject);
    procedure tbExcelClick(Sender: TObject);
    procedure tbHelpClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure qy_masterBeforeEdit(DataSet: TDataSet);
    procedure qy_masterNewRecord(DataSet: TDataSet);
    procedure Query1AfterOpen(DataSet: TDataSet);
    procedure qy_masterAfterPost(DataSet: TDataSet);
  private
    { Private declarations }
    function  parse_01:string;          //解析_01 join 條件
    function  parse_02:string;          //解析_02 master的過濾
    function  parse_03:string;          //解析_03 :關聯
    function  parse_04:string;          //解析_04:unique檢查
    function  parse_05:string;          //解析_05選擇串
    procedure assign_query;             //get mkey value form query1;
    procedure assign_master;            //get mkey value from master;
    function  parse_06:string;          //parse select condition(master's)
    function  keyis_null:boolean;       //master's key is null
  protected
    u_mpkey:array[1..10] of string;    //master的父親的字段
    u_mpvalue:array[1..10] of string;  //master的父親值
    u_mkey:array[1..10] of string;     //master的key
    u_dkey:array[1..10] of string;     //Detail的key

    u_rowid:string;                    //rowid

    u_master:string;                   //主表名稱
    u_detail:string;                   //輔表名稱

    u_pfilter:string;                  //父表的過濾
    u_join:string;                     //join條件
    u_filter:string;                   //過濾條件
    u_wc:string;                       //查詢條件
    u_dfilter:string;                  //detail的過濾條件

    u_order:string;                    //排序字段(no use)

    u_qtable:string;                   //用戶傳遞查詢表的變量

    u_oldkeyvalue:array[1..10]of string;//舊的關鍵字段值
    u_keyvalue:array[1..10] of string;  //key value
    u_error:string;                    //錯誤信息
    u_bookmark:pointer;                //當前位置
    procedure refresh_all;             //刷新
    procedure refresh_master;          //刷新單頭
    procedure refresh_detail;          //刷新單身
    procedure refresh_query;           //刷新query
    procedure navistatus;              //導航條狀態
    function  chk_acti:boolean;    //檢查是否已經確認
    function  chk_unique:boolean;  //檢查關鍵字是否重復
    //================================================
    function  chk_save:boolean; virtual;  //保存前的檢查
    function  chk_conf:boolean; virtual;  //確認前的檢查
    procedure set_Focus;        virtual;  //設置焦點
    procedure chg_canwrite;     virtual;  //設置關鍵字為可寫
    procedure chg_Readonly;     virtual;  //設置關鍵字為只讀
    procedure call_detail;      virtual;  //調用單身維護

  public
    { Public declarations }
  end;

var
  frm_level4_2: Tfrm_level4_2;

implementation
uses udm,uglobal_fun,uglobal_var, ufrm_filter1,ufrm_sql;
{$R *.dfm}
//***********************************************
function Tfrm_level4_2.chk_save:boolean;
begin
  result:=true;
end;

function Tfrm_level4_2.chk_conf:boolean;
begin
  result:=true;
end;

procedure Tfrm_level4_2.set_Focus;
begin
;
end;

procedure Tfrm_level4_2.chg_canwrite;
begin
;
end;

procedure Tfrm_level4_2.chg_Readonly;
begin
;
end;

procedure Tfrm_level4_2.call_detail;
begin
;
end;

//***********************************************
function Tfrm_level4_2.parse_01:string;
var i:integer;
begin
//for oracle
{
   result:=' (';
   for i:=1 to 10 do
     begin
       if u_mkey[i]<>'' then
          result:=result+' A.'+u_mkey[i]+'=B.'+u_dkey[i]+'(+) AND'
     end;
   result:=copy(result,1,length(result)-3);
   result:=result+')';
}
//for sqlserver
   result:=' (';
   for i:=1 to 10 do
     begin
       if u_mkey[i]<>'' then
          result:=result+' A.'+u_mkey[i]+'=B.'+u_dkey[i]+' AND' //need change 需要修改为sqlserver的外连接
     end;
   result:=copy(result,1,length(result)-3);
   result:=result+')';
end;
//old
//function Tfrm_level4_2.parse_02:string;
//var i:integer;
//begin
//  result:='';
//  for i:=1 to 10 do
//    begin
//     if u_mpkey[i]<>'' then
//        result:=result+' A.'+u_mpkey[i]+'='''+u_mpvalue[i]+''' AND';
//    end;
//  result:=copy(result,1,length(result)-3);
//  result:=trim(result);
//  if result='' then
//    result:=' 1=1 ';
//end;

function Tfrm_level4_2.parse_02:string;
var i:integer;
begin
  result:='';
  for i:=1 to 10 do
    begin
     if (u_mpkey[i]<>'') and (u_mpvalue[i]<>'') then
        result:=result+' A.'+u_mpkey[i]+'='''+u_mpvalue[i]+''' AND';
    end;
  result:=copy(result,1,length(result)-3);
  result:=trim(result);
  if result='' then
    result:=' 1=1 ';
end;

function Tfrm_level4_2.parse_03:string;
var i:integer;
begin
  result:='';
  for i:=1 to 10 do
    begin
      if u_mkey[i]<>'' then
        result:=result+' '+u_dkey[i]+'=:'+u_mkey[i] +' AND';
    end;
  result:=copy(result,1,length(result)-3);
end;

function Tfrm_level4_2.parse_04:string;
var i:integer;
begin
  result:='';
  for i:=1 to 10 do
    begin
      if u_mkey[i]<>'' then
        result:=result+' '+u_mkey[i]+'='''
          +qy_master.fieldbyname(u_mkey[i]).AsString+''' AND';
    end;
  result:=copy(result,1,length(result)-3);
end;


function Tfrm_level4_2.parse_05:string;
var i:integer;
begin
  result:=' ';
  for i:=1 to 10 do
    begin
      if u_mkey[i]<>'' then
        result:=result+'A.'+u_mkey[i]+','
    end;
  result:=' '+copy(result,1,length(result)-1)+' ';
end;

procedure Tfrm_level4_2.assign_query;
var i:integer;
begin
  for i:=1 to 10 do
    begin
      if u_mkey[i]<>'' then
        u_keyvalue[i]:=query1.fieldbyname(u_mkey[i]).AsString;
    end;
end;

procedure Tfrm_level4_2.assign_master;
var i:integer;
begin
  for i:=1 to 10 do
    begin
      if u_mkey[i]<>'' then
        u_keyvalue[i]:=qy_master.fieldbyname(u_mkey[i]).AsString;
    end;
end;

function Tfrm_level4_2.parse_06;//parse qy_master's condition
var i:integer;
begin
  result:='';
  for i:=1 to 10 do
    begin
      if u_mkey[i]<>'' then
         result:=result+u_mkey[i]+'='''+u_keyvalue[i]+''' AND ';
    end;
  result:=' '+copy(result,1,length(result)-4)+' ';
end;

function Tfrm_level4_2.keyis_null;
var i:integer;
begin
  result:=false;
  for i:=1 to 10 do
    begin
      if u_mkey[i]<>'' then
         if u_keyvalue[i]='' then result:=true;
    end;
end;
//=================================================
procedure Tfrm_level4_2.navistatus;
begin
  tbfirst.Enabled:=true;
  tbprior.Enabled:=true;
  tbnext.Enabled:=true;
  tblast.Enabled:=true;
  if query1.Bof and query1.Eof then
    begin
      tbfirst.Enabled:=false;
      tbprior.Enabled:=false;
      tbnext.Enabled:=false;
      tblast.Enabled:=false;
    end
  else if query1.Bof then
    begin
      tbfirst.Enabled:=false;
      tbprior.Enabled:=false;
    end
  else if query1.Eof then
    begin
      tbnext.Enabled:=false;
      tblast.Enabled:=false;
    end;
end;

procedure Tfrm_level4_2.refresh_all;
begin
  //use id
  {g_sqlstr:='SELECT DISTINCT A.ID FROM '+u_master+' A,'+
            u_detail+' B WHERE '+u_join+' AND ('+u_pfilter+')'
            +' AND ('+u_filter+') AND ('+u_wc+')'+
            ' ORDER BY A.ID';}//id
  //for oracle
  {g_sqlstr:='SELECT DISTINCT'+parse_05+' FROM '+u_master+' A,'+
            u_detail+' B WHERE '+u_join+' AND ('+u_pfilter+')'
            +' AND ('+u_filter+') AND ('+u_wc+')'+
            ' ORDER BY '+parse_05;}
  //for sqlserver
  g_sqlstr:='SELECT DISTINCT'+parse_05+' FROM '+u_master+' A LEFT JOIN '+
            u_detail+' B ON '+u_join+' WHERE ('+u_pfilter+')'
            +' AND ('+u_filter+') AND ('+u_wc+')'+
            ' ORDER BY '+parse_05;
  with query1 do
    begin
      close;
      sql.Clear;
      sql.Add(g_sqlstr);
      open;
    end;
  navistatus;
  {u_rowid:=query1.fieldbyname('ID').AsString;}//id
  assign_query;
  refresh_master;
end;

procedure Tfrm_level4_2.refresh_master;
begin
//qy_master.DatabaseName:=dm.connection.DatabaseName;
  with qy_master do
    begin
      {g_sqlstr:='SELECT * FROM '+u_master+' WHERE ID='''+u_rowid+'''';}//id
      g_sqlstr:='SELECT * FROM '+u_master+' WHERE '+self.parse_06;
      close;
      sql.Clear;
      sql.Add(g_sqlstr);
      Open;
    end;
end;

procedure Tfrm_level4_2.refresh_detail;
begin
  qy_detail.Close;
  qy_detail.Open;
end;

procedure Tfrm_level4_2.refresh_query;
begin
  query1.Close;
  query1.Open;
end;

function Tfrm_level4_2.chk_acti:boolean;
begin
  chk_acti:=false;
  with dm.pub1 do
   begin
    Close;
    SQL.Clear;
    {g_sqlstr:='SELECT * FROM '+u_master+' WHERE ID='''
            +u_rowid+'''';}//id
    g_sqlstr:='SELECT ACTI FROM '+u_master+' WHERE '+self.parse_06;
    SQL.Add(g_sqlstr);
    Open;
    IF FieldByName('ACTI').AsString='Y' then result:=true;
    Close;
   end;
end;

function Tfrm_level4_2.chk_unique:boolean;
var i:integer;
    flag:boolean;
begin
 chk_unique:=true;
 for i:=1 to 10 do
   begin
     if u_mkey[i]<>'' then
       begin
         if qy_master.FieldByName(u_mkey[i]).AsString='' then
           begin
             u_error:='關鍵字段不能為空';
             exit;
           end;
       end;
   end;

 //todo; ok
 flag:=true;
 for i:=1 to 10 do
   begin
     if u_oldkeyvalue[i]<>'' then
       begin
         flag:=flag and(u_oldkeyvalue[i]=qy_master.FieldByName(u_mkey[i]).AsString);
       end;
   end;
   
  if (qy_master.state = dsinsert)or
     ((qy_master.State=dsEdit) and (not flag))
   then
    begin
      with dm.pub1 do
       begin
        close;
        sql.Clear;
        g_sqlstr:='SELECT * FROM '+u_master+
                  ' WHERE '+parse_04;
        sql.add(g_sqlstr);
        Open;

        if  not(bof and eof ) then
            begin
              u_error :='記錄已經存在 !';
              chk_unique:=false;
              Set_focus;
              //Kxb01.SetFocus;
              exit;
            end;
       end;
    end;
end;

//=================================================
//*************************************************
//first
procedure Tfrm_level4_2.FormCreate(Sender: TObject);
var i:integer;
begin
  inherited;