fixed ipro flicker in win32 and added ipro print preview

git-svn-id: trunk@8302 -
2025-09-28 19:09:51 +02:00 · 2005-12-13 06:49:20 +00:00 · 2005-12-13 06:49:20 +00:00 · 7bc37435e5
commit 7bc37435e5
parent 04ae055762
5 changed files with 293 additions and 23 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -376,6 +376,8 @@ components/turbopower_ipro/ipdefct.inc svneol=native#text/pascal
 components/turbopower_ipro/ipdefine.inc svneol=native#text/pascal
 components/turbopower_ipro/iphtml.lrs svneol=native#text/pascal
 components/turbopower_ipro/iphtml.pas svneol=native#text/pascal
+components/turbopower_ipro/iphtmlpv.lfm svneol=native#text/plain
+components/turbopower_ipro/iphtmlpv.lrs svneol=native#text/pascal
 components/turbopower_ipro/iphtmlpv.pas svneol=native#text/pascal
 components/turbopower_ipro/ipmsg.pas svneol=native#text/pascal
 components/turbopower_ipro/ipstrms.pas svneol=native#text/pascal
--- a/components/turbopower_ipro/iphtml.pas
+++ b/components/turbopower_ipro/iphtml.pas
@ -2528,6 +2528,7 @@ type
    function GetPrintPageCount: Integer;
    procedure PrintPages(FromPage, ToPage: Integer);
    procedure PrintPreview;
+    procedure EraseBackground(DC: HDC); override;
  end;

  TIpAbstractHtmlDataProvider = class(TIpBaseComponent)
@ -2671,6 +2672,8 @@ type
    property MarginBottom: double read FMarginBottom write FMarginBottom;
  end;

+  { TIpHtmlCustomPanel }
+
  TIpHtmlCustomPanel = class(TCustomPanel)
  protected
    FFlagErrors: Boolean;
@ -2737,6 +2740,7 @@ type
    function GetPrintPageCount: Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
+    procedure EraseBackground(DC: HDC); override;

    procedure CopyToClipboard;
    procedure EnumDocuments(Enumerator: TIpHtmlEnumerator);
@ -15440,11 +15444,6 @@ end;

 {!!.10 new}
 procedure TIpHtmlInternalPanel.BeginPrint;
-{$IFDEF IP_LAZARUS}
-begin
-  DebugLn('ToDo: TIpHtmlInternalPanel.BeginPrint');
-end;
-{$ELSE}
 var
  LogPixX, LMarginPix, RMarginPix,
  LogPixY, TMarginPix, BMarginPix,
@ -15482,15 +15481,9 @@ begin
  end;
  inc(InPrint);
 end;
-{$ENDIF}

 {!!.10 new}
 procedure TIpHtmlInternalPanel.EndPrint;
-{$IFDEF IP_LAZARUS}
-begin
-  DebugLn('ToDo: TIpHtmlInternalPanel.BeginPrint');
-end;
-{$ELSE}
 begin
  dec(InPrint);
  if InPrint = 0 then begin
@ -15502,14 +15495,8 @@ begin
    InvalidateSize;
  end;
 end;
-{$ENDIF}

 procedure TIpHtmlInternalPanel.PrintPages(FromPage, ToPage: Integer);
-{$IFDEF IP_LAZARUS}
-begin
-  DebugLn('ToDo: TIpHtmlInternalPanel.BeginPrint');
-end;
-{$ELSE}
 var
  CR : TRect;
 var
@ -15543,7 +15530,6 @@ begin
    end;
  end;
 end;
-{$ENDIF}

 {!!.10 new}
 procedure TIpHtmlInternalPanel.PrintPreview;
@ -15574,6 +15560,11 @@ begin
  end;
 end;

+procedure TIpHtmlInternalPanel.EraseBackground(DC: HDC);
+begin
+  //
+end;
+
 function TIpHtmlInternalPanel.GetPrintPageCount: Integer;
 {var
  H : Integer;}                                                        {!!.10}
@ -16028,6 +16019,7 @@ begin
  Anchor.DoOnBlur;
  {HaveFocus := False;}                                                {!!.12}
 end;
+
 {$ELSE}
 procedure TIpHtmlFocusRect.WMSetFocus(var Message: TWMSetFocus);
 begin
@ -16041,8 +16033,8 @@ begin
  Anchor.DoOnBlur;
  {HaveFocus := False;}                                                {!!.12}
 end;
-{$ENDIF}

+{$ENDIF}
 { TIpHtmlFrame }

 procedure TIpHtmlFrame.InitHtml;
@ -17138,6 +17130,11 @@ begin
  inherited;
 end;

+procedure TIpHtmlCustomPanel.EraseBackground(DC: HDC);
+begin
+  //
+end;
+
 procedure TIpHtmlCustomPanel.OpenURL(const URL: string);
 begin
  InternalOpenURL('', URL);
@ -17487,6 +17484,14 @@ end;

 procedure TIpHtmlCustomPanel.PrintPreview;
 begin
+  {$IFDEF IP_LAZARUS}
+  if not assigned(printer) then begin
+    raise exception.create(
+      'Printer has not been assigned, checkout that package'#13+
+      'Printer4lazarus.lpk has been installed and OSPrinters'#13+
+      'or PrintDialog is in uses clause of main unit');
+  end;
+  {$ENDIF}
  if Assigned(MasterFrame) then
    MasterFrame.HyperPanel.PrintPreview;
 end;
--- a/components/turbopower_ipro/iphtmlpv.lfm
+++ b/components/turbopower_ipro/iphtmlpv.lfm
@ -0,0 +1,188 @@
+object IpHTMLPreview: TIpHTMLPreview
+  ActiveControl = btnPrint
+  Caption = 'Print preview'
+  ClientHeight = 338
+  ClientWidth = 558
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnResize = FormResize
+  OnShow = FormShow
+  PixelsPerInch = 96
+  Position = poScreenCenter
+  TextHeight = 13
+  HorzScrollBar.Page = 557
+  VertScrollBar.Page = 337
+  Left = 196
+  Height = 338
+  Top = 103
+  Width = 558
+  object Panel1: TPanel
+    Align = alTop
+    BevelOuter = bvLowered
+    ClientHeight = 41
+    ClientWidth = 558
+    TabOrder = 0
+    Height = 41
+    Width = 558
+    object Label1: TLabel
+      Caption = 'Page:'
+      Color = clNone
+      ParentColor = False
+      Left = 360
+      Height = 14
+      Top = 14
+      Width = 29
+    end
+    object Label2: TLabel
+      Caption = 'of'
+      Color = clNone
+      ParentColor = False
+      Left = 440
+      Height = 14
+      Top = 14
+      Width = 10
+    end
+    object lblMaxPage: TLabel
+      Color = clNone
+      ParentColor = False
+      Left = 457
+      Height = 14
+      Top = 14
+      Width = 4
+    end
+    object Label3: TLabel
+      Caption = 'Zoom:'
+      Color = clNone
+      ParentColor = False
+      Left = 96
+      Height = 14
+      Top = 16
+      Width = 31
+    end
+    object btnPrint: TButton
+      BorderSpacing.InnerBorder = 2
+      Caption = 'Print'
+      Default = True
+      OnClick = btnPrintClick
+      TabOrder = 0
+      Left = 8
+      Height = 25
+      Top = 8
+      Width = 75
+    end
+    object btnFirst: TButton
+      BorderSpacing.InnerBorder = 2
+      Caption = '<<'
+      OnClick = btnFirstClick
+      TabOrder = 1
+      Left = 280
+      Height = 25
+      Top = 8
+      Width = 32
+    end
+    object btnPrev: TButton
+      BorderSpacing.InnerBorder = 2
+      Caption = '<'
+      OnClick = btnPrevClick
+      TabOrder = 2
+      Left = 320
+      Height = 25
+      Top = 8
+      Width = 32
+    end
+    object btnNext: TButton
+      BorderSpacing.InnerBorder = 2
+      Caption = '>'
+      OnClick = btnNextClick
+      TabOrder = 4
+      Left = 472
+      Height = 25
+      Top = 8
+      Width = 32
+    end
+    object btnLast: TButton
+      BorderSpacing.InnerBorder = 2
+      Caption = '>>'
+      OnClick = btnLastClick
+      TabOrder = 5
+      Left = 512
+      Height = 25
+      Top = 8
+      Width = 32
+    end
+    object btnClose: TButton
+      BorderSpacing.InnerBorder = 2
+      Cancel = True
+      Caption = 'Close'
+      ModalResult = 2
+      TabOrder = 6
+      Left = 200
+      Height = 25
+      Top = 8
+      Width = 75
+    end
+    object edtPage: TEdit
+      OnChange = edtPageChange
+      TabOrder = 3
+      Text = '1'
+      Left = 400
+      Height = 21
+      Top = 10
+      Width = 32
+    end
+    object ZoomCombo: TComboBox
+      ItemHeight = 13
+      Items.Strings = (
+        '10%'
+        '25%'
+        '50%'
+        '75%'
+        '100%'
+        '150%'
+        '200%'
+        '300%'
+        '400%'
+      )
+      MaxLength = 0
+      OnChange = ZoomComboChange
+      Style = csDropDownList
+      TabOrder = 7
+      Left = 132
+      Height = 21
+      Top = 10
+      Width = 61
+    end
+  end
+  object ScrollBox1: TScrollBox
+    Align = alClient
+    Color = clBtnFace
+    ParentColor = False
+    TabOrder = 1
+    HorzScrollBar.Page = 553
+    VertScrollBar.Page = 292
+    Height = 297
+    Top = 41
+    Width = 558
+    object PaperPanel: TPanel
+      BevelOuter = bvNone
+      ClientHeight = 153
+      ClientWidth = 185
+      Color = clWhite
+      ParentColor = False
+      TabOrder = 0
+      Left = 16
+      Height = 153
+      Top = 8
+      Width = 185
+      object PaintBox1: TPaintBox
+        OnPaint = PaintBox1Paint
+        Left = 16
+        Height = 113
+        Top = 24
+        Width = 145
+      end
+    end
+  end
+end
--- a/components/turbopower_ipro/iphtmlpv.lrs
+++ b/components/turbopower_ipro/iphtmlpv.lrs
@ -0,0 +1,49 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TIpHTMLPreview','FORMDATA',[
+  'TPF0'#14'TIpHTMLPreview'#13'IpHTMLPreview'#13'ActiveControl'#7#8'btnPrint'#7
+  +'Caption'#6#13'Print preview'#12'ClientHeight'#3'R'#1#11'ClientWidth'#3'.'#2
+  +#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#8'OnCreate'#7#10'For'
+  +'mCreate'#9'OnDestroy'#7#11'FormDestroy'#8'OnResize'#7#10'FormResize'#6'OnSh'
+  +'ow'#7#8'FormShow'#13'PixelsPerInch'#2'`'#8'Position'#7#14'poScreenCenter'#10
+  +'TextHeight'#2#13#18'HorzScrollBar.Page'#3'-'#2#18'VertScrollBar.Page'#3'Q'#1
+  +#4'Left'#3#196#0#6'Height'#3'R'#1#3'Top'#2'g'#5'Width'#3'.'#2#0#6'TPanel'#6
+  +'Panel1'#5'Align'#7#5'alTop'#10'BevelOuter'#7#9'bvLowered'#12'ClientHeight'#2
+  +')'#11'ClientWidth'#3'.'#2#8'TabOrder'#2#0#6'Height'#2')'#5'Width'#3'.'#2#0#6
+  +'TLabel'#6'Label1'#7'Caption'#6#5'Page:'#5'Color'#7#6'clNone'#11'ParentColor'
+  +#8#4'Left'#3'h'#1#6'Height'#2#14#3'Top'#2#14#5'Width'#2#29#0#0#6'TLabel'#6'L'
+  +'abel2'#7'Caption'#6#2'of'#5'Color'#7#6'clNone'#11'ParentColor'#8#4'Left'#3
+  +#184#1#6'Height'#2#14#3'Top'#2#14#5'Width'#2#10#0#0#6'TLabel'#10'lblMaxPage'
+  +#5'Color'#7#6'clNone'#11'ParentColor'#8#4'Left'#3#201#1#6'Height'#2#14#3'Top'
+  +#2#14#5'Width'#2#4#0#0#6'TLabel'#6'Label3'#7'Caption'#6#5'Zoom:'#5'Color'#7#6
+  +'clNone'#11'ParentColor'#8#4'Left'#2'`'#6'Height'#2#14#3'Top'#2#16#5'Width'#2
+  +#31#0#0#7'TButton'#8'btnPrint'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6
+  +#5'Print'#7'Default'#9#7'OnClick'#7#13'btnPrintClick'#8'TabOrder'#2#0#4'Left'
+  +#2#8#6'Height'#2#25#3'Top'#2#8#5'Width'#2'K'#0#0#7'TButton'#8'btnFirst'#25'B'
+  +'orderSpacing.InnerBorder'#2#2#7'Caption'#6#2'<<'#7'OnClick'#7#13'btnFirstCl'
+  +'ick'#8'TabOrder'#2#1#4'Left'#3#24#1#6'Height'#2#25#3'Top'#2#8#5'Width'#2' '
+  +#0#0#7'TButton'#7'btnPrev'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#1
+  +'<'#7'OnClick'#7#12'btnPrevClick'#8'TabOrder'#2#2#4'Left'#3'@'#1#6'Height'#2
+  +#25#3'Top'#2#8#5'Width'#2' '#0#0#7'TButton'#7'btnNext'#25'BorderSpacing.Inne'
+  +'rBorder'#2#2#7'Caption'#6#1'>'#7'OnClick'#7#12'btnNextClick'#8'TabOrder'#2#4
+  +#4'Left'#3#216#1#6'Height'#2#25#3'Top'#2#8#5'Width'#2' '#0#0#7'TButton'#7'bt'
+  +'nLast'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#2'>>'#7'OnClick'#7#12
+  +'btnLastClick'#8'TabOrder'#2#5#4'Left'#3#0#2#6'Height'#2#25#3'Top'#2#8#5'Wid'
+  +'th'#2' '#0#0#7'TButton'#8'btnClose'#25'BorderSpacing.InnerBorder'#2#2#6'Can'
+  +'cel'#9#7'Caption'#6#5'Close'#11'ModalResult'#2#2#8'TabOrder'#2#6#4'Left'#3
+  +#200#0#6'Height'#2#25#3'Top'#2#8#5'Width'#2'K'#0#0#5'TEdit'#7'edtPage'#8'OnC'
+  +'hange'#7#13'edtPageChange'#8'TabOrder'#2#3#4'Text'#6#1'1'#4'Left'#3#144#1#6
+  +'Height'#2#21#3'Top'#2#10#5'Width'#2' '#0#0#9'TComboBox'#9'ZoomCombo'#10'Ite'
+  +'mHeight'#2#13#13'Items.Strings'#1#6#3'10%'#6#3'25%'#6#3'50%'#6#3'75%'#6#4'1'
+  +'00%'#6#4'150%'#6#4'200%'#6#4'300%'#6#4'400%'#0#9'MaxLength'#2#0#8'OnChange'
+  +#7#15'ZoomComboChange'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#7#4'Left'
+  +#3#132#0#6'Height'#2#21#3'Top'#2#10#5'Width'#2'='#0#0#0#10'TScrollBox'#10'Sc'
+  +'rollBox1'#5'Align'#7#8'alClient'#5'Color'#7#9'clBtnFace'#11'ParentColor'#8#8
+  +'TabOrder'#2#1#18'HorzScrollBar.Page'#3')'#2#18'VertScrollBar.Page'#3'$'#1#6
+  +'Height'#3')'#1#3'Top'#2')'#5'Width'#3'.'#2#0#6'TPanel'#10'PaperPanel'#10'Be'
+  +'velOuter'#7#6'bvNone'#12'ClientHeight'#3#153#0#11'ClientWidth'#3#185#0#5'Co'
+  +'lor'#7#7'clWhite'#11'ParentColor'#8#8'TabOrder'#2#0#4'Left'#2#16#6'Height'#3
+  +#153#0#3'Top'#2#8#5'Width'#3#185#0#0#9'TPaintBox'#9'PaintBox1'#7'OnPaint'#7
+  +#14'PaintBox1Paint'#4'Left'#2#16#6'Height'#2'q'#3'Top'#2#24#5'Width'#3#145#0
+  +#0#0#0#0#0
+]);
--- a/components/turbopower_ipro/iphtmlpv.pas
+++ b/components/turbopower_ipro/iphtmlpv.pas
@ -40,6 +40,7 @@ uses
  GraphType,
  LCLIntf,
  Buttons,
+  LResources,
  {$ELSE}
  Windows,
  {$ENDIF}
@ -268,10 +269,21 @@ var
  Scale1, Scale2, Scale0: double;
 begin
  FZoom := Value;
+  {$IFDEF IP_LAZARUS}
+  if Printer.PageHeight>0 then
+    Scale1 := Double(ClientHeight)/Printer.PageHeight
+  else
+    Scale1 := Double(ClientHeight)/500;
+  if Printer.PageWidth>0 then
+    Scale2 := Double(ClientWidth)/ Printer.PageWidth
+  else
+    Scale2 := Double(ClientWidth)/ 500;
+  {$ELSE}
  Scale1 := Double(ClientHeight)
-              / {$IFDEF IP_LAZARUS}500{$ELSE}Printer.PageHeight{$ENDIF};
+              / Printer.PageHeight;
  Scale2 := Double(ClientWidth)
-              / {$IFDEF IP_LAZARUS}500{$ELSE}Printer.PageWidth{$ENDIF};
+              / Printer.PageWidth;
+  {$ENDIF}
  if Scale1 < Scale2 then
    Scale0 := Scale1
  else
@ -285,8 +297,19 @@ procedure TIpHTMLPreview.ResizeCanvas;
 begin
  ScrollBox1.HorzScrollBar.Position := 0;
  ScrollBox1.VertScrollBar.Position := 0;
-  PaperPanel.Width := round({$IFDEF IP_LAZARUS}500{$ELSE}Printer.PageWidth{$ENDIF} * Scale);
-  PaperPanel.Height := round({$IFDEF IP_LAZARUS}500{$ELSE}Printer.PageHeight{$ENDIF} * Scale);
+  {$IFDEF IP_LAZARUS}
+  if Printer.PageHeight>0 then
+    PaperPanel.Height := round(Printer.PageHeight * Scale)
+  else
+    PaperPanel.Height := round(500 * Scale);
+  if Printer.PageWidth>0 then
+    PaperPanel.Width := round(Printer.PageWidth * Scale)
+  else
+    PaperPanel.Width := round(500 * Scale);
+  {$ELSE}
+  PaperPanel.Width := round(Printer.PageWidth * Scale);
+  PaperPanel.Height := round(Printer.PageHeight * Scale);
+  {$ENDIF}
  PaintBox1.Width := round(OwnerPanel.PrintWidth * Scale);
  PaintBox1.Height := round(OwnerPanel.PrintHeight * Scale);
  PaintBox1.Left := round(OwnerPanel.PrintTopLeft.x * Scale);
@ -311,4 +334,7 @@ begin
  SetZoom(Zoom); {force recalc of preview sizes}
 end;

+initialization
+  {$I iphtmlpv.lrs}
+
 end.