This repository has been archived on 2024-11-28. You can view files and clone it, but cannot push or open issues or pull requests.
LuisLeon_FactuGES/Source/Base/GUIBase/uEditorPreview.pas

403 lines
11 KiB
ObjectPascal

unit uEditorPreview;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uEditorBase, ImgList, PngImageList, StdActns, ActnList, TBX,
TB2Item, TB2Dock, TB2Toolbar, JvExControls, JvComponent, JvNavigationPane,
TB2ExtItems, TBXExtItems, uViewPreview, frxClass, ComCtrls, frxPreview,
JvFormAutoSize, JvAppStorage, JvAppRegistryStorage, JvFormPlacement,
pngimage, frxExportImage, frxExportPDF, frxDCtrl, frxDMPExport,
frxGradient, frxChBox, frxCross, frxRich, frxChart, frxOLE, frxBarcode,
ExtCtrls, JvComponentBase, TBXStatusBars, JvExComCtrls, JvStatusBar;
type
IEditorPreview = interface(IEditorBase)
['{43934C3E-2776-4F9E-9292-FB0D7DE2E4DA}']
function GetReport: TfrxReport;
property Report: TfrxReport read GetReport;
procedure LoadFromStream(AStream : TStream);
function ExportToFile : String;
procedure Print;
procedure Preview;
function GetTablaImpresion: String;
function GetIdTablaImpresion: String;
procedure SetTablaImpresion (Value: String);
procedure SetIdTablaImpresion (Value: String);
property TablaImpresion: String read GetTablaImpresion write SetTablaImpresion;
property IdTablaImpresion: String read GetIdTablaImpresion write SetIdTablaImpresion;
end;
TfEditorPreview = class(TfEditorBase, IEditorPreview)
TBXToolbar1: TTBXToolbar;
TBXItem33: TTBXItem;
TBXItem34: TTBXItem;
TBXItem39: TTBXItem;
TBXSeparatorItem16: TTBXSeparatorItem;
cbZoom: TTBXComboBoxItem;
PreviewActionList: TActionList;
PreviewSmallImageList: TPngImageList;
PreviewLargeImageList: TPngImageList;
actPrimeraPagina: TAction;
actUltimaPagina: TAction;
actPaginaAnterior: TAction;
actPaginaSiguiente: TAction;
TBXItem36: TTBXItem;
actZoomIn: TAction;
actZoomOut: TAction;
actTodaPagina: TAction;
actAnchoPagina: TAction;
TBXSeparatorItem17: TTBXSeparatorItem;
TBXItem37: TTBXItem;
TBXItem40: TTBXItem;
TBXItem41: TTBXItem;
TBXItem42: TTBXItem;
frxReport1: TfrxReport;
actToolHand: TAction;
actToolZoom: TAction;
tbxZoom: TTBXItem;
tbxMano: TTBXItem;
TBXSeparatorItem18: TTBXSeparatorItem;
frxBarCodeObject1: TfrxBarCodeObject;
frxOLEObject1: TfrxOLEObject;
frxChartObject1: TfrxChartObject;
frxRichObject1: TfrxRichObject;
frxCrossObject1: TfrxCrossObject;
frxCheckBoxObject1: TfrxCheckBoxObject;
frxGradientObject1: TfrxGradientObject;
frxDotMatrixExport1: TfrxDotMatrixExport;
frxDialogControls1: TfrxDialogControls;
frxTIFFExport1: TfrxTIFFExport;
frxPDFExport1: TfrxPDFExport;
frxBMPExport1: TfrxBMPExport;
TBXItem38: TTBXItem;
TBXSeparatorItem19: TTBXSeparatorItem;
TBXItem43: TTBXItem;
TBXItem44: TTBXItem;
TBXItem45: TTBXItem;
TBXItem46: TTBXItem;
TBXItem47: TTBXItem;
TBXSubmenuItem2: TTBXSubmenuItem;
TBXItem48: TTBXItem;
TBXSubmenuItem3: TTBXSubmenuItem;
TBXItem49: TTBXItem;
TBXItem50: TTBXItem;
TBXItem7: TTBXItem;
TBXItem35: TTBXItem;
procedure FormShow(Sender: TObject);
procedure actPrimeraPaginaExecute(Sender: TObject);
procedure actUltimaPaginaExecute(Sender: TObject);
procedure actPaginaAnteriorExecute(Sender: TObject);
procedure actPaginaSiguienteExecute(Sender: TObject);
procedure actZoomInExecute(Sender: TObject);
procedure actTodaPaginaExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure actImprimirExecute(Sender: TObject);
procedure actAnchoPaginaExecute(Sender: TObject);
procedure actZoomOutExecute(Sender: TObject);
procedure cbZoomItemClick(Sender: TObject);
procedure actToolHandExecute(Sender: TObject);
procedure actToolZoomExecute(Sender: TObject);
procedure actPaginaSiguienteUpdate(Sender: TObject);
procedure actUltimaPaginaUpdate(Sender: TObject);
procedure actPrimeraPaginaUpdate(Sender: TObject);
procedure actPaginaAnteriorUpdate(Sender: TObject);
private
FPreview : TfrViewPreview;
procedure OnPageChanged(Sender: TfrxPreview; PageNo: Integer);
procedure UpdateZoom;
procedure OnPrint(Sender: Tobject);
protected
FTablaImpresion: String;
FIdTablaImpresion: String;
function GetTablaImpresion: String;
function GetIdTablaImpresion: String;
procedure SetTablaImpresion (Value: String);
procedure SetIdTablaImpresion (Value: String);
function GetReport: TfrxReport; virtual;
public
property TablaImpresion: String read GetTablaImpresion write SetTablaImpresion;
property IdTablaImpresion: String read GetIdTablaImpresion write SetIdTablaImpresion;
constructor Create(AOwner: TComponent); override;
property Report: TfrxReport read GetReport;
procedure Print;
procedure Preview;
procedure LoadFromStream(AStream : TStream);
function ExportToFile : String;
end;
implementation
uses
frxRes, frxUtils, frxPrinter,
uCustomEditor, uSistemaFunc, uDataModuleImpresiones;
{$R *.dfm}
{ TfEditorBase1 }
function TfEditorPreview.GetIdTablaImpresion: String;
begin
Result := FIdTablaImpresion;
end;
function TfEditorPreview.GetReport: TfrxReport;
begin
Result := frxReport1;
end;
function TfEditorPreview.GetTablaImpresion: String;
begin
Result := FTablaImpresion;
end;
procedure TfEditorPreview.FormShow(Sender: TObject);
begin
inherited;
UpdateZoom;
actPrimeraPagina.Execute;
FPreview.ShowEmbedded(Self);
Report.ShowPreparedReport;
actAnchoPagina.Execute;
end;
procedure TfEditorPreview.actPrimeraPaginaExecute(Sender: TObject);
begin
inherited;
FPreview.Preview.First;
end;
procedure TfEditorPreview.actPrimeraPaginaUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := (FPreview.Preview.PageNo > 1);
end;
procedure TfEditorPreview.actUltimaPaginaExecute(Sender: TObject);
begin
inherited;
FPreview.Preview.Last;
end;
procedure TfEditorPreview.actUltimaPaginaUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := (FPreview.Preview.PageNo < FPreview.Preview.PageCount);
end;
procedure TfEditorPreview.actPaginaAnteriorExecute(Sender: TObject);
begin
inherited;
FPreview.Preview.Prior;
end;
procedure TfEditorPreview.actPaginaAnteriorUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := (FPreview.Preview.PageNo > 1);
end;
procedure TfEditorPreview.actPaginaSiguienteExecute(Sender: TObject);
begin
inherited;
FPreview.Preview.Next;
end;
procedure TfEditorPreview.actPaginaSiguienteUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := (FPreview.Preview.PageNo < FPreview.Preview.PageCount);
end;
procedure TfEditorPreview.actZoomInExecute(Sender: TObject);
begin
inherited;
FPreview.Preview.Zoom := FPreview.Preview.Zoom + 0.25;
UpdateZoom;
end;
procedure TfEditorPreview.UpdateZoom;
begin
cbZoom.Text := IntToStr(Round(FPreview.Preview.Zoom * 100)) + '%';
end;
procedure TfEditorPreview.actTodaPaginaExecute(Sender: TObject);
begin
inherited;
FPreview.Preview.ZoomMode := zmWholePage;
UpdateZoom;
end;
procedure TfEditorPreview.FormDestroy(Sender: TObject);
begin
inherited;
FPreview.Free;
end;
procedure TfEditorPreview.FormResize(Sender: TObject);
begin
inherited;
UpdateZoom;
end;
procedure TfEditorPreview.actImprimirExecute(Sender: TObject);
begin
inherited;
Print;
end;
procedure TfEditorPreview.actAnchoPaginaExecute(Sender: TObject);
begin
inherited;
FPreview.Preview.ZoomMode := zmPageWidth;
UpdateZoom;
end;
procedure TfEditorPreview.actZoomOutExecute(Sender: TObject);
begin
inherited;
FPreview.Preview.Zoom := FPreview.Preview.Zoom - 0.25;
UpdateZoom;
end;
procedure TfEditorPreview.cbZoomItemClick(Sender: TObject);
var
s: String;
begin
FPreview.Preview.SetFocus;
if cbZoom.ItemIndex = 6 then
actAnchoPagina.Execute
else if cbZoom.ItemIndex = 7 then
actTodaPagina.Execute
else
begin
s := cbZoom.Text;
if Pos('%', s) <> 0 then
s[Pos('%', s)] := ' ';
while Pos(' ', s) <> 0 do
Delete(s, Pos(' ', s), 1);
if s <> '' then
FPreview.Preview.Zoom := frxStrToFloat(s) / 100;
end;
UpdateZoom;
end;
procedure TfEditorPreview.actToolHandExecute(Sender: TObject);
begin
if tbxMano.Checked then
FPreview.Preview.Tool := ptHand
end;
procedure TfEditorPreview.actToolZoomExecute(Sender: TObject);
begin
if tbxZoom.Checked then
FPreview.Preview.Tool := ptZoom;
end;
procedure TfEditorPreview.OnPageChanged(Sender: TfrxPreview;
PageNo: Integer);
begin
StatusBar.Panels[0].Text := Format(frxResources.Get('clPageOf'),
[PageNo, Sender.PageCount]);
end;
procedure TfEditorPreview.OnPrint(Sender: Tobject);
begin
dmImpresiones.AnadirMarcaImpresion(TablaImpresion, IdTablaImpresion);
end;
constructor TfEditorPreview.Create(AOwner: TComponent);
begin
inherited;
with cbZoom.Strings do
begin
Clear;
Add('25%');
Add('50%');
Add('75%');
Add('100%');
Add('150%');
Add('200%');
Add(frxResources.Get('zmPageWidth'));
Add(frxResources.Get('zmWholePage'));
end;
FPreview := TfrViewPreview.Create(Self);
Report.Preview := FPreview.Preview;
FPreview.Preview.OnPageChanged := OnPageChanged;
FTablaImpresion := '-1';
FIdTablaImpresion := '-1';
end;
procedure TfEditorPreview.Preview;
begin
Self.ShowModal;
end;
procedure TfEditorPreview.Print;
begin
FPreview.Preview.Report.OnPrintReport := onprint;
if not frxPrinters.HasPhysicalPrinters then
frxErrorMsg(frxResources.Get('clNoPrinters'))
else
FPreview.Preview.Print;
Enabled := True;
end;
procedure TfEditorPreview.SetIdTablaImpresion(Value: String);
begin
FIdTablaImpresion := Value;
end;
procedure TfEditorPreview.SetTablaImpresion(Value: String);
begin
FTablaImpresion := Value;
end;
function TfEditorPreview.ExportToFile: String;
var
AFile : String;
begin
Result := '';
AFile := DarFicheroTIFFTemporal;
frxTIFFExport1.SeparateFiles := False;
frxTIFFExport1.DefaultPath := ExtractFilePath(AFile);
frxTIFFExport1.FileName := ExtractFileName(AFile);
try
if Report.Export(frxTIFFExport1) then
Result := AFile;
finally
frxTIFFExport1.DefaultPath := '';
frxTIFFExport1.FileName := '';
end;
end;
procedure TfEditorPreview.LoadFromStream(AStream: TStream);
begin
Report.PreviewPages.LoadFromStream(AStream);
end;
initialization
RegisterClass(TfEditorPreview);
finalization
UnRegisterClass(TfEditorPreview);
end.