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

📄 mainunit.pas

📁 通过delphi和sql的使用
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    
    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 + -