Author: Jonas Bilinkevicius
I am trying to put together a simple print preview program that can be used by
other programs. I am using the panel component as my printing cavas and I am having
troubles equating the screen and page ratios. Does anyone have any ideas on how I
could simplify this task or point me in the direction of a good book or give some
example code?
Answer:
1 unit printpreview;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, ComCtrls;
8
9 type
10 TForm1 = class(TForm)
11 Panel1: TPanel;
12 Panel2: TPanel;
13 PreviewPaintbox: TPaintBox;
14 Label1: TLabel;
15 Label2: TLabel;
16 LeftMarginEdit: TEdit;
17 TopMarginEdit: TEdit;
18 Label3: TLabel;
19 Label4: TLabel;
20 RightMarginEdit: TEdit;
21 Label5: TLabel;
22 BottomMarginEdit: TEdit;
23 ApplyMarginsButton: TButton;
24 OrientationRGroup: TRadioGroup;
25 Label6: TLabel;
26 ZoomEdit: TEdit;
27 ZoomUpDown: TUpDown;
28 procedure LeftMarginEditKeyPress(Sender: TObject; var Key: Char);
29 procedure FormCreate(Sender: TObject);
30 procedure PreviewPaintboxPaint(Sender: TObject);
31 procedure ApplyMarginsButtonClick(Sender: TObject);
32 private
33 { Private declarations }
34 PreviewText: string;
35 public
36 { Public declarations }
37 end;
38
39 var
40 Form1: TForm1;
41
42 implementation
43
44 uses printers;
45
46 {$R *.DFM}
47
48 procedure TForm1.LeftMarginEditKeyPress(Sender: TObject; var Key: Char);
49 begin
50 if not (Key in ['0'..'9', #9, DecimalSeparator]) then
51 Key := #0;
52 end;
53
54 procedure TForm1.FormCreate(Sender: TObject);
55 var
56 S: string;
57
58 procedure loadpreviewtext;
59 var
60 sl: TStringList;
61 begin
62 sl := TStringList.Create;
63 try
64 sl.Loadfromfile(Extractfilepath(application.exename) + 'printpreview.pas');
65 PreviewText := sl.Text;
66 finally
67 sl.free
68 end;
69 end;
70
71 begin
72 {Initialize the margin edits with a margin of 0.75 inch}
73 S := FormatFloat('0.00', 0.75);
74 LeftMarginEdit.Text := S;
75 TopMarginEdit.Text := S;
76 RightMarginEdit.Text := S;
77 BottomMarginEdit.Text := S;
78 {Initialize the orientation radio group}
79 if Printer.Orientation = poPortrait then
80 OrientationRGroup.ItemIndex := 0
81 else
82 OrientationRGroup.ItemIndex := 1;
83 {load test text for display}
84 LoadPreviewtext;
85 end;
86
87 procedure TForm1.PreviewPaintboxPaint(Sender: TObject);
88 var
89 pagewidth, pageheight: Double; {printer page dimension in inch}
90 printerResX, printerResY: Integer; {printer resolution in dots/inch}
91 minmarginX, minmarginY: Double; {nonprintable margin in inch}
92 outputarea: TRect; {print area in 1/1000 inches}
93 scale: Double; {conversion factor, pixels per 1/1000 inch}
94
95 procedure InitPrintSettings;
96 function GetMargin(S: string; inX: Boolean): Double;
97 begin
98 Result := StrToFloat(S);
99 if InX then
100 begin
101 if Result < minmarginX then
102 Result := minmarginX;
103 end
104 else
105 begin
106 if Result < minmarginY then
107 Result := minmarginY;
108 end;
109 end;
110 begin
111 printerResX := GetDeviceCaps(printer.handle, LOGPIXELSX);
112 printerResY := GetDeviceCaps(printer.handle, LOGPIXELSY);
113 pagewidth := GetDeviceCaps(printer.handle, PHYSICALWIDTH) / printerResX;
114 pageheight := GetDeviceCaps(printer.handle, PHYSICALHEIGHT) / printerResY;
115 minmarginX := GetDeviceCaps(printer.handle, PHYSICALOFFSETX) / printerResX;
116 minmarginY := GetDeviceCaps(printer.handle, PHYSICALOFFSETY) / printerResY;
117 outputarea.Left := Round(GetMargin(LeftMarginEdit.Text, true) * 1000);
118 outputarea.Top := Round(GetMargin(TopMarginEdit.Text, false) * 1000);
119 outputarea.Right := Round((pagewidth - GetMargin(RightMarginEdit.Text, true)) *
120 1000);
121 outputarea.Bottom := Round((pageheight - GetMargin(BottomMarginEdit.Text,
122 false))
123 * 1000);
124 end;
125
126 procedure ScaleCanvas(Canvas: TCanvas; widthavail, heightavail: Integer);
127 var
128 needpixelswidth, needpixelsheight: Integer;
129 {dimensions of preview at current zoom factor in pixels}
130 orgpixels: TPoint;
131 {origin of preview in pixels}
132 begin
133 {set up a coordinate system for the canvas that uses 1/1000 inch as unit,
134 honors the zoom factor and maintains the MM_TEXT orientation of the
135 coordinate axis (origin in top left corner, positive Y axis points down}
136 scale := Screen.PixelsPerInch / 1000;
137 {Apply zoom factor}
138 scale := scale * StrToInt(Zoomedit.text) / 100;
139 {figure out size of preview}
140 needpixelswidth := Round(pagewidth * 1000 * scale);
141 needpixelsheight := Round(pageheight * 1000 * scale);
142 if needpixelswidth >= widthavail then
143 orgpixels.X := 0
144 else
145 orgpixels.X := (widthavail - needpixelswidth) div 2;
146 if needpixelsheight >= heightavail then
147 orgpixels.Y := 0
148 else
149 orgpixels.Y := (heightavail - needpixelsheight) div 2;
150 {change mapping mode to MM_ISOTROPIC}
151 SetMapMode(canvas.handle, MM_ISOTROPIC);
152 {move viewport origin to orgpixels}
153 SetViewportOrgEx(canvas.handle, orgpixels.x, orgpixels.y, nil);
154 {scale the window}
155 SetViewportExtEx(canvas.handle, Round(1000 * scale), Round(1000 * scale), nil);
156 SetWindowExtEx(canvas.handle, 1000, 1000, nil);
157 end;
158
159 begin
160 if OrientationRGroup.ItemIndex = 0 then
161 Printer.Orientation := poPortrait
162 else
163 Printer.Orientation := poLandscape;
164 InitPrintsettings;
165 with Sender as TPaintBox do
166 begin
167 ScaleCanvas(Canvas, ClientWidth, ClientHeight);
168 {specify font height in 1/1000 inch}
169 Canvas.Font.Height := Round(font.height / font.pixelsperinch * 1000);
170 {paint page white}
171 Canvas.Brush.Color := clWindow;
172 Canvas.Brush.Style := bsSolid;
173 Canvas.FillRect(Rect(0, 0, Round(pagewidth * 1000), Round(pageheight * 1000)));
174 {draw the text}
175 DrawText(canvas.handle, PChar(PreviewText), Length(PreviewText),
176 outputarea, DT_WORDBREAK or DT_LEFT);
177 {Draw thin gray lines to mark borders}
178 Canvas.Pen.Color := clGray;
179 Canvas.Pen.Style := psSolid;
180 Canvas.Pen.Width := 10;
181 with Canvas do
182 begin
183 MoveTo(outputarea.left - 100, outputarea.top);
184 LineTo(outputarea.right + 100, outputarea.top);
185 MoveTo(outputarea.left - 100, outputarea.bottom);
186 LineTo(outputarea.right + 100, outputarea.bottom);
187 MoveTo(outputarea.left, outputarea.top - 100);
188 LineTo(outputarea.left, outputarea.bottom + 100);
189 MoveTo(outputarea.right, outputarea.top - 100);
190 LineTo(outputarea.right, outputarea.bottom + 100);
191 end;
192 end;
193 end;
194
195 procedure TForm1.ApplyMarginsButtonClick(Sender: TObject);
196 begin
197 PreviewPaintbox.Invalidate;
198 end;
199
200 end.
201
202
203 {
204 object Form1: TForm1
205 Left = 192
206 Top = 128
207 Width = 696
208 Height = 480
209 Caption = 'Form1'
210 Color = clBtnFace
211 Font.Charset = ANSI_CHARSET
212 Font.Color = clWindowText
213 Font.Height = -15
214 Font.Name = 'Arial'
215 Font.Style = []
216 OldCreateOrder = False
217 OnCreate = FormCreate
218 PixelsPerInch = 120
219 TextHeight = 17
220 object Panel1: TPanel
221 Left = 503
222 Top = 0
223 Width = 185
224 Height = 453
225 Align = alRight
226 TabOrder = 0
227 object Label1: TLabel
228 Left = 8
229 Top = 8
230 Width = 92
231 Height = 17
232 Caption = 'Margins (inch)'
233 end
234 object Label2: TLabel
235 Left = 8
236 Top = 45
237 Width = 24
238 Height = 17
239 Caption = 'Left'
240 end
241 object Label3: TLabel
242 Left = 8
243 Top = 77
244 Width = 25
245 Height = 17
246 Caption = 'Top'
247 end
248 object Label4: TLabel
249 Left = 8
250 Top = 109
251 Width = 34
252 Height = 17
253 Caption = 'Right'
254 end
255 object Label5: TLabel
256 Left = 8
257 Top = 141
258 Width = 47
259 Height = 17
260 Caption = 'Bottom'
261 end
262 object Label6: TLabel
263 Left = 8
264 Top = 261
265 Width = 64
266 Height = 17
267 Caption = 'Zoom (%)'
268 end
269 object LeftMarginEdit: TEdit
270 Left = 60
271 Top = 40
272 Width = 100
273 Height = 25
274 TabOrder = 0
275 OnKeyPress = LeftMarginEditKeyPress
276 end
277 object TopMarginEdit: TEdit
278 Left = 60
279 Top = 72
280 Width = 100
281 Height = 25
282 TabOrder = 1
283 OnKeyPress = LeftMarginEditKeyPress
284 end
285 object RightMarginEdit: TEdit
286 Left = 60
287 Top = 104
288 Width = 100
289 Height = 25
290 TabOrder = 2
291 OnKeyPress = LeftMarginEditKeyPress
292 end
293 object BottomMarginEdit: TEdit
294 Left = 60
295 Top = 136
296 Width = 100
297 Height = 25
298 TabOrder = 3
299 OnKeyPress = LeftMarginEditKeyPress
300 end
301 object ApplyMarginsButton: TButton
302 Left = 24
303 Top = 304
304 Width = 137
305 Height = 25
306 Caption = 'Apply'
307 TabOrder = 4
308 OnClick = ApplyMarginsButtonClick
309 end
310 object OrientationRGroup: TRadioGroup
311 Left = 8
312 Top = 176
313 Width = 161
314 Height = 65
315 Caption = 'Orientation'
316 Items.Strings = (
317 'Portrait'
318 'Landscape')
319 TabOrder = 5
320 end
321 object ZoomEdit: TEdit
322 Left = 80
323 Top = 256
324 Width = 40
325 Height = 25
326 TabOrder = 6
327 Text = '50'
328 end
329 object ZoomUpDown: TUpDown
330 Left = 120
331 Top = 256
332 Width = 17
333 Height = 25
334 Associate = ZoomEdit
335 Min = 0
336 Increment = 10
337 Position = 50
338 TabOrder = 7
339 Wrap = False
340 end
341 end
342 object Panel2: TPanel
343 Left = 0
344 Top = 0
345 Width = 503
346 Height = 453
347 Align = alClient
348 Font.Charset = ANSI_CHARSET
349 Font.Color = clWindowText
350 Font.Height = -17
351 Font.Name = 'Times New Roman'
352 Font.Style = []
353 ParentFont = False
354 TabOrder = 1
355 object PreviewPaintbox: TPaintBox
356 Left = 1
357 Top = 1
358 Width = 501
359 Height = 451
360 Align = alClient
361 OnPaint = PreviewPaintboxPaint
362 end
363 end
364 end
365 }
|
