📄 infobase.pas
字号:
{设置功能按钮的有效性}
//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 + -