{******************************************} { } { FastReport v4.0 } { Report preview } { } { Copyright (c) 1998-2008 } { by Alexander Tzyganenko, } { Fast Reports Inc. } { } {******************************************} unit FMX.frxPreview; interface {$I fmx.inc} {$I frx.inc} uses System.Classes, System.SysUtils, System.Types, System.UITypes, System.Variants, FMX.Types, FMX.Controls, FMX.TreeView, FMX.Menus, FMX.Forms, FMX.Edit, FMX.Dialogs, System.UIConsts, FMX.frxCtrls, FMX.frxPreviewPages, FMX.frxClass, FMX.frxFMX, FMX.ListBox, FMX.Objects, FMX.frxBaseModalForm {$IFDEF DELPHI18} ,FMX.StdCtrls {$ENDIF} {$IFDEF DELPHI19} , FMX.Graphics {$ENDIF} {$IFDEF DELPHI20} , System.Math.Vectors {$ENDIF} {$IFDEF DELPHI21} , FMX.ComboEdit {$ENDIF} {$IFDEF DELPHI28} , FMX.BaseTypeAliases, FMX.FormTypeAliases {$ENDIF}; type TfrxPreview = class; TfrxPreviewWorkspace = class; TfrxPageList = class; TfrxPageChangedEvent = procedure(Sender: TfrxPreview; PageNo: Integer) of object; {$I frxFMX_PlatformsAttribute.inc} TfrxPreview = class(TfrxCustomPreview) private FAllowF3: Boolean; FCancelButton: TButton; FLocked: Boolean; FMessageLabel: TLabel; FMessagePanel: TPanel; FOnPageChanged: TfrxPageChangedEvent; FOutline: TTreeView; FOutlineColor: TAlphaColor; FOutlinePopup: TPopupMenu; FPageNo: Integer; FRefreshing: Boolean; FRunning: Boolean; FSplitter: TfrxSplitter; FThumbnail: TfrxPreviewWorkspace; FWorkspace: TfrxPreviewWorkspace; FZoom: Double; FZoomMode: TfrxZoomMode; HintPanel: TCalloutPanel; HintLabel: TLabel; function GetActiveFrameColor: TAlphaColor; function GetBackColor: TAlphaColor; function GetFrameColor: TAlphaColor; function GetOutlineVisible: Boolean; function GetOutlineWidth: Integer; function GetPageCount: Integer; function GetThumbnailVisible: Boolean; function GetOnMouseDown: TMouseEvent; procedure EditTemplate; procedure OnCancel(Sender: TObject); procedure OnCollapseClick(Sender: TObject); procedure OnExpandClick(Sender: TObject); procedure OnMoveSplitter(Sender: TObject); procedure OnOutlineClick(Sender: TObject); procedure SetActiveFrameColor(const Value: TAlphaColor); procedure SetBackColor(const Value: TAlphaColor); procedure SetFrameColor(const Value: TAlphaColor); procedure SetOutlineColor(const Value: TAlphaColor); procedure SetOutlineWidth(const Value: Integer); procedure SetOutlineVisible(const Value: Boolean); procedure SetPageNo(Value: Integer); procedure SetThumbnailVisible(const Value: Boolean); procedure SetZoom(const Value: Double); procedure SetZoomMode(const Value: TfrxZoomMode); procedure SetOnMouseDown(const Value: TMouseEvent); procedure UpdateOutline; procedure UpdatePages; procedure UpdatePageNumbers; protected procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override; procedure Resize; override; procedure OnResize(Sender: TObject); procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetParent(const Value: TFmxObject); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetCanvas: TCanvas; override; procedure Init; override; procedure Lock; override; procedure ShowHint(aRect: TRectF; Text: String); override; procedure HideHint; override; procedure Unlock; override; procedure RefreshReport; override; procedure InternalOnProgressStart(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); override; procedure InternalOnProgress(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); override; procedure InternalOnProgressStop(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); override; procedure AddPage; procedure DeletePage; procedure Print; procedure Edit; procedure First; procedure Next; procedure Prior; procedure Last; procedure PageSetupDlg; procedure PageSetupDialog; procedure Cancel; procedure Clear; procedure ClearBackBuffer; override; procedure SetPosition(PageN, Top: Integer); procedure ShowMessage(const s: String); procedure HideMessage; procedure MouseWheelScroll(Delta: Integer; Horz: Boolean = False; Zoom: Boolean = False); function GetTopPosition: Integer; procedure LoadFromFile; overload; procedure LoadFromFile(FileName: String); overload; procedure SaveToFile; overload; procedure SaveToFile(FileName: String); overload; procedure Export(Filter: TfrxCustomExportFilter); property PageCount: Integer read GetPageCount; property PageNo: Integer read FPageNo write SetPageNo; property Zoom: Double read FZoom write SetZoom; property ZoomMode: TfrxZoomMode read FZoomMode write SetZoomMode; property Locked: Boolean read FLocked; property OutlineTree: TTreeView read FOutline; property Splitter: TfrxSplitter read FSplitter; property Thumbnail: TfrxPreviewWorkspace read FThumbnail; property Workspace: TfrxPreviewWorkspace read FWorkspace; published property Align; property ActiveFrameColor: TAlphaColor read GetActiveFrameColor write SetActiveFrameColor default $804020; property BackColor: TAlphaColor read GetBackColor write SetBackColor default claGray; property FrameColor: TAlphaColor read GetFrameColor write SetFrameColor default claBlack; property OutlineColor: TAlphaColor read FOutlineColor write SetOutlineColor default claWhite; property OutlineVisible: Boolean read GetOutlineVisible write SetOutlineVisible; property OutlineWidth: Integer read GetOutlineWidth write SetOutlineWidth; property PopupMenu; property Position; property Width stored True; property Height stored True; property ThumbnailVisible: Boolean read GetThumbnailVisible write SetThumbnailVisible; property OnClick; property OnDblClick; property OnPageChanged: TfrxPageChangedEvent read FOnPageChanged write FOnPageChanged; property OnMouseDown: TMouseEvent read GetOnMouseDown write SetOnMouseDown; property Anchors; property UseReportHints; end; TfrxPreviewForm = class(TfrxForm) ToolBar: TToolBar; OpenB: TfrxToolButton; SaveB: TfrxToolButton; PrintB: TfrxToolButton; ExportB: TfrxToolButton; PageSettingsB: TfrxToolButton; FirstB: TfrxToolButton; PriorB: TfrxToolButton; PageE: TEdit; NextB: TfrxToolButton; LastB: TfrxToolButton; StatusBar: TStatusBar; DesignerB: TfrxToolButton; CancelB: TSpeedButton; ExportPopup: TPopupMenu; HiddenMenu: TPopupMenu; Showtemplate1: TMenuItem; RightMenu: TPopupMenu; FullScreenBtn: TfrxToolButton; OutlineB: TfrxToolButton; ThumbB: TfrxToolButton; N1: TMenuItem; ExpandMI: TMenuItem; CollapseMI: TMenuItem; Line1: TfrxToolSeparator; PageWidthB: TfrxToolButton; WholePageB: TfrxToolButton; Line2: TfrxToolSeparator; Line3: TfrxToolSeparator; Panel0: TText; Panel1: TText; Panel2: TText; OpenMI: TMenuItem; SaveMI: TMenuItem; PrintMI: TMenuItem; ExportMI: TMenuItem; ExportPDFMI: TMenuItem; ExportMailMI: TMenuItem; FindMI: TMenuItem; FullScrMI: TMenuItem; ZoomInMI: TMenuItem; ZoomOutMI: TMenuItem; ZoomCB: TComboEdit; HintPanel: TCalloutPanel; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure ZoomMinusBClick(Sender: TObject); procedure FirstBClick(Sender: TObject); procedure PriorBClick(Sender: TObject); procedure NextBClick(Sender: TObject); procedure LastBClick(Sender: TObject); procedure PageEClick(Sender: TObject); procedure PrintBClick(Sender: TObject); procedure OpenBClick(Sender: TObject); procedure SaveBClick(Sender: TObject); procedure DesignerBClick(Sender: TObject); procedure NewPageBClick(Sender: TObject); procedure DelPageBClick(Sender: TObject); procedure CancelBClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState); procedure PageSettingsBClick(Sender: TObject); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); procedure DesignerBMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Showtemplate1Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FullScreenBtnClick(Sender: TObject); procedure PdfBClick(Sender: TObject); procedure EmailBClick(Sender: TObject); procedure ZoomPlusBClick(Sender: TObject); procedure OutlineBClick(Sender: TObject); procedure ThumbBClick(Sender: TObject); procedure CollapseAllClick(Sender: TObject); procedure ExpandAllClick(Sender: TObject); procedure ZoomCBChange(Sender: TObject); procedure PageWidthBClick(Sender: TObject); procedure WholePageBClick(Sender: TObject); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure ExportBClick(Sender: TObject); procedure ZoomCBClick(Sender: TObject); procedure PrintBMouseEnter(Sender: TObject); procedure PrintBMouseLeave(Sender: TObject); private FPopUpMItemsCount: Integer; FPopUpExporttemsCount: Integer; FFreeOnClose: Boolean; FPreview: TfrxPreview; FOldState: TWindowState; FFullScreen: Boolean; FPDFExport: TfrxCustomExportFilter; FEmailExport: TfrxCustomExportFilter; procedure ExportMIClick(Sender: TObject); procedure OnPageChanged(Sender: TfrxPreview; PageNo: Integer); procedure OnPreviewDblClick(Sender: TObject); procedure UpdateControls; procedure UpdateZoom; function GetReport: TfrxReport; public procedure Init; procedure SetMessageText(const Value: String; IsHint: Boolean = False); procedure SwitchToFullScreen; property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose; property Preview: TfrxPreview read FPreview; property Report: TfrxReport read GetReport; end; TfrxPreviewWorkspace = class(TfrxScrollWin) private FActiveFrameColor: TAlphaColor; FBackColor: TAlphaColor; FDefaultCursor: TCursor; FDisableUpdate: Boolean; FDown: Boolean; FFrameColor: TAlphaColor; FIsThumbnail: Boolean; FLastPoint: TPointF; FLocked: Boolean; FOffset: TPoint; FOldOffset: TPoint; FPageList: TfrxPageList; FPageNo: Integer; FPreview: TfrxPreview; FPreviewPages: TfrxCustomPreviewPages; FZoom: Double; FRTLLanguage: Boolean; FDrawBuffer: TBitmap; FDrawBuffer2: TBitmap; FNeedBufferClear: Boolean; FDoubleBuffered: Boolean; FFastCanvas: TfrxFastCanvasLayer; FDoDblClick: Boolean; FParentForm: TfmxObject; procedure DrawPages(BorderOnly: Boolean; DrawCanvas: TCanvas; ARect: TRectF); procedure SetToPageNo(PageNo: Integer); procedure UpdateScrollBars; procedure SetDoubleBuffered(const Value: Boolean); procedure SetLocked(const Value: Boolean); protected procedure PrevDblClick(Sender: TObject); procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; procedure MouseMove(Shift: TShiftState; X, Y: Single); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; procedure OnHScrollChange(Sender: TObject); override; procedure OnVScrollChange(Sender: TObject); override; procedure SetParent(const Value: TFmxObject); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetPosition(PageN, Top: Integer); function GetTopPosition: Integer; procedure ClearBackBuffer; { page list } procedure AddPage(AWidth, AHeight: Integer); procedure ClearPageList; procedure CalcPageBounds(ClientWidth: Integer); procedure DoContentPaint(Sender: TObject; aCanvas: TCanvas; const ARect: TRectF); override; property ActiveFrameColor: TAlphaColor read FActiveFrameColor write FActiveFrameColor default $804020; property BackColor: TAlphaColor read FBackColor write FBackColor default claGray; property DoubleBuffered: Boolean read FDoubleBuffered write SetDoubleBuffered default True; property FrameColor: TAlphaColor read FFrameColor write FFrameColor default claBlack; property IsThumbnail: Boolean read FIsThumbnail write FIsThumbnail; property Locked: Boolean read FLocked write SetLocked; property PageNo: Integer read FPageNo write FPageNo; property Preview: TfrxPreview read FPreview write FPreview; property PreviewPages: TfrxCustomPreviewPages read FPreviewPages write FPreviewPages; property Zoom: Double read FZoom write FZoom; property RTLLanguage: Boolean read FRTLLanguage write FRTLLanguage; property OnDblClick; end; TfrxPageItem = class(TCollectionItem) public Height: Integer; Width: Integer; OffsetX: Integer; OffsetY: Integer; end; TfrxPageList = class(TCollection) private FMaxWidth: Integer; function GetItems(Index: Integer): TfrxPageItem; public constructor Create; property Items[Index: Integer]: TfrxPageItem read GetItems; default; procedure AddPage(AWidth, AHeight: Integer; Zoom: Extended); procedure CalcBounds(ClientWidth: Integer); function FindPage(OffsetY: Integer; OffsetX: Integer = 0): Integer; function GetPageBounds(Index: Integer; ClientWidth: Single; Scale: Extended; RTL: Boolean): TRect; function GetMaxBounds: TPoint; end; implementation {$R *.FMX} {$R *.RES} uses FMX.frxPrinter, FMX.frxSearchDialog, FMX.frxUtils, FMX.frxRes, FMX.frxDsgnIntf, FMX.frxPreviewPageSettings, FMX.frxDMPClass; { TfrxPageList } constructor TfrxPageList.Create; begin inherited Create(TfrxPageItem); end; function TfrxPageList.GetItems(Index: Integer): TfrxPageItem; begin Result := TfrxPageItem(inherited Items[Index]); end; procedure TfrxPageList.AddPage(AWidth, AHeight: Integer; Zoom: Extended); begin with TfrxPageItem(Add) do begin Width := Round(AWidth * Zoom); Height := Round(AHeight * Zoom); end; end; procedure TfrxPageList.CalcBounds(ClientWidth: Integer); var i, j, CurX, CurY, MaxY, offs: Integer; Item: TfrxPageItem; begin FMaxWidth := 0; CurY := 10; i := 0; while i < Count do begin j := i; CurX := 0; MaxY := 0; { find series of pages that will fit in the clientwidth } { also calculate max height of series } while j < Count do begin Item := Items[j]; { check the width, allow at least one iteration } if (CurX > 0) and (CurX + Item.Width > ClientWidth) then break; Item.OffsetX := CurX; Item.OffsetY := CurY; Inc(CurX, Item.Width + 10); if Item.Height > MaxY then MaxY := Item.Height; Inc(j); end; if CurX > FMaxWidth then FMaxWidth := CurX; { center series horizontally } offs := (ClientWidth - CurX + 10) div 2; if offs < 0 then offs := 0; Inc(offs, 10); while (i < j) do begin Inc(Items[i].OffsetX, offs); Inc(i); end; Inc(CurY, MaxY + 10); end; end; function TfrxPageList.FindPage(OffsetY: Integer; OffsetX: Integer = 0): Integer; var i, i0, i1, c, add: Integer; Item: TfrxPageItem; begin i0 := 0; i1 := Count - 1; while i0 <= i1 do begin i := (i0 + i1) div 2; if OffsetX <> 0 then add := 0 else add := Round(Items[i].Height / 5); if Items[i].OffsetY <= OffsetY + add then c := -1 else c := 1; if c < 0 then i0 := i + 1 else i1 := i - 1; end; { find exact page } if OffsetX <> 0 then begin for i := i1 - 20 to i1 + 20 do begin if (i < 0) or (i >= Count) then continue; Item := Items[i]; if PtInRect(Rect(Item.OffsetX, Item.OffsetY, Item.OffsetX + Item.Width, Item.OffsetY + Item.Height), Point(OffsetX, OffsetY)) then begin i1 := i; break; end; end; end; Result := i1; end; function TfrxPageList.GetPageBounds(Index: Integer; ClientWidth: Single; Scale: Extended; RTL: Boolean): TRect; var ColumnOffs: Integer; Item: TfrxPageItem; begin if (Index >= Count) or (Index < 0) then begin if 794 * Scale > ClientWidth then ColumnOffs := 10 else ColumnOffs := Round((ClientWidth - 794 * Scale) / 2); Result.Left := ColumnOffs; Result.Top := Round(10 * Scale); Result.Right := Result.Left + Round(794 * Scale); Result.Bottom := Result.Top + Round(1123 * Scale); end else begin Item := Items[Index]; if RTL then Result.Left := Round(ClientWidth) - Item.Width - Item.OffsetX else Result.Left := Item.OffsetX; Result.Top := Item.OffsetY; Result.Right := Result.Left + Item.Width; Result.Bottom := Result.Top + Item.Height; end; end; function TfrxPageList.GetMaxBounds: TPoint; begin if Count = 0 then Result := Point(0, 0) else begin Result.X := FMaxWidth; Result.Y := Items[Count - 1].OffsetY + Items[Count - 1].Height; end; end; { TfrxPreviewWorkspace } type TCommonCustomFormHack = class(TCommonCustomForm); constructor TfrxPreviewWorkspace.Create(AOwner: TComponent); begin inherited; FPageList := TfrxPageList.Create; OnDblClick := PrevDblClick; FDoDblClick := False; FBackColor := claGray; FFrameColor := claBlack; FActiveFrameColor := $804020; FZoom := 1; FDefaultCursor := crDefault; FDrawBuffer := TBitmap.Create(1, 1); FDrawBuffer2 := TBitmap.Create(1, 1); FOldOffset := Point(0, 0); FDoubleBuffered := True; {$IFDEF DELPHI27} FDoubleBuffered := FDoubleBuffered and not GlobalUseMetal; {$ENDIF}; FFastCanvas := nil; FParentForm := nil; if frxCanvasClass <> nil then FFastCanvas := frxCanvasClass.Create; end; destructor TfrxPreviewWorkspace.Destroy; begin FPageList.Free; if Assigned(FDrawBuffer) then FreeAndNil(FDrawBuffer); if Assigned(FDrawBuffer2) then FreeAndNil(FDrawBuffer2); if Assigned(FFastCanvas) then FreeAndNil(FFastCanvas); inherited; end; procedure TfrxPreviewWorkspace.DoContentPaint(Sender: TObject; aCanvas: TCanvas; const ARect: TRectF); begin if Assigned(FFastCanvas)then begin if not Assigned(FParentForm) then begin FParentForm := Parent; while (FParentForm <> nil) and not (FParentForm is TCommonCustomForm) do FParentForm := FParentForm.Parent; end; if FParentForm <> nil then TfrxFastCanvasLayer(FFastCanvas).Context := TCommonCustomFormHack(FParentForm).ContextHandle; end; DrawPages(False, aCanvas, ARect); inherited; end; procedure TfrxPreviewWorkspace.OnHScrollChange(Sender: TObject); begin FOffset.X := Round(HorzPosition); Repaint; end; procedure TfrxPreviewWorkspace.OnVScrollChange(Sender: TObject); var i: Integer; begin FOffset.Y := Round(VertPosition); Repaint; if not FIsThumbnail then begin i := FPageList.FindPage(FOffset.Y); FDisableUpdate := True; Preview.PageNo := i + 1; FDisableUpdate := False; end; end; procedure TfrxPreviewWorkspace.DrawPages(BorderOnly: Boolean; DrawCanvas: TCanvas; ARect: TRectF); var n, aWidth, aHeight, TmpOffset: Integer; PageBounds: TRect; WorkArea, WorkRect, WorkAreaX, WorkAreaY: TRectF; BufferArea: TRectF; poly: TPolygon; state: TCanvasSaveState; cWidth: Single; m: TMatrix; aCanvas: TCanvas; bUseBuffer: Boolean; function PageVisible: Boolean; begin if (PageBounds.Top > WorkArea.Bottom) or (PageBounds.Bottom < WorkArea.Top) then Result := False else Result := True; end; procedure DrawPage(Index: Integer); var state: TCanvasSaveState; m: TMatrix; FramePath: TPathData; begin WorkRect := RectF(PageBounds.Left, PageBounds.Top, PageBounds.Right, PageBounds.Bottom); { correct work reak with re-draw work area } if WorkArea.Left > WorkRect.Left then WorkRect.Left := WorkArea.Left; if WorkArea.Top > WorkRect.Top then WorkRect.Top := WorkArea.Top; if WorkArea.Bottom < WorkRect.Bottom then WorkRect.Bottom := WorkArea.Bottom; if WorkArea.Right < WorkRect.Right then WorkRect.Right := WorkArea.Right; { can't draw with negative coords } if (WorkRect.Top > WorkRect.Bottom) or (WorkRect.Left > WorkRect.Right) then Exit; with ACanvas, PageBounds do begin Dec(Bottom); m := ACanvas.Matrix; State := ACanvas.SaveState; FramePath := TPathData.Create; { check what part of the frame we need to redraw add it to FramePath } if PageBounds.Left > WorkArea.Left then begin FramePath.MoveTo(PointF(WorkRect.Left, WorkRect.Top)); FramePath.LineTo(PointF(WorkRect.Left, WorkRect.Bottom)); end; if PageBounds.Bottom < WorkArea.Bottom then begin FramePath.MoveTo(PointF(WorkRect.Left, WorkRect.Bottom)); FramePath.LineTo(PointF(WorkRect.Right, WorkRect.Bottom)); end; if PageBounds.Right < WorkArea.Right then begin FramePath.MoveTo(PointF(WorkRect.Right, WorkRect.Top)); FramePath.LineTo(PointF(WorkRect.Right, WorkRect.Bottom)); end; if PageBounds.Top >= WorkRect.Top then begin FramePath.MoveTo(PointF(WorkRect.Left, WorkRect.Top)); FramePath.LineTo(PointF(WorkRect.Right, WorkRect.Top)); end; { set clip for draw area } aCanvas.IntersectClipRect(RectF(WorkRect.Left, WorkRect.Top, WorkRect.Right, WorkRect.Bottom)); try { draw background } Fill.Kind := TBrushKind.bkSolid; Fill.Color := claWhite; FillRect(RectF(WorkRect.Left, WorkRect.Top, WorkArea.Right, WorkArea.Bottom), 0, 0, allCorners, 1); { draw frame if any } Stroke.Color := FrameColor; {$IFDEF DELPHI25} Stroke.Thickness := 2; {$ELSE} StrokeThickness := 2; {$ENDIF} Stroke.Kind := TBrushKind.bkSolid; DrawPath(FramePath, 1); { draw page objects only inside WorkArea } PreviewPages.DrawPage(Index, aCanvas, Zoom, Zoom, PageBounds.Left, PageBounds.Top, WorkArea); finally aCanvas.RestoreState(state); aCanvas.SetMatrix(m); FreeAndNil(FramePath); end; end; if FIsThumbnail then with aCanvas do begin Font.Family := 'Arial'; Font.Size := 8; Font.Style := []; Fill.Kind := TBrushKind.bkSolid; Fill.Color := claWhite; FillText(RectF(PageBounds.Left + 1, PageBounds.Top + 1, PageBounds.Left + 10, PageBounds.Top + 10), ' ' + IntToStr(Index + 1) + ' ', False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading); end; end; procedure DrawPages(); var i: Integer; begin { width of area to redraw } cWidth := WorkArea.Right - WorkArea.Left; { preview backcolor fill } if not BorderOnly then with aCanvas do begin Fill.Color := BackColor; Fill.Kind := TBrushKind.bkSolid; FillRect(RectF(WorkArea.Left, WorkArea.Top, WorkArea.Right, WorkArea.Bottom), 0, 0, allCorners, 1); end; if Locked or (FPageList.Count = 0) then Exit; if PreviewPages = nil then Exit; { index of first visible page } n := FPageList.FindPage(FOffset.Y); { draw border around the active page } PageBounds := FPageList.GetPageBounds(PageNo - 1, cWidth, Zoom, FRTLLanguage); OffsetRect(PageBounds, -FOffset.X, -FOffset.Y); with aCanvas, PageBounds do begin Stroke.Color := ActiveFrameColor; {$IFDEF DELPHI25} Stroke.Thickness := 2; {$ELSE} StrokeThickness := 2; {$ENDIF} Stroke.Kind := TBrushKind.bkSolid; SetLength(poly, 5); poly[0] := PointF(Left - 1, Top - 1); poly[1] := PointF(Right + 1, Top - 1); poly[2] := PointF(Right + 1, Bottom + 1); poly[3] := PointF(Left - 1, Bottom + 1); poly[4] := PointF(Left - 1, Top - 2); // DrawPolygon(poly, 1); // todo end; if not BorderOnly then begin { draw visible pages } for i := n - 40 to n + 40 do begin if i < 0 then continue; if i >= FPageList.Count then break; PageBounds := FPageList.GetPageBounds(i, cWidth, Zoom, FRTLLanguage); OffsetRect(PageBounds, -FOffset.X, -FOffset.Y); Inc(PageBounds.Bottom); { draw only pages in area } if PageVisible then DrawPage(i); end; end; end; begin if not Visible then Exit; { assign default draw area } aWidth := Round(ARect.Right - ARect.Left); aHeight := Round(ARect.Bottom - ARect.Top); WorkArea.Top := Round(aRect.Top); WorkArea.Left := Round(aRect.Left); WorkArea.Bottom := Round(aRect.Bottom); WorkArea.Right := Round(aRect.Right); { used for horizontal re-draw } WorkAreaX := WorkArea; { used for vertical re-draw } WorkAreaY := WorkArea; { there is no buffer to draw on, draws on canvas } if not Assigned(FDrawBuffer) then begin aCanvas := DrawCanvas; m := Canvas.Matrix; State := Canvas.SaveState; Canvas.IntersectClipRect(ARect); try DrawPages(); finally Canvas.RestoreState(state); Canvas.SetMatrix(m); end; Exit; end; BufferArea := aRect; bUseBuffer := False; { if scrooled area more than view size, redraw all buffer } FNeedBufferClear := (FNeedBufferClear or (Abs(FOffset.X - FOldOffset.X) > aWidth) or (Abs(FOffset.Y - FOldOffset.Y) > aHeight)); // resize buffers if (FDrawBuffer.Width <> aWidth) or (FDrawBuffer.Height <> aHeight) then begin FDrawBuffer2.SetSize(aWidth, aHeight); FDrawBuffer.SetSize(aWidth, aHeight); end else { do we need to re draw part of buffer, or just draw as is ? } bUseBuffer := (((FOffset.X <> FOldOffset.X) or (FOffset.Y <> FOldOffset.Y)) and not FNeedBufferClear); { redraw part of buffer } if bUseBuffer then begin { calculate offset for buffer contend and new area to redraw objects } if (FOffset.X > FOldOffset.X) then begin TmpOffset := FOffset.X - FOldOffset.X; WorkAreaX.Left := WorkAreaX.Right - TmpOffset; BufferArea.Left := BufferArea.Left - TmpOffset; BufferArea.Right := BufferArea.Right - TmpOffset; end; if (FOffset.X < FOldOffset.X) then begin TmpOffset := FOldOffset.X - FOffset.X; WorkAreaX.Right := WorkAreaX.Left + TmpOffset; BufferArea.Right := BufferArea.Right + TmpOffset; BufferArea.Left := BufferArea.Left + TmpOffset; end; if (FOffset.Y > FOldOffset.Y) then begin TmpOffset := FOffset.Y - FOldOffset.Y; WorkAreaY.Top := WorkAreaY.Bottom - TmpOffset; BufferArea.Top := BufferArea.Top - TmpOffset; BufferArea.Bottom := BufferArea.Bottom - TmpOffset; end; if (FOffset.Y < FOldOffset.Y) then begin TmpOffset := FOldOffset.Y - FOffset.Y; WorkAreaY.Bottom := WorkAreaY.Top + TmpOffset; BufferArea.Bottom := BufferArea.Bottom + TmpOffset; BufferArea.Top := BufferArea.Top + TmpOffset; end; { copy buffer content to temp buffer } FDrawBuffer2.Canvas.BeginScene(); try //FDrawBuffer2.Clear(BackColor); FDrawBuffer2.Canvas.DrawBitmap(FDrawBuffer, RectF(0, 0, FDrawBuffer.Width, FDrawBuffer.Height), RectF(0, 0, FDrawBuffer.Width, FDrawBuffer.Height), 1, True); finally FDrawBuffer2.Canvas.EndScene; end; FDrawBuffer.Canvas.BeginScene(); State := FDrawBuffer.Canvas.SaveState; m := FDrawBuffer.Canvas.Matrix; { draws old content with offset from temp buffer } try FDrawBuffer.Clear(BackColor); FDrawBuffer.Canvas.DrawBitmap(FDrawBuffer2, RectF(0, 0, FDrawBuffer.Width, FDrawBuffer.Height), BufferArea, 1, True); finally FDrawBuffer.Canvas.RestoreState(state); FDrawBuffer.Canvas.SetMatrix(m); FDrawBuffer.Canvas.EndScene; end; end; { set current canvas to draw, backbuffer canvas } aCanvas := FDrawBuffer.Canvas; { check if we have fake FR canvas assigned for fast draw } if Assigned(FFastCanvas) then begin FFastCanvas.Canvas := aCanvas; FFastCanvas.BeginScene; end else aCanvas.BeginScene; m := DrawCanvas.Matrix; state := DrawCanvas.SaveState; try DrawCanvas.IntersectClipRect(aRect); try { draw full content if needed } if FNeedBufferClear then DrawPages() else begin { draw for horizontal offset } if (FOffset.X <> FOldOffset.X) then begin WorkArea := WorkAreaX; DrawPages(); end; { draw for vertical offset } if (FOffset.Y <> FOldOffset.Y) then begin WorkArea := WorkAreaY; DrawPages(); end; end; { reset offset } FNeedBufferClear := False; FOldOffset := FOffset; finally if Assigned(FFastCanvas) then FFastCanvas.EndScene else aCanvas.EndScene; end; { draw from buffer to form canvas } DrawCanvas.DrawBitmap(FDrawBuffer, RectF(0, 0, FDrawBuffer.Width, FDrawBuffer.Height), aRect, 1, not GlobalUseDirect2D); finally DrawCanvas.RestoreState(state); DrawCanvas.SetMatrix(m); end; end; procedure TfrxPreviewWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin if Assigned(OnMouseDown) then OnMouseDown(Self, Button, Shift, X, Y); if (FPageList.Count = 0) or Locked then Exit; if Button = mbLeft then begin FDown := True; FDoDblClick := ssDouble in Shift; FLastPoint.X := X; FLastPoint.Y := Y; end; end; procedure TfrxPreviewWorkspace.MouseMove(Shift: TShiftState; X, Y: Single); var PageNo: Integer; PageBounds: TRect; Cur: TCursor; begin if (FPageList.Count = 0) or Locked or FIsThumbnail then Exit; if FDown then begin HorzPosition := HorzPosition - (X - FLastPoint.X); VertPosition := VertPosition - (Y - FLastPoint.Y); FLastPoint.X := X; FLastPoint.Y := Y; end else begin PageNo := FPageList.FindPage(FOffset.Y + Round(Y), FOffset.X + Round(X)); PageBounds := FPageList.GetPageBounds(PageNo, Width, Zoom, FRTLLanguage); Cur := FDefaultCursor; PreviewPages.ObjectOver(PageNo, Round(X), Round(Y), mbLeft, [], Zoom, PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, False, Cur); Cursor := Cur; end; end; procedure TfrxPreviewWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); var PageNo: Integer; PageBounds: TRect; Cur: TCursor; XOffSet: Integer; begin inherited; if not FIsThumbnail and Assigned(Preview.OnClick) then Preview.OnClick(Preview); if (FPageList.Count = 0) or Locked then Exit; FDown := False; if FRTLLanguage then XOffSet := Round(Width - (FOffset.X + X)) else XOffSet := FOffset.X + Round(X); PageNo := FPageList.FindPage(FOffset.Y + Round(Y), XOffSet); FDisableUpdate := True; Preview.PageNo := PageNo + 1; FDisableUpdate := False; if not FIsThumbnail and (Button <> mbRight) then begin PageBounds := FPageList.GetPageBounds(PageNo, Width, Zoom, FRTLLanguage); if FDoDblClick then begin PreviewPages.ObjectOver(PageNo, Round(X), Round(Y), Button, Shift, Zoom, PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, True, Cur, True); FDoDblClick := False; end else begin PreviewPages.ObjectOver(PageNo, Round(X), Round(Y), Button, Shift, Zoom, PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, True, Cur); end; end; end; procedure TfrxPreviewWorkspace.SetToPageNo(PageNo: Integer); begin if FDisableUpdate then Exit; VertPosition := FPageList.GetPageBounds(PageNo - 1, Width, Zoom, FRTLLanguage).Top - 10; end; procedure TfrxPreviewWorkspace.UpdateScrollBars; var MaxSize: TPoint; begin MaxSize := FPageList.GetMaxBounds; HorzRange := MaxSize.X + 10; VertRange := MaxSize.Y + 10; end; procedure TfrxPreviewWorkspace.SetDoubleBuffered(const Value: Boolean); begin FDoubleBuffered := Value; {$IFDEF DELPHI27} FDoubleBuffered := FDoubleBuffered and not GlobalUseMetal; {$ENDIF}; if Value = False then begin if Assigned(FDrawBuffer) then FreeAndNil(FDrawBuffer); if Assigned(FDrawBuffer2) then FreeAndNil(FDrawBuffer2); end; end; procedure TfrxPreviewWorkspace.SetLocked(const Value: Boolean); begin if Value and not FLocked then FNeedBufferClear := True; FLocked := Value; end; procedure TfrxPreviewWorkspace.SetParent(const Value: TFmxObject); begin inherited; FParentForm := nil; end; procedure TfrxPreviewWorkspace.SetPosition(PageN, Top: Integer); var Pos: Integer; Page: TfrxReportPage; begin Page := PreviewPages.Page[PageN - 1]; if Page = nil then exit; if Top = 0 then Pos := 0 else Pos := Round((Top + Page.TopMargin * fr01cm) * Zoom); VertPosition := FPageList.GetPageBounds(PageN - 1, Width, Zoom, FRTLLanguage).Top - 10 + Pos; end; function TfrxPreviewWorkspace.GetTopPosition: Integer; var Page: TfrxReportPage; begin Result := 0; Page := PreviewPages.Page[Preview.PageNo - 1]; if Page <> nil then Result := Round((VertPosition - FPageList.GetPageBounds(Preview.PageNo - 1, Width, Zoom, FRTLLanguage).Top + 10)/ Zoom - Page.TopMargin * fr01cm); end; procedure TfrxPreviewWorkspace.AddPage(AWidth, AHeight: Integer); begin FPageList.AddPage(AWidth, AHeight, Zoom); end; procedure TfrxPreviewWorkspace.CalcPageBounds(ClientWidth: Integer); begin FPageList.CalcBounds(ClientWidth); end; procedure TfrxPreviewWorkspace.ClearBackBuffer; begin FNeedBufferClear := True; end; procedure TfrxPreviewWorkspace.ClearPageList; begin FPageList.Clear; if Assigned(FFastCanvas) then TfrxFastCanvasLayer(FFastCanvas).ClearCache; FNeedBufferClear := True; end; procedure TfrxPreviewWorkspace.PrevDblClick(Sender: TObject); begin if not IsThumbnail and Assigned(FPreview.OnDblClick) then FPreview.OnDblClick(Sender); end; { TfrxPreview } constructor TfrxPreview.Create(AOwner: TComponent); var m: TMenuItem; begin inherited; FOutlinePopup := TPopupMenu.Create(Self); m := TMenuItem.Create(FOutlinePopup); FOutlinePopup.AddObject(m); m.Text := frxGet(601); FOutlinePopup.Stored := false; // m.Bitmap := 13; m.OnClick := OnCollapseClick; m := TMenuItem.Create(FOutlinePopup); FOutlinePopup.AddObject(m); m.Text := frxGet(600); // m.ImageIndex := 14; m.OnClick := OnExpandClick; FOutline := TTreeView.Create(Self); with FOutline do begin Parent := Self; Align := alLeft; OnClick := OnOutlineClick; PopupMenu := FOutlinePopup; Stored := False; end; FThumbnail := TfrxPreviewWorkspace.Create(Self); FThumbnail.Parent := Self; FThumbnail.Align := alLeft; FThumbnail.Visible := False; FThumbnail.Zoom := 0.1; FThumbnail.IsThumbnail := True; FThumbnail.Preview := Self; FThumbnail.Stored := False; FSplitter := TfrxSplitter.Create(Self); FSplitter.Parent := Self; FSplitter.Align := alLeft; FSplitter.Width := 4; FSplitter.OnMove := OnMoveSplitter; FSplitter.Stored := False; FWorkspace := TfrxPreviewWorkspace.Create(Self); FWorkspace.Parent := Self; FWorkspace.Align := alClient; FWorkspace.Preview := Self; FWorkspace.OnResize := OnResize; FWorkspace.Stored := False; FWorkspace.DoubleBuffered := True {$IFDEF DELPHI27} and not GlobalUseMetal; {$ENDIF}; FMessagePanel := TPanel.Create(Self); FMessagePanel.Parent := Self; FMessagePanel.Visible := False; FMessagePanel.SetBounds(0, 0, 0, 0); FMessagePanel.Stored := False; FMessageLabel := TLabel.Create(FMessagePanel); FMessageLabel.Parent := FMessagePanel; FMessageLabel.AutoSize := False; FMessageLabel.TextAlign := taCenter; FMessageLabel.SetBounds(4, 20, 255, 20); FMessageLabel.Stored := False; FCancelButton := TButton.Create(FMessagePanel); FCancelButton.Parent := FMessagePanel; FCancelButton.SetBounds(92, 44, 75, 25); FCancelButton.Text := frxResources.Get('clCancel'); FCancelButton.Visible := False; FCancelButton.OnClick := OnCancel; FCancelButton.Stored := False; FPageNo := 1; FZoom := 1; FZoomMode := zmDefault; FOutlineColor := claWhite; UseReportHints := True; Width := 100; Height := 100; HintPanel := TCalloutPanel.Create(Self); HintPanel.Stored := False; HintPanel.Parent := Self; HintLabel := TLabel.Create(HintPanel); HintLabel.Stored := False; HintLabel.Parent := HintPanel; HintPanel.Visible := False; HintPanel.SetBounds(0,0,100, 40); HintLabel.Align := TAlignLayout.alClient; end; destructor TfrxPreview.Destroy; begin if Report <> nil then Report.Preview := nil; inherited; end; procedure TfrxPreview.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if Operation = opRemove then if AComponent = Report then begin Clear; Report := nil; PreviewPages := nil; end; end; procedure TfrxPreview.Init; begin if csDesigning in ComponentState then Exit; FWorkspace.PreviewPages := PreviewPages; FThumbnail.PreviewPages := PreviewPages; FAllowF3 := False; OutlineWidth := Report.PreviewOptions.OutlineWidth; OutlineVisible := Report.PreviewOptions.OutlineVisible; ThumbnailVisible := Report.PreviewOptions.ThumbnailVisible; FZoomMode := Report.PreviewOptions.ZoomMode; FZoom := Report.PreviewOptions.Zoom; UpdatePages; UpdateOutline; First; end; procedure TfrxPreview.KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); begin inherited; if ssCtrl in Shift then begin if (Key = Ord('P')) and (pbPrint in Report.PreviewOptions.Buttons) then Print else if (Key = Ord('S')) and (pbSave in Report.PreviewOptions.Buttons) then SaveToFile else if (Key = Ord('O')) and (pbLoad in Report.PreviewOptions.Buttons) then LoadFromFile end; end; procedure TfrxPreview.Resize; begin inherited; end; procedure TfrxPreview.OnMoveSplitter(Sender: TObject); begin UpdatePages; end; procedure TfrxPreview.OnCollapseClick(Sender: TObject); begin FOutline.CollapseAll; FWorkspace.SetFocus; end; procedure TfrxPreview.OnExpandClick(Sender: TObject); begin FOutline.ExpandAll; FWorkspace.SetFocus; end; procedure TfrxPreview.SetZoom(const Value: Double); begin FZoom := Value; if FZoom < 0.25 then FZoom := 0.25; if FZoom > 5.0 then FZoom := 5; FZoomMode := zmDefault; UpdatePages; end; procedure TfrxPreview.SetZoomMode(const Value: TfrxZoomMode); begin FZoomMode := Value; UpdatePages; end; function TfrxPreview.GetOutlineVisible: Boolean; begin Result := FOutline.Visible; end; procedure TfrxPreview.SetOutlineVisible(const Value: Boolean); var NeedChange: Boolean; begin NeedChange := Value <> FOutline.Visible; FSplitter.Visible := Value or ThumbnailVisible; FOutline.Visible := Value; if Value then FThumbnail.Visible := False; if Owner is TfrxPreviewForm then TfrxPreviewForm(Owner).OutlineB.Down := Value; if NeedChange then UpdatePages; end; function TfrxPreview.GetThumbnailVisible: Boolean; begin Result := FThumbnail.Visible; end; procedure TfrxPreview.SetThumbnailVisible(const Value: Boolean); var NeedChange: Boolean; begin NeedChange := Value <> FThumbnail.Visible; FSplitter.Visible := Value or OutlineVisible; FThumbnail.Visible := Value; if Value then FOutline.Visible := False; if Value then begin FThumbnail.HorzPosition := FThumbnail.HorzPosition; FThumbnail.VertPosition := FThumbnail.VertPosition; end; if Owner is TfrxPreviewForm then TfrxPreviewForm(Owner).ThumbB.Down := Value; if NeedChange then UpdatePages; end; function TfrxPreview.GetOutlineWidth: Integer; begin Result := Round(FOutline.Width); end; procedure TfrxPreview.SetOutlineWidth(const Value: Integer); begin FOutline.Width := Value; if not (csDesigning in ComponentState) then FThumbnail.Width := Value; end; procedure TfrxPreview.SetOutlineColor(const Value: TAlphaColor); begin FOutlineColor := Value; // FOutline.Color := Value; end; procedure TfrxPreview.SetPageNo(Value: Integer); begin if Value < 1 then Value := 1; if Value > PageCount then Value := PageCount; if Value = 0 then Exit; FPageNo := Value; FWorkspace.PageNo := Value; FThumbnail.PageNo := Value; FWorkspace.SetToPageNo(FPageNo); FThumbnail.SetToPageNo(FPageNo); UpdatePageNumbers; end; procedure TfrxPreview.SetParent(const Value: TFmxObject); begin inherited; if Assigned(FWorkspace) then FWorkspace.Parent := Self; end; function TfrxPreview.GetActiveFrameColor: TAlphaColor; begin Result := FWorkspace.ActiveFrameColor; end; function TfrxPreview.GetBackColor: TAlphaColor; begin Result := FWorkspace.BackColor; end; function TfrxPreview.GetCanvas: TCanvas; begin Result := nil; if Assigned(FWorkspace.FFastCanvas) then Result := FWorkspace.FFastCanvas; end; function TfrxPreview.GetFrameColor: TAlphaColor; begin Result := FWorkspace.FrameColor; end; procedure TfrxPreview.SetActiveFrameColor(const Value: TAlphaColor); begin FWorkspace.ActiveFrameColor := Value; end; procedure TfrxPreview.SetBackColor(const Value: TAlphaColor); begin FWorkspace.BackColor := Value; end; procedure TfrxPreview.SetFrameColor(const Value: TAlphaColor); begin FWorkspace.FrameColor := Value; end; procedure TfrxPreview.UpdatePageNumbers; begin if Assigned(FOnPageChanged) then FOnPageChanged(Self, FPageNo); end; function TfrxPreview.GetPageCount: Integer; begin if PreviewPages <> nil then Result := PreviewPages.Count else Result := 0; end; function TfrxPreview.GetOnMouseDown: TMouseEvent; begin Result := FWorkspace.OnMouseDown; end; procedure TfrxPreview.SetOnMouseDown(const Value: TMouseEvent); begin FWorkspace.OnMouseDown := Value; end; procedure TfrxPreview.ShowHint(aRect: TRectF; Text: String); var r: TRectF; begin inherited; HintPanel.CalloutPosition := TCalloutPosition.cpTop; HintPanel.Position.X := aRect.Left + aRect.Width/2 - HintPanel.Width/2; HintPanel.Position.Y := aRect.Top + aRect.Height; {$IFDEF DELPHI18} HintLabel.Margins.Left := 0; HintLabel.Margins.Top := 0; {$ELSE} HintLabel.Padding.Left := 0; HintLabel.Padding.Top := 0; {$ENDIF} HintLabel.Visible := True; HintLabel.WordWrap := True; r := RectF(0, 0, 200, 1000); if HintLabel.Canvas <> nil then HintLabel.Canvas.MeasureText(r, Text, True, [], TTextAlign.taCenter, TTextAlign.taCenter); HintPanel.Width := r.Width + 6; HintPanel.Height := r.Height + HintPanel.CalloutLength + 10; HintLabel.WordWrap := True; HintLabel.VertTextAlign := TTextAlign.taCenter; HintLabel.TextAlign := TTextAlign.taCenter; HintLabel.Text := Text; HintPanel.Visible := True; end; procedure TfrxPreview.ShowMessage(const s: String); begin FMessagePanel.SetBounds((Width - 260) / 2, (Height - 75) / 3, 260, 75); FMessageLabel.Text := s; FMessagePanel.Visible := True; FMessagePanel.Repaint; end; procedure TfrxPreview.HideHint; begin inherited; HintPanel.Visible := False; end; procedure TfrxPreview.HideMessage; begin FMessagePanel.Visible := False; FCancelButton.Visible := False; end; procedure TfrxPreview.First; begin PageNo := 1; end; procedure TfrxPreview.Next; begin PageNo := PageNo + 1; end; procedure TfrxPreview.Prior; begin PageNo := PageNo - 1; end; procedure TfrxPreview.Last; begin PageNo := PageCount; end; procedure TfrxPreview.Print; begin if FRunning then Exit; try PreviewPages.CurPreviewPage := PageNo; PreviewPages.Print; finally Unlock; end; end; procedure TfrxPreview.SaveToFile; var SaveDlg: TSaveDialog; begin if FRunning then Exit; SaveDlg := TSaveDialog.Create(Application); try SaveDlg.Filter := frxResources.Get('clFP3files') + ' (*.fp3)|*.fp3'; if SaveDlg.Execute then begin FWorkspace.Repaint; SaveToFile(ChangeFileExt(SaveDlg.FileName, '.fp3')); end; finally SaveDlg.Free; end; end; procedure TfrxPreview.SaveToFile(FileName: String); begin if FRunning then Exit; try Lock; ShowMessage(frxResources.Get('clSaving')); PreviewPages.SaveToFile(FileName); finally Unlock; end; end; procedure TfrxPreview.LoadFromFile; var OpenDlg: TOpenDialog; begin if FRunning then Exit; OpenDlg := TOpenDialog.Create(nil); try OpenDlg.Filter := frxResources.Get('clFP3files') + ' (*.fp3)|*.fp3'; if OpenDlg.Execute then begin FWorkspace.Repaint; LoadFromFile(OpenDlg.FileName); end; finally OpenDlg.Free; end; end; procedure TfrxPreview.LoadFromFile(FileName: String); begin if FRunning then Exit; try Lock; ShowMessage(frxResources.Get('clLoading')); PreviewPages.LoadFromFile(FileName); finally PageNo := 1; UpdateOutline; Unlock; end; end; procedure TfrxPreview.Export(Filter: TfrxCustomExportFilter); begin if FRunning then Exit; try PreviewPages.CurPreviewPage := PageNo; if Report.DotMatrixReport and (frxDotMatrixExport <> nil) and (Filter.ClassName = 'TfrxTextExport') then Filter := frxDotMatrixExport; PreviewPages.Export(Filter); finally Unlock; end; end; procedure TfrxPreview.PageSetupDialog; begin PageSetupDlg; end; procedure TfrxPreview.PageSetupDlg; var APage: TfrxReportPage; procedure UpdateReport; var i: Integer; begin for i := 0 to Report.PagesCount - 1 do if Report.Pages[i] is TfrxReportPage then with TfrxReportPage(Report.Pages[i]) do begin Orientation := APage.Orientation; PaperWidth := APage.PaperWidth; PaperHeight := APage.PaperHeight; PaperSize := APage.PaperSize; LeftMargin := APage.LeftMargin; RightMargin := APage.RightMargin; TopMargin := APage.TopMargin; BottomMargin := APage.BottomMargin; end; end; begin if FRunning then Exit; APage := PreviewPages.Page[PageNo - 1]; if Assigned(APage) then with TfrxPageSettingsForm.Create(Application) do begin Page := APage; Report := Self.Report; FormShow(nil); if ShowModal = mrOk then begin if NeedRebuild then begin UpdateReport; Self.Report.PrepareReport; end else begin try Lock; PreviewPages.ModifyPage(PageNo - 1, Page); finally Unlock; end; end; end; if Report.PreviewForm is TfrxForm then TfrxForm(Report.PreviewForm).PeekLastModalResult; Free; end; end; procedure TfrxPreview.Edit; var r: TfrxReport; p: TfrxReportPage; SourcePage: TfrxPage; procedure RemoveBands; var i: Integer; l: TList; c: TfrxComponent; begin l := p.AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if c is TfrxView then begin TfrxView(c).DataField := ''; TfrxView(c).DataSet := nil; TfrxView(c).Restrictions := []; end; if c.Parent <> p then begin c.Left := c.AbsLeft; c.Top := c.AbsTop; c.ParentFont := False; c.Parent := p; if (c is TfrxView) and (TfrxView(c).Align in [baBottom, baClient]) then TfrxView(c).Align := baNone; end; end; for i := 0 to l.Count - 1 do begin c := l[i]; if c is TfrxBand then c.Free; end; end; begin SourcePage := PreviewPages.Page[PageNo - 1]; r := nil; if Assigned(SourcePage) then try if SourcePage is TfrxDMPPage then p := TfrxDMPPage.Create(nil) else p := TfrxReportPage.Create(nil); r := TfrxReport.Create(nil); p.AssignAll(SourcePage); p.Parent := r; RemoveBands; try Lock; if r.DesignPreviewPage then PreviewPages.ModifyPage(PageNo - 1, TfrxReportPage(r.Pages[0])); finally Unlock; end; except end; if r <> nil then r.Free; end; procedure TfrxPreview.EditTemplate; var r: TfrxReport; i: Integer; begin r := TfrxReport.Create(nil); try for i := 0 to TfrxPreviewPages(PreviewPages).SourcePages.Count - 1 do r.Objects.Add(TfrxPreviewPages(PreviewPages).SourcePages[i]); r.DesignReport; finally r.Objects.Clear; r.Free; end; end; procedure TfrxPreview.Clear; begin if FRunning then Exit; Lock; try PreviewPages.Clear; finally Unlock; end; FWorkspace.ClearPageList; FThumbnail.ClearPageList; UpdateOutline; PageNo := 1; with FWorkspace do begin HorzRange := 0; VertRange := 0; end; if ThumbnailVisible then with FThumbnail do begin HorzRange := 0; VertRange := 0; end; end; procedure TfrxPreview.ClearBackBuffer; begin FWorkspace.ClearBackBuffer; end; procedure TfrxPreview.AddPage; begin if FRunning then Exit; PreviewPages.AddEmptyPage(PageNo - 1); UpdatePages; PageNo := PageNo; end; procedure TfrxPreview.DeletePage; begin if FRunning then Exit; PreviewPages.DeletePage(PageNo - 1); if PageNo >= PageCount then PageNo := PageNo - 1; UpdatePages; UpdatePageNumbers; end; procedure TfrxPreview.Lock; begin FLocked := True; FWorkspace.Locked := True; FThumbnail.Locked := True; end; procedure TfrxPreview.Unlock; begin HideMessage; FLocked := False; FWorkspace.Locked := False; FThumbnail.Locked := False; UpdatePages; FWorkspace.Repaint; FThumbnail.Repaint; end; procedure TfrxPreview.SetPosition(PageN, Top: Integer); begin if PageN > PageCount then PageN := PageCount; if PageN <= 0 then PageN := 1; FWorkspace.SetPosition(PageN, Top); end; function TfrxPreview.GetTopPosition: Integer; begin Result := FWorkspace.GetTopPosition; end; procedure TfrxPreview.RefreshReport; var hpos, vpos, pno: Integer; begin if not Assigned(Report) then exit; hpos := FWorkspace.FOffset.X; vpos := FWorkspace.FOffset.Y; pno := FPageNo; Lock; FRefreshing := True; try Report.PrepareReport; FLocked := False; FThumbnail.Locked := False; if pno <= PageCount then FPageNo := pno else FPageNo := 1; UpdatePages; UpdateOutline; finally Unlock; FRefreshing := False; end; FWorkspace.FOffset.X := hpos; FWorkspace.FOffset.Y := vpos; FWorkspace.Locked := False; FWorkspace.Repaint; FThumbnail.Repaint; if pno > PageCount then PageNo := 1; end; procedure TfrxPreview.UpdatePages; var PageSize: TPoint; i: Integer; begin if FLocked or (PageCount = 0) then Exit; { calc zoom if not zmDefault} PageSize := PreviewPages.PageSize[PageNo - 1]; if PageSize.Y = 0 then Exit; case FZoomMode of zmWholePage: begin if PageSize.Y / Height < PageSize.X / Width then FZoom := (FWorkspace.Width - 26) / PageSize.X else FZoom := (FWorkspace.Height - 26) / PageSize.Y; SetPosition(PageNo, 0); end; zmPageWidth: FZoom := (FWorkspace.Width - 26) / PageSize.X end; { fill page list and calc bounds } FWorkspace.Zoom := FZoom; FThumbnail.Zoom := 0.1; FWorkspace.ClearPageList; FThumbnail.ClearPageList; for i := 0 to PageCount - 1 do begin PageSize := PreviewPages.PageSize[i]; FWorkspace.AddPage(PageSize.X, PageSize.Y); if not FRunning then FThumbnail.AddPage(PageSize.X, PageSize.Y); end; FWorkspace.CalcPageBounds(Round(FWorkspace.Width - 26)); if not FRunning then FThumbnail.CalcPageBounds(Round(FThumbnail.Width - 26)); FWorkspace.UpdateScrollBars; FThumbnail.UpdateScrollBars; { avoid positioning errors when resizing } FWorkspace.HorzPosition := FWorkspace.HorzPosition; FWorkspace.VertPosition := FWorkspace.VertPosition; if not FRefreshing then begin FWorkspace.Repaint; FThumbnail.Repaint; end; if Owner is TfrxPreviewForm then TfrxPreviewForm(Owner).UpdateZoom; end; procedure TfrxPreview.UpdateOutline; var Outline: TfrxCustomOutline; procedure DoUpdate(RootNode: TFmxObject); var i, n: Integer; Node: TTreeViewItem; Page, Top: Integer; Text: String; begin n := Outline.Count; for i := 0 to n - 1 do begin Outline.GetItem(i, Text, Page, Top); Node := TTreeViewItem.Create(RootNode); Node.Text := Text; Node.Tag := Page + 1; Node.TagFloat := Top; RootNode.AddObject(Node); Outline.LevelDown(i); DoUpdate(Node); Outline.LevelUp; end; end; begin FOutline.BeginUpdate; FOutline.Clear; Outline := Report.PreviewPages.Outline; Outline.LevelRoot; DoUpdate(FOutline); if Report.PreviewOptions.OutlineExpand then FOutline.ExpandAll; //todo //if FOutline.Count > 0 then // FOutline.TopItem := FOutline.Items[0]; FOutline.EndUpdate; end; procedure TfrxPreview.OnOutlineClick(Sender: TObject); var Node: TTreeViewItem; PageN, Top: Integer; begin Node := FOutline.Selected; if Node = nil then Exit; PageN := Node.Tag; Top := Trunc(Node.TagFloat); SetPosition(PageN, Top); SetFocus; end; procedure TfrxPreview.OnResize(Sender: TObject); begin if PreviewPages <> nil then UpdatePages; end; procedure TfrxPreview.InternalOnProgressStart(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); begin if FRefreshing then Exit; Clear; Report.DrillState.Clear; FRunning := True; if Owner is TfrxPreviewForm then TfrxPreviewForm(Owner).UpdateControls; end; procedure TfrxPreview.InternalOnProgress(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); var PageSize: TPoint; {$IFNDEF MSWINDOWS} bIDLE: Boolean; {$ENDIF} begin if FRefreshing then begin UpdatePageNumbers; Exit; end; if Report.Engine.FinalPass then begin PageSize := Report.PreviewPages.PageSize[Progress]; if Progress < 50 then begin FWorkspace.AddPage(PageSize.X, PageSize.Y); FWorkspace.CalcPageBounds(Round(FWorkspace.Width) - 26); end; end; if Progress = 0 then begin PageNo := 1; if Report.Engine.FinalPass then UpdatePages; if Owner is TfrxPreviewForm then TfrxPreviewForm(Owner).CancelB.Text := frxResources.Get('clCancel'); // FTick := GetTickCount; end else if Progress = 1 then begin { FTick := GetTickCount - FTick; if FTick < 5 then FTick := 50 else if FTick < 10 then FTick := 20 else FTick := 5;} PageNo := 1; if Report.Engine.FinalPass then UpdatePages; end else //if Progress mod Integer(FTick) = 0 then begin UpdatePageNumbers; if Report.Engine.FinalPass then FWorkspace.UpdateScrollBars; end; {$IFDEF MSWINDOWS} Application.ProcessMessages; {$ELSE} Application.DoIdle(bIDLE); {$ENDIF} end; procedure TfrxPreview.InternalOnProgressStop(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); begin if FRefreshing then Exit; FRunning := False; UpdatePageNumbers; FWorkspace.UpdateScrollBars; FThumbnail.UpdateScrollBars; UpdatePages; UpdateOutline; if Owner is TfrxPreviewForm then begin TfrxPreviewForm(Owner).CancelB.Text := frxResources.Get('clClose'); TfrxPreviewForm(Owner).Panel1.Text := ''; TfrxPreviewForm(Owner).UpdateControls; end; end; procedure TfrxPreview.OnCancel(Sender: TObject); begin Report.Terminated := True; end; procedure TfrxPreview.Cancel; begin if FRunning then OnCancel(Self); end; procedure TfrxPreview.MouseWheelScroll(Delta: Integer; Horz: Boolean = False; Zoom: Boolean = False); begin //disable in sesign time, may cause AV if csDesigning in ComponentState then Exit; if Delta <> 0 then if Zoom then begin FZoom := FZoom + Round(Delta / Abs(Delta)) / 10; if FZoom < 0.3 then FZoom := 0.3; SetZoom(FZoom); end else begin with FWorkspace do begin if Horz then HorzPosition := HorzPosition + Round(-Delta / Abs(Delta)) * 20 else VertPosition := VertPosition + Round(-Delta / Abs(Delta)) * 20; end; end; end; { TfrxPreviewForm } procedure TfrxPreviewForm.FormCreate(Sender: TObject); begin Caption := frxGet(100); frxResources.LoadImageFromResouce(PrintB.Bitmap, 19, 5); PrintMI.Bitmap.Assign(PrintB.Bitmap); PrintMI.Text := frxGet(102); PrintB.Hint := frxGet(102); OpenB.Hint := frxGet(104); frxResources.LoadImageFromResouce(OpenB.Bitmap, 0, 1); OpenMI.Bitmap.Assign(OpenB.Bitmap); OpenMI.Text := frxGet(104); SaveB.Hint := frxGet(106); frxResources.LoadImageFromResouce(SaveB.Bitmap, 0, 2); SaveMI.Bitmap.Assign(SaveB.Bitmap); SaveMI.Text := frxGet(106); ExportB.Hint := frxGet(108); frxResources.LoadImageFromResouce(ExportB.Bitmap, 17, 9); ExportMI.Bitmap.Assign(ExportB.Bitmap); ExportMI.Text := frxGet(108); FindMI.Text := frxGet(110); PageSettingsB.Hint := frxGet(121); frxResources.LoadImageFromResouce(PageSettingsB.Bitmap, 19, 4); DesignerB.Hint := frxGet(133); frxResources.LoadImageFromResouce(DesignerB.Bitmap, 19, 8); {$IFDEF FR_LITE} DesignerB.Hint := DesignerB.Hint + #13#10 + 'This feature is not available in FreeReport'; {$ENDIF} FirstB.Hint := frxGet(135); frxResources.LoadImageFromResouce(FirstB.Bitmap, 18, 5); PriorB.Hint := frxGet(137); frxResources.LoadImageFromResouce(PriorB.Bitmap, 18, 6); NextB.Hint := frxGet(139); frxResources.LoadImageFromResouce(NextB.Bitmap, 18, 7); LastB.Hint := frxGet(141); frxResources.LoadImageFromResouce(LastB.Bitmap, 18, 8); CancelB.Text := frxResources.Get('clClose'); FullScreenBtn.Hint := frxGet(150); frxResources.LoadImageFromResouce(FullScreenBtn.Bitmap, 19, 9); FullScrMI.Bitmap.Assign(FullScreenBtn.Bitmap); FullScrMI.Text := frxGet(150); ExportPDFMI.Text := frxGet(151); ExportMailMI.Text := frxGet(152); ExportMailMI.Visible := False; //ZoomPlusB.Hint := frxGet(125); ZoomInMI.Text := frxGet(125); //ZoomMinusB.Hint := frxGet(127); ZoomOutMI.Text := frxGet(127); OutlineB.Hint := frxGet(129); frxResources.LoadImageFromResouce(OutlineB.Bitmap, 19, 6); ThumbB.Hint := frxGet(131); frxResources.LoadImageFromResouce(ThumbB.Bitmap, 7, 8); frxResources.LoadImageFromResouce(PageWidthB.Bitmap, 23, 5); frxResources.LoadImageFromResouce(WholePageB.Bitmap, 23, 6); // ZoomCB.Min := 25; // ZoomCB.Max := 500; // ZoomCB.Frequency := 25; ZoomCB.Clear; ZoomCB.Items.Add('25%'); ZoomCB.Items.Add('50%'); ZoomCB.Items.Add('75%'); ZoomCB.Items.Add('100%'); ZoomCB.Items.Add('150%'); ZoomCB.Items.Add('200%'); ZoomCB.Items.Add('300%'); PageWidthB.Hint := frxResources.Get('zmPageWidth'); WholePageB.Hint := frxResources.Get('zmWholePage'); ExpandMI.Text := frxGet(600); CollapseMI.Text := frxGet(601); FPreview := TfrxPreview.Create(Self); FPreview.Parent := Self; FPreview.Align := alClient; FPreview.OnPageChanged := OnPageChanged; FPreview.OnDblClick := OnPreviewDblClick; FPreview.SetFocus; // FPreview.OnMouseUp := FormMouseUp; FPreview.FWorkspace.OnMouseUp := FormMouseUp; FFullScreen := False; FPDFExport := nil; FEmailExport := nil; end; procedure TfrxPreviewForm.Init; var i: Integer; m, m2: TMenuItem; procedure RemoveInvisibleButtons; var i, j: Integer; c, c1: TControl; begin for i := 0 to ToolBar.ChildrenCount - 1 do begin c := TControl(ToolBar.Children[i]); if not c.Visible then for j := 0 to ToolBar.ChildrenCount - 1 do begin c1 := TControl(ToolBar.Children[j]); if(c1.Position.X > c.Position.X + c.Width ) then c1.Position.X := c1.Position.X - c.Width - 1; end; end; end; begin FPreview.Init; HintPanel.BringToFront; with Report.PreviewOptions do begin if Maximized then WindowState := wsMaximized; FPreview.Zoom := Zoom; FPreview.ZoomMode := ZoomMode; {$IFDEF FR_LITE} DesignerB.Enabled := False; {$ELSE} DesignerB.Enabled := AllowEdit; {$ENDIF} Preview.Workspace.RTLLanguage := RTLPreview; PrintB.Visible := pbPrint in Buttons; OpenB.Visible := pbLoad in Buttons; SaveB.Visible := pbSave in Buttons; ExportB.Visible := pbExport in Buttons; PageWidthB.Visible := pbZoom in Buttons; WholePageB.Visible := pbZoom in Buttons; FullScreenBtn.Visible := pbFullScreen in Buttons; OutlineB.Visible := pbOutline in Buttons; ThumbB.Visible := pbThumbnails in Buttons; PageSettingsB.Visible := pbPageSetup in Buttons; DesignerB.Visible := pbEdit in Buttons; FirstB.Visible := pbNavigator in Buttons; PriorB.Visible := pbNavigator in Buttons; NextB.Visible := pbNavigator in Buttons; PageE.Visible := pbNavigator in Buttons; LastB.Visible := pbNavigator in Buttons; CancelB.Visible := pbClose in Buttons; ZoomCB.Visible := pbZoom in Buttons; Line1.Visible := ZoomCB.Visible or PageWidthB.Visible or WholePageB.Visible or FullScreenBtn.Visible; Line2.Visible := OutlineB.Visible or ThumbB.Visible or PageSettingsB.Visible or DesignerB.Visible; Line3.Visible := FirstB.Visible or PriorB.Visible or PageE.Visible or NextB.Visible or LastB.Visible or CancelB.Visible; RemoveInvisibleButtons; { ShiftControls([PrintB, OpenB, SaveB, ExportB, Line1, ZoomCB, PageWidthB, WholePageB, FullScreenBtn, Line2, OutlineB, ThumbB, PageSettingsB, DesignerB, Line3, FirstB, PriorB, PageE, NextB, LastB, CancelB], 0);} end; if (frxExportFilters.Count = 0) or ((frxExportFilters.Count = 1) and (frxExportFilters[0].Filter = frxDotMatrixExport)) then ExportB.Visible := False; for i := 0 to frxExportFilters.Count - 1 do begin if frxExportFilters[i].Filter = frxDotMatrixExport then continue; m := TMenuItem.Create(ExportMI); m2 := TMenuItem.Create(ExportPopup); m.Text := TfrxCustomExportFilter(frxExportFilters[i].Filter).GetDescription + '...'; m2.Text := TfrxCustomExportFilter(frxExportFilters[i].Filter).GetDescription + '...'; m.Tag := i; m2.Tag := i; m.OnClick := ExportMIClick; m2.OnClick := ExportMIClick; if TfrxCustomExportFilter(frxExportFilters[i].Filter).ClassName = 'TfrxPDFExport' then begin FPDFExport := TfrxCustomExportFilter(frxExportFilters[i].Filter); //PdfB.Visible := pbExportQuick in Report.PreviewOptions.Buttons; end; ExportMI.AddObject(m); ExportPopup.AddObject(m2); end; FPopUpMItemsCount := RightMenu.ChildrenCount; FPopUpExporttemsCount := ExportPopup.ChildrenCount; if Report.ReportOptions.Name <> '' then Caption := Report.ReportOptions.Name; UpdateControls; end; procedure TfrxPreviewForm.UpdateControls; function HasDrillDown: Boolean; var l: TList; i: Integer; c: TfrxComponent; begin Result := False; l := Report.AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then begin Result := True; break; end; end; end; procedure EnableControls(cAr: array of TObject; Enabled: Boolean); var i: Integer; begin for i := 0 to High(cAr) do begin if cAr[i] is TMenuItem then TMenuItem(cAr[i]).Visible := Enabled else if cAr[i] is TfrxToolButton then begin TfrxToolButton(cAr[i]).Enabled := Enabled; TfrxToolButton(cAr[i]).Down := False; if TfrxToolButton(cAr[i]).Tag <> 0 then TMenuItem(TfrxToolButton(cAr[i]).Tag).Enabled := Enabled; end; end; end; begin EnableControls([PrintB, OpenB, SaveB, ExportB, PageSettingsB], (not FPreview.FRunning) and (FPreview.PageCount > 0)); EnableControls([OpenB], (not FPreview.FRunning)); EnableControls([DesignerB], not FPreview.FRunning and Report.PreviewOptions.AllowEdit); EnableControls([ExpandMI, CollapseMI, N1], not FPreview.FRunning and HasDrillDown); end; procedure TfrxPreviewForm.PrintBClick(Sender: TObject); begin FPreview.Print; end; procedure TfrxPreviewForm.PrintBMouseEnter(Sender: TObject); var p, r: TRectF; s: String; begin if (Sender is TControl) then begin if Sender is TfrxToolButton then s:= TfrxToolButton(Sender).Hint else s := TControl(Sender).TagString; p := TControl(Sender).AbsoluteRect; r := RectF(0, 0, 300, 1000); if Label1.Canvas <> nil then begin Label1.Canvas.MeasureText(r, s, True, [], TTextAlign.taCenter, TTextAlign.taCenter); HintPanel.Width := r.Width + 12; HintPanel.Height := r.Height + HintPanel.CalloutLength + 10; end; if (p.Left + TControl(Sender).Width/2 > HintPanel.Width/2) then begin HintPanel.CalloutPosition := TCalloutPosition.cpTop; HintPanel.Position.X := p.Left + TControl(Sender).Width/2 - HintPanel.Width/2; HintPanel.Position.Y := p.Top + TControl(Sender).Height; {$IFDEF DELPHI18} Label1.Margins.Left := 0; Label1.Margins.Top := 0; {$ELSE} Label1.Padding.Left := 0; Label1.Padding.Top := 0; {$ENDIF} end else begin HintPanel.CalloutPosition := TCalloutPosition.cpLeft; HintPanel.Position.X := p.Left + TControl(Sender).Width; HintPanel.Position.Y := p.Top - HintPanel.Height/2 + TControl(Sender).Height/2; HintPanel.Width := HintPanel.Width + HintPanel.CalloutLength; {$IFDEF DELPHI18} Label1.Margins.Left := HintPanel.CalloutLength / 2; Label1.Margins.Top := HintPanel.CalloutLength / 2; {$ELSE} Label1.Padding.Left := HintPanel.CalloutLength; Label1.Padding.Top := -HintPanel.CalloutLength; {$ENDIF} end; HintPanel.Visible := True; Label1.Text := s; end; end; procedure TfrxPreviewForm.PrintBMouseLeave(Sender: TObject); begin HintPanel.Visible := False; end; procedure TfrxPreviewForm.OpenBClick(Sender: TObject); begin FPreview.LoadFromFile; PeekLastModalResult; if Report.ReportOptions.Name <> '' then Caption := Report.ReportOptions.Name else Caption := frxGet(100); {$IFDEF FRVIEWER} UpdateControls; {$ENDIF} end; procedure TfrxPreviewForm.SaveBClick(Sender: TObject); begin FPreview.SaveToFile; PeekLastModalResult; end; procedure TfrxPreviewForm.ZoomPlusBClick(Sender: TObject); begin FPreview.Zoom := FPreview.Zoom + 0.25; end; procedure TfrxPreviewForm.ZoomMinusBClick(Sender: TObject); begin FPreview.Zoom := FPreview.Zoom - 0.25; end; function TfrxPreviewForm.GetReport: TfrxReport; begin Result := Preview.Report; end; procedure TfrxPreviewForm.UpdateZoom; begin ZoomCB.Text := IntToStr(Round(FPreview.Zoom * 100)) + '%'; end; procedure TfrxPreviewForm.WholePageBClick(Sender: TObject); begin FPreview.ZoomMode := zmWholePage end; procedure TfrxPreviewForm.ZoomCBChange(Sender: TObject); begin if FPreview = nil then Exit; FPreview.SetFocus; //FPreview.Zoom := ZoomCB.Value / 100; end; procedure TfrxPreviewForm.ZoomCBClick(Sender: TObject); var s: String; begin { Note: TComboTrakBar causes errors in XE3 under OSX. Was removed } if FPreview = nil then Exit; s := ZoomCB.Text; if Pos('%', s) <> 0 then s[Pos('%', s)] := ' '; while Pos(' ', s) <> 0 do Delete(s, Pos(' ', s), 1); if s <> '' then FPreview.Zoom := frxStrToFloat(s) / 100; end; procedure TfrxPreviewForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState); begin if Key = vkESCAPE then CancelBClick(Self); if Key = vkF11 then SwitchToFullScreen; if Key = vkF1 then frxResources.Help(Self); if Key = vkReturn then begin if ActiveControl = PageE then PageEClick(nil); end; end; procedure TfrxPreviewForm.PageSettingsBClick(Sender: TObject); begin FPreview.PageSetupDlg; end; procedure TfrxPreviewForm.PageWidthBClick(Sender: TObject); begin FPreview.ZoomMode := zmPageWidth; end; procedure TfrxPreviewForm.OnPageChanged(Sender: TfrxPreview; PageNo: Integer); var FirstPass: Boolean; begin FirstPass := False; if FPreview.PreviewPages <> nil then FirstPass := not FPreview.PreviewPages.Engine.FinalPass; if FirstPass and FPreview.FRunning then Panel0.Text := frxResources.Get('clFirstPass') + ' ' + IntToStr(FPreview.PageCount) else Panel0.Text := Format(frxResources.Get('clPageOf'), [PageNo, FPreview.PageCount]); Panel0.Repaint; PageE.Text := IntToStr(PageNo); end; procedure TfrxPreviewForm.PageEClick(Sender: TObject); begin FPreview.PageNo := StrToInt(PageE.Text); FPreview.SetFocus; end; procedure TfrxPreviewForm.FirstBClick(Sender: TObject); begin FPreview.First; end; procedure TfrxPreviewForm.PriorBClick(Sender: TObject); begin FPreview.Prior; end; procedure TfrxPreviewForm.NextBClick(Sender: TObject); begin FPreview.Next; end; procedure TfrxPreviewForm.LastBClick(Sender: TObject); begin FPreview.Last; end; procedure TfrxPreviewForm.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); var p: TpointF; begin p := ClientToScreen(PointF(X, Y)); if Button = TMouseButton.mbRight then begin { pop up menu never remove itself when clicking right mouse button } { and create another instance of the menu } { if menu has all Children items, then it's hiden and we can show it again } if RightMenu.ChildrenCount = FPopUpMItemsCount then RightMenu.Popup(p.X, p.Y); end; end; procedure TfrxPreviewForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); begin FPreview.MouseWheelScroll(WheelDelta, False, ssCtrl in Shift); end; procedure TfrxPreviewForm.DesignerBClick(Sender: TObject); begin FPreview.Edit; end; procedure TfrxPreviewForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := not FPreview.FRunning; end; procedure TfrxPreviewForm.FormClose(Sender: TObject; var Action: TCloseAction); begin if FFreeOnClose then Action := TCloseAction.caFree; if (Report <> nil) and (Assigned(Report.OnClosePreview)) then Report.OnClosePreview(Self); end; procedure TfrxPreviewForm.NewPageBClick(Sender: TObject); begin FPreview.AddPage; end; procedure TfrxPreviewForm.DelPageBClick(Sender: TObject); begin FPreview.DeletePage; end; procedure TfrxPreviewForm.CancelBClick(Sender: TObject); begin if FPreview.FRunning then FPreview.Cancel else Close; end; procedure TfrxPreviewForm.ExportBClick(Sender: TObject); var p: TpointF; begin p := ClientToScreen(ExportB.Position.Point); if ExportPopup.ChildrenCount = FPopUpExporttemsCount then ExportPopup.Popup(p.X, p.Y); end; procedure TfrxPreviewForm.ExportMIClick(Sender: TObject); begin FPreview.Export(TfrxCustomExportFilter(frxExportFilters[TMenuItem(Sender).Tag].Filter)); end; procedure TfrxPreviewForm.DesignerBMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //var // pt: TPoint; begin // todo { pt := DesignerB.ClientToScreen(Point(0, 0)); if Button = mbRight then HiddenMenu.Popup(pt.X, pt.Y);} end; procedure TfrxPreviewForm.Showtemplate1Click(Sender: TObject); begin FPreview.EditTemplate; end; procedure TfrxPreviewForm.SetMessageText(const Value: String; IsHint: Boolean); begin if IsHint then begin if not ((Value = '') and (Panel2.Text = '')) then Panel2.Text := Value; end else Panel1.Text := Value; //Application.HandleMessage; Report.AppHandleMessage; end; procedure TfrxPreviewForm.SwitchToFullScreen; begin if not FFullScreen then begin StatusBar.Visible := False; ToolBar.Visible := False; FOldState := WindowState; WindowState := wsMaximized; FFullScreen := True; end else begin WindowState := FOldState; FFullScreen := False; StatusBar.Visible := True; ToolBar.Visible := True; end; end; procedure TfrxPreviewForm.FullScreenBtnClick(Sender: TObject); begin SwitchToFullScreen; end; procedure TfrxPreviewForm.PdfBClick(Sender: TObject); begin if Assigned(FPDFExport) then FPreview.Export(FPDFExport); end; procedure TfrxPreviewForm.EmailBClick(Sender: TObject); begin if Assigned(FEmailExport) then FPreview.Export(FEmailExport); end; procedure TfrxPreviewForm.OutlineBClick(Sender: TObject); begin FPreview.OutlineVisible := not FPreview.OutlineVisible;//OutlineB.Down; end; procedure TfrxPreviewForm.ThumbBClick(Sender: TObject); begin FPreview.ThumbnailVisible := not FPreview.ThumbnailVisible;//ThumbB.Down; end; procedure TfrxPreviewForm.OnPreviewDblClick(Sender: TObject); begin if FFullScreen then SwitchToFullScreen; end; procedure TfrxPreviewForm.CollapseAllClick(Sender: TObject); var l: TList; i: Integer; c: TfrxComponent; begin FPreview.Lock; l := Report.AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then TfrxGroupHeader(c).ExpandDrillDown := False; end; Report.DrillState.Clear; Preview.RefreshReport; Preview.SetPosition(0,0); end; procedure TfrxPreviewForm.ExpandAllClick(Sender: TObject); var l: TList; i: Integer; c: TfrxComponent; begin FPreview.Lock; l := Report.AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then TfrxGroupHeader(c).ExpandDrillDown := True; end; Report.DrillState.Clear; Preview.RefreshReport; end; initialization StartClassGroup(TFmxObject); ActivateClassGroup(TFmxObject); GroupDescendentsWith(TfrxPreview, TFmxObject); GroupDescendentsWith(TfrxPreviewWorkspace, TFmxObject); RegisterFmxClasses([TfrxPreviewWorkspace, TfrxPreview]); end.