From 32c65f7004a7108951a544ddb19769ce6fbeec2c Mon Sep 17 00:00:00 2001
From: micha <micha@lazarus-ide.org>
Date: Sat, 15 Jan 2005 13:25:29 +0000
Subject: [PATCH] fix scrolling (win32)

git-svn-id: trunk@6601 -
---
 lcl/include/scrollingwincontrol.inc  | 14 ++++++++++++++
 lcl/interfaces/gtk/gtkwsforms.pp     | 11 ++++++++++-
 lcl/interfaces/win32/win32wsforms.pp | 16 +++++++++++++++-
 lcl/widgetset/wsforms.pp             | 10 ++++++++++
 4 files changed, 49 insertions(+), 2 deletions(-)

diff --git a/lcl/include/scrollingwincontrol.inc b/lcl/include/scrollingwincontrol.inc
index 0743d224b4..0965391b67 100644
--- a/lcl/include/scrollingwincontrol.inc
+++ b/lcl/include/scrollingwincontrol.inc
@@ -133,7 +133,21 @@ begin
 end;
 
 procedure TScrollingWinControl.ScrollBy(DeltaX, DeltaY: Integer);
+var
+  Control: TControl;
+  I: integer;
 begin
+  TWSScrollingWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY);
+  for I := 0 to ControlCount - 1 do
+  begin
+    Control := Controls[I];
+    if not (Control is TWinControl) or not TWinControl(Control).HandleAllocated then
+    begin
+      // widgetset does not know about this control
+      Control.SetBounds(Control.Left+DeltaX, Control.Top+DeltaY, 
+        Control.Width, Control.Height);
+    end;
+  end;
   Invalidate;
 end;
 
diff --git a/lcl/interfaces/gtk/gtkwsforms.pp b/lcl/interfaces/gtk/gtkwsforms.pp
index bd50c06a45..b680a341e7 100644
--- a/lcl/interfaces/gtk/gtkwsforms.pp
+++ b/lcl/interfaces/gtk/gtkwsforms.pp
@@ -40,6 +40,8 @@ type
   private
   protected
   public
+    class procedure ScrollBy(const AWinControl: TScrollingWinControl;
+      const DeltaX, DeltaY: integer); override;
   end;
 
   { TGtkWSScrollBox }
@@ -115,6 +117,13 @@ implementation
 
 { TGtkWSCustomForm }
 
+procedure TGtkWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
+  const DeltaX, DeltaY: integer);
+begin
+end;
+          
+{ TGtkWSCustomForm }
+
 procedure TGtkWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
   const AFormBorderStyle: TFormBorderStyle);
 begin
@@ -168,7 +177,7 @@ initialization
 // To improve speed, register only classes
 // which actually implement something
 ////////////////////////////////////////////////////
-//  RegisterWSComponent(TScrollingWinControl, TGtkWSScrollingWinControl);
+  RegisterWSComponent(TScrollingWinControl, TGtkWSScrollingWinControl);
 //  RegisterWSComponent(TScrollBox, TGtkWSScrollBox);
 //  RegisterWSComponent(TCustomFrame, TGtkWSCustomFrame);
 //  RegisterWSComponent(TFrame, TGtkWSFrame);
diff --git a/lcl/interfaces/win32/win32wsforms.pp b/lcl/interfaces/win32/win32wsforms.pp
index 1ca8d55d0a..ab48aca32f 100644
--- a/lcl/interfaces/win32/win32wsforms.pp
+++ b/lcl/interfaces/win32/win32wsforms.pp
@@ -46,6 +46,8 @@ type
   private
   protected
   public
+    class procedure ScrollBy(const AWinControl: TScrollingWinControl;
+      const DeltaX, DeltaY: integer); override;
   end;
 
   { TWin32WSScrollBox }
@@ -186,7 +188,19 @@ begin
   Result := Params.Window;
 end;
 
+{ TWin32WSScrollingWinControl }
 
+function ScrollWindowPtr(hWnd:HWND; XAmount:longint; YAmount:longint; lpRect: pointer; lpClipRect: pointer):WINBOOL; stdcall; external 'user32' name 'ScrollWindow';
+
+procedure TWin32WSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
+  const DeltaX, DeltaY: integer);
+var
+  lVisible: boolean;
+begin
+  lVisible := AWinControl.HandleAllocated and Windows.IsWindowVisible(AWinControl.Handle);
+  if lVisible then
+    ScrollWindowPtr(AWinControl.Handle, DeltaX, DeltaY, nil, nil);
+end;
 
 { TWin32WSCustomForm }
 
@@ -340,7 +354,7 @@ initialization
 // To improve speed, register only classes
 // which actually implement something
 ////////////////////////////////////////////////////
-//  RegisterWSComponent(TScrollingWinControl, TWin32WSScrollingWinControl);
+  RegisterWSComponent(TScrollingWinControl, TWin32WSScrollingWinControl);
   RegisterWSComponent(TScrollBox, TWin32WSScrollBox);
 //  RegisterWSComponent(TCustomFrame, TWin32WSCustomFrame);
 //  RegisterWSComponent(TFrame, TWin32WSFrame);
diff --git a/lcl/widgetset/wsforms.pp b/lcl/widgetset/wsforms.pp
index ca62c81c1a..fc833cd3bd 100644
--- a/lcl/widgetset/wsforms.pp
+++ b/lcl/widgetset/wsforms.pp
@@ -51,7 +51,10 @@ uses
 type
   { TWSScrollingWinControl }
 
+  TWSScrollingWinControlClass = class of TWSScrollingWinControl;
   TWSScrollingWinControl = class(TWSWinControl)
+    class procedure ScrollBy(const AWinControl: TScrollingWinControl; 
+      const DeltaX, DeltaY: integer); virtual;
   end;
 
   { TWSScrollBox }
@@ -105,6 +108,13 @@ type
 
 implementation
 
+{ TWSScrollingWinControl }
+
+procedure TWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl; 
+  const DeltaX, DeltaY: integer);
+begin
+end;
+  
 { TWSCustomForm }
 
 procedure TWSCustomForm.CloseModal(const ACustomForm: TCustomForm);