paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 07:58:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazReport: Support for custom paper sizes.

Browse Source 
git-svn-id: trunk@63931 -
This commit is contained in:
jesus 2020-09-28 01:10:36 +00:00
parent 95f3ddc9cd
commit ebc3a1947b
20 changed files with 280 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/lazreport/source/languages/lr_const.cs.po
View File

@ -2326,6 +2326,10 @@ msgstr "Nepoužívat"
msgid "&Height, mm"
msgstr "Výška, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "Na šířku"

4
components/lazreport/source/languages/lr_const.de.po
View File

@ -2323,6 +2323,10 @@ msgstr "&Nicht definiert"
msgid "&Height, mm"
msgstr "&Höhe, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "&Querformat"

4
components/lazreport/source/languages/lr_const.es.po
View File

@ -2316,6 +2316,10 @@ msgstr "&No usar"
msgid "&Height, mm"
msgstr "&Altura, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr "Tamaño de papel personalizado no válido"
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "&Horizontal"

4
components/lazreport/source/languages/lr_const.fr.po
View File

@ -2314,6 +2314,10 @@ msgstr "&Ne pas utiliser"
msgid "&Height, mm"
msgstr "&Hauteur, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "Pa&ysage"

4
components/lazreport/source/languages/lr_const.hu.po
View File

@ -2313,6 +2313,10 @@ msgstr "Ne használja"
msgid "&Height, mm"
msgstr "Magasság, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "Tájkép"

4
components/lazreport/source/languages/lr_const.id.po
View File

@ -2378,6 +2378,10 @@ msgstr "Jan&gan pakai"
msgid "&Height, mm"
msgstr "&Tinggi, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "Membentan&g"

4
components/lazreport/source/languages/lr_const.it.po
View File

@ -2317,6 +2317,10 @@ msgstr "&Non usare"
msgid "&Height, mm"
msgstr "&Altezza, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "&Orizzontale"

4
components/lazreport/source/languages/lr_const.lt.po
View File

@ -2316,6 +2316,10 @@ msgstr "Nenau&doti"
msgid "&Height, mm"
msgstr "&Aukštis, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "&Gulsčias"

4
components/lazreport/source/languages/lr_const.pl.po
View File

@ -2322,6 +2322,10 @@ msgstr "&Nie używaj"
msgid "&Height, mm"
msgstr "&Wysokość, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "&Poziomo"

4
components/lazreport/source/languages/lr_const.pot
View File

@ -2306,6 +2306,10 @@ msgstr ""
msgid "&Height, mm"
msgstr ""
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr ""

4
components/lazreport/source/languages/lr_const.pt_BR.po
View File

@ -2313,6 +2313,10 @@ msgstr "&Não usar"
msgid "&Height, mm"
msgstr "&Altura, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "&Paisagem"

4
components/lazreport/source/languages/lr_const.ru.po
View File

@ -2313,6 +2313,10 @@ msgstr "&Не использовать"
msgid "&Height, mm"
msgstr "&Высота, мм"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "&Альбомная"

4
components/lazreport/source/languages/lr_const.tr.po
View File

@ -2325,6 +2325,10 @@ msgstr "&Kullanma"
msgid "&Height, mm"
msgstr "&Yükseklik, mm"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr ""

4
components/lazreport/source/languages/lr_const.uk.po
View File

@ -2315,6 +2315,10 @@ msgstr "Н&е використовувати"
msgid "&Height, mm"
msgstr "Ви&сота, мм"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr "&Альбомна"

4
components/lazreport/source/languages/lr_const.zh_CN.po
View File

@ -2314,6 +2314,10 @@ msgstr "不使用(&D)"
msgid "&Height, mm"
msgstr "高,mm(&H)"
#: lr_const.spgoptforminvalidcustompapersize
msgid "Invalid custom paper size"
msgstr ""
#: lr_const.spgoptformland
msgid "&Landscape"
msgstr ""

1
components/lazreport/source/lr_const.pas
View File

@ -61,6 +61,7 @@ resourcestring
sPgoptFormLayoutOrder = 'Layout Order';
sPgoptFormByColumns = 'By Colum&ns';
sPgoptFormByRows = 'By Row&s';
sPgoptFormInvalidCustomPaperSize = 'Invalid custom paper size';
//--- EditorForm resources ----------------------------------------------------
sEditorFormCapt = 'Text editor';

14
components/lazreport/source/lr_desgn.pas
View File

@ -6459,14 +6459,14 @@ begin
RB1.Checked := True
else
RB2.Checked := True;
ComB1.Items := Prn.PaperNames;
ComB1.ItemIndex := Prn.GetArrayPos(pgSize);
Prn.FillPapers(COMB1.Items);
ComB1.ItemIndex := COMB1.Items.IndexOfObject(TObject(PtrInt(pgSize)));
E1.Text := ''; E2.Text := '';
if pgSize = $100 then
begin
E1.Text := IntToStr(Width div 10);
E2.Text := IntToStr(Height div 10);
PaperWidth := round(Width * 25.4 / 72); // pt to mm
PaperHeight := round(Height * 25.4 / 72); // pt to mm
end;
E3.Text := PointsToMMStr(Margins.Left);
@ -6497,12 +6497,12 @@ begin
else
LayoutOrder := loRows;
p := Prn.PaperSizes[ComB1.ItemIndex];
p := frPgoptForm.pgSize;
w := 0; h := 0;
if p = $100 then
try
w := StrToInt(E1.Text) * 10;
h := StrToInt(E2.Text) * 10;
w := round(PaperWidth * 72 / 25.4); // mm to pt
h := round(PaperHeight * 72 / 25.4); // mm to pt
except
on exception do p := 9; // A4
end;

195
components/lazreport/source/lr_pgopt.lfm
View File

@ -8,13 +8,14 @@ object frPgoptForm: TfrPgoptForm
ClientHeight = 336
ClientWidth = 467
OnActivate = FormActivate
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
Position = poScreenCenter
ShowHint = True
LCLVersion = '0.9.29'
LCLVersion = '2.1.0.0'
object PageControl1: TPageControl
Left = 0
Height = 286
Height = 290
Top = 0
Width = 467
ActivePage = TabSheet1
@ -23,16 +24,16 @@ object frPgoptForm: TfrPgoptForm
TabOrder = 0
object TabSheet1: TTabSheet
Caption = 'Paper'
ClientHeight = 253
ClientWidth = 461
ClientHeight = 262
ClientWidth = 459
object GroupBox2: TGroupBox
AnchorSideTop.Control = TabSheet1
AnchorSideRight.Control = TabSheet1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = TabSheet1
AnchorSideBottom.Side = asrBottom
Left = 264
Height = 241
Left = 262
Height = 250
Top = 6
Width = 191
Anchors = [akTop, akRight, akBottom]
@ -40,15 +41,15 @@ object frPgoptForm: TfrPgoptForm
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
Caption = 'Orientation'
ClientHeight = 225
ClientWidth = 189
ClientHeight = 230
ClientWidth = 187
TabOrder = 0
object imgLandScape: TImage
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 151
Left = 149
Height = 26
Top = 100
Top = 103
Width = 32
Anchors = [akRight]
AutoSize = True
@ -90,9 +91,9 @@ object frPgoptForm: TfrPgoptForm
object imgPortrait: TImage
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 157
Left = 155
Height = 32
Top = 97
Top = 100
Width = 26
Anchors = [akRight]
AutoSize = True
@ -136,45 +137,42 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Control = GroupBox2
AnchorSideTop.Side = asrCenter
Left = 3
Height = 50
Top = 87
Width = 99
Height = 44
Top = 93
Width = 82
AutoSize = True
BorderSpacing.Left = 3
BevelOuter = bvNone
ClientHeight = 50
ClientWidth = 99
ClientHeight = 44
ClientWidth = 82
TabOrder = 0
object RB1: TRadioButton
AnchorSideTop.Control = Panel1
Left = 6
Height = 22
Height = 19
Top = 0
Width = 71
Width = 59
HelpContext = 111
AllowGrayed = True
BorderSpacing.Left = 6
Caption = '&Portrait'
Checked = True
OnClick = RB1Click
State = cbChecked
TabOrder = 0
TabStop = True
end
object RB2: TRadioButton
AnchorSideLeft.Control = RB1
AnchorSideTop.Control = RB1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 22
Top = 28
Width = 93
Height = 19
Top = 25
Width = 76
HelpContext = 120
AllowGrayed = True
BorderSpacing.Top = 6
Caption = '&Landscape'
OnClick = RB2Click
TabOrder = 1
TabStop = False
end
end
end
@ -185,25 +183,25 @@ object frPgoptForm: TfrPgoptForm
AnchorSideBottom.Control = TabSheet1
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 241
Height = 250
Top = 6
Width = 252
Width = 250
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Top = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
Caption = 'Size'
ClientHeight = 225
ClientWidth = 250
ClientHeight = 230
ClientWidth = 246
TabOrder = 1
object Label1: TLabel
AnchorSideBottom.Control = E1
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 16
Top = 55
Width = 70
Height = 15
Top = 51
Width = 60
Anchors = [akLeft, akBottom]
Caption = '&Width, mm'
FocusControl = E1
@ -213,9 +211,9 @@ object frPgoptForm: TfrPgoptForm
AnchorSideBottom.Control = E2
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 16
Top = 82
Width = 77
Height = 15
Top = 80
Width = 64
Anchors = [akLeft, akBottom]
Caption = '&Height, mm'
FocusControl = E2
@ -226,17 +224,17 @@ object frPgoptForm: TfrPgoptForm
AnchorSideRight.Control = GroupBox3
AnchorSideRight.Side = asrBottom
Left = 6
Height = 29
Height = 22
Top = 15
Width = 238
Width = 234
HelpContext = 130
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Right = 6
ItemHeight = 16
ItemWidth = 200
OnClick = ComB1Click
OnDrawItem = ComB1DrawItem
OnSelect = ComB1Select
Style = csOwnerDrawFixed
TabOrder = 0
end
@ -245,13 +243,14 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox3
AnchorSideRight.Side = asrBottom
Left = 170
Height = 21
Top = 50
Left = 166
Height = 23
Top = 43
Width = 74
HelpContext = 140
Anchors = [akTop, akRight]
BorderSpacing.Around = 6
OnChange = E1Change
TabOrder = 1
end
object E2: TEdit
@ -259,21 +258,22 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox3
AnchorSideRight.Side = asrBottom
Left = 170
Height = 21
Top = 77
Left = 166
Height = 23
Top = 72
Width = 74
HelpContext = 150
Anchors = [akTop, akRight]
BorderSpacing.Around = 6
OnChange = E1Change
TabOrder = 2
end
end
end
object TabSheet3: TTabSheet
Caption = 'Options'
ClientHeight = 253
ClientWidth = 461
ClientHeight = 262
ClientWidth = 459
object GroupBox1: TGroupBox
AnchorSideLeft.Control = TabSheet3
AnchorSideTop.Control = TabSheet3
@ -287,14 +287,14 @@ object frPgoptForm: TfrPgoptForm
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
Caption = 'Options'
ClientHeight = 36
ClientWidth = 214
ClientHeight = 32
ClientWidth = 212
TabOrder = 0
object CB1: TCheckBox
Left = 6
Height = 19
Top = 6
Width = 171
Width = 136
HelpContext = 160
Caption = '&Print to previous page'
TabOrder = 0
@ -307,24 +307,24 @@ object frPgoptForm: TfrPgoptForm
AnchorSideBottom.Control = TabSheet3
AnchorSideBottom.Side = asrBottom
Left = 228
Height = 241
Height = 250
Top = 6
Width = 229
Width = 225
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
Caption = 'Columns'
ClientHeight = 225
ClientWidth = 227
ClientHeight = 230
ClientWidth = 221
TabOrder = 1
object Label7: TLabel
AnchorSideLeft.Control = GroupBox5
AnchorSideTop.Control = GroupBox5
Left = 0
Height = 18
Height = 15
Top = 0
Width = 68
Width = 44
Caption = '&Number'
ParentColor = False
end
@ -333,9 +333,9 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Control = ecolCount
AnchorSideTop.Side = asrBottom
Left = 0
Height = 18
Top = 57
Width = 130
Height = 15
Top = 50
Width = 94
Caption = '&Column gap, mm'
FocusControl = E7
ParentColor = False
@ -345,9 +345,9 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Control = E7
AnchorSideTop.Side = asrBottom
Left = 6
Height = 18
Top = 116
Width = 89
Height = 15
Top = 100
Width = 69
BorderSpacing.Around = 6
Caption = 'Layout Order'
ParentColor = False
@ -403,8 +403,8 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox5
Left = 6
Height = 29
Top = 81
Height = 23
Top = 71
Width = 127
HelpContext = 180
BorderSpacing.Around = 6
@ -415,8 +415,8 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Control = Label7
AnchorSideTop.Side = asrBottom
Left = 6
Height = 27
Top = 24
Height = 23
Top = 21
Width = 127
BorderSpacing.Around = 6
OnChange = ecolCountChange
@ -428,15 +428,15 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Side = asrBottom
Left = 12
Height = 19
Top = 140
Width = 102
Top = 121
Width = 84
BorderSpacing.Around = 6
Caption = 'By Colum&ns'
Checked = True
Enabled = False
OnClick = RBColumnsClick
State = cbChecked
TabOrder = 2
TabStop = True
end
object RBRows: TRadioButton
AnchorSideLeft.Control = lblLayout
@ -444,14 +444,13 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Side = asrBottom
Left = 12
Height = 19
Top = 165
Width = 78
Top = 146
Width = 64
BorderSpacing.Around = 6
Caption = 'By Row&s'
Enabled = False
OnClick = RBRowsClick
TabOrder = 3
TabStop = False
end
end
object GroupBox4: TGroupBox
@ -462,23 +461,23 @@ object frPgoptForm: TfrPgoptForm
AnchorSideBottom.Control = TabSheet3
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 183
Height = 192
Top = 64
Width = 216
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6
Caption = 'Page margins'
ClientHeight = 167
ClientWidth = 214
ClientHeight = 172
ClientWidth = 212
TabOrder = 2
object Label3: TLabel
AnchorSideTop.Control = CB5
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 108
Height = 18
Height = 15
Top = 27
Width = 72
Width = 48
BorderSpacing.Left = 6
Caption = '&Left, mm'
ParentColor = False
@ -489,9 +488,9 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 14
Height = 18
Height = 15
Top = 27
Width = 72
Width = 47
BorderSpacing.Left = 6
Caption = '&Top, mm'
ParentColor = False
@ -502,9 +501,9 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 14
Height = 18
Top = 86
Width = 83
Height = 15
Top = 77
Width = 56
Caption = '&Right, mm'
ParentColor = False
end
@ -514,9 +513,9 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 108
Height = 18
Top = 86
Width = 98
Height = 15
Top = 77
Width = 68
Caption = '&Bottom, mm'
ParentColor = False
end
@ -525,7 +524,7 @@ object frPgoptForm: TfrPgoptForm
Left = 8
Height = 19
Top = 2
Width = 87
Width = 70
HelpContext = 62
BorderSpacing.Around = 6
Caption = '&Don''t use'
@ -537,8 +536,8 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
Left = 114
Height = 29
Top = 51
Height = 23
Top = 48
Width = 64
HelpContext = 72
BorderSpacing.Around = 6
@ -549,8 +548,8 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Control = Label4
AnchorSideTop.Side = asrBottom
Left = 20
Height = 29
Top = 51
Height = 23
Top = 48
Width = 64
HelpContext = 81
BorderSpacing.Around = 6
@ -561,8 +560,8 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Control = Label5
AnchorSideTop.Side = asrBottom
Left = 20
Height = 29
Top = 110
Height = 23
Top = 98
Width = 64
HelpContext = 91
BorderSpacing.Around = 6
@ -573,8 +572,8 @@ object frPgoptForm: TfrPgoptForm
AnchorSideTop.Control = Label6
AnchorSideTop.Side = asrBottom
Left = 114
Height = 29
Top = 110
Height = 23
Top = 98
Width = 64
HelpContext = 101
BorderSpacing.Around = 6
@ -585,14 +584,18 @@ object frPgoptForm: TfrPgoptForm
end
object ButtonPanel1: TButtonPanel
Left = 6
Height = 38
Top = 292
Height = 34
Top = 296
Width = 455
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CloseButton.Enabled = False
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 1
ShowButtons = [pbOK, pbCancel, pbHelp]
end

82
components/lazreport/source/lr_pgopt.pas
View File

@ -17,7 +17,7 @@ interface
uses
Classes, SysUtils, LResources,
Forms, Controls, Graphics, Dialogs,
ExtCtrls, Buttons, StdCtrls,ComCtrls,LCLType, ButtonPanel, Spin;
ExtCtrls, Buttons, StdCtrls,ComCtrls,LCLType, ButtonPanel, Spin, Printers;
type
@ -64,20 +64,28 @@ TfrPgoptForm = class(TForm)
Label8: TLabel;
procedure ComB1DrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
State: TOwnerDrawState);
procedure ComB1Select(Sender: TObject);
procedure E1Change(Sender: TObject);
procedure ecolCountChange(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure RB1Click(Sender: TObject);
procedure RB2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure ComB1Click(Sender: TObject);
procedure CB5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RBColumnsClick(Sender: TObject);
procedure RBRowsClick(Sender: TObject);
private
{ Private declarations }
FCustomWidth, FCustomHeight: Integer;
function GetPgSize: Integer;
procedure UpdateColumnsLayout;
procedure UpdatePaperSize;
public
{ Public declarations }
property PgSize: Integer read GetPgSize;
property PaperWidth: Integer read FCustomWidth write FCustomWidth;
property PaperHeight: Integer read FCustomHeight write FCustomHeight;
end;
var
@ -117,24 +125,46 @@ begin
Canvas.FillRect(aRect);
i := PtrInt(Items.Objects[Index]);
if (i>=1)and(i<=MAX_TYP_KNOWN) then S := 'W' else // Known Windows std paper size
if (i>MAX_TYP_KNOWN)and (i<256) then S:='w' else // Unkknown Windows std paper size
if (i=256) then S:='U' else // User Defined paper size
if (i>=2000) then S:='I' else // Looks like an Input Slot
if (i>=1000) then S:='C' // Known Custom No-Std Paper Size
else
S:='?'; // unknown unclassified paper size
if (i>=1)and(i<=MAX_TYP_KNOWN) then S := 'W' else // Known Windows std paper size
if (i>MAX_TYP_KNOWN) and (i<256) then S := 'w' else // Unknown Windows std paper size
if (i=256) then S := 'U' else // User Defined paper size
if (i>=2000) and (i<2050) then S := 'I' // Looks like an Input Slot
else S := 'C'; // Known Custom No-Std Paper Size
Canvas.Font.Color := clWindowText;
Canvas.TextRect(aRect, aRect.Left+1, aRect.Top+3, S);
end;
end;
procedure TfrPgoptForm.ComB1Select(Sender: TObject);
begin
UpdatePaperSize;
end;
procedure TfrPgoptForm.E1Change(Sender: TObject);
begin
if pgSize=256 then begin
if Sender=E1 then FCustomWidth := StrToIntDef(E1.Text, 0);
if Sender=E2 then FCustomHeight := StrToIntDef(E2.Text, 0);
end;
end;
procedure TfrPgoptForm.ecolCountChange(Sender: TObject);
begin
UpdateColumnsLayout;
end;
procedure TfrPgoptForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if (ModalResult=mrOk) and (PgSize=256) then
begin
canClose := (PaperWidth>1) and (PaperHeight>1);
if not canClose then
ShowMessage(sPgoptFormInvalidCustomPaperSize);
end;
end;
procedure TfrPgoptForm.RB2Click(Sender: TObject);
begin
ImgLandscape.Show;
@ -148,7 +178,7 @@ begin
RB1Click(nil)
else
RB2Click(nil);
ComB1Click(nil);
UpdatePaperSize;
CB5Click(nil);
ComB1.Width:=E1.Width;
@ -160,12 +190,6 @@ begin
UpdateColumnsLayout;
end;
procedure TfrPgoptForm.ComB1Click(Sender: TObject);
begin
frEnableControls([Label1, Label2, E1, E2],
Prn.PaperSizes[ComB1.ItemIndex] = $100);
end;
procedure TfrPgoptForm.CB5Click(Sender: TObject);
begin
frEnableControls([Label3, Label4, Label5, Label6, E3, E4, E5, E6],
@ -174,7 +198,7 @@ end;
procedure TfrPgoptForm.FormCreate(Sender: TObject);
begin
Caption := sPgoptFormCapt;
Caption := sPgoptFormCapt + ' - ' + QuotedStr(prn.Printer.PrinterName);
TabSheet1.Caption := sPgoptFormPaper;
GroupBox2.Caption := sPgoptFormOr;
RB1.Caption := sPgoptFormPort;
@ -211,6 +235,11 @@ begin
ImgRows.Visible:=true;
end;
function TfrPgoptForm.GetPgSize: Integer;
begin
result := PtrInt(ComB1.Items.Objects[Comb1.ItemIndex]);
end;
procedure TfrPgoptForm.UpdateColumnsLayout;
begin
if EColCount.Value<2 then begin
@ -222,5 +251,24 @@ begin
end;
end;
procedure TfrPgoptForm.UpdatePaperSize;
var
isCustom: Boolean;
pgIndex: Integer;
PaperRect: TPaperRect;
begin
isCustom := (pgSize = $100);
frEnableControls([Label1, Label2, E1, E2], isCustom);
if isCustom then begin
E1.Text := IntToStr(PaperWidth);
E2.Text := IntToStr(PaperHeight);
end else begin
pgIndex := prn.GetArrayPos(pgSize);
PaperRect := prn.Printer.PaperSize.PaperRectOf[prn.PaperNames[pgIndex]];
E1.Text := IntToStr(round(PaperRect.PhysicalRect.Width*25.4/prn.Printer.XDPI));
E2.Text := IntToStr(round(PaperRect.PhysicalRect.Height*25.4/prn.Printer.YDPI));
end;
end;
end.

54
components/lazreport/source/lr_prntr.pas
View File

@ -9,6 +9,7 @@
{*****************************************}
{.$define DbgPrinter}
{.$define DbgPrinter_detail}
unit LR_Prntr;
@ -46,6 +47,7 @@ type
procedure SetPrinterIndex(Value: Integer);
function GetPaperNames: TStringList;
function MatchPrinterPaper(const aWidth, aHeight: Integer): integer;
function GetPaperRect: TPaperRect;
public
Orientation: TPrinterOrientation;
PaperSize: Integer;
@ -64,6 +66,7 @@ type
function DefaultPaperIndex: Integer;
function DefaultPageSize: Integer;
function UseVirtualPrinter: boolean;
function FillPapers(list: TStrings; addCustom:boolean=true): Integer;
{$IFDEF DbgPrinter}
procedure DumpPrinterInfo;
{$ENDIF}
@ -814,7 +817,7 @@ begin
{$ENDIF}
{$IFDEF DbgPrinter_detail}
DebugLn(['Dump printer List of papers:']);
DebugLn(['Dump printer List of papers for ''',fPrinter.PrinterName,''' :']);
n := FPapernames.IndexOf(FPrinter.PaperSize.PaperName);
if n<0 then
@ -854,7 +857,7 @@ begin
end;
end;
{$ifdef DbgPrinter}
DebugLnExit(['TfrPrinter.GetSettings DONE: PrinterChanged: ', PrinterChanged]);
DebugLnExit('TfrPrinter.GetSettings DONE: Paper w=%d h=%d or=%d', [PaperWidth, PaperHeight, ord(Orientation)]);
{$endif}
end;
@ -944,7 +947,10 @@ begin
// todo: real USER custom sized papers are handled here
// requested custom paper size currently is not
// supported by printer4lazarus
DebugLn('SetCustomPaperSize REQUESTED, not yet supported...');
{$IFDEF DbgPrinter}
DebugLn('PaperSize Setting CustomPaper width=%d height=%d', [paperWidth, paperHeight]);
{$ENDIF}
FPrinter.PaperSize.PaperRect := GetPaperRect;
end else begin
// Standard paper sizes are handled here
n := -1;
@ -1146,17 +1152,41 @@ begin
result := FPrinterIndex = FDefaultPrinter;
end;
function TfrPrinter.FillPapers(list: TStrings; addCustom: boolean): Integer;
var
i, customIndex: Integer;
begin
list.BeginUpdate;
try
list.Clear;
result := FPaperNames.Count;
customIndex := -1;
for i:=0 to result-1 do
begin
if PaperSizes[i]=256 then
customIndex := i;
list.AddObject(FPaperNames[i], TObject(PtrInt(PaperSizes[i])));
end;
if addCustom and (customIndex<0) then
list.AddObject(sPaper256, TObject(PtrInt(256)));
finally
list.EndUpdate;
end;
end;
{$IFDEF DbgPrinter}
procedure TfrPrinter.DumpPrinterInfo;
begin
DbgOut(['PrinterIndex=',FPrinterIndex]);
if (FPrinters<>nil)and(FPrinters.Count>0) then begin
if FPrinters.Count>0 then begin
if FPrinterIndex>=0 then
DbgOut([' (',FPrinters[FPrinterIndex],')'])
else
DbgOut(' (no printer selected???)');
end else
DbgOut(' (no defined internal list of printers)');
DebugLn([' Is Default(Virtual) printer=',UseVirtualPrinter]);
DbgOut(' (internal list of printers is empty)');
DebugLn([' Is Virtual printer=',UseVirtualPrinter]);
if FPrinter=nil then
DebugLn('SysPrinter is nil')
else
@ -1214,11 +1244,23 @@ begin
end;
end;
function TfrPrinter.GetPaperRect: TPaperRect;
begin
result.PhysicalRect.Left := 0;
result.PhysicalRect.Top := 0;
result.PhysicalRect.Width := PaperWidth * FPrinter.XDPI div 72;
result.PhysicalRect.Height := PaperHeight * FPrinter.YDPI div 72;
result.WorkRect := result.PhysicalRect;
end;
procedure TfrPrinter.SetPrinter(Value: TPrinter);
begin
{$ifdef DbgPrinter}
DebugLnEnter('TfrPrinter.SetPrinter: INIT',[]);
DumpPrinterInfo;
DbgOut('New printer ');
if Value=nil then DebugLn('is nil')
else DebugLn('Index=%d ''%s''',[Value.PrinterIndex, Value.PrinterName]);
{$endif}
FPrinters.Clear;
FPrinterIndex := 0;