{%MainUnit ../comctrls.pp} {****************************************************************************** TCoolBar ****************************************************************************** ***************************************************************************** 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. ***************************************************************************** } const GrabWidth = 9; { TCoolBand } constructor TCoolBand.Create(aCollection: TCollection); begin inherited Create(aCollection); Assert(aCollection is TCoolBands, 'TCoolBand.Create: aCollection is not TCoolBands'); FCoolBar := TCoolBands(aCollection).FCoolBar; Width := 100; FBreak := True; FColor := clBtnFace; FFixedBackground := True; FImageIndex := -1; FMinHeight := 25; FParentColor := True; FParentBitmap := True; FBitmap := TBitmap.Create; FVisible := True; end; destructor TCoolBand.Destroy; begin FBitmap.Free; inherited Destroy; end; function TCoolBand.GetWidth: Integer; begin Result := FCoolBar.Width; end; function TCoolBand.GetText: string; begin if Assigned(FTextLabel) then Result := FTextLabel.Caption else Result := ''; end; function TCoolBand.IsBitmapStored: Boolean; begin Result := not ParentBitmap; end; function TCoolBand.IsColorStored: Boolean; begin Result := not ParentColor; end; function TCoolBand.GetHeight: Integer; begin if Assigned(FControl) then Result := FControl.Height else Result := 20; end; function TCoolBand.GetVisible: Boolean; begin Result := FVisible and not (FCoolBar.Vertical and FHorizontalOnly); end; procedure TCoolBand.ResetControlProps; begin FControl.AnchorSide[akLeft].Control := Nil; FControl.AnchorSide[akRight].Control := Nil; FControl.BorderSpacing.Left := 0; FControl.BorderSpacing.Right := 0; FControl.Anchors := []; if FCoolBar.BiDiMode = bdLeftToRight then FControl.Left := FCoolBar.GrabLeft + GrabWidth + 6 else FControl.Left := FCoolBar.GrabLeft - FControl.Width - 6; end; procedure TCoolBand.SetBorderStyle(aValue: TBorderStyle); begin if FBorderStyle = aValue then Exit; FBorderStyle := aValue; Changed(False); end; procedure TCoolBand.SetBreak(aValue: Boolean); begin if FBreak = aValue then Exit; FBreak := aValue; Changed(False); end; procedure TCoolBand.SetFixedSize(aValue: Boolean); begin if FFixedSize = aValue then Exit; FFixedSize := aValue; if FFixedSize then FBreak := False; Changed(FFixedSize); end; procedure TCoolBand.SetMinHeight(aValue: Integer); begin if FMinHeight = aValue then Exit; FMinHeight := aValue; Changed(False); end; procedure TCoolBand.SetMinWidth(aValue: Integer); begin // No operation currently. Client's width is used for band's width end; procedure TCoolBand.SetVisible(aValue: Boolean); begin if FVisible = aValue then Exit; FVisible := aValue; Changed(True); end; procedure TCoolBand.SetHorizontalOnly(aValue: Boolean); begin if FHorizontalOnly = aValue then Exit; FHorizontalOnly := aValue; Changed(FCoolBar.Vertical); end; procedure TCoolBand.SetImageIndex(aValue: TImageIndex); begin if FImageIndex = aValue then Exit; FImageIndex := aValue; Changed(False); end; procedure TCoolBand.SetFixedBackground(aValue: Boolean); begin if FFixedBackground = aValue then Exit; FFixedBackground := aValue; Changed(False); end; procedure TCoolBand.SetColor(aValue: TColor); begin if FColor = aValue then Exit; FColor := aValue; FParentColor := False; Changed(False); end; procedure TCoolBand.SetControlWidth; var www: Integer; begin if FControl is TCustomCheckBox then Exit; // Calculate width in different situations. if FCoolBar.BiDiMode = bdLeftToRight then www := Width - FControl.Left - 6 // LeftToRight else if Assigned(FTextLabel) then www := FTextLabel.Left - 12 // RightToLeft with TextLabel else www := FCoolBar.GrabLeft - 12; // RightToLeft without TextLabel // Control's width can go negative if CoolBar's width < TextLabel's width. if www < 0 then www := 0; FControl.Width := www; end; procedure TCoolBand.UpdControl(aLabelWidth: integer); begin if FCoolBar = Nil then Exit; FCoolBar.DisableAlign; try Inc(FCoolBar.FUpdateCount); if Assigned(FTextLabel) then begin if Assigned(FControl) then FTextLabel.Top := FTop+4 // Adjust text position for the control (which is higher). else FTextLabel.Top := FTop+1; if FCoolBar.BiDiMode = bdLeftToRight then FTextLabel.Left := FCoolBar.GrabLeft + GrabWidth + 6 else FTextLabel.Left := FCoolBar.GrabLeft - aLabelWidth - 6; FTextLabel.Visible := FCoolBar.ShowText; end; if Assigned(FControl) then begin // Calculate left positions and anchoring for text label and control FControl.Align := alNone; // alCustom does not work here FControl.FreeNotification(FCoolBar); FControl.Top := FTop; if Assigned(FTextLabel) and FCoolBar.ShowText then begin if FCoolBar.BiDiMode = bdLeftToRight then begin FControl.AnchorSide[akRight].Control := Nil; FControl.AnchorSide[akLeft].Control := FTextLabel; FControl.AnchorSide[akLeft].Side := asrRight; FControl.BorderSpacing.Left := 7; FControl.Anchors := [akLeft]; end else begin FControl.AnchorSide[akLeft].Control := Nil; FControl.AnchorSide[akRight].Control := FTextLabel; FControl.AnchorSide[akRight].Side := asrLeft; FControl.BorderSpacing.Right := 7; FControl.Anchors := [akRight]; end; end else ResetControlProps; // Make sure other Anchors a Nil FControl.AnchorSide[akBottom].Control := Nil; FControl.AnchorSide[akTop].Control := Nil; FControl.Parent := FCoolBar; SetControlWidth; end; Dec(FCoolBar.FUpdateCount); finally FCoolBar.EnableAlign; end; end; procedure TCoolBand.SetControl(aValue: TControl); var Band: TCoolBand; begin if FControl = aValue then Exit; FCoolBar.BeginUpdate; try if Assigned(aValue) then begin Band := TCoolBands(Collection).FindBand(aValue); if Assigned(Band) and (Band <> Self) then begin Band.ResetControlProps; Band.SetControl(Nil); // Remove old association end; aValue.Parent := Nil; end; FControl := aValue; Changed(True); finally FCoolBar.EndUpdate; end; end; procedure TCoolBand.SetParentColor(aValue: Boolean); begin if FParentColor = aValue then Exit; FParentColor := aValue; Changed(False); end; procedure TCoolBand.SetParentBitmap(aValue: Boolean); begin if FParentBitmap = aValue then Exit; FParentBitmap := aValue; end; procedure TCoolBand.SetBitmap(aValue: TBitmap); begin FParentBitmap := False; FBitmap.Assign(aValue); Changed(True); end; procedure TCoolBand.SetText(const aValue: string); begin if aValue <> '' then begin if FTextLabel = Nil then begin Inc(FCoolBar.FUpdateCount); FTextLabel := TLabel.Create(FCoolBar); FTextLabel.Name := Format('TextLabel%d', [Index]); FTextLabel.AutoSize := True; FTextLabel.FreeNotification(FCoolBar); FTextLabel.Align := alCustom; FTextLabel.Parent := FCoolBar; Dec(FCoolBar.FUpdateCount); end else if FTextLabel.Caption = aValue then Exit; FTextLabel.Caption := aValue; end else begin if Assigned(FTextLabel) then FreeAndNil(FTextLabel); end; Changed(True); end; procedure TCoolBand.SetWidth(aValue: Integer); begin // No operation currently end; function TCoolBand.GetDisplayName: string; begin Result := Text; if Result = '' then Result := ClassName; end; procedure TCoolBand.SetIndex(aValue: Integer); begin inherited SetIndex(aValue); end; procedure TCoolBand.Assign(aSource: TPersistent); var src: TCoolBand; SrcCtrl: TWinControl; begin if aSource is TCoolBand then begin src := TCoolBand(aSource); Bitmap := src.Bitmap; Break := src.Break; Color := src.Color; FixedBackground := src.FixedBackground; FixedSize := src.FixedSize; HorizontalOnly := src.HorizontalOnly; ImageIndex := src.ImageIndex; MinHeight := src.MinHeight; MinWidth := src.MinWidth; ParentBitmap := src.ParentBitmap; ParentColor := src.ParentColor; Text := src.Text; Visible := src.Visible; // Width := src.Width; SrcCtrl := Nil; if Assigned(src.Control) then SrcCtrl := FCoolBar.Owner.FindComponent(src.Control.Name) as TWinControl; Control := SrcCtrl; end else inherited Assign(aSource); end; { TCoolBands } constructor TCoolBands.Create(aCoolBar: TCustomCoolBar); begin inherited Create(TCoolBand); FCoolBar := aCoolBar; end; function TCoolBands.GetItem(Index: Integer): TCoolBand; begin Result := TCoolBand(inherited GetItem(Index)); end; procedure TCoolBands.SetItem(Index: Integer; aValue: TCoolBand); begin inherited SetItem(Index, aValue); end; function TCoolBands.GetOwner: TPersistent; begin Result := FCoolBar; end; procedure TCoolBands.Update(aItem: TCollectionItem); var PrefWidth, PrefHeight: integer; begin inherited Update(aItem); if FCoolBar = Nil then Exit; if csDestroying in FCoolBar.ComponentState then Exit; if FCoolBar.FUpdateCount = 0 then CalcPreferredSize(True, PrefWidth, PrefHeight); // Calculate control positions end; procedure TCoolBands.Notify(aItem: TCollectionItem; aAction: TCollectionNotification); begin inherited Notify(aItem, aAction); case aAction of cnAdded: begin end; cnExtracting: begin DebugLn('TCoolBands.Notify: aAction = cnExtracting'); FreeAndNil(TCoolBand(aItem).FTextLabel); end; cnDeleting: begin DebugLn('TCoolBands.Notify: aAction = cnDeleting'); end; end; end; function TCoolBands.Add: TCoolBand; begin Result := TCoolBand(inherited Add); DebugLn('TCoolBands.Add'); end; function TCoolBands.FindBand(aControl: TControl): TCoolBand; var i: Integer; begin Result := nil; for i := 0 to Count-1 do if GetItem(i).FControl = AControl then Exit(GetItem(i)); end; procedure TCoolBands.CalcPreferredSize(aAlsoUpdate: Boolean; var aPrefWidth, aPrefHeight: integer); var i, BndWidth, hh: Integer; LabWidth, CtrlWidth, xHeight: integer; Band: TCoolBand; begin aPrefWidth := 0; aPrefHeight := 3; for i := 0 to Count-1 do begin Band := Items[i]; // Calculate width BndWidth := 0; LabWidth := 0; if Assigned(Band.FTextLabel) and FCoolBar.ShowText then begin //DebugLn('TCoolBands.CalcPreferredSize: Calling FTextLabel.GetPreferredSize'); xHeight := 0; Band.FTextLabel.GetPreferredSize(LabWidth, xHeight); BndWidth := LabWidth; end; if Assigned(Band.FControl) then begin //DebugLn('TCoolBands.CalcPreferredSize: Calling FControl.GetPreferredSize'); CtrlWidth := 0; xHeight := 0; Band.FControl.GetPreferredSize(CtrlWidth, xHeight); Inc(BndWidth, CtrlWidth); end; aPrefWidth := Max(aPrefWidth, BndWidth); // Select the widest band // Calculate height hh := Band.Height; if FCoolBar.BandBorderStyle = bsSingle then Inc(hh, 2); if aAlsoUpdate then begin Band.FTop := aPrefHeight; Band.UpdControl(LabWidth); // Set control's location end; Inc(aPrefHeight, hh+3); // Height is cumulative end; end; { TCustomCoolBar } constructor TCustomCoolBar.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, csOpaque, csDoubleClicks]; DragMode := dmAutomatic; Height := 75; Align := alTop; ParentColor := True; ParentFont := True; FBandBorderStyle := bsSingle; FBandMaximize := bmClick; FBands := TCoolBands.Create(Self); FBitmap := TBitmap.Create; FShowText := True; FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := @ImageListChange; end; destructor TCustomCoolBar.Destroy; begin FImageChangeLink.Free; FBitmap.Free; FBands.Free; inherited Destroy; end; procedure TCustomCoolBar.BeginUpdate; begin DisableAlign; inherited BeginUpdate; end; procedure TCustomCoolBar.EndUpdate; begin inherited EndUpdate; EnableAlign; end; function TCustomCoolBar.GrabLeft: integer; begin Result := 2; if BiDiMode <> bdLeftToRight then Result := Width - GrabWidth - Result; end; function TCustomCoolBar.GetAlign: TAlign; begin Result := inherited Align; end; procedure TCustomCoolBar.SetAlign(aValue: TAlign); var Old: TAlign; begin Old := inherited Align; inherited Align := aValue; if (csReading in ComponentState) or (aValue = Old) then Exit; if aValue in [alLeft, alRight] then Vertical := True else if aValue in [alTop, alBottom] then Vertical := False; end; procedure TCustomCoolBar.SetBands(aValue: TCoolBands); begin FBands.Assign(aValue); end; procedure TCustomCoolBar.SetBitmap(aValue: TBitmap); begin FBitmap.Assign(aValue); end; procedure TCustomCoolBar.SetImages(aValue: TCustomImageList); begin if Assigned(FImages) then FImages.UnRegisterChanges(FImageChangeLink); FImages := aValue; if Assigned(FImages) then begin FImages.RegisterChanges(FImageChangeLink); FImages.FreeNotification(Self); end; Invalidate; end; procedure TCustomCoolBar.SetShowText(aValue: Boolean); begin if FShowText = aValue then Exit; FShowText := aValue; if not (csLoading in ComponentState) then FBands.Update(Nil); end; procedure TCustomCoolBar.SetVertical(aValue: Boolean); begin if FVertical = aValue then Exit; Invalidate; end; procedure TCustomCoolBar.ImageListChange(Sender: TObject); begin Invalidate; end; procedure TCustomCoolBar.AlignControls(aControl: TControl; var aRect: TRect); var PrefWidth, PrefHeight: integer; begin //DebugLn('TCoolBar.AlignControls'); if FUpdateCount = 0 then begin FBands.CalcPreferredSize(True, PrefWidth, PrefHeight); inherited AlignControls(aControl, aRect); end; end; procedure TCustomCoolBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); var MinWidth, MinHeight: Integer; PrefWidth, PrefHeight: Integer; begin // Calculate preferred width and height FBands.CalcPreferredSize(False, PrefWidth, PrefHeight); PreferredWidth := Max(PreferredWidth, PrefWidth); PreferredHeight := Max(PreferredHeight, PrefHeight); end; procedure TCustomCoolBar.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if csDestroying in ComponentState then Exit; if Operation = opRemove then begin DebugLn('TCoolBar.Notification: Operation = opRemove'); if AComponent = FImages then Images := nil; end; end; procedure TCustomCoolBar.InsertControl(AControl: TControl; Index: integer); var Band: TCoolBand; begin inherited InsertControl(AControl, Index); if (FUpdateCount = 0) and (AControl is TWinControl) and not (csLoading in ComponentState) then begin Band := Bands.FindBand(AControl); if Band = Nil then begin DebugLn('TCoolBar.InsertControl: Adding band for Comp=' + AControl.Name + ', class=' + AControl.ClassName); Band := FBands.Add; Band.Control := AControl; end; end; end; procedure TCustomCoolBar.RemoveControl(AControl: TControl); var Band: TCoolBand; begin Band := Bands.FindBand(AControl); if Assigned(Band) then begin DebugLn('TCoolBar.RemoveControl: Comp=' + AControl.Name + ', class=' + AControl.ClassName); Band.FControl := nil; end; inherited RemoveControl(AControl); end; procedure TCustomCoolBar.Loaded; begin inherited Loaded; //DebugLn('TCoolBar.Loaded'); FBands.Update(Nil); end; procedure TCustomCoolBar.Paint; procedure PaintGrabber(aRect: TRect); begin Canvas.Pen.Color := clBtnHighlight; Canvas.MoveTo(aRect.Left+2, aRect.Top); Canvas.LineTo(aRect.Left, aRect.Top); Canvas.LineTo(aRect.Left, aRect.Bottom+1); Canvas.Pen.Color := clBtnShadow; Canvas.MoveTo(aRect.Right, aRect.Top); Canvas.LineTo(aRect.Right, aRect.Bottom); Canvas.LineTo(aRect.Left, aRect.Bottom); end; var i, BottomY: Integer; begin inherited Paint; //DebugLn('TCoolBar.Paint'); for i := 0 to FBands.Count-1 do begin BottomY := FBands[i].FTop+FBands[i].Height+2; // Paint a grabber PaintGrabber(Rect(GrabLeft, FBands[i].FTop, GrabLeft+GrabWidth, BottomY-1)); // Paint a separator border below the band. if FBandBorderStyle = bsSingle then begin Canvas.Line(3, BottomY, Width-3, BottomY); Canvas.Pen.Color := clBtnHighlight; Canvas.Line(3, BottomY+1, Width-3, BottomY+1); end; end; end; procedure TCustomCoolBar.Resize; var i: Integer; begin inherited Resize; if [csLoading, csDestroying] * ComponentState <> [] then Exit; if (FUpdateCount = 0) and Assigned(FBands) then for i := 0 to FBands.Count-1 do if Assigned(FBands[i].FControl) then FBands[i].SetControlWidth; end;