1{%MainUnit ../forms.pp} 2 3{ 4 ***************************************************************************** 5 This file is part of the Lazarus Component Library (LCL) 6 7 See the file COPYING.modifiedLGPL.txt, included in this distribution, 8 for details about the license. 9 ***************************************************************************** 10} 11 12procedure TScrollingWinControl.SetAutoScroll(Value: Boolean); 13var 14 LOldBounds: TRect; 15begin 16 if FAutoScroll = Value then Exit; 17 FAutoScroll := Value; 18 LOldBounds := BoundsRect; 19 if Value then 20 UpdateScrollBars 21 else 22 HideScrollbars; 23 if LOldBounds <> BoundsRect then 24 BoundsRect := LOldBounds; 25end; 26 27procedure TScrollingWinControl.CreateWnd; 28begin 29 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TScrollingWinControl.CreateWnd'){$ENDIF}; 30 try 31 inherited CreateWnd; 32 UpdateScrollBars; 33 finally 34 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TScrollingWinControl.CreateWnd'){$ENDIF}; 35 end; 36end; 37 38function TScrollingWinControl.GetClientScrollOffset: TPoint; 39begin 40 if (HorzScrollBar <> nil) and (VertScrollBar <> nil) then 41 begin 42 Result.X := HorzScrollBar.Position; 43 Result.Y := VertScrollBar.Position; 44 end else 45 begin 46 Result.X := 0; 47 Result.Y := 0; 48 end; 49end; 50 51function TScrollingWinControl.GetLogicalClientRect: TRect; 52begin 53 Result := ClientRect; 54 {if (FHorzScrollBar.Range>Result.Right) 55 or (FVertScrollBar.Range>Result.Bottom) then 56 DebugLn(['TScrollingWinControl.GetLogicalClientRect Client=',ClientWidth,'x',ClientHeight,' Ranges=',FHorzScrollBar.Range,'x',FVertScrollBar.Range]);} 57 if Assigned(FHorzScrollBar) and FHorzScrollBar.Visible 58 and (FHorzScrollBar.Range > Result.Right) then 59 Result.Right := FHorzScrollBar.Range; 60 if Assigned(FVertScrollBar) and FVertScrollBar.Visible 61 and (FVertScrollBar.Range > Result.Bottom) then 62 Result.Bottom := FVertScrollBar.Range; 63end; 64 65procedure TScrollingWinControl.DoOnResize; 66begin 67 inherited DoOnResize; 68 69 if AutoScroll then 70 begin 71 if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit; 72 if HorzScrollBar.Visible or VertScrollBar.Visible then 73 UpdateScrollBars; 74 end; 75 //debugln(['TScrollingWinControl.DoOnResize ',DbgSName(Self),' ',dbgs(BoundsRect),' ',dbgs(ClientRect),' ',dbgs(GetLogicalClientRect)]); 76end; 77 78procedure TScrollingWinControl.GetPreferredSizeClientFrame(out aWidth, 79 aHeight: integer); 80// return frame width independent of scrollbars (i.e. as if scrollbars not shown) 81begin 82 if AutoScroll and (VertScrollBar<>nil) then 83 aWidth:=Width-VertScrollBar.ClientSizeWithoutBar 84 else 85 aWidth:=Width-ClientWidth; 86 if AutoScroll and (HorzScrollBar<>nil) then 87 aHeight:=Height-HorzScrollBar.ClientSizeWithoutBar 88 else 89 aHeight:=Height-ClientHeight; 90end; 91 92procedure TScrollingWinControl.AlignControls(AControl: TControl; var ARect: TRect); 93begin 94 if AutoScroll then 95 begin 96 if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit; 97 inherited AlignControls(AControl, ARect); 98 99 UpdateScrollBars; 100 end 101 else 102 inherited AlignControls(AControl, ARect); 103end; 104 105function TScrollingWinControl.AutoScrollEnabled: Boolean; 106begin 107 Result := not (AutoSize or (DockSite and UseDockManager)); 108end; 109 110procedure TScrollingWinControl.CalculateAutoRanges; 111var 112 NeededClientW: Integer; 113 NeededClientH: Integer; 114 FrameWidth: integer; 115 FrameHeight: integer; 116begin 117 NeededClientW:=0; 118 NeededClientH:=0; 119 GetPreferredSize(NeededClientW,NeededClientH,true,false); 120 GetPreferredSizeClientFrame(FrameWidth,FrameHeight); 121 if NeededClientW>0 then 122 NeededClientW-=FrameWidth; 123 if NeededClientH>0 then 124 NeededClientH-=FrameHeight; 125 126 if HorzScrollBar.Visible then 127 HorzScrollBar.InternalSetRange(NeededClientW) 128 else 129 HorzScrollBar.InternalSetRange(0); 130 131 if VertScrollBar.Visible then 132 VertScrollBar.InternalSetRange(NeededClientH) 133 else 134 VertScrollBar.InternalSetRange(0); 135end; 136 137class function TScrollingWinControl.GetControlClassDefaultSize: TSize; 138begin 139 Result.CX := 150; 140 Result.CY := 150; 141end; 142 143procedure TScrollingWinControl.SetHorzScrollBar(Value: TControlScrollBar); 144begin 145 FHorzScrollbar.Assign(Value); 146end; 147 148procedure TScrollingWinControl.SetVertScrollBar(Value: TControlScrollBar); 149begin 150 FVertScrollbar.Assign(Value); 151end; 152 153procedure TScrollingWinControl.HideScrollbars; 154begin 155 if Assigned(FHorzScrollBar) and FHorzScrollBar.HandleAllocated then 156 begin 157 ShowScrollBar(FHorzScrollBar.ControlHandle, SB_Horz, False); 158 FHorzScrollBar.Range := 0; 159 FHorzScrollBar.Page := 80; 160 FHorzScrollBar.Position := 0; 161 end; 162 if Assigned(FVertScrollBar) and FVertScrollBar.HandleAllocated then 163 begin 164 ShowScrollBar(FVertScrollBar.ControlHandle, SB_Vert, False); 165 FVertScrollBar.Range := 0; 166 FVertScrollBar.Page := 80; 167 FVertScrollBar.Position := 0; 168 end; 169end; 170 171procedure TScrollingWinControl.WMSize(var Message: TLMSize); 172var 173 NewState: TWindowState; 174begin 175 inherited; 176 if (Message.SizeType and SIZE_SourceIsInterface) <> 0 then 177 begin 178 NewState := wsNormal; 179 case (Message.SizeType xor SIZE_SourceIsInterface) of 180 SIZE_MINIMIZED: 181 NewState := wsMinimized; 182 SIZE_MAXIMIZED: 183 NewState := wsMaximized; 184 SIZE_FULLSCREEN: 185 NewState := wsFullScreen; 186 end; 187 Resizing(NewState); 188 end; 189end; 190 191procedure TScrollingWinControl.Resizing(State: TWindowState); 192begin 193 // 194end; 195 196procedure TScrollingWinControl.ComputeScrollbars; 197 procedure UpdateBar(aBar: TControlScrollBar; aClientSize: integer); 198 begin 199 // page (must be smaller than Range but at least 1) 200 aBar.FPage := Max(1,Min(Min(aBar.Range,aClientSize), High(HorzScrollbar.FPage))); 201 aBar.FAutoRange := Max(0, aBar.Range - aClientSize); 202 {$IFDEF VerboseScrollingWinControl} 203 debugln(['TScrollingWinControl.ComputeScrollbars ',DbgSName(Self),' ',dbgs(aBar.Kind),' Page=',aBar.Page,' Range=',aBar.Range,' ClientSize=',aClientSize]); 204 {$ENDIF} 205 end; 206 207var 208 ClientW: Integer; 209 ClientH: Integer; 210begin 211 CalculateAutoRanges; 212 213 ClientW:=VertScrollBar.ClientSizeWithoutBar; 214 ClientH:=HorzScrollBar.ClientSizeWithoutBar; 215 {$IFDEF VerboseScrollingWinControl} 216 debugln(['TScrollingWinControl.ComputeScrollbars ',DbgSName(Self),' Bounds=',dbgs(BoundsRect),' ClientRect=',dbgs(ClientRect),' ClientRectNoScrollBars=',ClientW,'x',ClientH]); 217 {$ENDIF} 218 219 if VertScrollBar.Range > ClientH then 220 begin 221 // vertical does not fit -> vertical scrollbar will be shown 222 ClientW:=VertScrollBar.ClientSizeWithBar; 223 end; 224 if HorzScrollBar.Range > ClientW then 225 begin 226 // horizontal does not fit -> horizontal scrollbar will be shown 227 ClientH:=HorzScrollBar.ClientSizeWithBar; 228 if VertScrollBar.Range > ClientH then 229 begin 230 // vertical does not fit, because of the other scrollbar 231 // -> vertical scrollbar will be shown too 232 ClientW:=VertScrollBar.ClientSizeWithBar; 233 end; 234 end; 235 236 UpdateBar(HorzScrollBar,ClientW); 237 UpdateBar(VertScrollBar,ClientH); 238end; 239 240procedure TScrollingWinControl.UpdateScrollbars; 241begin 242 if ([csLoading, csDestroying] * ComponentState <> []) then Exit; 243 if not HandleAllocated then Exit; 244 if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit; 245 246 if FIsUpdating then Exit; 247 248 FIsUpdating := True; 249 try 250 if AutoScroll then 251 ComputeScrollbars; // page, autorange, IsScrollBarVisible 252 FVertScrollbar.UpdateScrollbar; 253 FHorzScrollbar.UpdateScrollbar; 254 finally 255 FIsUpdating := False; 256 end; 257end; 258 259class procedure TScrollingWinControl.WSRegisterClass; 260const 261 Registered : boolean = False; 262begin 263 if Registered then 264 Exit; 265 inherited WSRegisterClass; 266 RegisterScrollingWinControl; 267 Registered := True; 268end; 269 270procedure TScrollingWinControl.ScrollBy(DeltaX, DeltaY: Integer); 271begin 272 ScrollBy_WS(DeltaX, DeltaY); 273end; 274 275procedure TScrollingWinControl.ScrollInView(AControl: TControl); 276var 277 LRect: TRect; 278 LPoint: TPoint; 279 LHorzVisible, LVertVisible: Boolean; 280begin 281 if (AControl = nil) or not IsParentOf(AControl) then Exit; 282 LHorzVisible := HorzScrollBar.IsScrollBarVisible; 283 LVertVisible := VertScrollBar.IsScrollBarVisible; 284 if not LHorzVisible and not LVertVisible then Exit; 285 LRect := Rect(0, 0, AControl.Width, AControl.Height); 286 LPoint := AControl.ClientToParent(Point(0, 0), Self); 287 OffsetRect(LRect, LPoint.x, LPoint.y); 288 if LHorzVisible then 289 if LRect.Left < 0 then 290 HorzScrollBar.Position := HorzScrollBar.Position + LRect.Left 291 else if LRect.Right > ClientWidth then 292 begin 293 if LRect.Right - LRect.Left > ClientWidth then 294 LRect.Right := LRect.Left + ClientWidth; 295 HorzScrollBar.Position := HorzScrollBar.Position + LRect.Right - ClientWidth; 296 end; 297 if LVertVisible then 298 if LRect.Top < 0 then 299 VertScrollBar.Position := VertScrollBar.Position + LRect.Top 300 else if LRect.Bottom > ClientHeight then 301 begin 302 if LRect.Bottom - LRect.Top > ClientHeight then 303 LRect.Bottom := LRect.Top + ClientHeight; 304 VertScrollBar.Position := VertScrollBar.Position + LRect.Bottom - ClientHeight; 305 end; 306end; 307 308procedure TScrollingWinControl.Loaded; 309begin 310 inherited Loaded; 311 UpdateScrollbars; 312end; 313 314procedure TScrollingWinControl.SetAutoSize(Value: Boolean); 315begin 316 if AutoSize=Value then exit; 317 if Value then 318 ControlStyle:=ControlStyle-[csAutoSizeKeepChildLeft,csAutoSizeKeepChildTop] 319 else 320 ControlStyle:=ControlStyle+[csAutoSizeKeepChildLeft,csAutoSizeKeepChildTop]; 321 inherited SetAutoSize(Value); 322end; 323 324procedure TScrollingWinControl.WMVScroll(var Message : TLMVScroll); 325begin 326 VertScrollbar.ScrollHandler(Message); 327end; 328 329procedure TScrollingWinControl.WMHScroll(var Message : TLMHScroll); 330begin 331 //DebugLn(['TScrollingWinControl.WMHScroll ',dbgsName(Self)]); 332 HorzScrollbar.ScrollHandler(Message); 333end; 334 335constructor TScrollingWinControl.Create(TheOwner : TComponent); 336begin 337 Inherited Create(TheOwner); 338 339 FAutoScroll := False; 340 FVertScrollbar := TControlScrollBar.Create(Self, sbVertical); 341 FHorzScrollbar := TControlScrollBar.Create(Self, sbHorizontal); 342 343 ControlStyle := [csAcceptsControls, csClickEvents, csDoubleClicks, 344 csAutoSizeKeepChildLeft, csAutoSizeKeepChildTop]; 345 346 with GetControlClassDefaultSize do 347 SetInitialBounds(0, 0, CX, CY); 348end; 349 350destructor TScrollingWinControl.Destroy; 351begin 352 FreeThenNil(FHorzScrollBar); 353 FreeThenNil(FVertScrollBar); 354 inherited Destroy; 355end; 356 357function TScrollingWinControl.ScreenToClient(const APoint: TPoint): TPoint; 358var 359 P: TPoint; 360begin 361 P := GetClientScrollOffset; 362 Result := inherited; 363 Result.x := Result.x - P.x; 364 Result.y := Result.y - P.y; 365end; 366 367function TScrollingWinControl.ClientToScreen(const APoint: TPoint): TPoint; 368var 369 P: TPoint; 370begin 371 P := GetClientScrollOffset; 372 Result := inherited; 373 Result.x := Result.x + P.x; 374 Result.y := Result.y + P.y; 375end; 376 377// included by forms.pp 378