home *** CD-ROM | disk | FTP | other *** search
- unit UFlDemoData;
-
- 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}Excel2000,{$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;
- 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;
- 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;
- 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;
-
- 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;
- 9: Result:= RepFishFacts;
- 10: Result:= RepEvents;
- 11: Result:= RepCustom;
- 12: Result:= RepSideBySide;
- 13: Result:= RepMemory;
- 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.RepMemoryAfterGenerateWorkbook(Sender: TObject;
- const ExcelApp: TExcelFile);
- var
- Wb: TExcelWorkbook;
- i: integer; v:variant ;
- begin
- if Protect and ((Sender as TCustomFlexCelReport).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;
- if AutoPrint then
- if ((Sender as TCustomFlexCelReport).Adapter is TOLEAdapter) then
- begin
- Wb:=(ExcelApp as TOleFile ).ExcelWorkbook;
- Wb.PrintOut;
- end else
- begin
- ShellExecute( 0,'print', PCHAR((Sender as TCustomFlexCelReport).FileName), NIL,NIL, SW_SHOW);
- 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;
-
- procedure TDemoData.RepChartsAfterGenerateWorkbook(Sender: TObject;
- const ExcelApp: TExcelFile);
- var
- Wb: TExcelWorkbook;
- Ws: variant;
- v,v2:variant ;
- i:integer;
- LCID: integer;
- begin
- if ((Sender as TCustomFlexCelReport).Adapter is TOLEAdapter) then
- begin
- Wb:=(ExcelApp as TOleFile ).ExcelWorkbook;
- LCID:=(ExcelApp as TOleFile ).LCID;
- Wb.Charts.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam, LCID);
-
- wb.ActiveChart.ChartType := xl3DColumnStacked100;
- v:=Wb.Sheets['Hoja1'];
- v:=v.Range['ChartData'];
- v2:=wb.ActiveChart;
- v2.SetSourceData(v, xlRows);
- wb.ActiveChart.Location(xlLocationAsObject,'Hoja1');
- v:=wb.ActiveChart;
- v.HasTitle := False;
- v.Axes(xlCategory).HasTitle := False;
- v.Axes(xlSeries).HasTitle := False;
- v.Axes(xlValue).HasTitle := False;
- Ws:=(ExcelApp as TOleFile ).ExcelApplication.ActiveSheet ;
- i:=Ws.ChartObjects.Count;
- Ws.ChartObjects(i).Left:=400;
- Ws.ChartObjects(i).Top:=200;
- end;
- end;
-
- procedure TDemoData.FillMemTable(const aStg: TStringGrid);
- var
- R:ArrayOfVariant;
- i: integer;
- begin
- Birthday.Clear;
- SetLength(R,4);
- for i:=1 to aStg.RowCount-1 do
- if aStg.Cells[1,i]<>'' then
- begin
- R[0]:=StrtoInt(aStg.Cells[0,i]);
- R[1]:=aStg.Cells[1,i];
- R[2]:=StrToDate(aStg.Cells[2,i]);
- R[3]:=aStg.Cells[3,i];
- Birthday.AddRecord(R);
- end;
- BirthSex.Clear;
- BirthSex.AddRecord(['M']);
- BirthSex.AddRecord(['F']);
-
- //Setup for virtual table
- GridMem:=aStg;
-
- end;
-
- procedure TDemoData.VBirthdayGetData(Sender: TObject;
- const FieldName: String; const RecordPos: Integer; var Value: Variant);
- begin
- if FieldName='Number' then Value:=StrToInt(GridMem.Cells[0,RecordPos+1]) else
- if FieldName='Name' then Value:=GridMem.Cells[1,RecordPos+1] else
- if FieldName='Birthday Date' then Value:=StrToDate(GridMem.Cells[2,RecordPos+1]) else
- if FieldName='Sex' then Value:=GridMem.Cells[3,RecordPos+1];
-
- end;
-
- procedure TDemoData.VBirthdayVirtualRecordCount(Sender: TObject;
- var RecordCount: Integer);
- begin
- RecordCount:=GridMem.RowCount-1;
- end;
-
- procedure TDemoData.ChangeFastCount(const Value: boolean);
- var
- i: integer;
- begin
- for i:=0 to ComponentCount-1 do
- begin
- if (Components[i] is TFlexCelReport) then
- if Value then (Components[i] as TFlexCelReport).CalcRecordCount:=cr_None else
- (Components[i] as TFlexCelReport).CalcRecordCount:=cr_SlowCount;
- end;
- end;
-
- end.
-