source: PrintPreview/UPrintPreview.pas@ 437

Last change on this file since 437 was 266, checked in by george, 14 years ago
File size: 13.9 KB
Line 
1unit UPrintPreview;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
9 ComCtrls, ExtCtrls, ActnList, PrintersDlgs, Contnrs, Printers, StdCtrls;
10
11const
12 ScreenDPI = 72;
13 SizeDivider = 7.2;
14
15type
16 TPrintPreviewForm = class;
17
18 { TPrintPage }
19
20 TPrintPage = class
21 Bitmap: TBitmap;
22 constructor Create;
23 destructor Destroy; override;
24 end;
25
26 { TPrintPreview }
27
28 TPrintPreview = class(TComponent)
29 private
30 FOnNewPage: TNotifyEvent;
31 FOnPrint: TNotifyEvent;
32 FOnPrintFooter: TNotifyEvent;
33 FZoom: Double;
34 FPageNumber: Integer;
35 FPageCount: Integer;
36 function GetHeight: Integer;
37 function GetPageCount: Integer;
38 function GetPageNumber: Integer;
39 function GetWidth: Integer;
40 function GetXDPI: Integer;
41 function GetYDPI: Integer;
42 function GetZoom: Double;
43 procedure SetZoom(const AValue: Double);
44 procedure UpdateMargins;
45 public
46 Canvas: TCanvas;
47 Pages: TObjectList;
48 PageTitle: string;
49 Margins: TRect;
50 MarginsMM: TRect;
51 property XDPI: Integer read GetXDPI;
52 property YDPI: Integer read GetYDPI;
53 function MMToPixels(AValue: Double; VertRes: Boolean = True): Integer;
54 function PixelsToMM(AValue: Integer; VertRes: Boolean = True): Double;
55 procedure CreateNewPage;
56 constructor Create(AOwner: TComponent); override;
57 destructor Destroy; override;
58 procedure Preview;
59 procedure Execute;
60 procedure Print;
61 published
62 property PageNumber: Integer read GetPageNumber;
63 property Zoom: Double read GetZoom write SetZoom;
64 property OnNewPage: TNotifyEvent read FOnNewPage write FOnNewPage;
65 property OnPrint: TNotifyEvent read FOnPrint write FOnPrint;
66 property PageWidth: Integer read GetWidth;
67 property PageHeight: Integer read GetHeight;
68 property PageCount: Integer read GetPageCount;
69 end;
70
71 { TPrintPreviewForm }
72
73 TPrintPreviewForm = class(TForm)
74 AClose: TAction;
75 ALastPage: TAction;
76 AFirstPage: TAction;
77 ANextPage: TAction;
78 APreviousPage: TAction;
79 AZoomOut: TAction;
80 AZoomIn: TAction;
81 APageSetup: TAction;
82 APrinterSetup: TAction;
83 APrint: TAction;
84 ActionList1: TActionList;
85 Button1: TButton;
86 Button2: TButton;
87 Button3: TButton;
88 Button4: TButton;
89 EditPageNumber: TEdit;
90 Image1: TImage;
91 ImageList1: TImageList;
92 PageSetupDialog1: TPageSetupDialog;
93 PrintDialog1: TPrintDialog;
94 PrinterSetupDialog1: TPrinterSetupDialog;
95 ScrollBarHoriz: TScrollBar;
96 ScrollBarVert: TScrollBar;
97 ToolBar1: TToolBar;
98 ToolButton1: TToolButton;
99 ToolButton2: TToolButton;
100 ToolButton3: TToolButton;
101 ToolButton4: TToolButton;
102 ToolButton5: TToolButton;
103 ToolButton6: TToolButton;
104 ToolButton7: TToolButton;
105 ToolButton8: TToolButton;
106 ToolButton9: TToolButton;
107 procedure ACloseExecute(Sender: TObject);
108 procedure AFirstPageExecute(Sender: TObject);
109 procedure ALastPageExecute(Sender: TObject);
110 procedure ANextPageExecute(Sender: TObject);
111 procedure APageSetupExecute(Sender: TObject);
112 procedure APreviousPageExecute(Sender: TObject);
113 procedure APrinterSetupExecute(Sender: TObject);
114 procedure APrintExecute(Sender: TObject);
115 procedure AZoomInExecute(Sender: TObject);
116 procedure AZoomOutExecute(Sender: TObject);
117 procedure EditPageNumberChange(Sender: TObject);
118 procedure FormCreate(Sender: TObject);
119 procedure FormDestroy(Sender: TObject);
120 procedure FormResize(Sender: TObject);
121 procedure FormShow(Sender: TObject);
122 procedure ScrollBarHorizChange(Sender: TObject);
123 procedure ScrollBarVertChange(Sender: TObject);
124 private
125 FPrintPreview: TPrintPreview;
126 procedure ReloadPageNumber;
127 public
128 PageNumber: Integer;
129 procedure Redraw;
130 property PrintPreview: TPrintPreview read FPrintPreview
131 write FPrintPreview;
132 end;
133
134procedure Register;
135
136resourcestring
137 SPrintPreview = 'Print preview';
138 SPrint = 'Print';
139 SPageSetup = 'Page setup';
140 SPrinterSetup = 'Printer setup';
141 SClose = 'Close';
142 SZoomOut = 'Zoom out';
143 SZoomIn = 'Zoom in';
144 SNextPage = 'Next page';
145 SPreviousPage = 'Previous page';
146 SLastPage = 'Last page';
147 SFirstPage = 'First page';
148
149implementation
150
151procedure Register;
152begin
153 RegisterComponents('Samples', [TPrintPreview]);
154end;
155
156{ TPrintPage }
157
158constructor TPrintPage.Create;
159begin
160 Bitmap := TBitmap.Create;
161end;
162
163destructor TPrintPage.Destroy;
164begin
165 Bitmap.Free;
166 inherited Destroy;
167end;
168
169{ TPrintPreview }
170
171function TPrintPreview.GetHeight: Integer;
172begin
173 if Printer.Printing then Result := Printer.PageHeight
174 else Result := Round(Printer.PageHeight / SizeDivider * Zoom);
175end;
176
177function TPrintPreview.GetPageCount: Integer;
178begin
179 Result := FPageCount;
180end;
181
182function TPrintPreview.GetPageNumber: Integer;
183begin
184 if Printer.Printing then Result := Printer.PageNumber
185 else Result := FPageNumber + 1;
186end;
187
188function TPrintPreview.GetWidth: Integer;
189begin
190 if Printer.Printing then Result := Printer.PageWidth
191 else Result := Round(Printer.PageWidth / SizeDivider * Zoom);
192end;
193
194function TPrintPreview.GetXDPI: Integer;
195begin
196 if Printer.Printing then Result := Printer.XDPI
197 else Result := Round(ScreenDPI * Zoom);
198end;
199
200function TPrintPreview.GetYDPI: Integer;
201begin
202 if Printer.Printing then Result := Printer.YDPI
203 else Result := Round(ScreenDPI * Zoom);
204end;
205
206function TPrintPreview.GetZoom: Double;
207begin
208 if Printer.Printing then Result := 1
209 else Result := FZoom;
210end;
211
212procedure TPrintPreview.SetZoom(const AValue: Double);
213begin
214 if FZoom = AValue then Exit;
215 FZoom := AValue;
216 Preview;
217end;
218
219procedure TPrintPreview.UpdateMargins;
220begin
221 Margins := Rect(MMToPixels(MarginsMM.Left), MMToPixels(MarginsMM.Top),
222 MMToPixels(MarginsMM.Right), MMToPixels(MarginsMM.Bottom));
223end;
224
225function TPrintPreview.MMToPixels(AValue: Double; VertRes: Boolean = True): Integer;
226begin
227 if VertRes then
228 Result := Round(AValue * YDPI / 25.4)
229 else
230 Result := Round(AValue * XDPI / 25.4);
231end;
232
233function TPrintPreview.PixelsToMM(AValue: Integer; VertRes: Boolean): Double;
234begin
235 if VertRes then
236 Result := AValue / YDPI * 25.4
237 else
238 Result := AValue / XDPI * 25.4;
239end;
240
241procedure TPrintPreview.CreateNewPage;
242var
243 NewPage: TPrintPage;
244begin
245 if Printer.Printing then begin
246 Printer.NewPage;
247 end else begin
248 NewPage := TPrintPage.Create;
249 Canvas := NewPage.Bitmap.Canvas;
250 if Pages.Count > 0 then
251 NewPage.Bitmap.Canvas.Font.Assign(TPrintPage(Pages.Last).Bitmap.Canvas.Font);
252 Pages.Add(NewPage);
253 NewPage.Bitmap.SetSize(PageWidth, PageHeight);
254 with NewPage.Bitmap.Canvas do begin
255 Brush.Color := clWhite;
256 Brush.Style := bsSolid;
257 Clear; //Brush.Color := clWhite;
258 Brush.Color := clWhite;
259 Brush.Style := bsSolid;
260 Clear; //Brush.Color := clWhite;
261 //Brush.Style := bsSolid;
262 //FillRect(Rect(0, 0, Width, Height));
263 //Brush.Color := clRed;
264 //Brush.Style := bsSolid;
265 //FillRect(Rect(0, 0, 100, 100));
266 Inc(FPageNumber);
267 end;
268 end;
269 if Assigned(FOnNewPage) then FOnNewPage(Self);
270end;
271
272constructor TPrintPreview.Create(AOwner: TComponent);
273begin
274 inherited;
275 Zoom := 1;
276 Pages := TObjectList.Create;
277 MarginsMM := Rect(10, 10, 10, 10);
278end;
279
280destructor TPrintPreview.Destroy;
281begin
282 Pages.Free;
283 inherited Destroy;
284end;
285
286procedure TPrintPreview.Preview;
287const
288 DefaultMargin = 10;
289begin
290 if Assigned(FOnPrint) then begin
291 Pages.Clear;
292 FPageNumber := -1;
293 UpdateMargins;
294 CreateNewPage;
295 FOnPrint(Self);
296 end;
297end;
298
299procedure TPrintPreview.Execute;
300var
301 Form: TPrintPreviewForm;
302begin
303 try
304 Form := TPrintPreviewForm.Create(nil);
305 Form.PrintPreview := Self;
306 Preview;
307 FPageCount := Pages.Count;
308 Preview; // Call again for page count update
309 Form.ShowModal;
310 finally
311 Form.Free;
312 end;
313end;
314
315procedure TPrintPreview.Print;
316begin
317 if Assigned(FOnPrint) then begin
318 Canvas := Printer.Canvas;
319 try
320 FPageNumber := 0;
321 Canvas := Printer.Canvas;
322 Printer.Title := UTF8Decode(PageTitle);
323 Printer.BeginDoc;
324 UpdateMargins;
325 FOnPrint(Self);
326 finally
327 Printer.EndDoc;
328 end;
329 end;
330end;
331
332
333{ TPrintPreviewForm }
334
335procedure TPrintPreviewForm.APrintExecute(Sender: TObject);
336begin
337(* with Printer.Canvas.Font do begin
338 Size := 10;
339 ShowMessage(IntToStr(Height) + ' ' +
340 IntToStr(PixelsPerInch));
341 end;
342 with TPrintPage(PrintPreview.Pages.Last).Bitmap.Canvas.Font do begin
343 Size := 10;
344 ShowMessage(IntToStr(Height) + ' ' + IntToStr(PixelsPerInch));
345 end; *)
346
347 PrintDialog1.MinPage := 1;
348 PrintDialog1.MaxPage := PrintPreview.PageCount;
349 PrintDialog1.FromPage := 1;
350 PrintDialog1.ToPage := PrintPreview.PageCount;
351 if PrintDialog1.Execute then
352 if Assigned(FPrintPreview) then PrintPreview.Print;
353end;
354
355procedure TPrintPreviewForm.AZoomInExecute(Sender: TObject);
356begin
357 PrintPreview.Zoom := PrintPreview.Zoom * 1.25;
358 Redraw;
359end;
360
361procedure TPrintPreviewForm.AZoomOutExecute(Sender: TObject);
362begin
363 PrintPreview.Zoom := PrintPreview.Zoom / 1.25;
364 EditPageNumberChange(Self);
365 Redraw;
366end;
367
368procedure TPrintPreviewForm.EditPageNumberChange(Sender: TObject);
369var
370 Value: Integer;
371begin
372 if TryStrToInt(EditPageNumber.Text, Value) then begin
373 PageNumber := Value;
374 if PageNumber < 0 then PageNumber := 0;
375 if PageNumber >= PrintPreview.PageCount then
376 PageNumber := PrintPreview.PageCount - 1;
377 end;
378 ReloadPageNumber;
379end;
380
381procedure TPrintPreviewForm.FormCreate(Sender: TObject);
382begin
383 DoubleBuffered := True;
384end;
385
386procedure TPrintPreviewForm.FormDestroy(Sender: TObject);
387begin
388end;
389
390procedure TPrintPreviewForm.FormResize(Sender: TObject);
391begin
392 Redraw;
393end;
394
395procedure TPrintPreviewForm.FormShow(Sender: TObject);
396begin
397 Caption := SPrintPreview;
398 AClose.Caption := SClose;
399 AClose.Hint := SClose;
400 AFirstPage.Caption := SFirstPage;
401 AFirstPage.Hint := SFirstPage;
402 ALastPage.Caption := SLastPage;
403 ALastPage.Hint := SLastPage;
404 ANextPage.Caption := SNextPage;
405 ANextPage.Hint := SNextPage;
406 APreviousPage.Caption := SPreviousPage;
407 APreviousPage.Hint := SPreviousPage;
408 APageSetup.Caption := SPageSetup;
409 APageSetup.Hint := SPageSetup;
410 APrinterSetup.Caption := SPrinterSetup;
411 APrinterSetup.Hint := SPrinterSetup;
412 APrint.Caption := SPrint;
413 APrint.Hint := SPrint;
414 AZoomIn.Caption := SZoomIn;
415 AZoomIn.Hint := SZoomIn;
416 AZoomOut.Caption := SZoomOut;
417 AZoomOut.Hint := SZoomOut;
418
419 PrintDialog1.MaxPage := PrintPreview.Pages.Count;
420 ReloadPageNumber;
421 Redraw;
422end;
423
424procedure TPrintPreviewForm.ScrollBarHorizChange(Sender: TObject);
425begin
426 Redraw;
427end;
428
429procedure TPrintPreviewForm.ScrollBarVertChange(Sender: TObject);
430begin
431 Redraw;
432end;
433
434procedure TPrintPreviewForm.ReloadPageNumber;
435begin
436 EditPageNumber.Text := IntToStr(PageNumber);
437 Redraw;
438 ANextPage.Enabled := PageNumber < (PrintPreview.PageCount - 1);
439 APreviousPage.Enabled := PageNumber > 0;
440end;
441
442procedure TPrintPreviewForm.Redraw;
443var
444 SourceRect: TRect;
445 DestRect: TRect;
446 Page: TPrintPage;
447begin
448 Page := TPrintPage(PrintPreview.Pages[PageNumber]);
449 SourceRect := Rect(0, 0,
450 Page.Bitmap.Canvas.Width,
451 Page.Bitmap.Canvas.Height);
452 DestRect.Left := -Round(ScrollBarHoriz.Position / ScrollBarHoriz.Max * Width * PrintPreview.Zoom);
453 DestRect.Top := -Round(ScrollBarVert.Position / ScrollBarVert.Max * Height * PrintPreview.Zoom);
454 DestRect.Right := DestRect.Left + Round(Page.Bitmap.Canvas.Width * PrintPreview.Zoom);
455 DestRect.Bottom := DestRect.Top + Round(Page.Bitmap.Canvas.Height * PrintPreview.Zoom);
456 try
457 Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
458 Image1.Picture.Bitmap.BeginUpdate(True);
459 with Image1.Picture.Bitmap, Canvas do begin
460 Brush.Color := clBlack;
461 Brush.Style := bsSolid;
462 FillRect(Rect(0, 0, Width, Height));
463 Draw(DestRect.Left, DestRect.Top, Page.Bitmap);
464 //CopyRect(DestRect, Page.Bitmap.Canvas, SourceRect);
465 Pen.Style := psSolid;
466 Pen.Color := clBlack;
467 Frame(DestRect);
468 end;
469 finally
470 Image1.Picture.Bitmap.EndUpdate;
471 end;
472end;
473
474procedure TPrintPreviewForm.APageSetupExecute(Sender: TObject);
475begin
476 with PrintPreview do begin
477 PageSetupDialog1.Margins := Rect(MarginsMM.Left * 100,
478 MarginsMM.Top * 100,
479 MarginsMM.Right * 100,
480 MarginsMM.Bottom * 100);
481 if PageSetupDialog1.Execute then begin
482 MarginsMM := Rect(Round(PageSetupDialog1.Margins.Left / 100),
483 Round(PageSetupDialog1.Margins.Top / 100),
484 Round(PageSetupDialog1.Margins.Right / 100),
485 Round(PageSetupDialog1.Margins.Bottom / 100));
486 UpdateMargins;
487 Redraw;
488 end;
489 end;
490end;
491
492procedure TPrintPreviewForm.APreviousPageExecute(Sender: TObject);
493begin
494 Dec(PageNumber);
495 if PageNumber < 0 then PageNumber := 0;
496 ReloadPageNumber;
497end;
498
499procedure TPrintPreviewForm.ANextPageExecute(Sender: TObject);
500begin
501 Inc(PageNumber);
502 if PageNumber >= PrintPreview.PageCount then
503 PageNumber := PrintPreview.PageCount;
504 ReloadPageNumber;
505end;
506
507procedure TPrintPreviewForm.ALastPageExecute(Sender: TObject);
508begin
509 PageNumber := PrintPreview.PageCount - 1;
510 ReloadPageNumber;
511end;
512
513procedure TPrintPreviewForm.AFirstPageExecute(Sender: TObject);
514begin
515 PageNumber := 0;
516 ReloadPageNumber;
517end;
518
519procedure TPrintPreviewForm.ACloseExecute(Sender: TObject);
520begin
521 Close;
522end;
523
524procedure TPrintPreviewForm.APrinterSetupExecute(Sender: TObject);
525begin
526 PrinterSetupDialog1.Execute;
527end;
528
529initialization
530 {$I UPrintPreview.lrs}
531
532end.
533
Note: See TracBrowser for help on using the repository browser.