infobase_un.pas

手机进销存系统Delphi源码,管理手机的进货还有销售方面的功能

unit infobase_un;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, frmbase_un, bsMessages, bsSkinData, BusinessSkinForm, ExtCtrls,
  bsSkinCtrls, ActnList, DB, ADODB, wwDialog, wwidlg;

type
  Tinfobase_frm = class(Tbase_frm)
    bsSkinToolBar2: TbsSkinToolBar;
    bsSkinSpeedButton12: TbsSkinSpeedButton;
    bsSkinSpeedButton13: TbsSkinSpeedButton;
    bsSkinSpeedButton14: TbsSkinSpeedButton;
    bsSkinSpeedButton15: TbsSkinSpeedButton;
    bsSkinBevel3: TbsSkinBevel;
    bsSkinSpeedButton16: TbsSkinSpeedButton;
    bsSkinSpeedButton17: TbsSkinSpeedButton;
    bsSkinSpeedButton18: TbsSkinSpeedButton;
    bsSkinBevel4: TbsSkinBevel;
    bsSkinSpeedButton19: TbsSkinSpeedButton;
    bsSkinSpeedButton21: TbsSkinSpeedButton;
    bsSkinBevel8: TbsSkinBevel;
    bsSkinSpeedButton1: TbsSkinSpeedButton;
    ALToolbar: TActionList;
    acNew: TAction;
    acModify: TAction;
    acDelete: TAction;
    acSave: TAction;
    acCancel: TAction;
    acFirst: TAction;
    acPrior: TAction;
    acNext: TAction;
    acLast: TAction;
    acFind: TAction;
    acFilter: TAction;
    acPrint: TAction;
    acExit: TAction;
    acset: TAction;
    QBaseInfo: TADOQuery;
    dsBaseInfo: TDataSource;
    bsSkinSpeedButton2: TbsSkinSpeedButton;
    wwLookupDlg: TwwLookupDialog;
    spgetid: TADOStoredProc;
    bsSkinSpeedButton3: TbsSkinSpeedButton;
    acRefresh: TAction;
    acuse: TAction;
    qtemp: TADOQuery;
    dstemp: TDataSource;
    bsSkinSpeedButton4: TbsSkinSpeedButton;
    procedure dsBaseInfoStateChange(Sender: TObject);
    procedure dsBaseInfoDataChange(Sender: TObject; Field: TField);
    procedure QBaseInfoAfterDelete(DataSet: TDataSet);
    procedure QBaseInfoAfterPost(DataSet: TDataSet);
    procedure QBaseInfoBeforeDelete(DataSet: TDataSet);
    procedure QBaseInfoBeforePost(DataSet: TDataSet);
    procedure QBaseInfoDeleteError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure QBaseInfoPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure acCancelExecute(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure acModifyExecute(Sender: TObject);
    procedure acPriorExecute(Sender: TObject);
    procedure acFirstExecute(Sender: TObject);
    procedure acNextExecute(Sender: TObject);
    procedure acLastExecute(Sender: TObject);
    procedure acSaveExecute(Sender: TObject);
    procedure accloseExecute(Sender: TObject);
    procedure acExitExecute(Sender: TObject);
    procedure dsBaseInfoUpdateData(Sender: TObject);
    procedure acFindExecute(Sender: TObject);
    procedure acRefreshExecute(Sender: TObject);
    procedure wwLookupDlgCloseDialog(Dialog: TwwLookupDlg);
    procedure FormShow(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acsetExecute(Sender: TObject);
    procedure acuseExecute(Sender: TObject);
    procedure acPrintExecute(Sender: TObject);
  private
   function CheckSave :Boolean;  {检测当前数据是否保存函数}
   function GetErrorInfo(E: EDatabaseError) :String; {取错误描述信息和错误原码}

  protected
   ibillidtype:string;
   ibillnum:Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  infobase_frm: Tinfobase_frm;

implementation
  uses data_un;
{$R *.dfm}

function tinfobase_frm.CheckSave:Boolean;

begin
Result:=true;
if QBaseInfo.State in [dsInsert,dsEdit] then //判断当前状态
   Case bsSkinMessage1.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  Tinfobase_frm.GetErrorInfo(E: EDatabaseError) :String;
var
  AdoErrors :Errors; //ado的错误信息对象
  sError :String;
//  i :Integer;
begin
  inherited;
{取得错误信息}
AdoErrors:=dm.ADOConnection1.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 Tinfobase_frm.dsBaseInfoStateChange(Sender: TObject);
begin
  inherited;

acSave.Enabled := QBaseInfo.State in [dsInsert,dsEdit];
acNew.Enabled := Not acSave.Enabled ;

acModify.Enabled := Not acSave.Enabled;
acCancel.Enabled := acSave.Enabled ;
acFind.Enabled := Not acSave.Enabled ;
acFilter.Enabled := Not acSave.Enabled ;
if QBaseInfo.RecordCount>0 then
if acNew.Enabled then
  acDelete.Enabled:=true;
//acDelete.Enabled:=acNew.Enabled and QBaseInfo.RecordCount;
{设置导航按钮的有效性}
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 Tinfobase_frm.dsBaseInfoDataChange(Sender: TObject;
  Field: TField);
begin
  inherited;
{调用状态变化过程}
  dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.QBaseInfoAfterDelete(DataSet: TDataSet);
begin
  inherited;

if dm.ADOConnection1.InTransaction then
   dm.ADOConnection1.CommitTrans ;

end;

procedure Tinfobase_frm.QBaseInfoAfterPost(DataSet: TDataSet);
begin
  inherited;
if dm.ADOConnection1.InTransaction then
 dm.ADOConnection1.CommitTrans ;
end;

procedure Tinfobase_frm.QBaseInfoBeforeDelete(DataSet: TDataSet);
begin
  inherited;
if Not dm.ADOConnection1.InTransaction then
   dm.ADOConnection1.BeginTrans ;
end;

procedure Tinfobase_frm.QBaseInfoBeforePost(DataSet: TDataSet);
begin
  inherited;

if QBaseInfo.State=dsinsert then
begin
//取流水号
    try
         with spgetid do
             begin
                   parameters.ParamValues['@IDType']:=ibillidtype;
                    parameters.ParamValues['@numb']:=ibillnum;
                    Execproc;
             end;
     except
    on E:Exception do
      begin
      bsSkinMessage1.MessageDlg('取工艺流程流水号失败！'+#13#10+E.Message,mterror,[mbOk],0);
      Abort;
      end;
    end;
   

end;

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

if dm.ADOConnection1.InTransaction then
   dm.ADOConnection1.RollbackTrans ;

end;

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

if dm.ADOConnection1.InTransaction then
   dm.ADOConnection1.RollbackTrans ;

end;

procedure Tinfobase_frm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  CanClose :=CheckSave; 
end;

procedure Tinfobase_frm.FormCreate(Sender: TObject);
begin
  inherited;
if not QBaseInfo.Active then
       QBaseInfo.Open
       Else
 dsBaseInfoStateChange(Sender);{调用状态变化过程}
 acExit.Enabled:=true;

      end;

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

procedure Tinfobase_frm.acNewExecute(Sender: TObject);
begin
  inherited;
QBaseInfo.Append;
 dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acModifyExecute(Sender: TObject);
begin
  inherited;
QBaseInfo.Edit ;
dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acPriorExecute(Sender: TObject);
begin
  inherited;
QBaseInfo.Prior ;
 dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acFirstExecute(Sender: TObject);
begin
  inherited;
QBaseInfo.First ;
 dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acNextExecute(Sender: TObject);
begin
  inherited;
QBaseInfo.Next;
 dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acLastExecute(Sender: TObject);
begin
  inherited;
QBaseInfo.Last ;
 dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acSaveExecute(Sender: TObject);
begin
  inherited;
  if QBaseInfo.State=dsinsert then
      if bsSkinMessage1.MessageDlg('是否真的插入本记录', mtInformation, [mbYes, mbNo], 0)=mryes then
       QBaseInfo.Post
       else
       QBaseInfo.Cancel;
  if QBaseInfo.State=dsEdit then
      if bsSkinMessage1.MessageDlg('是否真的修改本记录', mtInformation, [mbYes, mbNo], 0)=mryes then
       QBaseInfo.Post
       else
       QBaseInfo.Cancel;


if dm.ADOConnection1.InTransaction then
 dm.ADOConnection1.CommitTrans ;
acRefreshExecute(self)   ;
end;

procedure Tinfobase_frm.accloseExecute(Sender: TObject);
begin
  inherited;
close;
end;

procedure Tinfobase_frm.acExitExecute(Sender: TObject);
begin
  inherited;
close;
end;

procedure Tinfobase_frm.dsBaseInfoUpdateData(Sender: TObject);
begin
  inherited;
  dsBaseInfoStateChange(Self);
end;

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

procedure Tinfobase_frm.acRefreshExecute(Sender: TObject);
begin
  inherited;
 // qbaseinfo.Close;
 // QBaseInfo.Open;
try

qbaseinfo.Refresh;

 except
 end;
 dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.wwLookupDlgCloseDialog(Dialog: TwwLookupDlg);
begin
  inherited;
 dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.FormShow(Sender: TObject);
begin
  inherited;
       acExit.Enabled:=true;

//dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acDeleteExecute(Sender: TObject);
begin
  inherited;
  if bsSkinMessage1.MessageDlg('由于本记录删除，如果删除会牵涉到历史帐目，'+#13+'所以不能删除，只能标记为不可用，'+#13+'同意请按Yes进入编辑状态,不同意则按No', mtInformation, [mbYes, mbNo], 0)=mryes then
acModifyExecute(self);
 dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acsetExecute(Sender: TObject);
begin
  inherited;
 dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acuseExecute(Sender: TObject);
begin
  inherited;
  dsBaseInfoStateChange(Self);
end;

procedure Tinfobase_frm.acPrintExecute(Sender: TObject);
begin
  inherited;
ShowMessage('打印测试');
end;

end.