turbopoweripro: added select printer; resourcestrings of captions, autosize, anchors for labels and buttons in print preview dlg by Žilvinas Ledas (issue #0017559)

git-svn-id: trunk@27702 -
2025-09-26 06:49:34 +02:00 · 2010-10-14 03:13:59 +00:00 · 2010-10-14 03:13:59 +00:00 · 1732203228
commit 1732203228
parent 61112f9973
4 changed files with 228 additions and 85 deletions
--- a/components/turbopower_ipro/iphtml.pas
+++ b/components/turbopower_ipro/iphtml.pas
@ -3123,6 +3123,7 @@ type
    procedure HideHint;
    function HtmlPanel: TIpHtmlCustomPanel;
    procedure BeginPrint;                                              {!!.10}
+    procedure ResetPrint;
    procedure EndPrint;                                                {!!.10}
  public
    ViewTop, ViewLeft : Integer;
@ -3151,6 +3152,7 @@ type
    function GetPrintPageCount: Integer;
    procedure PrintPages(FromPage, ToPage: Integer);
    procedure PrintPreview;
+    function SelectPrinterDlg: boolean;
    procedure EraseBackground(DC: HDC); {$IFDEF IP_LAZARUS} override; {$ENDIF} //JMN
  end;

@ -3603,7 +3605,8 @@ implementation

 uses
  Printers,
-  IpHtmlPv;  {!!.10}
+  IpHtmlPv,  {!!.10}
+  PrintersDlgs;

 {$IFNDEF IP_LAZARUS}
 {$R *.res}
@ -17311,20 +17314,39 @@ end;

 {!!.10 new}
 procedure TIpHtmlInternalPanel.BeginPrint;
+begin
+  if InPrint = 0 then begin
+    Printed := False;
+    ScaleBitmaps := True;
+    ResetPrint;
+  end;
+  Inc(InPrint);
+end;
+
+{!!.10 new}
+procedure TIpHtmlInternalPanel.EndPrint;
+begin
+  Dec(InPrint);
+  if InPrint = 0 then begin
+    ScaleBitmaps := False;
+    InvalidateSize;
+  end;
+end;
+
+procedure TIpHtmlInternalPanel.ResetPrint;
 var
  LogPixX, LMarginPix, RMarginPix,
  LogPixY, TMarginPix, BMarginPix,
  H: Integer;
 begin
-  if InPrint = 0 then begin
+  // check ir BeginPrint was called
+  if not Printed then begin
    SetRectEmpty(PrintPageRect);
    if Hyper.TitleNode <> nil then
      Printer.Title := Hyper.TitleNode.Title
    else
      Printer.Title := 'HTML Document';
    Printer.BeginDoc;
-    Printed := False;
-    ScaleBitmaps := True;
    GetRelativeAspect(Printer.Canvas.Handle);
    {$IF DEFINED(IP_LAZARUS) AND NOT DEFINED(WINDOWS)}
    // this test looks weird, according to most references consulted, the number
@ -17349,32 +17371,34 @@ begin
    {$ENDIF}
    TMarginPix := round(HtmlPanel.PrintSettings.MarginTop * LogPixY);
    BMarginPix := round(HtmlPanel.PrintSettings.MarginBottom * LogPixY);
-    PrintHeight := Printer.PageHeight - TMarginPix - BMarginPix;
+    if Printer.Printers.Count = 0 then begin
+      PrintHeight := 500;
+    end else begin
+      PrintHeight := Printer.PageHeight - TMarginPix - BMarginPix;
+    end;
    PrintTopLeft := Point(LMarginPix, TMarginPix);
    {PrintBottomRight := Point(
      Printer.PageWidth - RMarginPix,
-      Printer.PageHeight - BMarginPix);}                               {!!.12}
-    PrintPageRect := Hyper.GetPageRect(Printer.Canvas,
-      PrintWidth, PrintHeight);
+      Printer.PageHeight - BMarginPix);}                {!!.12}
+    PrintPageRect := Hyper.GetPageRect(Printer.Canvas, PrintWidth, PrintHeight);
    H := PrintPageRect.Bottom - PrintPageRect.Top;
    PageCount := H div PrintHeight;
    if H mod PrintHeight <> 0 then
      Inc(PageCount);
-  end;
-  Inc(InPrint);
+    Printer.Abort;
+  end else
+    raise Exception.Create('BeginPrint must be called before ResetPrint.');
 end;

-{!!.10 new}
-procedure TIpHtmlInternalPanel.EndPrint;
+function TIpHtmlInternalPanel.SelectPrinterDlg: boolean;
+var
+  printDialog: TPrintDialog;
 begin
-  Dec(InPrint);
-  if InPrint = 0 then begin
-    if Printed then
-      Printer.EndDoc
-    else
-      Printer.Abort;
-    ScaleBitmaps := False;
-    InvalidateSize;
+  Result := False;
+  printDialog := TPrintDialog.Create(nil);
+  if printDialog.Execute then begin
+    ResetPrint;
+    Result := true;
  end;
 end;

@ -17386,8 +17410,8 @@ var
 begin
  {CR := Rect(0, 0, Printer.PageWidth, 0);}
  if (Hyper <> nil) then begin
-    {Printer.BeginDoc;}
    BeginPrint;                                                        {!!.10}
+    Printer.BeginDoc;
    try
      (*
      ScaleBitmaps := True;                                            {!!.02}
@ -17406,7 +17430,10 @@ begin
      end;
    finally
      {ScaleBitmaps := False;}                                         {!!.10}
-      {Printer.EndDoc;}                                                {!!.10}
+      if Printed then
+        Printer.EndDoc
+      else
+        Printer.Abort;
      {InvalidateSize;}                                                {!!.10}
      EndPrint;                                                        {!!.10}
    end;
--- a/components/turbopower_ipro/iphtmlpv.lfm
+++ b/components/turbopower_ipro/iphtmlpv.lfm
@ -1,12 +1,11 @@
 object IpHTMLPreview: TIpHTMLPreview
-  Left = 196
-  Height = 338
-  Top = 103
-  Width = 558
-  ActiveControl = btnPrint
+  Left = 274
+  Height = 372
+  Top = 141
+  Width = 645
  Caption = 'Print preview'
-  ClientHeight = 338
-  ClientWidth = 558
+  ClientHeight = 372
+  ClientWidth = 645
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  OnCreate = FormCreate
@ -14,117 +13,181 @@ object IpHTMLPreview: TIpHTMLPreview
  OnResize = FormResize
  OnShow = FormShow
  Position = poScreenCenter
-  LCLVersion = '0.9.25'
+  LCLVersion = '0.9.29'
  object Panel1: TPanel
-    Height = 41
-    Width = 558
+    Left = 0
+    Height = 33
+    Top = 0
+    Width = 645
    Align = alTop
-    BevelOuter = bvLowered
-    ClientHeight = 41
-    ClientWidth = 558
+    AutoSize = True
+    BevelOuter = bvNone
+    ClientHeight = 33
+    ClientWidth = 645
    TabOrder = 0
    object Label1: TLabel
-      Left = 360
+      AnchorSideLeft.Control = btnPrev
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 398
      Height = 14
-      Top = 14
+      Top = 9
      Width = 29
+      BorderSpacing.Around = 5
      Caption = 'Page:'
      ParentColor = False
    end
    object Label2: TLabel
-      Left = 440
+      AnchorSideLeft.Control = edtPage
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 469
      Height = 14
-      Top = 14
+      Top = 9
      Width = 10
+      BorderSpacing.Around = 5
      Caption = 'of'
      ParentColor = False
    end
    object lblMaxPage: TLabel
-      Left = 457
-      Height = 14
-      Top = 14
-      Width = 4
+      AnchorSideLeft.Control = Label2
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 484
+      Height = 1
+      Top = 16
+      Width = 1
+      BorderSpacing.Around = 5
      ParentColor = False
    end
    object Label3: TLabel
-      Left = 96
+      AnchorSideLeft.Control = btnSelectPrinter
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 159
      Height = 14
-      Top = 16
+      Top = 9
      Width = 31
+      BorderSpacing.Around = 5
      Caption = 'Zoom:'
      ParentColor = False
    end
    object btnPrint: TButton
-      Left = 8
-      Height = 25
-      Top = 8
-      Width = 75
+      Left = 5
+      Height = 23
+      Top = 5
+      Width = 47
+      AutoSize = True
+      BorderSpacing.Around = 5
      Caption = 'Print'
      Default = True
      OnClick = btnPrintClick
      TabOrder = 0
    end
    object btnFirst: TButton
-      Left = 280
-      Height = 25
-      Top = 8
-      Width = 32
+      AnchorSideLeft.Control = btnClose
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 318
+      Height = 23
+      Top = 5
+      Width = 38
+      AutoSize = True
+      BorderSpacing.Around = 5
      Caption = '<<'
      OnClick = btnFirstClick
      TabOrder = 1
    end
    object btnPrev: TButton
-      Left = 320
-      Height = 25
-      Top = 8
+      AnchorSideLeft.Control = btnFirst
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 361
+      Height = 23
+      Top = 5
      Width = 32
+      AutoSize = True
+      BorderSpacing.Around = 5
      Caption = '<'
      OnClick = btnPrevClick
      TabOrder = 2
    end
    object btnNext: TButton
-      Left = 472
-      Height = 25
-      Top = 8
+      AnchorSideLeft.Control = lblMaxPage
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 490
+      Height = 23
+      Top = 5
      Width = 32
+      AutoSize = True
+      BorderSpacing.Around = 5
      Caption = '>'
      OnClick = btnNextClick
      TabOrder = 4
    end
    object btnLast: TButton
-      Left = 512
-      Height = 25
-      Top = 8
-      Width = 32
+      AnchorSideLeft.Control = btnNext
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 527
+      Height = 23
+      Top = 5
+      Width = 38
+      AutoSize = True
+      BorderSpacing.Around = 5
      Caption = '>>'
      OnClick = btnLastClick
      TabOrder = 5
    end
    object btnClose: TButton
-      Left = 200
-      Height = 25
-      Top = 8
-      Width = 75
+      AnchorSideLeft.Control = ZoomCombo
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 261
+      Height = 23
+      Top = 5
+      Width = 52
+      AutoSize = True
+      BorderSpacing.Around = 5
      Cancel = True
      Caption = 'Close'
      ModalResult = 2
      TabOrder = 6
    end
    object edtPage: TEdit
-      Left = 400
+      AnchorSideLeft.Control = Label1
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 432
      Height = 21
-      Top = 10
+      Top = 6
      Width = 32
+      BorderSpacing.Around = 5
      OnChange = edtPageChange
      TabOrder = 3
      Text = '1'
    end
    object ZoomCombo: TComboBox
-      Left = 132
+      AnchorSideLeft.Control = Label3
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 195
      Height = 21
-      Top = 10
+      Top = 6
      Width = 61
-      AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
+      BorderSpacing.Around = 5
      ItemHeight = 13
      Items.Strings = (
        '10%'
@ -137,35 +200,54 @@ object IpHTMLPreview: TIpHTMLPreview
        '300%'
        '400%'
      )
-      MaxLength = 0
      OnChange = ZoomComboChange
      Style = csDropDownList
      TabOrder = 7
    end
+    object btnSelectPrinter: TButton
+      AnchorSideLeft.Control = btnPrint
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 57
+      Height = 23
+      Top = 5
+      Width = 97
+      AutoSize = True
+      BorderSpacing.Around = 5
+      Caption = 'Select printer...'
+      OnClick = btnSelectPrinterClick
+      TabOrder = 8
+    end
  end
  object ScrollBox1: TScrollBox
-    Height = 297
-    Top = 41
-    Width = 558
+    Left = 0
+    Height = 339
+    Top = 33
+    Width = 645
    Align = alClient
+    ClientHeight = 335
+    ClientWidth = 641
    Color = clBtnFace
    ParentColor = False
    TabOrder = 1
    object PaperPanel: TPanel
-      Left = 16
-      Height = 153
-      Top = 8
-      Width = 185
+      Left = 0
+      Height = 125
+      Top = 0
+      Width = 158
      BevelOuter = bvNone
-      ClientHeight = 153
-      ClientWidth = 185
+      ClientHeight = 125
+      ClientWidth = 158
      Color = clWhite
      ParentColor = False
      TabOrder = 0
      object PaintBox1: TPaintBox
-        Left = 16
+        AnchorSideLeft.Side = asrCenter
+        AnchorSideTop.Side = asrCenter
+        Left = 0
        Height = 113
-        Top = 24
+        Top = 0
        Width = 145
        OnPaint = PaintBox1Paint
      end
--- a/components/turbopower_ipro/iphtmlpv.pas
+++ b/components/turbopower_ipro/iphtmlpv.pas
@ -46,14 +46,28 @@ uses
  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, IpHtml;

+resourcestring
+  rsIpHTMLPreviewPrintPreview = 'Print preview';
+  rsIpHTMLPreviewPrint = 'Print';
+  rsIpHTMLPreviewZoom = 'Zoom:';
+  rsIpHTMLPreviewClose = 'Close';
+  rsIpHTMLPreviewPage = 'Page:';
+  rsIpHTMLPreviewOf = 'of';
+  rsIpHTMLPreviewSelectPrinter = 'Select printer...';
+
 type
+
+  { TIpHTMLPreview }
+
  TIpHTMLPreview = class(TForm)
+    btnSelectPrinter: TButton;
    Label3: TLabel;
    ZoomCombo: TComboBox;
    PaperPanel: TPanel;
    PaintBox1: TPaintBox;
    procedure btnNextClick(Sender: TObject);
    procedure btnLastClick(Sender: TObject);
+    procedure btnSelectPrinterClick(Sender: TObject);
    procedure edtPageChange(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
@ -163,6 +177,13 @@ begin
  CurPage := OwnerPanel.PageCount;
 end;

+procedure TIpHTMLPreview.btnSelectPrinterClick(Sender: TObject);
+begin
+  if OwnerPanel <> nil then
+    if OwnerPanel.SelectPrinterDlg then
+      SetZoom(Zoom); {force recalc of preview sizes}
+end;
+
 procedure TIpHTMLPreview.edtPageChange(Sender: TObject);
 begin
  CurPage := StrToInt(edtPage.Text);
@ -177,6 +198,7 @@ begin
  finally
    ScaleFonts := True;
    Screen.Cursor := crDefault;
+    Close;
  end;
 end;

@ -263,6 +285,15 @@ begin
  Scratch := TBitmap.Create;
  Scratch.Width := SCRATCH_WIDTH;
  Scratch.Height := SCRATCH_HEIGHT;
+
+  // localization
+  Self.Caption := rsIpHTMLPreviewPrintPreview;
+  btnPrint.Caption := rsIpHTMLPreviewPrint;
+  Label3.Caption := rsIpHTMLPreviewZoom;
+  btnClose.Caption := rsIpHTMLPreviewClose;
+  Label1.Caption := rsIpHTMLPreviewPage;
+  Label2.Caption := rsIpHTMLPreviewOf;
+  btnSelectPrinter.Caption := rsIpHTMLPreviewSelectPrinter
 end;

 procedure TIpHTMLPreview.SetZoom(const Value: Integer);
--- a/components/turbopower_ipro/turbopoweripro.lpk
+++ b/components/turbopower_ipro/turbopoweripro.lpk
@ -77,10 +77,13 @@
      <OutDir Value="languages"/>
    </i18n>
    <Type Value="RunAndDesignTime"/>
-    <RequiredPkgs Count="1">
+    <RequiredPkgs Count="2">
      <Item1>
        <PackageName Value="LCL"/>
      </Item1>
+      <Item2>
+        <PackageName Value="Printer4Lazarus"/>
+      </Item2>
    </RequiredPkgs>
    <UsageOptions>
      <UnitPath Value="$(PkgOutDir)/"/>