1{%MainUnit ../comctrls.pp} 2{ 3 ***************************************************************************** 4 This file is part of the Lazarus Component Library (LCL) 5 6 See the file COPYING.modifiedLGPL.txt, included in this distribution, 7 for details about the license. 8 ***************************************************************************** 9} 10 11{------------------------------------------------------------------------------} 12{ TStatusBar Constructor } 13{------------------------------------------------------------------------------} 14constructor TStatusBar.Create(TheOwner: TComponent); 15begin 16 inherited Create(TheOwner); 17 FCompStyle := csStatusBar; 18 FAutoHint := False; 19 FCanvas := TControlCanvas.Create; 20 TControlCanvas(FCanvas).Control := Self; 21 ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque]; 22 FSimplePanel := True; 23 FSizeGrip := True; 24 FUseSystemFont := True; 25 FPanels := CreatePanels; 26 Color := {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif}; 27 Align := alBottom; 28 AutoSize := True; 29end; 30 31 32{------------------------------------------------------------------------------} 33{ TStatusBar SetSimpleText } 34{------------------------------------------------------------------------------} 35procedure TStatusBar.SetSimpleText(const Value : TCaption); 36begin 37 if FSimpleText <> value then 38 begin 39 FSimpleText := Value; 40 if HandleAllocated and FSimplePanel then 41 TWSStatusBarClass(WidgetSetClass).SetPanelText(Self, 0); 42 end; 43end; 44 45procedure TStatusBar.SetSimplePanel(Value : Boolean); 46begin 47 if FSimplePanel <> Value then 48 begin 49 FSimplePanel := Value; 50 //debugln('TStatusBar.SetSimplePanel FSimplePanel=',dbgs(FSimplePanel),' ',dbgsName(Self)); 51 UpdateHandleObject(-1, AllPanelsParts); 52 end; 53end; 54 55procedure TStatusBar.SetSizeGrip(const AValue: Boolean); 56begin 57 if FSizeGrip = AValue then 58 Exit; 59 FSizeGrip := AValue; 60 if HandleAllocated then 61 TWSStatusBarClass(WidgetSetClass).SetSizeGrip(Self, AValue); 62end; 63 64class procedure TStatusBar.WSRegisterClass; 65begin 66 inherited WSRegisterClass; 67 RegisterStatusBar; 68end; 69 70function TStatusBar.DoSetApplicationHint(AHintStr: String): Boolean; 71begin 72 Result := DoHint; 73 if Result then 74 Exit; 75 if SimplePanel then 76 SimpleText := AHintStr 77 else 78 if Panels.Count > 0 then 79 Panels[0].Text := AHintStr; 80 Result := True; 81end; 82 83function TStatusBar.DoHint: Boolean; 84begin 85 Result := Assigned(FOnHint); 86 if Result then 87 OnHint(Self); 88end; 89 90procedure TStatusBar.DrawPanel(Panel: TStatusPanel; const Rect: TRect); 91begin 92 if Assigned(FOnDrawPanel) then 93 FOnDrawPanel(Self, Panel, Rect); 94end; 95 96procedure TStatusBar.LMDrawItem(var Message: TLMDrawItems); 97var 98 OldHandle: HDC; 99begin 100 with Message.DrawItemStruct^ do 101 begin 102 if Canvas.HandleAllocated then 103 OldHandle := Canvas.Handle 104 else 105 OldHandle := 0; 106 Canvas.Handle := _hDC; 107 DrawPanel(Panels[itemID], rcItem); 108 Canvas.Handle := OldHandle; 109 end; 110end; 111 112procedure TStatusBar.BoundsChanged; 113begin 114 inherited BoundsChanged; 115 if HandleAllocated then 116 TWSStatusBarClass(WidgetSetClass).SetSizeGrip(Self, SizeGrip); 117end; 118 119procedure TStatusBar.SetPanels(Value: TStatusPanels); 120begin 121 FPanels.Assign(Value); 122end; 123 124{------------------------------------------------------------------------------} 125{ TStatusBar Destructor } 126{------------------------------------------------------------------------------} 127destructor TStatusBar.Destroy; 128begin 129 FreeThenNil(FCanvas); 130 FreeThenNil(FPanels); 131 inherited Destroy; 132end; 133 134procedure TStatusBar.CreateWnd; 135begin 136 inherited CreateWnd; 137 if FHandleObjectNeedsUpdate then 138 UpdateHandleObject(FHandleUpdatePanelIndex, AllPanelsParts); 139end; 140 141procedure TStatusBar.DestroyWnd; 142begin 143 inherited DestroyWnd; 144 if FCanvas <> nil then 145 TControlCanvas(FCanvas).FreeHandle; 146 FHandlePanelCount:=0; 147 FHandleObjectNeedsUpdate:=false; 148end; 149 150procedure TStatusBar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; 151 const AXProportion, AYProportion: Double); 152var 153 I: Integer; 154begin 155 inherited; 156 157 if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then 158 begin 159 BeginUpdate; 160 try 161 for I := 0 to Panels.Count-1 do 162 Panels[I].Width := Round(Panels[I].Width * AXProportion); 163 finally 164 EndUpdate; 165 end; 166 end; 167end; 168 169procedure TStatusBar.Loaded; 170begin 171 inherited Loaded; 172 if FHandleObjectNeedsUpdate then 173 UpdateHandleObject(FHandleUpdatePanelIndex, AllPanelsParts); 174end; 175 176procedure TStatusBar.UpdateHandleObject(PanelIndex: integer; PanelParts: TPanelParts); 177begin 178 if (not HandleAllocated) or (csDestroying in ComponentState) or 179 ((PanelIndex>0) and SimplePanel) then 180 Exit; 181 182 if (csLoading in ComponentState) or (FUpdateLock > 0) then 183 begin 184 //DebugLn('TStatusBar.UpdateHandleObject Caching FHandleObjectNeedsUpdate=',dbgs(FHandleObjectNeedsUpdate),' FHandleUpdatePanelIndex=',dbgs(FHandleUpdatePanelIndex),' PanelIndex=',dbgs(PanelIndex)); 185 if FHandleObjectNeedsUpdate then 186 begin 187 // combine multiple updates 188 if (FHandleUpdatePanelIndex>=0) and (FHandleUpdatePanelIndex <> PanelIndex) then 189 FHandleUpdatePanelIndex:=-1; // at least 2 different panels need update => update all 190 end else 191 begin 192 // start an update sequence 193 FHandleObjectNeedsUpdate := True; 194 FHandleUpdatePanelIndex := PanelIndex; 195 end; 196 Exit; 197 end; 198 199 //DebugLn('TStatusBar.UpdateHandleObject A FHandlePanelCount=',dbgs(FHandlePanelCount),' PanelIndex=',dbgs(PanelIndex),' Panels.Count=',dbgs(Panels.Count),' SimplePanel=',dbgs(SimplePanel)); 200 if (FHandlePanelCount > PanelIndex) and (PanelIndex >= 0) then 201 begin 202 // update one panel 203 TWSStatusBarClass(WidgetSetClass).PanelUpdate(Self, PanelIndex); 204 end else 205 begin 206 // update all panels 207 //DebugLn('TStatusBar.UpdateHandleObject C update all panels'); 208 TWSStatusBarClass(WidgetSetClass).Update(Self); 209 if SimplePanel then 210 FHandlePanelCount := 1 211 else 212 FHandlePanelCount := Panels.Count; 213 end; 214 FHandleObjectNeedsUpdate := False; 215end; 216 217procedure TStatusBar.CalculatePreferredSize(var PreferredWidth, 218 PreferredHeight: integer; WithThemeSpace: Boolean); 219begin 220 inherited CalculatePreferredSize(PreferredWidth, PreferredHeight, WithThemeSpace); 221 PreferredWidth := 0; 222 if PreferredHeight <= 0 then 223 PreferredHeight := 25; 224end; 225 226procedure TStatusBar.SetBiDiMode(AValue: TBiDiMode); 227var 228 OldUseRTL: Boolean; 229 i: Integer; 230begin 231 if (BiDiMode = AValue) then Exit; 232 OldUseRTL := UseRightToLeftAlignment; 233 inherited SetBiDiMode(AValue); 234 if (OldUseRTL <> UseRightToLeftAlignment) and (Panels.Count > 0) then 235 begin 236 for i := 0 to Panels.Count - 1 do 237 Panels[i].Alignment := BiDiFlipAlignment(Panels[i].Alignment, True); 238 end; 239 UpdateHandleObject(-1, AllPanelsParts); 240end; 241 242procedure TStatusBar.BeginUpdate; 243begin 244 inc(FUpdateLock); 245 if FUpdateLock=1 then 246 Panels.BeginUpdate; 247end; 248 249procedure TStatusBar.EndUpdate; 250begin 251 if FUpdateLock<=0 then RaiseGDBException('TStatusBar.EndUpdate'); 252 if FUpdateLock=1 then begin 253 // end update in Panels before decreasing FUpdateLock, so that 254 // multiple changes of Panels will be combined 255 Panels.EndUpdate; 256 end; 257 dec(FUpdateLock); 258 if (FUpdateLock=0) then begin 259 if FHandleObjectNeedsUpdate then 260 UpdateHandleObject(FHandleUpdatePanelIndex, AllPanelsParts); 261 end; 262end; 263 264function TStatusBar.ExecuteAction(ExeAction: TBasicAction): Boolean; 265var 266 HintAction: TCustomHintAction absolute ExeAction; 267begin 268 if AutoHint and (ExeAction is TCustomHintAction) then 269 Result := DoSetApplicationHint(HintAction.Hint) 270 else 271 Result := inherited ExecuteAction(ExeAction); 272end; 273 274function TStatusBar.GetPanelIndexAt(X, Y: Integer): Integer; 275var 276 R, PanelRect: TRect; 277 P: TPoint; 278 i: integer; 279begin 280 Result := -1; 281 if Panels.Count = 0 then 282 Exit; 283 R := GetChildrenRect(False); 284 P := Point(X, Y); 285 if not PtInRect(R, P) then 286 Exit; 287 PanelRect := R; 288 for i := 0 to Panels.Count - 1 do 289 begin 290 if i <> Panels.Count - 1 then 291 PanelRect.Right := PanelRect.Left + Panels[i].Width 292 else 293 PanelRect.Right := R.Right; 294 if PtInRect(PanelRect, P) then 295 Exit(i); 296 PanelRect.Left := PanelRect.Right; 297 end; 298end; 299 300 301function TStatusBar.SizeGripEnabled: Boolean; 302begin 303 Result := (Parent <> nil) and 304 (Parent is TCustomForm) and 305 (TCustomForm(Parent).BorderStyle in [bsSizeable, bsSizeToolWin]) and 306 (Align = alBottom); 307end; 308 309function TStatusBar.UpdatingStatusBar: boolean; 310begin 311 Result:=FUpdateLock>0; 312end; 313 314{------------------------------------------------------------------------------ 315 procedure TStatusBar.InvalidatePanel(PanelIndex: integer; 316 PanelParts: TPanelParts); 317------------------------------------------------------------------------------} 318procedure TStatusBar.InvalidatePanel(PanelIndex: integer; 319 PanelParts: TPanelParts); 320begin 321 if (PanelParts=[]) then exit; 322 UpdateHandleObject(PanelIndex, PanelParts); 323end; 324 325{------------------------------------------------------------------------------ 326 function TStatusBar.CreatePanel(): TStatusPanel; 327------------------------------------------------------------------------------} 328function TStatusBar.CreatePanel: TStatusPanel; 329var 330 AClass: TStatusPanelClass; 331begin 332 AClass := GetPanelClass; 333 if Assigned(FOnCreatePanelClass) then 334 OnCreatePanelClass(Self, AClass); 335 Result := AClass.Create(Panels); 336end; 337{------------------------------------------------------------------------------ 338 function TStatusBar.CreatePanels(): TStatusPanels; 339------------------------------------------------------------------------------} 340function TStatusBar.CreatePanels: TStatusPanels; 341begin 342 Result := TStatusPanels.Create(Self); 343end; 344{------------------------------------------------------------------------------ 345 function TStatusBar.GetPanelClass(): TStatusPanelClass; 346------------------------------------------------------------------------------} 347function TStatusBar.GetPanelClass: TStatusPanelClass; 348begin 349 Result := TStatusPanel; 350end; 351 352// included by comctrls.pp 353