{%MainUnit ../forms.pp} { ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } procedure TScrollingWinControl.SetAutoScroll(Value: Boolean); begin if FAutoScroll = Value then Exit; FAutoScroll := Value; UpdateScrollBars; end; procedure TScrollingWinControl.CreateWnd; begin DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TScrollingWinControl.CreateWnd'){$ENDIF}; try inherited CreateWnd; UpdateScrollBars; finally EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TScrollingWinControl.CreateWnd'){$ENDIF}; end; end; function TScrollingWinControl.GetClientScrollOffset: TPoint; begin if (HorzScrollBar <> nil) and (VertScrollBar <> nil) then begin Result.X := HorzScrollBar.Position; Result.Y := VertScrollBar.Position; end else begin Result.X := 0; Result.Y := 0; end; end; function TScrollingWinControl.GetLogicalClientRect: TRect; begin Result := ClientRect; {if (FHorzScrollBar.Range>Result.Right) or (FVertScrollBar.Range>Result.Bottom) then DebugLn(['TScrollingWinControl.GetLogicalClientRect Client=',ClientWidth,'x',ClientHeight,' Ranges=',FHorzScrollBar.Range,'x',FVertScrollBar.Range]);} if Assigned(FHorzScrollBar) and FHorzScrollBar.Visible and (FHorzScrollBar.Range > Result.Right) then Result.Right := FHorzScrollBar.Range; if Assigned(FVertScrollBar) and FVertScrollBar.Visible and (FVertScrollBar.Range > Result.Bottom) then Result.Bottom := FVertScrollBar.Range; end; procedure TScrollingWinControl.DoOnResize; begin inherited DoOnResize; if AutoScroll then begin if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit; if HorzScrollBar.Visible or VertScrollBar.Visible then UpdateScrollBars; end; //debugln(['TScrollingWinControl.DoOnResize ',DbgSName(Self),' ',dbgs(BoundsRect),' ',dbgs(ClientRect),' ',dbgs(GetLogicalClientRect)]); end; procedure TScrollingWinControl.GetPreferredSizeClientFrame(out aWidth, aHeight: integer); // return frame width independent of scrollbars (i.e. as if scrollbars not shown) begin if AutoScroll and (VertScrollBar<>nil) then aWidth:=Width-VertScrollBar.ClientSizeWithoutBar else aWidth:=Width-ClientWidth; if AutoScroll and (HorzScrollBar<>nil) then aHeight:=Height-HorzScrollBar.ClientSizeWithoutBar else aHeight:=Height-ClientHeight; end; procedure TScrollingWinControl.AlignControls(AControl: TControl; var ARect: TRect); begin if AutoScroll then begin if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit; inherited AlignControls(AControl, ARect); UpdateScrollBars; end else inherited AlignControls(AControl, ARect); end; function TScrollingWinControl.AutoScrollEnabled: Boolean; begin Result := not (AutoSize or (DockSite and UseDockManager)); end; procedure TScrollingWinControl.CalculateAutoRanges; var NeededClientW: Integer; NeededClientH: Integer; FrameWidth: integer; FrameHeight: integer; begin NeededClientW:=0; NeededClientH:=0; GetPreferredSize(NeededClientW,NeededClientH,true,false); GetPreferredSizeClientFrame(FrameWidth,FrameHeight); if NeededClientW>0 then NeededClientW-=FrameWidth; if NeededClientH>0 then NeededClientH-=FrameHeight; if HorzScrollBar.Visible then HorzScrollBar.InternalSetRange(NeededClientW) else HorzScrollBar.InternalSetRange(0); if VertScrollBar.Visible then VertScrollBar.InternalSetRange(NeededClientH) else VertScrollBar.InternalSetRange(0); end; class function TScrollingWinControl.GetControlClassDefaultSize: TSize; begin Result.CX := 150; Result.CY := 150; end; procedure TScrollingWinControl.SetHorzScrollBar(Value: TControlScrollBar); begin FHorzScrollbar.Assign(Value); end; procedure TScrollingWinControl.SetVertScrollBar(Value: TControlScrollBar); begin FVertScrollbar.Assign(Value); end; procedure TScrollingWinControl.WMSize(var Message: TLMSize); var NewState: TWindowState; begin inherited; if (Message.SizeType and SIZE_SourceIsInterface) <> 0 then begin NewState := wsNormal; case (Message.SizeType xor SIZE_SourceIsInterface) of SIZE_MINIMIZED: NewState := wsMinimized; SIZE_MAXIMIZED: NewState := wsMaximized; SIZE_FULLSCREEN: NewState := wsFullScreen; end; Resizing(NewState); end; end; procedure TScrollingWinControl.Resizing(State: TWindowState); begin // end; procedure TScrollingWinControl.ComputeScrollbars; procedure UpdateBar(aBar: TControlScrollBar; aClientSize: integer); begin // page (must be smaller than Range but at least 1) aBar.FPage := Max(1,Min(Min(aBar.Range,aClientSize), High(HorzScrollbar.FPage))); aBar.FAutoRange := Max(0, aBar.Range - aClientSize); {$IFDEF VerboseScrollingWinControl} debugln(['TScrollingWinControl.ComputeScrollbars ',DbgSName(Self),' ',dbgs(aBar.Kind),' Page=',aBar.Page,' Range=',aBar.Range,' ClientSize=',aClientSize]); {$ENDIF} end; var ClientW: Integer; ClientH: Integer; begin CalculateAutoRanges; ClientW:=VertScrollBar.ClientSizeWithoutBar; ClientH:=HorzScrollBar.ClientSizeWithoutBar; {$IFDEF VerboseScrollingWinControl} debugln(['TScrollingWinControl.ComputeScrollbars ',DbgSName(Self),' Bounds=',dbgs(BoundsRect),' ClientRect=',dbgs(ClientRect),' ClientRectNoScrollBars=',ClientW,'x',ClientH]); {$ENDIF} if VertScrollBar.Range > ClientH then begin // vertical does not fit -> vertical scrollbar will be shown ClientW:=VertScrollBar.ClientSizeWithBar; end; if HorzScrollBar.Range > ClientW then begin // horizontal does not fit -> horizontal scrollbar will be shown ClientH:=HorzScrollBar.ClientSizeWithBar; if VertScrollBar.Range > ClientH then begin // vertical does not fit, because of the other scrollbar // -> vertical scrollbar will be shown too ClientW:=VertScrollBar.ClientSizeWithBar; end; end; UpdateBar(HorzScrollBar,ClientW); UpdateBar(VertScrollBar,ClientH); end; procedure TScrollingWinControl.UpdateScrollbars; begin if ([csLoading, csDestroying] * ComponentState <> []) then Exit; if not HandleAllocated then Exit; if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit; if FIsUpdating then Exit; FIsUpdating := True; try if AutoScroll then ComputeScrollbars; // page, autorange, IsScrollBarVisible FVertScrollbar.UpdateScrollbar; FHorzScrollbar.UpdateScrollbar; finally FIsUpdating := False; end; end; class procedure TScrollingWinControl.WSRegisterClass; begin inherited WSRegisterClass; RegisterScrollingWinControl; end; procedure TScrollingWinControl.ScrollBy(DeltaX, DeltaY: Integer); begin ScrollBy_WS(DeltaX, DeltaY); end; procedure TScrollingWinControl.ScrollInView(AControl: TControl); var xRect: TRect; begin if AControl=nil then Exit; xRect := AControl.BoundsRect; OffsetRect(xRect, -HorzScrollBar.Position, -VertScrollBar.Position); if xRect.Left < 0 then HorzScrollBar.Position := HorzScrollBar.Position + xRect.Left else if xRect.Right > ClientWidth then begin if xRect.Right - xRect.Left > ClientWidth then xRect.Right := xRect.Left + ClientWidth; HorzScrollBar.Position := HorzScrollBar.Position + xRect.Right - ClientWidth; end; if xRect.Top < 0 then VertScrollBar.Position := VertScrollBar.Position + xRect.Top else if xRect.Bottom > ClientHeight then begin if xRect.Bottom - xRect.Top > ClientHeight then xRect.Bottom := xRect.Top + ClientHeight; VertScrollBar.Position := VertScrollBar.Position + xRect.Bottom - ClientHeight; end; end; procedure TScrollingWinControl.Loaded; begin inherited Loaded; UpdateScrollbars; end; procedure TScrollingWinControl.SetAutoSize(Value: Boolean); begin if AutoSize=Value then exit; if Value then ControlStyle:=ControlStyle-[csAutoSizeKeepChildLeft,csAutoSizeKeepChildTop] else ControlStyle:=ControlStyle+[csAutoSizeKeepChildLeft,csAutoSizeKeepChildTop]; inherited SetAutoSize(Value); end; procedure TScrollingWinControl.WMVScroll(var Message : TLMVScroll); begin VertScrollbar.ScrollHandler(Message); end; procedure TScrollingWinControl.WMHScroll(var Message : TLMHScroll); begin //DebugLn(['TScrollingWinControl.WMHScroll ',dbgsName(Self)]); HorzScrollbar.ScrollHandler(Message); end; constructor TScrollingWinControl.Create(TheOwner : TComponent); begin Inherited Create(TheOwner); FAutoScroll := False; FVertScrollbar := TControlScrollBar.Create(Self, sbVertical); FHorzScrollbar := TControlScrollBar.Create(Self, sbHorizontal); ControlStyle := [csAcceptsControls, csClickEvents, csDoubleClicks, csAutoSizeKeepChildLeft, csAutoSizeKeepChildTop]; with GetControlClassDefaultSize do SetInitialBounds(0, 0, CX, CY); end; destructor TScrollingWinControl.Destroy; begin FreeThenNil(FHorzScrollBar); FreeThenNil(FVertScrollBar); inherited Destroy; end; function TScrollingWinControl.ControlAtPos(const Pos: TPoint; Flags: TControlAtPosFlags): TControl; begin Result := inherited ControlAtPos(Pos, Flags - [capfHasScrollOffset]); end; function TScrollingWinControl.ScreenToClient(const APoint: TPoint): TPoint; var P: TPoint; begin P := GetClientScrollOffset; Result := inherited; Result.x := Result.x - P.x; Result.y := Result.y - P.y; end; function TScrollingWinControl.ClientToScreen(const APoint: TPoint): TPoint; var P: TPoint; begin P := GetClientScrollOffset; Result := inherited; Result.x := Result.x + P.x; Result.y := Result.y + P.y; end; // included by forms.pp