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 12const 13 IntfBarKind: array[TScrollBarKind] of Integer = 14 ( 15 SB_HORZ, 16 SB_VERT 17 ); 18 19 TrackToPolicyMap: array[Boolean] of integer = 20 ( 21 SB_POLICY_DISCONTINUOUS, 22 SB_POLICY_CONTINUOUS 23 ); 24 25procedure TControlScrollBar.SetPosition(const Value: Integer); 26var 27 MaxPos, PrevPosition: Integer; 28 ScrollInfo: TScrollInfo; 29begin 30 if csLoading in FControl.ComponentState then 31 begin 32 FPosition := Value; 33 Exit; 34 end; 35 36 if Value < 0 then 37 begin 38 SetPosition(0); 39 exit; 40 end; 41 42 if GetAutoScroll then 43 begin 44 if Value > FAutoRange then 45 begin 46 {$IFDEF VerboseScrollingWinControl} 47 if DebugCondition then 48 DebugLn(['TControlScrollBar.SetPosition FAutoRange Value=',Value,' > AutoRange=',FAutoRange]); 49 {$ENDIF} 50 SetPosition(FAutoRange); 51 exit; 52 end; 53 end; 54 55 MaxPos := Range - Page; 56 if (MaxPos >= 0) and (Value > MaxPos) then 57 begin 58 {$IFDEF VerboseScrollingWinControl} 59 if DebugCondition then 60 DebugLn(['TControlScrollBar.SetPosition Range Value=',Value,' > Range=',Range]); 61 {$ENDIF} 62 SetPosition(MaxPos); 63 exit; 64 end; 65 66 {$IFDEF VerboseScrollingWinControl} 67 if DebugCondition then 68 DebugLn(['TControlScrollBar.SetPosition Value=',Value,' FPosition=',FPosition]); 69 {$ENDIF} 70 if Value = FPosition then 71 exit; 72 73 PrevPosition := FPosition; 74 // position has to be set before FControl.ScrollBy !!! 75 FPosition := Value; 76 77 // scroll logical client area of FControl 78 if Kind = sbVertical then 79 FControl.ScrollBy(0, PrevPosition - FPosition) 80 else 81 FControl.ScrollBy(PrevPosition - FPosition, 0); 82 83 // check that the new position is also set on the scrollbar 84 if HandleAllocated and (GetScrollPos(ControlHandle, IntfBarKind[Kind]) <> FPosition) then 85 begin 86 InvalidateScrollInfo; 87 {$IFDEF VerboseScrollingWinControl} 88 if DebugCondition then 89 DebugLn(['TControlScrollBar.SetPosition FPosition=',FPosition]); 90 {$ENDIF} 91 // send position to interface and store it back to FPosition (this way LCL will have actual position value) 92 FillChar(ScrollInfo,SizeOf(ScrollInfo), 0); 93 ScrollInfo.cbSize := SizeOf(ScrollInfo); 94 ScrollInfo.fMask := SIF_POS; 95 ScrollInfo.nPos := FPosition; 96 97 FPosition := SetScrollInfo(ControlHandle, IntfBarKind[Kind], ScrollInfo, ScrollBarShouldBeVisible); 98 end; 99end; 100 101function TControlScrollBar.GetIncrement: TScrollBarInc; 102begin 103 Result := FIncrement; 104end; 105 106function TControlScrollBar.GetPage: TScrollBarInc; 107var 108 ScrollInfo: TScrollInfo; 109begin 110 if HandleAllocated and (not (FControl is TScrollingWinControl)) then 111 begin 112 ScrollInfo.fMask := SIF_PAGE; 113 GetScrollInfo(ControlHandle, IntfBarKind[Kind], ScrollInfo); 114 if FPage<>ScrollInfo.nPage then 115 begin 116 FPage := ScrollInfo.nPage; 117 InvalidateScrollInfo; 118 end; 119 end; 120 Result := FPage; 121end; 122 123function TControlScrollBar.GetPosition: Integer; 124var 125 ScrollInfo: TScrollInfo; 126begin 127 if HandleAllocated and (not (FControl is TScrollingWinControl)) then 128 begin 129 ScrollInfo.fMask := SIF_POS; 130 GetScrollInfo(ControlHandle, IntfBarKind[Kind], ScrollInfo); 131 if FPosition <> ScrollInfo.nPos then 132 begin 133 FPosition := ScrollInfo.nPos; 134 InvalidateScrollInfo; 135 end; 136 end; 137 Result := FPosition; 138end; 139 140function TControlScrollBar.GetRange: Integer; 141var 142 ScrollInfo: TScrollInfo; 143 NewRange: Integer; 144begin 145 if HandleAllocated and (not (FControl is TScrollingWinControl)) then 146 begin 147 ScrollInfo.fMask := SIF_Range + SIF_Page; 148 GetScrollInfo(ControlHandle, IntfBarKind[Kind], ScrollInfo); 149 NewRange := ScrollInfo.nMax - ScrollInfo.nMin; 150 if NewRange <> FRange then 151 begin 152 FRange := NewRange; 153 InvalidateScrollInfo; 154 end; 155 end; 156 Result := FRange; 157end; 158 159function TControlScrollBar.GetSmooth: Boolean; 160begin 161 Result := FSmooth; 162end; 163 164procedure TControlScrollBar.SetIncrement(const AValue: TScrollBarInc); 165begin 166 // This value is only used by the ScrollHandler procedure 167 FIncrement := AValue; 168end; 169 170procedure TControlScrollBar.SetPage(const AValue: TScrollBarInc); 171begin 172 if FPage = AValue then exit; 173 FPage := AValue; 174 ControlUpdateScrollBars; 175end; 176 177function TControlScrollBar.GetSize: integer; 178var 179 KindID: integer; 180begin 181 if Kind = sbHorizontal then 182 KindID := SM_CYHSCROLL 183 else 184 KindID := SM_CXVSCROLL; 185 if HandleAllocated then 186 Result := LCLIntf.GetScrollBarSize(ControlHandle,KindID) 187 else 188 Result := GetSystemMetrics(KindID); 189end; 190 191procedure TControlScrollBar.SetRange(const AValue: Integer); 192begin 193 if not (csLoading in FControl.ComponentState) then 194 if FControl is TScrollingWinControl then 195 TScrollingWinControl(FControl).FAutoScroll := False; 196 197 InternalSetRange(AValue); 198end; 199 200procedure TControlScrollBar.SetVisible(const AValue: Boolean); 201begin 202 if FVisible = AValue then 203 Exit; 204 FVisible := AValue; 205 ControlUpdateScrollBars; 206end; 207 208procedure TControlScrollBar.SetSmooth(const AValue: Boolean); 209begin 210 // only used by the ScrollHandler procedure 211 FSmooth := AValue; 212end; 213 214procedure TControlScrollBar.UpdateScrollBar; 215var 216 ScrollInfo: TScrollInfo; 217 NewVisible: Boolean; 218begin 219 if HandleAllocated and (FControl is TScrollingWinControl) then 220 begin 221 FillChar(ScrollInfo, SizeOf(ScrollInfo), 0); 222 ScrollInfo.cbSize := SizeOf(ScrollInfo); 223 ScrollInfo.fMask := SIF_ALL; 224 ScrollInfo.nMin := 0; 225 ScrollInfo.nMax := FRange; 226 ScrollInfo.nPos := FPosition; 227 ScrollInfo.nPage := FPage; 228 ScrollInfo.nTrackPos := FPosition; 229 NewVisible := ScrollBarShouldBeVisible; 230 if (not FOldScrollInfoValid) or (not CompareMem(@ScrollInfo, @FOldScrollInfo, SizeOf(TScrollInfo))) then 231 begin 232 FOldScrollInfo := ScrollInfo; 233 FOldScrollInfoValid := True; 234 SetScrollInfo(ControlHandle, IntfBarKind[Kind], ScrollInfo, NewVisible); 235 // update policy too 236 ScrollInfo.fMask := SIF_UPDATEPOLICY; 237 ScrollInfo.nTrackPos := TrackToPolicyMap[FTracking]; 238 SetScrollInfo(ControlHandle, IntfBarKind[Kind], ScrollInfo, NewVisible); 239 end; 240 ShowScrollBar(ControlHandle, IntfBarKind[Kind], NewVisible); 241 {$IFDEF VerboseScrollingWinControl} 242 //if DebugCondition then 243 DebugLn(['TControlScrollBar.UpdateScrollBar ',DbgSName(FControl),' ',DbgSName(Self),' ',dbgs(Kind),' FVisible=',FVisible,' Range=',FRange,' FPosition=',FPosition,' FPage=',FPage,' FAutoRange=',FAutoRange,' ShouldVisible=',NewVisible,' IsVisible=',IsScrollBarVisible]); 244 {$ENDIF} 245 end; 246 247 SetPosition(FPosition); 248 249 if FControl is TScrollingWinControl then 250 begin 251 // I am not positive that this is right, but it appeared to be when I 252 // compared results to Delphi 4 253 if FSmooth then 254 FIncrement := Max(low(FIncrement),FPage div 10); 255 end; 256end; 257 258procedure TControlScrollBar.InvalidateScrollInfo; 259begin 260 FOldScrollInfoValid := False; 261end; 262 263{$ifdef VerboseScrollingWinControl} 264function TControlScrollBar.DebugCondition: Boolean; 265begin 266 Result := (Kind = sbHorizontal); 267end; 268{$endif} 269 270function TControlScrollBar.GetAutoScroll: boolean; 271begin 272 if FControl is TScrollingWinControl then 273 Result := TScrollingWinControl(FControl).AutoScroll 274 else 275 Result := False; 276end; 277 278procedure TControlScrollBar.ScrollHandler(var Message: TLMScroll); 279var 280 NewPos: Longint; 281begin 282 if (csDesigning in FControl.ComponentState) then 283 exit; //prevent wierdness in IDE. 284 285 NewPos := FPosition; 286 case Message.ScrollCode of 287 SB_LINEUP: 288 Dec(NewPos, FIncrement); 289 SB_LINEDOWN: 290 Inc(NewPos, FIncrement); 291 SB_PAGEUP: 292 Dec(NewPos, FPage); 293 SB_PAGEDOWN: 294 Inc(NewPos, FPage); 295 SB_THUMBPOSITION: 296 NewPos := Message.Pos; 297 SB_THUMBTRACK: 298 if Tracking then 299 NewPos := Message.Pos; 300 SB_TOP: 301 NewPos := 0; 302 SB_BOTTOM: 303 NewPos := Range; 304 else 305 Exit; 306 end; 307 {$IFDEF VerboseScrollingWinControl} 308 if DebugCondition then 309 DebugLn(['TControlScrollBar.ScrollHandler Message.ScrollCode=',Message.ScrollCode,' FPosition=',FPosition,' NewPos=',NewPos,' Range=',Range]); 310 {$ENDIF} 311 if NewPos < 0 then 312 NewPos := 0; 313 if NewPos > FRange then 314 NewPos := FRange; 315 if NewPos<>FPosition then 316 begin 317 InvalidateScrollInfo; 318 SetPosition(NewPos); 319 Message.Result := 1; 320 end; 321end; 322 323procedure TControlScrollBar.ControlUpdateScrollBars; 324begin 325 if ([csLoading, csDestroying] * FControl.ComponentState <> []) then 326 Exit; 327 if not HandleAllocated then 328 Exit; 329 if FControl is TScrollingWinControl then 330 TScrollingWinControl(FControl).UpdateScrollBars; 331end; 332 333procedure TControlScrollBar.InternalSetRange(const AValue: Integer); 334var 335 NewRange: Integer; 336begin 337 NewRange := AValue; 338 if NewRange < 0 then 339 NewRange := 0; 340 if FRange = NewRange then 341 Exit; 342 FRange := NewRange; 343 {$IFDEF VerboseScrollingWinControl} 344 //if DebugCondition then 345 DebugLn(['TControlScrollBar.InternalSetRange ',dbgs(Kind),' ',Self,' FRange=',FRange]); 346 {$ENDIF} 347 ControlUpdateScrollBars; 348end; 349 350function TControlScrollBar.HandleAllocated: boolean; 351begin 352 Result := (FControl <> nil) and FControl.HandleAllocated; 353end; 354 355function TControlScrollBar.IsRangeStored: boolean; 356begin 357 Result := not GetAutoScroll; 358end; 359 360procedure TControlScrollBar.SetTracking(const AValue: Boolean); 361var 362 ScrollInfo: TScrollInfo; 363begin 364 if FTracking = AValue then Exit; 365 FTracking := AValue; 366 if not HandleAllocated then 367 Exit; 368 FillChar(ScrollInfo,SizeOf(ScrollInfo), 0); 369 ScrollInfo.cbSize := SizeOf(ScrollInfo); 370 ScrollInfo.fMask := SIF_UPDATEPOLICY; 371 ScrollInfo.nTrackPos := TrackToPolicyMap[FTracking]; 372 SetScrollInfo(ControlHandle, IntfBarKind[Kind], ScrollInfo, ScrollBarShouldBeVisible); 373end; 374 375function TControlScrollBar.ControlHandle: HWnd; 376begin 377 Result := FControl.Handle; 378end; 379 380function TControlScrollBar.ControlSize: integer; 381begin 382 if Kind = sbVertical then 383 Result := FControl.Width 384 else 385 Result := FControl.Height; 386end; 387 388constructor TControlScrollBar.Create(AControl: TWinControl; 389 AKind: TScrollBarKind); 390begin 391 inherited Create; 392 FControl := AControl; 393 FKind := AKind; 394 FPage := 80; 395 FIncrement := 8; 396 FPosition := 0; 397 FRange := 0; 398 FSmooth := False; 399 FTracking := False; 400 FVisible := True; 401end; 402 403procedure TControlScrollBar.Assign(Source: TPersistent); 404begin 405 if Source is TControlScrollBar then 406 begin 407 with Source as TControlScrollBar do 408 begin 409 Self.Increment := Increment; 410 Self.Position := Position; 411 Self.Range := Range; 412 Self.Visible := Visible; 413 Self.Smooth := Smooth; 414 // page and size depend on FControl, so no need to copy them 415 end; 416 end 417 else 418 inherited Assign(Source); 419end; 420 421function TControlScrollBar.IsScrollBarVisible: Boolean; 422begin 423 Result := FVisible; 424 if HandleAllocated then 425 Result := GetScrollbarVisible(ControlHandle, IntfBarKind[Kind]); 426end; 427 428function TControlScrollBar.ScrollPos: Integer; 429begin 430 if Visible then 431 Result := Position 432 else 433 Result := 0; 434end; 435 436function TControlScrollBar.GetOtherScrollBar: TControlScrollBar; 437begin 438 if Kind = sbVertical then 439 Result := GetHorzScrollBar 440 else 441 Result := GetVertSCrollbar; 442end; 443 444function TControlScrollBar.ClientSize: integer; 445begin 446 if Kind = sbVertical then 447 Result := FControl.ClientWidth 448 else 449 Result := FControl.ClientHeight; 450end; 451 452function TControlScrollBar.ClientSizeWithBar: integer; 453begin 454 Result := ClientSize; 455 if not IsScrollBarVisible then 456 Result := Max(0,Result-GetSize-GetSystemMetrics(SM_SWSCROLLBARSPACING)); 457end; 458 459function TControlScrollBar.ClientSizeWithoutBar: integer; 460begin 461 Result:=ClientSize; 462 if IsScrollBarVisible then 463 Result := Min(ControlSize, Result+GetSize+GetSystemMetrics(SM_SWSCROLLBARSPACING)); 464end; 465 466function TControlScrollBar.GetHorzScrollBar: TControlScrollBar; 467begin 468 if FControl is TScrollingWinControl then 469 Result := TScrollingWinControl(FControl).HorzScrollBar 470 else 471 Result := nil; 472end; 473 474function TControlScrollBar.GetVertScrollBar: TControlScrollBar; 475begin 476 if FControl is TScrollingWinControl then 477 Result := TScrollingWinControl(FControl).VertScrollBar 478 else 479 Result := nil; 480end; 481 482function TControlScrollBar.ScrollBarShouldBeVisible: Boolean; 483begin 484 Result := FVisible and (FRange > FPage); 485end; 486 487// included by forms.pp 488