paymentbase.pas

产品信息系统!关于产品基础信息的系统!功能强大!

unit PaymentBase;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Base, DBCtrls, StdCtrls, ExtCtrls, DB, ADODB, ComCtrls, ToolWin,
  ActnList, wwdbdatetimepicker, Mask, wwdbedit;

type
  TfrmPaymentBase = class(TfrmBase)
    ALToolbar: TActionList;
    acNew: TAction;
    acModify: TAction;
    acDelete: TAction;
    acSave: TAction;
    acCancel: TAction;
    acFirst: TAction;
    acPrior: TAction;
    acNext: TAction;
    acLast: TAction;
    acFind: TAction;
    acPrint: TAction;
    acExit: TAction;
    acConfirm: TAction;
    ToolBar: TToolBar;
    tbtNew: TToolButton;
    tbtModify: TToolButton;
    tbtDelete: TToolButton;
    tbtDivider1: TToolButton;
    tbtFirst: TToolButton;
    tbtPrior: TToolButton;
    tbtNext: TToolButton;
    tbtLast: TToolButton;
    tbtDivider: TToolButton;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    tbtSave: TToolButton;
    tbtCancel: TToolButton;
    ToolButton5: TToolButton;
    tbtFind: TToolButton;
    tbtDivider3: TToolButton;
    tbtExit: TToolButton;
    spGetInNumber: TADOStoredProc;
    spGetOutNumber: TADOStoredProc;
    pnlTop: TPanel;
    lblSubmit: TLabel;
    lblBillCaption: TLabel;
    lblNO: TLabel;
    dbtxtNo: TDBText;
    QMaster: TADOQuery;
    dsMaster: TDataSource;
    lblMaker: TLabel;
    lblSubmitUser: TLabel;
    lblDate: TLabel;
    lblSubmitDate: TLabel;
    wwDBEdtMaker: TwwDBEdit;
    wwDBEdtSubmitUser: TwwDBEdit;
    wwPKDate: TwwDBDateTimePicker;
    wwPKSubmitDate: TwwDBDateTimePicker;
    procedure acFirstExecute(Sender: TObject);
    procedure acPriorExecute(Sender: TObject);
    procedure acNextExecute(Sender: TObject);
    procedure acLastExecute(Sender: TObject);
    procedure acExitExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure dsMasterDataChange(Sender: TObject; Field: TField);
    procedure dsMasterStateChange(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure acModifyExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acSaveExecute(Sender: TObject);
    procedure acCancelExecute(Sender: TObject);
    procedure QMasterBeforePost(DataSet: TDataSet);
    procedure QMasterAfterPost(DataSet: TDataSet);
    procedure QMasterBeforeDelete(DataSet: TDataSet);
    procedure QMasterPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure QMasterDeleteError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure FormCreate(Sender: TObject);
    procedure QMasterAfterInsert(DataSet: TDataSet);
    procedure acConfirmExecute(Sender: TObject);
  private
    { Private declarations }
  protected
    iFunctionID: Integer;               {模块标识ID}
    iBillTypeID: Integer;               {单据类型ID}
    sMasterSql: string;                 {主表的Sql语句}
    bCanNew, bCanModify, bCanDelete, bCanPrint, bCanConfirm, bCanCounteract: Boolean;
    function CheckSave: Boolean;        {检测当前数据是否保存函数}
    function GetErrorInfo(E: EDatabaseError): string; {取错误描述信息和错误原码}
    procedure GetPermiss; virtual;      {得到当前用户的权限}
  public
    { Public declarations }
  end;

var
  frmPaymentBase    : TfrmPaymentBase;

implementation

uses Main, Global, DataModule;
{$R *.dfm}

{检测当前数据是否保存函数}
function TfrmPaymentBase.CheckSave: Boolean;
begin
  Result := True;
  if QMaster.State in [dsInsert, dsEdit] then //判断当前状态
    case Messagedlg('是否保存当前的修改？', mtWarning, [mbYes, mbNo, mbCancel], 0) of
      mrYes:
        begin
          QMaster.Post;
          Result := QMaster.State = dsBrowse; //状态是否为Browse
        end;
      mrNo:
        begin
          QMaster.Cancel;
          Result := QMaster.State = dsBrowse; //状态是否为Browse
        end;
      mrCancel:
        Result := false;
    end
end;

{取错误描述信息和错误原码}
function TfrmPaymentBase.GetErrorInfo(E: EDatabaseError): string;
var
  AdoErrors         : Errors;           //ado的错误信息对象
  sError            : string;
  //  i :Integer;
begin
  inherited;
  {取得错误信息}
  AdoErrors := dmClient.adocnClothing.Errors;
  //for i:=0 to AdoErrors.Count-1 do
  if AdoErrors.Count > 0 then           //可能有多个错误信息，这里只取第一个
    sError := sError + #10#13 + AdoErrors.Item[0].Description + ' (错误码:' + InttoStr(AdoErrors.Item[0].NativeError) + ')'
  else if (E is EDatabaseError) then
    sError := E.Message;

  Result := sError;
end;

{得到用户对当前窗体的操作权限}
procedure TfrmPaymentBase.GetPermiss;
begin
  bCanNew := G_bAdmin;
  bCanModify := G_bAdmin;
  bCanDelete := G_bAdmin;
  bCanPrint := G_bAdmin;
  bCanConfirm := G_bAdmin;
  bCanCounteract := G_bAdmin;

  if G_bAdmin then                      //判断是否为超级用户
  begin
    bCanNew := G_bAdmin;
    bCanModify := G_bAdmin;
    bCanDelete := G_bAdmin;
    bCanPrint := G_bAdmin;
    bCanConfirm := G_bAdmin;
    bCanCounteract := G_bAdmin;
  end
  else                                  //否则查找当前用户是否有当前窗体的操作权限
    with dmClient.spUserRight do
      if Locate('fModuleID;fActionName', varArrayOf([iModuleID, sFunctionName]), []) then
      begin
        bCanNew := FieldbyName('fInsert').asBoolean;
        bCanModify := FieldbyName('fEdit').asBoolean;
        bCanDelete := FieldbyName('fDelete').asBoolean;
        bCanPrint := FieldbyName('fPrint').asBoolean;
        bCanConfirm := FieldbyName('fConfirm').asBoolean;
        bCanCounteract := FieldbyName('fCancel').asBoolean;
      end
end;

procedure TfrmPaymentBase.acFirstExecute(Sender: TObject);
begin
  inherited;
  QMaster.First;
end;

procedure TfrmPaymentBase.acPriorExecute(Sender: TObject);
begin
  inherited;
  QMaster.Prior;
end;

procedure TfrmPaymentBase.acNextExecute(Sender: TObject);
begin
  inherited;
  QMaster.Next;
end;

procedure TfrmPaymentBase.acLastExecute(Sender: TObject);
begin
  inherited;
  QMaster.Last;
end;

procedure TfrmPaymentBase.acExitExecute(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TfrmPaymentBase.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  CanClose := CheckSave;                //未保存则不能退出
end;

procedure TfrmPaymentBase.dsMasterDataChange(Sender: TObject;
  Field: TField);
begin
  inherited;
  {调用状态变化过程}
  dsMasterStateChange(Sender);
end;

procedure TfrmPaymentBase.dsMasterStateChange(Sender: TObject);
var
  i                 : Integer;
begin
  inherited;
  {设置功能按钮的有效性}
  acSave.Enabled := QMaster.State in [dsInsert, dsEdit];
  acNew.Enabled := bCanNew and not acSave.Enabled;
  acModify.Enabled := bCanModify
    and not acSave.Enabled
    and not QMaster.FieldbyName('fSubmitFlag').asBoolean; //还未确认的单据
  acCancel.Enabled := acSave.Enabled;
  acDelete.Enabled := bCanDelete
    and not QMaster.FieldbyName('fSubmitFlag').asBoolean; //还未确认的单据
  acPrint.Enabled := bCanPrint;

  acConfirm.Enabled := bCanConfirm      //有确认操作权限
  and not QMaster.FieldbyName('fSubmitFlag').asBoolean //还未确认的单据
  and not acSave.Enabled;
  acFind.Enabled := not acSave.Enabled;

  //页脚信息
  lblSubmitDate.Visible := QMaster.FieldbyName('fSubmitFlag').asBoolean;
  lblSubmitUser.Visible := lblSubmitDate.Visible;
  wwPKSubmitDate.Visible := lblSubmitDate.Visible;
  wwDBEdtSubmitUser.Visible := lblSubmitDate.Visible;

  //Lable信息
  lblSubmit.Visible := QMaster.FieldbyName('fSubmitFlag').asBoolean;

  {设置编辑控件的ReadOnly}
  with pnlTop do
    for i := 0 to ControlCount - 1 do
      if Controls[i] is TDBEdit then
        (Controls[i] as TDBEdit).ReadOnly := not acSave.Enabled
      else if Controls[i] is TwwDBEdit then
        (Controls[i] as TwwDBEdit).ReadOnly := not acSave.Enabled
      else if Controls[i] is TDBMemo then
        (Controls[i] as TDBMemo).ReadOnly := not acSave.Enabled;

  {设置导航按钮的有效性}
  acFirst.Enabled := (not QMaster.Bof) and (not acSave.Enabled);
  acLast.Enabled := (not QMaster.Eof) and (not acSave.Enabled);
  acPrior.Enabled := (acFirst.Enabled) and (not acSave.Enabled);
  acNext.Enabled := (acLast.Enabled) and (not acSave.Enabled);

end;

procedure TfrmPaymentBase.acNewExecute(Sender: TObject);
begin
  inherited;
  QMaster.Append;
end;

procedure TfrmPaymentBase.acModifyExecute(Sender: TObject);
begin
  inherited;
  QMaster.Edit;
end;

procedure TfrmPaymentBase.acDeleteExecute(Sender: TObject);
begin
  inherited;
  if QMaster.RecordCount > 0 then
    if Messagedlg('您确定要删除当前单据吗?', mtWarning, [mbOk, mbCancel], 0) = mrOk then
      QMaster.Delete;
end;

procedure TfrmPaymentBase.acSaveExecute(Sender: TObject);
begin
  inherited;
  if QMaster.State in [dsInsert, dsEdit] then
    QMaster.Post;
end;

procedure TfrmPaymentBase.acCancelExecute(Sender: TObject);
begin
  inherited;
  if Messagedlg('您确定要取消修改吗?', mtWarning, [mbOk, mbCancel], 0) = mrOk then
    QMaster.Cancel;
end;

procedure TfrmPaymentBase.QMasterBeforePost(DataSet: TDataSet);
begin
  inherited;
  if QMaster.State = dsInsert then
  begin
    //取外部单号NO
    try
      with spGetOutNumber do
      begin
        parameters.ParamValues['@BillType'] := iBillTypeID;
        Execproc;
      end;
    except
      on E: Exception do
      begin
        Messagedlg('取单据号失败！' + #13#10 + E.Message, mtError, [mbOk], 0);
        abort;
      end;
    end;
    QMaster.FieldbyName('fNO').asString :=
      Trim(spGetOutNumber.parameters.ParamValues['@OutNumber']);
  end;

  //开启事务
  if not dmClient.adocnClothing.InTransaction then
    dmClient.adocnClothing.BeginTrans;
end;

procedure TfrmPaymentBase.QMasterAfterPost(DataSet: TDataSet);
begin
  inherited;
  {提交事务}
  if dmClient.adocnClothing.InTransaction then
    dmClient.adocnClothing.CommitTrans;
end;

procedure TfrmPaymentBase.QMasterBeforeDelete(DataSet: TDataSet);
begin
  inherited;
  {开启事务}
  if not dmClient.adocnClothing.InTransaction then
    dmClient.adocnClothing.BeginTrans;
end;

procedure TfrmPaymentBase.QMasterPostError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
  inherited;
  {提示错误描述信息和错误原码}
  Messagedlg('存盘失败!' + GetErrorInfo(E), mtError, [mbOk], 0);
  Action := daAbort;                    //终止存盘
end;

procedure TfrmPaymentBase.QMasterDeleteError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
  inherited;
  {提示错误描述信息和错误原码}
  Messagedlg('删除失败!' + GetErrorInfo(E), mtError, [mbOk], 0);
  Action := daAbort;                    //终止存盘
end;

procedure TfrmPaymentBase.FormCreate(Sender: TObject);
begin
  inherited;
  GetPermiss;
  if not QMaster.Active then
    QMaster.Open
  else
    dsMasterStateChange(Sender);        {调用状态变化过程}
end;

procedure TfrmPaymentBase.QMasterAfterInsert(DataSet: TDataSet);
begin
  inherited;
  //取内部单号ID
  try
    with spGetInNumber do
    begin
      parameters.ParamValues['@BillType'] := iBillTypeID;
      Execproc;
    end;
  except
    on E: Exception do
    begin
      Messagedlg('新增单据失败！' + #13#10 + E.Message, mtError, [mbOk], 0);
      abort;
    end;
  end;
  QMaster.FieldbyName('fID').asInteger :=
    spGetInNumber.parameters.ParamValues['@InNumber'];
  QMaster.FieldbyName('fPayType').asInteger := 0;
  QMaster.FieldbyName('fUseRemain').asBoolean := false;
  QMaster.FieldbyName('fMaker').asString := G_sUserName;
  QMaster.FieldbyName('fDate').asDatetime := Date();
end;

procedure TfrmPaymentBase.acConfirmExecute(Sender: TObject);
begin
  inherited;
  if Messagedlg('你确定要审核当前单据吗?', mtWarning, [mbOk, mbCancel], 0) = mrOk then
  begin
    screen.Cursor := crHourGlass;
    try
      QMaster.Edit;
      QMaster.FieldValues['fSubmitFlag'] := 1;
      QMaster.FieldbyName('fSubmitDate').asDatetime := Date();
      QMaster.FieldbyName('fSubmitUser').asString := G_sUserName;
      QMaster.Post;
    except
      on E: Exception do
      begin
        screen.Cursor := crDefault;
        Messagedlg('操作失败！' + #13#10 + E.Message, mtError, [mbOk], 0);
        exit;
      end;
    end;
    screen.Cursor := crDefault;
  end;
end;

end.