mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 20:55:59 +02:00
printers: modified dialogs sample for multipage test
git-svn-id: trunk@45481 -
This commit is contained in:
jesus
parent
66134be838
commit
0f12584f36
@ -1,7 +1,7 @@
|
||||
object Form1: TForm1
|
||||
Left = 330
|
||||
Left = 106
|
||||
Height = 683
|
||||
Top = 176
|
||||
Top = 121
|
||||
Width = 489
|
||||
ActiveControl = Button7
|
||||
Caption = 'Form1'
|
||||
@ -12,9 +12,9 @@ object Form1: TForm1
|
||||
LCLVersion = '1.3'
|
||||
object Label1: TLabel
|
||||
Left = 12
|
||||
Height = 16
|
||||
Height = 13
|
||||
Top = 4
|
||||
Width = 307
|
||||
Width = 229
|
||||
Caption = 'This sample show how to use the printer dialogs'
|
||||
ParentColor = False
|
||||
end
|
||||
@ -28,14 +28,14 @@ object Form1: TForm1
|
||||
OnClick = Button2Click
|
||||
TabOrder = 0
|
||||
end
|
||||
object Button1: TButton
|
||||
object btnTPrintDialog: TButton
|
||||
Left = 8
|
||||
Height = 27
|
||||
Top = 78
|
||||
Width = 176
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Execute TPrintDialog'
|
||||
OnClick = Button1Click
|
||||
OnClick = btnTPrintDialogClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object SGrid: TStringGrid
|
||||
@ -59,7 +59,7 @@ object Form1: TForm1
|
||||
MaxSize = 350
|
||||
ReadOnly = True
|
||||
Title.Caption = 'Value'
|
||||
Width = 349
|
||||
Width = 345
|
||||
end>
|
||||
DefaultColWidth = 120
|
||||
FixedCols = 0
|
||||
@ -71,7 +71,7 @@ object Form1: TForm1
|
||||
OnSelectCell = SGridSelectCell
|
||||
ColWidths = (
|
||||
120
|
||||
349
|
||||
345
|
||||
)
|
||||
end
|
||||
object Button3: TButton
|
||||
@ -125,24 +125,24 @@ object Form1: TForm1
|
||||
TabOrder = 6
|
||||
end
|
||||
object chkTestImgs: TCheckBox
|
||||
Left = 200
|
||||
Height = 18
|
||||
Top = 133
|
||||
Width = 82
|
||||
Left = 407
|
||||
Height = 17
|
||||
Top = 100
|
||||
Width = 65
|
||||
Caption = 'Test Imgs'
|
||||
TabOrder = 8
|
||||
end
|
||||
object chkOutputFile: TCheckBox
|
||||
Left = 195
|
||||
Height = 18
|
||||
Height = 17
|
||||
Top = 27
|
||||
Width = 90
|
||||
Width = 71
|
||||
Caption = 'Output File'
|
||||
TabOrder = 9
|
||||
end
|
||||
object txtOutputFile: TFileNameEdit
|
||||
Left = 195
|
||||
Height = 22
|
||||
Height = 21
|
||||
Top = 48
|
||||
Width = 261
|
||||
DialogKind = dkSave
|
||||
@ -157,25 +157,25 @@ object Form1: TForm1
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 20
|
||||
Height = 16
|
||||
Height = 13
|
||||
Top = 188
|
||||
Width = 123
|
||||
Width = 94
|
||||
Alignment = taRightJustify
|
||||
Caption = 'PageSetupDlg Title:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 5
|
||||
Height = 16
|
||||
Height = 13
|
||||
Top = 212
|
||||
Width = 135
|
||||
Width = 102
|
||||
Alignment = taRightJustify
|
||||
Caption = 'PrinterSetupDlg Title:'
|
||||
ParentColor = False
|
||||
end
|
||||
object txtPageSetupDlgTitle: TEdit
|
||||
Left = 184
|
||||
Height = 22
|
||||
Height = 21
|
||||
Top = 188
|
||||
Width = 293
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -184,7 +184,7 @@ object Form1: TForm1
|
||||
end
|
||||
object txtPrinterSetupDlgTitle: TEdit
|
||||
Left = 184
|
||||
Height = 22
|
||||
Height = 21
|
||||
Top = 212
|
||||
Width = 293
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -193,16 +193,16 @@ object Form1: TForm1
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 38
|
||||
Height = 16
|
||||
Height = 13
|
||||
Top = 236
|
||||
Width = 106
|
||||
Width = 78
|
||||
Alignment = taRightJustify
|
||||
Caption = 'PrintDialog Title:'
|
||||
ParentColor = False
|
||||
end
|
||||
object txtPrintDialogTitle: TEdit
|
||||
Left = 184
|
||||
Height = 22
|
||||
Height = 21
|
||||
Top = 236
|
||||
Width = 293
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -210,20 +210,20 @@ object Form1: TForm1
|
||||
Text = 'Printer Dialogs Tests: PrinterDialog'
|
||||
end
|
||||
object btnRotateBin: TButton
|
||||
Left = 334
|
||||
Left = 195
|
||||
Height = 25
|
||||
Top = 120
|
||||
Width = 143
|
||||
Top = 72
|
||||
Width = 127
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = 'Rotate Bin'
|
||||
OnClick = btnRotateBinClick
|
||||
TabOrder = 14
|
||||
end
|
||||
object btnRestoreDefaultBin: TButton
|
||||
Left = 334
|
||||
Left = 332
|
||||
Height = 25
|
||||
Top = 91
|
||||
Width = 143
|
||||
Top = 72
|
||||
Width = 123
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = 'Restore Default Bin'
|
||||
OnClick = btnRestoreDefaultBinClick
|
||||
@ -238,6 +238,30 @@ object Form1: TForm1
|
||||
OnClick = btnPrintWithDlgClick
|
||||
TabOrder = 16
|
||||
end
|
||||
object comboTests: TComboBox
|
||||
Left = 200
|
||||
Height = 21
|
||||
Top = 120
|
||||
Width = 272
|
||||
ItemHeight = 13
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Single Page'
|
||||
'Single Page with Images'
|
||||
'Multi-Page'
|
||||
)
|
||||
Style = csDropDownList
|
||||
TabOrder = 17
|
||||
Text = 'Single Page'
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 200
|
||||
Height = 13
|
||||
Top = 104
|
||||
Width = 30
|
||||
Caption = 'Tests:'
|
||||
ParentColor = False
|
||||
end
|
||||
object PSD: TPrinterSetupDialog
|
||||
Title = 'Testing dialog title'
|
||||
left = 172
|
||||
|
||||
@ -19,14 +19,14 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Types, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
|
||||
PrintersDlgs, StdCtrls, Grids, Menus, EditBtn;
|
||||
PrintersDlgs, StdCtrls, Grids, Menus, EditBtn, ExtCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
btnTPrintDialog: TButton;
|
||||
Button2: TButton;
|
||||
Button3: TButton;
|
||||
btnDirectPrint: TButton;
|
||||
@ -38,6 +38,8 @@ type
|
||||
btnPrintWithDlg: TButton;
|
||||
chkOutputFile: TCheckBox;
|
||||
chkTestImgs: TCheckBox;
|
||||
comboTests: TComboBox;
|
||||
Label5: TLabel;
|
||||
txtPageSetupDlgTitle: TEdit;
|
||||
txtPrinterSetupDlgTitle: TEdit;
|
||||
txtPrintDialogTitle: TEdit;
|
||||
@ -52,7 +54,7 @@ type
|
||||
PSD: TPrinterSetupDialog;
|
||||
SGrid: TStringGrid;
|
||||
procedure btnPrintWithDlgClick(Sender: TObject);
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure btnTPrintDialogClick(Sender: TObject);
|
||||
procedure Button2Click(Sender: TObject);
|
||||
procedure Button3Click(Sender: TObject);
|
||||
procedure btnDirectPrintClick(Sender: TObject);
|
||||
@ -75,8 +77,10 @@ type
|
||||
function Per(AValue: Double; VertRes:boolean=true): Integer;
|
||||
procedure CenterText(const X,Y: Integer; const AText: string);
|
||||
function FormatDots(Dots: Integer):string;
|
||||
procedure PrintSamplePage;
|
||||
procedure PrintSamplePage(PrintImgs:boolean);
|
||||
procedure PrintMultiPage;
|
||||
procedure doPrintDialog(withSample: boolean);
|
||||
procedure PrintTest;
|
||||
public
|
||||
|
||||
{ public declarations }
|
||||
@ -163,7 +167,7 @@ begin
|
||||
result := format('%d dots (%f mm, %f in)',[Dots, Dots*25.4/Printer.YDPI, Dots/Printer.YDPI]);
|
||||
end;
|
||||
|
||||
procedure TForm1.PrintSamplePage;
|
||||
procedure TForm1.PrintSamplePage(PrintImgs: boolean);
|
||||
var
|
||||
Pic: TPicture;
|
||||
d, pgw,pgh: Integer;
|
||||
@ -212,7 +216,7 @@ begin
|
||||
Printer.Canvas.Line(pgw,0,pgw,HIn);
|
||||
|
||||
// Image test
|
||||
if chkTestImgs.Checked then
|
||||
if PrintImgs then
|
||||
begin
|
||||
Pic := TPicture.Create;
|
||||
Pic.LoadFromFile('../../../../images/splash_logo.png');
|
||||
@ -233,6 +237,59 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
UpdatePrinterInfo;
|
||||
end;
|
||||
|
||||
procedure TForm1.PrintMultiPage;
|
||||
const
|
||||
PAGE_COUNT = 2;
|
||||
ColorArray: array[1..PAGE_COUNT] of TColor = (clAqua, clLime);
|
||||
var
|
||||
pgw, pgh, Hin, Page: Integer;
|
||||
R: TRect;
|
||||
te: TTextStyle;
|
||||
begin
|
||||
try
|
||||
Printer.Title := 'Multipage Sample';
|
||||
|
||||
if chkOutputFile.Checked then
|
||||
Printer.FileName := txtOutputFile.FileName
|
||||
else
|
||||
Printer.FileName := '';
|
||||
|
||||
Printer.BeginDoc;
|
||||
|
||||
// some often used consts
|
||||
pgw := Printer.PageWidth-1;
|
||||
pgh := Printer.PageHeight-1;
|
||||
Hin := Inch(0.5);
|
||||
|
||||
Te := Printer.Canvas.TextStyle;
|
||||
Te.Alignment := taCenter;
|
||||
Te.Layout := tlCenter;
|
||||
|
||||
Printer.Canvas.Font.Size:=20;
|
||||
|
||||
for Page:=1 to PAGE_COUNT do begin
|
||||
Printer.Canvas.Pen.Color := clBlack;
|
||||
Printer.Canvas.Brush.Color := ColorArray[Page];
|
||||
R := Rect(0, 0, 3*Hin, Hin);
|
||||
Printer.Canvas.Rectangle(R);
|
||||
Printer.canvas.TextRect(R, R.Left, R.Top, format('Page %d',[Page]), Te);
|
||||
if Page<>PAGE_COUNT then
|
||||
Printer.NewPage;
|
||||
end;
|
||||
|
||||
Printer.EndDoc;
|
||||
|
||||
except
|
||||
on E:Exception do
|
||||
begin
|
||||
Printer.Abort;
|
||||
Application.MessageBox(pChar(e.message),'Error',mb_iconhand);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.UpdatePrinterInfo;
|
||||
@ -315,8 +372,7 @@ end;
|
||||
|
||||
procedure TForm1.btnDirectPrintClick(Sender: TObject);
|
||||
begin
|
||||
PrintSamplePage;
|
||||
UpdatePrinterInfo;
|
||||
PrintTest;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button5Click(Sender: TObject);
|
||||
@ -400,7 +456,7 @@ var
|
||||
begin
|
||||
rowCount := SGrid.RowCount;
|
||||
if SGrid.FixedRows=1 then
|
||||
SGrid.RowHeights[0] := Button1.Height;
|
||||
SGrid.RowHeights[0] := btnTPrintDialog.Height;
|
||||
UpdatePrinterInfo;
|
||||
end;
|
||||
|
||||
@ -415,6 +471,7 @@ var
|
||||
s,x : String;
|
||||
begin
|
||||
PD.Title := txtPrintDialogTitle.Text;
|
||||
PD.PrintToFile := false;
|
||||
if PD.Execute then
|
||||
begin
|
||||
UpdatePrinterInfo;
|
||||
@ -424,7 +481,7 @@ begin
|
||||
if PD.PrintRange=prSelection then x :='Selection,';
|
||||
if PD.PrintToFile then x := x + ' ,PrintToFile,';
|
||||
if withSample then
|
||||
PrintSamplePage
|
||||
PrintTest
|
||||
else begin
|
||||
s := Format(x + ' From : %d to %d,Copies:%d',[PD.FromPage,PD.ToPage,PD.Copies]);
|
||||
Application.MessageBox(pChar(s),'Info',mb_iconinformation);
|
||||
@ -432,7 +489,19 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
procedure TForm1.PrintTest;
|
||||
begin
|
||||
case comboTests.ItemIndex of
|
||||
1:
|
||||
PrintSamplePage(true);
|
||||
2:
|
||||
PrintMultiPage;
|
||||
else
|
||||
PrintSamplePage(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.btnTPrintDialogClick(Sender: TObject);
|
||||
begin
|
||||
doPrintDialog(false);
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user