⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 infobase.pas

📁 产品信息系统!关于产品基础信息的系统!功能强大!
💻 PAS
📖 第 1 页 / 共 2 页
字号:
   {设置功能按钮的有效性}
   //ShowMessage('jin');
   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
      begin
         QBaseInfo.Delete;
         QBaseInfo.UpdateBatch();
      end;
end;

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

   QBaseInfo.DisableControls;
   QBaseInfo.UpdateBatch;
   QBaseInfo.EnableControls;
     //Qbaseinfo.Post;
   end;

end;

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

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

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

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

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

   if dmClient.adocnequip_manage.InTransaction then
      dmClient.adocnequip_manage.RollbackTrans;
end;

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

   if dmClient.adocnequip_manage.InTransaction then
      dmClient.adocnequip_manage.RollbackTrans;
end;

procedure TfrmInfoBase.FormCreate(Sender: TObject);
begin
   inherited;
   //tbtPrint.visible := False;           {屏蔽打印按钮}
   GetPermiss;
   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;

function TfrmInfoBase.S_IsFileInUse(FileName: string): Boolean;
var
   HFileRes         : HFILE;
begin
   Result := False;
   if not FileExists(FileName) then
      exit;
   HFileRes := CreateFile(pchar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
   Result := (HFileRes = INVALID_HANDLE_VALUE);
   if not Result then
      CloseHandle(HFileRes);
end;

procedure TfrmInfoBase.ToolButton1Click(Sender: TObject);
//Var
 // ExcelApp:Variant;
//  SaveDialog1: TSaveDialog;
 // i,j,row,column:integer;
begin
   inherited;
   {  with QBaseinfo do begin
      close;open;
     if QBaseinfo.IsEmpty then
     begin
       ShowMessage('没有数据需要存盘!');//test
       Exit;
     end;
     SaveDialog1:= TSaveDialog.Create(nil);
     SaveDialog1.Filter := 'Excel 文件 (*.xls)|*.xls';
     SaveDialog1.Title:='确定另存为excel的文件名';
     if savedialog1.Execute Then
       begin
         while S_IsFileInUse(savedialog1.FileName) do
         begin
           case Application.MessageBox(PChar('无法存盘,'+string(ExtractFileName(savedialog1.FileName))+'正在使用中'), '请确认', MB_ICONQuestion+MB_ABORTRETRYIGNORE+MB_DEFBUTTON2) of
             IDAbort:
               begin
                 SaveDialog1.Free;
                 Exit;
               end;
             IDRetry:
               begin
                 continue;
               end;
             IDIgnore:
               begin
                 if Not savedialog1.Execute then break;
               end;
           end;
         end;
       end
     else
       begin
         SaveDialog1.Free;
         exit;
       end;//if
      try
       ExcelApp:=CreateOleObject('Excel.Application');//首先创建 Excel 对象,使用ComObj
      except
       Application.Messagebox('Excel没有安装!','Hello',MB_ICONERROR + mb_Ok);
       Abort;
      end;//end try
     try
       ExcelApp.Visible := False;//显示当前窗口
       ExcelApp.Caption := '应用程序调用 Microsoft Excel';//更改 Excel 标题栏
       ExcelApp.WorkBooks.Add;//添加新工作簿:
       ExcelApp.WorkSheets[ 'Sheet1' ].Activate;//设置第1个工作表为活动工作表
       ExcelApp.ActiveSheet.Rows[1].Font.Size:=10;
       ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
       row:=1;
       column:=1;
       for j:= 0 to QBaseinfo.FieldCount-1 do
         begin
           ExcelApp.Cells[row,column].Value:=QBaseinfo.Fields[j].DisplayLabel;
           column:=column+1;
         end;
       row:=2;
       while (Not QBaseinfo.Eof) and (Not QBaseinfo.IsEmpty) do
       begin
         column:=1;
         for i:=1 to QBaseinfo.FieldCount do
           begin
             ExcelApp.Cells[row,column].Value:=QBaseinfo.fields[i-1].AsString;
             column:=column+1;
           end;
         QBaseinfo.Next;
         row:=row+1;
       end;
       if Not S_IsFileInUse(savedialog1.FileName) then
         try
           ExcelApp.ActiveWorkBook.SaveAs(savedialog1.filename);
         except
           SaveDialog1.Free;
           ExcelApp.WorkBooks.Close;
           ExcelApp.Quit;
           ExcelApp:= Unassigned;
           exit;
         end;
       SaveDialog1.Free;
       ExcelApp.WorkBooks.Close;
       ExcelApp.Quit;
       ExcelApp:= Unassigned;
       Application.MessageBox('Excel文件导出成功!','成功',MB_OK);
     except
       SaveDialog1.Free;
       ExcelApp:= Unassigned;
     end;
     end;  }

end;

procedure TfrmInfoBase.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
    //self:=nil;
    //ShowMessage(Self.ClassName+'infobase');
    Action:=caFree;
end;

procedure TfrmInfoBase.acFilterExecute(Sender: TObject);
begin
  inherited;
//
end;

procedure TfrmInfoBase.acPrintExecute(Sender: TObject);
begin
  inherited;
//
end;

procedure TfrmInfoBase.acExportExecute(Sender: TObject);
begin
  inherited;
//
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -