adobase_un.pas

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

unit adobase_un;

interface

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

type
  Tadobase_frm = class(TForm)
    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;
    bsSkinSpeedButton2: TbsSkinSpeedButton;
    bsSkinSpeedButton3: 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;
    acRefresh: TAction;
    acuse: TAction;
    bsBusinessSkinForm1: TbsBusinessSkinForm;
    bsSkinData1: TbsSkinData;
    bsSkinMessage1: TbsSkinMessage;
    wwLookupDlg: TwwLookupDialog;
    spgetid: TADOStoredProc;
    qbaseinfo: TADOTable;
    dsbaseinfo: TDataSource;
    qtemp: TADOQuery;
    dstemp: TDataSource;
    bsSkinSpeedButton4: TbsSkinSpeedButton;
    procedure dsbaseinfoStateChange(Sender: TObject);
    procedure dsbaseinfoDataChange(Sender: TObject; Field: TField);
    procedure dsbaseinfoUpdateData(Sender: TObject);
    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 acNewExecute(Sender: TObject);
    procedure acModifyExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acSaveExecute(Sender: TObject);
    procedure acCancelExecute(Sender: TObject);
    procedure acFirstExecute(Sender: TObject);
    procedure acPriorExecute(Sender: TObject);
    procedure acNextExecute(Sender: TObject);
    procedure acLastExecute(Sender: TObject);
    procedure acFindExecute(Sender: TObject);
    procedure acExitExecute(Sender: TObject);
    procedure acRefreshExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure acPrintExecute(Sender: TObject);
    procedure qtempBeforeRefresh(DataSet: TDataSet);
    procedure qtempAfterRefresh(DataSet: TDataSet);
    procedure FormShow(Sender: TObject);
    procedure qtempAfterOpen(DataSet: TDataSet);
  private
    function CheckSave :Boolean;  {检测当前数据是否保存函数}
   function GetErrorInfo(E: EDatabaseError) :String; {取错误描述信息和错误原码}

    { Private declarations }

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

var
  adobase_frm: Tadobase_frm;

implementation
uses data_un;
{$R *.dfm}

function tadobase_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 tadobase_frm.GetErrorInfo(E: EDatabaseError) :String;
var
  AdoErrors :Errors; //ado的错误信息对象
  sError :String;
//  i :Integer;
begin

{取得错误信息}
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 Tadobase_frm.dsbaseinfoStateChange(Sender: TObject);
begin

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 Qtemp.RecordCount>0 then
  if acNew.Enabled then
    acDelete.Enabled:=true;
//acDelete.Enabled:=acNew.Enabled and QBaseInfo.RecordCount;
{设置导航按钮的有效性}
acFirst.Enabled := (Not Qtemp.Bof) and (Not acSave.Enabled) ;
acLast.Enabled := (Not Qtemp.Eof) and (Not acSave.Enabled);
acPrior.Enabled := (acFirst.Enabled) and (Not acSave.Enabled);
acNext.Enabled := (acLast.Enabled) and (Not acSave.Enabled);
if acnew.enabled  then
begin
    if qtemp.Active then
        if qtemp.RecordCount>0 then
            acModify.Enabled:=true
        else
            acModify.Enabled:=false;
end;
acDelete.Enabled:=acModify.Enabled;
end;

procedure Tadobase_frm.dsbaseinfoDataChange(Sender: TObject;
  Field: TField);
begin
 dsBaseInfoStateChange(Self);
end;

procedure Tadobase_frm.dsbaseinfoUpdateData(Sender: TObject);
begin
 dsBaseInfoStateChange(Self);
end;

procedure Tadobase_frm.qbaseinfoAfterDelete(DataSet: TDataSet);
begin

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

procedure Tadobase_frm.qbaseinfoAfterPost(DataSet: TDataSet);
begin

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

end;

procedure Tadobase_frm.qbaseinfoBeforeDelete(DataSet: TDataSet);
begin
if Not dm.ADOConnection1.InTransaction then
   dm.ADOConnection1.BeginTrans ;
end;

procedure Tadobase_frm.qbaseinfoBeforePost(DataSet: TDataSet);
begin

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;
if qbaseinfo.state=dsinsert then
QBaseInfo.FieldByName('fid').AsString:= Trim(spgetid.Parameters.ParamValues['@OutNumber']);

if Not dm.ADOConnection1.InTransaction then
 dm.ADOConnection1.BeginTrans ;

end;
end;

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

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

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

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

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

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

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

procedure Tadobase_frm.acSaveExecute(Sender: TObject);
begin
 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;

qbaseinfo.Close;  //为什么不能在APPEND状态下对QTEMP进行刷新操作，
        qtemp.Close;     //此处暂时使用这种关闭数据库和打开数据库的方法来进行
       //showmessage('e'); //等以后找到了新的方法后，再改动!!!!
         qtemp.Open;
        qbaseinfo.Open;
       // qtemp.Refresh;

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


end;

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

procedure Tadobase_frm.acFirstExecute(Sender: TObject);
begin
Qtemp.First ;
 dsBaseInfoStateChange(Self);
end;

procedure Tadobase_frm.acPriorExecute(Sender: TObject);
begin
Qtemp.Prior ;
 dsBaseInfoStateChange(Self);
end;

procedure Tadobase_frm.acNextExecute(Sender: TObject);
begin
Qtemp.Next;
 dsBaseInfoStateChange(Self);
end;

procedure Tadobase_frm.acLastExecute(Sender: TObject);
begin
Qtemp.Last ;
 dsBaseInfoStateChange(Self);
end;

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

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

procedure Tadobase_frm.acRefreshExecute(Sender: TObject);
begin

qtemp.Refresh;

dsBaseInfoStateChange(Self);
end;

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

procedure Tadobase_frm.FormCreate(Sender: TObject);
begin  {
if not qtemp.Active then
 qtemp.open;

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

procedure Tadobase_frm.acPrintExecute(Sender: TObject);
begin
showmessage('打印测试');
end;

procedure Tadobase_frm.qtempBeforeRefresh(DataSet: TDataSet);
begin
if Not dm.ADOConnection1.InTransaction then
   dm.ADOConnection1.BeginTrans ;
end;

procedure Tadobase_frm.qtempAfterRefresh(DataSet: TDataSet);
begin
if dm.ADOConnection1.InTransaction then
 dm.ADOConnection1.CommitTrans ;
end;

procedure Tadobase_frm.FormShow(Sender: TObject);
begin
if not qtemp.Active then
 qtemp.open;

 if not QBaseInfo.Active then
       QBaseInfo.Open
       Else
 dsBaseInfoStateChange(Sender);{调用状态变化过程}
 qbaseinfo.close;
 qtemp.Close;
 qtemp.Open;
 qbaseinfo.Open;
 if qtemp.Active then
if qtemp.RecordCount>0 then
acModify.Enabled:=true
else
acModify.Enabled:=false;

end;

procedure Tadobase_frm.qtempAfterOpen(DataSet: TDataSet);
begin
 if qtemp.Active then
if qtemp.RecordCount>0 then
acModify.Enabled:=true
else
acModify.Enabled:=false;
end;

end.