mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-02 13:03:51 +02: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.
|
|
|