Chip 2002 October/Chip_2002-10_cd1.bin/zkuste/delphi/kolekce/d56/FLEXCEL.ZIP/Demo/UFlDemoData.pas

Pascal/Delphi Source File | 2002-07-03 | 15KB | 494 lines

unit UFlDemoData;

interface

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

  JPEG, ExtDlgs;

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;
    FishNotes: TMemoField;
    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;
    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 RepAfterGenerateWorkbook(Sender: TObject;
      const ExcelApp: TExcelFile);
  private
    FVarArrayDemo: variant;
    FProtect: boolean;
    function GetCurrent_Date: variant;
    function GetAvailability: variant;
    function GetCurrentDate: variant;
    function GetCurrentSQL: variant;
    function GetDsName: variant;
    function GetMyImage: variant;
    { Private declarations }
  public
    MyImageFilename: string;

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

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

    property Protect: boolean read FProtect write FProtect;
    { 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 TFlexCelReport) then (Components[i] as TFlexCelReport).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 TFlexCelReport) then (Components[i] as TFlexCelReport).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): TFlexCelReport;
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;
    9:  Result:= RepFishFacts;
   10:  Result:= RepEvents;
   11: Result:= RepCustom;
    else Raise Exception.Create('Invalid tag');
  end; //Case
end;

procedure TDemoData.ItemsCalcFields(DataSet: TDataSet);
begin
  ItemsExtPrice.Value := ItemsQty.Value *
    ItemsSellPrice.Value * (100 - ItemsDiscount.Value) / 100;
  ItemsDiscountPc.Value:=ItemsDiscount.Value / 100;
end;

procedure TDemoData.EmpsCalcFields(DataSet: TDataSet);
begin
  EmpsFullName.Value := Format('%s, %s', [EmpsLastName.Value, EmpsFirstName.Value]);
end;

procedure TDemoData.CustCalcFields(DataSet: TDataSet);
begin
  CustTotAddr1.Value:= CustAddr1.Value+' '+ CustAddr2.Value;
  CustTotAddr2.Value:= CustCity.Value+' '+ CustState.Value + ' '+ CustZip.Value;
end;


{ Paradox graphic BLOB header }
type
  TGraphicHeader = record
    Count: Word;                { Fixed at 1 }
    HType: Word;                { Fixed at $0100 }
    Size: Longint;              { Size not including header }
  end;

procedure TDemoData.RepFishFactsGetCellValue(Sender: TObject;
  const FieldName: WideString; var FieldValue: Variant);

var
  Jp: TJPEGImage;
  Bmp: Graphics.TBitmap;
  Ms: TMemoryStream;
  s:string;
begin
  if FieldName='##FISH##Graphic##JPEG' then
  begin
    Jp:= TJPEGImage.Create;
    try
      Bmp:= TBitmap.Create;
      try
        Ms:= TMemoryStream.Create;
        try
          s:=FieldValue;
          Ms.Write(s[1+SizeOf(TGraphicHeader)], Length(s)-SizeOf(TGraphicHeader));
          Ms.Position:=0;
          Bmp.LoadFromStream(Ms);
          Jp.Assign(Bmp);
          Ms.Clear;
          Jp.SaveToStream(Ms);
          Ms.Position:=0;
          setLength(s, Ms.Size);
          Ms.Read(s[1],Ms.Size);
          FieldValue:=s;
        finally
          FreeAndNil(Ms);
        end; //finally
      finally
        FreeAndNil(Bmp);
      end; //finally
    finally
      FreeAndNil(Jp);
    end; //finally
  end;
end;

procedure TDemoData.RepEventsGetCellValue(Sender: TObject;
  const FieldName: WideString; var FieldValue: Variant);
var
  Jp: TJPEGImage;
  Bmp: Graphics.TBitmap;
  Ms: TMemoryStream;
  s:string;
begin
  if FieldName='##Events##Event_Photo##JPEG' then
  begin
    Jp:= TJPEGImage.Create;
    try
      Bmp:= TBitmap.Create;
      try
        Ms:= TMemoryStream.Create;
        try
          s:=FieldValue;
          Ms.Write(s[1+SizeOf(TGraphicHeader)], Length(s)-SizeOf(TGraphicHeader));
          Ms.Position:=0;
          Bmp.LoadFromStream(Ms);
          Jp.Assign(Bmp);
          Ms.Clear;
          Jp.SaveToStream(Ms);
          Ms.Position:=0;
          setLength(s, Ms.Size);
          Ms.Read(s[1],Ms.Size);
          FieldValue:=s;
        finally
          FreeAndNil(Ms);
        end; //finally
      finally
        FreeAndNil(Bmp);
      end; //finally
    finally
      FreeAndNil(Jp);
    end; //finally
  end;
end;

function TDemoData.GetAvailability: variant;
var
  w:Widestring;
  wc: word;
begin
  if (EventsEventNo.Value=2) or (EventsEventNo.Value=4) then
    begin
      //There should be a better way to create a widestring... but this works
      setLength(w,6);
      wc:=$FB46;move(wc,w[1],2);
      wc:=64335; move(wc,w[2],2);
      wc:=65209; move(wc,w[3],2);
      wc:=65272; move(wc,w[4],2);
      wc:=65153; move(wc,w[5],2);
      wc:=65179; move(wc,w[6],2);
      w:='This is some no-no-sense unicode: '+w;
    end else w:='';
  result:=w;
end;

function TDemoData.GetCurrentDate: variant;
begin
  Result:= double(Now); //Dates should be passed as numbers, and the corresponding cell in excel have Date format.
end;

function TDemoData.GetCurrentSQL: variant;
begin
  Result:=''; //Not implemented here, see DbDump.exe for an implementation
end;

function TDemoData.GetDsName: variant;
begin
  Result:='DBDEMOS';
end;

procedure TDemoData.RepAfterGenerateWorkbook(Sender: TObject;
  const ExcelApp: TExcelFile);
var
  Wb: TExcelWorkbook;
  i: integer; v:variant ;
begin
  if Protect and ((Sender as TFlexCelReport).Adapter is TOLEAdapter) then
  begin
    Wb:=(ExcelApp as TOleFile ).ExcelWorkbook;
    Wb.Protect('pass',EmptyParam, EmptyParam);
    for i:=1 to Wb.Sheets.Count do
    begin
      //we could use (Wb.Sheets[i] as WorkSheet).Protect('pass', EmptyParam, EmptyParam, EmptyParam, EmptyParam, (ExcelApp as TOleFile ).LCID);
      //if there were no charts
      v:=Wb.Sheets[i];v.Protect('pass');
    end;
  end;
end;

function TDemoData.GetMyImage: variant;
var
  Fs: TFileStream;
  Pic: TPicture;
  Jp: TJPEGImage;
  Ms: TMemoryStream;
  s: string;
begin
  if Uppercase(ExtractFileExt(MyImageFilename))<>'.JPG' then
  begin //We have to convert it to a JPEG
    Pic:=TPicture.Create;
    try
      Jp:= TJPEGImage.Create;
      try
        Pic.LoadFromFile(MyImageFilename);
        Jp.Assign(Pic.Graphic);
        Ms:= TMemoryStream.Create;
        try
          Jp.SaveToStream(Ms);
          Ms.Position:=0;
          setLength(s, Ms.Size);
          Ms.Read(s[1],Ms.Size);
          Result:=s;
        finally
          FreeAndNil(Ms);
        end; //finally
      finally
        FreeAndNil(Jp);
      end; //finally
    finally
      FreeAndNil(Pic);
    end; //finally
  end else //File is already JPEG, we dont need to convert it
  begin
    Fs:= TFileStream.Create(MyImageFilename, fmOpenRead);
    try
      SetLength(s, Fs.Size);
      Fs.Read(s[1], Length(s));
      Result:=s;
    finally
      FreeAndNil(Fs);
    end; //finally
  end;
end;
end.