mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-10-29 10:51:41 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			260 lines
		
	
	
		
			6.6 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			260 lines
		
	
	
		
			6.6 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     This file is part of the Free Component Library.
 | |
|     Copyright (c) 2016 Michael Van Canneyt, member of the Free Pascal development team
 | |
| 
 | |
|     FPImage form export - render fpReport to a form.
 | |
|     Simple version, no design time
 | |
| 
 | |
|     See the file COPYING.FPC, included in this distribution,
 | |
|     for details about the copyright.
 | |
| 
 | |
|     This program is distributed in the hope that it will be useful,
 | |
|     but WITHOUT ANY WARRANTY; without even the implied warranty of
 | |
|     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 | |
| 
 | |
|  **********************************************************************}
 | |
| unit fpreportformexport;
 | |
| 
 | |
| {$mode objfpc}{$H+}
 | |
| 
 | |
| {$DEFINE USEPAINTBOX}
 | |
| 
 | |
| interface
 | |
| 
 | |
| uses
 | |
|   Classes, SysUtils, fpreport, forms, comctrls, extctrls, fpreportlclexport, controls, actnlist;
 | |
| 
 | |
| Type
 | |
| 
 | |
|   { TCustomFPreportPreviewForm }
 | |
| 
 | |
|   TCustomFPreportPreviewForm = Class(TForm)
 | |
|   private
 | |
|     FReport: TFPCustomReport;
 | |
|     FReportPages: TFPList;
 | |
|   Protected
 | |
|     function GetEnableHyperLinks: Boolean ; virtual;
 | |
|     procedure SetEnableHyperLinks(AValue: Boolean); virtual;
 | |
|     procedure SetReport(AValue: TFPCustomReport); virtual;
 | |
|     Property ReportPages : TFPList Read FReportPages;
 | |
|     Class Function LoadFromResource : Boolean; virtual;
 | |
|   Public
 | |
|     Property Report : TFPCustomReport Read FReport Write SetReport;
 | |
|   Published
 | |
|     Property EnableHyperLinks : Boolean Read GetEnableHyperLinks Write SetEnableHyperLinks;
 | |
|   end;
 | |
|   TCustomFPreportPreviewFormClass = Class of TCustomFPreportPreviewForm;
 | |
| 
 | |
|   { TFPreportPreviewForm }
 | |
|   // This is a default, minimalistic implementation. It is shown by default.
 | |
|   // For a better implementation, add the fpreportpreview form to your project uses clause.
 | |
| 
 | |
|   TFPreportPreviewForm = Class(TCustomFPreportPreviewForm)
 | |
|   Private
 | |
|     FToolBar : TToolbar;
 | |
|     FActions : TActionList;
 | |
| {$IFDEF USEPAINTBOX}
 | |
|     FPaintBox : TPaintBox;
 | |
| {$ELSE}
 | |
|     FPaintBox : TPanel;
 | |
| {$ENDIF}
 | |
|     FRender : TFPReportExportCanvas;
 | |
|     FAClose : TAction;
 | |
|     FBClose : TToolButton;
 | |
|     FAPrevious : TAction;
 | |
|     FBPrevious : TToolButton;
 | |
|     FANext : TAction;
 | |
|     FBNext : TToolButton;
 | |
|   Protected
 | |
|     procedure SetReport(AValue: TFPCustomReport); override;
 | |
|   Public
 | |
|     Constructor CreateNew(AOwner: TComponent; Num: Integer=0); override;
 | |
|     procedure DoCloseAction(Sender: TObject);
 | |
|     procedure DoNextAction(Sender: TObject);
 | |
|     procedure DoPaintReport(Sender: TObject);
 | |
|     procedure DoPreviousAction(Sender: TObject);
 | |
|     procedure UpdateNextAction(Sender: TObject);
 | |
|     procedure UpdatePreviousAction(Sender: TObject);
 | |
|   end;
 | |
| 
 | |
|   { TFPreportPreviewExport }
 | |
| 
 | |
|   TFPreportPreviewExport = Class(TFPReportExporter)
 | |
|   Protected
 | |
|     procedure DoExecute(const ARTObjects: TFPList); override;
 | |
|   Public
 | |
|     Class Var
 | |
|        DefaultPreviewFormClass : TCustomFPreportPreviewFormClass;
 | |
|     Class Function Name : String; override;
 | |
|     Class Function Description : String; override;
 | |
|   end;
 | |
| 
 | |
| implementation
 | |
| 
 | |
| { TCustomFPreportPreviewForm }
 | |
| 
 | |
| procedure TCustomFPreportPreviewForm.SetEnableHyperLinks(AValue: Boolean);
 | |
| begin
 | |
| //
 | |
| end;
 | |
| 
 | |
| function TCustomFPreportPreviewForm.GetEnableHyperLinks: Boolean;
 | |
| begin
 | |
|   Result:=False;
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure TCustomFPreportPreviewForm.SetReport(AValue: TFPCustomReport);
 | |
| begin
 | |
|   if FReport=AValue then Exit;
 | |
|   FReport:=AValue;
 | |
| end;
 | |
| 
 | |
| class function TCustomFPreportPreviewForm.LoadFromResource: Boolean;
 | |
| begin
 | |
|   Result:=False;
 | |
| end;
 | |
| 
 | |
| { TFPreportPreviewExport }
 | |
| 
 | |
| procedure TFPreportPreviewExport.DoExecute(const ARTObjects: TFPList);
 | |
| Var
 | |
|   R : TCustomFPreportPreviewFormClass;
 | |
|   F : TCustomFPreportPreviewForm;
 | |
| 
 | |
| begin
 | |
|   R:=Self.DefaultPreviewFormClass;
 | |
|   if R=Nil then
 | |
|     R:=TFPreportPreviewForm;
 | |
|   If R.LoadFromResource then
 | |
|     F:=R.Create(Self)
 | |
|   else
 | |
|     F:=R.CreateNew(Self,0);
 | |
|   With F do
 | |
|     try
 | |
|        Report:=Self.Report;
 | |
|        FReportPages:=ARTObjects;
 | |
|        ShowModal;
 | |
|     finally
 | |
|        Free;
 | |
|     end;
 | |
| end;
 | |
| 
 | |
| class function TFPreportPreviewExport.Name: String;
 | |
| begin
 | |
|   Result:='Preview';
 | |
| end;
 | |
| 
 | |
| class function TFPreportPreviewExport.Description: String;
 | |
| begin
 | |
|   Result:='Preview on screen';
 | |
| end;
 | |
| 
 | |
| { TFPreportPreviewForm }
 | |
| 
 | |
| procedure TFPreportPreviewForm.SetReport(AValue: TFPCustomReport);
 | |
| begin
 | |
|   inherited SetReport(AValue);
 | |
|   FRender.Report:=AValue;
 | |
|   If Assigned(AValue) then
 | |
|     FRender.Execute;
 | |
| end;
 | |
| 
 | |
| constructor TFPreportPreviewForm.CreateNew(AOwner: TComponent; Num: Integer);
 | |
| 
 | |
| Var
 | |
|   ButtonLeft : Integer;
 | |
| 
 | |
|   Function CreateAction(Const ACaption : STring; AImageIndex : Integer; AOnExecute,  AOnUpdate : TNotifyEvent) : TAction;
 | |
| 
 | |
|   begin
 | |
|     Result:=Taction.Create(Self);
 | |
|     Result.ActionList:=FActions;
 | |
|     Result.Caption:=ACaption;
 | |
|     Result.OnExecute:=AOnExecute;
 | |
|     Result.OnUpdate:=AOnUpdate;
 | |
|   end;
 | |
| 
 | |
|   Function CreateButton(AAction : TAction) : TToolbutton;
 | |
| 
 | |
|   begin
 | |
|      Result:=TToolButton.Create(Self);
 | |
|      Result.Parent:=FToolbar;
 | |
|      Result.Top:=0;
 | |
|      Result.Left:=ButtonLeft;
 | |
|      Result.Width:=32;
 | |
|      Result.Height:=FToolbar.ButtonHeight;
 | |
|      Result.Caption:=IntToStr(ButtonLeft);
 | |
|      Result.Action:=AAction;
 | |
|      ButtonLeft:=ButtonLeft+Result.Width+1;
 | |
|   end;
 | |
| 
 | |
| begin
 | |
|   inherited CreateNew(AOwner, Num);
 | |
|   ButtonLeft:=0;
 | |
|   WindowState:=wsMaximized;
 | |
|   FActions:=TActionList.Create(Self);
 | |
|   FToolBar:=TToolbar.Create(Self);
 | |
|   FToolbar.ShowCaptions:=True;
 | |
|   FToolBar.Height:=24;
 | |
|   FToolbar.ButtonHeight:=22;
 | |
|   FToolBar.Parent:=Self;
 | |
|   FToolBar.Align:=alTop;
 | |
|   FToolBar.Flat:=True;
 | |
|   FAClose:=CreateAction('Close',0,@DoCloseAction,Nil);
 | |
|   FBClose:=CreateButton(FAClose);
 | |
|   FAPrevious:=CreateAction('Previous',1,@DoPreviousAction,@UpdatePreviousAction);
 | |
|   FBPrevious:=CreateButton(FAPrevious);
 | |
|   FANext:=CreateAction('Next',1,@DoNextAction,@UpdateNextAction);
 | |
|   FBNext:=CreateButton(FANext);
 | |
| {$IFDEF USEPAINTBOX}
 | |
|   FPaintBox:=TPaintBox.Create(Self);
 | |
| {$ELSE}
 | |
|   FPaintBox:=TPanel.Create(Self);
 | |
|   FPaintBox.BevelInner:=bvLowered;
 | |
|   FPaintBox.Caption:='';
 | |
| {$ENDIF}
 | |
|   FPaintBox.Parent:=Self;
 | |
|   FPaintBox.Align:=alClient;
 | |
|   FPaintBox.OnPaint:=@DoPaintReport;
 | |
|   FRender:=TFPReportExportCanvas.Create(Self);
 | |
|   FRender.Canvas:=FPaintBox.Canvas;
 | |
|   Caption:='fpReport preview';
 | |
| end;
 | |
| 
 | |
| procedure TFPreportPreviewForm.DoCloseAction(Sender: TObject);
 | |
| begin
 | |
|   Close;
 | |
| end;
 | |
| 
 | |
| procedure TFPreportPreviewForm.DoNextAction(Sender: TObject);
 | |
| begin
 | |
|   FRender.PageIndex:=FRender.PageIndex+1
 | |
| end;
 | |
| 
 | |
| procedure TFPreportPreviewForm.DoPaintReport(Sender: TObject);
 | |
| begin
 | |
|   FRender.Execute;
 | |
| end;
 | |
| 
 | |
| procedure TFPreportPreviewForm.DoPreviousAction(Sender: TObject);
 | |
| begin
 | |
|   FRender.PageIndex:=FRender.PageIndex-1;
 | |
| end;
 | |
| 
 | |
| procedure TFPreportPreviewForm.UpdateNextAction(Sender: TObject);
 | |
| begin
 | |
|   (Sender as TAction).Enabled:=(FRender.PageIndex<ReportPages.Count-1);
 | |
| end;
 | |
| 
 | |
| procedure TFPreportPreviewForm.UpdatePreviousAction(Sender: TObject);
 | |
| begin
 | |
|   (Sender as TAction).Enabled:=(FRender.PageIndex>0);
 | |
| 
 | |
| end;
 | |
| 
 | |
| initialization
 | |
|   TFPreportPreviewExport.RegisterExporter;
 | |
| end.
 | |
| 
 | 
