ufrm_level4_1.~pas

来自「完整的进销存系统。 设计文件及完整的源代码。 Delphi6.0」· ~PAS 代码 · 共 580 行

~PAS
580
字号
//  *******************************************
//  *    Program name: pattern ufrm_level4_1  *
//  *    AUTHOR      : Guo xuliang 郭许良     *
//  *    Date        : 2005/05/15             *
//  *    Purpose     :公共模板第四层          *
//  *******************************************

//=================================================================
//單檔維護模板
//==========================================
//設置項目﹕
//1.放入query,datasource.
//2.編寫,取得要操作的table的函數
//3.編寫取得過濾條件的函數
//4.各個按鈕的功能.
//等等......


//=================================================================
//注意事項﹕
//1.必須調用參數: prog,         程序名稱
//                master,       Table
//                key1,         Key field
//                order,        Order field
//2.需要 override
//       function  chk_save:boolean; virtual;  //保存前的檢查
//       function  chk_conf:boolean; virtual;  //確認前的檢查
//       procedure set_Focus;        virtual;  //設置焦點
//  把錯誤信息存放到 u_error中.

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

unit ufrm_level4_1;

interface

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

type
  Tfrm_level4_1 = class(Tfrm_level3_1)
    qy_master: TQuery;
    ds_master: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure tbExitClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure qy_masterNewRecord(DataSet: TDataSet);
    procedure tbAddClick(Sender: TObject);
    procedure tbEditClick(Sender: TObject);
    procedure tbDeleteClick(Sender: TObject);
    procedure tbFirstClick(Sender: TObject);
    procedure tbPriorClick(Sender: TObject);
    procedure tbNextClick(Sender: TObject);
    procedure tbLastClick(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 dbGridDblClick(Sender: TObject);
    procedure tbRefreshClick(Sender: TObject);
    procedure qy_masterBeforeEdit(DataSet: TDataSet);
    procedure tbfilterClick(Sender: TObject);
  private
    { Private declarations }
  protected
    u_table:string;                //要操作的TABLE
    u_filter:string;               //過濾條件
    u_wc:string;                   //查詢條件
    u_order:string;                //排序字段
    u_key1:string;                 //關鍵字
    u_error:string;                //錯誤信息
    u_bookmark:pointer;            //當前位置
    u_oldkeyvalue:string;          //舊的key值
    procedure navistatus;          //導航條狀態
    procedure refresh;
    function  chk_acti:boolean;    //檢查是否已經確認
    function  chk_unique:boolean;  //檢查關鍵字是否重復
    function  chk_save:boolean; virtual;  //保存前的檢查
    function  chk_conf:boolean; virtual;  //確認前的檢查
    procedure set_Focus;        virtual;  //設置焦點
  public
    { Public declarations }
  end;

var
  frm_level4_1: Tfrm_level4_1;

implementation
uses uglobal_fun,uglobal_var, udm,ufrm_sql,ufrm_filter1;
{$R *.dfm}

//*******************************************************

function Tfrm_level4_1.chk_save:boolean;
begin
  result:=true;
end;

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

procedure Tfrm_level4_1.set_focus;
begin
//在繼承的FORM中實現
end;

//*******************************************************
procedure Tfrm_level4_1.navistatus;
begin
  tbfirst.Enabled:=true;
  tbprior.Enabled:=true;
  tbnext.Enabled:=true;
  tblast.Enabled:=true;
  if qy_master.Bof and qy_master.Eof then
    begin
      tbfirst.Enabled:=false;
      tbprior.Enabled:=false;
      tbnext.Enabled:=false;
      tblast.Enabled:=false;
    end
  else if qy_master.Bof then
    begin
      tbfirst.Enabled:=false;
      tbprior.Enabled:=false;
    end
  else if qy_master.Eof then
    begin
      tbnext.Enabled:=false;
      tblast.Enabled:=false;
    end;
end;

procedure Tfrm_level4_1.refresh;
begin
   qy_master.Close;
   qy_master.SQL.Clear;
   g_sqlstr:='SELECT * FROM '+u_table+' WHERE '+u_filter+' AND '
              +u_wc+' ORDER BY '+u_order;
   qy_master.SQL.Add(g_sqlstr);
   qy_master.Open;
   savestatus;
end;

function  Tfrm_level4_1.chk_acti:boolean;
begin
  result:=false;
  with dm.pub1 do
   begin
    Close;
    SQL.Clear;
    g_sqlstr:='SELECT * FROM '+u_table+' WHERE '+u_key1+'='''
            +qy_master.fieldbyName(u_key1).AsString+'''';
    SQL.Add(g_sqlstr);
    Open;
    IF FieldByName('ACTI').AsString='Y' then result:=true;
    Close;
   end;
end;

function Tfrm_level4_1.chk_unique:boolean;
begin
  chk_unique:=true;
  if qy_master.fieldbyName(u_key1).asstring='' then
     begin
       u_error:='此欄位不可為空 !!';
       chk_unique:=false;
       set_Focus;
       //Kxb01.SetFocus;
       exit;
     end;

  if (qy_master.state = dsinsert)or
     ((qy_master.State=dsEdit)
       and (u_oldkeyvalue<>qy_master.FieldByName(u_key1).AsString)
     ) then
    begin
      with dm.pub1 do
       begin
        close;
        sql.Clear;
        g_sqlstr:='SELECT '+u_key1+' FROM '+u_table+
                  ' WHERE '+u_key1+'= '''
                  +qy_master.fieldbyName(u_key1).asstring+'''';
        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_1.FormCreate(Sender: TObject);
begin
  inherited;
  u_table:=g_transfer.master;     //取得要操作的Table
  u_filter:=cl_filter(u_table);   //取得要過濾條件
  u_wc:=' 1=1 ';
  u_order:=g_transfer.order;
  u_key1:=g_transfer.key1;
  qy_master.DatabaseName:=dm.connection.DatabaseName;
  refresh;
  cl_setcolor(self);
end;

//********************************************************

procedure Tfrm_level4_1.tbExitClick(Sender: TObject);
begin
//button 1
  inherited;
  close;
end;

procedure Tfrm_level4_1.tbAddClick(Sender: TObject);
begin
  inherited;
  //2
  if not cl_prichk('A',u_user_permission,u_grup_permission) then
   begin
     messagedlg('您沒有權限執行此功能!!',mtinformation,[mbok],0);
     exit;
   end;

  modistatus;
  Set_focus;
  //IF Kxb01.Enabled=true THEN Kxb01.SetFocus;
  qy_master.Append;
end;

procedure Tfrm_level4_1.tbEditClick(Sender: TObject);
begin
  inherited;
  //3
  IF qy_master.Fieldbyname(u_key1).asstring='' then exit;
  if not cl_prichk('U',u_user_permission,u_grup_permission) then
  begin
    messagedlg('您沒有權限執行此功能!!',mtinformation,[mbok],0);
    exit;
  end;

  IF chk_acti then begin cl_showmsg('資料已被確認,不可修改!');exit;end;

  modistatus;

  Set_focus;
  //if kxb01.Enabled=true then kxb01.SetFocus;
  qy_master.Edit;
  qy_master.FieldByName('MODU').AsString:=g_user;
  qy_master.FieldByName('MODT').AsString:=DateToStr(cl_curdt);

end;

procedure Tfrm_level4_1.tbDeleteClick(Sender: TObject);
begin
  inherited;
  //4
  if qy_master.Fieldbyname(u_key1).asstring='' then exit;

  if not cl_prichk('R',u_user_permission,u_grup_permission) then
   begin
     messagedlg('您沒有權限執行此功能!!',mtinformation,[mbok],0);
     exit;
   end;

  if chk_acti then begin cl_showmsg('資料已被確認,不可修改!');exit;end;

  if messagedlg('確定要刪除此條紀錄嗎?',
                mtconfirmation,[mbyes,mbno],0) <> mryes then exit;

  try
    qy_master.Delete;
  except
    messagedlg('刪除失敗!!',mtinformation,[mbok],0);
  end;
end;



procedure Tfrm_level4_1.tbFirstClick(Sender: TObject);
begin
  inherited;
  //5
  if qy_master.Bof then exit;
  qy_master.First;
  navistatus;
end;

procedure Tfrm_level4_1.tbPriorClick(Sender: TObject);
begin
  inherited;
  //6
  if qy_master.Bof then exit;
  qy_master.Prior;
  navistatus;
end;


procedure Tfrm_level4_1.tbNextClick(Sender: TObject);
begin
  inherited;
  //7
  if qy_master.Eof then exit;
  qy_master.Next;
  navistatus;
end;

procedure Tfrm_level4_1.tbLastClick(Sender: TObject);
begin
  inherited;
  //8
  if qy_master.Eof then exit;
  qy_master.last;
  navistatus;
end;

procedure Tfrm_level4_1.tbRefreshClick(Sender: TObject);
begin
  inherited;
  //9
  //u_bookmark:=qy_master.GetBookmark;
  try
    qy_master.DisableControls;
    qy_master.Close;
    qy_master.Open;
    try
      //qy_master.GotoBookmark(u_bookmark);
    except
      ;
    end;
  finally
   qy_master.EnableControls;
   //qy_master.FreeBookmark(u_bookmark);
  end;
end;

procedure Tfrm_level4_1.tbfilterClick(Sender: TObject);
begin
  inherited;
  //10
  //過濾

  if not cl_prichk('F',u_user_permission,u_grup_permission) then
    begin
     messagedlg('您沒有權限執行此功能!!',mtinformation,[mbok],0);
     exit;
    end;
  Application.CreateForm(Tfrm_filter1,frm_filter1);
  frm_filter1.init(u_table);
  if (frm_filter1.ShowModal=mrYes) then
    u_filter:=frm_filter1.u_wc;
  try
    frm_filter1.release;
  except
    ;
  end;
  try
    refresh;
  except
    ;
  end;
end;

procedure Tfrm_level4_1.tbQueryClick(Sender: TObject);
var l_wc:string;
begin
  inherited;
  //11
  Application.CreateForm(Tfrm_sql,frm_sql);
  frm_sql.init(u_table);
  l_wc:='';
  if (frm_sql.ShowModal=mrok) then
    l_wc:=frm_sql.sqlstr2;
  try
    frm_sql.release;
  except
    ;
  end;
  IF l_wc<>'' then
   begin
     u_wc:=l_wc;
     refresh;
   end;
end;

procedure Tfrm_level4_1.tbSaveClick(Sender: TObject);
begin
  inherited;
  //12
  toolbar1.SetFocus;
  if not chk_unique then
      begin
        messagedlg(u_error,mtinformation,[mbok],0);
        exit;
      end;

  if not chk_save then
      begin
        messagedlg(u_error,mtinformation,[mbok],0);
        exit;
      end;

   try
     qy_master.Post;
   except
     qy_master.Cancel;
     cl_showmsg('存盤失敗!');
   end;

   savestatus;
   //kxb01.Enabled:=true;
end;

procedure Tfrm_level4_1.tbUnsaveClick(Sender: TObject);
begin
  inherited;
  //13
   toolbar1.SetFocus;
   try
     qy_master.Cancel;
   except
      cl_showmsg('放棄存盤失敗!');
   end;
   savestatus;
   //kxb01.Enabled:=true;
end;

procedure Tfrm_level4_1.tbConfirmClick(Sender: TObject);
begin
  inherited;
//14
   if qy_master.FieldByName(u_key1).AsString='' THEN EXIT;
   if not cl_prichk('Y',u_user_permission,u_grup_permission) then
   begin
     messagedlg('您沒有權限執行此功能!!',mtinformation,[mbok],0);
     exit;
   end;

   if messagedlg('是否要確認此筆資料?',
                mtconfirmation,[mbyes,mbno],0) <> mryes then exit;

   if chk_acti then begin cl_showmsg('此筆資料已經確認 !');exit;end;

   if not chk_conf then
      begin
        messagedlg(u_error,mtinformation,[mbok],0);
        exit;
      end;


   {qy_master.Edit;

   qy_master.FieldByName('ACTI').AsString:='Y';
   qy_master.FieldByName('MODU').AsString:=g_user;
   qy_master.FieldByName('MODT').AsString:=DateToStr(cl_curdt);
   try
     qy_master.Post;
   except
     qy_master.Cancel;
     messagedlg('確認記錄失敗!',mtinformation,[mbok],0);
   end;}

   g_sqlstr:=' UPDATE '+u_table +' SET ACTI=''Y'',MODU='''+g_user+''','
     +'MODT='''+DateToStr(cl_curdt)+''' WHERE '+u_key1+'='''+
     qy_master.fieldbyname(u_key1).AsString+'''';
   try
    dm.connection.Execute(g_sqlstr);
   except
    messagedlg('確認記錄失敗!',mtinformation,[mbok],0);
   end;
end;

procedure Tfrm_level4_1.tbUnconfirmClick(Sender: TObject);
begin
  inherited;
//15
   if qy_master.FieldByName(u_key1).AsString='' THEN EXIT;
   if not cl_prichk('Z',u_user_permission,u_grup_permission) then
   begin
     messagedlg('您沒有權限執行此功能!!',mtinformation,[mbok],0);
     exit;
   end;

   if messagedlg('確認要還原這筆資料嗎?',
                mtconfirmation,[mbyes,mbno],0) <> mryes then exit;

   if not chk_acti then begin cl_showmsg('此筆資料未被確認 !');exit;end;

   qy_master.Edit;
   qy_master.FieldByName('ACTI').AsString:='N';
   qy_master.FieldByName('MODU').AsString:=g_user;
   qy_master.FieldByName('MODT').AsString:=DateToStr(cl_curdt);
   try
     qy_master.Post;
   except
     messagedlg('還原失敗!',mtinformation,[mbok],0);
   end;
end;

procedure Tfrm_level4_1.tbPrintClick(Sender: TObject);
begin
  inherited;
  //16  需要自己在子類中編寫

end;

procedure Tfrm_level4_1.tbExcelClick(Sender: TObject);
begin
  inherited;
  //17
  cl_toexcel(u_table,dbgrid);
end;

procedure Tfrm_level4_1.tbHelpClick(Sender: TObject);
begin
  inherited;
  //18 子類中實現
end;

//**************************************************************

procedure Tfrm_level4_1.qy_masterBeforeEdit(DataSet: TDataSet);
begin
  inherited;
  u_oldkeyvalue:=qy_master.fieldbyname(u_key1).AsString;
end;

procedure Tfrm_level4_1.qy_masterNewRecord(DataSet: TDataSet);
begin
  inherited;
  qy_master.FieldByName('ACTI').AsString:='N';
  qy_master.FieldByName('OWUS').AsString:=g_user;
  qy_master.FieldByName('GRUP').AsString:=g_grup;
  qy_master.FieldByName('CRET').AsString:=datetostr(cl_curdt);
end;
//***************************************************************


procedure Tfrm_level4_1.dbGridDblClick(Sender: TObject);
begin
  inherited;
  page01.ActivePageIndex:=0;
end;

procedure Tfrm_level4_1.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  if (qy_master.state <> dsbrowse) and (qy_master.state <> dsinactive) then
       begin
          canclose:=false;
          MessageDlg('你已經修改的資料,'+
          '請存盤或放棄 !!',mtinformation,[mbok],0);
       end;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?