Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to create a print preview Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
07-Oct-02
Category
Reporting /Printing
Language
Delphi 2.x
Views
88
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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 }


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC