infobase.~pa

Barcode And LabelPrint

unit InfoBase;


interface

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

type
  TfrmInfoBase = class(TfrmBase)
    ToolBar: TToolBar;
    tbtNew: TToolButton;
    tbtModify: TToolButton;
    tbtDelete: TToolButton;
    ALToolbar: TActionList;
    acNew: TAction;
    acModify: TAction;
    acDelete: TAction;
    acSave: TAction;
    acPrior: TAction;
    acFirst: TAction;
    acNext: TAction;
    acLast: TAction;
    acFind: TAction;
    acPrint: TAction;
    acExit: TAction;
    acCancel: TAction;
    tbtDivider1: TToolButton;
    tbtFirst: TToolButton;
    tbtPrior: TToolButton;
    tbtNext: TToolButton;
    tbtLast: TToolButton;
    tbtDivider: TToolButton;
    tbtSave: TToolButton;
    tbtCancel: TToolButton;
    tbtFind: TToolButton;
    tbtDivider3: TToolButton;
    tbtExit: TToolButton;
    QBaseInfo: TADOQuery;
    dsBaseInfo: TDataSource;
    QIsUnique: TADOQuery;
    wwLookupDlg: TwwLookupDialog;
    acFilter: TAction;
    tbtFilter: TToolButton;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    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 dsBaseInfoStateChange(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure acModifyExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acSaveExecute(Sender: TObject);
    procedure acCancelExecute(Sender: TObject);
    procedure QBaseInfoBeforePost(DataSet: TDataSet);
    procedure QBaseInfoAfterPost(DataSet: TDataSet);
    procedure QBaseInfoBeforeDelete(DataSet: TDataSet);
    procedure QBaseInfoPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure QBaseInfoDeleteError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure FormCreate(Sender: TObject);
    procedure dsBaseInfoDataChange(Sender: TObject; Field: TField);
    procedure acFindExecute(Sender: TObject);
  private
    { Private declarations }
  protected
    //iFunctionID :Integer;
    sSql: string;
    bCanNew, bCanModify, bCanDelete, bCanPrint: Boolean;
    function IsUnique(ParamName, ParamValue: string): Boolean; {检测编号是否重复}
    function CheckSave: Boolean; {检测当前数据是否保存函数}
    function GetErrorInfo(E: EDatabaseError): string; {取错误描述信息和错误原码}

  public
    { Public declarations }
  end;

var
  frmInfoBase: TfrmInfoBase;

implementation

uses StockDataModel, StockMain;


{$R *.dfm}

{检测编号是否重复}

function TfrmInfoBase.IsUnique(ParamName, ParamValue: string): Boolean; {检测代码是否重复}
begin
  Result := True;
//if QBaseInfo.State = dsInsert then
  with QIsUnique do
  begin
    parameters.ParamValues[ParamName] := ParamValue;
    if Active then Requery else Open;
    if RecordCount > 0 then Result := False;
  end
end;

{检测当前数据是否保存函数}

function TfrmInfoBase.CheckSave: Boolean;
begin
  Result := true;
  if QBaseInfo.State in [dsInsert, dsEdit] then //判断当前状态
    case Messagedlg('是否保存当前的修改？', mtWarning, [mbYes, mbNo, mbCancel], 0) of
      mrYes:
        begin
          QBaseInfo.Post;
          Result := QBaseInfo.State = dsBrowse; //状态是否为Browse
        end;
      mrNo:
        begin
          QBaseInfo.Cancel;
          Result := QBaseInfo.State = dsBrowse; //状态是否为Browse
        end;
      mrCancel:
        Result := False;
    end
end;

{取错误描述信息和错误原码}

function TfrmInfoBase.GetErrorInfo(E: EDatabaseError): string;
var
  AdoErrors: Errors; //ado的错误信息对象
  sError: string;
//  i :Integer;
begin
  inherited;
{取得错误信息}
  AdoErrors := StockDM.ADOConn.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 TfrmInfoBase.acFirstExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.First;
end;

procedure TfrmInfoBase.acPriorExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.Prior;
end;

procedure TfrmInfoBase.acNextExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.Next;
end;

procedure TfrmInfoBase.acLastExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.Last;
end;

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

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

procedure TfrmInfoBase.dsBaseInfoDataChange(Sender: TObject;
  Field: TField);
begin
  inherited;
{调用状态变化过程}
  dsBaseInfoStateChange(Self);
end;

procedure TfrmInfoBase.dsBaseInfoStateChange(Sender: TObject);
begin
  inherited;
{设置功能按钮的有效性}
  acSave.Enabled := QBaseInfo.State in [dsInsert, dsEdit];
  acNew.Enabled := bCanNew and not acSave.Enabled;
  acModify.Enabled := bCanModify and not acSave.Enabled;
  acCancel.Enabled := acSave.Enabled;
  acDelete.Enabled := bCanDelete;
  acPrint.Enabled := bCanPrint;

  acFind.Enabled := not acSave.Enabled;
  acFilter.Enabled := not acSave.Enabled;

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

procedure TfrmInfoBase.acNewExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.Append;
end;

procedure TfrmInfoBase.acModifyExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.Edit;
end;

procedure TfrmInfoBase.acDeleteExecute(Sender: TObject);
begin
  inherited;
  if QBaseInfo.RecordCount > 0 then
    if messagedlg('您确定要删除当前记录吗?', mtWarning, [mbOk, mbCancel], 0) = mrOk then
      QBaseInfo.Delete;
end;

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

end;

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

procedure TfrmInfoBase.QBaseInfoBeforePost(DataSet: TDataSet);
begin
  inherited;
  if not StockDM.ADOConn.InTransaction then
    StockDM.ADOConn.BeginTrans;
end;

procedure TfrmInfoBase.QBaseInfoAfterPost(DataSet: TDataSet);
begin
  inherited;
  if StockDM.ADOConn.InTransaction then
    StockDM.ADOConn.CommitTrans;
end;

procedure TfrmInfoBase.QBaseInfoBeforeDelete(DataSet: TDataSet);
begin
  inherited;
  if not StockDM.ADOConn.InTransaction then
    StockDM.ADOConn.BeginTrans;
end;

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

  if StockDM.ADOConn.InTransaction then
    StockDM.ADOConn.RollbackTrans;
end;

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

  if StockDM.ADOConn.InTransaction then
    StockDM.ADOConn.RollbackTrans;
end;

procedure TfrmInfoBase.FormCreate(Sender: TObject);
var
  G_bAdmin: boolean;
begin
  inherited;
  G_bAdmin := true;
  bCanNew := G_bAdmin;
  bCanModify := G_bAdmin;
  bCanDelete := G_bAdmin;
  bCanPrint := G_bAdmin;

  if not QBaseInfo.Active then
    QBaseInfo.Open
  else
    dsBaseInfoStateChange(Sender); {调用状态变化过程}
end;

procedure TfrmInfoBase.acFindExecute(Sender: TObject);
begin
  inherited;
  if wwLookupDlg.Execute then
  begin
  end;
end;

end.