3525 lines
98 KiB
ObjectPascal
3525 lines
98 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ Preview Pages }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxPreviewPages;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
{$IFNDEF FPC}Windows,{$ENDIF}
|
|
Messages, Types, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
frxClass, frxXML, frxPictureCache, frxBaseGraphicsTypes, Printers
|
|
{$IFDEF FPC}
|
|
, LCLType, LResources, LCLIntf, LazHelper
|
|
{$IFDEF LCLGTK2}
|
|
, CairoCanvas
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF Delphi6}
|
|
, Variants
|
|
{$ENDIF};
|
|
|
|
|
|
type
|
|
TfrxOutline = class(TfrxCustomOutline)
|
|
private
|
|
protected
|
|
function GetCount: Integer; override;
|
|
public
|
|
function Root: TfrxXMLItem;
|
|
procedure AddItem(const Text: String; Top: Integer); override;
|
|
procedure DeleteItems(From: TfrxXMLItem); override;
|
|
procedure LevelDown(Index: Integer); override;
|
|
procedure LevelRoot; override;
|
|
procedure LevelUp; override;
|
|
procedure GetItem(Index: Integer; var Text: String;
|
|
var Page, Top: Integer); override;
|
|
procedure ShiftItems(From: TfrxXMLItem; NewTop: Integer); override;
|
|
function GetCurPosition: TfrxXMLItem; override;
|
|
end;
|
|
|
|
TfrxDictionary = class(TObject)
|
|
private
|
|
FNames: TStringList;
|
|
FSourceNames: TStringList;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Add(const Name, SourceName: String; Obj: TObject);
|
|
procedure Clear;
|
|
function AddUnique(const Base, SourceName: String; Obj: TObject): String;
|
|
function CreateUniqueName(const Base: String): String;
|
|
function GetSourceName(const Name: String): String;
|
|
function GetObject(const Name: String): TObject;
|
|
property Names: TStringList read FNames;
|
|
property SourceNames: TStringList read FSourceNames;
|
|
end;
|
|
|
|
TfrxSignaturePages = class(TStringList)
|
|
protected
|
|
FActive: Boolean;
|
|
public
|
|
constructor Create;
|
|
procedure Activate;
|
|
procedure Deactivate;
|
|
function IsContaine(Name: string): Boolean;
|
|
|
|
property Active: Boolean read FActive;
|
|
end;
|
|
|
|
TfrxPreviewPages = class(TfrxCustomPreviewPages)
|
|
private
|
|
FAllowPartialLoading: Boolean;
|
|
FDictionary: TfrxDictionary; { list of all objects }
|
|
FFirstObjectIndex: Integer; { used in the ClearFirstPassPages }
|
|
FFirstPageIndex: Integer; { used in the ClearFirstPassPages }
|
|
FFirstOutlineIndex: Integer; { used in the ClearFirstPassPages }
|
|
FLogicalPageN: Integer;
|
|
FPageCache: TStringList; { last 20 TfrxPreviewPage }
|
|
FPagesItem: TfrxXMLItem; { shortcut to XMLDoc.Root.FindName('previewpages') }
|
|
FPictureCache: TfrxPictureCache;
|
|
FSourcePages: TList; { list of source pages }
|
|
FTempStream: TStream;
|
|
FXMLDoc: TfrxXMLDocument; { parsed FP3 document }
|
|
FXMLSize: Integer;
|
|
FLastY: Extended; { last Y for composite report created with AddFrom }
|
|
// FMouseInView: Boolean; { used in the ObjectOver to deteterminate mouseleave/mouseenter events }
|
|
FLastObjectOver: TfrxView;
|
|
FLastDrill: TfrxGroupHeader;
|
|
FLockedPage: TfrxReportPage;
|
|
FCachedGraphicState: TfrxCachedGraphicType;
|
|
procedure AfterLoad;
|
|
procedure BeforeSave;
|
|
procedure ClearPageCache;
|
|
procedure ClearSourcePages;
|
|
function CurXMLPage: TfrxXMLItem;
|
|
function GetObject(const Name: String): TfrxComponent;
|
|
procedure DoLoadFromStream;
|
|
procedure DoSaveToStream;
|
|
function ProcessHyperlink(Hyperlink: TfrxHyperlink): Boolean;
|
|
procedure ThumbnailsUpdated(Sender: TObject; UpdateState: TfrxThumbnailsUpdateState);
|
|
protected
|
|
FSignaturePages: TfrxSignaturePages;
|
|
|
|
function GetCount: Integer; override;
|
|
function GetPage(Index: Integer): TfrxReportPage; override;
|
|
function GetPageSize(Index: Integer): TPoint; override;
|
|
procedure UpdateCachedObject(CachedObject: TfrxComponent; IsLoading: Boolean = False);
|
|
function GetPictureCacheOptions: TfrxPictureCacheOptions; override;
|
|
public
|
|
constructor Create(AReport: TfrxReport); override;
|
|
destructor Destroy; override;
|
|
procedure Clear; override;
|
|
procedure Initialize; override;
|
|
|
|
{ engine commands }
|
|
procedure AddAnchor(const Text: String);
|
|
procedure AddObject(Obj: TfrxComponent); override;
|
|
procedure AddPage(Page: TfrxReportPage); override;
|
|
procedure AddPicture(Picture: TfrxPictureView); override;
|
|
function AddGraphic(Graphic: TGraphic): Integer; override;
|
|
procedure AddSourcePage(Page: TfrxReportPage); override;
|
|
procedure AddToSourcePage(Obj: TfrxComponent); override;
|
|
procedure BeginPass; override;
|
|
procedure ClearFirstPassPages; override;
|
|
procedure CutObjects(APosition: Integer); override;
|
|
procedure DeleteObjects(APosition: Integer); override;
|
|
procedure DeleteAnchors(From: Integer); override;
|
|
procedure Finish; override;
|
|
procedure FireMouseLeave; override;
|
|
procedure IncLogicalPageNumber; override;
|
|
procedure ResetLogicalPageNumber; override;
|
|
procedure PasteObjects(X, Y: Extended); override;
|
|
procedure ShiftAnchors(From, NewTop: Integer); override;
|
|
procedure UpdatePageDimensions(Page: TfrxReportPage; Width, Height: Extended);
|
|
{ fast update of page bounds used for endless width }
|
|
procedure UpdatePageDimension(Index: Integer; Width, Height: Extended; AOrientation: TPrinterOrientation);
|
|
procedure UpdatePageLastColumn(aColumn: Integer; aColumnPos: Extended; aReset: Boolean = False);
|
|
procedure GetLastColumnPos(var aColumn: Integer; var ColumnPos: Extended);
|
|
function BandExists(Band: TfrxBand): Boolean; override;
|
|
function FindAnchor(const Text: String): TfrxXMLItem;
|
|
function FindAnchorRoot: TfrxXMLItem;
|
|
function GetPicture(CacheType: TfrxCachedGraphicType; ImageIndex: Integer): IfrxCachedGraphic; override;
|
|
function GetAnchorPage(const Text: String): Integer;
|
|
function GetAnchorCurPosition: Integer; override;
|
|
function GetCurPosition: Integer; override;
|
|
function GetLastY(ColumnPosition: Extended = 0): Extended; override;
|
|
function GetLogicalPageNo: Integer; override;
|
|
function GetLogicalTotalPages: Integer; override;
|
|
{ Lock/Unlock page uses to save-lock current exporting page }
|
|
{ in case export filter clears PageChache }
|
|
procedure LockPage;
|
|
procedure UnlockPage;
|
|
|
|
{ preview commands }
|
|
{$IFDEF ACADEMIC_ED}
|
|
procedure DrawWaterMark(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY, aPaperWidth, aPaperHeight: Extended);
|
|
{$ENDIF}
|
|
procedure DrawPage(Index: Integer; Canvas: TCanvas; ScaleX, ScaleY,
|
|
OffsetX, OffsetY: Extended; bHighlightEditable: Boolean = False); override;
|
|
procedure AddEmptyPage(Index: Integer); override;
|
|
procedure DeletePage(Index: Integer); override;
|
|
procedure ModifyPage(Index: Integer; Page: TfrxReportPage); override;
|
|
procedure ModifyObject(Component: TfrxComponent); override;
|
|
procedure AddFrom(Report: TfrxReport); overload; override;
|
|
procedure AddFromPreviewPages(vPreviewPages: TfrxCustomPreviewPages); overload; override;
|
|
procedure LoadFromStream(Stream: TStream;
|
|
AllowPartialLoading: Boolean = False); override;
|
|
function SaveToFilter(Filter: TfrxCustomIOTransport; const FileName: String): Boolean; override;
|
|
procedure SaveToStream(Stream: TStream); override;
|
|
function LoadFromFile(const FileName: String;
|
|
ExceptionIfNotFound: Boolean = False): Boolean; override;
|
|
procedure SaveToFile(const FileName: String); override;
|
|
function Print: Boolean; override;
|
|
function Export(Filter: TfrxCustomExportFilter): Boolean; override;
|
|
procedure ObjectOver(Index: Integer; X, Y: Integer; Button: TMouseButton;
|
|
Shift: TShiftState; Scale, OffsetX, OffsetY: Extended; var aEventParams: TfrxPreviewIntEventParams); override;
|
|
property SourcePages: TList read FSourcePages;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
frxPreview,
|
|
frxPrinter,
|
|
{$IFDEF DBGLOG}frxCryptoUtils,frxDebug,{$ENDIF}
|
|
frxPrintDialog,
|
|
frxXMLSerializer,
|
|
frxUtils,
|
|
{$IFDEF FPC}
|
|
LCLProc,
|
|
{$ELSE}
|
|
ShellApi,
|
|
{$ENDIF}
|
|
frxDMPClass,
|
|
frxRes,
|
|
frxProtocolFactory
|
|
{$IFDEF ACADEMIC_ED}
|
|
, frxGraphicUtils
|
|
, frxUnicodeUtils
|
|
{$IFDEF Delphi10}
|
|
, WideStrings
|
|
{$ENDIF}
|
|
{$ENDIF};
|
|
|
|
type
|
|
THackComponent = class(TfrxComponent);
|
|
THackMemoView = class(TfrxCustomMemoView);
|
|
THackThread = class(TThread);
|
|
|
|
{$IFDEF TRIAL}
|
|
const
|
|
FR_UNREG = ')segap 5 ylno( noisrev deretsigernU - tropeRtsaF';
|
|
{$ENDIF}
|
|
|
|
{$IFDEF ACADEMIC_ED}
|
|
const
|
|
FR_ACAD= 'NOISREV CIMEDACA';
|
|
{$ENDIF}
|
|
|
|
const
|
|
PropPaperSize = 'PaperSize';
|
|
PropPaperWidth = 'PaperWidth';
|
|
PropPaperHeight = 'PaperHeight';
|
|
|
|
{ TfrxOutline }
|
|
|
|
procedure TfrxOutline.AddItem(const Text: String; Top: Integer);
|
|
begin
|
|
CurItem := CurItem.Add;
|
|
CurItem.Name := 'item';
|
|
CurItem.Text := 'text="' + frxStrToXML(Text) +
|
|
'" page="' + IntToStr(PreviewPages.CurPage) +
|
|
'" top="' + IntToStr(Top) + '"';
|
|
end;
|
|
|
|
procedure TfrxOutline.GetItem(Index: Integer; var Text: String; var Page,
|
|
Top: Integer);
|
|
var
|
|
Item: TfrxXMLItem;
|
|
s: String;
|
|
begin
|
|
Item := CurItem[Index];
|
|
Text := Item.Prop['text'];
|
|
|
|
s := String(Item.Prop['page']);
|
|
if s <> '' then
|
|
Page := StrToInt(s);
|
|
|
|
s := String(Item.Prop['top']);
|
|
if s <> '' then
|
|
Top := StrToInt(s);
|
|
end;
|
|
|
|
procedure TfrxOutline.LevelDown(Index: Integer);
|
|
begin
|
|
CurItem := CurItem[Index];
|
|
end;
|
|
|
|
procedure TfrxOutline.LevelRoot;
|
|
begin
|
|
CurItem := Root;
|
|
end;
|
|
|
|
procedure TfrxOutline.LevelUp;
|
|
begin
|
|
if CurItem <> Root then
|
|
CurItem := CurItem.Parent;
|
|
end;
|
|
|
|
function TfrxOutline.Root: TfrxXMLItem;
|
|
begin
|
|
Result := TfrxPreviewPages(PreviewPages).FXMLDoc.Root.FindItem('outline');
|
|
end;
|
|
|
|
procedure TfrxOutline.DeleteItems(From: TfrxXMLItem);
|
|
var
|
|
nCount: Integer;
|
|
begin
|
|
if From = nil then Exit;
|
|
nCount := From.Parent.IndexOf(From) + 1;
|
|
if nCount >= From.Parent.Count then Exit;
|
|
From := From.Parent;
|
|
while nCount < From.Count do
|
|
From[From.Count - 1].Free;
|
|
end;
|
|
|
|
function TfrxOutline.GetCount: Integer;
|
|
begin
|
|
if CurItem = nil then
|
|
Result := 0
|
|
else
|
|
Result := CurItem.Count;
|
|
end;
|
|
|
|
procedure TfrxOutline.ShiftItems(From: TfrxXMLItem; NewTop: Integer);
|
|
var
|
|
i, TopY, CorrY: Integer;
|
|
|
|
procedure EnumItems(Item: TfrxXMLItem);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Item.Prop['page'] := IntToStr(StrToInt(Item.Prop['page']) + 1);
|
|
Item.Prop['top'] := IntToStr(StrToInt(Item.Prop['top']) + CorrY);
|
|
for i := 0 to Item.Count - 1 do
|
|
EnumItems(Item[i]);
|
|
end;
|
|
|
|
begin
|
|
if From = nil then Exit;
|
|
i := From.Parent.IndexOf(From);
|
|
if i + 1 >= From.Parent.Count then Exit;
|
|
From := From.Parent[i + 1];
|
|
|
|
TopY := StrToInt(String(From.Prop['top']));
|
|
CorrY := NewTop - TopY;
|
|
EnumItems(From);
|
|
end;
|
|
|
|
function TfrxOutline.GetCurPosition: TfrxXMLItem;
|
|
begin
|
|
if Count = 0 then
|
|
Result := nil else
|
|
Result := CurItem[Count - 1];
|
|
end;
|
|
|
|
|
|
{ TfrxDictionary }
|
|
|
|
constructor TfrxDictionary.Create;
|
|
begin
|
|
FNames := TStringList.Create;
|
|
FNames.Sorted := True;
|
|
FNames.Duplicates := dupIgnore;
|
|
FSourceNames := TStringList.Create;
|
|
end;
|
|
|
|
destructor TfrxDictionary.Destroy;
|
|
begin
|
|
FNames.Free;
|
|
FSourceNames.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxDictionary.Clear;
|
|
begin
|
|
FNames.Clear;
|
|
FSourceNames.Clear;
|
|
end;
|
|
|
|
procedure TfrxDictionary.Add(const Name, SourceName: String; Obj: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := FSourceNames.AddObject(SourceName, Obj);
|
|
FNames.AddObject(Name, TObject(i));
|
|
end;
|
|
|
|
function TfrxDictionary.AddUnique(const Base, SourceName: String; Obj: TObject): String;
|
|
{$IFDEF Delphi12}
|
|
var
|
|
TempStr: String;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
TempStr := CreateUniqueName(Base);
|
|
Add(TempStr, SourceName, Obj);
|
|
Result := TempStr;
|
|
{$ELSE}
|
|
Result := CreateUniqueName(Base);
|
|
Add(Result, SourceName, Obj);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TfrxDictionary.CreateUniqueName(const Base: String): String;
|
|
var
|
|
i, Index: Integer;
|
|
begin
|
|
i := 1;
|
|
if FNames.Count > 3 then
|
|
begin
|
|
Index := FNames.Add(String(Base) + '0');
|
|
Index := FNames.Add(String(Base) + 'A') - Index;
|
|
i := Index - 1;
|
|
while FNames.IndexOf(String(Base) + IntToStr(i)) = -1 do
|
|
Dec(i);
|
|
end;
|
|
|
|
while FNames.IndexOf(String(Base) + IntToStr(i)) <> -1 do
|
|
Inc(i);
|
|
|
|
Result := Base + IntToStr(i);
|
|
end;
|
|
|
|
function TfrxDictionary.GetObject(const Name: String): TObject;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
i := FNames.IndexOf(Name);
|
|
if i <> -1 then
|
|
Result := FSourceNames.Objects[frxInteger(FNames.Objects[i])];
|
|
end;
|
|
|
|
function TfrxDictionary.GetSourceName(const Name: String): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
i := FNames.IndexOf(Name);
|
|
if i <> -1 then
|
|
Result := FSourceNames[frxInteger(FNames.Objects[i])];
|
|
end;
|
|
|
|
|
|
{ TfrxPreviewPages }
|
|
|
|
constructor TfrxPreviewPages.Create(AReport: TfrxReport);
|
|
begin
|
|
inherited;
|
|
FDictionary := TfrxDictionary.Create;
|
|
FSourcePages := TList.Create;
|
|
FXMLDoc := TfrxXMLDocument.Create;
|
|
FXMLDoc.Root.Name := 'preparedreport';
|
|
// FXMLDoc.AutoIndent := True;
|
|
FPageCache := TStringList.Create;
|
|
FPictureCache := TfrxPictureCache.Create;
|
|
if Assigned(AReport.PreviewPagesList) and Assigned(AReport.PreviewPagesList.Main) then
|
|
FPictureCache.PictureCacheOptions.Assign(AReport.PreviewPagesList.Main.PictureCacheOptions);
|
|
FPictureCache.OnThumbnailUpdated := ThumbnailsUpdated;
|
|
FLastY := 0;
|
|
FLastObjectOver := nil;
|
|
FLastDrill := nil;
|
|
FSignaturePages := TfrxSignaturePages.Create;
|
|
FCachedGraphicState := cgOriginal;
|
|
end;
|
|
|
|
destructor TfrxPreviewPages.Destroy;
|
|
begin
|
|
FLockedPage := nil;
|
|
ClearPageCache;
|
|
FPageCache.Free;
|
|
FDictionary.Free;
|
|
ClearSourcePages;
|
|
FPictureCache.Free;
|
|
FSourcePages.Free;
|
|
FXMLDoc.Free;
|
|
FSignaturePages.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.Clear;
|
|
begin
|
|
FLockedPage := nil;
|
|
ClearPageCache;
|
|
ClearSourcePages;
|
|
FXMLDoc.Clear;
|
|
FDictionary.Clear;
|
|
FPostProcessor.Clear;
|
|
FPictureCache.Clear;
|
|
CurPage := -1;
|
|
FXMLSize := 0;
|
|
FLastY := 0;
|
|
FLastObjectOver := nil;
|
|
FPagesItem := nil;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.Initialize;
|
|
begin
|
|
FPictureCache.UseFileCache := Report.PreviewOptions.PictureCacheInFile;
|
|
FPictureCache.TempDir := Report.EngineOptions.TempDir;
|
|
FXMLDoc.TempDir := Report.EngineOptions.TempDir;
|
|
Report.InternalOnProgressStart(ptRunning);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ClearPageCache;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
Index, sIndex, i: Integer;
|
|
pIndex: String;
|
|
begin
|
|
if Assigned(Report.Preview) then
|
|
Report.Preview.Lock;
|
|
try
|
|
sIndex := 0;
|
|
if Assigned(FLockedPage) then
|
|
begin
|
|
sIndex := 1;
|
|
pIndex := FPageCache[0];
|
|
end;
|
|
for i := sIndex to FPageCache.Count - 1 do
|
|
begin
|
|
if (Report <> nil) and (FXMLDoc <> nil) and (FPagesItem <> nil) and
|
|
(FPagesItem.Count > 0) then
|
|
begin
|
|
Index := StrToInt(FPageCache[i]);
|
|
xi := nil;
|
|
if Index < FPagesItem.Count then
|
|
xi := FPagesItem[Index];
|
|
if Report.EngineOptions.UseFileCache and (xi <> nil) and xi.Unloadable then
|
|
begin
|
|
FXMLDoc.UnloadItem(xi);
|
|
xi.Clear;
|
|
end;
|
|
end;
|
|
TfrxReportPage(FPageCache.Objects[i]).Free;
|
|
end;
|
|
FPageCache.Clear;
|
|
if Assigned(FLockedPage) then
|
|
FPageCache.AddObject(pIndex, FLockedPage);
|
|
|
|
FLastObjectOver := nil;
|
|
FLastDrill := nil;
|
|
finally
|
|
if Assigned(Report.Preview) then
|
|
Report.Preview.Unlock(False); // do not refresh, prevent flickering
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ClearSourcePages;
|
|
begin
|
|
while FSourcePages.Count > 0 do
|
|
begin
|
|
TfrxReportPage(FSourcePages[0]).Free;
|
|
FSourcePages.Delete(0);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.BeginPass;
|
|
begin
|
|
FFirstPageIndex := Count - 1;
|
|
if FFirstPageIndex <> -1 then
|
|
begin
|
|
FFirstObjectIndex := FXMLDoc.Root.FindItem('previewpages')[FFirstPageIndex].Count;
|
|
FFirstOutlineIndex := FXMLDoc.Root.FindItem('outline').Count;
|
|
end;
|
|
ResetLogicalPageNumber;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ClearFirstPassPages;
|
|
var
|
|
PagesRoot, OutlineRoot: TfrxXMLItem;
|
|
p: TfrxXMLItem;
|
|
i: Integer;
|
|
begin
|
|
if FFirstPageIndex = -1 then
|
|
begin
|
|
for i := 0 to FXMLDoc.Root.Count - 1 do
|
|
{$IFDEF Delphi12}
|
|
{ if (AnsiStrIComp(PAnsiChar(FXMLDoc.Root[i].Name), PAnsiChar(AnsiString('anchors'))) <> 0) and
|
|
(AnsiStrIComp(PAnsiChar(FXMLDoc.Root[i].Name), PAnsiChar(AnsiString('logicalpagenumbers'))) <> 0) then}
|
|
if (CompareText(FXMLDoc.Root[i].Name, 'anchors') <> 0) and
|
|
(CompareText(FXMLDoc.Root[i].Name, 'logicalpagenumbers') <> 0) then
|
|
{$ELSE}
|
|
if (CompareText(FXMLDoc.Root[i].Name, 'anchors') <> 0) and
|
|
(CompareText(FXMLDoc.Root[i].Name, 'logicalpagenumbers') <> 0) then
|
|
{$ENDIF}
|
|
FXMLDoc.Root[i].Clear;
|
|
|
|
end
|
|
else
|
|
begin
|
|
PagesRoot := FXMLDoc.Root.FindItem('previewpages');
|
|
OutlineRoot := FXMLDoc.Root.FindItem('outline');
|
|
p := PagesRoot[FFirstPageIndex];
|
|
{ clear some objects on first page }
|
|
while p.Count > FFirstObjectIndex do
|
|
p[FFirstObjectIndex].Free;
|
|
{ clear remained pages }
|
|
while Count > FFirstPageIndex + 1 do
|
|
PagesRoot[FFirstPageIndex + 1].Free;
|
|
{ clear remained outline }
|
|
while OutlineRoot.Count > FFirstOutlineIndex do
|
|
OutlineRoot[FFirstOutlineIndex].Free;
|
|
end;
|
|
|
|
ResetLogicalPageNumber;
|
|
CurPage := FFirstPageIndex;
|
|
FXMLSize := 0;
|
|
end;
|
|
|
|
function TfrxPreviewPages.CurXMLPage: TfrxXMLItem;
|
|
begin
|
|
Result := FXMLDoc.Root.FindItem('previewpages');
|
|
Result := Result[CurPage];
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetCount: Integer;
|
|
begin
|
|
Result := FXMLDoc.Root.FindItem('previewpages').Count;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetCurPosition: Integer;
|
|
begin
|
|
Result := CurXMLPage.Count;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddAnchor(const Text: String);
|
|
var
|
|
AnchorRoot, Item: TfrxXMLItem;
|
|
begin
|
|
AnchorRoot := FXMLDoc.Root.FindItem('anchors');
|
|
Item := AnchorRoot.Add;
|
|
Item.Name := 'item';
|
|
Item.Text := 'text="' + frxStrToXML(Text) +
|
|
'" page="' + IntToStr(CurPage) +
|
|
'" top="' + IntToStr(Round(Engine.CurY)) + '"';
|
|
end;
|
|
|
|
function TfrxPreviewPages.FindAnchor(const Text: String): TfrxXMLItem;
|
|
var
|
|
AnchorRoot, Item: TfrxXMLItem;
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
AnchorRoot := FXMLDoc.Root.FindItem('anchors');
|
|
for i := AnchorRoot.Count - 1 downto 0 do
|
|
begin
|
|
Item := AnchorRoot[i];
|
|
{$IFDEF Delphi12}
|
|
// if AnsiCompareText(Item.Prop['text'], Text) = 0 then
|
|
// if AnsiStrIComp(PAnsiChar(Item.Prop['text']), Text) = 0 then
|
|
if AnsiCompareText(Item.Prop['text'], Text) = 0 then
|
|
{$ELSE}
|
|
if AnsiCompareText(Item.Prop['text'], Text) = 0 then
|
|
{$ENDIF}
|
|
begin
|
|
Result := Item;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.FindAnchorRoot: TfrxXMLItem;
|
|
begin
|
|
Result := FXMLDoc.Root.FindItem('anchors');
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetAnchorPage(const Text: String): Integer;
|
|
var
|
|
Item: TfrxXMLItem;
|
|
begin
|
|
Item := FindAnchor(Text);
|
|
if Item <> nil then
|
|
Result := StrToInt(String(Item.Prop['page'])) + 1 else
|
|
Result := 1;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetAnchorCurPosition: Integer;
|
|
begin
|
|
Result := FXMLDoc.Root.FindItem('anchors').Count - 1;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ShiftAnchors(From, NewTop: Integer);
|
|
var
|
|
i, CorrY: Integer;
|
|
AnchorRoot, Item: TfrxXMLItem;
|
|
begin
|
|
AnchorRoot := FXMLDoc.Root.FindItem('anchors');
|
|
if (From + 1 < 0) or (From + 1 >= AnchorRoot.Count) then Exit;
|
|
|
|
Item := AnchorRoot[From + 1];
|
|
CorrY := NewTop - StrToInt(String(Item.Prop['top']));
|
|
|
|
for i := From + 1 to AnchorRoot.Count - 1 do
|
|
begin
|
|
Item := AnchorRoot[i];
|
|
Item.Prop['page'] := IntToStr(StrToInt(Item.Prop['page']) + 1);
|
|
Item.Prop['top'] := IntToStr(StrToInt(Item.Prop['top']) + CorrY);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ThumbnailsUpdated(Sender: TObject;
|
|
UpdateState: TfrxThumbnailsUpdateState);
|
|
begin
|
|
if Report.Preview <> nil then
|
|
TfrxPreview(Report.Preview).Workspace.Repaint;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.IncLogicalPageNumber;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
if Engine.FinalPass and Engine.DoublePass then Exit;
|
|
|
|
Inc(FLogicalPageN);
|
|
xi := FXMLDoc.Root.FindItem('logicalpagenumbers').Add;
|
|
xi.Name := 'page';
|
|
xi.Prop['n'] := IntToStr(FLogicalPageN);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ResetLogicalPageNumber;
|
|
var
|
|
i: Integer;
|
|
xi, pageItem: TfrxXMLItem;
|
|
begin
|
|
if Engine.FinalPass and Engine.DoublePass then Exit;
|
|
|
|
pageItem := FXMLDoc.Root.FindItem('logicalpagenumbers');
|
|
for i := CurPage downto FFirstPageIndex + 1 do
|
|
begin
|
|
if (i < 0) or (i >= pageItem.Count) then continue;
|
|
xi := pageItem[i];
|
|
xi.Prop['t'] := IntToStr(FLogicalPageN);
|
|
if xi.Prop['n'] = '1' then
|
|
break;
|
|
end;
|
|
FLogicalPageN := 0;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetLogicalPageNo: Integer;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('logicalpagenumbers');
|
|
if (CurPage < 0) or (CurPage >= xi.Count) then
|
|
Result := CurPage - FirstPage + 1
|
|
else
|
|
begin
|
|
xi := xi[CurPage];
|
|
Result := StrToInt(String(xi.Prop['n']));
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetLogicalTotalPages: Integer;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('logicalpagenumbers');
|
|
if (CurPage < 0) or (CurPage >= xi.Count) then
|
|
Result := Engine.TotalPages - FirstPage
|
|
else
|
|
begin
|
|
xi := xi[CurPage];
|
|
if xi.Prop['t'] <> '' then
|
|
Result := StrToInt(String(xi.Prop['t']))
|
|
else
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.LockPage;
|
|
begin
|
|
if FPageCache.Count <= 0 then Exit;
|
|
if Assigned(FLockedPage) then
|
|
UnlockPage;
|
|
FLockedPage := TfrxReportPage(FPageCache.Objects[0]);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.UnlockPage;
|
|
begin
|
|
FLockedPage := nil;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddObject(Obj: TfrxComponent);
|
|
var
|
|
IsOriginalPage: Boolean;
|
|
CurPageItem: TfrxXMLItem;
|
|
|
|
procedure DoAdd(c: TfrxComponent; Item: TfrxXMLItem);
|
|
var
|
|
i: Integer;
|
|
LCachedView: IfrxCachedView;
|
|
begin
|
|
if (not c.Visible) or not (csPreviewVisible in c.frComponentStyle) then Exit;
|
|
if (c is TfrxView) and (TfrxView(c).IsPostProcessAllowed) then
|
|
TfrxView(c).SaveContentToDictionary(Report, FPostProcessor);
|
|
|
|
with THackComponent(c) do
|
|
begin
|
|
Item := Item.Add;
|
|
{ the component that was created after report has been started }
|
|
if (FOriginalComponent = nil) or IsOriginalPage then
|
|
begin
|
|
Item.Name := ClassName;
|
|
Item.Text := AllDiff(nil);
|
|
end
|
|
else
|
|
begin
|
|
{ the component that exists in the report template }
|
|
Item.Name := FAliasName;
|
|
if Engine.FinalPass then
|
|
begin
|
|
if Supports(c, IfrxCachedView, LCachedView) then
|
|
LCachedView.SetCachedGraphic(FPictureCache);
|
|
if csDefaultDiff in frComponentStyle then
|
|
Item.Text := AllDiff(FOriginalComponent) else
|
|
Item.Text := Diff(FOriginalComponent);
|
|
end
|
|
else
|
|
{ we don't need to output all info on the first pass, only coordinates }
|
|
Item.Text := InternalDiff(FOriginalComponent);
|
|
end;
|
|
Inc(FXMLSize, Length(Item.Name) + Length(Item.Text) + Item.InstanceSize + 16);
|
|
end;
|
|
|
|
for i := 0 to c.Objects.Count - 1 do
|
|
DoAdd(c.Objects[i], Item);
|
|
end;
|
|
|
|
begin
|
|
CurPageItem := CurXMLPage;
|
|
{ need for PrintOnPrevPage option when report has pages added by AddFrom method}
|
|
IsOriginalPage := ((CompareText(CurPageItem.Name, 'TfrxReportPage') = 0) or
|
|
(CompareText(CurPageItem.Name, 'TfrxDMPPage') = 0));
|
|
DoAdd(Obj, CurPageItem);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddPage(Page: TfrxReportPage);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
|
|
procedure UnloadPages;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Report.EngineOptions.UseFileCache then
|
|
if FXMLSize > Report.EngineOptions.MaxMemSize * 1024 * 1024 then
|
|
begin
|
|
for i := xi.Count - 2 downto 0 do
|
|
if xi[i].Loaded then
|
|
FXMLDoc.UnloadItem(xi[i]) else
|
|
break;
|
|
FXMLSize := 0;
|
|
end;
|
|
end;
|
|
|
|
function GetSourceNo(Page: TfrxReportPage): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := -1;
|
|
for i := 0 to FSourcePages.Count - 1 do
|
|
if THackComponent(FSourcePages[i]).FOriginalComponent = Page then
|
|
begin
|
|
Result := i;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FPagesItem := FXMLDoc.Root.FindItem('previewpages');
|
|
xi := FPagesItem;
|
|
UnloadPages;
|
|
|
|
CurPage := CurPage + 1;
|
|
if (CurPage >= Count) or (AddPageAction = apAdd) then
|
|
begin
|
|
xi := xi.Add;
|
|
xi.Name := 'page' + IntToStr(GetSourceNo(Page));
|
|
if Count > 2 then
|
|
xi.Unloadable := True;
|
|
Report.InternalOnProgress(ptRunning, CurPage + 1);
|
|
AddPageAction := apWriteOver;
|
|
CurPage := Count - 1;
|
|
IncLogicalPageNumber;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddSourcePage(Page: TfrxReportPage);
|
|
var
|
|
p: TfrxReportPage;
|
|
xs: TfrxXMLSerializer;
|
|
xi: TfrxXMLItem;
|
|
i: Integer;
|
|
originals, copies: TList;
|
|
c1, c2: TfrxComponent;
|
|
s, s1: String;
|
|
|
|
function EnumObjects(Parent, Parent1: TfrxComponent): TfrxComponent;
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
begin
|
|
Result := nil;
|
|
if not (csPreviewVisible in Parent.frComponentStyle) then
|
|
begin
|
|
originals.Add(Parent);
|
|
copies.Add(nil);
|
|
Exit;
|
|
end;
|
|
|
|
c := TfrxComponent(Parent.NewInstance);
|
|
c.Create(Parent1);
|
|
if Parent is TfrxPictureView then
|
|
TfrxPictureView(Parent).IsPictureStored := False;
|
|
c.AssignToDict(Parent);
|
|
if Parent is TfrxPictureView then
|
|
TfrxPictureView(Parent).IsPictureStored := True;
|
|
c.Name := Parent.Name;
|
|
originals.Add(Parent);
|
|
copies.Add(c);
|
|
|
|
for i := 0 to Parent.Objects.Count - 1 do
|
|
EnumObjects(Parent.Objects[i], c);
|
|
Result := c;
|
|
end;
|
|
|
|
begin
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
xi := TfrxXMLItem.Create;
|
|
originals := TList.Create;
|
|
copies := TList.Create;
|
|
|
|
try
|
|
p := TfrxReportPage(EnumObjects(Page, nil));
|
|
THackComponent(p).FOriginalComponent := Page;
|
|
FSourcePages.Add(p);
|
|
|
|
for i := 1 to copies.Count - 1 do
|
|
begin
|
|
c1 := copies[i];
|
|
c2 := originals[i];
|
|
if (c1 = nil) and not (csPreviewVisible in c2.frComponentStyle ) then
|
|
begin
|
|
c2.AddSourceObjects;
|
|
continue;
|
|
end;
|
|
|
|
THackComponent(c2).FOriginalComponent := c1;
|
|
THackComponent(c1).FOriginalComponent := c2;
|
|
|
|
if c1 is TfrxBand then
|
|
s := 'b' else
|
|
s := LowerCase(c1.BaseName[1]);
|
|
s := FDictionary.AddUnique(String(s), 'Page' + IntToStr(FSourcePages.Count - 1) +
|
|
'.' + c1.Name, c1);
|
|
// speed optimization
|
|
if c1 is TfrxCustomMemoView then
|
|
begin
|
|
TfrxCustomMemoView(c1).DataSet := nil;
|
|
TfrxCustomMemoView(c1).DataField := '';
|
|
end;
|
|
// diffall now compares with original object
|
|
// remove these in future
|
|
// if csDefaultDiff in c1.frComponentStyle then
|
|
// s1 := c1.ClassName
|
|
// else
|
|
s1 := xs.WriteComponentStr(c1);
|
|
THackComponent(c1).FBaseName := s1;
|
|
THackComponent(c1).FAliasName := s;
|
|
THackComponent(c2).FAliasName := s;
|
|
end;
|
|
|
|
finally
|
|
originals.Free;
|
|
copies.Free;
|
|
xs.Free;
|
|
xi.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddPicture(Picture: TfrxPictureView);
|
|
begin
|
|
Picture.ImageIndex := FPictureCache.AddPicture(Picture.GetGraphic);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddToSourcePage(Obj: TfrxComponent);
|
|
var
|
|
NewObj: TfrxComponent;
|
|
Page: TfrxReportPage;
|
|
s: String;
|
|
xs: TfrxXMLSerializer;
|
|
begin
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
Page := FSourcePages[FSourcePages.Count - 1];
|
|
NewObj := TfrxComponent(Obj.NewInstance);
|
|
NewObj.Create(Page);
|
|
NewObj.AssignToDict(Obj);
|
|
NewObj.CreateUniqueName;
|
|
|
|
s := FDictionary.AddUnique(LowerCase(String(NewObj.BaseName[1])),
|
|
'Page' + IntToStr(FSourcePages.Count - 1) + '.' + NewObj.Name, NewObj);
|
|
if csDefaultDiff in NewObj.frComponentStyle then
|
|
THackComponent(NewObj).FBaseName := NewObj.ClassName else
|
|
THackComponent(NewObj).FBaseName := xs.WriteComponentStr(NewObj);
|
|
|
|
THackComponent(Obj).FOriginalComponent := NewObj;
|
|
THackComponent(Obj).FAliasName := s;
|
|
THackComponent(NewObj).FAliasName := s;
|
|
xs.Free;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.UpdateCachedObject(CachedObject: TfrxComponent; IsLoading: Boolean);
|
|
var
|
|
LCachedView: IfrxCachedView;
|
|
begin
|
|
if Supports(CachedObject, IfrxCachedView, LCachedView) and LCachedView.IsUpdateRequired(FCachedGraphicState) then
|
|
LCachedView.GetCachedGraphic(FCachedGraphicState, FPictureCache);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.UpdatePageDimension(Index: Integer; Width,
|
|
Height: Extended; AOrientation: TPrinterOrientation);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
xi := FPagesItem[Index];
|
|
xi.Prop[PropPaperSize] := '256';
|
|
xi.Prop[PropPaperWidth] := frxFloatToStr(Width);
|
|
xi.Prop[PropPaperHeight] := frxFloatToStr(Height);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.UpdatePageDimensions(Page: TfrxReportPage; Width, Height: Extended);
|
|
var
|
|
SourcePage: TfrxReportPage;
|
|
xi: TfrxXMLItem;
|
|
i: Integer;
|
|
begin
|
|
SourcePage := nil;
|
|
for i := 0 to FSourcePages.Count - 1 do
|
|
begin
|
|
SourcePage := FSourcePages[i];
|
|
if THackComponent(SourcePage).FOriginalComponent = Page then
|
|
break;
|
|
end;
|
|
|
|
SourcePage.PaperSize := 256;
|
|
SourcePage.PaperWidth := Width / fr01cm;
|
|
SourcePage.PaperHeight := Height / fr01cm;
|
|
xi := TfrxXMLItem.Create;
|
|
xi.Text := THackComponent(SourcePage).FBaseName;
|
|
xi.Prop[PropPaperSize] := '256';
|
|
xi.Prop[PropPaperWidth] := frxFloatToStr(SourcePage.PaperWidth);
|
|
xi.Prop[PropPaperHeight] := frxFloatToStr(SourcePage.PaperHeight);
|
|
THackComponent(SourcePage).FBaseName := xi.Text;
|
|
xi.Free;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.UpdatePageLastColumn(aColumn: Integer; aColumnPos: Extended; aReset: Boolean);
|
|
begin
|
|
if (aColumn > 0) or aReset then
|
|
CurXMLPage.Prop['c'] := IntToStr(aColumn);
|
|
if (aColumnPos <> 0) or aReset then
|
|
CurXMLPage.Prop['cp'] := FloatToStr(aColumnPos);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.Finish;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FLastY := 0;
|
|
ClearPageCache;
|
|
{ avoid bug with multiple PrepareReport(False) }
|
|
for i := 0 to FSourcePages.Count - 1 do
|
|
THackComponent(FSourcePages[i]).FOriginalComponent := nil;
|
|
Report.InternalOnProgressStop(ptRunning);
|
|
FPictureCache.BuildFinished;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.FireMouseLeave;
|
|
var
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
begin
|
|
inherited;
|
|
if Assigned(Report.Preview) then
|
|
Report.Preview.SetDefaultEventParams(EventParams)
|
|
else
|
|
begin
|
|
EventParams.EventSender := esPreview;
|
|
EventParams.EditorsList := nil;
|
|
EventParams.OnFinish := nil;
|
|
EventParams.Sender := nil;
|
|
end;
|
|
EventParams.OffsetX := 0;
|
|
EventParams.OffsetY := 0;
|
|
EventParams.Scale := 1;
|
|
EventParams.EditMode := dtSelect;
|
|
if Assigned(FLastObjectOver) then
|
|
Report.DoMouseLeave(FLastObjectOver, 0, 0, nil, EventParams);
|
|
FLastObjectOver := nil;
|
|
FLastDrill := nil;
|
|
Report.Preview.Hint := '';
|
|
Report.Preview.ShowHint := False;
|
|
end;
|
|
|
|
function TfrxPreviewPages.BandExists(Band: TfrxBand): Boolean;
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to CurXMLPage.Count - 1 do
|
|
begin
|
|
c := GetObject(CurXMLPage[i].Name);
|
|
if c <> nil then
|
|
if (THackComponent(c).FOriginalComponent = Band) or
|
|
((Band is TfrxPageFooter) and (c is TfrxPageFooter)) or
|
|
((Band is TfrxColumnFooter) and (c is TfrxColumnFooter)) then
|
|
begin
|
|
Result := True;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.GetLastColumnPos(var aColumn: Integer; var ColumnPos: Extended);
|
|
var
|
|
s: String;
|
|
begin
|
|
s := String(CurXMLPage.Prop['c']);
|
|
if s <> '' then
|
|
aColumn := StrToInt(s);
|
|
s := String(CurXMLPage.Prop['cp']);
|
|
if s <> '' then
|
|
ColumnPos := frxStrToFloat(s);
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetLastY(ColumnPosition: Extended): Extended;
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
s: String;
|
|
y, x: Extended;
|
|
begin
|
|
Result := 0;
|
|
y := 0;
|
|
for i := 0 to CurXMLPage.Count - 1 do
|
|
begin
|
|
c := GetObject(CurXMLPage[i].Name);
|
|
if c is TfrxBand then
|
|
if not (c is TfrxPageFooter) and not (c is TfrxOverlay) then
|
|
begin
|
|
s := String(CurXMLPage[i].Prop['l']);
|
|
if s <> '' then
|
|
x := frxStrToFloat(s) else
|
|
x := c.Left;
|
|
{ check columns }
|
|
if (ColumnPosition = 0) or (ABS(ColumnPosition - x) < 0.001)
|
|
or (c is TfrxPageHeader) or (c is TfrxReportTitle) then
|
|
begin
|
|
s := String(CurXMLPage[i].Prop['t']);
|
|
if s <> '' then
|
|
y := frxStrToFloat(s) else
|
|
y := c.Top;
|
|
|
|
s := String(CurXMLPage[i].Prop['h']);
|
|
if s <> '' then
|
|
y := y + frxStrToFloat(s) else
|
|
y := y + c.Height;
|
|
end;
|
|
if y > Result then
|
|
Result := y;
|
|
end;
|
|
end;
|
|
if (Result = 0) and (FLastY <> 0) then
|
|
Result := FLastY;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.CutObjects(APosition: Integer);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('cutted');
|
|
while APosition < CurXMLPage.Count do
|
|
xi.AddItem(CurXMLPage[APosition]);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.PasteObjects(X, Y: Extended);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
LeftX, TopY, CorrX, CorrY: Extended;
|
|
|
|
procedure CorrectX(xi: TfrxXMLItem);
|
|
var
|
|
X: Extended;
|
|
begin
|
|
if xi.Prop['l'] <> '' then
|
|
X := frxStrToFloat(xi.Prop['l']) else
|
|
X := 0;
|
|
X := X + CorrX;
|
|
if CorrX <> 0 then
|
|
xi.Prop['l'] := FloatToStr(X);
|
|
end;
|
|
|
|
procedure CorrectY(xi: TfrxXMLItem);
|
|
var
|
|
Y: Extended;
|
|
begin
|
|
if xi.Prop['t'] <> '' then
|
|
Y := frxStrToFloat(xi.Prop['t']) else
|
|
Y := 0;
|
|
Y := Y + CorrY;
|
|
xi.Prop['t'] := FloatToStr(Y);
|
|
end;
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('cutted');
|
|
|
|
if xi.Count > 0 then
|
|
begin
|
|
if xi[0].Prop['l'] <> '' then
|
|
LeftX := frxStrToFloat(xi[0].Prop['l']) else
|
|
LeftX := 0;
|
|
CorrX := X - LeftX;
|
|
{ special case for crosstabs #307606 , #549920 }
|
|
{ do not try to restore column position for cross-bands }
|
|
{ we have to remove it when crosstab will use Table }
|
|
if (CompareText(xi[0].Name, 'TfrxNullBand') = 0) and (CorrX < 0) and (X = 0) then CorrX := 0;
|
|
|
|
if xi[0].Prop['t'] <> '' then
|
|
TopY := frxStrToFloat(xi[0].Prop['t']) else
|
|
TopY := 0;
|
|
CorrY := Y - TopY;
|
|
|
|
while xi.Count > 0 do
|
|
begin
|
|
CorrectX(xi[0]);
|
|
CorrectY(xi[0]);
|
|
CurXMLPage.AddItem(xi[0]);
|
|
end;
|
|
end;
|
|
|
|
xi.Free;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.DoLoadFromStream;
|
|
var
|
|
Compressor: TfrxCustomCompressor;
|
|
begin
|
|
Compressor := nil;
|
|
if frxCompressorClass <> nil then
|
|
begin
|
|
FAllowPartialLoading := False;
|
|
Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
|
|
Compressor.Create(nil);
|
|
Compressor.Report := Report;
|
|
Compressor.IsFR3File := False;
|
|
try
|
|
Compressor.CreateStream;
|
|
if Compressor.Decompress(FTempStream) then
|
|
FTempStream := Compressor.Stream;
|
|
except
|
|
Compressor.Free;
|
|
Report.Errors.Add(frxResources.Get('clDecompressError'));
|
|
frxCommonErrorHandler(Report, frxResources.Get('clErrors') + #13#10 + Report.Errors.Text);
|
|
Exit;
|
|
end;
|
|
end;
|
|
FXMLDoc.LoadFromStream(FTempStream, FAllowPartialLoading);
|
|
AfterLoad;
|
|
if Compressor <> nil then
|
|
Compressor.Free;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.DoSaveToStream;
|
|
var
|
|
Compressor: TfrxCustomCompressor;
|
|
StreamTo: TStream;
|
|
begin
|
|
StreamTo := FTempStream;
|
|
Compressor := nil;
|
|
if Report.ReportOptions.Compressed and (frxCompressorClass <> nil) then
|
|
begin
|
|
Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
|
|
Compressor.Create(nil);
|
|
Compressor.Report := Report;
|
|
Compressor.IsFR3File := False;
|
|
Compressor.CreateStream;
|
|
StreamTo := Compressor.Stream;
|
|
end;
|
|
try
|
|
BeforeSave;
|
|
FXMLDoc.SaveToStream(StreamTo);
|
|
finally
|
|
if Compressor <> nil then
|
|
begin
|
|
try
|
|
Compressor.Compress(FTempStream);
|
|
finally
|
|
Compressor.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.LoadFromStream(Stream: TStream;
|
|
AllowPartialLoading: Boolean = False);
|
|
begin
|
|
Clear;
|
|
FTempStream := Stream;
|
|
FAllowPartialLoading := AllowPartialLoading;
|
|
{$IFNDEF FR_COM}
|
|
// if Report.EngineOptions.ReportThread <> nil then
|
|
// THackThread(Report.EngineOptions.ReportThread).Synchronize(DoLoadFromStream)
|
|
// else
|
|
{$ENDIF}
|
|
DoLoadFromStream;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.SaveToStream(Stream: TStream);
|
|
begin
|
|
FTempStream := Stream;
|
|
{$IFNDEF FR_COM}
|
|
// if Report.EngineOptions.ReportThread <> nil then
|
|
// THackThread(Report.EngineOptions.ReportThread).Synchronize(DoSaveToStream)
|
|
// else
|
|
{$ENDIF}
|
|
DoSaveToStream;
|
|
end;
|
|
|
|
function TfrxPreviewPages.LoadFromFile(const FileName: String;
|
|
ExceptionIfNotFound: Boolean): Boolean;
|
|
var
|
|
Stream: TFileStream;
|
|
{$IFDEF FRVIEWER}
|
|
RepStream: TStringStream;
|
|
{$ENDIF}
|
|
begin
|
|
Result := FileExists(FileName);
|
|
if Result or ExceptionIfNotFound then
|
|
begin
|
|
{$IFNDEF FPC}
|
|
{$IFDEF FRVIEWER}
|
|
RepStream := TStringStream.Create;
|
|
try
|
|
RepStream.LoadFromFile(FileName);
|
|
if Pos('PixelsPerInch' ,RepStream.DataString, 1) > 0 then
|
|
begin
|
|
ShellExecute(0, 'open', PChar(ExtractFilePath(Application.ExeName) + 'FastReportFMX_Viewer.exe'), PChar(FileName), '', SW_SHOW);
|
|
Application.Terminate;
|
|
end;
|
|
finally
|
|
RepStream.Free;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Stream := TFileStream.Create(FileName, fmOpenRead + fmShareDenyWrite);
|
|
try
|
|
LoadFromStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
{ Clear;
|
|
FXMLDoc.LoadFromFile(FileName);
|
|
AfterLoad;}
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.SaveToFile(const FileName: String);
|
|
//var
|
|
// Stream: TFileStream;
|
|
//begin
|
|
var
|
|
f: TfrxIOTransportFile;
|
|
begin
|
|
f := TfrxIOTransportFile.CreateNoRegister;
|
|
f.BasePath := ExtractFilePath(FileName);
|
|
try
|
|
SaveToFilter(f, FileName);
|
|
finally
|
|
f.Free;
|
|
end;
|
|
end;
|
|
// Stream := TFileStream.Create(FileName, fmCreate);
|
|
// try
|
|
// SaveToStream(Stream);
|
|
// finally
|
|
// Stream.Free;
|
|
// end;
|
|
//{ BeforeSave;
|
|
// FXMLDoc.SaveToFile(FileName);
|
|
// ClearPageCache;
|
|
// AfterLoad;}
|
|
//end;
|
|
|
|
function TfrxPreviewPages.SaveToFilter(Filter: TfrxCustomIOTransport;
|
|
const FileName: String): Boolean;
|
|
var
|
|
FilterStream: TStream;
|
|
begin
|
|
FilterStream := nil;
|
|
Result := False;
|
|
Filter.FilterAccess := faWrite;
|
|
if (FileName = '') and (Filter.FileName = '') then
|
|
Filter.FileName := ExtractFileName(Report.FileName);
|
|
|
|
if Filter = nil then Exit;
|
|
Filter.Report := Report;
|
|
Result := Filter.OpenFilter;
|
|
try
|
|
if Result then
|
|
FilterStream := Filter.GetStream(FileName);
|
|
if FilterStream <> nil then
|
|
begin
|
|
if not Filter.DoFilterProcessStream(FilterStream, Self) then
|
|
SaveToStream(FilterStream);
|
|
Filter.FreeStream(FilterStream);
|
|
end;
|
|
finally
|
|
Filter.CloseFilter;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AfterLoad;
|
|
var
|
|
i: Integer;
|
|
xs: TfrxXMLSerializer;
|
|
xi: TfrxXMLItem;
|
|
p: TfrxReportPage;
|
|
|
|
{ store source objects' properties in the FBaseName to get it later in the GetPage }
|
|
procedure DoProps(p: TfrxReportPage);
|
|
var
|
|
i: Integer;
|
|
l: TList;
|
|
c: THackComponent;
|
|
begin
|
|
l := p.AllObjects;
|
|
for i := 0 to l.Count - 1 do
|
|
begin
|
|
c := l[i];
|
|
c.FBaseName := xs.WriteComponentStr(c);
|
|
end;
|
|
end;
|
|
|
|
{ fill FDictionary.Objects }
|
|
procedure FillDictionary;
|
|
var
|
|
i: Integer;
|
|
Name, PageName, ObjName: String;
|
|
PageN: Integer;
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('dictionary');
|
|
FDictionary.Clear;
|
|
for i := 0 to xi.Count - 1 do
|
|
begin
|
|
Name := Copy(xi[i].Text, 7, Length(xi[i].Text) - 7);
|
|
PageName := Copy(Name, 1, Pos('.', Name) - 1);
|
|
ObjName := Copy(Name, Pos('.', Name) + 1, 255);
|
|
|
|
PageN := StrToInt(Copy(PageName, 5, 255));
|
|
FDictionary.Add(xi[i].Name, Name,
|
|
TfrxReportPage(FSourcePages[PageN]).FindObject(ObjName));
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FPagesItem := FXMLDoc.Root.FindItem('previewpages');
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
xs.OldFormat := FXMLDoc.OldVersion;
|
|
|
|
{ load the report settings }
|
|
xi := FXMLDoc.Root.FindItem('report');
|
|
if xi.Count > 0 then
|
|
xs.ReadRootComponent(Report, xi[0]);
|
|
|
|
{ build sourcepages }
|
|
try
|
|
xi := FXMLDoc.Root.FindItem('sourcepages');
|
|
ClearSourcePages;
|
|
|
|
for i := 0 to xi.Count - 1 do
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
// if AnsiStrIComp(PAnsiChar(xi[i].Name), PansiChar(AnsiString('TfrxDMPPage'))) = 0 then
|
|
if CompareText(xi[i].Name, 'TfrxDMPPage') = 0 then
|
|
{$ELSE}
|
|
if CompareText(xi[i].Name, 'TfrxDMPPage') = 0 then
|
|
{$ENDIF}
|
|
p := TfrxDMPPage.Create(nil) else
|
|
p := TfrxReportPage.Create(nil);
|
|
xs.Owner := p;
|
|
xs.ReadRootComponent(p, xi[i]);
|
|
DoProps(p);
|
|
FSourcePages.Add(p);
|
|
end;
|
|
xi.Clear;
|
|
|
|
finally
|
|
xs.Free;
|
|
end;
|
|
|
|
{ build the dictionary }
|
|
FillDictionary;
|
|
|
|
{ load the picturecache }
|
|
FPictureCache.LoadFromXML(FXMLDoc.Root);
|
|
|
|
xi := FXMLDoc.Root.FindItem('postprocessing');
|
|
FPostProcessor.LoadFromXML(xi);
|
|
xi.Free;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.BeforeSave;
|
|
var
|
|
i: Integer;
|
|
xs: TfrxXMLSerializer;
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
FPagesItem := FXMLDoc.Root.FindItem('previewpages');
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
|
|
{ upload the report settings }
|
|
xi := FXMLDoc.Root.FindItem('report');
|
|
xi.Clear;
|
|
xi := xi.Add;
|
|
xi.Name := Report.ClassName;
|
|
xi.Text := 'DotMatrixReport="' + frxValueToXML(Report.DotMatrixReport) +
|
|
'" PreviewOptions.OutlineVisible="' + frxValueToXML(Report.PreviewOptions.OutlineVisible) +
|
|
'" PreviewOptions.OutlineWidth="' + frxValueToXML(Report.PreviewOptions.OutlineWidth) +
|
|
'" ReportOptions.Name="' + frxStrToXML(Report.ReportOptions.Name) + '"';
|
|
|
|
{ upload the sourcepages }
|
|
try
|
|
xi := FXMLDoc.Root.FindItem('sourcepages');
|
|
xi.Clear;
|
|
for i := 0 to FSourcePages.Count - 1 do
|
|
xs.WriteRootComponent(FSourcePages[i], True, xi.Add);
|
|
|
|
finally
|
|
xs.Free;
|
|
end;
|
|
|
|
{ upload the dictionary }
|
|
xi := FXMLDoc.Root.FindItem('dictionary');
|
|
xi.Clear;
|
|
for i := 0 to FDictionary.Names.Count - 1 do
|
|
with xi.Add do
|
|
begin
|
|
Name := FDictionary.Names[i];
|
|
Text := 'name="' + FDictionary.GetSourceName(Name) + '"';
|
|
end;
|
|
|
|
{ upload the picturecache }
|
|
// xi := FXMLDoc.Root.FindItem('picturecache');
|
|
FPictureCache.SaveToXML(FXMLDoc.Root);
|
|
xi := FXMLDoc.Root.FindItem('postprocessing');
|
|
xi.Clear;
|
|
FPostProcessor.SaveToXML(xi);
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetObject(const Name: String): TfrxComponent;
|
|
begin
|
|
Result := TfrxComponent(FDictionary.GetObject(Name));
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetPage(Index: Integer): TfrxReportPage;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
xs: TfrxXMLSerializer;
|
|
i, SwapIndex: Integer;
|
|
Source: TfrxReportPage;
|
|
|
|
procedure DoObjects(Item: TfrxXMLItem; Owner: TfrxComponent);
|
|
var
|
|
i: Integer;
|
|
c, c0: TfrxComponent;
|
|
DataLink: IfrxDataLinkObject;
|
|
sLink : String;
|
|
begin
|
|
for i := 0 to Item.Count - 1 do
|
|
begin
|
|
c0 := GetObject(Item[i].Name);
|
|
{ object not found in the dictionary }
|
|
|
|
if c0 = nil then
|
|
c := xs.ReadComponentStr(Owner, Item[i].Name + ' ' + Item[i].Text, True)
|
|
else
|
|
begin
|
|
c := xs.ReadComponentStr(Owner,
|
|
THackComponent(c0).FBaseName + ' ' + Item[i].Text, True);
|
|
c.Name := c0.Name;
|
|
UpdateCachedObject(c, True);
|
|
end;
|
|
// cause of this silly code see in silly ticket # 294150
|
|
if c is TfrxCustomMemoView then
|
|
begin
|
|
TfrxCustomMemoView(c).ApplyPreviewHighlight;
|
|
//THackMemoView(c).ExtractMacros(FPostProcessor);
|
|
end;
|
|
if Supports(c, IfrxDataLinkObject, DataLink) then
|
|
begin
|
|
sLink := DataLink.GetLink(dlmOnLoading);
|
|
if sLink <> '' then
|
|
frxDataProtocols.LoadToObject(sLink, DataLink);
|
|
DataLink := nil;
|
|
end;
|
|
if FPostProcessor.LoadValue(c) then continue;
|
|
c.Parent := Owner;
|
|
THackComponent(c).FSerializedItem := Item[i];
|
|
DoObjects(Item[i], c);
|
|
c.UpdateBounds;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := nil;
|
|
if Count = 0 then Exit;
|
|
SwapIndex := 0;
|
|
if Assigned(FLockedPage) then
|
|
SwapIndex := 1;
|
|
|
|
{ check pagecache first }
|
|
if not Engine.Running then
|
|
begin
|
|
i := FPageCache.IndexOf(IntToStr(Index));
|
|
if i <> -1 then
|
|
begin
|
|
Result := TfrxReportPage(FPageCache.Objects[i]);
|
|
if FPageCache.Count > 1 then
|
|
FPageCache.Exchange(i, SwapIndex);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
xs.OldFormat := FXMLDoc.OldVersion;
|
|
try
|
|
{ load the page item }
|
|
xi := FPagesItem[Index];
|
|
FXMLDoc.LoadItem(xi);
|
|
|
|
if CompareText(xi.Name, 'TfrxReportPage') = 0 then
|
|
begin
|
|
{ page item do not refer to the originalpages }
|
|
Result := TfrxReportPage.CreateInPreview(nil, Report);
|
|
xs.ReadRootComponent(Result, xi);
|
|
end
|
|
else if CompareText(xi.Name, 'TfrxDMPPage') = 0 then
|
|
begin
|
|
{ page item do not refer to the originalpages }
|
|
Result := TfrxDMPPage.CreateInPreview(nil, Report);
|
|
xs.ReadRootComponent(Result, xi);
|
|
end
|
|
else if FSignaturePages.Active and FSignaturePages.IsContaine(xi.Name) then
|
|
Exit
|
|
else
|
|
begin
|
|
Source := FSourcePages[StrToInt(Copy(String(xi.Name), 5, 5))];
|
|
{ create reportpage and assign properties from original page }
|
|
if Source is TfrxDMPPage then
|
|
Result := TfrxDMPPage.CreateInPreview(nil, Report) else
|
|
Result := TfrxReportPage.CreateInPreview(nil, Report);
|
|
Result.Assign(Source);
|
|
Result.Name := Source.Name;
|
|
{ check if paper has updated sizes }
|
|
if Length(xi.Text) > Length(PropPaperWidth) then
|
|
xs.XMLToObj(xi.Text, Result);
|
|
|
|
{ create objects }
|
|
DoObjects(xi, Result);
|
|
end;
|
|
finally
|
|
xs.Free;
|
|
end;
|
|
|
|
{ update aligned objects }
|
|
Result.AlignChildren(False, Result.MirrorMode);
|
|
{ add this page to the pagecache }
|
|
FPageCache.InsertObject(SwapIndex, IntToStr(Index), Result);
|
|
i := FPageCache.Count;
|
|
FPostProcessor.ResetSuppressed;
|
|
|
|
{ remove the least used item from the pagecache }
|
|
if (i > 1) and (i > Report.PreviewOptions.PagesInCache) then
|
|
begin
|
|
xi := FPagesItem[StrToInt(FPageCache[i - 1])];
|
|
if Report.EngineOptions.UseFileCache and xi.Unloadable then
|
|
begin
|
|
FXMLDoc.UnloadItem(xi);
|
|
xi.Clear;
|
|
end;
|
|
|
|
TfrxReportPage(FPageCache.Objects[i - 1]).Free;
|
|
FPageCache.Delete(i - 1);
|
|
FLastObjectOver := nil;
|
|
FLastDrill := nil;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetPageSize(Index: Integer): TPoint;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
p: TfrxReportPage;
|
|
sProp: String;
|
|
begin
|
|
if (Count = 0) or (Index < 0) or (Index >= Count) then
|
|
begin
|
|
Result := Point(0, 0);
|
|
Exit;
|
|
end;
|
|
|
|
xi := FPagesItem[Index];
|
|
{$IFDEF Delphi12}
|
|
{ if (AnsiStrIComp(PAnsiChar(xi.Name), PAnsiChar(AnsiString('TfrxReportPage'))) = 0) or
|
|
(AnsiStrIComp(PAnsiChar(xi.Name), PAnsiChar(AnsiString('TfrxDMPPage'))) = 0) then}
|
|
if (CompareText(xi.Name, 'TfrxReportPage') = 0) or
|
|
(CompareText(xi.Name, 'TfrxDMPPage') = 0) then
|
|
{$ELSE}
|
|
if (CompareText(xi.Name, 'TfrxReportPage') = 0) or
|
|
(CompareText(xi.Name, 'TfrxDMPPage') = 0) then
|
|
{$ENDIF}
|
|
p := GetPage(Index) else
|
|
p := FSourcePages[StrToInt(Copy(String(xi.Name), 5, 256))];
|
|
Result.X := Round(p.Width);
|
|
Result.Y := Round(p.Height);
|
|
{ fast access to updated PaperWidth/PaperHeight }
|
|
if Length(xi.Text) > Length(PropPaperWidth) then
|
|
begin
|
|
sProp := xi.Prop[PropPaperWidth];
|
|
if Length(sProp) > 0 then
|
|
Result.X := Round(frxStrToFloat(sProp) * fr01cm);
|
|
sProp := xi.Prop[PropPaperHeight];
|
|
if Length(sProp) > 0 then
|
|
Result.Y := Round(frxStrToFloat(sProp) * fr01cm);
|
|
end;
|
|
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetPicture(CacheType: TfrxCachedGraphicType;
|
|
ImageIndex: Integer): IfrxCachedGraphic;
|
|
begin
|
|
Result := FPictureCache.GetCachedBitmap(CacheType, ImageIndex);
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetPictureCacheOptions: TfrxPictureCacheOptions;
|
|
begin
|
|
if Assigned(FPictureCache) then
|
|
Result := FPictureCache.PictureCacheOptions
|
|
else
|
|
Result := inherited GetPictureCacheOptions;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddEmptyPage(Index: Integer);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
if Count = 0 then Exit;
|
|
|
|
xi := TfrxXMLItem.Create;
|
|
xi.Name := FPagesItem[Index].Name;
|
|
FPagesItem.InsertItem(Index, xi);
|
|
ClearPageCache;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.DeleteAnchors(From: Integer);
|
|
var
|
|
AnchorRoot: TfrxXMLItem;
|
|
begin
|
|
AnchorRoot := FXMLDoc.Root.FindItem('anchors');
|
|
if (From + 1 < 0) or (From + 1 >= AnchorRoot.Count) then Exit;
|
|
|
|
while (From + 1 < AnchorRoot.Count) do
|
|
AnchorRoot[AnchorRoot.Count - 1].Free;
|
|
end;
|
|
|
|
|
|
procedure TfrxPreviewPages.DeleteObjects(APosition: Integer);
|
|
begin
|
|
while APosition < CurXMLPage.Count do
|
|
CurXMLPage[APosition].Free;
|
|
end;
|
|
|
|
|
|
procedure TfrxPreviewPages.DeletePage(Index: Integer);
|
|
begin
|
|
if Count < 2 then Exit;
|
|
|
|
FPagesItem[Index].Free;
|
|
ClearPageCache;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ModifyObject(Component: TfrxComponent);
|
|
var
|
|
Item, pItem: TfrxXMLItem;
|
|
c: TfrxComponent;
|
|
begin
|
|
if (Component = nil) then Exit;
|
|
Item := THackComponent(Component).FSerializedItem;
|
|
if not Assigned(Item) then Exit;
|
|
c := GetObject(Item.Name);
|
|
//if (c = nil) then Exit;
|
|
Component.frComponentState := Component.frComponentState + [csFrxModifyObject];
|
|
try
|
|
if (c = nil) or (csDefaultDiff in Component.frComponentStyle) or (Component is TfrxPictureView) then
|
|
Item.Text := Component.AllDiff(c) else
|
|
Item.Text := Component.Diff(c);
|
|
finally
|
|
Component.frComponentState := Component.frComponentState - [csFrxModifyObject]
|
|
end;
|
|
pItem := Item;
|
|
while (pItem.Parent <> FPagesItem) and (pItem.Parent <> nil) do
|
|
pItem := pItem.Parent;
|
|
pItem.Unloadable := False;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ModifyPage(Index: Integer; Page: TfrxReportPage);
|
|
var
|
|
xs: TfrxXMLSerializer;
|
|
begin
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
try
|
|
FPagesItem[Index].Clear;
|
|
xs.WriteRootComponent(Page, True, FPagesItem[Index]);
|
|
FPagesItem[Index].Unloadable := False;
|
|
ClearPageCache;
|
|
finally
|
|
xs.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddFrom(Report: TfrxReport);
|
|
begin
|
|
Self.AddFromPreviewPages(Report.PreviewPages);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddFromPreviewPages(vPreviewPages: TfrxCustomPreviewPages);
|
|
var
|
|
i, nPageOffset: Integer;
|
|
Page: TfrxReportPage;
|
|
xi: TfrxXMLItem;
|
|
xs: TfrxXMLSerializer;
|
|
AnchorRootSource, AnchorRootDest: TfrxXMLItem;
|
|
|
|
procedure CopyOutline;
|
|
var
|
|
nPage, nTop, idx: Integer;
|
|
sText: String;
|
|
begin
|
|
for idx := 0 to vPreviewPages.Outline.Count - 1 do
|
|
begin
|
|
vPreviewPages.Outline.GetItem(idx, sText, nPage, nTop);
|
|
CurPage := nPageOffset + nPage;
|
|
Outline.AddItem(sText, nTop);
|
|
vPreviewPages.Outline.LevelDown(idx);
|
|
CopyOutline;
|
|
vPreviewPages.Outline.LevelUp;
|
|
Outline.LevelUp;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
|
|
nPageOffset := Count;
|
|
|
|
for i := 0 to vPreviewPages.Count - 1 do
|
|
begin
|
|
Page := vPreviewPages.Page[i];
|
|
xi := TfrxXMLItem.Create;
|
|
xi.Name := FPagesItem[Count - 1].Name;
|
|
xs.WriteRootComponent(Page, True, xi);
|
|
xi.Unloadable := False;
|
|
FPagesItem.AddItem(xi);
|
|
end;
|
|
|
|
{ Copy Anchors items}
|
|
AnchorRootDest := FXMLDoc.Root.FindItem('anchors');
|
|
AnchorRootSource := TfrxPreviewPages(vPreviewPages).FXMLDoc.Root.FindItem('anchors');
|
|
|
|
for i := 0 to AnchorRootSource.Count - 1 do
|
|
begin
|
|
xi := AnchorRootSource[i];
|
|
with AnchorRootDest.Add do
|
|
begin
|
|
Name := 'item';
|
|
Text := xi.Text;
|
|
Prop['page'] := IntToStr(StrToInt(Prop['page']) + nPageOffset);
|
|
end;
|
|
end;
|
|
|
|
{copy outline items}
|
|
vPreviewPages.Outline.LevelRoot;
|
|
Outline.LevelRoot;
|
|
CopyOutline;
|
|
if vPreviewPages.Count <> 0 then
|
|
begin
|
|
vPreviewPages.CurPage := vPreviewPages.Count - 1;
|
|
FLastY := vPreviewPages.GetLastY;
|
|
vPreviewPages.CurPage := -1;
|
|
end;
|
|
|
|
xs.Free;
|
|
ClearPageCache;
|
|
end;
|
|
|
|
function TfrxPreviewPages.AddGraphic(Graphic: TGraphic): Integer;
|
|
begin
|
|
Result := FPictureCache.AddPicture(Graphic);
|
|
end;
|
|
|
|
{$IFDEF ACADEMIC_ED}
|
|
procedure TfrxPreviewPages.DrawWaterMark(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY, aPaperWidth, aPaperHeight: Extended);
|
|
var
|
|
FDrawText: TfrxDrawText;
|
|
aFont: TFont;
|
|
aText: TWideStrings;
|
|
aTextRect: TRect;
|
|
begin
|
|
aFont := TFont.Create;
|
|
{$IFDEF Delphi10}
|
|
aText := TfrxWideStrings.Create;
|
|
{$ELSE}
|
|
aText := TWideStrings.Create;
|
|
{$ENDIF}
|
|
aText.Text := frxReverseString(FR_ACAD);
|
|
with aFont do
|
|
begin
|
|
Name := 'Arial';
|
|
Size := Round(aPaperHeight/4);
|
|
Color := clGray;
|
|
end;
|
|
FDrawText := frxDrawText;
|
|
FDrawText.UseDefaultCharset := True;
|
|
|
|
FDrawText.Lock;
|
|
try
|
|
FDrawText.SetFont(aFont);
|
|
FDrawText.SetOptions(false, false, false, false,
|
|
true, false, -45);
|
|
FDrawText.SetGaps(0, 1, 1);
|
|
aTextRect := Rect(Round(OffsetX),
|
|
Round(OffsetY),
|
|
Round(OffsetX + aPaperWidth * fr01cm * ScaleX) - 1,
|
|
Round(OffsetY + aPaperHeight * fr01cm * ScaleY) - 1);
|
|
FDrawText.SetDimensions(ScaleX, ScaleY, FPrintScale, aTextRect, aTextRect);
|
|
FDrawText.SetText(aText);
|
|
|
|
FDrawText.DrawText(Canvas, haCenter, vaCenter);
|
|
finally
|
|
FDrawText.Unlock;
|
|
aText.Free;
|
|
aFont.Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TfrxPreviewPages.DrawPage(Index: Integer; Canvas: TCanvas;
|
|
ScaleX, ScaleY, OffsetX, OffsetY: Extended; bHighlightEditable: Boolean = False);
|
|
var
|
|
i: Integer;
|
|
Page: TfrxReportPage;
|
|
l: TList;
|
|
c: TfrxComponent;
|
|
IsPrinting: Boolean;
|
|
SaveLeftMargin, SaveRightMargin: Extended;
|
|
rgn: HRGN;
|
|
canDraw: Boolean;
|
|
|
|
function ViewVisible(c: TfrxComponent): Boolean;
|
|
var
|
|
r: TRect;
|
|
h: extended;
|
|
m: TfrxMemoView;
|
|
begin
|
|
if c is TfrxMemoView then
|
|
begin
|
|
m := TfrxMemoView(c);
|
|
h := 0;
|
|
if not m.Clipped then
|
|
h := m.CalcHeight;
|
|
if h < m.Height then
|
|
h := m.Height;
|
|
end
|
|
else
|
|
h := c.Height;
|
|
with c do
|
|
r := Rect(Round(AbsLeft * ScaleX) - 20, Round(AbsTop * ScaleY) - 20,
|
|
Round((AbsLeft + Width) * ScaleX + 20),
|
|
Round((AbsTop + h) * ScaleY + 20));
|
|
OffsetRect(r, Round(OffsetX), Round(OffsetY));
|
|
Result := RectVisible(Canvas.Handle, r) or (Canvas is TMetafileCanvas) {$IFDEF LCLGTK2} or (Canvas is TPrinterCanvas){$ENDIF} ;
|
|
end;
|
|
begin
|
|
IsPrinting := Canvas is {$IFDEF LCLGTK2}TPrinterCanvas{$ELSE}TfrxPrinterCanvas{$ENDIF};
|
|
if IsPrinting then
|
|
FCachedGraphicState := cgOriginal
|
|
else
|
|
FCachedGraphicState := cgThumbnail;
|
|
Page := GetPage(Index);
|
|
if Page = nil then Exit;
|
|
|
|
SaveLeftMargin := Page.LeftMargin;
|
|
SaveRightMargin := Page.RightMargin;
|
|
if Page.MirrorMargins and (Index mod 2 = 1) then
|
|
begin
|
|
Page.LeftMargin := SaveRightMargin;
|
|
Page.RightMargin := SaveLeftMargin;
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
if IsPrinting then
|
|
begin
|
|
if not Canvas.Clipping then
|
|
begin
|
|
Canvas.Clipping := True;
|
|
Rgn := LCLIntf.CreateRectRgn(Round(OffsetX), Round(OffsetY), Round(OffsetX + Page.PaperWidth * fr01cm * ScaleX) - 1, Round(OffsetY + Page.PaperHeight * fr01cm * ScaleY) - 1);
|
|
LCLIntf.OffsetRgn(Rgn, Round(OffsetX), Round(OffsetY));
|
|
LCLIntf.SelectClipRGN(Canvas.Handle, Rgn);
|
|
DeleteObject(rgn);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
rgn := 0;
|
|
if not IsPrinting then
|
|
begin
|
|
rgn := CreateRectRgn(0, 0, 10000, 10000);
|
|
GetClipRgn(Canvas.Handle, rgn);
|
|
IntersectClipRect(Canvas.Handle,
|
|
Round(OffsetX),
|
|
Round(OffsetY),
|
|
Round(OffsetX + Page.PaperWidth * fr01cm * ScaleX) - 1,
|
|
Round(OffsetY + Page.PaperHeight * fr01cm * ScaleY) - 1);
|
|
end;
|
|
|
|
Page.IsPrinting := IsPrinting;
|
|
Page.Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
|
|
OffsetX := OffsetX + Page.LeftMargin * fr01cm * ScaleX;
|
|
OffsetY := OffsetY + Page.TopMargin * fr01cm * ScaleY;
|
|
l := Page.AllObjects;
|
|
|
|
for i := 0 to l.Count - 1 do
|
|
begin
|
|
c := l[i];
|
|
if (c is TfrxView) and ViewVisible(c) then
|
|
begin
|
|
if IsPrinting then
|
|
canDraw := vsPrint in TfrxView(c).Visibility
|
|
else
|
|
canDraw := vsPreview in TfrxView(c).Visibility;
|
|
|
|
if canDraw then
|
|
begin
|
|
c.IsPrinting := IsPrinting;
|
|
UpdateCachedObject(c);
|
|
{ needed for TOTALPAGES macro }
|
|
if c is TfrxCustomMemoView then
|
|
begin
|
|
// if not IsDesigning then
|
|
//THackMemoView(c).ExtractMacros(FPostProcessor);
|
|
THackMemoView(c).FTotalPages := Count;
|
|
THackMemoView(c).FCopyNo := FCopyNo;
|
|
THackMemoView(c).FPrintScale := FPrintScale;
|
|
end;
|
|
if TfrxView(c).IsOwnerDraw then continue;
|
|
|
|
{ draw the object }
|
|
// if bHighlightEditable then
|
|
// TfrxView(c).DrawWithHighlight(Canvas, ScaleX, ScaleY, OffsetX, OffsetY)
|
|
// else
|
|
TfrxView(c).InteractiveDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY, bHighlightEditable and (ferAllowInPreview in c.Editable));
|
|
c.IsPrinting := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF ACADEMIC_ED}
|
|
if IsPrinting then
|
|
DrawWaterMark(Canvas, ScaleX, ScaleY, OffsetX, OffsetY, Page.PaperWidth, Page.PaperHeight);
|
|
{$ENDIF}
|
|
|
|
Page.LeftMargin := SaveLeftMargin;
|
|
Page.RightMargin := SaveRightMargin;
|
|
if not IsPrinting then
|
|
begin
|
|
SelectClipRgn(Canvas.Handle, rgn);
|
|
DeleteObject(rgn);
|
|
end;
|
|
FCachedGraphicState := cgOriginal
|
|
end;
|
|
|
|
function TfrxPreviewPages.Print: Boolean;
|
|
var
|
|
MaxCount: Integer;
|
|
PagesPrinted, ACopyNo: Integer;
|
|
pgList: TStringList;
|
|
LastDuplexMode: TfrxDuplexMode;
|
|
LastPaperSize, LastPaperWidth, LastPaperHeight, LastBin: Integer;
|
|
LastOrientation: TPrinterOrientation;
|
|
DuplexMode: TfrxDuplexMode;
|
|
SavePrintOptions: TfrxPrintOptions;
|
|
SheetWidth, SheetHeight, SplicingLineSz: Extended;
|
|
NeedFinishDuplex: Boolean;
|
|
PrintedBins: TList;
|
|
|
|
|
|
function IsBinPrinted(ABin: Integer): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to PrintedBins.Count - 1 do
|
|
if Integer(PrintedBins[i]) = ABin then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
PrintedBins.Add(TObject(ABin));
|
|
Result := False;
|
|
end;
|
|
|
|
function GetPageIndex(Index: Integer): Integer;
|
|
var
|
|
pgIdx: Integer;
|
|
begin
|
|
Result := -1;
|
|
if (pgList.Count > 0) and (Index < pgList.Count) then
|
|
begin
|
|
pgIdx := StrToInt(pgList[Index]) - 1;
|
|
if (pgIdx < 0) or (pgIdx > Count) then
|
|
Result := -1
|
|
else
|
|
Result := pgIdx;
|
|
end
|
|
else if (Index < MaxCount) and (Index >= 0) then
|
|
Result := Index;
|
|
end;
|
|
|
|
function GetNextPage(var Index: Integer): TfrxReportPage;
|
|
var
|
|
pgIdx: Integer;
|
|
begin
|
|
Result := nil;
|
|
Inc(Index);
|
|
pgIdx := GetPageIndex(Index);
|
|
if (pgIdx <> -1) then
|
|
Result := GetPage(pgIdx);
|
|
end;
|
|
|
|
procedure SplitPage(a, b, c, d: Extended; var x, y: Integer; var NeedRotate: Boolean);
|
|
var
|
|
tempX, tempY: Integer;
|
|
tempC: Extended;
|
|
|
|
procedure TrySplit;
|
|
begin
|
|
if Abs(Trunc(a / c) * c - a) < 11 then
|
|
x := Round(a / c)
|
|
else
|
|
x := Trunc(a / c) + 1;
|
|
|
|
if Abs(Trunc(b / d) * d - b) < 11 then
|
|
y := Round(b / d)
|
|
else
|
|
y := Trunc(b / d) + 1;
|
|
end;
|
|
|
|
begin
|
|
NeedRotate := False;
|
|
|
|
TrySplit;
|
|
|
|
tempX := x;
|
|
tempY := y;
|
|
|
|
tempC := c;
|
|
c := d;
|
|
d := tempC;
|
|
|
|
TrySplit;
|
|
|
|
if x * y >= tempX * tempY then
|
|
begin
|
|
x := tempX;
|
|
y := tempY;
|
|
end
|
|
else
|
|
NeedRotate := True;
|
|
end;
|
|
|
|
procedure DoPrint;
|
|
var
|
|
i: Integer;
|
|
Printer: TfrxCustomPrinter;
|
|
PagePrinted: Boolean;
|
|
Page: TfrxReportPage;
|
|
|
|
function PrintSplittedPage(Index: Integer): Boolean;
|
|
var
|
|
Bin, ACopies, x, y, countX, countY: Integer;
|
|
pieceX, pieceY, offsX, offsY, marginX, marginY, printedX, printedY: Extended;
|
|
OldRgn, OutRgn: HRGN;
|
|
SplitAddX, SplitAddY: Extended;
|
|
|
|
orient: TPrinterOrientation;
|
|
NeedChangeOrientation: Boolean;
|
|
dup: TfrxDuplexMode;
|
|
SavedDCState: Integer;
|
|
|
|
procedure SwapXY(var sX, sY: Extended);
|
|
var
|
|
TempZ: Extended;
|
|
begin
|
|
TempZ := sX;
|
|
sX := sY;
|
|
sY := TempZ;
|
|
end;
|
|
begin
|
|
Result := True;
|
|
Index := GetPageIndex(Index);
|
|
// if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
|
|
if (Index = -1) or (Index >= Count) then Exit;
|
|
if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or
|
|
((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit;
|
|
if Report.Terminated then
|
|
begin
|
|
Printer.Abort;
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
Page := GetPage(Index);
|
|
|
|
if Report.PrintOptions.Collate then
|
|
begin
|
|
ACopies := 1;
|
|
FCopyNo := ACopyNo;
|
|
end
|
|
else
|
|
begin
|
|
ACopies := Report.PrintOptions.Copies;
|
|
FCopyNo := 1;
|
|
end;
|
|
|
|
if Assigned(Report.OnPrintPage) then
|
|
Report.OnPrintPage(Page, FCopyNo);
|
|
|
|
if Index = 0 then
|
|
Bin := Page.Bin else
|
|
Bin := Page.BinOtherPages;
|
|
|
|
SplitPage(Page.PaperWidth, Page.PaperHeight, SheetWidth, SheetHeight,
|
|
countX, countY, NeedChangeOrientation);
|
|
|
|
{ add splicing offset and calculate countX, countY again }
|
|
SplitAddX := 0;
|
|
SplitAddY := 0;
|
|
if countX > 1 then
|
|
SplitAddX := SplicingLineSz{ + Printer.LeftMargin + Printer.RightMargin};
|
|
if countY > 1 then
|
|
SplitAddY := SplicingLineSz{ + Printer.TopMargin + Printer.BottomMargin};
|
|
if NeedChangeOrientation then
|
|
SwapXY(SplitAddX, SplitAddY);
|
|
SplitPage(Page.PaperWidth, Page.PaperHeight, SheetWidth - SplitAddX, SheetHeight - SplitAddY,
|
|
countX, countY, NeedChangeOrientation);
|
|
|
|
|
|
orient := poPortrait;
|
|
if NeedChangeOrientation then
|
|
orient := poLandscape;
|
|
|
|
dup := Page.Duplex;
|
|
if DuplexMode <> dmNone then
|
|
dup := DuplexMode;
|
|
|
|
if not PagePrinted or (orient <> LastOrientation) then
|
|
Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
|
|
SheetWidth, SheetHeight, orient, Bin, Integer(dup) {+ 1}, ACopies);
|
|
|
|
if not PagePrinted then
|
|
Printer.BeginDoc;
|
|
|
|
if orient = poPortrait then
|
|
begin
|
|
pieceX := SheetWidth * (Printer.DPI.X / 25.4);
|
|
pieceY := SheetHeight * (Printer.DPI.Y / 25.4);
|
|
end
|
|
else
|
|
begin
|
|
pieceX := SheetHeight * (Printer.DPI.X / 25.4);
|
|
pieceY := SheetWidth * (Printer.DPI.Y / 25.4);
|
|
end;
|
|
|
|
//marginY := 0;
|
|
printedY := 0;
|
|
offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4;
|
|
|
|
SplitAddY := 0;
|
|
|
|
for y := 1 to countY do
|
|
begin
|
|
//marginX := 0;
|
|
printedX := 0;
|
|
offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4;
|
|
SplitAddX := 0;
|
|
|
|
for x := 1 to countX do
|
|
begin
|
|
SavedDCState := SaveDC(Printer.Canvas.Handle);
|
|
OldRgn := CreateRectRgn(0, 0, 10000, 10000);
|
|
GetClipRgn(Printer.Canvas.Handle, OldRgn);
|
|
OutRgn := CreateRectRgn(Round(SplitAddX + Printer.LeftMargin * Printer.DPI.X / 25.4),
|
|
Round(SplitAddY + Printer.TopMargin * Printer.DPI.Y / 25.4),
|
|
Round(Page.PaperWidth * fr01cm * Printer.DPI.X / 96 - Printer.RightMargin * Printer.DPI.X / 25.4) - 1,
|
|
Round(Page.PaperHeight * fr01cm * Printer.DPI.Y / 96 - Printer.BottomMargin * Printer.DPI.Y / 25.4) - 1);
|
|
SelectClipRgn(Printer.Canvas.Handle, OutRgn);
|
|
{$IFNDEF FPC}
|
|
SetMetaRgn(Printer.Canvas.Handle);
|
|
{$ENDIF}
|
|
try
|
|
Printer.BeginPage;
|
|
DrawPage(Index, Printer.Canvas, Printer.DPI.X / 96, Printer.DPI.Y / 96,
|
|
offsX, offsY);
|
|
|
|
{$IFDEF TRIAL}
|
|
with Printer.Canvas do
|
|
begin
|
|
Font.Size := 12;
|
|
Font.Color := clBlack;
|
|
TextOut(0, 0, frxReverseString(FR_UNREG));
|
|
end;
|
|
{$ENDIF}
|
|
Printer.EndPage;
|
|
finally
|
|
{ restore regions }
|
|
SelectClipRgn(Printer.Canvas.Handle, OldRgn);
|
|
DeleteObject(OutRgn);
|
|
DeleteObject(OldRgn);
|
|
RestoreDC(Printer.Canvas.Handle, SavedDCState);
|
|
end;
|
|
SplitAddX := SplicingLineSz * Printer.DPI.X / 25.4;
|
|
marginX := Printer.LeftMargin * Printer.DPI.X / 25.4;
|
|
printedX := printedX + (pieceX - marginX - Printer.RightMargin * Printer.DPI.X / 25.4) -
|
|
SplitAddX;
|
|
offsX := -printedX;
|
|
end;
|
|
marginY := Printer.TopMargin * Printer.DPI.Y / 25.4;
|
|
SplitAddY := SplicingLineSz * Printer.DPI.Y / 25.4;
|
|
printedY := printedY + (pieceY - marginY - Printer.BottomMargin * Printer.DPI.Y / 25.4) -
|
|
SplitAddY;
|
|
offsY := -printedY;
|
|
end;
|
|
|
|
Report.InternalOnProgress(ptPrinting, Index + 1);
|
|
if not Report.EngineOptions.EnableThreadSafe then
|
|
Application.ProcessMessages;
|
|
|
|
PagePrinted := True;
|
|
Inc(PagesPrinted);
|
|
|
|
LastOrientation := Page.Orientation;
|
|
ClearPageCache;
|
|
end;
|
|
|
|
|
|
function PrintPage(Index: Integer): Boolean;
|
|
var
|
|
Bin, ACopies: Integer;
|
|
dup: TfrxDuplexMode;
|
|
ZoomX, ZoomY: Extended;
|
|
begin
|
|
Result := True;
|
|
//if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
|
|
Index := GetPageIndex(Index);
|
|
if (Index = -1) or (Index >= Count) then Exit;
|
|
if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or
|
|
((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit;
|
|
if Report.Terminated then
|
|
begin
|
|
Printer.Abort;
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
Page := GetPage(Index);
|
|
|
|
if Report.PrintOptions.Collate then
|
|
begin
|
|
ACopies := 1;
|
|
FCopyNo := ACopyNo;
|
|
end
|
|
else
|
|
begin
|
|
ACopies := Report.PrintOptions.Copies;
|
|
FCopyNo := 1;
|
|
end;
|
|
|
|
if Assigned(Report.OnPrintPage) then
|
|
Report.OnPrintPage(Page, FCopyNo);
|
|
|
|
|
|
if not IsBinPrinted(Page.Bin)then
|
|
Bin := Page.Bin else
|
|
Bin := Page.BinOtherPages;
|
|
|
|
dup := Page.Duplex;
|
|
if DuplexMode <> dmNone then
|
|
dup := DuplexMode;
|
|
|
|
if LastDuplexMode <> dup then
|
|
NeedFinishDuplex := False;
|
|
if (dup in [dmVertical, dmHorizontal]) or ((dup = dmNone) and Printer.IsDuplexActive) then
|
|
NeedFinishDuplex := not NeedFinishDuplex;
|
|
|
|
if Report.PrintOptions.PrintMode = pmDefault then
|
|
begin
|
|
if (not PagePrinted) or
|
|
(LastPaperSize <> Page.PaperSize) or
|
|
(LastPaperWidth <> Round(Page.PaperWidth)) or
|
|
(LastPaperHeight <> Round(Page.PaperHeight)) or
|
|
(LastBin <> Bin) or
|
|
(LastOrientation <> Page.Orientation) or
|
|
(LastDuplexMode <> dup) then
|
|
Printer.SetPrintParams(Page.PaperSize, Page.PaperWidth, Page.PaperHeight,
|
|
Page.Orientation, Bin, Integer(dup) {+ 1}, ACopies);
|
|
end
|
|
else
|
|
if (not PagePrinted) or
|
|
(LastBin <> Bin) or
|
|
(LastOrientation <> Page.Orientation) or
|
|
(LastDuplexMode <> dup) then
|
|
begin
|
|
Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
|
|
SheetWidth, SheetHeight, Page.Orientation, Bin, Integer(dup) {+ 1}, ACopies);
|
|
SheetWidth := frxPrinters.Printer.PaperWidth;
|
|
SheetHeight := frxPrinters.Printer.PaperHeight;
|
|
end;
|
|
|
|
if not PagePrinted then
|
|
Printer.BeginDoc;
|
|
if not Printer.Printing then
|
|
begin
|
|
Printer.Abort;
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
Printer.BeginPage;
|
|
|
|
if Report.PrintOptions.PrintMode = pmDefault then
|
|
begin
|
|
ZoomX := 1;
|
|
ZoomY := 1;
|
|
end
|
|
else
|
|
begin
|
|
ZoomX := SheetWidth / Page.PaperWidth;
|
|
ZoomY := SheetHeight / Page.PaperHeight;
|
|
if ZoomY < ZoomX then
|
|
FPrintScale := ZoomY
|
|
else
|
|
FPrintScale := ZoomX;
|
|
end;
|
|
|
|
DrawPage(Index, Printer.Canvas, Printer.DPI.X / 96 * ZoomX, Printer.DPI.Y / 96 * ZoomY,
|
|
-Printer.LeftMargin * Printer.DPI.X / 25.4,
|
|
-Printer.TopMargin * Printer.DPI.Y / 25.4);
|
|
|
|
Report.InternalOnProgress(ptPrinting, Index + 1);
|
|
|
|
{$IFDEF TRIAL}
|
|
with Printer.Canvas do
|
|
begin
|
|
Font.Size := 12;
|
|
Font.Color := clBlack;
|
|
TextOut(0, 0, frxReverseString(FR_UNREG));
|
|
end;
|
|
{$ENDIF}
|
|
Printer.EndPage;
|
|
if not Report.EngineOptions.EnableThreadSafe then
|
|
Application.ProcessMessages;
|
|
|
|
PagePrinted := True;
|
|
Inc(PagesPrinted);
|
|
|
|
LastPaperSize := Page.PaperSize;
|
|
LastPaperWidth := Round(Page.PaperWidth);
|
|
LastPaperHeight := Round(Page.PaperHeight);
|
|
LastBin := Bin;
|
|
LastOrientation := Page.Orientation;
|
|
LastDuplexMode := dup;
|
|
ClearPageCache;
|
|
end;
|
|
|
|
procedure PrintPages;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
PagesPrinted := 0;
|
|
|
|
if Report.PrintOptions.Reverse then
|
|
begin
|
|
for i := MaxCount - 1 downto 0 do
|
|
if not PrintPage(i) then
|
|
break;
|
|
end
|
|
else
|
|
for i := 0 to MaxCount - 1 do
|
|
if not PrintPage(i) then
|
|
begin
|
|
Result := False;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
procedure PrintSplittedPages;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
PagesPrinted := 0;
|
|
|
|
if Report.PrintOptions.Reverse then
|
|
begin
|
|
for i := MaxCount - 1 downto 0 do
|
|
if not PrintSplittedPage(i) then
|
|
break;
|
|
end
|
|
else
|
|
for i := 0 to MaxCount - 1 do
|
|
if not PrintSplittedPage(i) then
|
|
break;
|
|
end;
|
|
|
|
procedure PrintJoinedPages;
|
|
var
|
|
Index, cp, x, y, countX, countY: Integer;
|
|
pieceX, pieceY, offsX, offsY: Extended;
|
|
orient: TPrinterOrientation;
|
|
NeedChangeOrientation: Boolean;
|
|
dup: TfrxDuplexMode;
|
|
begin
|
|
PagesPrinted := 0;
|
|
if Count = 0 then Exit;
|
|
|
|
{ get the first page and calculate the join options }
|
|
Index := -1;
|
|
Page := GetNextPage(Index);
|
|
|
|
SplitPage(SheetWidth, SheetHeight, Page.PaperWidth, Page.PaperHeight,
|
|
countX, countY, NeedChangeOrientation);
|
|
orient := poPortrait;
|
|
if NeedChangeOrientation then
|
|
begin
|
|
orient := poLandscape;
|
|
x := countX;
|
|
countX := countY;
|
|
countY := x;
|
|
end;
|
|
|
|
{ setup the printer }
|
|
dup := Page.Duplex;
|
|
if DuplexMode <> dmNone then
|
|
dup := DuplexMode;
|
|
Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
|
|
SheetWidth, SheetHeight, orient, Page.Bin, Integer(dup) {+ 1}, 1);
|
|
Printer.BeginDoc;
|
|
PagePrinted := True;
|
|
|
|
{ start the cycle }
|
|
pieceX := Page.PaperWidth * (Printer.DPI.X / 25.4);
|
|
pieceY := Page.PaperHeight * (Printer.DPI.Y / 25.4);
|
|
|
|
Index := -1;
|
|
while Index < MaxCount - 1 do
|
|
begin
|
|
cp := 1;
|
|
offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4;
|
|
Printer.BeginPage;
|
|
|
|
for y := 1 to countY do
|
|
begin
|
|
offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4;
|
|
|
|
for x := 1 to countX do
|
|
begin
|
|
{ get the next page }
|
|
FCopyNo := cp;
|
|
if cp = 1 then
|
|
Page := GetNextPage(Index)
|
|
else
|
|
begin
|
|
ClearPageCache;
|
|
Page := GetPage(GetPageIndex(Index));
|
|
end;
|
|
Inc(cp);
|
|
if cp > Report.PrintOptions.Copies then
|
|
cp := 1;
|
|
|
|
if Page = nil then break;
|
|
|
|
DrawPage(GetPageIndex(Index), Printer.Canvas, Printer.DPI.X / 96, Printer.DPI.Y / 96,
|
|
offsX, offsY);
|
|
|
|
offsX := offsX + pieceX;
|
|
end;
|
|
|
|
if Page = nil then break;
|
|
offsY := offsY + pieceY;
|
|
end;
|
|
|
|
{$IFDEF TRIAL}
|
|
with Printer.Canvas do
|
|
begin
|
|
Font.Size := 12;
|
|
Font.Color := clBlack;
|
|
TextOut(0, 0, frxReverseString(FR_UNREG));
|
|
end;
|
|
{$ENDIF}
|
|
Printer.EndPage;
|
|
|
|
Report.InternalOnProgress(ptPrinting, Index);
|
|
if not Report.EngineOptions.EnableThreadSafe then
|
|
Application.ProcessMessages;
|
|
if Report.Terminated then
|
|
begin
|
|
Printer.Abort;
|
|
Exit;
|
|
end;
|
|
|
|
Inc(PagesPrinted);
|
|
ClearPageCache;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Printer := frxPrinters.Printer;
|
|
Report.Terminated := False;
|
|
Report.InternalOnProgressStart(ptPrinting);
|
|
|
|
if Report.ReportOptions.Name <> '' then
|
|
Printer.Title := Report.ReportOptions.Name else
|
|
Printer.Title := Report.FileName;
|
|
if Report.PrintOptions.Copies <= 0 then
|
|
Report.PrintOptions.Copies := 1;
|
|
{$IFNDEF TRIAL}
|
|
if pgList.Count = 0 then
|
|
MaxCount := Count
|
|
else
|
|
MaxCount := pgList.Count;
|
|
{$ELSE}
|
|
MaxCount := 5;
|
|
if (pgList.Count <> 0) and (pgList.Count < MaxCount) then
|
|
MaxCount := pgList.Count;
|
|
{$ENDIF}
|
|
|
|
PagePrinted := False;
|
|
LastDuplexMode := dmNone;
|
|
NeedFinishDuplex := False;
|
|
|
|
if Report.PrintOptions.Collate then
|
|
for i := 0 to Report.PrintOptions.Copies - 1 do
|
|
begin
|
|
ACopyNo := i + 1;
|
|
case Report.PrintOptions.PrintMode of
|
|
pmDefault, pmScale:
|
|
PrintPages;
|
|
pmSplit:
|
|
PrintSplittedPages;
|
|
pmJoin:
|
|
PrintJoinedPages;
|
|
end;
|
|
if NeedFinishDuplex then
|
|
begin
|
|
NeedFinishDuplex := False;
|
|
Printer.BeginPage;
|
|
Printer.EndPage;
|
|
end;
|
|
|
|
if Report.Terminated then break;
|
|
end
|
|
else
|
|
begin
|
|
case Report.PrintOptions.PrintMode of
|
|
pmDefault, pmScale:
|
|
PrintPages;
|
|
pmSplit:
|
|
PrintSplittedPages;
|
|
pmJoin:
|
|
PrintJoinedPages;
|
|
end;
|
|
end;
|
|
|
|
if PagePrinted then
|
|
Printer.EndDoc;
|
|
Report.InternalOnProgressStop(ptPrinting);
|
|
end;
|
|
|
|
begin
|
|
Result := True;
|
|
if not frxPrinters.HasPhysicalPrinters then
|
|
begin
|
|
frxErrorMsg(frxResources.Get('clNoPrinters'));
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
FPrintScale := 1;
|
|
|
|
if Report.DotMatrixReport and (frxDotMatrixExport <> nil) then
|
|
begin
|
|
Report.SelectPrinter;
|
|
frxDotMatrixExport.ShowDialog := Report.PrintOptions.ShowDialog;
|
|
frxDotMatrixExport.SlaveExport := True;
|
|
frxDotMatrixExport.PageNumbers := Report.PrintOptions.PageNumbers;
|
|
Result := Export(frxDotMatrixExport);
|
|
Exit;
|
|
end;
|
|
|
|
SavePrintOptions := TfrxPrintOptions.Create;
|
|
try
|
|
SavePrintOptions.Assign(Report.PrintOptions);
|
|
DuplexMode := Report.PrintOptions.Duplex;
|
|
Report.SelectPrinter;
|
|
|
|
if Report.PrintOptions.ShowDialog then
|
|
with TfrxPrintDialog.Create(Application) do
|
|
try
|
|
AReport := Report;
|
|
ADuplexMode := DuplexMode;
|
|
ShowModal;
|
|
if ModalResult = mrOk then
|
|
begin
|
|
DuplexMode := ADuplexMode;
|
|
Report.PrintOptions.Printer := frxPrinters.Printer.Name;
|
|
Report.PrintOptions.Duplex := DuplexMode;
|
|
end
|
|
else
|
|
begin
|
|
FCopyNo := 0;
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
|
|
if Report.PrintOptions.PrnOutFileName <> '' then
|
|
frxPrinters.Printer.FileName := Report.PrintOptions.PrnOutFileName;
|
|
|
|
if Report.PrintOptions.PrintMode <> pmDefault then
|
|
begin
|
|
if Report.PrintOptions.PrintOnSheet <> 256 then
|
|
frxPrinters.Printer.SetViewParams(Report.PrintOptions.PrintOnSheet, 0, 0, poPortrait)
|
|
else
|
|
frxPrinters.Printer.SetViewParams(Report.PrintOptions.PrintOnSheet, frxPrinters.Printer.PaperWidth,
|
|
frxPrinters.Printer.PaperHeight, poPortrait);
|
|
|
|
if frxPrinters.Printer.PaperWidth <> 0 then
|
|
SheetWidth := frxPrinters.Printer.PaperWidth
|
|
else
|
|
SheetWidth := frxPrinters.Printer.DefPaperWidth;
|
|
if frxPrinters.Printer.PaperHeight <> 0 then
|
|
SheetHeight := frxPrinters.Printer.PaperHeight
|
|
else
|
|
SheetHeight := frxPrinters.Printer.DefPaperHeight;
|
|
SplicingLineSz := Report.PrintOptions.SplicingLine;
|
|
end;
|
|
|
|
if Assigned(Report.OnPrintReport) then
|
|
Report.OnPrintReport(Report);
|
|
Report.DoNotifyEvent(Report, Report.OnReportPrint, not Report.EngineOptions.DestroyForms);
|
|
|
|
if Report.Preview <> nil then
|
|
begin
|
|
Report.Preview.Lock;
|
|
Report.Preview.Refresh;
|
|
end;
|
|
pgList := TStringList.Create;
|
|
PrintedBins := TList.Create;
|
|
try
|
|
if frxPrinters.Printer.Initialized then
|
|
begin
|
|
frxParsePageNumbers(Report.PrintOptions.PageNumbers, pgList, Count);
|
|
ClearPageCache;
|
|
DoPrint;
|
|
end
|
|
else frxErrorMsg('Printer selected is not valid');
|
|
finally
|
|
if Report.Preview <> nil then
|
|
Report.Preview.Unlock;
|
|
try
|
|
if Assigned(Report.OnAfterPrintReport) then
|
|
Report.OnAfterPrintReport(Report);
|
|
FCopyNo := 0;
|
|
Report.PrintOptions.Assign(SavePrintOptions);
|
|
finally
|
|
pgList.Free;
|
|
PrintedBins.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
SavePrintOptions.Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.ProcessHyperlink(Hyperlink: TfrxHyperlink): Boolean;
|
|
var
|
|
Rep: TfrxReport;
|
|
RepPage: TfrxPage;
|
|
SPreview: TfrxCustomPreview;
|
|
ReportLoaded: Boolean;
|
|
lHyperlink: TfrxHyperlink;
|
|
|
|
procedure SetToAnchor(const Text: String);
|
|
var
|
|
Item: TfrxXMLItem;
|
|
PageN, Top: Integer;
|
|
begin
|
|
Item := FindAnchor(Text);
|
|
if Item <> nil then
|
|
begin
|
|
PageN := StrToInt(String(Item.Prop['page']));
|
|
Top := StrToInt(String(Item.Prop['top']));
|
|
TfrxPreview(Report.Preview).SetPosition(PageN + 1, Top);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := True;
|
|
lHyperlink := TfrxHyperlink.Create;
|
|
lHyperlink.Assign(Hyperlink);
|
|
try
|
|
|
|
case lHyperlink.Kind of
|
|
hkURL:
|
|
if lHyperlink.Value <> '' then
|
|
{$IFDEF FPC}
|
|
LCLIntf.OpenURL(Hyperlink.Value);
|
|
{$ELSE}
|
|
ShellExecute(GetDesktopWindow, nil, PChar(lHyperlink.Value), nil, nil,
|
|
sw_ShowNormal);
|
|
{$ENDIF}
|
|
hkAnchor:
|
|
if lHyperlink.Value <> '' then
|
|
SetToAnchor(lHyperlink.Value);
|
|
hkPageNumber:
|
|
if lHyperlink.Value <> '' then
|
|
TfrxPreview(Report.Preview).PageNo := StrToInt(lHyperlink.Value);
|
|
hkDetailPage:
|
|
if Report.Preview.HasTab(lHyperlink.Value) then
|
|
Report.Preview.SwitchToTab(lHyperlink.Value)
|
|
else if not lHyperlink.DetailIsEmpty then
|
|
begin
|
|
RepPage := Report.FindObject(lHyperlink.DetailPage) as TfrxPage;
|
|
if RepPage <> nil then
|
|
begin
|
|
lHyperlink.AssignVariables(Report);
|
|
FireMouseLeave;
|
|
Report.Terminated := False;
|
|
Report.PreviewPagesList.AddAsCurrent;
|
|
SPreview := Report.Preview;
|
|
Report.Preview.Lock;
|
|
try
|
|
SPreview.AddPreviewTab(Report, lHyperlink.Value,
|
|
lHyperlink.TabCaption, False, lHyperlink.DetailPage);
|
|
Report.PreparePage(RepPage);
|
|
finally
|
|
Report.Preview.Unlock;
|
|
end;
|
|
end;
|
|
end;
|
|
hkDetailReport:
|
|
if Report.Preview.HasTab(lHyperlink.Value) then
|
|
Report.Preview.SwitchToTab(lHyperlink.Value)
|
|
else if not lHyperlink.DetailIsEmpty then
|
|
begin
|
|
FireMouseLeave;
|
|
Rep := TfrxReport.Create(nil);
|
|
Rep.PreviewOptions.Assign(Report.PreviewOptions);
|
|
Rep.EngineOptions.Assign(Report.EngineOptions);
|
|
Rep.PictureCacheOptions.Assign(Report.PictureCacheOptions);
|
|
ReportLoaded := False;
|
|
if Assigned(Report.OnLoadTemplate) then
|
|
Rep.OnLoadTemplate := Report.OnLoadTemplate;
|
|
if Assigned(Report.OnLoadDetailTemplate) then
|
|
ReportLoaded := Report.OnLoadDetailTemplate(Rep,
|
|
lHyperlink.DetailReport, lHyperlink);
|
|
if not ReportLoaded then
|
|
ReportLoaded := Rep.LoadFromFile(lHyperlink.DetailReport);
|
|
|
|
if ReportLoaded then
|
|
begin
|
|
lHyperlink.AssignVariables(Rep);
|
|
Rep.PrepareReport();
|
|
Report.Preview.AddPreviewTab(Rep, lHyperlink.Value,
|
|
lHyperlink.TabCaption);
|
|
FLastObjectOver := nil;
|
|
FLastDrill := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
lHyperlink.Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.Export(Filter: TfrxCustomExportFilter): Boolean;
|
|
var
|
|
pgList: TStringList;
|
|
tempBMP: TBitmap;
|
|
{$IFDEF ACADEMIC_ED}
|
|
aWidth, aHeight: Integer;
|
|
{$ENDIF}
|
|
//OriginalfName: String;
|
|
procedure ExportPage(Index: Integer);
|
|
var
|
|
i, j: Integer;
|
|
Page: TfrxReportPage;
|
|
c: TfrxComponent;
|
|
p: TfrxPictureView;
|
|
{$IFDEF TRIAL}
|
|
m: TfrxCustomMemoView;
|
|
{$ENDIF}
|
|
|
|
procedure ExportObject(c: TfrxComponent);
|
|
begin
|
|
if Filter.DataOnly and not (c.Parent is TfrxDataBand) then
|
|
Exit;
|
|
if (c is TfrxView) and not (vsExport in TfrxView(c).Visibility) then
|
|
Exit;
|
|
|
|
UpdateCachedObject(c);
|
|
|
|
if c is TfrxCustomMemoView then
|
|
begin
|
|
{ needed for TOTALPAGES, COPYNAME macros }
|
|
THackMemoView(c).FTotalPages := Count;
|
|
THackMemoView(c).FCopyNo := 1;
|
|
THackMemoView(c).ExtractMacros;
|
|
{ needed if memo has AutoWidth and Align properties }
|
|
tempBMP.Canvas.Lock;
|
|
try
|
|
if THackMemoView(c).AutoWidth then
|
|
THackMemoView(c).Draw(tempBMP.Canvas, 1, 1, 0, 0);
|
|
finally
|
|
tempBMP.Canvas.Unlock;
|
|
end;
|
|
end;
|
|
|
|
// AllObjectsList := c.GetInternalObjects;
|
|
// if Assigned(AllObjectsList) then
|
|
// try
|
|
// for i := 0 to AllObjectsList.Count - 1 do
|
|
// if TObject(AllObjectsList[i]) is TfrxView then
|
|
// Filter.ExportObject(TfrxView(AllObjectsList[i]));
|
|
// if (AllObjectsList.Count > 0) then Exit;
|
|
// finally
|
|
// FreeAndNil(AllObjectsList);
|
|
// end;
|
|
if not c.ExportInternal(Filter) then
|
|
Filter.ExportObject(c);
|
|
|
|
if Report.Terminated or Filter.Terminated then
|
|
raise EExportTerminated.Create;
|
|
end;
|
|
|
|
begin
|
|
if Index >= Count then Exit;
|
|
if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
|
|
FCachedGraphicState := cgOriginal;
|
|
Page := GetPage(Index);
|
|
if Page = nil then Exit;
|
|
LockPage;
|
|
|
|
if Filter.ShowProgress then
|
|
Report.InternalOnProgress(ptExporting, Index + 1)
|
|
else
|
|
if not Report.EngineOptions.EnableThreadSafe then
|
|
begin
|
|
if Assigned(Report.OnProgress) then
|
|
Report.OnProgress(Report, ptExporting, Index + 1);
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
Filter.StartPage(Page, Index);
|
|
try
|
|
{ set the offset of the page objects }
|
|
Page.SetMarginOffset(Index);
|
|
|
|
{ export the page background picture and frame }
|
|
p := TfrxPictureView.Create(nil);
|
|
p.Name := PageBGName;
|
|
p.Color := Page.Color;
|
|
p.Frame.Assign(Page.Frame);
|
|
p.Picture.Assign(Page.BackPicture);
|
|
p.Stretched := True;
|
|
p.KeepAspectRatio := False;
|
|
try
|
|
p.SetBounds(Page.Left, Page.Top,
|
|
Page.Width - (Page.LeftMargin + Page.RightMargin) * fr01cm,
|
|
Page.Height - (Page.TopMargin + Page.BottomMargin) * fr01cm);
|
|
{$IFDEF ACADEMIC_ED}
|
|
aHeight := Round(Page.Height - (Page.TopMargin + Page.BottomMargin) * fr01cm);
|
|
aWidth := Round(Page.Width - (Page.LeftMargin + Page.RightMargin) * fr01cm);
|
|
if (p.Picture.Bitmap.Height <> aHeight) or (p.Picture.Bitmap.Width <> aWidth) then
|
|
begin
|
|
p.Picture.Bitmap.Width := aWidth;
|
|
p.Picture.Bitmap.Height := aHeight;
|
|
if (Page.BackPicture.Graphic <> nil) and not Page.BackPicture.Graphic.Empty then
|
|
p.Picture.Bitmap.Canvas.Draw(Round(Page.Left), Round(Page.Top), Page.BackPicture.Graphic);
|
|
end;
|
|
DrawWaterMark(p.Picture.Bitmap.Canvas, 1, 1, Page.Left, Page.Top, Page.PaperWidth, Page.PaperHeight);
|
|
{$ENDIF}
|
|
ExportObject(p);
|
|
finally
|
|
p.Free;
|
|
end;
|
|
{$IFDEF TRIAL}
|
|
m := TfrxCustomMemoView.Create(nil);
|
|
try
|
|
m.SetBounds(Page.Left, Page.Top - 10,
|
|
Page.Width - (Page.LeftMargin + Page.RightMargin) * fr01cm, 10);
|
|
m.Text := frxReverseString(FR_UNREG);
|
|
m.HAlign := haRight;
|
|
m.Font.Size := 7;
|
|
m.Font.Color := clGray;
|
|
Filter.ExportObject(m);
|
|
finally
|
|
m.Free;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
for i := 0 to Page.Objects.Count - 1 do
|
|
begin
|
|
c := Page.Objects[i];
|
|
if c is TfrxBand then
|
|
begin
|
|
if c is TfrxPageHeader then
|
|
begin
|
|
{ suppress a header }
|
|
if Filter.SuppressPageHeadersFooters and (Index <> 0) then continue;
|
|
end;
|
|
if c is TfrxPageFooter then
|
|
begin
|
|
{ suppress a footer }
|
|
if Filter.SuppressPageHeadersFooters and (Index <> Count - 1) then continue;
|
|
end;
|
|
end;
|
|
|
|
ExportObject(c);
|
|
if c.Objects.Count <> 0 then
|
|
for j := 0 to c.Objects.Count - 1 do
|
|
ExportObject(c.Objects[j]);
|
|
end;
|
|
|
|
finally
|
|
Filter.FinishPage(Page, Index);
|
|
UnlockPage;
|
|
end;
|
|
|
|
if Report.Preview = nil then
|
|
ClearPageCache
|
|
else
|
|
Page.ClearMarginOffset;
|
|
end;
|
|
|
|
procedure DoExport;
|
|
var
|
|
i: Integer;
|
|
{$IFDEF DBGLOG}
|
|
Time: Cardinal;
|
|
{$ENDIF}
|
|
begin
|
|
if Assigned(Filter.OnBeginExport) then
|
|
Filter.OnBeginExport(Filter);
|
|
|
|
{$IFDEF DBGLOG}
|
|
Time := GetTickCount;
|
|
{$ENDIF}
|
|
|
|
// if Filter.Stream = nil then
|
|
// begin
|
|
// Filter.Stream := Filter.SaveFilter.GetStream(Filter.FileName);
|
|
// bFinalizeStream := True;
|
|
// end;
|
|
|
|
if Filter.DoStart then
|
|
try
|
|
if Report.Preview <> nil then
|
|
begin
|
|
Report.Preview.Lock;
|
|
Report.Preview.Refresh;
|
|
end;
|
|
|
|
if Filter.ShowProgress then
|
|
Report.InternalOnProgressStart(ptExporting)
|
|
else
|
|
if not Report.EngineOptions.EnableThreadSafe then
|
|
begin
|
|
if Assigned(Report.OnProgressStart) then
|
|
Report.OnProgressStart(Report, ptExporting, 0);
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
try
|
|
{$IFNDEF TRIAL}
|
|
for i := 0 to Count - 1 do
|
|
{$ELSE}
|
|
for i := 0 to 4 do
|
|
{$ENDIF}
|
|
begin
|
|
ExportPage(i);
|
|
if not Report.EngineOptions.EnableThreadSafe then
|
|
Application.ProcessMessages;
|
|
end;
|
|
except
|
|
on Exceprion: EExportTerminated do
|
|
Filter.Terminated := False;
|
|
end;
|
|
|
|
finally
|
|
if Report.Preview <> nil then
|
|
begin
|
|
Report.Preview.Unlock();
|
|
Report.Preview.Refresh;
|
|
end;
|
|
|
|
if Filter.ShowProgress then
|
|
Report.InternalOnProgressStop(ptExporting)
|
|
else
|
|
if not Report.EngineOptions.EnableThreadSafe then
|
|
begin
|
|
if Assigned(Report.OnProgressStop) then
|
|
Report.OnProgressStop(Report, ptExporting, 0);
|
|
Application.ProcessMessages;
|
|
end;
|
|
Filter.DoFinish;
|
|
// Filter.SaveFilter.DoFilterSave(Filter.Stream);
|
|
end;
|
|
|
|
{$IFDEF DBGLOG}
|
|
Time := GetTickCount - Time;
|
|
|
|
DbgPrintTitle('Exporting Results');
|
|
DbgPrint('Filter: %s'#10, [Filter.ClassName]);
|
|
DbgPrint('Duration: %d ms'#10, [Time]);
|
|
|
|
if (Report <> nil) and (Report.FileName <> '') then
|
|
DbgPrint('Input: %s'#10, [Report.FileName]);
|
|
|
|
with Filter do
|
|
if Stream <> nil then
|
|
begin
|
|
DbgPrint('Output: %s'#10, [Stream.ClassName]);
|
|
DbgPrint('SHA1(Output): %s'#10, [HashStream('SHA1', Stream)]);
|
|
DbgPrint('Output size: %d'#10, [Stream.Size]);
|
|
end
|
|
else
|
|
begin
|
|
DbgPrint('Output: %s'#10, [FileName]);
|
|
DbgPrint('SHA1(Output): %s'#10, [HashFile('SHA1', FileName)]);
|
|
|
|
with TFileStream.Create(FileName, 0) do
|
|
try
|
|
DbgPrint('Output size: %d'#10, [Size]);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
begin
|
|
Result := False;
|
|
FCopyNo := 0;
|
|
|
|
if Filter = nil then
|
|
Exit;
|
|
|
|
{$IFNDEF STATIC_EXPORTING_RESULTS}
|
|
Filter.CreationTime := Now;
|
|
{$ENDIF}
|
|
|
|
Filter.Report := Report;
|
|
Filter.DefaultIOTransport := nil;
|
|
if Assigned(Filter.OnBeforeExport) then
|
|
Filter.OnBeforeExport(Filter);
|
|
|
|
if (doShowExportSettings in Filter.ShowDialogOptions) then
|
|
if (Filter.ShowModal <> mrOk) then
|
|
Exit;
|
|
if Filter.IOTransport = nil then
|
|
Filter.IOTransport := Filter.DefaultIOTransport;
|
|
|
|
Filter.IOTransport.InitFromExport(Filter);
|
|
|
|
//OriginalfName := Filter.FileName;
|
|
try
|
|
{$IFDEF Linux}
|
|
Application.ProcessMessages;
|
|
{$ENDIF}
|
|
if not Filter.IOTransport.OpenFilter then
|
|
Exit;
|
|
Filter.FileName := Filter.IOTransport.FileName;
|
|
if Filter.CurPage then
|
|
if Report.Preview <> nil then
|
|
Filter.PageNumbers := IntToStr(CurPreviewPage)
|
|
else
|
|
Filter.PageNumbers := '1';
|
|
|
|
Result := True;
|
|
Report.Terminated := False;
|
|
|
|
pgList := TStringList.Create;
|
|
tempBMP := TBitmap.Create;
|
|
try
|
|
frxParsePageNumbers(Filter.PageNumbers, pgList, Count);
|
|
|
|
if Filter = frxDotMatrixExport then
|
|
if Assigned(Report.OnPrintReport) then
|
|
Report.OnPrintReport(Report);
|
|
|
|
try
|
|
DoExport;
|
|
except
|
|
on EExportTerminated do
|
|
{ do nothing };
|
|
on e: Exception do
|
|
begin
|
|
Result := False;
|
|
Report.Errors.Text := e.Message;
|
|
frxCommonErrorHandler(Report, frxResources.Get('clErrors') + #13#10 +
|
|
Report.Errors.Text);
|
|
end;
|
|
end;
|
|
|
|
if Filter = frxDotMatrixExport then
|
|
if Assigned(Report.OnAfterPrintReport) then
|
|
Report.OnAfterPrintReport(Report);
|
|
finally
|
|
pgList.Free;
|
|
tempBMP.Free;
|
|
// if bFinalizeStream then
|
|
// begin
|
|
// Filter.IOTransport.FreeStream(Filter.Stream);
|
|
// Filter.Stream := nil;
|
|
// end;
|
|
end;
|
|
finally
|
|
//Filter.FileName := OriginalfName;
|
|
Filter.IOTransport.CloseFilter;
|
|
if Filter.IOTransport = Filter.DefaultIOTransport then
|
|
Filter.IOTransport := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ObjectOver(Index: Integer; X, Y: Integer;
|
|
Button: TMouseButton; Shift: TShiftState; Scale, OffsetX, OffsetY: Extended; var aEventParams: TfrxPreviewIntEventParams);
|
|
var
|
|
Page: TfrxReportPage;
|
|
c: TfrxComponent;
|
|
//l: TList;
|
|
i: Integer;
|
|
//Flag: Boolean;
|
|
v: TfrxView;
|
|
drill: TfrxGroupHeader;
|
|
IsInView: Boolean;
|
|
//NeedRefresh: Boolean;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
|
|
Params: Variant;
|
|
ModObjList: TList;
|
|
sHint: String;
|
|
bIsHint, bHandleMessage: Boolean;
|
|
|
|
function MouseInView(c: TfrxComponent): Boolean;
|
|
var
|
|
r: TRect;
|
|
begin
|
|
with c do
|
|
r := Rect(Round(AbsLeft * Scale), Round(AbsTop * Scale),
|
|
Round((AbsLeft + Width) * Scale),
|
|
Round((AbsTop + Height) * Scale));
|
|
OffsetRect(r, Round(OffsetX), Round(OffsetY));
|
|
Result := PtInRect(r, Point(X, Y));
|
|
end;
|
|
|
|
procedure FireMouseLeave;
|
|
begin
|
|
if Assigned(FLastObjectOver) then
|
|
Report.DoMouseLeave(FLastObjectOver, X, Y, nil, EventParams);
|
|
FLastObjectOver := nil;
|
|
FLastDrill := nil;
|
|
Report.Preview.Hint := '';
|
|
Report.Preview.ShowHint := False;
|
|
end;
|
|
|
|
begin
|
|
if (Index < 0) or (Index >= Count) or Engine.Running then Exit;
|
|
Page := GetPage(Index);
|
|
if Page = nil then Exit;
|
|
bIsHint := False;
|
|
bHandleMessage := False;
|
|
sHint := '';
|
|
LockPage;
|
|
|
|
if Page.MirrorMargins and (Index mod 2 = 1) then
|
|
OffsetX := OffsetX + Page.RightMargin * fr01cm * Scale else
|
|
OffsetX := OffsetX + Page.LeftMargin * fr01cm * Scale;
|
|
OffsetY := OffsetY + Page.TopMargin * fr01cm * Scale;
|
|
|
|
|
|
//Page := GetPage(Index); // get page again to ensure it was not cleared during export
|
|
//if Page = nil then Exit;
|
|
|
|
|
|
IsInView := False;
|
|
drill := nil;
|
|
//l := Page.AllObjects;
|
|
|
|
if Assigned(Report.Preview) then
|
|
Report.Preview.SetDefaultEventParams(EventParams)
|
|
else
|
|
begin
|
|
EventParams.EventSender := esPreview;
|
|
EventParams.EditorsList := nil;
|
|
EventParams.OnFinish := nil;
|
|
EventParams.Sender := nil;
|
|
end;
|
|
EventParams.OffsetX := OffsetX;
|
|
EventParams.OffsetY := OffsetY;
|
|
EventParams.Scale := Scale;
|
|
EventParams.EditMode := aEventParams.EditMode;
|
|
v := nil;
|
|
if (aEventParams.MouseEventType = meMouseMove) or (FLastObjectOver = nil) then
|
|
begin
|
|
c := Page.GetContainedComponent((X - OffsetX) / Scale,
|
|
(Y - OffsetY) / Scale);
|
|
if (c is TfrxGroupHeader) and MouseInView(c) then
|
|
if TfrxGroupHeader(c).DrillDown then
|
|
FLastDrill := TfrxGroupHeader(c);
|
|
if (c is TfrxView) and c.IsContain((X - OffsetX) / Scale,
|
|
(Y - OffsetY) / Scale) then
|
|
v := TfrxView(c);
|
|
end
|
|
else
|
|
v := FLastObjectOver;
|
|
|
|
if Assigned(FLastDrill) then
|
|
drill := FLastDrill;
|
|
if Assigned(EventParams.SelectionList) and (pbSelection in Report.PreviewOptions.Buttons) and not (Assigned(v) and (ssShift in Shift)) and (aEventParams.MouseEventType = meMouseDown) then
|
|
begin
|
|
if (EventParams.SelectionList.Count > 0) then
|
|
EventParams.Refresh := True;
|
|
EventParams.SelectionList.Clear;
|
|
end;
|
|
|
|
if Assigned(v) then
|
|
begin
|
|
IsInView := True;
|
|
if (FLastObjectOver <> nil) and (FLastObjectOver <> v) then
|
|
begin
|
|
Report.DoMouseLeave(FLastObjectOver, X - Round(OffsetX), Y - Round(OffsetY), v, EventParams);
|
|
end;
|
|
if (FLastObjectOver <> v) then
|
|
begin
|
|
Report.DoMouseEnter(v, FLastObjectOver, EventParams);
|
|
FLastObjectOver := v;
|
|
end;
|
|
|
|
if (v.Parent is TfrxGroupHeader) and TfrxGroupHeader(v.Parent).DrillDown
|
|
then
|
|
begin
|
|
drill := TfrxGroupHeader(v.Parent);
|
|
// break;
|
|
end;
|
|
if v.Cursor <> crDefault then
|
|
aEventParams.Cursor := v.Cursor;
|
|
if v.Hyperlink.Value <> '' then
|
|
begin
|
|
//Report.SetProgressMessage(v.Hyperlink.Value, False, False);
|
|
sHint := v.Hyperlink.Value;
|
|
if v.Cursor = crDefault then
|
|
aEventParams.Cursor := crHandPoint;
|
|
end;
|
|
if (v.Hint <> '') and (v.ShowHint) and (Report.Preview.UseReportHints) then
|
|
begin
|
|
//Report.SetProgressMessage(GetLongHint(v.Hint), True);
|
|
sHint := GetLongHint(v.Hint);
|
|
bHandleMessage := True;
|
|
bIsHint := True;
|
|
Report.Preview.Hint := GetShortHint(v.Hint);
|
|
Report.Preview.ShowHint := True;
|
|
// remove ActivateHint and implement new class/hint system in preview workspace
|
|
if Report.Preview.HasVisibleTabs then
|
|
Application.ActivateHint(Point(X + Report.Preview.ClientOrigin.X,
|
|
Y + Report.Preview.ClientOrigin.Y + 22))
|
|
else
|
|
Application.ActivateHint(Point(X + Report.Preview.ClientOrigin.X,
|
|
Y + Report.Preview.ClientOrigin.Y));
|
|
end;
|
|
EventParams.Modified := False;
|
|
// object events
|
|
// todo add in-script events
|
|
case aEventParams.MouseEventType of
|
|
meMouseMove:
|
|
v.MouseMove(X - Round(OffsetX), Y - Round(OffsetY), Shift, EventParams);
|
|
meMouseUp:
|
|
Report.DoMouseUp(v, X - Round(OffsetX), Y - Round(OffsetY), Button, Shift, EventParams);
|
|
meMouseDown:
|
|
begin
|
|
aEventParams.RetResult := v.MouseDown(X - Round(OffsetX), Y - Round(OffsetY), Button, Shift, EventParams);
|
|
if Assigned(EventParams.SelectionList) and (pbSelection in Report.PreviewOptions.Buttons) then
|
|
begin
|
|
if ssShift in Shift then
|
|
begin
|
|
if EventParams.SelectionList.IndexOf(v) = -1 then
|
|
EventParams.SelectionList.Add(v)
|
|
else
|
|
EventParams.SelectionList.Remove(v);
|
|
EventParams.Refresh := True;
|
|
end;
|
|
end;
|
|
end;
|
|
meMouseWheel:
|
|
aEventParams.RetResult := v.MouseWheel(Shift,
|
|
aEventParams.WheelDelta, aEventParams.MousePos, EventParams);
|
|
meClick:
|
|
Report.DoPreviewClick(v, Button, Shift, EventParams.Modified,
|
|
EventParams);
|
|
meDbClick:
|
|
Report.DoPreviewClick(v, Button, Shift, EventParams.Modified,
|
|
EventParams, True);
|
|
meDragOver:
|
|
aEventParams.RetResult := v.DragOver(aEventParams.Sender, X - Round(OffsetX), Y - Round(OffsetY),
|
|
aEventParams.State, aEventParams.Accept, EventParams);
|
|
meDragDrop:
|
|
aEventParams.RetResult := v.DragDrop(aEventParams.Sender, X, Y,
|
|
EventParams);
|
|
end;
|
|
|
|
// interactive reports in Hyperlink
|
|
if (aEventParams.MouseEventType in [meClick, meDbClick]) and (drill = nil)
|
|
and (FLastObjectOver <> nil) then
|
|
ProcessHyperlink(v.Hyperlink)
|
|
else if Assigned(Report.OnMouseOverObject) then
|
|
Report.OnMouseOverObject(v);
|
|
end;
|
|
// todo show hide hints !
|
|
// else if c is TfrxView then
|
|
// if (TfrxView(c).ShowHint) and (Report.Preview <> nil) and (Report.Preview.UseReportHints) then
|
|
// Report.Preview.ShowHint := False;
|
|
// end;
|
|
|
|
if (EventParams.Modified) and Assigned(FLastObjectOver) then
|
|
begin
|
|
{ #543558 - using of Highlight should not work, because }
|
|
{ Highlight is a report run-time property, but someone used it }
|
|
{ for preview object highlight and it worked in FR4 }
|
|
{ so we add it just for backward compat, this will be removed in future }
|
|
if (FLastObjectOver is TfrxCustomMemoView) and TfrxCustomMemoView(FLastObjectOver).Highlight.Active then
|
|
TfrxCustomMemoView(FLastObjectOver).ApplyHighlight(TfrxCustomMemoView(FLastObjectOver).Highlight);
|
|
// ModifyPage(Index, Page);
|
|
ModifyObject(FLastObjectOver);
|
|
if (Report <> nil) and (FLastObjectOver.OnContentChanged <> '') then
|
|
begin
|
|
ModObjList := TList.Create;
|
|
try
|
|
Params := VarArrayOf([frxInteger(FLastObjectOver),
|
|
frxInteger(ModObjList), EventParams.Refresh]);
|
|
Report.DoParamEvent(FLastObjectOver.OnContentChanged, Params, True);
|
|
aEventParams.RetResult := FLastObjectOver.OnContentChanged <> '';
|
|
EventParams.Refresh := Params[2];
|
|
for i := 0 to ModObjList.Count - 1 do
|
|
if TObject(ModObjList[i]) is TfrxView then
|
|
ModifyObject(TfrxView(ModObjList[i]));
|
|
finally
|
|
ModObjList.Free;
|
|
end;
|
|
end;
|
|
// handle below
|
|
//if EventParams.Refresh then
|
|
//Report.Preview.Invalidate;
|
|
// FLastObjectOver := nil;
|
|
FLastDrill := nil;
|
|
end;
|
|
{ #631690 call SetProgressMessage only once after all callbacks processed }
|
|
{ SetProgressMessage may use ProcessMessages cycle and event may appear inside }
|
|
if (not IsInView) and (FLastObjectOver <> nil) then
|
|
begin
|
|
FireMouseLeave;
|
|
Report.SetProgressMessage('', False, False);
|
|
Report.SetProgressMessage('', True);
|
|
end
|
|
else if sHint <> '' then
|
|
Report.SetProgressMessage(sHint, bIsHint, bHandleMessage);
|
|
|
|
if (EventParams.Refresh or EventParams.Modified) and (Report.Preview <> nil) then
|
|
TfrxPreview(Report.Preview).Workspace.Repaint;
|
|
|
|
if drill <> nil then
|
|
begin
|
|
aEventParams.Cursor := crHandPoint;
|
|
if (aEventParams.MouseEventType = meClick) and (Button = mbLeft) then
|
|
begin
|
|
if Report.DrillState.IndexOf(drill.DrillName) = -1 then
|
|
Report.DrillState.Add(drill.DrillName)
|
|
else
|
|
Report.DrillState.Delete(Report.DrillState.IndexOf(drill.DrillName));
|
|
Report.Preview.RefreshReport;
|
|
FLastObjectOver := nil;
|
|
FLastDrill := nil;
|
|
end;
|
|
end;
|
|
UnlockPage;
|
|
Report.RunDelayedCommands;
|
|
end;
|
|
|
|
{ TfrxSignaturePages }
|
|
|
|
procedure TfrxSignaturePages.Activate;
|
|
begin
|
|
FActive := True;
|
|
Clear;
|
|
end;
|
|
|
|
constructor TfrxSignaturePages.Create;
|
|
begin
|
|
inherited Create;
|
|
FActive := False;
|
|
end;
|
|
|
|
procedure TfrxSignaturePages.Deactivate;
|
|
begin
|
|
FActive := False;
|
|
end;
|
|
|
|
function TfrxSignaturePages.IsContaine(Name: string): Boolean;
|
|
begin
|
|
Result := IndexOf(Name) <> -1;
|
|
if not Result then
|
|
Add(Name);
|
|
end;
|
|
|
|
end.
|