paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 10:19:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

Printers: rulers sample page for dialogs sample

Browse Source 
git-svn-id: trunk@62462 -
This commit is contained in:
jesus 2019-12-29 22:35:48 +00:00
parent 650b991e87
commit 47248e1066
3 changed files with 140 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
components/printers/samples/dialogs/frmselprinter.lfm
View File

@ -1,7 +1,7 @@
object Form1: TForm1 object Form1: TForm1
Left = 106 Left = 106
Height = 787 Height = 787
Top = 121 Top = 50
Width = 489 Width = 489
ActiveControl = Button7 ActiveControl = Button7
Caption = 'Form1' Caption = 'Form1'
@ -9,12 +9,12 @@ object Form1: TForm1
ClientWidth = 489 ClientWidth = 489
OnCreate = FormCreate OnCreate = FormCreate
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '1.9.0.0' LCLVersion = '2.1.0.0'
object Label1: TLabel object Label1: TLabel
Left = 12 Left = 12
Height = 15 Height = 16
Top = 4 Top = 4
Width = 254 Width = 292
Caption = 'This sample show how to use the printer dialogs' Caption = 'This sample show how to use the printer dialogs'
ParentColor = False ParentColor = False
end end
@ -59,7 +59,7 @@ object Form1: TForm1
MaxSize = 350 MaxSize = 350
ReadOnly = True ReadOnly = True
Title.Caption = 'Value' Title.Caption = 'Value'
Width = 345 Width = 347
end> end>
DefaultColWidth = 120 DefaultColWidth = 120
FixedCols = 0 FixedCols = 0
@ -71,7 +71,7 @@ object Form1: TForm1
OnSelectCell = SGridSelectCell OnSelectCell = SGridSelectCell
ColWidths = ( ColWidths = (
120 120
345 347
) )
end end
object Button3: TButton object Button3: TButton
@ -126,23 +126,23 @@ object Form1: TForm1
end end
object chkTestImgs: TCheckBox object chkTestImgs: TCheckBox
Left = 392 Left = 392
Height = 19 Height = 18
Top = 100 Top = 100
Width = 71 Width = 77
Caption = 'Test Imgs' Caption = 'Test Imgs'
TabOrder = 8 TabOrder = 8
end end
object chkOutputFile: TCheckBox object chkOutputFile: TCheckBox
Left = 195 Left = 195
Height = 19 Height = 18
Top = 27 Top = 27
Width = 79 Width = 85
Caption = 'Output File' Caption = 'Output File'
TabOrder = 9 TabOrder = 9
end end
object txtOutputFile: TFileNameEdit object txtOutputFile: TFileNameEdit
Left = 195 Left = 195
Height = 23 Height = 22
Top = 48 Top = 48
Width = 261 Width = 261
DialogKind = dkSave DialogKind = dkSave
@ -157,25 +157,25 @@ object Form1: TForm1
end end
object Label2: TLabel object Label2: TLabel
Left = 61 Left = 61
Height = 15 Height = 16
Top = 192 Top = 192
Width = 103 Width = 120
Alignment = taRightJustify Alignment = taRightJustify
Caption = 'PageSetupDlg Title:' Caption = 'PageSetupDlg Title:'
ParentColor = False ParentColor = False
end end
object Label3: TLabel object Label3: TLabel
Left = 49 Left = 49
Height = 15 Height = 16
Top = 212 Top = 212
Width = 112 Width = 130
Alignment = taRightJustify Alignment = taRightJustify
Caption = 'PrinterSetupDlg Title:' Caption = 'PrinterSetupDlg Title:'
ParentColor = False ParentColor = False
end end
object txtPageSetupDlgTitle: TEdit object txtPageSetupDlgTitle: TEdit
Left = 202 Left = 202
Height = 23 Height = 22
Top = 188 Top = 188
Width = 275 Width = 275
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
@ -184,7 +184,7 @@ object Form1: TForm1
end end
object txtPrinterSetupDlgTitle: TEdit object txtPrinterSetupDlgTitle: TEdit
Left = 202 Left = 202
Height = 23 Height = 22
Top = 212 Top = 212
Width = 275 Width = 275
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
@ -193,16 +193,16 @@ object Form1: TForm1
end end
object Label4: TLabel object Label4: TLabel
Left = 78 Left = 78
Height = 15 Height = 16
Top = 236 Top = 236
Width = 88 Width = 100
Alignment = taRightJustify Alignment = taRightJustify
Caption = 'PrintDialog Title:' Caption = 'PrintDialog Title:'
ParentColor = False ParentColor = False
end end
object txtPrintDialogTitle: TEdit object txtPrintDialogTitle: TEdit
Left = 202 Left = 202
Height = 23 Height = 22
Top = 236 Top = 236
Width = 275 Width = 275
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
@ -240,82 +240,85 @@ object Form1: TForm1
end end
object comboTests: TComboBox object comboTests: TComboBox
Left = 200 Left = 200
Height = 23 Height = 20
Top = 120 Top = 120
Width = 272 Width = 272
ItemHeight = 15 ItemHeight = 26
ItemIndex = 0
Items.Strings = ( Items.Strings = (
'Single Page' 'Single Page'
'Single Page with Images' 'Single Page with Images'
'Multi-Page' 'Multi-Page'
'Multipage with paper changes' 'Multipage with paper changes'
'Rulers'
) )
OnSelect = comboTestsSelect OnSelect = comboTestsSelect
Style = csDropDownList Style = csDropDownList
TabOrder = 17 TabOrder = 17
Text = 'Single Page'
end end
object Label5: TLabel object Label5: TLabel
Left = 202 Left = 202
Height = 15 Height = 16
Top = 104 Top = 104
Width = 29 Width = 36
Caption = 'Tests:' Caption = 'Tests:'
ParentColor = False ParentColor = False
end end
object chkAsSheet: TCheckBox object chkAsSheet: TCheckBox
Left = 360 Left = 360
Height = 19 Height = 18
Hint = 'Cocoa Only:'#10'Attach the dialogs to the main form:'#10'use the dialogs AttachTo property'#10'to select the target formulary.' Hint = 'Cocoa Only:'#10'Attach the dialogs to the main form:'#10'use the dialogs AttachTo property'#10'to select the target formulary.'
Top = 4 Top = 4
Width = 65 Width = 73
Caption = 'As Sheet' Caption = 'As Sheet'
Enabled = False Enabled = False
TabOrder = 18 TabOrder = 18
end end
object cbPrinters: TComboBox object cbPrinters: TComboBox
Left = 202 Left = 202
Height = 23 Height = 20
Top = 264 Top = 264
Width = 275 Width = 275
ItemHeight = 15 ItemHeight = 19
OnSelect = cbPrintersSelect OnSelect = cbPrintersSelect
TabOrder = 19 TabOrder = 19
Text = 'cbPrinters' Text = 'cbPrinters'
end end
object cbPapers: TComboBox object cbPapers: TComboBox
Left = 202 Left = 202
Height = 23 Height = 20
Top = 288 Top = 288
Width = 275 Width = 275
ItemHeight = 15 ItemHeight = 19
OnSelect = cbPapersSelect OnSelect = cbPapersSelect
TabOrder = 20 TabOrder = 20
Text = 'cbPapers' Text = 'cbPapers'
end end
object Label6: TLabel object Label6: TLabel
Left = 1 Left = 1
Height = 15 Height = 16
Top = 264 Top = 264
Width = 153 Width = 175
Alignment = taRightJustify Alignment = taRightJustify
Caption = 'Programmatically set printer:' Caption = 'Programmatically set printer:'
ParentColor = False ParentColor = False
end end
object Label7: TLabel object Label7: TLabel
Left = 8 Left = 8
Height = 15 Height = 16
Top = 288 Top = 288
Width = 148 Width = 170
Alignment = taRightJustify Alignment = taRightJustify
Caption = 'Programmatically set paper:' Caption = 'Programmatically set paper:'
ParentColor = False ParentColor = False
end end
object chkNativeDlg: TCheckBox object chkNativeDlg: TCheckBox
Left = 360 Left = 360
Height = 19 Height = 18
Hint = 'Cocoa Only: '#10'Checked State: (default) Use the native cocoa look with print preview.'#10'Uncheck State: Use a dialog without print preview.'#10#10'By default the sistem uses the native look, to force the old look'#10'turn the print dialog option poBeforeBeginDoc on' Hint = 'Cocoa Only: '#10'Checked State: (default) Use the native cocoa look with print preview.'#10'Uncheck State: Use a dialog without print preview.'#10#10'By default the sistem uses the native look, to force the old look'#10'turn the print dialog option poBeforeBeginDoc on'
Top = 22 Top = 22
Width = 91 Width = 98
Caption = 'Native Dialog' Caption = 'Native Dialog'
Checked = True Checked = True
Enabled = False Enabled = False
@ -326,8 +329,8 @@ object Form1: TForm1
end end
object PSD: TPrinterSetupDialog object PSD: TPrinterSetupDialog
Title = 'Testing dialog title' Title = 'Testing dialog title'
Left = 172 left = 172
Top = 452 top = 452
end end
object PD: TPrintDialog object PD: TPrintDialog
Title = 'Testing title' Title = 'Testing title'
@ -338,16 +341,16 @@ object Form1: TForm1
Options = [poPrintToFile, poPageNums, poSelection, poWarning, poHelp] Options = [poPrintToFile, poPageNums, poSelection, poWarning, poHelp]
PrintToFile = True PrintToFile = True
ToPage = 1 ToPage = 1
Left = 172 left = 172
Top = 484 top = 484
end end
object PopupMenu1: TPopupMenu object PopupMenu1: TPopupMenu
Left = 212 left = 212
Top = 452 top = 452
end end
object PAGED: TPageSetupDialog object PAGED: TPageSetupDialog
Title = 'Ustawienie strony raportu' Title = 'Ustawienie strony raportu'
Left = 172 left = 172
Top = 516 top = 516
end end
end end

88
components/printers/samples/dialogs/frmselprinter.pas
View File

@ -91,6 +91,7 @@ type
procedure PrintSamplePage(PrintImgs:boolean); procedure PrintSamplePage(PrintImgs:boolean);
procedure PrintMultiPage; procedure PrintMultiPage;
procedure PrintMultiPageMultiPaper; procedure PrintMultiPageMultiPaper;
procedure PrintRulersPage;
procedure PrintTest; procedure PrintTest;
public public
@ -370,6 +371,91 @@ begin
end; end;
procedure TForm1.PrintRulersPage;
const
LONG_LINE = 3.0;
MID_LINE = 2.1;
SMALL_LINE = 1.3;
var
pgw, pgh, oldFontSize: Integer;
h, w: Double;
oldStyle: TBrushStyle;
ts: TSize;
procedure DrawVertRuler(x: double);
var
y: double;
lSize: double;
begin
Printer.Canvas.Line(mm(x), 0, mm(x), mm(h));
y := 0.0;
Printer.Canvas.TextOut( MM(x - LONG_LINE) - ts.cx - 3, MM(y) - ts.cy div 2, format('%3.0f',[y]));
while y<h do begin
if trunc(y) mod 10 = 0 then lSize := LONG_LINE else
if trunc(y) mod 5 = 0 then lSize := MID_LINE
else lSize := SMALL_LINE;
Printer.Canvas.Line( MM(x - lSize), MM(y), MM(x + lSize)+1, MM(y) );
y := y + 1.0;
if trunc(y) mod 10 = 0 then
Printer.Canvas.TextOut( MM(x - lSize) - ts.cx - 3, MM(y) - ts.cy div 2, format('%3.0f',[y]));
end;
end;
procedure DrawHorzRuler(y: double);
var
x: double;
lSize: double;
begin
Printer.Canvas.Line(0, mm(y), mm(w), mm(y));
x := 0.0;
Printer.Canvas.TextOut( MM(x) - ts.cx div 2, MM(y + LONG_LINE) + ts.cy + 3, format('%3.0f',[x]));
while x<w do begin
if trunc(x) mod 10 = 0 then lSize := LONG_LINE else
if trunc(x) mod 5 = 0 then lSize := MID_LINE
else lSize := SMALL_LINE;
Printer.Canvas.Line( MM(x), MM(y - lSize), MM(x), MM(y + lSize)+1);
x := x + 1.0;
if trunc(x) mod 10 = 0 then
Printer.Canvas.TextOut( MM(x) - ts.cx div 2, MM(y + LONG_LINE) + 3, format('%3.0f',[x]));
end;
end;
begin
try
Printer.Title := 'printers4lazarus Rulers sample page';
if chkOutputFile.Checked then
Printer.FileName := txtOutputFile.FileName
else
Printer.FileName := '';
Printer.BeginDoc;
// for testing high resolution printing, where available.
Printer.Canvas.Font.Size := 6;
Printer.Canvas.Font.Color := clBlack;
Printer.Canvas.Brush.Style := bsClear;
Printer.Canvas.Pen.Width := 1;
Printer.Canvas.Pen.Color := clBlack;
pgw := Printer.PageWidth;
pgh := Printer.PageHeight;
h := pgh*25.4/Printer.YDPI;
w := pgw*25.4/Printer.XDPI;
ts := Printer.Canvas.TextExtent('000');
DrawVertRuler( w/2 );
DrawHorzRuler( h/2 );
Printer.EndDoc;
except
on E:Exception do
begin
Printer.Abort;
Application.MessageBox(pChar(e.message),'Error',mb_iconhand);
end;
end;
UpdatePrinterInfo;
end;
procedure TForm1.UpdatePrinterInfo; procedure TForm1.UpdatePrinterInfo;
var var
i: Integer; i: Integer;
@ -606,6 +692,8 @@ begin
PrintMultiPage; PrintMultiPage;
3: 3:
PrintMultiPageMultiPaper; PrintMultiPageMultiPaper;
4:
PrintRulersPage;
else else
PrintSamplePage(false); PrintSamplePage(false);
end; end;

9
components/printers/samples/dialogs/selectprinter.lpi
View File

@ -1,15 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="11"/> <Version Value="12"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<Flags> <Flags>
<SaveClosedFiles Value="False"/> <SaveClosedFiles Value="False"/>
<LRSInOutputDirectory Value="False"/> <LRSInOutputDirectory Value="False"/>
<CompatibilityMode Value="True"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="selectprinter"/> <Title Value="selectprinter"/>
</General> </General>
<BuildModes Count="4"> <BuildModes Count="4">
@ -71,6 +71,7 @@
<Linking> <Linking>
<Debugging> <Debugging>
<DebugInfoType Value="dsDwarf2"/> <DebugInfoType Value="dsDwarf2"/>
<UseExternalDbgSyms Value="True"/>
</Debugging> </Debugging>
<Options> <Options>
<Win32> <Win32>
@ -128,13 +129,13 @@
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <local>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local> </local>
<FormatVersion Value="2"/> <FormatVersion Value="2"/>
<Modes Count="1"> <Modes Count="1">
<Mode0 Name="default"> <Mode0 Name="default">
<local> <local>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local> </local>
</Mode0> </Mode0>
</Modes> </Modes>