infobase.pas

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

unit InfoBase;

interface

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

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;
      tbtPrint: TToolButton;
      dsQTemp: TDataSource;
      QTemp: TADOQuery;
    tbtExport: TToolButton;
      SaveDialog1: TSaveDialog;
    ToolButton3: TToolButton;
    ToolButton1: TToolButton;
    acExport: TAction;
    acRefresh: TAction;
      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);
      procedure ToolButton1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure acFilterExecute(Sender: TObject);
    procedure acPrintExecute(Sender: TObject);
    procedure acExportExecute(Sender: TObject);
   private
      { Private declarations }
   protected
      //iFunctionID :Integer;
      sSql: string;
      bCanNew, bCanModify, bCanDelete,bCanSave,bCanCancel,bCanFind,bCanFilter, bCanPrint,bCanExport: Boolean;
      function IsUnique(ParamName, ParamValue: string): Boolean; {检测编号是否重复}
      function CheckSave: Boolean;      {检测当前数据是否保存函数}
      function GetErrorInfo(E: EDatabaseError): string; {取错误描述信息和错误原码}
      procedure GetPermiss; virtual;    {得到当前用户的权限}
   public
      function S_IsFileInUse(FileName: string): Boolean;
      { Public declarations }
   end;

var
   frmInfoBase      : TfrmInfoBase;

implementation

uses  Global, main, DataModule;
{$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
    //QBaseInfo.UpdateBatch();
   //ShowMessage('xian');
   Result := True;
   if QBaseInfo.State in [dsInsert, dsEdit] then //判断当前状态
      case MessageDlg('是否保存当前的修改？', mtWarning, [mbYes, mbNo, mbCancel], 0) of
         mrYes:
            begin
               QBaseInfo.UpdateBatch;
               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 := dmClient.adocnequip_manage.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.GetPermiss;
//var
//    i:Integer;
begin
   {初始化变量}
   {bCanNew := G_bAdmin;
   bCanModify := G_bAdmin;
   bCanDelete := G_bAdmin;
   bCanPrint := G_bAdmin;}

   if G_bAdmin then                     //判断是否为超级用户
   begin
        //ShowMessage('G_bAdmin');
      bCanNew := G_bAdmin;
      bCanModify := G_bAdmin;
      bCanDelete := G_bAdmin;
      bCanSave:=G_bAdmin;
      bCanCancel:=G_bAdmin;
      bCanFind:=G_bAdmin;
      bCanFilter:=G_bAdmin;
      bCanPrint := G_bAdmin;
      bCanExport:=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;
            bCanSave:=FieldByName('fConfirm').AsBoolean;
            bCanCancel:=FieldByName('fCancel').AsBoolean;
            bCanFind:=FieldByName('fFind').AsBoolean;
            bCanFilter:=FieldByName('fFilter').AsBoolean;
            bCanPrint := FieldbyName('fPrint').asBoolean;
            bCanExport:=FieldByName('fExport').AsBoolean;
         end;
   if tbtNew.Visible then
    tbtNew.Visible:=bCanNew;
   if tbtModify.Visible then
    tbtModify.Visible:=bCanModify;
   if tbtDelete.Visible then
    tbtDelete.Visible:=bCanDelete;
   if tbtSave.Visible then
    tbtSave.Visible:=bCanSave;
   if tbtCancel.Visible then
    tbtCancel.Visible:=bCanCancel;
   if tbtFind.Visible then
    tbtFind.Visible:=bCanFind;
   if tbtFilter.Visible then
    tbtFilter.Visible:=bCanFilter;
   if tbtPrint.Visible then
    tbtPrint.Visible:=bCanPrint;
   if tbtExport.Visible then
    tbtExport.Visible:=bCanExport;
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;