home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 October / Chip_2002-10_cd1.bin / zkuste / delphi / kolekce / d56 / FLEXCEL.ZIP / Demo / UTestReport.pas < prev    next >
Pascal/Delphi Source File  |  2002-06-15  |  11KB  |  366 lines
  1. unit UTestReport;
  2. interface
  3. {* $DEFINE EXCEL97}
  4. uses
  5.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  6.   StdCtrls, Db, DBTables, ExcelReport, DBCtrls, ExtCtrls, Grids, ShellApi,
  7.   {$IFDEF Excel97}
  8.     Excel97,
  9.   {$ELSE}
  10.     Excel2000,
  11.   {$ENDIF}
  12.  
  13.   DBGrids, UFlexcel, UExcelAdapter, OLEAdapter, XLSAdapter, TemplateStore, JPEG,
  14.   UFlexCelImport;
  15.  
  16. type
  17.   TFTestReport = class(TForm)
  18.     BtnReport: TButton;
  19.     Items: TTable;
  20.     ItemsItemNo: TFloatField;
  21.     ItemsOrderNo: TFloatField;
  22.     ItemsPartNo: TFloatField;
  23.     ItemsDescription: TStringField;
  24.     ItemsSellPrice: TCurrencyField;
  25.     ItemsQty: TIntegerField;
  26.     ItemsDiscount: TFloatField;
  27.     ItemsExtPrice: TCurrencyField;
  28.     Database: TDatabase;
  29.     OrdersSource: TDataSource;
  30.     ExcelReport2: TExcelReport;
  31.     Cust: TTable;
  32.     CustCustNo: TFloatField;
  33.     CustCompany: TStringField;
  34.     CustPhone: TStringField;
  35.     CustLastInvoiceDate: TDateTimeField;
  36.     CustAddr1: TStringField;
  37.     CustAddr2: TStringField;
  38.     CustCity: TStringField;
  39.     CustState: TStringField;
  40.     CustZip: TStringField;
  41.     CustCountry: TStringField;
  42.     CustFAX: TStringField;
  43.     CustTaxRate: TFloatField;
  44.     CustContact: TStringField;
  45.     Parts: TTable;
  46.     PartsPartNo: TFloatField;
  47.     PartsDescription: TStringField;
  48.     PartsVendorNo: TFloatField;
  49.     PartsOnHand: TFloatField;
  50.     PartsOnOrder: TFloatField;
  51.     PartsBackOrd: TBooleanField;
  52.     PartsCost: TCurrencyField;
  53.     PartsListPrice: TCurrencyField;
  54.     Emps: TTable;
  55.     EmpsEmpNo: TIntegerField;
  56.     EmpsFullName: TStringField;
  57.     EmpsLastName: TStringField;
  58.     EmpsFirstName: TStringField;
  59.     EmpsPhoneExt: TStringField;
  60.     EmpsHireDate: TDateTimeField;
  61.     EmpsSalary: TFloatField;
  62.     CustSource: TDataSource;
  63.     CustTotAddr1: TStringField;
  64.     CustTotAddr2: TStringField;
  65.     ReportKind: TRadioGroup;
  66.     Label1: TLabel;
  67.     edCustomer: TDBLookupComboBox;
  68.     ExcelReport3: TExcelReport;
  69.     ExcelReport4: TExcelReport;
  70.     GridOrders: TDBGrid;
  71.     Orders: TTable;
  72.     OrdersOrderNo: TFloatField;
  73.     OrdersCustNo: TFloatField;
  74.     OrdersSaleDate: TDateTimeField;
  75.     OrdersShipDate: TDateTimeField;
  76.     OrdersItemsTotal: TCurrencyField;
  77.     OrdersTaxRate: TFloatField;
  78.     OrdersFreight: TCurrencyField;
  79.     OrdersAmountPaid: TCurrencyField;
  80.     OrdersAmountDue: TCurrencyField;
  81.     OrdersEmpNo: TIntegerField;
  82.     OrdersShipToContact: TStringField;
  83.     OrdersShipToAddr1: TStringField;
  84.     OrdersShipToAddr2: TStringField;
  85.     OrdersShipToCity: TStringField;
  86.     OrdersShipToState: TStringField;
  87.     OrdersShipToZip: TStringField;
  88.     OrdersShipToCountry: TStringField;
  89.     OrdersShipToPhone: TStringField;
  90.     OrdersShipVIA: TStringField;
  91.     OrdersPO: TStringField;
  92.     OrdersTerms: TStringField;
  93.     OrdersPaymentMethod: TStringField;
  94.     OrdersSalesPerson: TStringField;
  95.     ExcelReport5: TExcelReport;
  96.     Total: TQuery;
  97.     TotalSaleDate: TDateTimeField;
  98.     TotalCustNo: TFloatField;
  99.     TotalCompany: TStringField;
  100.     TotalAddr1: TStringField;
  101.     TotalAddr2: TStringField;
  102.     TotalCity: TStringField;
  103.     TotalState: TStringField;
  104.     TotalZip: TStringField;
  105.     TotalCountry: TStringField;
  106.     TotalPhone: TStringField;
  107.     TotalFAX: TStringField;
  108.     TotalTaxRate: TFloatField;
  109.     TotalContact: TStringField;
  110.     TotalLastInvoiceDate: TDateTimeField;
  111.     TotalOrderNo: TFloatField;
  112.     TotalCustNo_1: TFloatField;
  113.     TotalShipDate: TDateTimeField;
  114.     TotalEmpNo: TIntegerField;
  115.     TotalShipToContact: TStringField;
  116.     TotalShipToAddr1: TStringField;
  117.     TotalShipToAddr2: TStringField;
  118.     TotalShipToCity: TStringField;
  119.     TotalShipToState: TStringField;
  120.     TotalShipToZip: TStringField;
  121.     TotalShipToCountry: TStringField;
  122.     TotalShipToPhone: TStringField;
  123.     TotalShipVIA: TStringField;
  124.     TotalPO: TStringField;
  125.     TotalTerms: TStringField;
  126.     TotalPaymentMethod: TStringField;
  127.     TotalItemsTotal: TCurrencyField;
  128.     TotalTaxRate_1: TFloatField;
  129.     TotalFreight: TCurrencyField;
  130.     TotalAmountPaid: TCurrencyField;
  131.     TotalOrderNo_1: TFloatField;
  132.     TotalItemNo: TFloatField;
  133.     TotalPartNo: TFloatField;
  134.     TotalQty: TIntegerField;
  135.     TotalDiscount: TFloatField;
  136.     TotalPartNo_1: TFloatField;
  137.     TotalVendorNo: TFloatField;
  138.     TotalDescription: TStringField;
  139.     TotalOnHand: TFloatField;
  140.     TotalOnOrder: TFloatField;
  141.     TotalCost: TCurrencyField;
  142.     TotalListPrice: TCurrencyField;
  143.     GridItems: TDBGrid;
  144.     ItemsSource: TDataSource;
  145.     ItemsDiscountPc: TFloatField;
  146.     ExcelReport1: TExcelReport;
  147.     chProtectTheWorkbook: TCheckBox;
  148.     chWeb: TCheckBox;
  149.     OLEAdapter: TOLEAdapter;
  150.     Fish: TTable;
  151.     FishSpeciesNo: TFloatField;
  152.     FishCommon_Name: TStringField;
  153.     FishCategory: TStringField;
  154.     FishSpeciesName: TStringField;
  155.     FishLengthcm: TFloatField;
  156.     FishLength_In: TFloatField;
  157.     FishNotes: TMemoField;
  158.     FishGraphic: TGraphicField;
  159.     XLSAdapter: TXLSAdapter;
  160.     XlsTemplateStore1: TXlsTemplateStore;
  161.     FlexCelImport1: TFlexCelImport;
  162.     Button1: TButton;
  163.     procedure BtnReportClick(Sender: TObject);
  164.     procedure CustCalcFields(DataSet: TDataSet);
  165.     procedure ReportKindClick(Sender: TObject);
  166.     procedure ItemsCalcFields(DataSet: TDataSet);
  167.     procedure EmpsCalcFields(DataSet: TDataSet);
  168.     procedure FormCreate(Sender: TObject);
  169.     procedure ExcelReport1AfterGenerateWorkbook(Sender: TObject;
  170.       const ExcelApp: TExcelApplication;
  171.       const ExcelWorkbook: TExcelWorkbook; const LCID: Integer);
  172.     procedure chWebClick(Sender: TObject);
  173.     procedure ExcelReport6GetCellValue(Sender: TObject;
  174.       const FieldName: WideString; var FieldValue: Variant);
  175.     procedure Button1Click(Sender: TObject);
  176.   private
  177.     ExePath: string;
  178.  
  179.     function GetCurrent_Date: Variant;
  180.     procedure UpdateReport(const ExcelReport: TExcelReport);
  181.     { Private declarations }
  182.   public
  183.     { Public declarations }
  184.   published
  185.     property Current_Date: Variant read GetCurrent_Date;
  186.   end;
  187.  
  188. var
  189.   FTestReport: TFTestReport;
  190.  
  191. implementation
  192.  
  193. {$R *.DFM}
  194.  
  195. procedure TFTestReport.BtnReportClick(Sender: TObject);
  196. begin
  197.   GridOrders.DataSource:=nil; //We don't use OrderSource.DisableControls because it would disable the master/detail relationship....
  198.                              // In a real app, we should use different datasets for showing data/ reporting
  199.   try
  200.     GridItems.DataSource:=nil;
  201.     try
  202.       case ReportKind.ItemIndex of
  203.         0: ExcelReport1.Run;
  204.         1: ExcelReport2.Run;
  205.         2: ExcelReport3.Run;
  206.         3: begin
  207.              Cust.Filtered:=true;  //So we dont use many records
  208.              try
  209.                ExcelReport4.Run;
  210.              finally
  211.                Cust.Filtered:=false;
  212.              end; //finally
  213.            end;
  214.         4: ExcelReport6.Run;
  215.       end; //case
  216.     finally
  217.       GridItems.DataSource:=ItemsSource;
  218.     end; //finally
  219.   finally
  220.     GridOrders.DataSource:=OrdersSource;
  221.   end; //finally
  222.  
  223.   {$IFNDEF Excel97}
  224.     if chWeb.Checked then ShellExecute( Handle,'open', PCHAR(ExePath+'Demo.htm'), NIL,NIL, SW_SHOW);
  225.   {$ENDIF}
  226.  
  227.  
  228. end;
  229.  
  230. function TFTestReport.GetCurrent_Date: Variant;
  231. begin
  232.   GetCurrent_Date:= DateTimeToStr(Now);
  233. end;
  234.  
  235. procedure TFTestReport.CustCalcFields(DataSet: TDataSet);
  236. begin
  237.   CustTotAddr1.Value:= CustAddr1.Value+' '+ CustAddr2.Value;
  238.   CustTotAddr2.Value:= CustCity.Value+' '+ CustState.Value + ' '+ CustZip.Value;
  239. end;
  240.  
  241. procedure TFTestReport.ReportKindClick(Sender: TObject);
  242. begin
  243.   edCustomer.Enabled:= ReportKind.ItemIndex=1;
  244. end;
  245.  
  246. procedure TFTestReport.ItemsCalcFields(DataSet: TDataSet);
  247. begin
  248.   ItemsExtPrice.Value := ItemsQty.Value *
  249.     ItemsSellPrice.Value * (100 - ItemsDiscount.Value) / 100;
  250.   ItemsDiscountPc.Value:=ItemsDiscount.Value / 100;
  251. end;
  252.  
  253. procedure TFTestReport.EmpsCalcFields(DataSet: TDataSet);
  254. begin
  255.   EmpsFullName.Value := Format('%s, %s', [EmpsLastName.Value, EmpsFirstName.Value]);
  256. end;
  257.  
  258. procedure TFTestReport.FormCreate(Sender: TObject);
  259. begin
  260.   ExePath := ExtractFilePath(Paramstr(0));
  261.   ExcelReport1.Template:=ExePath+'Templates\SimpleDemo.xls';
  262.   ExcelReport2.Template:=ExePath+'Templates\Invoices.xls';
  263.   ExcelReport3.Template:=ExePath+'Templates\InvoicesAll.xls';
  264.   ExcelReport4.Template:=ExePath+'Templates\Invoices.xls';
  265.   if ExcelReport6.Adapter=OleAdapter then ExcelReport6.Template:=ExePath+'Templates\FishFacts.xls'
  266.     else ExcelReport6.Template:='FishFacts.xls';
  267.   {$IFDEF Excel97}
  268.     chWeb.Enabled:=false;
  269.   {$ENDIF}
  270. end;
  271.  
  272. procedure TFTestReport.ExcelReport1AfterGenerateWorkbook(Sender: TObject;
  273.   const ExcelApp: TExcelApplication; const ExcelWorkbook: TExcelWorkbook;
  274.   const LCID: Integer);
  275. begin
  276.   try
  277.     if chProtectTheWorkbook.Checked then ExcelWorkbook.Protect;
  278.     ExcelWorkbook.PrintOut;
  279.   except
  280.     on e: Exception do Application.ShowException(e);
  281.     //Clear the exception so the report gets generated anyway
  282.   end; //except
  283. end;
  284.  
  285. procedure TFTestReport.UpdateReport(const ExcelReport: TExcelReport);
  286. begin
  287. {$IFNDEF Excel97}
  288.   if chWeb.Checked then
  289.   begin
  290.     ExcelReport.AutoClose:=true;
  291.     ExcelReport.FileName:=ExePath+'Demo';
  292.     ExcelReport.SaveFormatBasic:=[saHtml];
  293.   end
  294.   else ExcelReport.AutoClose:=false;
  295. {$ENDIF}
  296. end;
  297.  
  298. procedure TFTestReport.chWebClick(Sender: TObject);
  299. begin
  300.   UpdateReport(ExcelReport1);
  301.   UpdateReport(ExcelReport2);
  302.   UpdateReport(ExcelReport3);
  303.   UpdateReport(ExcelReport4);
  304.   UpdateReport(ExcelReport5);
  305. end;
  306.  
  307. procedure TFTestReport.ExcelReport6GetCellValue(Sender: TObject;
  308.   const FieldName: WideString; var FieldValue: Variant);
  309.  
  310. { Paradox graphic BLOB header }
  311. type
  312.   TGraphicHeader = record
  313.     Count: Word;                { Fixed at 1 }
  314.     HType: Word;                { Fixed at $0100 }
  315.     Size: Longint;              { Size not including header }
  316.   end;
  317.  
  318. var
  319.   Jp: TJPEGImage;
  320.   Bmp: Graphics.TBitmap;
  321.   Ms: TMemoryStream;
  322.   s:string;
  323. begin
  324.   if (FieldName='##FISH##NOTES') and (random(3)=1) then FieldValue:='';
  325.   if FieldName='##FISH##Graphic##JPEG' then
  326.   begin
  327.     Jp:= TJPEGImage.Create;
  328.     try
  329.       Bmp:= TBitmap.Create;
  330.       try
  331.         Ms:= TMemoryStream.Create;
  332.         try
  333.           s:=FieldValue;
  334.           Ms.Write(s[1+SizeOf(TGraphicHeader)], Length(s)-SizeOf(TGraphicHeader));
  335.           Ms.Position:=0;
  336.           Bmp.LoadFromStream(Ms);
  337.           Jp.Assign(Bmp);
  338.           Ms.Clear;
  339.           Jp.SaveToStream(Ms);
  340.           Ms.Position:=0;
  341.           setLength(s, Ms.Size);
  342.           Ms.Read(s[1],Ms.Size);
  343.           FieldValue:=s;
  344.         finally
  345.           FreeAndNil(Ms);
  346.         end; //finally
  347.       finally
  348.         FreeAndNil(Bmp);
  349.       end; //finally
  350.     finally
  351.       FreeAndNil(Jp);
  352.     end; //finally
  353.   end;
  354. end;
  355.  
  356. procedure TFTestReport.Button1Click(Sender: TObject);
  357. begin
  358.   FlexCelImport1.OpenFile('c:\adrian\excel\libro1.xls');
  359.   FlexCelImport1.CellValue[1,2]:='Aaay';
  360.   showmessage(FlexCelImport1.CellValue[1,2]);
  361.   FlexCelImport1.Save('c:\adrian\excel\libro1pp.xls');
  362.   FlexCelImport1.CloseFile;
  363. end;
  364.  
  365. end.
  366.