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