1
0
Files
aarre
applications
biffexplorer
cactusjukebox
draw_test
foobot
fpbrowser
build
browserconfig.pas
browserconstants.pas
browsermodules.pas
browserviewer.pas
demounit.dfm
dlgabout.lfm
dlgabout.pas
dlgconfig.lfm
dlgconfig.lrs
dlgconfig.pas
fdemunit.dfm
fontdlg.dfm
fontdlg.lfm
fontdlg.lrs
fontdlg.pas
fpbrowser.dpr
fpbrowser.lpi
gopage.dfm
gopage.lfm
gopage.lrs
gopage.pas
imgform.dfm
imgform.lfm
imgform.lrs
imgform.pas
mainform.lfm
mainform.lrs
mainform.pas
mod_braille.pas
mod_testhttp.lfm
mod_testhttp.lrs
mod_testhttp.pas
pageloader.pas
previewform.dfm
previewform.lfm
previewform.lrs
previewform.pas
printstatusform.dfm
printstatusform.lfm
printstatusform.lrs
printstatusform.pas
submit.dfm
submit.lfm
submit.lrs
submit.pas
viewer_ipro.pas
viewer_thtmlcomp.pas
fpchess
fppkgrepotest
fpsvnsync
fpvviewer
gobject-introspection
idlparser
instantfpc
json_packager
khexeditor
lazclock
lazedit
lazeyes
lazimageeditor
lazspreadsheet
lazstacktrace
pyramidtiff
spready
tappytux
wikihelp
bindings
components
examples
image_sources
lclbindings
wst
lazarus-ccr/applications/fpbrowser/printstatusform.pas

102 lines
2.2 KiB
ObjectPascal
Raw Normal View History

unit PrintStatusForm;
interface
uses
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, HTMLView {$IFNDEF LCL}, MetaFilePrinter {$ENDIF};
type
TPrnStatusForm = class(TForm)
StatusLabel: TLabel;
CancelButton: TBitBtn;
procedure CancelButtonClick(Sender: TObject);
private
{ Private declarations }
Viewer: ThtmlViewer;
Canceled: boolean;
{$IFNDEF LCL}
MFPrinter: TMetaFilePrinter;
{$ENDIF}
FromPage, ToPage: integer;
procedure PageEvent(Sender: TObject; PageNum: integer; var Stop: boolean);
public
{ Public declarations }
{$IFNDEF LCL}
procedure DoPreview(AViewer: ThtmlViewer; AMFPrinter: TMetaFilePrinter;
var Abort: boolean);
{$ENDIF}
procedure DoPrint(AViewer: ThtmlViewer; FromPg, ToPg: integer;
var Abort: boolean);
end;
var
PrnStatusForm: TPrnStatusForm;
implementation
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$IFNDEF LCL}
procedure TPrnStatusForm.DoPreview(AViewer: ThtmlViewer; AMFPrinter: TMetaFilePrinter;
var Abort: boolean);
begin
Viewer := AViewer;
MFPrinter := AMFPrinter;
Viewer.OnPageEvent := PageEvent;
try
Show;
Viewer.PrintPreview(MFPrinter);
Hide;
Abort := Canceled;
finally
Viewer.OnPageEvent := Nil;
end;
end;
{$ENDIF}
procedure TPrnStatusForm.DoPrint(AViewer: ThtmlViewer; FromPg, ToPg: integer;
var Abort: boolean);
begin
Viewer := AViewer;
FromPage := FromPg;
ToPage := ToPg;
Viewer.OnPageEvent := PageEvent;
try
Show;
Viewer.Print(FromPage, ToPage);
Hide;
Abort := Canceled;
finally
Viewer.OnPageEvent := Nil;
end;
end;
procedure TPrnStatusForm.PageEvent(Sender: TObject; PageNum: integer; var Stop: boolean);
begin
if Canceled then
Stop := True
else
if PageNum = 0 then
StatusLabel.Caption := 'Formating'
else
StatusLabel.Caption := 'Page Number '+ IntToStr(PageNum);
Update;
end;
procedure TPrnStatusForm.CancelButtonClick(Sender: TObject);
begin
Canceled := True;
end;
initialization
{$IFDEF LCL}
{$I PrintStatusForm.lrs} {Include form's resource file}
{$ENDIF}
end.