wel.pas

delphi开发的委托加工管理系统源代码

unit wel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, Grids, DBGrids, StdCtrls, Buttons, TFlatGaugeUnit,
  scExcelExport, FR_Desgn,
  FR_Class, FR_DSet, FR_DBSet, bsSkinShellCtrls, RzButton, DosMove,
  RzPanel, ExtCtrls, wwDialog, wwfltdlg, DBGridEh;

type
  Tql = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    DataSource1: TDataSource;
    ADODataSet1: TADODataSet;
    scExcelExport1: TscExcelExport;
    frDBDataSet1: TfrDBDataSet;
    frReport1: TfrReport;
    RzToolbar1: TRzToolbar;
    RzToolButton1: TRzToolButton;
    RzSpacer1: TRzSpacer;
    RzToolButton2: TRzToolButton;
    RzSpacer2: TRzSpacer;
    RzToolButton3: TRzToolButton;
    RzSpacer3: TRzSpacer;
    RzToolButton4: TRzToolButton;
    wwFilterDialog1: TwwFilterDialog;
    bsSkinSaveDialog1: TSaveDialog;
    DBGridEh1: TDBGridEh;
    procedure BitBtn2Click(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure RzBitBtn3Click(Sender: TObject);
    procedure RzBitBtn4Click(Sender: TObject);
    procedure RzToolButton4Click(Sender: TObject);
    procedure RzToolButton3Click(Sender: TObject);
    procedure RzToolButton1Click(Sender: TObject);
    procedure RzToolButton2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ql: Tql;

implementation

uses adodm;

{$R *.dfm}

procedure Tql.BitBtn2Click(Sender: TObject);
begin
close
end;


procedure Tql.RzBitBtn1Click(Sender: TObject);
begin
if adodataset1.IsEmpty=false then
begin
frreport1.LoadFromFile('report\ql.frf');
//打印当前数据库
frreport1.ShowReport;
end
else
showmessage('请先执行查询')
end;

procedure Tql.RzBitBtn3Click(Sender: TObject);
begin
if adodataset1.IsEmpty=true then
showmessage('请先查询相应的数据')
else
begin
bsskinSaveDialog1 := bsskinSaveDialog1.Create(nil);
  bsskinSaveDialog1.Filter := 'Execl 文件(*.XLS)|*.XLS|Word 文件(*.doc)|*.doc|HTML 文件(*.HTM)|*.HTM|TXT 文件 (*.txt)|*.TXT';
if bsskinSaveDialog1.Execute then
begin
  try
    scExcelExport1.LoadDefaultProperties;
    scExcelExport1.ExcelVisible:=False;
    scExcelExport1.WorksheetName := 'sheet1';
    scExcelExport1.ExportDataset;
    scExcelExport1.SaveAs(bsskinSaveDialog1.FileName,ffXLS);
    //scExcelExport1.SaveAs('c:\ExcelExport.htm',ffHTM);
    //scExcelExport1.SaveAs('c:\ExcelExport.csv',ffCSV);
  finally
    scExcelExport1.Disconnect;
  showmessage('数据导出成功!'+bsskinSaveDialog1.FileName);
    end;
  end;
  end;
end;

procedure Tql.RzBitBtn4Click(Sender: TObject);
begin
close
end;

procedure Tql.RzToolButton4Click(Sender: TObject);
begin
close
end;

procedure Tql.RzToolButton3Click(Sender: TObject);
begin
if adodataset1.IsEmpty=false then
begin
frreport1.LoadFromFile('report\ql.frf');
//打印当前数据库
frreport1.ShowReport;
end
else
showmessage('请先执行查询')
end;

procedure Tql.RzToolButton1Click(Sender: TObject);
begin
adodataset1.Active:=false;
adodataset1.Active:=true;
wwFilterDialog1.Execute;
end;

procedure Tql.RzToolButton2Click(Sender: TObject);
begin
if adodataset1.IsEmpty=true then
showmessage('请先查询相应的数据')
else
begin
bsskinSaveDialog1 := bsskinSaveDialog1.Create(nil);
bsskinSaveDialog1.Filter := 'Execl 文件(*.XLS)|*.XLS|Word 文件(*.doc)|*.doc|HTML 文件(*.HTM)|*.HTM|TXT 文件 (*.txt)|*.TXT';
if bsskinSaveDialog1.Execute then
begin
if fileexists(bsskinSaveDialog1.FileName) then
if application.MessageBox('目标文件已经存在,要覆盖吗?',pchar(application.Title),mb_yesno+mb_iconquestion) <> 6 then exit;
  try
    scExcelExport1.LoadDefaultProperties;
    scExcelExport1.ExcelVisible:=False;
    scExcelExport1.WorksheetName := 'sheet1';
    scExcelExport1.ExportDataset;
    scExcelExport1.SaveAs(bsskinSaveDialog1.FileName,ffXLS);
    //scExcelExport1.SaveAs('c:\ExcelExport.htm',ffHTM);
    //scExcelExport1.SaveAs('c:\ExcelExport.csv',ffCSV);
  finally
    scExcelExport1.Disconnect;
  showmessage('数据导出成功!'+bsskinSaveDialog1.FileName);
    end;
  end;
  end;
end;

end.