[JVCL-Checkins] dev/JVCL3/qcommon QToolWin.pas,1.3,1.4 - Added viewport

[André S. <asn...@us...>]

Update of /cvsroot/jvcl/dev/JVCL3/qcommon
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5844/JVCL3/qcommon

Modified Files:
	QToolWin.pas 
Log Message:
Added viewport


Index: QToolWin.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/JVCL3/qcommon/QToolWin.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** QToolWin.pas	6 Nov 2004 22:12:36 -0000	1.3
--- QToolWin.pas	1 Dec 2004 17:18:31 -0000	1.4
***************
*** 16,25 ****
  All Rights Reserved.
  
! Contributor(s):
  
! Last Modified: 2004-01-12
  
  Known Issues:
  ----------------------------------------------------------------------------}
  
  unit QToolWin;
--- 16,26 ----
  All Rights Reserved.
  
! Contributor(s): André Snepvangers. (Viewport implementation)
  
! Last Modified: 2004-11-29
  
  Known Issues:
  ----------------------------------------------------------------------------}
+ //
  
  unit QToolWin;
***************
*** 36,40 ****
    TEdgeBorders = set of TEdgeBorder;
  
!   TToolWindow = class(TCustomControl)
    private
      FEdgeBorders: TEdgeBorders;
--- 37,41 ----
    TEdgeBorders = set of TEdgeBorder;
  
!   TToolWindow = class(TWidgetControl)
    private
      FEdgeBorders: TEdgeBorders;
***************
*** 42,60 ****
      FEdgeOuter: TEdgeStyle;
      FBorderWidth: TBorderWidth;
      procedure SetEdgeBorders(Value: TEdgeBorders);
      procedure SetEdgeInner(Value: TEdgeStyle);
      procedure SetEdgeOuter(Value: TEdgeStyle);
      procedure SetBorderWidth(const Value: TBorderWidth);
    protected
!     procedure Paint; override;
      function GetClientOrigin: TPoint; override;
      function GetClientRect: TRect; override;
      procedure UpdateControl; virtual;
      property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth;
    public
      constructor Create(AOwner: TComponent); override;
      property EdgeBorders: TEdgeBorders read FEdgeBorders write SetEdgeBorders default [ebLeft, ebTop, ebRight, ebBottom];
      property EdgeInner: TEdgeStyle read FEdgeInner write SetEdgeInner default esRaised;
      property EdgeOuter: TEdgeStyle read FEdgeOuter write SetEdgeOuter default esLowered;
    end;
  
--- 43,81 ----
      FEdgeOuter: TEdgeStyle;
      FBorderWidth: TBorderWidth;
+     FCanvas: TControlCanvas;
+     FViewPortHandle: QWidgetH;
+     FViewportHook: QWidget_HookH;
      procedure SetEdgeBorders(Value: TEdgeBorders);
      procedure SetEdgeInner(Value: TEdgeStyle);
      procedure SetEdgeOuter(Value: TEdgeStyle);
      procedure SetBorderWidth(const Value: TBorderWidth);
+     function GetCanvas: TCanvas;
    protected
!     procedure PaletteChanged(Sender: TObject); override;
!     procedure BoundsChanged; override;
!     procedure Paint; virtual;
!     procedure NCPaint; virtual;
!     procedure CreateWidget; override;
!     procedure ControlsListChanging(Control: TControl; Inserting: Boolean); override;
!     function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override;
      function GetClientOrigin: TPoint; override;
      function GetClientRect: TRect; override;
+     procedure HookEvents; override;
+     procedure WidgetDestroyed; override;
+     function GetAlignedPaintDevice: QPaintDeviceH; override;
+     function GetPaintDevice: QPaintDeviceH; override;
+     function GetChildHandle: QWidgetH; override;
+     function ViewPortHandle: QWidgetH;
+     function ViewPortRect: TRect; override;
      procedure UpdateControl; virtual;
      property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth;
    public
      constructor Create(AOwner: TComponent); override;
+     procedure ScrollBy(DeltaX, DeltaY: Integer); override;
+ 
      property EdgeBorders: TEdgeBorders read FEdgeBorders write SetEdgeBorders default [ebLeft, ebTop, ebRight, ebBottom];
      property EdgeInner: TEdgeStyle read FEdgeInner write SetEdgeInner default esRaised;
      property EdgeOuter: TEdgeStyle read FEdgeOuter write SetEdgeOuter default esLowered;
+     property Canvas: TCanvas read GetCanvas;
    end;
  
***************
*** 66,83 ****
  begin
    inherited Create(AOwner);
    FEdgeInner := esRaised;
    FEdgeOuter := esLowered;
    FEdgeBorders := [ebLeft, ebTop, ebRight, ebBottom];
  end;
  
  procedure TToolWindow.UpdateControl;
  var
!   R: TRect;
  begin
    Invalidate;
    R := ClientRect;
    AlignControls(Self, R);
  end;
  
  
  procedure TToolWindow.SetEdgeBorders(Value: TEdgeBorders);
--- 87,144 ----
  begin
    inherited Create(AOwner);
+ //  ControlStyle := ControlStyle + [csAcceptsControls];
    FEdgeInner := esRaised;
    FEdgeOuter := esLowered;
    FEdgeBorders := [ebLeft, ebTop, ebRight, ebBottom];
+   FCanvas := TControlCanvas.Create;
+   FCanvas.Control := Self;
+ end;
+ 
+ procedure TToolWindow.CreateWidget;
+ begin
+   inherited CreateWidget;
+   FViewportHandle := QWidget_create(Handle, nil, WidgetFlags);
+   QClxObjectMap_add(FViewportHandle, Integer(Self));
+ end;
+ 
+ procedure TToolWindow.HookEvents;
+ var
+   Method: TMethod;
+ begin
+   FViewportHook := QWidget_hook_create(ViewportHandle);
+   TEventFilterMethod(Method) := MainEventFilter;
+   Qt_hook_hook_events(FViewportHook, Method);
+   inherited HookEvents;
+ end;
+ 
+ 
+ procedure TToolWindow.WidgetDestroyed;
+ begin
+   QClxObjectMap_remove(FViewportHandle);
+   QWidget_hook_destroy(FViewportHook);
+   FViewportHandle := nil;
+   inherited WidgetDestroyed;
  end;
  
  procedure TToolWindow.UpdateControl;
  var
!   R, R2: TRect;
  begin
    Invalidate;
    R := ClientRect;
+   R2 := R;
+   OffsetRect(R2, -Top, -Left);
+   QWidget_setGeometry(FViewPortHandle, @R2);
    AlignControls(Self, R);
  end;
  
+ procedure TToolWindow.BoundsChanged;
+ var
+   R2: TRect;
+ begin
+   inherited BoundsChanged;
+   R2 := ClientRect;
+   QWidget_setGeometry(FViewPortHandle, @R2);
+ end;
  
  procedure TToolWindow.SetEdgeBorders(Value: TEdgeBorders);
***************
*** 90,93 ****
--- 151,170 ----
  end;
  
+ procedure TToolWindow.ControlsListChanging(Control: TControl;
+   Inserting: Boolean);
+ var
+   WasVisible: Boolean;
+ begin
+   inherited ControlsListChanging(Control, Inserting);
+   if Control is TWidgetControl then
+     if Inserting then
+     begin
+       HandleNeeded;
+       WasVisible := Control.Visible;
+       TWidgetControl(Control).ParentWidget := ChildHandle;
+       Control.Visible := WasVisible;
+     end
+ end;
+ 
  procedure TToolWindow.SetEdgeInner(Value: TEdgeStyle);
  begin
***************
*** 108,111 ****
--- 185,204 ----
  end;
  
+ function TToolWindow.GetAlignedPaintDevice: QPaintDeviceH;
+ begin
+   Result := QWidget_to_QPaintDevice(FViewportHandle);
+ end;
+ 
+ function TToolWindow.GetPaintDevice: QPaintDeviceH;
+ begin
+   Result := QWidget_to_QPaintDevice(FViewportHandle);
+ end;
+ 
+ function TToolWindow.GetChildHandle: QWidgetH;
+ begin
+   Result := FViewportHandle;
+ end;
+ 
+ (*
  function TToolWindow.GetClientOrigin: TPoint;
  begin
***************
*** 114,117 ****
--- 207,237 ----
    Inc(Result.Y, BorderWidth);
  end;
+ *)
+ 
+ function TToolWindow.GetClientOrigin: TPoint;
+ var
+   P: TPoint;
+ begin
+   Result := inherited GetClientOrigin;
+   P := ViewportRect.TopLeft;
+   Result.X := Result.X + P.X;
+   Result.Y := Result.Y + P.Y;
+ end;
+ 
+ function TToolWindow.ViewportRect: TRect;
+ var
+   Offset: TPoint;
+ begin
+   QWidget_geometry(ViewportHandle, @Result);
+   Offset := ClientRect.TopLeft;
+   OffsetRect(Result, Offset.X, Offset.Y);
+ end;
+ 
+ function TToolWindow.ViewportHandle: QWidgetH;
+ begin
+   if not (csDestroying in ComponentState) then
+     HandleNeeded;
+   Result := FViewportHandle;
+ end;
  
  function TToolWindow.GetClientRect: TRect;
***************
*** 136,140 ****
--- 256,270 ----
  end;
  
+ function TToolWindow.GetCanvas: TCanvas;
+ begin
+   Result := FCanvas;
+ end;
+ 
  procedure TToolWindow.Paint;
+ begin
+ 
+ end;
+ 
+ procedure TToolWindow.NCPaint;
  const
    InnerStyles: array[TEdgeStyle] of Integer = (0, BDR_RAISEDINNER, BDR_SUNKENINNER);
***************
*** 142,150 ****
  var
    R: TRect;
  begin
    R := BoundsRect;
    OffsetRect(R, -R.Left, -R.Top);
!   DrawEdge(Canvas.Handle, R, InnerStyles[FEdgeInner] or OuterStyles[FEdgeOuter],
      Byte(FEdgeBorders) or BF_ADJUST);
  end;
  
--- 272,321 ----
  var
    R: TRect;
+   DC: QPainterH;
  begin
    R := BoundsRect;
    OffsetRect(R, -R.Left, -R.Top);
!   DC := GetDC(FHandle);
!   DrawEdge(DC, R, InnerStyles[FEdgeInner] or OuterStyles[FEdgeOuter],
      Byte(FEdgeBorders) or BF_ADJUST);
+   ReleaseDC(nil, DC);
+ end;
+ 
+ procedure TToolWindow.PaletteChanged(Sender: TObject);
+ begin
+   inherited;
+   QWidget_setPalette(ViewportHandle, (Sender as TPalette).Handle, True);
+ end;
+ 
+ procedure TToolWindow.ScrollBy(DeltaX, DeltaY: Integer);
+ var
+   IsVisible: Boolean;
+ begin
+   IsVisible := Visible and HandleAllocated;
+   if IsVisible then
+     QWidget_scroll(ViewPortHandle, DeltaX, DeltaY);
+   ScrollControls(DeltaX, DeltaY, IsVisible);
+   Realign;
+ end;
+ 
+ function TToolWindow.EventFilter(Sender: QObjectH;
+   Event: QEventH): Boolean;
+ begin
+   case QEvent_type(Event) of
+     QEventType_Paint:
+       if not (csWidgetPainting in ControlState) then
+       begin
+         Result := inherited EventFilter(Sender, Event);
+         NCPaint;
+         TControlCanvas(Canvas).StartPaint;
+         try
+           Paint;
+         finally
+           TControlCanvas(Canvas).StopPaint;
+         end;
+         Exit;
+       end;
+   end;
+   Result := inherited EventFilter(Sender, Event);
  end;