1 {******************************************************************}
2 {* IPHTMLPV.PAS - HTML Browser Print Preview *}
3 {******************************************************************}
4
5 (* ***** BEGIN LICENSE BLOCK *****
6 * Version: MPL 1.1
7 *
8 * The contents of this file are subject to the Mozilla Public License Version
9 * 1.1 (the "License"); you may not use this file except in compliance with
10 * the License. You may obtain a copy of the License at
11 * http://www.mozilla.org/MPL/
12 *
13 * Software distributed under the License is distributed on an "AS IS" basis,
14 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
15 * for the specific language governing rights and limitations under the
16 * License.
17 *
18 * The Original Code is TurboPower Internet Professional
19 *
20 * The Initial Developer of the Original Code is
21 * TurboPower Software
22 *
23 * Portions created by the Initial Developer are Copyright (C) 2000-2002
24 * the Initial Developer. All Rights Reserved.
25 *
26 * Contributor(s):
27 *
28 * ***** END LICENSE BLOCK ***** *)
29
30 { Global defines potentially affecting this unit }
31 {$I IPDEFINE.INC}
32
33 unit IpHtmlPv;
34
35 {$IFNDEF Html_Print}
36 {$ERROR requires -dHTML_Print}
37 {$ENDIF}
38
39 interface
40
41 uses
42 LCLType,
43 GraphType,
44 LCLIntf,
45 Buttons,
46 Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
47 StdCtrls, ExtCtrls, Spin, IpHtml, IpConst;
48
49 type
50
51 { TIpHTMLPreview }
52
53 TIpHTMLPreview = class(TForm)
54 btnFitHeight: TButton;
55 btnFitWidth: TButton;
56 btnFit: TButton;
57 btnSelectPrinter: TButton;
58 Label3: TLabel;
59 PaperPanel: TPanel;
60 PaintBox1: TPaintBox;
61 edtZoom: TSpinEdit;
62 ToolbarPanel: TPanel;
63 btnPrint: TButton;
64 btnFirst: TButton;
65 btnPrev: TButton;
66 btnNext: TButton;
67 btnLast: TButton;
68 btnClose: TButton;
69 edtPage: TEdit;
70 Label1: TLabel;
71 Label2: TLabel;
72 lblMaxPage: TLabel;
73 ScrollBox1: TScrollBox;
74 procedure btnFirstClick(Sender: TObject);
75 procedure btnFitClick(Sender: TObject);
76 procedure btnFitHeightClick(Sender: TObject);
77 procedure btnFitWidthClick(Sender: TObject);
78 procedure btnLastClick(Sender: TObject);
79 procedure btnNextClick(Sender: TObject);
80 procedure btnPrevClick(Sender: TObject);
81 procedure btnPrintClick(Sender: TObject);
82 procedure btnSelectPrinterClick(Sender: TObject);
83 procedure edtPageChange(Sender: TObject);
84 procedure edtZoomChange(Sender: TObject);
85 procedure FormCreate(Sender: TObject);
86 procedure FormDestroy(Sender: TObject);
87 procedure FormResize(Sender: TObject);
88 procedure FormShow(Sender: TObject);
89 procedure PaintBox1Paint(Sender: TObject);
90 private
91 SourceRect: TRect;
92 Scratch: TBitmap;
93 FScale: double;
94 FZoom: Integer;
95 FZoomToFit: Integer;
96 FLockZoomUpdate: Integer;
97 procedure SetCurPage(const Value: Integer);
98 procedure SetZoom(const Value: Integer);
99 protected
100 procedure AlignPaintBox;
101 procedure Render;
102 procedure ResizeCanvas;
103 // procedure ScaleSourceRect;
104 procedure UpdateBtnStates;
105 public
106 FCurPage: Integer;
107 HTML : TIpHtml;
108 PageRect: TRect;
109 OwnerPanel: TIpHtmlInternalPanel;
110 procedure RenderPage(PageNo: Integer);
111 property CurPage: Integer read FCurPage write SetCurPage;
112 property Scale: double read FScale;
113 property Zoom: Integer read FZoom write SetZoom;
114 end;
115
116
117 implementation
118
119 uses
120 Printers;
121
122 {$R *.lfm}
123
124 const
125 SCRATCH_WIDTH = 800; //640;
126 SCRATCH_HEIGHT = 600; //480;
127 ZOOM_FACTOR = 1.1;
128
ScaleRectnull129 function ScaleRect(ARect: TRect; AFactor: Double): TRect;
130 begin
131 Result.Left := round(ARect.Left * AFactor);
132 Result.Top := round(ARect.Top * AFactor);
133 Result.Right := round(ARect.Right * AFactor);
134 Result.Bottom := round(ARect.Bottom * AFactor);
135 end;
136
137 procedure TIpHTMLPreview.AlignPaintBox;
138 var
139 sb: Integer;
140 begin
141 sb := GetSystemMetrics(SM_CXVSCROLL);
142 if PaperPanel.Width < ClientWidth - sb then
143 PaperPanel.Left := (ClientWidth - sb - PaperPanel.Width) div 2
144 else
145 PaperPanel.Left := 0;
146
147 sb := GetSystemMetrics(SM_CXHSCROLL);
148 if PaperPanel.Height < ClientHeight - sb - ToolbarPanel.Height then
149 PaperPanel.Top := (ClientHeight - sb - ToolbarPanel.Height - PaperPanel.Height) div 2
150 else
151 PaperPanel.Top := 0;
152 end;
153
154 procedure TIpHTMLPreview.btnFirstClick(Sender: TObject);
155 begin
156 CurPage := 1;
157 end;
158
159 procedure TIpHTMLPreview.btnFitClick(Sender: TObject);
160 begin
161 SetZoom(ZOOM_TO_FIT);
162 end;
163
164 procedure TIpHTMLPreview.btnFitHeightClick(Sender: TObject);
165 begin
166 SetZoom(ZOOM_TO_FIT_HEIGHT);
167 end;
168
169 procedure TIpHTMLPreview.btnFitWidthClick(Sender: TObject);
170 begin
171 SetZoom(ZOOM_TO_FIT_WIDTH);
172 end;
173
174 procedure TIpHTMLPreview.btnLastClick(Sender: TObject);
175 begin
176 CurPage := OwnerPanel.PageCount;
177 end;
178
179 procedure TIpHTMLPreview.btnNextClick(Sender: TObject);
180 begin
181 CurPage := CurPage + 1;
182 end;
183
184 procedure TIpHTMLPreview.btnPrevClick(Sender: TObject);
185 begin
186 CurPage := CurPage - 1;
187 end;
188
189 procedure TIpHTMLPreview.btnSelectPrinterClick(Sender: TObject);
190 begin
191 if OwnerPanel <> nil then
192 if OwnerPanel.SelectPrinterDlg then
193 SetZoom(Zoom); {force recalc of preview sizes}
194 end;
195
196 procedure TIpHTMLPreview.btnPrintClick(Sender: TObject);
197 begin
198 Screen.Cursor := crHourglass;
199 ScaleFonts := False;
200 try
201 OwnerPanel.PrintPages(1, OwnerPanel.PageCount);
202 finally
203 ScaleFonts := True;
204 Screen.Cursor := crDefault;
205 Close;
206 end;
207 end;
208
209 procedure TIpHTMLPreview.edtPageChange(Sender: TObject);
210 begin
211 CurPage := StrToInt(edtPage.Text);
212 end;
213
214 procedure TIpHTMLPreview.edtZoomChange(Sender: TObject);
215 var
216 newZoom: Double;
217 begin
218 if (FLockZoomUpdate = 0) and TryStrToFloat(edtZoom.Text, newZoom) then
219 SetZoom(Round(newZoom));
220 end;
221
222 procedure TIpHTMLPreview.FormCreate(Sender: TObject);
223 begin
224 FZoom := 100;
225 FZoomToFit := ZOOM_TO_FIT;
226 Scratch := TBitmap.Create;
227 Scratch.Width := SCRATCH_WIDTH;
228 Scratch.Height := SCRATCH_HEIGHT;
229
230 // localization
231 Self.Caption := rsIpHTMLPreviewPrintPreview;
232 btnPrint.Caption := rsIpHTMLPreviewPrint;
233 Label3.Caption := rsIpHTMLPreviewZoom;
234 btnClose.Caption := rsIpHTMLPreviewClose;
235 Label1.Caption := rsIpHTMLPreviewPage;
236 Label2.Caption := rsIpHTMLPreviewOf;
237 btnSelectPrinter.Caption := rsIpHTMLPreviewSelectPrinter;
238 btnFit.Caption := rsIpHTMLPreviewFitAll;
239 btnFitWidth.Caption := rsIpHTMLPreviewFitWidth;
240 btnFitHeight.Caption := rsIpHTMLPreviewFitHeight;
241 end;
242
243 procedure TIpHTMLPreview.FormDestroy(Sender: TObject);
244 begin
245 Scratch.Free;
246 end;
247
248 procedure TIpHTMLPreview.FormResize(Sender: TObject);
249 begin
250 if (FZoomToFit <= 0) and (OwnerPanel <> nil) then
251 SetZoom(FZoomToFit) {force recalc of preview sizes}
252 else
253 AlignPaintbox;
254 end;
255
256 procedure TIpHTMLPreview.FormShow(Sender: TObject);
257 begin
258 UpdateBtnStates;
259 RenderPage(CurPage);
260 end;
261
262 procedure TIpHTMLPreview.PaintBox1Paint(Sender: TObject);
263 begin
264 SourceRect := ScaleRect(PaintBox1.Canvas.ClipRect, 1.0/Scale);
265 OffsetRect(SourceRect, 0, PageRect.Top);
266 Render;
267 end;
268
269 procedure TIpHTMLPreview.Render;
270 var
271 TileTop, TileLeft,
272 WindowTop, WindowLeft: Integer;
273 R, Rscr: TRect;
274 begin
275 {GDI won't let us create a bitmap for a whole page
276 since it would become too big for large resolutions,
277 so we have to do banding by hand}
278
279 Screen.Cursor := crHourglass;
280 try
281 Application.ProcessMessages;
282 PaintBox1.Canvas.Brush.Color := clWhite;
283 PaintBox1.Canvas.FillRect(PaintBox1.Canvas.ClipRect);
284 PaintBox1.Canvas.AntialiasingMode := OwnerPanel.PreviewAntiAliasingMode;
285 WindowTop := SourceRect.Top;
286 TileTop := 0;
287 while WindowTop < SourceRect.Bottom do begin
288 WindowLeft := SourceRect.Left;
289 TileLeft := 0;
290 while WindowLeft < SourceRect.Right do begin
291 R.Left := WindowLeft;
292 R.Top := WindowTop;
293 R.Right := R.Left + SCRATCH_WIDTH + 1;
294 R.Bottom := R.Top + SCRATCH_HEIGHT + 1;
295 Rscr := R;
296 if R.Bottom - SourceRect.Top > OwnerPanel.PrintHeight then begin
297 Scratch.Canvas.FillRect(0, 0, R.Right-R.Left, R.Bottom-R.Top);
298 R.Bottom := SourceRect.Top + OwnerPanel.PrintHeight;
299 end;
300
301 HTML.Render(Scratch.Canvas, R, PageRect.Top, PageRect.Bottom, False, Point(0, 0));
302
303 OffsetRect(RScr, 0, -PageRect.Top);
304 Rscr := ScaleRect(Rscr, Scale);
305 PaintBox1.Canvas.StretchDraw(Rscr, Scratch);
306
307 inc(WindowLeft, SCRATCH_WIDTH);
308 inc(TileLeft, SCRATCH_WIDTH);
309 end;
310 inc(WindowTop, SCRATCH_HEIGHT);
311 inc(TileTop, SCRATCH_HEIGHT);
312 end;
313 finally
314 Screen.Cursor := crDefault;
315 end;
316
317 (*
318 This is an untiled version ...
319 var
320 R: TRect;
321 begin
322 // Render to single "scratch" bitmap which has the original print size and
323 // then is stretch-drawn into the preview paintbox.
324 Screen.Cursor := crHourglass;
325 try
326 Application.ProcessMessages;
327 Paintbox1.Canvas.Brush.Color := clWhite;
328 Paintbox1.Canvas.FillRect(Paintbox1.Canvas.ClipRect);
329 PaintBox1.Canvas.AntialiasingMode := OwnerPanel.PreviewAntiAliasingMode;
330 Scratch.Clear;
331 Scratch.Width := SourceRect.Right - SourceRect.Left;
332 Scratch.Height := SourceRect.Bottom - SourceRect.Top;
333
334 // probably not needed
335 Scratch.Canvas.Brush.Color := clWhite;
336 Scratch.Canvas.FillRect(SourceRect);
337
338 HTML.Render(Scratch.Canvas, SourceRect, PageRect.Top, PageRect.Bottom, False, Point(0, 0));
339
340 R := Paintbox1.Canvas.ClipRect;
341 PaintBox1.Canvas.StretchDraw(R, Scratch);
342 finally
343 Screen.Cursor := crDefault;
344 end;
345 *)
346 end;
347
348 procedure TIpHTMLPreview.RenderPage(PageNo: Integer);
349 var
350 CR : TRect;
351 begin
352 CR := Rect(0, 0, OwnerPanel.PrintWidth, 0);
353 CR.Top := (PageNo - 1) * OwnerPanel.PrintHeight;
354 CR.Bottom := Cr.Top + OwnerPanel.PrintHeight;
355 PageRect := CR;
356 PaintBox1.Invalidate;
357 end;
358
359 procedure TIpHTMLPreview.ResizeCanvas;
360 begin
361 ScrollBox1.HorzScrollBar.Position := 0;
362 ScrollBox1.VertScrollBar.Position := 0;
363 if Printer.PageHeight > 0 then
364 PaperPanel.Height := round(Printer.PageHeight * Scale)
365 else
366 PaperPanel.Height := round(500 * Scale);
367 if Printer.PageWidth > 0 then
368 PaperPanel.Width := round(Printer.PageWidth * Scale)
369 else
370 PaperPanel.Width := round(500 * Scale);
371
372 PaintBox1.Left := round(OwnerPanel.PrintTopLeft.x * Scale);
373 PaintBox1.Top := round(OwnerPanel.PrintTopLeft.y * Scale);
374 Paintbox1.Width := PaperPanel.Width - Paintbox1.Left;
375 Paintbox1.Height := PaperPanel.Height - Paintbox1.top;
376
377 AlignPaintBox;
378 end;
379
380 procedure TIpHTMLPreview.SetCurPage(const Value: Integer);
381 begin
382 if (Value <> FCurPage) and (Value >= 1) and (Value <= OwnerPanel.PageCount) then
383 begin
384 FCurPage := Value;
385 RenderPage(Value);
386 edtPage.Text := IntToStr(CurPage);
387 UpdateBtnStates;
388 end;
389 end;
390
391 procedure TIpHTMLPreview.SetZoom(const Value: Integer);
392 var
393 ClientHeightDbl, ClientWidthDbl: Double;
394 PrnPgHeight, PrnPgWidth: Double;
395 scaleW, scaleH: Integer;
396 sb: Integer;
397 begin
398 FZoomToFit := Value;
399
400 // Available client area in inches, without scrollbars
401 sb := GetSystemMetrics(SM_CXHSCROLL);
402 ClientHeightDbl := (ClientHeight - sb - ToolbarPanel.Height) / ScreenInfo.PixelsPerInchY;
403 sb := GetSystemMetrics(SM_CXVSCROLL);
404 ClientWidthDbl := (ClientWidth - sb)/ ScreenInfo.PixelsPerInchX;
405
406 // Printer page size in inches
407 PrnPgHeight := Printer.PageHeight / Printer.YDpi;
408 PrnPgWidth := Printer.PageWidth / Printer.XDpi;
409
410 case Value of
411 ZOOM_TO_FIT:
412 begin
413 scaleW := round(ClientWidthDbl / PrnPgWidth * 100);
414 scaleH := round(ClientHeightDbl / PrnPgHeight * 100);
415 if scaleW < scaleH then FZoom := scaleW else FZoom := scaleH;
416 end;
417 ZOOM_TO_FIT_WIDTH:
418 FZoom := round(ClientWidthDbl / PrnPgWidth * 100);
419 ZOOM_TO_FIT_HEIGHT:
420 FZoom := round(ClientHeightDbl / PrnPgHeight * 100);
421 else
422 FZoom := Value;
423 end;
424 inc(FLockZoomUpdate);
425 edtZoom.Value := FZoom;
426 dec(FLockZoomUpdate);
427 FScale := ScreenInfo.PixelsPerInchX / Printer.XDpi * FZoom * 0.01;
428
429 ResizeCanvas;
430 end;
431
432 procedure TIpHtmlPreview.UpdateBtnStates;
433 begin
434 btnFirst.Enabled := (FCurPage > 1);
435 btnPrev.Enabled := (FCurPage > 1);
436 btnNext.Enabled := (FCurPage < OwnerPanel.PageCount);
437 btnLast.Enabled := (FCurPage < OwnerPanel.PageCount);
438 end;
439
440 end.
441