mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-11 04:48:03 +02:00
Printers: rulers sample page for dialogs sample
git-svn-id: trunk@62462 -
This commit is contained in:
jesus
parent
650b991e87
commit
47248e1066
@ -1,7 +1,7 @@
|
||||
object Form1: TForm1
|
||||
Left = 106
|
||||
Height = 787
|
||||
Top = 121
|
||||
Top = 50
|
||||
Width = 489
|
||||
ActiveControl = Button7
|
||||
Caption = 'Form1'
|
||||
@ -9,12 +9,12 @@ object Form1: TForm1
|
||||
ClientWidth = 489
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.9.0.0'
|
||||
LCLVersion = '2.1.0.0'
|
||||
object Label1: TLabel
|
||||
Left = 12
|
||||
Height = 15
|
||||
Height = 16
|
||||
Top = 4
|
||||
Width = 254
|
||||
Width = 292
|
||||
Caption = 'This sample show how to use the printer dialogs'
|
||||
ParentColor = False
|
||||
end
|
||||
@ -59,7 +59,7 @@ object Form1: TForm1
|
||||
MaxSize = 350
|
||||
ReadOnly = True
|
||||
Title.Caption = 'Value'
|
||||
Width = 345
|
||||
Width = 347
|
||||
end>
|
||||
DefaultColWidth = 120
|
||||
FixedCols = 0
|
||||
@ -71,7 +71,7 @@ object Form1: TForm1
|
||||
OnSelectCell = SGridSelectCell
|
||||
ColWidths = (
|
||||
120
|
||||
345
|
||||
347
|
||||
)
|
||||
end
|
||||
object Button3: TButton
|
||||
@ -126,23 +126,23 @@ object Form1: TForm1
|
||||
end
|
||||
object chkTestImgs: TCheckBox
|
||||
Left = 392
|
||||
Height = 19
|
||||
Height = 18
|
||||
Top = 100
|
||||
Width = 71
|
||||
Width = 77
|
||||
Caption = 'Test Imgs'
|
||||
TabOrder = 8
|
||||
end
|
||||
object chkOutputFile: TCheckBox
|
||||
Left = 195
|
||||
Height = 19
|
||||
Height = 18
|
||||
Top = 27
|
||||
Width = 79
|
||||
Width = 85
|
||||
Caption = 'Output File'
|
||||
TabOrder = 9
|
||||
end
|
||||
object txtOutputFile: TFileNameEdit
|
||||
Left = 195
|
||||
Height = 23
|
||||
Height = 22
|
||||
Top = 48
|
||||
Width = 261
|
||||
DialogKind = dkSave
|
||||
@ -157,25 +157,25 @@ object Form1: TForm1
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 61
|
||||
Height = 15
|
||||
Height = 16
|
||||
Top = 192
|
||||
Width = 103
|
||||
Width = 120
|
||||
Alignment = taRightJustify
|
||||
Caption = 'PageSetupDlg Title:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 49
|
||||
Height = 15
|
||||
Height = 16
|
||||
Top = 212
|
||||
Width = 112
|
||||
Width = 130
|
||||
Alignment = taRightJustify
|
||||
Caption = 'PrinterSetupDlg Title:'
|
||||
ParentColor = False
|
||||
end
|
||||
object txtPageSetupDlgTitle: TEdit
|
||||
Left = 202
|
||||
Height = 23
|
||||
Height = 22
|
||||
Top = 188
|
||||
Width = 275
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -184,7 +184,7 @@ object Form1: TForm1
|
||||
end
|
||||
object txtPrinterSetupDlgTitle: TEdit
|
||||
Left = 202
|
||||
Height = 23
|
||||
Height = 22
|
||||
Top = 212
|
||||
Width = 275
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -193,16 +193,16 @@ object Form1: TForm1
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 78
|
||||
Height = 15
|
||||
Height = 16
|
||||
Top = 236
|
||||
Width = 88
|
||||
Width = 100
|
||||
Alignment = taRightJustify
|
||||
Caption = 'PrintDialog Title:'
|
||||
ParentColor = False
|
||||
end
|
||||
object txtPrintDialogTitle: TEdit
|
||||
Left = 202
|
||||
Height = 23
|
||||
Height = 22
|
||||
Top = 236
|
||||
Width = 275
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -240,82 +240,85 @@ object Form1: TForm1
|
||||
end
|
||||
object comboTests: TComboBox
|
||||
Left = 200
|
||||
Height = 23
|
||||
Height = 20
|
||||
Top = 120
|
||||
Width = 272
|
||||
ItemHeight = 15
|
||||
ItemHeight = 26
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Single Page'
|
||||
'Single Page with Images'
|
||||
'Multi-Page'
|
||||
'Multipage with paper changes'
|
||||
'Rulers'
|
||||
)
|
||||
OnSelect = comboTestsSelect
|
||||
Style = csDropDownList
|
||||
TabOrder = 17
|
||||
Text = 'Single Page'
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 202
|
||||
Height = 15
|
||||
Height = 16
|
||||
Top = 104
|
||||
Width = 29
|
||||
Width = 36
|
||||
Caption = 'Tests:'
|
||||
ParentColor = False
|
||||
end
|
||||
object chkAsSheet: TCheckBox
|
||||
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.'
|
||||
Top = 4
|
||||
Width = 65
|
||||
Width = 73
|
||||
Caption = 'As Sheet'
|
||||
Enabled = False
|
||||
TabOrder = 18
|
||||
end
|
||||
object cbPrinters: TComboBox
|
||||
Left = 202
|
||||
Height = 23
|
||||
Height = 20
|
||||
Top = 264
|
||||
Width = 275
|
||||
ItemHeight = 15
|
||||
ItemHeight = 19
|
||||
OnSelect = cbPrintersSelect
|
||||
TabOrder = 19
|
||||
Text = 'cbPrinters'
|
||||
end
|
||||
object cbPapers: TComboBox
|
||||
Left = 202
|
||||
Height = 23
|
||||
Height = 20
|
||||
Top = 288
|
||||
Width = 275
|
||||
ItemHeight = 15
|
||||
ItemHeight = 19
|
||||
OnSelect = cbPapersSelect
|
||||
TabOrder = 20
|
||||
Text = 'cbPapers'
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 1
|
||||
Height = 15
|
||||
Height = 16
|
||||
Top = 264
|
||||
Width = 153
|
||||
Width = 175
|
||||
Alignment = taRightJustify
|
||||
Caption = 'Programmatically set printer:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label7: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Height = 16
|
||||
Top = 288
|
||||
Width = 148
|
||||
Width = 170
|
||||
Alignment = taRightJustify
|
||||
Caption = 'Programmatically set paper:'
|
||||
ParentColor = False
|
||||
end
|
||||
object chkNativeDlg: TCheckBox
|
||||
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'
|
||||
Top = 22
|
||||
Width = 91
|
||||
Width = 98
|
||||
Caption = 'Native Dialog'
|
||||
Checked = True
|
||||
Enabled = False
|
||||
@ -326,8 +329,8 @@ object Form1: TForm1
|
||||
end
|
||||
object PSD: TPrinterSetupDialog
|
||||
Title = 'Testing dialog title'
|
||||
Left = 172
|
||||
Top = 452
|
||||
left = 172
|
||||
top = 452
|
||||
end
|
||||
object PD: TPrintDialog
|
||||
Title = 'Testing title'
|
||||
@ -338,16 +341,16 @@ object Form1: TForm1
|
||||
Options = [poPrintToFile, poPageNums, poSelection, poWarning, poHelp]
|
||||
PrintToFile = True
|
||||
ToPage = 1
|
||||
Left = 172
|
||||
Top = 484
|
||||
left = 172
|
||||
top = 484
|
||||
end
|
||||
object PopupMenu1: TPopupMenu
|
||||
Left = 212
|
||||
Top = 452
|
||||
left = 212
|
||||
top = 452
|
||||
end
|
||||
object PAGED: TPageSetupDialog
|
||||
Title = 'Ustawienie strony raportu'
|
||||
Left = 172
|
||||
Top = 516
|
||||
left = 172
|
||||
top = 516
|
||||
end
|
||||
end
|
||||
|
||||
@ -91,6 +91,7 @@ type
|
||||
procedure PrintSamplePage(PrintImgs:boolean);
|
||||
procedure PrintMultiPage;
|
||||
procedure PrintMultiPageMultiPaper;
|
||||
procedure PrintRulersPage;
|
||||
procedure PrintTest;
|
||||
public
|
||||
|
||||
@ -370,6 +371,91 @@ begin
|
||||
|
||||
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;
|
||||
var
|
||||
i: Integer;
|
||||
@ -606,6 +692,8 @@ begin
|
||||
PrintMultiPage;
|
||||
3:
|
||||
PrintMultiPageMultiPaper;
|
||||
4:
|
||||
PrintRulersPage;
|
||||
else
|
||||
PrintSamplePage(false);
|
||||
end;
|
||||
|
||||
@ -1,15 +1,15 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<SaveClosedFiles Value="False"/>
|
||||
<LRSInOutputDirectory Value="False"/>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="selectprinter"/>
|
||||
</General>
|
||||
<BuildModes Count="4">
|
||||
@ -71,6 +71,7 @@
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf2"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
@ -128,13 +129,13 @@
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
|
||||
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="1">
|
||||
<Mode0 Name="default">
|
||||
<local>
|
||||
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
|
||||
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</Mode0>
|
||||
</Modes>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user