📄 mainunit.pas
字号:
FirstBtn.Enabled:=true;
priorBtn.Enabled:=true;
NextBtn.Enabled:=true;
LastBtn.Enabled:=true;
ModifBtn.Enabled:=true;
AddBtn.Enabled:=true;
SaveBtn.Enabled:=false;
CancelBtn.Enabled:=false;
DelBtn.Enabled:=true;
PrintBtn.Enabled:=true;
FirstSubMenu.Enabled:=true;
priorsubmenu.Enabled:=true;
NextSubMenu.Enabled:=true;
LastSubMenu.Enabled:=true;
ModiSubMenu.Enabled:=true;
AddSubMenu.Enabled:=true;
SaveSubMenu.Enabled:=false;
CancelSubMenu.Enabled:=false;
DelSubMenu.Enabled:=true;
PrintSubMenu.Enabled:=true;
passsubmenu.Enabled:=true;
CompressSubMenu.Enabled:=true;
RepairSubMenu.Enabled:=true;
ExcelSubMenu.Enabled:=true;
edit2.ReadOnly:=true;
edit3.ReadOnly:=true;
memo1.ReadOnly:=true;
isadd:=0;
showrecord;
end;
procedure TMainForm.PrintSubMenuClick(Sender: TObject); //打印
var
sqllink:string;
begin
form3:=Tform3.Create(self);
form3.Caption:='打印向导';
if form3.ShowModal<>mrOK then
begin
form3.Free;
exit;
end;
if Form3.AllDataRadioButton.Checked then
sqllink:='select * from Account order by date';
if Form3.PartRadioButton.Checked then
sqllink:='select * from Account where Date>=#'
+DateToStr(form3.BeginDate.Date)
+'# and Date<=#'+DateToStr(form3.EndDate.Date)
+'# order by date';
form3.Free;
ADOQuery1.Close;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add(sqllink);
ADOQuery1.Open;
ADOQuery1.First;
if ADOQuery1.RecordCount=0 then
begin
showmessage('没有数据可以打印!');
ADOQuery1.Close;
exit;
end;
frReport1.Dataset:=frDBDataSet1;
//frDBDataSet1.DataSource:=DataSource1;
frDBDataSet1.DataSet:=ADOQuery1;
frReport1.ShowReport;
ADOQuery1.Close;
end;
procedure TMainForm.Edit2Exit(Sender: TObject);
begin
if (edit2.ReadOnly=false) and (edit2.Text='') then edit2.Text:='0.00';
end;
procedure TMainForm.Edit3Exit(Sender: TObject);
begin
if (edit3.ReadOnly=false) and (edit3.Text='') then edit3.Text:='0.00';
end;
procedure TMainForm.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
if not (key in['0'..'9','.',#8]) then key:=#0;
end;
procedure TMainForm.DBGrid1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key=38) or (key=40) then showrecord;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
if ADOTable2.Active then
begin
if (ADOTable2.State=dsEdit) or (ADOTable2.State=dsInsert) then
ADOTable2.Cancel;
ADOTable2.Close;
end;
if ADOTable1.Active then ADOTable1.Close;
IF ADOQuery1.Active then ADOQuery1.Close;
ADOConnection1.Connected:=false;
end;
{function TMainForm.RepairMDB: Boolean;
var
dao:OLEVariant;
begin
result:=true;
dao:=CreateOleObject('DAO.DBEngine.36');
try
try
dao.RepairDatabase(fn);
except
on e:Exception do begin
result:=false;
MessageDlg('数据库修复失败!!'+#13+#13+e.Message,mtError,[mbOK],0);
end;
end;
finally
Dao:=UnAssigned;
end;
end; }
function TMainForm.CompressRePairMDB: Boolean;
var
dao:OLEVariant;
sTempDBname:string;
begin
result:=true;
screen.Cursor:=crHourGlass;
stempdbname:=changefileext(fn,'.tmp');
if fileExists(stempDBName) then DeleteFile(sTempDBName);
dao:=CreateOLEObject('DAO.DBEngine.36');
try
try
dao.compactDatabase(fn,sTempDBName,'',0,';pwd=dltjy');
DeleteFile(fn);
RenameFile(sTempDBName,fn);
except
on e:Exception do begin
result:=False;
MessageDlg('数据库压缩修复失败!!'+#13+#13+e.Message,mtError,[mbOK],0);
end;
end;
finally
dao:=Unassigned;
end;
screen.Cursor:=crDefault;
end;
procedure TMainForm.CompressSubMenuClick(Sender: TObject);
begin
if ADOTable2.Active then ADOTable2.Close;
if ADOTable1.Active then ADOTable1.Close;
IF ADOQuery1.Active then ADOQuery1.Close;
DataSource1.Enabled:=false;
ADOConnection1.Connected:=false;
if CompressRepairMDB Then messagedlg('数据库压缩成功!!',mtInFormation,[mbOK],0);
ADOConnection1.Connected:=true;
opentable;
end;
procedure TMainForm.RepairSubMenuClick(Sender: TObject);
begin
if ADOTable2.Active then ADOTable2.Close;
if ADOTable1.Active then ADOTable1.Close;
IF ADOQuery1.Active then ADOQuery1.Close;
DataSource1.Enabled:=false;
ADOConnection1.Connected:=false;
if CompressRepairMDB Then messagedlg('数据库修复成功!!',mtInFormation,[mbOK],0);
ADOConnection1.Connected:=true;
opentable;
end;
function TMainForm.ToExcel(const fn:string): boolean;
var
Excel:OLEVariant;
i,j:integer;
//CurrentRecord:TBookMark;
begin
result:=true;
//光标形状,进度条等
Screen.Cursor:=crHourGlass;
with Progressbar1 do begin
Max:=ADOQuery1.RecordCount+2;
min:=0;
step:=1;
smooth:=false;
position:=0;
end;
Panel2.BringToFront;
Panel2.Visible:=true;
Label8.Caption:='正在导出数据,请等候...';
label8.Update;
Try
excel:=getActiveOleObject('excel.application');
except
try
excel:=createoleObject('excel.application');
except
messagedlg('导出失败!!'+#13+'Excel可能没有安装!',mtError,[mbOK],0);
Result:=false;
exit;
end;
end;
try
try
excel.visible:=false;
Excel.caption:=Application.Title;
Excel.workbooks.add;
Excel.activeworkbook.sheets['sheet1'].activate;
Excel.activesheet.name:='个人账目';
Excel.activesheet.Pagesetup.centerHeader:='&22个 人 帐 目';
Excel.activesheet.pagesetup.rightHeader:=Chr(10)+'第&P/&N页';
Excel.activesheet.PageSetup.leftMargin:=0;
Excel.activesheet.pagesetup.rightMargin:=0;
Excel.activesheet.pagesetup.TopMargin:=1.5/0.035;
Excel.activesheet.pagesetup.BottomMargin:=1/0.035;
Excel.activesheet.pagesetup.HeaderMargin:=0.3/0.035;
Excel.activesheet.pagesetup.FooterMargin:=0;
Excel.activesheet.pagesetup.CenterHorizontally:=true;
//Excel.activesheet.pagesetup.papersize:=1; //letter
Excel.activesheet.pagesetup.Orientation:=1;
Excel.activesheet.pagesetup.Zoom:=100;
Excel.activesheet.pagesetup.PrintTitleRows := '$1:$1';
Excel.cells[1,1].value:='日期';
Excel.activesheet.columns[1].columnWidth:=18;
Excel.cells[1,2].value:='收入';
Excel.activesheet.columns[2].columnWidth:=16;
Excel.cells[1,3].value:='支出';
Excel.activesheet.columns[3].columnWidth:=16;
Excel.cells[1,4].value:='备注';
Excel.activesheet.columns[4].columnWidth:=30;
Excel.activesheet.rows[1].RowHeight:=25;
Excel.activesheet.range['A1','D1'].Select;
Excel.selection.font.Size:=14;
Excel.selection.font.Bold:=True;
Progressbar1.StepIt;
i:=2;
//CurrentRecord:=ADOQuery1.GetBookmark;
ADOQuery1.DisableControls;
ADOQuery1.First;
while not ADOQuery1.Eof do
begin
Excel.cells[i,1].value:=ADOQuery1.FieldByName('Date').AsDateTime;
Excel.cells[i,2].value:=ADOQuery1.FieldByName('InAccount').AsFloat;
Excel.cells[i,3].value:=ADOQuery1.FieldByName('OutAccount').AsFloat;
Excel.cells[i,4].value:=ADOQuery1.FieldByName('ReMark').AsString;
Excel.ActiveSheet.rows[i].rowheight:=20;
Progressbar1.StepIt;
ADOQuery1.Next;
Inc(i);
end;
ADOQuery1.EnableControls;
//ADOQuery1.GotoBookmark(CurrentRecord);
//ADOQuery1.FreeBookmark(CurrentRecord);
Excel.cells[i,1].value:='合计:';
Excel.Cells[i,2].value:='=SUM(R[-'+inttostr(i-2)+']C:R[-1]C)';
Excel.Cells[i,3].value:='=SUM(R[-'+inttostr(i-2)+']C:R[-1]C)';
Excel.ActiveSheet.rows[i].rowheight:=20;
Excel.ActiveSheet.rows[i+1].rowheight:=20;
Excel.cells[i+1,1].value:='剩余:';
Excel.activesheet.range['B'+intToStr(i+1),'D'+intToStr(i+1)].select;
Excel.selection.Merge;
Excel.cells[i+1,2].value:='=R[-1]C-R[-1]C[1]';
Excel.cells.select;
Excel.selection.HorizontalAlignment:=3;
Excel.selection.VerticalAlignment:=2;
Excel.Selection.ShrinkToFit:=True;
Excel.activesheet.range['A1']. Activate;
Excel.activesheet.range['A1','D'+IntTostr(i+1)].select;
For j:=1 to 4 do begin
Excel.selection.Borders[j].lineStyle:=1;
Excel.selection.Borders[j].weight:=2;
end;
Excel.Activeworkbook.saveAs(fn);
Excel.ActiveWorkBook.saved:=true;
Excel.workbooks.close;
Progressbar1.StepIt;
except
messagedlg('导出失败!!',mtError,[mbOK],0);
Result:=false;
end;
finally
//Excel.visible:=true;
Excel.quit;
Excel:=UnAssigned;
end;
Panel2.Visible:=false;
Screen.Cursor:=crDefault;
end;
procedure TMainForm.ExcelSubMenuClick(Sender: TObject);
var
ExcelName:string;
sqllink:string;
begin
//if not ADOTable2.Active then exit;
form3:=Tform3.Create(self);
form3.Caption:='数据导出向导';
if form3.ShowModal<>mrOK then
begin
form3.Free;
exit;
end;
if Form3.AllDataRadioButton.Checked then
sqllink:='select * from Account order by date';
if Form3.PartRadioButton.Checked then
sqllink:='select * from Account where Date>=#'
+DateToStr(form3.BeginDate.Date)
+'# and Date<=#'+DateToStr(form3.EndDate.Date)
+'# order by date';
form3.Free;
ADOQuery1.Close;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add(sqllink);
ADOQuery1.Open;
ADOQuery1.First;
if ADOQuery1.RecordCount=0 then
begin
showmessage('没有数据可以导出!');
ADOQuery1.Close;
exit;
end;
SaveDialog1.Title:='导出到Excel表格,请输入要保存的文件名';
savedialog1.Filter:='Excel File[*.xls]|*.xls';
savedialog1.FilterIndex:=0;
if not SaveDialog1.Execute then exit;
ExcelName:=SaveDialog1.FileName;
if LowerCase(Copy(ExcelName,Length(ExcelName)-3,4))<>'.xls' then
ExcelName:=ExcelName+'.xls';
if ToExcel(ExcelName) then messagedlg('导出完成!!',mtInformation,[mbOK],0);
ADOQuery1.Close;
end;
procedure TMainForm.showHint(sender: TObject);
begin
StatusBar1.Panels[0].Text:=Application.Hint;
end;
procedure TMainForm.HelpSubMenuClick(Sender: TObject);
begin
showmessage('没有帮助,自己搞定!!');
end;
procedure TMainForm.RunNotepadMenuClick(Sender: TObject);
begin
IF ShellExecute(Handle,nil,'NotePad.exe',nil,nil,SW_SHOWNoRMAL)<=32 THEN
Messagedlg('运行记事本失败!',mtError,[mbOK],0);
end;
procedure TMainForm.RunCalcMenuClick(Sender: TObject);
begin
IF ShellExecute(Handle,nil,'Calc.exe',nil,nil,SW_SHOWNoRMAL)<=32 THEN
Messagedlg('运行计算器失败!',mtError,[mbOK],0);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -