mainexcelexport.pas

导出delphi程序的一些数据到

{--------------------------------------------------------------------------------
* Description : Examples how to use the TscExcelExport component
* Author : Stefan Cruysberghs
* Email : [e-mail]
* Website : http://www.scip.be
--------------------------------------------------------------------------------}

unit MainExcelExport;

interface

{$Include scExcelExportConfig.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, DBTables, scExcelExport, Grids, DBGrids, ExtCtrls, Buttons,
  ComCtrls, OleServer, ImgList, DBClient,
  {$IFNDEF DELPHI5}
  Variants, jpeg,
  {$ENDIF}
  {$IFDEF EXCEL97}
  Excel97;
  {$ENDIF}
  {$IFDEF EXCEL2000}
  Excel2000;
  {$ENDIF}
  {$IFDEF EXCELXP}
  ExcelXP;
  {$ENDIF}

type
  TFormExcelExport = class(TForm)
    TableOrders: TTable;
    DataSourceOrders: TDataSource;
    TableAnimals: TTable;
    TableBiolife: TTable;
    StatusBar: TStatusBar;
    PanelTitle: TPanel;
    scExcelExport1: TscExcelExport;
    QuerySortShipVia: TQuery;
    TableOrdersOrderNo: TFloatField;
    TableOrdersCustNo: TFloatField;
    TableOrdersSaleDate: TDateTimeField;
    TableOrdersShipDate: TDateTimeField;
    TableOrdersEmpNo: TIntegerField;
    TableOrdersShipToContact: TStringField;
    TableOrdersShipToAddr1: TStringField;
    TableOrdersShipToAddr2: TStringField;
    TableOrdersShipToCity: TStringField;
    TableOrdersShipToState: TStringField;
    TableOrdersShipToZip: TStringField;
    TableOrdersShipToCountry: TStringField;
    TableOrdersShipToPhone: TStringField;
    TableOrdersShipVIA: TStringField;
    TableOrdersPO: TStringField;
    TableOrdersTerms: TStringField;
    TableOrdersPaymentMethod: TStringField;
    TableOrdersItemsTotal: TCurrencyField;
    TableOrdersTaxRate: TFloatField;
    TableOrdersFreight: TCurrencyField;
    TableOrdersAmountPaid: TCurrencyField;
    DataSourceAnimals: TDataSource;
    TableAnimalsNAME: TStringField;
    TableAnimalsSIZE: TSmallintField;
    TableAnimalsWEIGHT: TSmallintField;
    TableAnimalsAREA: TStringField;
    TableAnimalsBMP: TBlobField;
    TableAnimalsCalcField: TFloatField;
    PageControlExcelExport: TPageControl;
    DataSourceBiolife: TDataSource;
    TableAnimalsAreaText: TStringField;
    TableBiolifeSpeciesNo: TFloatField;
    TableBiolifeCategory: TStringField;
    TableBiolifeCommon_Name: TStringField;
    TableBiolifeSpeciesName: TStringField;
    TableBiolifeLengthcm: TFloatField;
    TableBiolifeLength_In: TFloatField;
    TableBiolifeNotes: TMemoField;
    TableBiolifeGraphic: TGraphicField;
    ImageExcelExportLogo: TImage;
    LabelTitle1: TLabel;
    LabelAuthor: TLabel;
    LabelWebsite: TLabel;
    LabelRegister: TLabel;
    LabelDelphiVersions: TLabel;
    LabelBDE: TLabel;
    scExcelExport2: TscExcelExport;
    TableAnimalsSizeText: TStringField;
    ImageListTabs: TImageList;
    TableAnimalsWeight2: TFloatField;
    TableAnimalsWeight3: TFloatField;
    TableAnimalsWeight4: TStringField;
    TableAnimalsWeight5: TCurrencyField;
    TableAnimalsWeight6: TCurrencyField;
    LabelExtraInfo: TLabel;
    TableAnimalsTime1: TDateTimeField;
    TableAnimalsTime2: TDateTimeField;
    TableAnimalsTime3: TDateTimeField;
    TableAnimalsWeight7: TFloatField;
    TableAnimalsTime4: TDateTimeField;
    TableAnimalsTime5: TDateTimeField;
    TableAnimalsTime6: TDateField;
    LabelExcelVersions: TLabel;
    TabSheetDemos: TTabSheet;
    TabSheetDatasets: TTabSheet;
    PageControlDemos: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    PageControlDatasets: TPageControl;
    TabSheetTableOrders: TTabSheet;
    TabSheetTableAnimals: TTabSheet;
    PanelOrders: TPanel;
    DBGridOrders: TDBGrid;
    DBGridAnimals: TDBGrid;
    PanelAnimals: TPanel;
    TabSheetTableBiolife: TTabSheet;
    PanelBiolife: TPanel;
    DBGridBiolife: TDBGrid;
    TabSheetQuerySortShipVia: TTabSheet;
    PanelSortShipVia: TPanel;
    DBGridSortShipVia: TDBGrid;
    DataSourceSortShipVia: TDataSource;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    TabSheet7: TTabSheet;
    TabSheet8: TTabSheet;
    TabSheet9: TTabSheet;
    TabSheet10: TTabSheet;
    TabSheet11: TTabSheet;
    TabSheet12: TTabSheet;
    TabSheet13: TTabSheet;
    TabSheet14: TTabSheet;
    TabSheet15: TTabSheet;
    TabSheet16: TTabSheet;
    TabSheet17: TTabSheet;
    TabSheet18: TTabSheet;
    PanelNumber1: TPanel;
    PanelTitle1: TPanel;
    Memo1: TMemo;
    BitBtnExecute1: TBitBtn;
    PanelNumber2: TPanel;
    PanelTitle2: TPanel;
    Memo2: TMemo;
    BitBtnExecute2: TBitBtn;
    PanelNumber3: TPanel;
    PanelTitle3: TPanel;
    Memo3: TMemo;
    BitBtnExecute3: TBitBtn;
    PanelNumber4: TPanel;
    PanelTitle4: TPanel;
    Memo4: TMemo;
    BitBtnExecute4: TBitBtn;
    PanelNumber5: TPanel;
    PanelTitle5: TPanel;
    Memo5: TMemo;
    BitBtnExecute5: TBitBtn;
    Panel9: TPanel;
    PanelTitle6: TPanel;
    Memo6: TMemo;
    BitBtnExecute6: TBitBtn;
    Panel11: TPanel;
    PanelTitle7: TPanel;
    Memo7: TMemo;
    BitBtnExecute7: TBitBtn;
    Panel13: TPanel;
    PanelTitle8: TPanel;
    Memo8: TMemo;
    BitBtnExecute8: TBitBtn;
    PanelNumber9: TPanel;
    PanelTitle9: TPanel;
    Memo9: TMemo;
    BitBtnExecute9: TBitBtn;
    PanelNumber10: TPanel;
    PanelTitle10: TPanel;
    Memo10: TMemo;
    BitBtnExecute10: TBitBtn;
    PanelNumber11: TPanel;
    PanelTitle11: TPanel;
    Memo11: TMemo;
    BitBtnExecute11: TBitBtn;
    PanelNumber12: TPanel;
    PanelTitle12: TPanel;
    Memo12: TMemo;
    BitBtnExecute12: TBitBtn;
    PanelNumber13: TPanel;
    PanelTitle13: TPanel;
    Memo13: TMemo;
    BitBtnExecute13: TBitBtn;
    PanelNumber14: TPanel;
    PanelTitle14: TPanel;
    Memo14: TMemo;
    BitBtnExecute14: TBitBtn;
    Panel27: TPanel;
    PanelTitle15: TPanel;
    Memo15: TMemo;
    BitBtnExecute15: TBitBtn;
    Panel29: TPanel;
    PanelTitle16: TPanel;
    Memo16: TMemo;
    BitBtnExecute16: TBitBtn;
    Panel31: TPanel;
    PanelTitle17: TPanel;
    Memo17: TMemo;
    BitBtnExecute17: TBitBtn;
    Panel33: TPanel;
    Panel34: TPanel;
    Memo18: TMemo;
    BitBtnExecute18: TBitBtn;
    Image13: TImage;
    Image2: TImage;
    Image6: TImage;
    Image7: TImage;
    Image12: TImage;
    Image9: TImage;
    Bevel9: TBevel;
    Bevel2: TBevel;
    Bevel6: TBevel;
    Bevel7: TBevel;
    Bevel12: TBevel;
    Bevel13: TBevel;
    DatabaseDBDemos: TDatabase;
    Bevel14: TBevel;
    Image14: TImage;
    Bevel15: TBevel;
    Image15: TImage;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure BitBtnExecute18Click(Sender: TObject);
    procedure BitBtnExecute17Click(Sender: TObject);
    procedure BitBtnExecute15Click(Sender: TObject);
    procedure BitBtnExecute16Click(Sender: TObject);
    procedure BitBtnExecute14Click(Sender: TObject);
    procedure BitBtnExecute13Click(Sender: TObject);
    procedure BitBtnExecute12Click(Sender: TObject);
    procedure BitBtnExecute11Click(Sender: TObject);
    procedure BitBtnExecute10Click(Sender: TObject);
    procedure BitBtnExecute9Click(Sender: TObject);
    procedure BitBtnExecute8Click(Sender: TObject);
    procedure BitBtnExecute7Click(Sender: TObject);
    procedure BitBtnExecute6Click(Sender: TObject);
    procedure BitBtnExecute5Click(Sender: TObject);
    procedure BitBtnExecute4Click(Sender: TObject);
    procedure BitBtnExecute3Click(Sender: TObject);
    procedure BitBtnExecute2Click(Sender: TObject);
    procedure BitBtnExecute1Click(Sender: TObject);
    procedure scExcelExport2GetFieldCellStyleEvent(Sender: TObject; const IntFieldIndex: Integer;
      var ColorBackground: TColor; FontCell: TxlFont);
    procedure scExcelExport1ExportRecords(Sender: TObject; IntRecordNumber: Integer);
    procedure scExcelExport2GetEOF(Sender: TObject; var BlnEOF: Boolean);
    procedure scExcelExport2GetFieldCount(Sender: TObject;
      var IntFieldCount: Integer);
    procedure scExcelExport2GetFieldDataSize(Sender: TObject;
      const FieldIndex: Integer; var IntFieldDataSize: Integer);
    procedure scExcelExport2GetFieldDataType(Sender: TObject;
      const FieldIndex: Integer; var FieldDataType: TFieldType);
    procedure scExcelExport2GetFieldDisplayName(Sender: TObject;
      const FieldIndex: Integer; var StrFieldDisplayName: String);
    procedure scExcelExport2GetFieldName(Sender: TObject;
      const FieldIndex: Integer; var StrFieldName: String);
    procedure scExcelExport2GetFieldValue(Sender: TObject;
      const FieldIndex: Integer; var VarValue: Variant);
    procedure scExcelExport2GetFieldVisible(Sender: TObject;
      const FieldIndex: Integer; var BlnFieldVisible: Boolean);
    procedure scExcelExport2ExportRecords(Sender: TObject;
      IntRecordNumber: Integer);
    procedure scExcelExport2GotoFirstRecord(Sender: TObject);
    procedure scExcelExport2GotoNextRecord(Sender: TObject);
    procedure TableAnimalsCalcFields(DataSet: TDataSet);
    procedure LabelWebsiteClick(Sender: TObject);
  private
    procedure TableBiolifeNotesGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure ChangeCellColors(Sender: TObject; Field: TField; var ColorBackground : TColor; FontCell : TxlFont);
  public
  end;

var
  FormExcelExport: TFormExcelExport;

implementation

uses ShellAPI, {$IFNDEF DELPHI5}DateUtils,{$ENDIF} ActiveX;

{$R *.DFM}

//-----------------------------------------------------------------------------
procedure TFormExcelExport.scExcelExport1ExportRecords(Sender: TObject;
  IntRecordNumber: Integer);
begin
  StatusBar.Panels[0].Text := 'Records : '+IntToStr(IntRecordNumber);
end;

//-----------------------------------------------------------------------------
procedure TFormExcelExport.ChangeCellColors(Sender: TObject; Field: TField; var ColorBackground : TColor; FontCell : TxlFont);
begin
  if Field.FieldName = 'CustNo' then
  begin
    if Field.Value > 2000 then
    begin
      FontCell.Color := clRed;
      FontCell.Name  := 'Times New Roman';
      FontCell.Size := 14;
    end;
    if Field.Value > 3000 then
    begin
      FontCell.Color := clGreen;
      FontCell.Style := [fsBold];
    end;
  end;

  if Field.FieldName = 'EmpNo' then
  begin
    if Field.Dataset.FieldByName('CustNo').Value > 2000 then
      ColorBackground := clRed;
  end;

  if Field.DataSet.FieldByName('EmpNo').Value > 100 then
    ColorBackground := clYellow;
end;

//-----------------------------------------------------------------------------
procedure TFormExcelExport.FormCreate(Sender: TObject);
begin
  try
    if not DatabaseDBDemos.Connected then
      DatabaseDBDemos.Open;
    if not TableOrders.Active then
      TableOrders.Open;
    if not TableAnimals.Active then
      TableAnimals.Open;
    if not TableBiolife.Active then
      TableBiolife.Open;
    if not QuerySortShipVia.Active then
      QuerySortShipVia.Open;

    StatusBar.Panels[2].Text := 'Connection with BDE ' + DatabaseDBDemos.AliasName +' tables';
  except
    on E: Exception do
    begin
      BitBtnExecute1.Enabled := False;
      BitBtnExecute2.Enabled := False;
      BitBtnExecute3.Enabled := False;
      BitBtnExecute4.Enabled := False;
      BitBtnExecute5.Enabled := False;
      BitBtnExecute6.Enabled := False;
      BitBtnExecute7.Enabled := False;
      BitBtnExecute8.Enabled := False;
      BitBtnExecute9.Enabled := False;
      BitBtnExecute10.Enabled := False;
      BitBtnExecute11.Enabled := False;
      BitBtnExecute12.Enabled := False;
      BitBtnExecute13.Enabled := False;
      BitBtnExecute14.Enabled := False;
      BitBtnExecute15.Enabled := False;
      BitBtnExecute16.Enabled := False;

      StatusBar.Panels[2].Text := 'NO connection with BDE ' + DatabaseDBDemos.AliasName +' tables !';

      MessageDlg('NO connection with the BDE ' + DatabaseDBDemos.AliasName +' tables could be established !'+#13+#10+#13+#10+E.Message, mtError, [mbOK], 0);
    end;
  end;

  PageControlExcelExport.ActivePage := TabSheetDemos;
  PageControlDemos.ActivePage := TabSheet1;
end;

//-----------------------------------------------------------------------------