source: PrintPreview/UPrintPreview.pas

Last change on this file was 455, checked in by chronos, 13 years ago
  • Modified: PrintPreview should use TVectorCanvas instead of raster TCanvas dependent on DPI of printer. But some font function as TextWidth and TextHeight cannot be easily implemented without use of OS API.
File size: 18.4 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 Menus, LCLType, types;
11
12const
13 ScreenDPI = 72;
14 SizeDivider = 7.2;
15
16type
17 TPrintPreviewForm = class;
18
19 { TPrintPage }
20
21 TPrintPage = class
22 Bitmap: TBitmap;
23 constructor Create;
24 destructor Destroy; override;
25 end;
26
27 { TPrintPreview }
28
29 TPrintPreview = class(TComponent)
30 private
31 FOnNewPage: TNotifyEvent;
32 FOnPrint: TNotifyEvent;
33 //FOnPrintFooter: TNotifyEvent;
34 FZoom: Double;
35 FPageNumber: Integer;
36 FPageCount: Integer;
37 function GetHeight: Integer;
38 function GetPageCount: Integer;
39 function GetPageNumber: Integer;
40 function GetWidth: Integer;
41 function GetXDPI: Integer;
42 function GetYDPI: Integer;
43 function GetZoom: Double;
44 procedure SetZoom(const AValue: Double);
45 procedure UpdateMargins;
46 public
47 Canvas: TCanvas;
48 Pages: TObjectList;
49 PageTitle: string;
50 Margins: TRect;
51 MarginsMM: TRect;
52 property XDPI: Integer read GetXDPI;
53 property YDPI: Integer read GetYDPI;
54 function MMToPixels(AValue: Double; VertRes: Boolean = True): Integer;
55 function PixelsToMM(AValue: Integer; VertRes: Boolean = True): Double;
56 procedure CreateNewPage;
57 constructor Create(AOwner: TComponent); override;
58 destructor Destroy; override;
59 procedure Preview;
60 procedure Execute;
61 procedure Print;
62 published
63 property PageNumber: Integer read GetPageNumber;
64 property Zoom: Double read GetZoom write SetZoom;
65 property OnNewPage: TNotifyEvent read FOnNewPage write FOnNewPage;
66 property OnPrint: TNotifyEvent read FOnPrint write FOnPrint;
67 property PageWidth: Integer read GetWidth;
68 property PageHeight: Integer read GetHeight;
69 property PageCount: Integer read GetPageCount;
70 end;
71
72 { TPrintPreviewForm }
73
74 TPrintPreviewForm = class(TForm)
75 AClose: TAction;
76 AToolbarShowCaption: TAction;
77 AZoomFitToWidth: TAction;
78 AZoomFitToHeight: TAction;
79 ALastPage: TAction;
80 AFirstPage: TAction;
81 ANextPage: TAction;
82 APreviousPage: TAction;
83 AZoomOut: TAction;
84 AZoomIn: TAction;
85 APageSetup: TAction;
86 APrinterSetup: TAction;
87 APrint: TAction;
88 ActionList1: TActionList;
89 ComboBoxZoom: TComboBox;
90 EditPageNumber: TEdit;
91 Image1: TImage;
92 ImageList1: TImageList;
93 MenuItem1: TMenuItem;
94 PageSetupDialog1: TPageSetupDialog;
95 Panel1: TPanel;
96 PopupMenuToolbar: TPopupMenu;
97 PrintDialog1: TPrintDialog;
98 PrinterSetupDialog1: TPrinterSetupDialog;
99 ScrollBarHoriz: TScrollBar;
100 ScrollBarVert: TScrollBar;
101 ToolBar1: TToolBar;
102 ToolButton1: TToolButton;
103 ToolButton10: TToolButton;
104 ToolButton11: TToolButton;
105 ToolButton12: TToolButton;
106 ToolButton13: TToolButton;
107 ToolButton14: TToolButton;
108 ToolButton15: TToolButton;
109 ToolButton2: TToolButton;
110 ToolButton3: TToolButton;
111 ToolButton4: TToolButton;
112 ToolButton5: TToolButton;
113 ToolButton6: TToolButton;
114 ToolButton7: TToolButton;
115 ToolButton8: TToolButton;
116 ToolButton9: TToolButton;
117 procedure ACloseExecute(Sender: TObject);
118 procedure AFirstPageExecute(Sender: TObject);
119 procedure ALastPageExecute(Sender: TObject);
120 procedure ANextPageExecute(Sender: TObject);
121 procedure APageSetupExecute(Sender: TObject);
122 procedure APreviousPageExecute(Sender: TObject);
123 procedure APrinterSetupExecute(Sender: TObject);
124 procedure APrintExecute(Sender: TObject);
125 procedure AToolbarShowCaptionExecute(Sender: TObject);
126 procedure AZoomFitToHeightExecute(Sender: TObject);
127 procedure AZoomFitToWidthExecute(Sender: TObject);
128 procedure AZoomInExecute(Sender: TObject);
129 procedure AZoomOutExecute(Sender: TObject);
130 procedure ComboBoxZoomChange(Sender: TObject);
131 procedure EditPageNumberChange(Sender: TObject);
132 procedure FormCreate(Sender: TObject);
133 procedure FormDestroy(Sender: TObject);
134 procedure FormResize(Sender: TObject);
135 procedure FormShow(Sender: TObject);
136 procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
137 Shift: TShiftState; X, Y: Integer);
138 procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
139 );
140 procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
141 Shift: TShiftState; X, Y: Integer);
142 procedure Image1MouseWheel(Sender: TObject; Shift: TShiftState;
143 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
144 procedure ScrollBarHorizChange(Sender: TObject);
145 procedure ScrollBarVertChange(Sender: TObject);
146 private
147 DragStart: Boolean;
148 DragStartPos: TPoint;
149 DragScrollBarPos: TPoint;
150 FPrintPreview: TPrintPreview;
151 procedure UpdateInterface;
152 public
153 PageNumber: Integer;
154 MinZoom: Double;
155 MaxZoom: Double;
156 procedure EraseBackground(DC: HDC); override;
157 procedure Redraw;
158 property PrintPreview: TPrintPreview read FPrintPreview
159 write FPrintPreview;
160 end;
161
162procedure Register;
163
164resourcestring
165 SPrintPreview = 'Print preview';
166 SPrint = 'Print';
167 SPageSetup = 'Page setup';
168 SPrinterSetup = 'Printer setup';
169 SClose = 'Close';
170 SZoomOut = 'Zoom out';
171 SZoomIn = 'Zoom in';
172 SNextPage = 'Next page';
173 SPreviousPage = 'Previous page';
174 SLastPage = 'Last page';
175 SFirstPage = 'First page';
176
177implementation
178
179procedure Register;
180begin
181 RegisterComponents('Samples', [TPrintPreview]);
182end;
183
184{ TPrintPage }
185
186constructor TPrintPage.Create;
187begin
188 Bitmap := TBitmap.Create;
189end;
190
191destructor TPrintPage.Destroy;
192begin
193 Bitmap.Free;
194 inherited Destroy;
195end;
196
197{ TPrintPreview }
198
199function TPrintPreview.GetHeight: Integer;
200begin
201 if Printer.Printing then Result := Printer.PageHeight
202 else Result := Round(Printer.PageHeight / SizeDivider * Zoom);
203end;
204
205function TPrintPreview.GetPageCount: Integer;
206begin
207 Result := FPageCount;
208end;
209
210function TPrintPreview.GetPageNumber: Integer;
211begin
212 if Printer.Printing then Result := Printer.PageNumber
213 else Result := FPageNumber + 1;
214end;
215
216function TPrintPreview.GetWidth: Integer;
217begin
218 if Printer.Printing then Result := Printer.PageWidth
219 else Result := Round(Printer.PageWidth / SizeDivider * Zoom);
220end;
221
222function TPrintPreview.GetXDPI: Integer;
223begin
224 if Printer.Printing then Result := Printer.XDPI
225 else Result := Round(ScreenDPI * Zoom);
226end;
227
228function TPrintPreview.GetYDPI: Integer;
229begin
230 if Printer.Printing then Result := Printer.YDPI
231 else Result := Round(ScreenDPI * Zoom);
232end;
233
234function TPrintPreview.GetZoom: Double;
235begin
236 if Printer.Printing then Result := 1
237 else Result := FZoom;
238end;
239
240procedure TPrintPreview.SetZoom(const AValue: Double);
241begin
242 if FZoom = AValue then Exit;
243 FZoom := AValue;
244 Preview;
245end;
246
247procedure TPrintPreview.UpdateMargins;
248begin
249 Margins := Rect(MMToPixels(MarginsMM.Left), MMToPixels(MarginsMM.Top),
250 MMToPixels(MarginsMM.Right), MMToPixels(MarginsMM.Bottom));
251end;
252
253function TPrintPreview.MMToPixels(AValue: Double; VertRes: Boolean = True): Integer;
254begin
255 if VertRes then
256 Result := Round(AValue * YDPI / 25.4)
257 else
258 Result := Round(AValue * XDPI / 25.4);
259end;
260
261function TPrintPreview.PixelsToMM(AValue: Integer; VertRes: Boolean): Double;
262begin
263 if VertRes then
264 Result := AValue / YDPI * 25.4
265 else
266 Result := AValue / XDPI * 25.4;
267end;
268
269procedure TPrintPreview.CreateNewPage;
270var
271 NewPage: TPrintPage;
272begin
273 if Printer.Printing then begin
274 Printer.NewPage;
275 end else begin
276 NewPage := TPrintPage.Create;
277 Canvas := NewPage.Bitmap.Canvas;
278 if Pages.Count > 0 then
279 NewPage.Bitmap.Canvas.Font.Assign(TPrintPage(Pages.Last).Bitmap.Canvas.Font);
280 Pages.Add(NewPage);
281 NewPage.Bitmap.SetSize(PageWidth, PageHeight);
282 with NewPage.Bitmap.Canvas do begin
283 Brush.Color := clWhite;
284 Brush.Style := bsSolid;
285 Clear; //Brush.Color := clWhite;
286 Brush.Color := clWhite;
287 Brush.Style := bsSolid;
288 Clear; //Brush.Color := clWhite;
289 //Brush.Style := bsSolid;
290 //FillRect(Rect(0, 0, Width, Height));
291 //Brush.Color := clRed;
292 //Brush.Style := bsSolid;
293 //FillRect(Rect(0, 0, 100, 100));
294 Inc(FPageNumber);
295 end;
296 end;
297 if Assigned(FOnNewPage) then FOnNewPage(Self);
298end;
299
300constructor TPrintPreview.Create(AOwner: TComponent);
301begin
302 inherited;
303 Zoom := 1;
304 Pages := TObjectList.Create;
305 MarginsMM := Rect(10, 10, 10, 10);
306end;
307
308destructor TPrintPreview.Destroy;
309begin
310 Pages.Free;
311 inherited Destroy;
312end;
313
314procedure TPrintPreview.Preview;
315begin
316 if Assigned(FOnPrint) then begin
317 Pages.Clear;
318 FPageNumber := -1;
319 UpdateMargins;
320 CreateNewPage;
321 FOnPrint(Self);
322 end;
323end;
324
325procedure TPrintPreview.Execute;
326var
327 Form: TPrintPreviewForm;
328begin
329 try
330 Form := TPrintPreviewForm.Create(nil);
331 Form.PrintPreview := Self;
332 Preview;
333 FPageCount := Pages.Count;
334 Preview; // Call again for page count update
335 Form.ShowModal;
336 finally
337 Form.Free;
338 end;
339end;
340
341procedure TPrintPreview.Print;
342begin
343 if Assigned(FOnPrint) then begin
344 Canvas := Printer.Canvas;
345 try
346 FPageNumber := 0;
347 Canvas := Printer.Canvas;
348 Printer.Title := UTF8Decode(PageTitle);
349 Printer.BeginDoc;
350 UpdateMargins;
351 FOnPrint(Self);
352 finally
353 Printer.EndDoc;
354 end;
355 end;
356end;
357
358
359{ TPrintPreviewForm }
360
361procedure TPrintPreviewForm.APrintExecute(Sender: TObject);
362begin
363(* with Printer.Canvas.Font do begin
364 Size := 10;
365 ShowMessage(IntToStr(Height) + ' ' +
366 IntToStr(PixelsPerInch));
367 end;
368 with TPrintPage(PrintPreview.Pages.Last).Bitmap.Canvas.Font do begin
369 Size := 10;
370 ShowMessage(IntToStr(Height) + ' ' + IntToStr(PixelsPerInch));
371 end; *)
372
373 PrintDialog1.MinPage := 1;
374 PrintDialog1.MaxPage := PrintPreview.PageCount;
375 PrintDialog1.FromPage := 1;
376 PrintDialog1.ToPage := PrintPreview.PageCount;
377 if PrintDialog1.Execute then begin
378 if Assigned(FPrintPreview) then PrintPreview.Print;
379 end;
380end;
381
382procedure TPrintPreviewForm.AToolbarShowCaptionExecute(Sender: TObject);
383begin
384 AToolbarShowCaption.Checked := not AToolbarShowCaption.Checked;
385 if AToolbarShowCaption.Checked then begin
386 ToolBar1.ButtonHeight := 42;
387 ToolBar1.ButtonWidth := 42;
388 ToolBar1.ShowCaptions := True;
389 end else begin
390 ToolBar1.ButtonHeight := 22;
391 ToolBar1.ButtonWidth := 23;
392 ToolBar1.ShowCaptions := False;
393 end;
394end;
395
396procedure TPrintPreviewForm.AZoomFitToHeightExecute(Sender: TObject);
397begin
398 PrintPreview.Zoom := 1 / (Printer.PageHeight / SizeDivider / Image1.Height) * 0.95;
399 ScrollBarVert.Position := 0;
400 Redraw;
401 UpdateInterface;
402end;
403
404procedure TPrintPreviewForm.AZoomFitToWidthExecute(Sender: TObject);
405begin
406 PrintPreview.Zoom := 1 / (Printer.PageWidth / SizeDivider / Image1.Width) * 0.95;
407 ScrollBarHoriz.Position := 0;
408 Redraw;
409 UpdateInterface;
410end;
411
412procedure TPrintPreviewForm.AZoomInExecute(Sender: TObject);
413var
414 NewZoom: Double;
415begin
416 NewZoom := PrintPreview.Zoom * 1.25;
417 if NewZoom > MaxZoom then NewZoom := MaxZoom;
418 PrintPreview.Zoom := NewZoom;
419 Redraw;
420 UpdateInterface;
421end;
422
423procedure TPrintPreviewForm.AZoomOutExecute(Sender: TObject);
424var
425 NewZoom: Double;
426begin
427 NewZoom := PrintPreview.Zoom / 1.25;
428 if NewZoom < MinZoom then NewZoom := MinZoom;
429 PrintPreview.Zoom := NewZoom;
430 Redraw;
431 UpdateInterface;
432end;
433
434procedure TPrintPreviewForm.ComboBoxZoomChange(Sender: TObject);
435var
436 ZoomText: string;
437 NewZoomInt: Integer;
438 NewZoom: Double;
439begin
440 ZoomText := Trim(ComboBoxZoom.Text);
441 if Pos('%', ZoomText) > 0 then
442 ZoomText := Copy(ZoomText, 1, Pos('%', ZoomText) - 1);
443 if TryStrToInt(ZoomText, NewZoomInt) then begin
444 NewZoom := NewZoomInt / 100;
445 if NewZoom < MinZoom then NewZoom := MinZoom;
446 if NewZoom > MaxZoom then NewZoom := MaxZoom;
447 PrintPreview.Zoom := NewZoom;
448 EditPageNumberChange(Self);
449 Redraw;
450 end;
451end;
452
453procedure TPrintPreviewForm.EditPageNumberChange(Sender: TObject);
454var
455 Value: Integer;
456begin
457 if TryStrToInt(EditPageNumber.Text, Value) then begin
458 PageNumber := Value;
459 if PageNumber < 0 then PageNumber := 0;
460 if PageNumber >= PrintPreview.PageCount then
461 PageNumber := PrintPreview.PageCount - 1;
462 end;
463 UpdateInterface;
464end;
465
466procedure TPrintPreviewForm.FormCreate(Sender: TObject);
467begin
468 //DoubleBuffered := True;
469 Panel1.DoubleBuffered := True;
470 AToolbarShowCaption.Checked := True;
471 MinZoom := 0.1;
472 MaxZoom := 3;
473end;
474
475procedure TPrintPreviewForm.FormDestroy(Sender: TObject);
476begin
477end;
478
479procedure TPrintPreviewForm.FormResize(Sender: TObject);
480begin
481 Redraw;
482end;
483
484procedure TPrintPreviewForm.FormShow(Sender: TObject);
485begin
486 Caption := SPrintPreview;
487 AClose.Caption := SClose;
488 AClose.Hint := SClose;
489 AFirstPage.Caption := SFirstPage;
490 AFirstPage.Hint := SFirstPage;
491 ALastPage.Caption := SLastPage;
492 ALastPage.Hint := SLastPage;
493 ANextPage.Caption := SNextPage;
494 ANextPage.Hint := SNextPage;
495 APreviousPage.Caption := SPreviousPage;
496 APreviousPage.Hint := SPreviousPage;
497 APageSetup.Caption := SPageSetup;
498 APageSetup.Hint := SPageSetup;
499 APrinterSetup.Caption := SPrinterSetup;
500 APrinterSetup.Hint := SPrinterSetup;
501 APrint.Caption := SPrint;
502 APrint.Hint := SPrint;
503 AZoomIn.Caption := SZoomIn;
504 AZoomIn.Hint := SZoomIn;
505 AZoomOut.Caption := SZoomOut;
506 AZoomOut.Hint := SZoomOut;
507
508 PrintDialog1.MaxPage := PrintPreview.Pages.Count;
509 UpdateInterface;
510 Redraw;
511end;
512
513procedure TPrintPreviewForm.Image1MouseDown(Sender: TObject;
514 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
515begin
516 DragStartPos := Point(X, Y);
517 DragStart := True;
518 DragScrollBarPos := Point(ScrollBarHoriz.Position, ScrollBarVert.Position);
519end;
520
521procedure TPrintPreviewForm.Image1MouseMove(Sender: TObject;
522 Shift: TShiftState; X, Y: Integer);
523begin
524 if DragStart then begin
525 ScrollBarHoriz.Position := DragScrollBarPos.X - Trunc((X - DragStartPos.x) *
526 (ScrollBarHoriz.Max - ScrollBarHoriz.Min) / Width / PrintPreview.Zoom);
527 ScrollBarVert.Position := DragScrollBarPos.Y - Trunc((Y - DragStartPos.Y) *
528 (ScrollBarVert.Max - ScrollBarVert.Min) / Height / PrintPreview.Zoom);
529 end;
530end;
531
532procedure TPrintPreviewForm.Image1MouseUp(Sender: TObject;
533 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
534begin
535 DragStart := False;
536end;
537
538procedure TPrintPreviewForm.Image1MouseWheel(Sender: TObject;
539 Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
540 var Handled: Boolean);
541begin
542 if WheelDelta > 0 then AZoomIn.Execute
543 else if WheelDelta < 0 then AZoomOut.Execute;
544end;
545
546procedure TPrintPreviewForm.ScrollBarHorizChange(Sender: TObject);
547begin
548 Redraw;
549end;
550
551procedure TPrintPreviewForm.ScrollBarVertChange(Sender: TObject);
552begin
553 Redraw;
554end;
555
556procedure TPrintPreviewForm.UpdateInterface;
557begin
558 EditPageNumber.Text := IntToStr(PageNumber);
559 Redraw;
560 ANextPage.Enabled := PageNumber < (PrintPreview.PageCount - 1);
561 ALastPage.Enabled := PageNumber < (PrintPreview.PageCount - 1);
562 APreviousPage.Enabled := PageNumber > 0;
563 AFirstPage.Enabled := PageNumber > 0;
564 ComboBoxZoom.Text := IntToStr(Trunc(PrintPreview.Zoom * 100)) + '%';
565end;
566
567procedure TPrintPreviewForm.EraseBackground(DC: HDC);
568begin
569 //inherited EraseBackground(DC);
570end;
571
572procedure TPrintPreviewForm.Redraw;
573var
574 //SourceRect: TRect;
575 DestRect: TRect;
576 Page: TPrintPage;
577 PageSize: TPoint;
578begin
579 Page := TPrintPage(PrintPreview.Pages[PageNumber]);
580 //SourceRect := Rect(0, 0,
581 // Page.Bitmap.Canvas.Width,
582 // Page.Bitmap.Canvas.Height);
583 PageSize := Point(Round(Page.Bitmap.Canvas.Width),
584 Round(Page.Bitmap.Canvas.Height));
585 DestRect.Left := (Image1.Width - PageSize.X) div 2 - Round(ScrollBarHoriz.Position /
586 (ScrollBarHoriz.Max - ScrollBarHoriz.Min) * Image1.Width * PrintPreview.Zoom);
587 DestRect.Top := (Image1.Height - PageSize.Y) div 2 - Round(ScrollBarVert.Position /
588 (ScrollBarVert.Max - ScrollBarVert.Min) * Image1.Height * PrintPreview.Zoom);
589 DestRect.Right := DestRect.Left + PageSize.X;
590 DestRect.Bottom := DestRect.Top + PageSize.Y;
591 try
592 Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
593 Image1.Picture.Bitmap.BeginUpdate(True);
594 with Image1.Picture.Bitmap, Canvas do begin
595 Brush.Color := clGray;
596 Brush.Style := bsSolid;
597 FillRect(Rect(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height));
598 Draw(DestRect.Left, DestRect.Top, Page.Bitmap);
599 //CopyRect(DestRect, Page.Bitmap.Canvas, SourceRect);
600 Pen.Style := psSolid;
601 Pen.Color := clBlack;
602 Frame(DestRect);
603 end;
604 finally
605 Image1.Picture.Bitmap.EndUpdate;
606 end;
607end;
608
609procedure TPrintPreviewForm.APageSetupExecute(Sender: TObject);
610begin
611 with PrintPreview do begin
612 PageSetupDialog1.Margins := Rect(MarginsMM.Left * 100,
613 MarginsMM.Top * 100,
614 MarginsMM.Right * 100,
615 MarginsMM.Bottom * 100);
616 if PageSetupDialog1.Execute then begin
617 MarginsMM := Rect(Round(PageSetupDialog1.Margins.Left / 100),
618 Round(PageSetupDialog1.Margins.Top / 100),
619 Round(PageSetupDialog1.Margins.Right / 100),
620 Round(PageSetupDialog1.Margins.Bottom / 100));
621 UpdateMargins;
622 PrintPreview.Preview;
623 Redraw;
624 end;
625 end;
626end;
627
628procedure TPrintPreviewForm.APreviousPageExecute(Sender: TObject);
629begin
630 Dec(PageNumber);
631 if PageNumber < 0 then PageNumber := 0;
632 UpdateInterface;
633end;
634
635procedure TPrintPreviewForm.ANextPageExecute(Sender: TObject);
636begin
637 Inc(PageNumber);
638 if PageNumber >= PrintPreview.PageCount then
639 PageNumber := PrintPreview.PageCount;
640 UpdateInterface;
641end;
642
643procedure TPrintPreviewForm.ALastPageExecute(Sender: TObject);
644begin
645 PageNumber := PrintPreview.PageCount - 1;
646 UpdateInterface;
647end;
648
649procedure TPrintPreviewForm.AFirstPageExecute(Sender: TObject);
650begin
651 PageNumber := 0;
652 UpdateInterface;
653end;
654
655procedure TPrintPreviewForm.ACloseExecute(Sender: TObject);
656begin
657 Close;
658end;
659
660procedure TPrintPreviewForm.APrinterSetupExecute(Sender: TObject);
661begin
662 PrinterSetupDialog1.Execute;
663end;
664
665initialization
666 {$I UPrintPreview.lrs}
667
668end.
669
Note: See TracBrowser for help on using the repository browser.