ufldemodata.pas

Delphi/BCB 各种版本都支持的Excel 读写控件.一成功应用在N个项目中 .

unit UFlDemoData;
{$IFDEF LINUX}{$INCLUDE ../../FLXCONFIG.INC}{$ELSE}{$INCLUDE ..\..\FLXCONFIG.INC}{$ENDIF}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UFlexcelReport, TemplateStore, UFlexCelImport, OLEAdapter, UExcelAdapter,
  XLSAdapter, ImgList, Db, DBTables, Grids, UFlxMessages, ShellApi,
  UFlxMemTable, ExtDlgs, UCustomFlexCelReport, XlsBaseTemplateStore,
  {$IFDEF Excel97} Excel97,{$ELSE} {$IFDEF EXCELXP} ExcelXp, {$ELSE} Excel2000,{$ENDIF}{$ENDIF}
  {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above

  JPEG, UFlexcelReportNoDB;

type
  TDemoData = class(TDataModule)
    ImageList1: TImageList;
    ImageList2: TImageList;
    ImageList3: TImageList;
    XlsSaveDialog: TSaveDialog;
    XLSAdapter: TXLSAdapter;
    OLEAdapter: TOLEAdapter;
    FlexCelImport: TFlexCelImport;
    XlsTemplateStore: TXlsTemplateStore;
    RepSimpleDemo: TFlexCelReport;
    Total: TQuery;
    TotalSaleDate: TDateTimeField;
    TotalCustNo: TFloatField;
    TotalCompany: TStringField;
    TotalAddr1: TStringField;
    TotalAddr2: TStringField;
    TotalCity: TStringField;
    TotalState: TStringField;
    TotalZip: TStringField;
    TotalCountry: TStringField;
    TotalPhone: TStringField;
    TotalFAX: TStringField;
    TotalTaxRate: TFloatField;
    TotalContact: TStringField;
    TotalLastInvoiceDate: TDateTimeField;
    TotalOrderNo: TFloatField;
    TotalCustNo_1: TFloatField;
    TotalShipDate: TDateTimeField;
    TotalEmpNo: TIntegerField;
    TotalShipToContact: TStringField;
    TotalShipToAddr1: TStringField;
    TotalShipToAddr2: TStringField;
    TotalShipToCity: TStringField;
    TotalShipToState: TStringField;
    TotalShipToZip: TStringField;
    TotalShipToCountry: TStringField;
    TotalShipToPhone: TStringField;
    TotalShipVIA: TStringField;
    TotalPO: TStringField;
    TotalTerms: TStringField;
    TotalPaymentMethod: TStringField;
    TotalItemsTotal: TCurrencyField;
    TotalTaxRate_1: TFloatField;
    TotalFreight: TCurrencyField;
    TotalAmountPaid: TCurrencyField;
    TotalOrderNo_1: TFloatField;
    TotalItemNo: TFloatField;
    TotalPartNo: TFloatField;
    TotalQty: TIntegerField;
    TotalDiscount: TFloatField;
    TotalPartNo_1: TFloatField;
    TotalVendorNo: TFloatField;
    TotalDescription: TStringField;
    TotalOnHand: TFloatField;
    TotalOnOrder: TFloatField;
    TotalCost: TCurrencyField;
    TotalListPrice: TCurrencyField;
    Orders: TTable;
    OrdersOrderNo: TFloatField;
    OrdersCustNo: TFloatField;
    OrdersSaleDate: TDateTimeField;
    OrdersShipDate: TDateTimeField;
    OrdersItemsTotal: TCurrencyField;
    OrdersTaxRate: TFloatField;
    OrdersFreight: TCurrencyField;
    OrdersAmountPaid: TCurrencyField;
    OrdersAmountDue: TCurrencyField;
    OrdersEmpNo: TIntegerField;
    OrdersShipToContact: TStringField;
    OrdersShipToAddr1: TStringField;
    OrdersShipToAddr2: TStringField;
    OrdersShipToCity: TStringField;
    OrdersShipToState: TStringField;
    OrdersShipToZip: TStringField;
    OrdersShipToCountry: TStringField;
    OrdersShipToPhone: TStringField;
    OrdersSalesPerson: TStringField;
    OrdersShipVIA: TStringField;
    OrdersPO: TStringField;
    OrdersTerms: TStringField;
    OrdersPaymentMethod: TStringField;
    Items: TTable;
    ItemsItemNo: TFloatField;
    ItemsOrderNo: TFloatField;
    ItemsPartNo: TFloatField;
    ItemsDescription: TStringField;
    ItemsSellPrice: TCurrencyField;
    ItemsQty: TIntegerField;
    ItemsDiscount: TFloatField;
    ItemsExtPrice: TCurrencyField;
    ItemsDiscountPc: TFloatField;
    Parts: TTable;
    PartsPartNo: TFloatField;
    PartsDescription: TStringField;
    PartsVendorNo: TFloatField;
    PartsOnHand: TFloatField;
    PartsOnOrder: TFloatField;
    PartsBackOrd: TBooleanField;
    PartsCost: TCurrencyField;
    PartsListPrice: TCurrencyField;
    Emps: TTable;
    EmpsEmpNo: TIntegerField;
    EmpsFullName: TStringField;
    EmpsLastName: TStringField;
    EmpsFirstName: TStringField;
    EmpsPhoneExt: TStringField;
    EmpsHireDate: TDateTimeField;
    EmpsSalary: TFloatField;
    Cust: TTable;
    CustCustNo: TFloatField;
    CustCompany: TStringField;
    CustPhone: TStringField;
    CustLastInvoiceDate: TDateTimeField;
    CustAddr1: TStringField;
    CustAddr2: TStringField;
    CustCity: TStringField;
    CustState: TStringField;
    CustZip: TStringField;
    CustCountry: TStringField;
    CustFAX: TStringField;
    CustTaxRate: TFloatField;
    CustContact: TStringField;
    CustTotAddr1: TStringField;
    CustTotAddr2: TStringField;
    Fish: TTable;
    FishSpeciesNo: TFloatField;
    FishCommon_Name: TStringField;
    FishCategory: TStringField;
    FishSpeciesName: TStringField;
    FishLengthcm: TFloatField;
    FishLength_In: TFloatField;
    FishGraphic: TGraphicField;
    HTMLSaveDialog: TSaveDialog;
    RepVarArray: TFlexCelReport;
    DsCust: TDataSource;
    RepDbDemo: TFlexCelReport;
    DsOrders: TDataSource;
    RepMultMast: TFlexCelReport;
    RepSheets: TFlexCelReport;
    RepFishFacts: TFlexCelReport;
    RepPivot: TFlexCelReport;
    RepEvents: TFlexCelReport;
    Events: TTable;
    EventsEventNo: TAutoIncField;
    EventsVenueNo: TIntegerField;
    EventsEvent_Name: TStringField;
    EventsEvent_Date: TDateField;
    EventsEvent_Time: TTimeField;
    EventsEvent_Description: TMemoField;
    EventsTicket_price: TCurrencyField;
    EventsEvent_Photo: TGraphicField;
    RepCustom: TFlexCelReport;
    Ds: TQuery;
    RepCharts: TFlexCelReport;
    SortedItems: TQuery;
    OpenDialog: TOpenDialog;
    OpenPictureDialog: TOpenPictureDialog;
    RepImgDemo: TFlexCelReport;
    SortedItemsPartNo: TFloatField;
    SortedItemsqty: TFloatField;
    SortedItemsDescription: TStringField;
    SortedItemsTotalCost: TCurrencyField;
    RepSideBySide: TFlexCelReport;
    Vendors: TTable;
    VendorsVendorNo: TFloatField;
    VendorsVendorName: TStringField;
    VendorsAddress1: TStringField;
    VendorsAddress2: TStringField;
    VendorsCity: TStringField;
    VendorsState: TStringField;
    VendorsZip: TStringField;
    VendorsCountry: TStringField;
    VendorsPhone: TStringField;
    VendorsFAX: TStringField;
    VendorsPreferred: TBooleanField;
    Birthday: TFlxMemTable;
    RepMemory: TFlexCelReportNoDB;
    BirthSex: TFlxMemTable;
    VBirthday: TFlxMemTable;
    FishNotes: TMemoField;
    procedure ItemsCalcFields(DataSet: TDataSet);
    procedure EmpsCalcFields(DataSet: TDataSet);
    procedure CustCalcFields(DataSet: TDataSet);
    procedure RepFishFactsGetCellValue(Sender: TObject;
      const FieldName: WideString; var FieldValue: Variant);
    procedure RepEventsGetCellValue(Sender: TObject;
      const FieldName: WideString; var FieldValue: Variant);
    procedure RepMemoryAfterGenerateWorkbook(Sender: TObject;
      const ExcelApp: TExcelFile);
    procedure RepChartsAfterGenerateWorkbook(Sender: TObject;
      const ExcelApp: TExcelFile);
    procedure VBirthdayGetData(Sender: TObject; const FieldName: String;
      const RecordPos: Integer; var Value: Variant);
    procedure VBirthdayVirtualRecordCount(Sender: TObject;
      var RecordCount: Integer);
  private
    FVarArrayDemo: variant;
    FProtect: boolean;
    FAutoPrint: boolean;

    GridMem: TStringGrid;

    function GetCurrent_Date: variant;
    function GetAvailability: variant;
    function GetCurrentDate: variant;
    function GetCurrentSQL: variant;
    function GetDsName: variant;
    function GetMyImage: variant;
    { Private declarations }
  public
    MyImageFilename: string;

    function LoadImageAsJPEG(const FileName: string): string;

    procedure SetAdapter (const Adapter: TExcelAdapter);
    procedure SetFileName (const FName: string);
    procedure ChangeFastCount(const Value: boolean);

    procedure FillArrayDemo(const aStg: array of TStringGrid);
    procedure FillMemTable(const aStg: TStringGrid);
    function GetReport(const Tag: integer): TCustomFlexCelReport;

    property Protect: boolean read FProtect write FProtect;
    property AutoPrint: boolean read FAutoPrint write FAutoPrint;

    { Public declarations }
  published
    property Current_Date: variant read GetCurrent_Date;
    property VarArrayDemo: variant read FVarArrayDemo;
    property Availability: variant read GetAvailability;

    property DsName: variant read GetDsName;
    property CurrentDate: variant read GetCurrentDate;
    property CurrentSQL: variant read GetCurrentSQL;

    property MyImage: variant read GetMyImage;
  end;

var
  DemoData: TDemoData;


implementation

{$R *.DFM}

{ TDemoData }

procedure TDemoData.SetAdapter(const Adapter: TExcelAdapter);
var
  i: integer;
begin
  for i:=0 to ComponentCount-1 do
  begin
    if (Components[i] is TCustomFlexCelReport) then (Components[i] as TCustomFlexCelReport).Adapter:= Adapter;
    if (Components[i] is TFlexCelImport) then (Components[i] as TFlexCelImport).Adapter:= Adapter;
  end;
end;

function TDemoData.GetCurrent_Date: variant;
begin
  Result:=now;
end;

procedure TDemoData.SetFileName(const FName: string);
var
  i: integer;
begin
  for i:=0 to ComponentCount-1 do
  begin
    if (Components[i] is TCustomFlexCelReport) then (Components[i] as TCustomFlexCelReport).FileName:= FName;
  end;
end;



procedure TDemoData.FillArrayDemo(const aStg: array of TStringGrid);
var
  i,j, k: integer;
  e: extended;
begin
  FVarArrayDemo:=VarArrayCreate([Low(aStg), High(aStg), 0,aStg[Low(aStg)].RowCount-2,0,aStg[Low(aStg)].ColCount-2], VarVariant);
  for k:= Low(aStg) to High(aStg) do
    for i:=0 to aStg[k].RowCount-2 do
      for j:=0 to aStg[k].ColCount-2 do
        //try to convert to number
        if TextToFloat(PChar(aStg[k].Cells[j+1,i+1]), e, fvExtended) then  //Dont use val because it doesnt handle locales
          FVarArrayDemo[k,i,j]:=e else
          FVarArrayDemo[k,i,j]:=aStg[k].Cells[j+1,i+1];

end;

function TDemoData.GetReport(const Tag: integer): TCustomFlexCelReport;
begin
  case Tag of
    1:  Result:= RepSimpleDemo;
    2:  Result:= RepVarArray;
    3:  Result:= RepImgDemo;
    4:  Result:= RepDbDemo;
    5:  Result:= RepMultMast;
    6:  Result:= RepSheets;
    7:  Result:= RepPivot;
    8:  Result:= RepCharts;