TScrollBar implementation from zeljko on qt interface

git-svn-id: trunk@11225 -

lcl/interfaces/qt/qtwidgets.pas

@@ -216,6 +216,8 @@ type
 
   TQtAbstractSlider = class(TQtWidget)
   private
+    FSliderPressed: Boolean;
+    FSliderReleased: Boolean;
   protected
     function CreateWidget(const AParams: TCreateParams):QWidgetH; override;
   public
@@ -235,6 +237,13 @@ type
     procedure setSliderPosition(p1: Integer); virtual;
     procedure setTracking(p1: Boolean); virtual;
     procedure setValue(p1: Integer); virtual; 
+    procedure SlotSliderMoved(p1: Integer); cdecl;
+    procedure SlotValueChanged(p1: Integer); cdecl;
+    procedure SlotRangeChanged(minimum: Integer; maximum: Integer); cdecl;
+    procedure SlotSliderPressed; cdecl;
+    procedure SlotSliderReleased; cdecl;
+    property SliderPressed: Boolean read FSliderPressed;
+    property SliderReleased: Boolean read FSliderReleased;
   end;
 
   { TQtScrollBar }
@@ -415,7 +424,6 @@ type
   end;
   
 implementation
-
 const
   AlignmentMap: array[TAlignment] of QtAlignment =
   (
@@ -2205,6 +2213,10 @@ begin
   {$ifdef VerboseQt}
     WriteLn('TQtAbstractSlider.Create');
   {$endif}
+  
+  FSliderPressed := False;
+  FSliderReleased:= False;
+
   Parent := TQtWidget(LCLObject.Parent.Handle).Widget;
   Result := QAbstractSlider_create(Parent);
 end;
@@ -2225,6 +2237,19 @@ begin
   inherited Destroy;
 end;
 
+{------------------------------------------------------------------------------
+  Function: TQtAbstractSlider.rangeChanged
+  Params:  minimum,maximum: Integer
+  Returns: Nothing
+ ------------------------------------------------------------------------------}
+procedure TQtAbstractSlider.SlotRangeChanged(minimum: Integer; maximum: Integer); cdecl;
+begin
+  {TODO: what to do on rangeChanged ? repaint or recount pageSize() }
+ {$ifdef VerboseQt}
+  writeln('TQtAbstractSlider.rangeChanged() to min=',minimum,' max=',maximum);
+ {$endif}
+end;
+
 {------------------------------------------------------------------------------
   Function: TQtAbstractSlider.setInvertedAppereance
   Params:  p1: Boolean
@@ -2346,6 +2371,92 @@ begin
   QAbstractSlider_setValue(QAbstractSliderH(Widget), p1);
 end;
 
+procedure TQtAbstractSlider.SlotSliderMoved(p1: Integer); cdecl;
+var
+   Msg: PLMessage;
+   LMScroll: TLMScroll;
+begin
+ {$ifdef VerboseQt}
+  writeln('TQtAbstractSlider.sliderMoved() to pos=',p1);
+ {$endif}
+ 
+  FillChar(Msg, SizeOf(Msg), #0);
+  FillChar(LMScroll, SizeOf(LMScroll), #0);
+
+  LMScroll.ScrollBar := LCLObject.Handle;
+   
+  if QAbstractSlider_orientation(QAbstractSliderH(Widget)) = QtHorizontal then
+  LMScroll.Msg := LM_HSCROLL
+  else
+  LMScroll.Msg := LM_VSCROLL;
+
+  LMScroll.Pos := p1;
+  LMScroll.ScrollCode := SIF_POS; {what about SIF_TRACKPOS ?!?}
+
+  Msg := @LMScroll;
+  
+  try
+    if (TScrollBar(LCLObject).Position <> p1)
+    and (Assigned(LCLObject.Parent)) then
+    LCLObject.Parent.WindowProc(Msg^);
+  except
+    Application.HandleException(nil);
+  end;
+end;
+
+procedure TQtAbstractSlider.SlotSliderPressed; cdecl;
+begin
+ {$ifdef VerboseQt}
+  writeln('TQtAbstractSlider.sliderPressed()');
+ {$endif}
+ FSliderPressed := True;
+ FSliderReleased := False;
+end;
+
+procedure TQtAbstractSlider.SlotSliderReleased; cdecl;
+begin
+ {$ifdef VerboseQt}
+  writeln('TQtAbstractSlider.sliderReleased()');
+ {$endif}
+ FSliderPressed := False;
+ FSliderReleased := True;
+end;
+
+procedure TQtAbstractSlider.SlotValueChanged(p1: Integer); cdecl;
+var
+  Msg: PLMessage;
+  LMScroll: TLMScroll;
+begin
+ {$ifdef VerboseQt}
+  writeln('TQtAbstractSlider.SlotValueChanged()');
+ {$endif}
+ 
+  FillChar(Msg, SizeOf(Msg), #0);
+  FillChar(LMScroll, SizeOf(LMScroll), #0);
+
+  LMScroll.ScrollBar := LCLObject.Handle;
+
+  if QAbstractSlider_orientation(QAbstractSliderH(Widget)) = QtHorizontal then
+  LMScroll.Msg := LM_HSCROLL
+  else
+  LMScroll.Msg := LM_VSCROLL;
+  
+  LMScroll.Pos := p1;
+  LMScroll.ScrollCode := SIF_POS;
+
+  Msg := @LMScroll;
+  try
+    if not SliderPressed and Assigned(LCLObject.Parent)
+    and (p1 <> TScrollBar(LCLObject).Position) then
+    begin
+      LCLObject.Parent.WindowProc(Msg^);
+    end;
+  except
+    Application.HandleException(nil);
+  end;
+end;
+
+
 { TQtScrollBar }
 
 function TQtScrollBar.CreateWidget(const AParams: TCreateParams): QWidgetH;

lcl/interfaces/qt/qtwinapi.inc

@@ -1496,6 +1496,42 @@ begin
   Result := True;
 end;
 
+{------------------------------------------------------------------------------
+  Function: GetScrollInfo
+  Params: BarFlag
+           SB_CTL Retrieves the parameters for a scroll bar control. The hwnd parameter must be the handle to the scroll bar control.
+           SB_HORZ Retrieves the parameters for the window's standard horizontal scroll bar.
+           SB_VERT Retrieves the parameters for the window's standard vertical scroll bar.
+           
+          ScrollInfo returns TScrollInfo structure.
+          
+  Returns: boolean
+
+ ------------------------------------------------------------------------------}
+function TQtWidgetSet.GetScrollInfo(Handle: HWND; BarFlag: Integer; Var ScrollInfo: TScrollInfo): Boolean;
+var
+  FScrollBar: TScrollBar;
+begin
+  Result := False;
+  if Handle = 0 then exit;
+
+  FScrollBar := TScrollBar(TQtWidget(Handle).LCLObject);
+
+  if Assigned(FScrollBar) then
+  begin
+
+    if (csDestroying in FScrollBar.ComponentState) then exit;
+
+    ScrollInfo.nTrackPos := 0; {TODO: according to msdn this is ignored in SetScrollInfo()}
+    ScrollInfo.nPage := FScrollBar.PageSize;
+    ScrollInfo.nMax := FScrollBar.Max;
+    ScrollInfo.nMin := FScrollBar.Min;
+    ScrollInfo.nPos := FScrollBar.Position;
+    ScrollInfo.cbSize := SizeOf(ScrollInfo);
+    Result := True;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Function: TQtWidgetSet.GetSysColor
   Params:   index to the syscolors array
@@ -2675,6 +2711,212 @@ begin
     result:=False;
 end;
 
+
+{------------------------------------------------------------------------------
+  Function: SetScrollInfo
+  Params:  none
+  Returns: The old position value
+
+
+ ------------------------------------------------------------------------------}
+function TQtWidgetSet.SetScrollInfo(Handle : HWND; SBStyle : Integer;
+  ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer;
+var
+  i: Integer;
+  ScrollBar: TScrollBar;
+  FScrollInfo: TScrollInfo;
+  R: TRect;
+  FRepaint: Boolean;
+
+function PrepareScrollInfo: Boolean;
+begin
+
+  Result := False;
+  
+  if not Assigned(ScrollBar) then exit;
+
+  FillChar(FScrollInfo, SizeOf(FScrollInfo), #0);
+  FScrollInfo.cbSize := SizeOf(FScrollInfo);
+  FScrollInfo.FMask := ScrollInfo.FMask;
+
+  if GetScrollInfo(Handle, SBStyle, FScrollInfo) then
+  begin
+  
+    if (ScrollInfo.FMask or SIF_RANGE) = ScrollInfo.FMask then
+    begin
+      FScrollInfo.nMin := ScrollInfo.nMin;
+      FScrollInfo.nMax := ScrollInfo.nMax;
+      ScrollBar.Min := ScrollInfo.nMin;
+      ScrollBar.Max := ScrollInfo.nMax - ScrollInfo.nPage;
+      { - (ScrollInfo.nMax div 4 PageStep property)); }
+    end;
+
+    if (ScrollInfo.FMask or SIF_PAGE) = ScrollInfo.FMask then
+    begin
+      FScrollInfo.nPage := ScrollInfo.nPage;
+      {segfaults if we don't check Enabled property !}
+      if ScrollBar.Enabled  then
+        ScrollBar.PageSize := ScrollInfo.nPage;
+    end;
+    
+    if (ScrollInfo.FMask or SIF_POS) = ScrollInfo.FMask then
+    begin
+      FScrollInfo.nPos := ScrollInfo.nPos;
+      if ScrollBar.Position <> ScrollInfo.nPos then
+        ScrollBar.Position := ScrollInfo.nPos;
+    end;
+
+    if (ScrollInfo.FMask or SIF_TRACKPOS) = ScrollInfo.FMask then
+    begin
+      FScrollInfo.nTrackPos := ScrollInfo.nTrackPos;
+      {TODO: TQtScrollBar(ScrollBar.Handle).setTracking(True); via SB_THUMBTRACK }
+    end;
+
+    if (ScrollInfo.FMask or SIF_ALL) = ScrollInfo.FMask then
+    begin
+      FScrollInfo.nPage := ScrollInfo.nPage;
+      FScrollInfo.nPos := ScrollInfo.nPos;
+      FScrollInfo.nMin := ScrollInfo.nMin;
+      FScrollInfo.nMax := ScrollInfo.nMax;
+      ScrollBar.Min := ScrollInfo.nMin;
+      ScrollBar.Max := ScrollInfo.nMax;
+      {segfaults if we don't check Enabled property !}
+      if ScrollBar.Enabled then
+        ScrollBar.PageSize := ScrollInfo.nPage;
+      if ScrollBar.Position<>ScrollInfo.nPos then
+        ScrollBar.Position := ScrollInfo.nPos;
+    end;
+    
+    if (ScrollInfo.FMask or SIF_DISABLENOSCROLL) = ScrollInfo.FMask then
+    begin
+      {This value is used only when setting a scroll bar's parameters.
+       If the scroll bar's new parameters make the scroll bar unnecessary,
+       disable the scroll bar instead of removing it.}
+       ScrollBar.Enabled := False;
+    end else
+    begin
+       if not ScrollBar.Enabled then
+       begin
+         ScrollBar.Enabled := True;
+         ScrollBar.Invalidate;
+       end;
+    end;
+    
+    ScrollInfo := FScrollInfo;
+    Result := True;
+  end;
+end;
+
+begin
+  Result := 0;
+  
+  if (Handle = 0) then exit;
+  
+  FRepaint := False;
+  ScrollBar := NiL;
+  case SBStyle of
+  
+    SB_BOTH:
+    begin
+      {TODO: SB_BOTH fixme }
+      // writeln('TODO: ############## SB_BOTH CALLED HERE .... #################');
+    end; {SB_BOTH}
+    
+    SB_CTL:
+    begin
+      {HWND is always TScrollBar, but seem that Create ScrollBar should be called here }
+      if (csReading in TQtWidget(Handle).LCLObject.ComponentState)
+      or (csDestroying in TQtWidget(Handle).LCLObject.ComponentState) then
+      exit;
+
+      ScrollBar := TScrollBar(TQtWidget(Handle).LCLObject);
+
+      if not Assigned(ScrollBar) then exit;
+
+      if not Assigned(ScrollBar.Parent) then
+      begin
+       ScrollBar := NiL;
+       exit; {still creating ... set it to Nil because of PrepareScrollInfo() }
+      end;
+
+      FRepaint := bRedraw and not ScrollBar.Visible;
+                   
+      ScrollBar.Visible := bRedraw;
+    end; {SB_CTL}
+    
+    SB_HORZ:
+    begin
+      if (csReading in TQtWidget(Handle).LCLObject.ComponentState)
+      or (csDestroying in TQtWidget(Handle).LCLObject.ComponentState) then
+      exit;
+
+
+      if  TQtWidget(Handle).LCLObject.InheritsFrom(TScrollingWinControl) then
+        if not TScrollingWinControl(TQtWidget(Handle).LCLObject).HorzScrollBar.Visible then exit;;
+
+      {do not localize !}
+      ScrollBar := TScrollBar(TQtWidget(Handle).LCLObject.FindChildControl(TQtWidget(Handle).LCLObject.Name+'_HSCROLLBAR'));
+
+      if not Assigned(ScrollBar) then
+      begin
+        ScrollBar := TScrollBar.Create(TQtWidget(Handle).LCLObject);
+        ScrollBar.Name := TQtWidget(Handle).LCLObject.Name+'_HSCROLLBAR'; {do not localize !}
+        ScrollBar.Parent := TQtWidget(Handle).LCLObject;
+        ScrollBar.Kind := sbHorizontal;
+      end;
+                   
+      FRepaint := bRedraw and not ScrollBar.Visible;
+                   
+      ScrollBar.Visible := bRedraw;
+
+      R := TQtWidget(Handle).LCLObject.ClientRect;
+
+      Scrollbar.Width := R.Right - ScrollBar.Height;
+      ScrollBar.Top := R.Bottom - ScrollBar.Height;
+    end; {SB_HORZ}
+    
+    SB_VERT:
+    begin
+      if (csReading in TQtWidget(Handle).LCLObject.ComponentState)
+      or (csDestroying in TQtWidget(Handle).LCLObject.ComponentState) then
+      exit;
+
+                   
+      if  TQtWidget(Handle).LCLObject.InheritsFrom(TScrollingWinControl) then
+        if not TScrollingWinControl(TQtWidget(Handle).LCLObject).VertScrollBar.Visible then exit;
+
+      {do not localize !}
+      ScrollBar := TScrollBar(TQtWidget(Handle).LCLObject.FindChildControl(TQtWidget(Handle).LCLObject.Name+'_VSCROLLBAR'));
+                   
+      if not Assigned(ScrollBar) then
+      begin
+        ScrollBar := TScrollBar.Create(TQtWidget(Handle).LCLObject);
+        ScrollBar.Name := TQtWidget(Handle).LCLObject.Name+'_VSCROLLBAR';  {do not localize !}
+        ScrollBar.Parent := TQtWidget(Handle).LCLObject;
+        ScrollBar.Kind := sbVertical;
+      end;
+                   
+      FRepaint := bRedraw and not ScrollBar.Visible;
+                   
+      ScrollBar.Visible := bRedraw;
+                   
+      R := TQtWidget(Handle).LCLObject.ClientRect;
+      
+      Scrollbar.Height := R.Bottom;
+
+      ScrollBar.Top := 0;
+      ScrollBar.Left := R.Right - ScrollBar.Width;
+    end; {SB_VERT}
+    
+  end;
+  
+  if FRepaint then ScrollBar.Invalidate;
+
+  PrepareScrollInfo;
+  Result := ScrollInfo.nPos;
+
+end;
+
 {------------------------------------------------------------------------------
   Method:  SetTextColor
   Params:  Handle -

lcl/interfaces/qt/qtwinapih.inc

@@ -70,6 +70,7 @@ function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; ov
 function GetProp(Handle : hwnd; Str : PChar): Pointer; override;
 function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; override;
 function GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; Override;
+function GetScrollInfo(Handle: HWND; BarFlag: Integer; Var ScrollInfo: TScrollInfo): Boolean; override;
 function GetSysColor(nIndex: Integer): DWORD; override;
 function GetSystemMetrics(nIndex: Integer): Integer; override;
 function GetTextColor(DC: HDC) : TColorRef; Override;
@@ -101,6 +102,7 @@ function SetCursor(ACursor: HCURSOR): HCURSOR; override;
 function SetCursorPos(X, Y: Integer): Boolean; override;
 function SetFocus(hWnd: HWND): HWND; override;
 function SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean; override;
+function SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer; override;
 function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; override;
 function SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; OldPoint: PPoint) : Boolean; override;
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;

lcl/interfaces/qt/qtwsstdctrls.pp

@@ -30,7 +30,7 @@ uses
   // Bindings
   qt4, qtprivate, qtwidgets,
   // LCL
-  Classes, StdCtrls, Controls, Graphics, Forms, SysUtils, InterfaceBase, LCLType, LCLIntf,
+  Classes, StdCtrls, Controls, Graphics, Forms, SysUtils, InterfaceBase, LCLType, LCLIntf, LCLProc,
   // Widgetset
   WSStdCtrls, WSLCLClasses;
 
@@ -318,6 +318,7 @@ var
   Method: TMethod;
   Hook : QScrollBar_hookH;
 begin
+
   QtScrollBar := TQtScrollBar.Create(AWinControl, AParams);
 
   case TScrollBar(AWinControl).Kind of
@@ -326,23 +327,41 @@ begin
       QtScrollBar.SetOrientation(QtHorizontal);
       QtScrollBar.setInvertedAppereance(False);
       QTScrollBar.setInvertedControls(False);
+      TScrollBar(AWinControl).Height := TScrollBar(AWinControl).Height + 1;
     end;
     sbVertical:
     begin
       QtScrollBar.SetOrientation(QtVertical);
       QtScrollBar.setInvertedAppereance(False);
       QTScrollBar.setInvertedControls(False);
+      TScrollBar(AWinControl).Width := TScrollBar(AWinControl).Width + 1;
     end;
   end;
   
-  QtScrollbar.setWidth(TScrollBar(AWinControl).Width);
+  QWidget_setGeometry(QtScrollbar.Widget,TScrollBar(AWinControl).Left,TScrollBar(AWinControl).Top,TScrollBar(AWinControl).Width,TScrollBar(AWinControl).Height);
-  QtScrollbar.setHeight(TScrollBar(AWinControl).Height);
+  QtScrollBar.setRange(TScrollBar(AWinControl).Min, TScrollBar(AWinControl).Max);
   QtScrollbar.setValue(TScrollBar(AWinControl).Position);
   QtScrollBar.setPageStep(TScrollBar(AWinControl).PageSize);
 
   // Various Events
-//  Hook := QScrollBar_hook_create(QtScrollBar.Widget);
+  Hook := QScrollBar_hook_create(QtScrollBar.Widget);
-  // TEventFilterMethod(Method) := QtScrollBar.EventFilter;
+  TEventFilterMethod(Method) := QtScrollBar.EventFilter;
+  QObject_hook_hook_events(Hook, Method);
+
+  QAbstractSlider_rangeChanged_Event(Method) := QtScrollBar.SlotRangeChanged;
+  QAbstractSlider_hook_hook_rangeChanged(QAbstractSlider_hook_create(QtScrollBar.Widget), Method);
+
+  QAbstractSlider_sliderMoved_Event(Method) := QtScrollBar.SlotSliderMoved;
+  QAbstractSlider_hook_hook_sliderMoved(QAbstractSlider_hook_create(QtScrollBar.Widget), Method);
+  
+  QAbstractSlider_sliderPressed_Event(Method) := QtScrollBar.SlotSliderPressed;
+  QAbstractSlider_hook_hook_sliderPressed(QAbstractSlider_hook_create(QtScrollBar.Widget), Method);
+  
+  QAbstractSlider_sliderReleased_Event(Method) := QtScrollBar.SlotSliderReleased;
+  QAbstractSlider_hook_hook_sliderReleased(QAbstractSlider_hook_create(QtScrollBar.Widget), Method);
+  
+  QAbstractSlider_valueChanged_Event(Method) := QtScrollBar.SlotValueChanged;
+  QAbstractSlider_hook_hook_valueChanged(QAbstractSlider_hook_create(QtScrollBar.Widget), Method);
 
   Result := THandle(QtScrollbar);
 end;
@@ -366,17 +385,23 @@ end;
 class procedure TQtWSScrollBar.SetParams(const AScrollBar: TCustomScrollBar);
 var
   QtScrollBar: TQtScrollBar;
+  RA,RB: TRect;
+  IsSameGeometry: Boolean;
 begin
   QtScrollBar := TQtScrollBar(AScrollBar.Handle);	
-// TODO: Check HeightForWidth() set here or we have lazarus bug ?
-// AScrollBar.Width;
 
   QtScrollBar.setValue(AScrollBar.Position);
   QtScrollBar.setPageStep(AScrollBar.PageSize);
   QtScrollBar.setRange(AScrollBar.Min, AScrollBar.Max);
      
-  QtScrollbar.setWidth(AscrollBar.Width);
+  RA := QtScrollBar.LCLObject.ClientRect;
-  QtScrollbar.setHeight(AscrollBar.Height);
+  RB := AScrollBar.ClientRect;
+  
+  IsSameGeometry := (RA.Left = RB.Left) and (RA.Top = RB.Top) and (RA.Right = RB.Right) and (RA.Bottom = RB.Bottom);
+
+  if not IsSameGeometry then
+    QWidget_setGeometry(QtScrollbar.Widget,AScrollBar.Left,AScrollBar.Top,AScrollBar.Width,AScrollBar.Height);
+    {don't update geometry each time}
 
   case AScrollBar.Kind of
     sbHorizontal: