home *** CD-ROM | disk | FTP | other *** search
Wrap
unit UFlDemo; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, ActnList, ImgList, ToolWin, TemplateStore, XLSAdapter, UExcelAdapter, OLEAdapter, UFlexCelImport, UFlexcelReport, UReport, UFlDemoData, ShellApi, Grids, DBCtrls, UFlDemoEdit, UWaitCursor, UExcelEdit, Menus, FileCtrl, UFlxMessages; type TMain = class(TForm) ActionList: TActionList; ActionClose: TAction; ActionReport: TAction; ActionUseOle: TAction; ActionUseNative: TAction; ActionHtml: TAction; ActionProtect: TAction; ActionViewTemplateExcel: TAction; ActionUseTStore: TAction; Panel1: TPanel; Splitter1: TSplitter; ListDemos: TTreeView; Tabs: TPageControl; TabSheet1: TTabSheet; Panel2: TPanel; TxtWelcome: TRichEdit; TabSheet2: TTabSheet; Panel3: TPanel; Label3: TLabel; TabSheet3: TTabSheet; Panel4: TPanel; Label2: TLabel; TxtSimpleDemo: TRichEdit; TabSheet4: TTabSheet; Panel5: TPanel; Label1: TLabel; TxtVarArr: TRichEdit; Panel6: TPanel; Label4: TLabel; TabSheet5: TTabSheet; Panel7: TPanel; Label5: TLabel; TxtDbDemo: TRichEdit; Panel8: TPanel; Label6: TLabel; DBLookupComboBox1: TDBLookupComboBox; TabSheet6: TTabSheet; Panel9: TPanel; Label7: TLabel; TxtMultMast: TRichEdit; TabSheet7: TTabSheet; Panel10: TPanel; Label8: TLabel; TxtSheets: TRichEdit; TabSheet8: TTabSheet; TabSheet9: TTabSheet; TabSheet10: TTabSheet; TabSheet11: TTabSheet; TabSheet12: TTabSheet; TabSheet13: TTabSheet; ToolBar: TToolBar; BtnUseNative: TToolButton; BtnUseOle: TToolButton; ToolButton5: TToolButton; BtnHTML: TToolButton; BtnProtect: TToolButton; BtnUseTStore: TToolButton; ToolButton2: TToolButton; BtnReport: TToolButton; BtnViewTemplate: TToolButton; BtnClose: TToolButton; StatusBar: TStatusBar; Panel11: TPanel; Label9: TLabel; TxtFishFacts: TRichEdit; PageControl1: TPageControl; TabSheet15: TTabSheet; TabSheet16: TTabSheet; GridVarArray1: TStringGrid; GridVarArray2: TStringGrid; Panel12: TPanel; Label10: TLabel; TxtPivot: TRichEdit; Panel13: TPanel; Label11: TLabel; TxtEvents: TRichEdit; Panel14: TPanel; Label12: TLabel; TxtCustom: TRichEdit; Label13: TLabel; edSQL: TMemo; Panel15: TPanel; Label14: TLabel; TxtReadFile: TRichEdit; ToolButton1: TToolButton; TabSheet17: TTabSheet; Panel16: TPanel; Label15: TLabel; TxtCharts: TRichEdit; Panel17: TPanel; Label16: TLabel; TxtImport: TRichEdit; TxtReport: TRichEdit; ActionPreview: TAction; TabSheet14: TTabSheet; Panel18: TPanel; Label17: TLabel; TxtImgDemo: TRichEdit; Panel19: TPanel; Label18: TLabel; edMyImage: TEdit; btnOpenMyImage: TButton; PopViewTemplate: TPopupMenu; VievwithExcel1: TMenuItem; Openwithinternaleditor1: TMenuItem; ActionViewTemplateInternal: TAction; TabSheet18: TTabSheet; TxtSideBySide: TRichEdit; Label19: TLabel; PopReport: TPopupMenu; MenuItem1: TMenuItem; MenuItem2: TMenuItem; about: TTabSheet; PopupMenu1: TPopupMenu; MenuItem3: TMenuItem; MenuItem4: TMenuItem; Panel20: TPanel; Label20: TLabel; TxtAbout: TRichEdit; TabSheet19: TTabSheet; TxtMemory: TRichEdit; Label21: TLabel; Panel21: TPanel; Label22: TLabel; ActionAutoPrint: TAction; GridMemory: TStringGrid; PrintWARNING1: TMenuItem; N1: TMenuItem; TestAll1: TMenuItem; ActionTestAll: TAction; TabSheet20: TTabSheet; Panel22: TPanel; Label23: TLabel; TxtCreateFile: TRichEdit; ActionFastCount: TAction; ToolButton3: TToolButton; procedure FormCreate(Sender: TObject); procedure ListDemosChange(Sender: TObject; Node: TTreeNode); procedure ActionCloseExecute(Sender: TObject); procedure ActionReportUpdate(Sender: TObject); procedure ActionUseOleExecute(Sender: TObject); procedure ActionHtmlUpdate(Sender: TObject); procedure ActionViewTemplateExcelUpdate(Sender: TObject); procedure ActionUseTStoreExecute(Sender: TObject); procedure ActionUseNativeExecute(Sender: TObject); procedure ActionViewTemplateExcelExecute(Sender: TObject); procedure ActionReportExecute(Sender: TObject); procedure ActionPreviewUpdate(Sender: TObject); procedure ActionPreviewExecute(Sender: TObject); procedure btnOpenMyImageClick(Sender: TObject); procedure ActionViewTemplateInternalExecute(Sender: TObject); procedure ActionAutoPrintExecute(Sender: TObject); procedure ActionTestAllExecute(Sender: TObject); procedure ActionFastCountExecute(Sender: TObject); private DemoEdit: TDemoEdit; DlgReport: TReport; Directory: string; procedure FillGridVarArray(const GridVarArray: TStringGrid); procedure DoReport(const Preview: boolean; const Automatic: boolean); procedure DoImport; procedure DoCreateFile(const Automatic: boolean); procedure FillGridMemory(const GridMemory: TStringGrid); { Private declarations } public { Public declarations } end; var Main: TMain; implementation {$R *.DFM} procedure TMain.FillGridVarArray(const GridVarArray: TStringGrid); var i,k: integer; begin for i:=1 to GridVarArray.ColCount-1 do GridVarArray.Cells[ i , 0]:= chr(ord('A')+i-1); for i:=1 to GridVarArray.RowCount-1 do GridVarArray.Cells[ 0 , i]:= IntToStr(i+3); for i:=1 to GridVarArray.ColCount-1 do for k:=1 to GridVarArray.RowCount-1 do GridVarArray.Cells[ i , k]:= IntToStr(Random(5)); GridVarArray.Cells[3,2]:='FlexCel'; end; procedure TMain.FillGridMemory(const GridMemory: TStringGrid); var i: integer; begin GridMemory.RowCount:=500; GridMemory.Cells[0,0]:='Number'; GridMemory.Cells[1,0]:='Name'; GridMemory.Cells[2,0]:='Date'; GridMemory.Cells[3,0]:='Sex'; for i:=1 to GridMemory.RowCount-1 do begin GridMemory.Cells[ 0 , i]:= IntToStr(i); GridMemory.Cells[ 1 , i]:= 'Test'+IntToStr(i); GridMemory.Cells[ 2 , i]:= DateToStr(Now-random(365*50)); if Random(2)=0 then GridMemory.Cells[ 3 , i]:= 'M' else GridMemory.Cells[ 3 , i]:= 'F'; end; GridMemory.Cells[1,1]:='Adrian'; GridMemory.Cells[2,1]:='8/9/1972'; GridMemory.Cells[3,1]:='M'; GridMemory.Cells[1,2]:='Agus'; GridMemory.Cells[2,2]:='2/3/2002'; GridMemory.Cells[3,2]:='F'; GridMemory.Cells[1,3]:='Zoe'; GridMemory.Cells[2,3]:='1/7/1939'; GridMemory.Cells[3,3]:='F'; for i:=1 to GridMemory.RowCount-1 do GridMemory.Cells[ 0 , i]:= IntToStr(i); end; procedure TMain.FormCreate(Sender: TObject); var i:integer; ExePath: string; begin try for i:=0 to Tabs.PageCount-1 do Tabs.Pages[i].TabVisible:=false; ListDemos.FullExpand; ExePath:=ExtractFilePath(ParamStr(0)); for i:=0 to ComponentCount-1 do if (Components[i] is TRichEdit) and (copy(Components[i].Name,1,3)='Txt') then (Components[i] as TRichEdit).Lines.LoadFromFile( ExePath +'FlDemoSheets\'+ copy(Components[i].Name,4,length(Components[i].Name))+'.rtf'); edSQL.Text:='select * from customer'; //Sometimes it gets deleted if written directly into the designer FillGridVarArray(GridVarArray1); FillGridVarArray(GridVarArray2); FillGridMemory(GridMemory); edMyImage.Text:= ExePath+'FlexCel.bmp'; except on e: Exception do begin Application.ShowException(e); ShowMessage('Make sure you have unzipped all the files'); Application.Terminate; end; end;//Except end; procedure TMain.ListDemosChange(Sender: TObject; Node: TTreeNode); begin Tabs.ActivePageIndex:= Node.AbsoluteIndex; if Tabs.ActivePage.Tag=4 then DemoData.Cust.Open else DemoData.Cust.Close; end; procedure TMain.ActionCloseExecute(Sender: TObject); begin Close; end; procedure TMain.DoReport(const Preview: boolean; const Automatic: boolean); var Dlg: TSaveDialog; StartTime, EndTime: TDateTime; begin StatusBar.SimpleText:=''; //Process Options if BtnUseNative.Down then DemoData.SetAdapter(DemoData.XLSAdapter) else DemoData.SetAdapter(DemoData.OLEAdapter); DemoData.Protect:= BtnProtect.Down; //if it's native or HTML, ask the user for a filename Dlg:=nil; if BtnUseNative.Down then Dlg:=DemoData.XlsSaveDialog else if BtnHTML.Down then Dlg:=DemoData.HTMLSaveDialog; if Automatic then begin Dlg:=nil; DemoData.SetFileName(Directory+'\TestReport'+IntToStr(Tabs.ActivePage.Tag)+'.xls'); if FileExists(Directory+'\TestReport'+IntToStr(Tabs.ActivePage.Tag)+'.xls') then DeleteFile(Directory+'\TestReport'+IntToStr(Tabs.ActivePage.Tag)+'.xls'); end; if Dlg<>nil then begin if not Dlg.Execute then exit; DemoData.SetFileName(Dlg.FileName); if FileExists(Dlg.FileName) then DeleteFile(Dlg.FileName); end; Application.ProcessMessages; if Tabs.ActivePage.Tag=2 then DemoData.FillArrayDemo([GridVarArray1, GridVarArray2]); if Tabs.ActivePage.Tag=3 then DemoData.MyImageFilename:=edMyImage.Text; if Tabs.ActivePage.Tag=6 then DemoData.Cust.Open; DemoData.Cust.Filtered:= Tabs.ActivePage.Tag=6; //So we dont use so many records if BtnUseNative.Down then DemoData.RepPivot.Template:='Templates\PivotDemo AutoOpen.xls' else DemoData.RepPivot.Template:='Templates\PivotDemo.xls'; if Tabs.ActivePage.Tag=11 then DemoData.Ds.SQL:= edSQL.Lines; if Tabs.ActivePage.Tag=13 then DemoData.FillMemTable(GridMemory); {$IFNDEF Excel97} DemoData.OLEAdapter.SaveFormatBasic:=[saHtml]; DemoData.GetReport(Tabs.ActivePage.Tag).AutoClose:= BtnHTML.Down and BtnHTML.Enabled; {$ENDIF} //Run the report StartTime:=Now; DemoData.GetReport(Tabs.ActivePage.Tag).Run; EndTime:=Now; StatusBar.SimpleText:=Format('Last Report took: %f seconds', [(EndTime-StartTime)*24*3600]); if Dlg<>nil then begin if Preview then begin if DlgReport= nil then DlgReport:=TReport.Create(Self); DlgReport.WB.Navigate(Dlg.FileName); try DlgReport.ShowModal; finally FreeAndNil(DlgReport); //only way I've seen to free document end; //finally end else if DemoData.AutoPrint then ShellExecute( Handle,'print', PCHAR(Dlg.FileName), NIL,NIL, SW_Hide) else ShellExecute( Handle,'open', PCHAR(Dlg.FileName), NIL,NIL, SW_SHOW); end; end; procedure TMain.DoImport; begin if not DemoData.OpenDialog.Execute then exit; Application.ProcessMessages; if BtnUseNative.Down then DemoData.SetAdapter(DemoData.XLSAdapter) else DemoData.SetAdapter(DemoData.OLEAdapter); DemoData.XLSAdapter.TemplateStore:=nil; try DemoData.FlexCelImport.OpenFile(DemoData.OpenDialog.FileName); finally ActionUseTStore.Execute; end;//finally try if DemoEdit=nil then DemoEdit:=TDemoEdit.Create(Self); DemoEdit.Caption:=Format(TxtEditing, [DemoData.OpenDialog.FileName]); DemoEdit.FillData; DemoEdit.ShowModal; finally DemoData.FlexCelImport.CloseFile; end; //finally end; procedure TMain.DoCreateFile(const Automatic: boolean); var Fi: TFlexCelImport; FName: string; w: widestring; begin if BtnUseNative.Down then DemoData.SetAdapter(DemoData.XLSAdapter) else DemoData.SetAdapter(DemoData.OLEAdapter); if Automatic then FName:=Directory+'\TestImport'+IntToStr(Tabs.ActivePage.Tag)+'.xls' else begin if not DemoData.XlsSaveDialog.Execute then exit; FName:=DemoData.XlsSaveDialog.FileName; end; if FileExists(FName) then DeleteFile(FName); Fi:=DemoData.FlexCelImport; Fi.OpenFile(ExtractFilePath(ParamStr(0))+'\Templates\NewFile.xls'); Fi.CellValue[6,1]:=integer(Fi.ColorPalette[3]); Fi.ColorPalette[3]:=Rgb(0,200,20); Fi.CellValue[6,2]:=integer(Fi.ColorPalette[3]); Fi.CellValue[3,3]:=5; Fi.CellFormat[2,2]:=Fi.CellFormat[1,1]; Fi.CellValue[2,1]:='Test'; Fi.CellValue[3,1]:='TΘst'; w:=WideChar($266b); Fi.CellValue[4,1]:=w; Fi.RowHeight[3]:=1000; Fi.ColumnWidth[4]:=2000; Fi.RowHeight[4]:=4000; Fi.CellValue[1,3]:=Fi.RowHeight[4]; Fi.AutoRowHeight[4]:=true; Fi.CellValue[1,4]:=Fi.RowHeight[4]; Fi.ActiveSheet:=2; Fi.CellValue[1,1]:=Fi.RowFormat[6]; Fi.CellValue[1,2]:=Fi.ColumnFormat[2]; Fi.CellValue[6,1]:='Testing'; //Fi.CellValue[6,2]:='Testing'; Fi.CellValue[6,3]:='Testing'; Fi.RowFormat[6]:=Fi.FormatListCount-1; Fi.ColumnFormat[2]:=Fi.FormatListCount-2; Fi.CellValue[2,1]:=Fi.RowFormat[6]; Fi.CellValue[2,2]:=Fi.ColumnFormat[2]; Fi.CellValue[6,4]:='Testing'; Fi.Save(FName); Fi.CloseFile; //Just to test I can read what I wrote... Fi.OpenFile(FName); Fi.CloseFile; end; procedure TMain.ActionReportUpdate(Sender: TObject); begin ActionReport.Enabled:= Tabs.ActivePage.Tag>0; if Tabs.ActivePage.Tag<>100 then begin ActionReport.ImageIndex:= 13; ActionReport.Caption:='Report !'; end else begin ActionReport.ImageIndex:= 0; ActionReport.Caption:='Import !'; end; end; procedure TMain.ActionUseOleExecute(Sender: TObject); begin // end; procedure TMain.ActionHtmlUpdate(Sender: TObject); begin ActionUseNative.Checked:= BtnUseNative.Down; ActionUseOle.Checked:= BtnUseOle.Down and (Tabs.ActivePage.Tag<100); ActionProtect.Enabled:=ActionUseOle.Checked and (Tabs.ActivePage.Tag<100); ActionUseTStore.Enabled:=ActionUseNative.Checked and (Tabs.ActivePage.Tag<100); ActionAutoPrint.Enabled:=(Tabs.ActivePage.Tag<100); ActionFastCount.Enabled:=(Tabs.ActivePage.Tag>0)and(Tabs.ActivePage.Tag<100); {$IfDef Excel97} ActionHTML.Enabled:=false; {$Else} ActionHtml.Enabled:=ActionUseOle.Checked and (Tabs.ActivePage.Tag<100); {$Endif} end; procedure TMain.ActionViewTemplateExcelUpdate(Sender: TObject); begin ActionViewTemplateExcel.Enabled:=ActionReport.Enabled and (Tabs.ActivePage.Tag<100); ActionViewTemplateInternal.Enabled:=ActionViewTemplateExcel.Enabled; end; procedure TMain.ActionUseTStoreExecute(Sender: TObject); begin if DemoData.XlsTemplateStore.Templates.Count=0 then begin showmessage('For size considerations in the zipped file, this demo has the template store empty. If you want to use it, edit the unit UFLDemoData, double click the store, and add all the files from the folder "Templates"'); BtnUseTStore.Down:=false; exit; end; if BtnUseTStore.Down then DemoData.XLSAdapter.TemplateStore:=DemoData.XlsTemplateStore else DemoData.XLSAdapter.TemplateStore:=nil; end; procedure TMain.ActionUseNativeExecute(Sender: TObject); begin // end; procedure TMain.ActionViewTemplateExcelExecute(Sender: TObject); var WaitCursor: IWaitCursor; begin WaitCursor:=TWaitCursor.Create; BtnViewTemplate.Action:=ActionViewTemplateExcel; ShellExecute( Handle,'open', PCHAR(ExtractFilePath(Paramstr(0))+DemoData.GetReport(Tabs.ActivePage.Tag).Template), NIL,NIL, SW_SHOW); end; procedure TMain.ActionViewTemplateInternalExecute(Sender: TObject); var WaitCursor: IWaitCursor; begin WaitCursor:=TWaitCursor.Create; BtnViewTemplate.Action:=ActionViewTemplateInternal; InvokeExcelEditor( DemoData, ExtractFilePath(Paramstr(0))+DemoData.GetReport(Tabs.ActivePage.Tag).Template); end; procedure TMain.ActionReportExecute(Sender: TObject); var WaitCursor: IWaitCursor; begin WaitCursor:=TWaitCursor.Create; if Tabs.ActivePage.Tag<100 then DoReport(false, false) else if Tabs.ActivePage.Tag=100 then DoImport else DoCreateFile(false); end; procedure TMain.ActionPreviewUpdate(Sender: TObject); begin ActionPreview.Enabled:= ActionViewTemplateExcel.Enabled and (not BtnUseOle.Down or BtnHTML.Down); end; procedure TMain.ActionPreviewExecute(Sender: TObject); var WaitCursor: IWaitCursor; begin WaitCursor:=TWaitCursor.Create; DoReport(true, false); end; procedure TMain.btnOpenMyImageClick(Sender: TObject); begin if not DemoData.OpenPictureDialog.Execute then exit; edMyImage.Text:= DemoData.OpenPictureDialog.FileName; end; procedure TMain.ActionAutoPrintExecute(Sender: TObject); var WaitCursor:IWaitCursor; begin if MessageDlg('This will print the report into a printer!'#10'Make sure you have a printer connected before you try'#10#10'Also, if in NATIVE mode, do not print reports with formulas'#10#10'┐CONTINUE?', mtWarning,[mbYes, mbNo], 0)<> mrYes then exit; WaitCursor:=TWaitCursor.Create; DemoData.AutoPrint:=true; try if Tabs.ActivePage.Tag<100 then DoReport(false, false); finally DemoData.AutoPrint:=false; end; //finally end; procedure TMain.ActionTestAllExecute(Sender: TObject); var WaitCursor:IWaitCursor; i: integer; begin if MessageDlg('This is a test I use to check the suite for memory leaks and more'#10'It will run all the reports and can take some time to complete'#10#10'┐CONTINUE?', mtWarning,[mbYes, mbNo], 0)<> mrYes then exit; WaitCursor:=TWaitCursor.Create; Directory:=''; if not SelectDirectory('Select the folder to store the reports','', Directory) then exit; ListDemos.FullCollapse; for i:=0 to Tabs.PageCount-1 do if (Tabs.Pages[i].Tag>0)and (Tabs.Pages[i].Tag<>100) then begin Tabs.ActivePageIndex:=i; Application.ProcessMessages; if Tabs.Pages[i].Tag<100 then DoReport(false, true) else DoCreateFile(true); end; ListDemos.FullExpand; ListDemos.Selected:=ListDemos.Items[1]; ListDemos.Selected:=ListDemos.Items[0]; end; procedure TMain.ActionFastCountExecute(Sender: TObject); begin ActionFastCount.Checked:=not ActionFastCount.Checked; DemoData.ChangeFastCount(ActionFastCount.Checked); end; end.