source: trunk/Packages/PrintPreview/UPrintPreview.pas

Last change on this file was 23, checked in by chronos, 13 years ago
  • Přidáno: Rozpracovaná třídy pro komunikaci s přístupovým terminálem BF-630. Přiložen popis protokolu.
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;
287begin
288 if Assigned(FOnPrint) then begin
289 Pages.Clear;
290 FPageNumber := -1;
291 UpdateMargins;
292 CreateNewPage;
293 FOnPrint(Self);
294 end;
295end;
296
297procedure TPrintPreview.Execute;
298var
299 Form: TPrintPreviewForm;
300begin
301 try
302 Form := TPrintPreviewForm.Create(nil);
303 Form.PrintPreview := Self;
304 Preview;
305 FPageCount := Pages.Count;
306 Preview; // Call again for page count update
307 Form.ShowModal;
308 finally
309 Form.Free;
310 end;
311end;
312
313procedure TPrintPreview.Print;
314begin
315 if Assigned(FOnPrint) then begin
316 Canvas := Printer.Canvas;
317 try
318 FPageNumber := 0;
319 Canvas := Printer.Canvas;
320 Printer.Title := UTF8Decode(PageTitle);
321 Printer.BeginDoc;
322 UpdateMargins;
323 FOnPrint(Self);
324 finally
325 Printer.EndDoc;
326 end;
327 end;
328end;
329
330
331{ TPrintPreviewForm }
332
333procedure TPrintPreviewForm.APrintExecute(Sender: TObject);
334begin
335(* with Printer.Canvas.Font do begin
336 Size := 10;
337 ShowMessage(IntToStr(Height) + ' ' +
338 IntToStr(PixelsPerInch));
339 end;
340 with TPrintPage(PrintPreview.Pages.Last).Bitmap.Canvas.Font do begin
341 Size := 10;
342 ShowMessage(IntToStr(Height) + ' ' + IntToStr(PixelsPerInch));
343 end; *)
344
345 PrintDialog1.MinPage := 1;
346 PrintDialog1.MaxPage := PrintPreview.PageCount;
347 PrintDialog1.FromPage := 1;
348 PrintDialog1.ToPage := PrintPreview.PageCount;
349 if PrintDialog1.Execute then begin
350 if Assigned(FPrintPreview) then PrintPreview.Print;
351 end;
352end;
353
354procedure TPrintPreviewForm.AZoomInExecute(Sender: TObject);
355begin
356 PrintPreview.Zoom := PrintPreview.Zoom * 1.25;
357 Redraw;
358end;
359
360procedure TPrintPreviewForm.AZoomOutExecute(Sender: TObject);
361begin
362 PrintPreview.Zoom := PrintPreview.Zoom / 1.25;
363 EditPageNumberChange(Self);
364 Redraw;
365end;
366
367procedure TPrintPreviewForm.EditPageNumberChange(Sender: TObject);
368var
369 Value: Integer;
370begin
371 if TryStrToInt(EditPageNumber.Text, Value) then begin
372 PageNumber := Value;
373 if PageNumber < 0 then PageNumber := 0;
374 if PageNumber >= PrintPreview.PageCount then
375 PageNumber := PrintPreview.PageCount - 1;
376 end;
377 ReloadPageNumber;
378end;
379
380procedure TPrintPreviewForm.FormCreate(Sender: TObject);
381begin
382 DoubleBuffered := True;
383end;
384
385procedure TPrintPreviewForm.FormDestroy(Sender: TObject);
386begin
387end;
388
389procedure TPrintPreviewForm.FormResize(Sender: TObject);
390begin
391 Redraw;
392end;
393
394procedure TPrintPreviewForm.FormShow(Sender: TObject);
395begin
396 Caption := SPrintPreview;
397 AClose.Caption := SClose;
398 AClose.Hint := SClose;
399 AFirstPage.Caption := SFirstPage;
400 AFirstPage.Hint := SFirstPage;
401 ALastPage.Caption := SLastPage;
402 ALastPage.Hint := SLastPage;
403 ANextPage.Caption := SNextPage;
404 ANextPage.Hint := SNextPage;
405 APreviousPage.Caption := SPreviousPage;
406 APreviousPage.Hint := SPreviousPage;
407 APageSetup.Caption := SPageSetup;
408 APageSetup.Hint := SPageSetup;
409 APrinterSetup.Caption := SPrinterSetup;
410 APrinterSetup.Hint := SPrinterSetup;
411 APrint.Caption := SPrint;
412 APrint.Hint := SPrint;
413 AZoomIn.Caption := SZoomIn;
414 AZoomIn.Hint := SZoomIn;
415 AZoomOut.Caption := SZoomOut;
416 AZoomOut.Hint := SZoomOut;
417
418 PrintDialog1.MaxPage := PrintPreview.Pages.Count;
419 ReloadPageNumber;
420 Redraw;
421end;
422
423procedure TPrintPreviewForm.ScrollBarHorizChange(Sender: TObject);
424begin
425 Redraw;
426end;
427
428procedure TPrintPreviewForm.ScrollBarVertChange(Sender: TObject);
429begin
430 Redraw;
431end;
432
433procedure TPrintPreviewForm.ReloadPageNumber;
434begin
435 EditPageNumber.Text := IntToStr(PageNumber);
436 Redraw;
437 ANextPage.Enabled := PageNumber < (PrintPreview.PageCount - 1);
438 APreviousPage.Enabled := PageNumber > 0;
439end;
440
441procedure TPrintPreviewForm.Redraw;
442var
443 //SourceRect: TRect;
444 DestRect: TRect;
445 Page: TPrintPage;
446begin
447 Page := TPrintPage(PrintPreview.Pages[PageNumber]);
448 //SourceRect := Rect(0, 0,
449 // Page.Bitmap.Canvas.Width,
450 // Page.Bitmap.Canvas.Height);
451 DestRect.Left := -Round(ScrollBarHoriz.Position / ScrollBarHoriz.Max * Width * PrintPreview.Zoom);
452 DestRect.Top := -Round(ScrollBarVert.Position / ScrollBarVert.Max * Height * PrintPreview.Zoom);
453 DestRect.Right := DestRect.Left + Round(Page.Bitmap.Canvas.Width * PrintPreview.Zoom);
454 DestRect.Bottom := DestRect.Top + Round(Page.Bitmap.Canvas.Height * PrintPreview.Zoom);
455 try
456 Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
457 Image1.Picture.Bitmap.BeginUpdate(True);
458 with Image1.Picture.Bitmap, Canvas do begin
459 Brush.Color := clBlack;
460 Brush.Style := bsSolid;
461 FillRect(Rect(0, 0, Width, Height));
462 Draw(DestRect.Left, DestRect.Top, Page.Bitmap);
463 //CopyRect(DestRect, Page.Bitmap.Canvas, SourceRect);
464 Pen.Style := psSolid;
465 Pen.Color := clBlack;
466 Frame(DestRect);
467 end;
468 finally
469 Image1.Picture.Bitmap.EndUpdate;
470 end;
471end;
472
473procedure TPrintPreviewForm.APageSetupExecute(Sender: TObject);
474begin
475 with PrintPreview do begin
476 PageSetupDialog1.Margins := Rect(MarginsMM.Left * 100,
477 MarginsMM.Top * 100,
478 MarginsMM.Right * 100,
479 MarginsMM.Bottom * 100);
480 if PageSetupDialog1.Execute then begin
481 MarginsMM := Rect(Round(PageSetupDialog1.Margins.Left / 100),
482 Round(PageSetupDialog1.Margins.Top / 100),
483 Round(PageSetupDialog1.Margins.Right / 100),
484 Round(PageSetupDialog1.Margins.Bottom / 100));
485 UpdateMargins;
486 Redraw;
487 end;
488 end;
489end;
490
491procedure TPrintPreviewForm.APreviousPageExecute(Sender: TObject);
492begin
493 Dec(PageNumber);
494 if PageNumber < 0 then PageNumber := 0;
495 ReloadPageNumber;
496end;
497
498procedure TPrintPreviewForm.ANextPageExecute(Sender: TObject);
499begin
500 Inc(PageNumber);
501 if PageNumber >= PrintPreview.PageCount then
502 PageNumber := PrintPreview.PageCount;
503 ReloadPageNumber;
504end;
505
506procedure TPrintPreviewForm.ALastPageExecute(Sender: TObject);
507begin
508 PageNumber := PrintPreview.PageCount - 1;
509 ReloadPageNumber;
510end;
511
512procedure TPrintPreviewForm.AFirstPageExecute(Sender: TObject);
513begin
514 PageNumber := 0;
515 ReloadPageNumber;
516end;
517
518procedure TPrintPreviewForm.ACloseExecute(Sender: TObject);
519begin
520 Close;
521end;
522
523procedure TPrintPreviewForm.APrinterSetupExecute(Sender: TObject);
524begin
525 PrinterSetupDialog1.Execute;
526end;
527
528initialization
529 {$I UPrintPreview.lrs}
530
531end.
532
Note: See TracBrowser for help on using the repository browser.