View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0025026 | Lazarus | LCL | public | 2013-09-15 13:27 | 2014-04-27 14:12 |
Reporter | Vojtech Cihak | Assigned To | Juha Manninen | ||
Priority | normal | Severity | minor | Reproducibility | N/A |
Status | closed | Resolution | fixed | ||
Platform | amd64 | OS | Linux | ||
Product Version | 1.1 (SVN) | ||||
Summary | 0025026: [Patch] TCoolBar | ||||
Description | Patch that improves TCoolBar. - implements Break property - Bands can be sized and moved with mouse at runtime - implemented Bitmap and FixedBackground - implemented FixedOrder and FixedSize - added GrabStyle and GrabWidth - bands can have image from imagelist - text is now painted via ThemeServices (instead of built-in labels) Note that I have no Delphi to compare, I had only a few screenshots and some vague description, so I don't know whether I implemented it correctly. I am not sure with sizing, moving and Vertical mode. BandMaximize and BiDi mode are not yet implemented. I would rather implement correctly normal mode and then finish the BiDi. There are many changes in coolbar.inc so I attach full file too. I tested with Qt (designtime+rruntime) and GTK2 (only runtime). Please tests on Win and Carbon. | ||||
Additional Information | Lazarus 1.1 r42801M FPC 2.7.1 x86_64-linux-qt | ||||
Tags | No tags attached. | ||||
Fixed in Revision | r44812 | ||||
LazTarget | - | ||||
Widgetset | |||||
Attached Files |
|
|
|
|
coolbar.diff (45,104 bytes)
Index: coolbar.inc =================================================================== --- coolbar.inc (revision 42801) +++ coolbar.inc (working copy) @@ -1,7 +1,7 @@ {%MainUnit ../comctrls.pp} {****************************************************************************** - TCoolBar + TMyCoolBar ****************************************************************************** ***************************************************************************** @@ -10,28 +10,29 @@ See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** - } -const - GrabWidth = 9; -{ TCoolBand } +{ TMyCoolBand } 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; + FColor := clDefault; + FControl := nil; FFixedBackground := True; FImageIndex := -1; - FMinHeight := 25; - FParentColor := True; + FMinHeight := cDefMinHeight; + FMinWidth := cDefMinWidth; FParentBitmap := True; + FParentColor := True; + FVisible := True; + FWidth := cDefWidth; + + inherited Create(aCollection); + Assert(aCollection is TCoolBands, 'TCoolBand.Create: aCollection is not TCoolBands'); + FCoolBar := TCoolBands(aCollection).FCoolBar; FBitmap := TBitmap.Create; - FVisible := True; + FBitmap.OnChange := @InvalidateCoolBar; end; destructor TCoolBand.Destroy; @@ -40,17 +41,58 @@ inherited Destroy; end; -function TCoolBand.GetWidth: Integer; +procedure TCoolBand.Assign(aSource: TPersistent); +var src: TCoolBand; + SrcCtrl: TWinControl; begin - Result := FCoolBar.Width; + 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; + SrcCtrl := Nil; + if Assigned(src.Control) then + SrcCtrl := FCoolBar.Owner.FindComponent(src.Control.Name) as TWinControl; + Control := SrcCtrl; + end else + inherited Assign(aSource); +end; + +function TCoolBand.CalcPreferredHeight: Integer; +begin + Result := FMinHeight; + if assigned(FControl) then + Result := max(Result, FControl.Height+2*cVertSpacing); + if FCoolBar.FShowText then + Result := max(Result, FCoolBar.FTextHeight+2*cVertSpacing); + if assigned(FCoolBar.Images) and (ImageIndex >= 0) then + Result := max(Result, FCoolBar.Images.Height+2*cVertSpacing); +end; + +function TCoolBand.CalcPrefferedWidth: Integer; +begin + Result := FCoolBar.GrabWidth+2*cHorSpacing; + if assigned(Control) then + inc(Result, Control.Width+cHorSpacing); + if (FText <> '') and FCoolBar.FShowText then + inc(Result, FCoolBar.Canvas.TextWidth(FText)+cHorSpacing); + Result := max(FMinWidth, Result); end; -function TCoolBand.GetText: string; +function TCoolBand.GetDisplayName: string; begin - if Assigned(FTextLabel) then - Result := FTextLabel.Caption - else - Result := ''; + Result := Text; + if Result = '' then Result := ClassName; end; function TCoolBand.IsBitmapStored: Boolean; @@ -63,423 +105,224 @@ Result := not ParentColor; end; -function TCoolBand.GetHeight: Integer; +procedure TCoolBand.InvalidateCoolBar(Sender: TObject); begin - if Assigned(FControl) then - Result := FControl.Height - else - Result := 20; -end; + Changed(False); +end; function TCoolBand.GetVisible: Boolean; begin Result := FVisible and not (FCoolBar.Vertical and FHorizontalOnly); end; -procedure TCoolBand.ResetControlProps; +procedure TCoolBand.SetBitmap(AValue: TBitmap); 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; + FParentBitmap := False; + FBitmap.Assign(AValue); Changed(False); -end; +end; -procedure TCoolBand.SetBreak(aValue: Boolean); +procedure TCoolBand.SetBorderStyle(AValue: TBorderStyle); begin - if FBreak = aValue then Exit; - FBreak := aValue; + if FBorderStyle = AValue then Exit; + FBorderStyle := AValue; Changed(False); end; -procedure TCoolBand.SetFixedSize(aValue: Boolean); +procedure TCoolBand.SetBreak(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; + if FBreak = AValue then Exit; + FBreak := AValue; Changed(True); end; -procedure TCoolBand.SetHorizontalOnly(aValue: Boolean); +procedure TCoolBand.SetColor(AValue: TColor); 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; + if FColor = AValue then Exit; + FColor := AValue; FParentColor := False; Changed(False); -end; +end; -procedure TCoolBand.SetControlWidth; -var - www: Integer; +procedure TCoolBand.SetControl(AValue: TControl); +var aBand: TCoolBand; 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; + if FControl = AValue then Exit; FCoolBar.BeginUpdate; try - if Assigned(aValue) then + 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; + AValue.Align := alNone; + aBand := TCoolBands(Collection).FindBand(AValue); + if assigned(aBand) and (aBand <> Self) then + aBand.SetControl(Nil); // Remove old association + AValue.Parent := FCoolBar; end; - FControl := aValue; + FControl := AValue; Changed(True); finally FCoolBar.EndUpdate; end; -end; +end; -procedure TCoolBand.SetParentColor(aValue: Boolean); +procedure TCoolBand.SetFixedBackground(AValue: Boolean); begin - if FParentColor = aValue then Exit; - FParentColor := aValue; + if FFixedBackground = AValue then Exit; + FFixedBackground := AValue; Changed(False); -end; +end; -procedure TCoolBand.SetParentBitmap(aValue: Boolean); +procedure TCoolBand.SetHorizontalOnly(AValue: Boolean); begin - if FParentBitmap = aValue then Exit; - FParentBitmap := aValue; + if FHorizontalOnly = AValue then Exit; + FHorizontalOnly := AValue; + Changed(FCoolBar.Vertical); end; -procedure TCoolBand.SetBitmap(aValue: TBitmap); +procedure TCoolBand.SetImageIndex(AValue: TImageIndex); begin - FParentBitmap := False; - FBitmap.Assign(aValue); + if FImageIndex = AValue then Exit; + FImageIndex := AValue; Changed(True); end; -procedure TCoolBand.SetText(const aValue: string); +procedure TCoolBand.SetMinHeight(AValue: Integer); 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); + if FMinHeight = AValue then Exit; + FMinHeight := AValue; + Changed(False); end; -procedure TCoolBand.SetWidth(aValue: Integer); +procedure TCoolBand.SetMinWidth(AValue: Integer); begin - // No operation currently + if FMinWidth = AValue then Exit; + FMinWidth := AValue; + Changed(False); end; -function TCoolBand.GetDisplayName: string; +procedure TCoolBand.SetParentBitmap(AValue: Boolean); begin - Result := Text; - if Result = '' then - Result := ClassName; -end; + if FParentBitmap = AValue then Exit; + FParentBitmap := AValue; + Changed(False); +end; -procedure TCoolBand.SetIndex(aValue: Integer); +procedure TCoolBand.SetParentColor(AValue: Boolean); begin - inherited SetIndex(aValue); + if FParentColor = AValue then Exit; + FParentColor := AValue; + Changed(False); end; -procedure TCoolBand.Assign(aSource: TPersistent); -var - src: TCoolBand; - SrcCtrl: TWinControl; +procedure TCoolBand.SetText(const AValue: TTranslateString); 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; + if AValue = FText then exit; + FText := AValue; + Changed(True); +end; -{ TCoolBands } - -constructor TCoolBands.Create(aCoolBar: TCustomCoolBar); +procedure TCoolBand.SetVisible(AValue: Boolean); begin - inherited Create(TCoolBand); - FCoolBar := aCoolBar; + if FVisible = AValue then Exit; + FVisible := AValue; + if assigned(FControl) then FControl.Visible := AValue; + Changed(True); end; -function TCoolBands.GetItem(Index: Integer): TCoolBand; +procedure TCoolBand.SetWidth(AValue: Integer); begin - Result := TCoolBand(inherited GetItem(Index)); + if AValue = FWidth then Exit; + if AValue < FMinWidth then AValue := FMinWidth; + FWidth := AValue; + Changed(True); end; -procedure TCoolBands.SetItem(Index: Integer; aValue: TCoolBand); +{ TCoolBands } + +constructor TCoolBands.Create(ACoolBar: TCustomCoolBar); begin - inherited SetItem(Index, aValue); + inherited Create(TCoolBand); + FCoolBar := ACoolBar; end; -function TCoolBands.GetOwner: TPersistent; +function TCoolBands.Add: TCoolBand; begin - Result := FCoolBar; + Result := TCoolBand(inherited Add); + //DebugLn('TCoolBands.Add'); end; -procedure TCoolBands.Update(aItem: TCollectionItem); -var - PrefWidth, PrefHeight: integer; +function TCoolBands.FindBand(AControl: TControl): TCoolBand; +var i: 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; + Result := nil; + for i := 0 to Count-1 do + if GetItem(i).FControl = AControl then + Exit(GetItem(i)); +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); + cnAdded: begin + //DebugLn('TCoolBands.Notify: aAction = cnAdded'); + TCoolBand(aItem).FCoolBar:=FCoolBar; end; + cnExtracting: begin + //DebugLn('TCoolBands.Notify: aAction = cnExtracting'); + end; cnDeleting: begin - DebugLn('TCoolBands.Notify: aAction = cnDeleting'); + //DebugLn('TCoolBands.Notify: aAction = cnDeleting'); end; end; -end; +end; -function TCoolBands.Add: TCoolBand; +procedure TCoolBands.Update(aItem: TCollectionItem); begin - Result := TCoolBand(inherited Add); - DebugLn('TCoolBands.Add'); + inherited Update(aItem); + if assigned(FCoolBar) then begin + //DebugLn('Bands.Update calls CalcAndAlign'); + if not assigned(aItem) then FCoolBar.CalculateAndAlign; + FCoolBar.Invalidate; + end; end; -function TCoolBands.FindBand(aControl: TControl): TCoolBand; -var - i: Integer; +function TCoolBands.GetItem(Index: Integer): TCoolBand; begin - Result := nil; - for i := 0 to Count-1 do - if GetItem(i).FControl = AControl then - Exit(GetItem(i)); + Result := TCoolBand(inherited GetItem(Index)); end; -procedure TCoolBands.CalcPreferredSize(aAlsoUpdate: Boolean; var aPrefWidth, aPrefHeight: integer); -var - i, BndWidth, hh: Integer; - LabWidth, CtrlWidth, xHeight: integer; - Band: TCoolBand; +function TCoolBands.GetOwner: TPersistent; begin - aPrefWidth := 0; - aPrefHeight := 3; - for i := 0 to Count-1 do - begin - Band := Items[i]; + Result := FCoolBar; +end; - // 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; +procedure TCoolBands.SetItem(Index: Integer; aValue: TCoolBand); +begin + inherited SetItem(Index, aValue); end; -{ TCustomCoolBar } +{ TMyCustomCoolBar } constructor TCustomCoolBar.Create(AOwner: TComponent); begin inherited Create(AOwner); - ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, csOpaque, csDoubleClicks]; - DragMode := dmAutomatic; + ControlStyle := ControlStyle - [csSetCaption] + + [csAcceptsControls, csNoFocus, csOpaque, csParentBackground, csReplicatable]; + Align := alTop; Height := 75; - Align := alTop; ParentColor := True; ParentFont := True; FBandBorderStyle := bsSingle; FBandMaximize := bmClick; FBands := TCoolBands.Create(Self); FBitmap := TBitmap.Create; + FBitmap.OnChange:=@BitmapOrImageListChange; + FGrabStyle := cDefGrabStyle; + FGrabWidth := cDefGrabWidth; + FImageChangeLink := TChangeLink.Create; + FImageChangeLink.OnChange := @BitmapOrImageListChange; FShowText := True; - FImageChangeLink := TChangeLink.Create; - FImageChangeLink.OnChange := @ImageListChange; end; destructor TCustomCoolBar.Destroy; @@ -490,149 +333,285 @@ inherited Destroy; end; -procedure TCustomCoolBar.BeginUpdate; +function TCustomCoolBar.GetAlign: TAlign; begin - DisableAlign; - inherited BeginUpdate; + Result := inherited Align; end; -procedure TCustomCoolBar.EndUpdate; +procedure TCustomCoolBar.SetAlign(aValue: TAlign); +var Old: TAlign; begin - inherited EndUpdate; - EnableAlign; + Old := inherited Align; + if aValue = Old then Exit; + inherited Align := aValue; + if csReading in ComponentState then Exit; + Vertical := (aValue in [alLeft, alRight]); end; -function TCustomCoolBar.GrabLeft: integer; +procedure TCustomCoolBar.SetBandBorderStyle(AValue: TBorderStyle); begin - Result := 2; - if BiDiMode <> bdLeftToRight then - Result := Width - GrabWidth - Result; + if FBandBorderStyle = AValue then Exit; + FBandBorderStyle := AValue; + Invalidate; end; -function TCustomCoolBar.GetAlign: TAlign; +procedure TCustomCoolBar.SetBands(AValue: TCoolBands); begin - Result := inherited Align; + FBands.Assign(AValue); end; -procedure TCustomCoolBar.SetAlign(aValue: TAlign); -var - Old: TAlign; +procedure TCustomCoolBar.SetBitmap(aValue: TBitmap); 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; + FBitmap.Assign(aValue); end; -procedure TCustomCoolBar.SetBands(aValue: TCoolBands); +procedure TCustomCoolBar.SetGrabStyle(AValue: TGrabStyle); begin - FBands.Assign(aValue); + if FGrabStyle = AValue then Exit; + FGrabStyle := AValue; + Invalidate; end; -procedure TCustomCoolBar.SetBitmap(aValue: TBitmap); +procedure TCustomCoolBar.SetGrabWidth(AValue: Integer); begin - FBitmap.Assign(aValue); + if FGrabWidth = AValue then Exit; + FGrabWidth := AValue; + CalculateAndAlign; + Invalidate; end; -procedure TCustomCoolBar.SetImages(aValue: TCustomImageList); +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); + FImages := AValue; + if Assigned(FImages) then begin + AValue.RegisterChanges(FImageChangeLink); + AValue.FreeNotification(Self); end; + CalculateAndAlign; Invalidate; end; -procedure TCustomCoolBar.SetShowText(aValue: Boolean); +procedure TCustomCoolBar.SetShowText(AValue: Boolean); begin - if FShowText = aValue then Exit; - FShowText := aValue; - if not (csLoading in ComponentState) then - FBands.Update(Nil); + if FShowText = AValue then Exit; + FShowText := AValue; + CalculateAndAlign; + Invalidate; end; procedure TCustomCoolBar.SetVertical(aValue: Boolean); begin if FVertical = aValue then Exit; + FVertical := aValue; Invalidate; end; -procedure TCustomCoolBar.ImageListChange(Sender: TObject); +procedure TCustomCoolBar.BitmapOrImageListChange(Sender: TObject); begin Invalidate; end; -procedure TCustomCoolBar.AlignControls(aControl: TControl; var aRect: TRect); -var - PrefWidth, PrefHeight: integer; +procedure TCustomCoolBar.CalculateAndAlign; +var i, x, y, aCountM1, aHeight, aLeft, aStartIndex, aTop, aWidth: Integer; + aRowEnd: Boolean; begin - //DebugLn('TCoolBar.AlignControls'); - if FUpdateCount = 0 then + if (FUpdateCount > 0) or ([csLoading, csDestroying] * ComponentState <> []) then exit; + //DebugLn('CalculateAndAlign'); + aCountM1 := FBands.Count-1; + x := 0; + for i := 0 to aCountM1 do + if FBands[i].Visible then inc(x); + SetLength(FVisiBands, x); + x := 0; + for i := 0 to aCountM1 do + if FBands[i].Visible then begin + FVisiBands[x] := FBands[i]; + inc(x); + end; + aCountM1 := x-1; + //Do not use FBands from this point, only FVisiBands + aHeight := 0; + aStartIndex := 0; + aRowEnd := True; + if AutoSize and (aCountM1 >= 0) then DisableAutoSizing; + for i := 0 to aCountM1 do begin - FBands.CalcPreferredSize(True, PrefWidth, PrefHeight); - inherited AlignControls(aControl, aRect); + if (FVisiBands[i].Break or Vertical) or aRowEnd then aLeft := cBorderWidth; + aHeight := Max(aHeight, FVisiBands[i].CalcPreferredHeight); + inc(aLeft, FVisiBands[i].Width); + aRowEnd := (i = aCountM1) or ((i < aCountM1) + and ((FVisiBands[i+1].Break or Vertical) + or ((aLeft+FVisiBands[i+1].Width) > (ClientWidth-2*cBorderWidth)))); + //Set all Bands in row to uniform height + if aRowEnd then begin + for y := aStartIndex to i do + FVisiBands[y].FHeight := aHeight; + aHeight := 0; + aStartIndex := i+1; + end; end; + aTop := cBorderWidth; + aRowEnd := True; + for i := 0 to aCountM1 do + begin + if aRowEnd or (FVisiBands[i].Break or Vertical) then aLeft := cBorderWidth; + FVisiBands[i].FLeft := aLeft; + FVisiBands[i].FTop := aTop; + if assigned(FVisiBands[i].Control) then begin + x := 2+GrabWidth+TCoolBand.cHorSpacing; + if (FVisiBands[i].Text<>'') and FShowText then + inc(x, Canvas.TextWidth(FVisiBands[i].Text)+TCoolBand.cHorSpacing); + if assigned(FImages) and (FVisiBands[i].ImageIndex >=0) then + inc(x, FImages.Width+TCoolBand.cHorSpacing); + aWidth := FVisiBands[i].Width-x-TCoolBand.cHorSpacing-cBorderWidth; + inc(x, aLeft); + y := aTop+(FVisiBands[i].FHeight-FVisiBands[i].Control.Height) div 2; + FVisiBands[i].Control.BorderSpacing.Left:=x-cBorderWidth; + FVisiBands[i].Control.BorderSpacing.Top:=y-cBorderWidth; + FVisiBands[i].Control.SetBounds(x, y, aWidth, FVisiBands[i].Control.Height); + end; + x := FVisiBands[i].Width; + inc(aLeft, x); + aRowEnd := IsRowEnd(aLeft, i); + if aRowEnd or (i = aCountM1) then + FVisiBands[i].FRealWidth := x+ClientWidth-aLeft-cBorderWidth + else + FVisiBands[i].FRealWidth := x; + if aRowEnd then + inc(aTop, FVisiBands[i].FHeight+cBorderWidth); + end; + if AutoSize then begin + inc(FUpdateCount); + InvalidatePreferredSize; + AdjustSize; + if aCountM1 >= 0 then EnableAutoSizing; + dec(FUpdateCount); + end; + FPrevWidth := Width; + FPrevHeight := Height; end; -procedure TCustomCoolBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; +procedure TCustomCoolBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; WithThemeSpace: Boolean); -var - MinWidth, MinHeight: Integer; - PrefWidth, PrefHeight: Integer; +var i, aCountM1, aPrefWidth: Integer; begin - // Calculate preferred width and height - FBands.CalcPreferredSize(False, PrefWidth, PrefHeight); - PreferredWidth := Max(PreferredWidth, PrefWidth); - PreferredHeight := Max(PreferredHeight, PrefHeight); + aCountM1 := length(FVisiBands)-1; + if aCountM1 >= 0 then + PreferredHeight := FVisiBands[aCountM1].FTop+FVisiBands[aCountM1].FHeight+2 + else + PreferredHeight := TCoolBand.cDefMinHeight+4; + if not FVertical then + PreferredWidth := 0 + else begin + aPrefWidth := TCoolBand.cDefMinHeight+4; //min. Width is ~ 25 pixels + for i := 0 to aCountM1 do + aPrefWidth := max(aPrefWidth, FVisiBands[i].Width); + PreferredWidth := aPrefWidth; + end; end; -procedure TCustomCoolBar.Notification(AComponent: TComponent; Operation: TOperation); +function TCustomCoolBar.CalculateRealIndex(AVisibleIndex: Integer): Integer; +var i, aInvisibles, aVisibles: Integer; begin - inherited Notification(AComponent, Operation); - if csDestroying in ComponentState then Exit; - if Operation = opRemove then + aInvisibles := 0; + aVisibles := 0; + for i:=0 to FBands.Count-1 do begin - DebugLn('TCoolBar.Notification: Operation = opRemove'); - if AComponent = FImages then - Images := nil; + if not FBands[i].Visible then + inc(aInvisibles) + else + inc(aVisibles); + if aVisibles > AVisibleIndex then break; end; + Result := AVisibleIndex+aInvisibles; end; +procedure TCustomCoolBar.CreateWnd; +begin + inherited CreateWnd; + FDefCursor := Cursor; + DoFontChanged; +end; + +procedure TCustomCoolBar.DrawTiledBitmap(ARect: TRect; ABitmap: TBitmap); +var i, j, x, y, aWidth, aHeight: Integer; +begin + aWidth := ABitmap.Width; + aHeight := ABitmap.Height; + x := (ARect.Right-ARect.Left) div aWidth; + y := (ARect.Bottom-ARect.Top) div aHeight; + if ((ARect.Right-ARect.Left) mod aWidth) =0 then dec(x); + if ((ARect.Bottom-ARect.Top) mod aHeight) =0 then dec(y); + Canvas.Clipping := True; + Canvas.ClipRect := ARect; + for i := 0 to x do + for j := 0 to y do + Canvas.Draw(ARect.Left+i*aWidth, ARect.Top+j*aHeight, ABitmap); + Canvas.Clipping := False; +end; + +procedure TCustomCoolBar.DoFontChanged; +begin + FTextHeight := Canvas.TextHeight('Žy|'); +end; + +procedure TCustomCoolBar.EndUpdate; +begin + inherited EndUpdate; + //DebugLn('EndUpdate calls CalculateAndAlign'); + CalculateAndAlign; + Invalidate; +end; + +procedure TCustomCoolBar.FontChanged(Sender: TObject); +begin + inherited FontChanged(Sender); + DoFontChanged; + //DebugLn('FontChanged calls CalculateAndAlign'); + CalculateAndAlign; +end; + +function TCustomCoolBar.IsRowEnd(ALeft, AVisibleIndex: Integer): Boolean; +begin + Result := (AVisibleIndex < (length(FVisiBands)-1)) + and ((FVisiBands[AVisibleIndex+1].Break or Vertical) + or ((ALeft+FVisiBands[AVisibleIndex+1].Width) > ClientWidth)); +end; + procedure TCustomCoolBar.InsertControl(AControl: TControl; Index: integer); -var - Band: TCoolBand; +var aBand: 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 + //DebugLn('TMyCustomCoolBar.InsertControl'); + if (FUpdateCount = 0) and (AControl is TWinControl) and + not (csLoading in ComponentState) then begin - DebugLn('TCoolBar.InsertControl: Adding band for Comp=' + AControl.Name + ', class=' + AControl.ClassName); - Band := FBands.Add; - Band.Control := AControl; + aBand := Bands.FindBand(AControl); + if aBand = Nil then + begin + //DebugLn('TCoolBar.InsertControl: Adding band for Comp=' + AControl.Name + ', class=' + AControl.ClassName); + BeginUpdate; + aBand := FBands.Add; + aBand.Control := AControl; + aBand.Width := aBand.CalcPrefferedWidth; + EndUpdate; + end; end; - end; end; procedure TCustomCoolBar.RemoveControl(AControl: TControl); -var - Band: TCoolBand; +var aBand: TCoolBand; begin - Band := Bands.FindBand(AControl); - if Assigned(Band) then begin - DebugLn('TCoolBar.RemoveControl: Comp=' + AControl.Name + ', class=' + AControl.ClassName); - Band.FControl := nil; + inherited RemoveControl(AControl); + aBand := Bands.FindBand(AControl); + if assigned(aBand) then begin + //DebugLn('TCoolBar.RemoveControl: Comp=' + AControl.Name + ', class=' + AControl.ClassName); + aBand.FControl := nil; + CalculateAndAlign; + Invalidate; end; - inherited RemoveControl(AControl); end; procedure TCustomCoolBar.Loaded; @@ -642,49 +621,337 @@ FBands.Update(Nil); end; +procedure TCustomCoolBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var aBand: Integer; + aGrabber: Boolean; +begin + inherited MouseDown(Button, Shift, X, Y); + MouseToBandPos(X, Y, aBand, aGrabber); + FDraggedBandIndex := aBand; + if aBand >= 0 then begin //Hit any Band + if not aGrabber or (FVisiBands[aBand].FLeft = cBorderWidth) + or FFixedSize or FVisiBands[aBand-1].FFixedSize then begin + if not FFixedOrder then begin //Move Band + FDragBand := dbMove; + Cursor := crDrag; + end; + end else begin //Resize Band + if not FFixedSize and not FVisiBands[aBand-1].FFixedSize then begin + FDragBand := dbResize; + FDragInitPos := X-FVisiBands[aBand-1].FWidth-FVisiBands[aBand-1].FLeft; + end; + end; + end; +end; + +procedure TCustomCoolBar.MouseEnter; +begin + inherited MouseEnter; + FDefCursor := Cursor; +end; + +procedure TCustomCoolBar.MouseLeave; +begin + inherited MouseLeave; + Cursor := FDefCursor; +end; + +procedure TCustomCoolBar.MouseMove(Shift: TShiftState; X, Y: Integer); +var aBand: Integer; + aGrabber: Boolean; +begin + inherited MouseMove(Shift, X, Y); + if (FDragBand = dbNone) and not FFixedSize then begin + MouseToBandPos(X, Y, aBand, aGrabber); + if (aBand >= 1) and not FVisiBands[aBand-1].FFixedSize then begin + if aGrabber and (aBand > 0) and (FVisiBands[aBand].FLeft > cBorderWidth) then + Cursor := crHSplit + else + Cursor := FDefCursor; + end; + end else + if FDragBand = dbResize then begin + FVisiBands[FDraggedBandIndex-1].Width := X-FDragInitPos-FVisiBands[FDraggedBandIndex-1].FLeft; + end; +end; + +procedure TCustomCoolBar.MouseToBandPos(X, Y: Integer; out ABand: Integer; out AGrabber: Boolean); +var i, aCountM1, aLeft, aTop: Integer; +begin + ABand := low(Integer); + AGrabber := False; + aCountM1 := length(FVisiBands)-1; + if aCountM1 >= 0 then begin + if Y > (FVisiBands[aCountM1].FTop+FVisiBands[aCountM1].FHeight+cBorderWidth) then + ABand := -1 // new row, i.e. free space below the last row + else + for i := 0 to aCountM1 do + begin + aLeft := FVisiBands[i].FLeft; + aTop := FVisiBands[i].FTop; + if PtInRect(Rect(aLeft, aTop, aLeft+FVisiBands[i].FRealWidth, + aTop+FVisiBands[i].FHeight), Point(X, Y)) then + begin + ABand := i; + //DebugLn('Mouse over Band ', i); + AGrabber := (X <= (aLeft+GrabWidth+1)); + //DebugLn('Grabber '+BoolToStr(AGrabber), ' hit', ' not hit'); + exit; // EXIT! + end; + end; + end; +end; + +procedure TCustomCoolBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var aBand: Integer; + newRow, needRecalc: Boolean; +begin + inherited MouseUp(Button, Shift, X, Y); + if FDragBand = dbMove then begin + needRecalc := False; + MouseToBandPos(X, Y, aBand, newRow); //newRow is NOT used here + if aBand >= -1 then begin + newRow := (aBand = -1); + if newRow then aBand := length(FVisiBands)-1; + if aBand <> FDraggedBandIndex then begin //move to new position + if (FVisiBands[FDraggedBandIndex].Break or Vertical) + and (FDraggedBandIndex < (length(FVisiBands)-1)) + then FVisiBands[FDraggedBandIndex+1].FBreak := True; + if (X > (FVisiBands[aBand].FLeft+FVisiBands[aBand].Width)) then begin //beyond the last band in row + FVisiBands[FDraggedBandIndex].FBreak := False; + if FDraggedBandIndex > aBand then + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand+1) + else + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + if FDraggedBandIndex = (aBand+1) then needRecalc := True; + end else begin //on another Band + FVisiBands[FDraggedBandIndex].FBreak := FVisiBands[aBand].Break; + if FDraggedBandIndex > aBand then begin //move up or left + FVisiBands[aBand].FBreak := False; + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + end else begin //move down or right + if not newRow then begin + if (FVisiBands[FDraggedBandIndex].FTop = FVisiBands[aBand].FTop) then begin //the same row + FVisiBands[FDraggedBandIndex].FBreak := False; + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + end else begin //other row + if (not FVertical) and (FVisiBands[FDraggedBandIndex].FLeft > cBorderWidth) then + FVisiBands[aBand].FBreak := False; + if (FVisiBands[FDraggedBandIndex].FLeft = cBorderWidth) + and (FVisiBands[aBand].FLeft = cBorderWidth) + and (FVertical or ((aBand-FDraggedBandIndex) = 1) + or (length(FVisiBands) = (aBand+1)) + or (FVisiBands[aBand+1].FLeft = cBorderWidth)) then + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand) + else + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand-1); + if FDraggedBandIndex = (aBand-1) then needRecalc := True; + end; + end else begin //new row + FVisiBands[FDraggedBandIndex].FBreak := True; + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + end; + end; + end; + end else + if newRow then begin //last Band in last row moved to new row + FVisiBands[aBand].FBreak := True; + needRecalc:= True; + end; + if needRecalc then begin //necessary only when no Index is changed + CalculateAndAlign; + Invalidate; + end; + end; + end; + if FDragBand > dbNone then begin + Cursor := FDefCursor; + FDragBand := dbNone; + end; +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.Paint; +var i, x, aCountM1, aLeft, aTop: Integer; + aRowEnd, aRaisedBevel: Boolean; + aColor: TColor; + aDetails, aGrabDetails: TThemedElementDetails; + aFlags: Cardinal; + aRect: TRect; + +const arBevel: array[False..True] of TColor = (clBtnShadow, clBtnHighlight); procedure PaintGrabber(aRect: TRect); + var l, w: SmallInt; 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); + case FGrabStyle of + gsSimple: begin + Canvas.Pen.Color := clBtnHighlight; + Canvas.Line(aRect.Left, aRect.Top, aRect.Right, aRect.Top); + Canvas.Line(aRect.Left, aRect.Top, aRect.Left, aRect.Bottom+1); + Canvas.Pen.Color := clBtnShadow; + Canvas.Line(aRect.Left, aRect.Bottom, aRect.Right, aRect.Bottom); + Canvas.Line(aRect.Right, aRect.Top, aRect.Right, aRect.Bottom+1); + end; + gsDouble: begin + w := (FGrabWidth-2) div 2; + Canvas.Pen.Color := clBtnHighlight; + Canvas.Line(aRect.Left, aRect.Top, aRect.Left+w, aRect.Top); + Canvas.Line(aRect.Left, aRect.Top, aRect.Left, aRect.Bottom+1); + Canvas.Line(aRect.Right-w, aRect.Top, aRect.Right, aRect.Top); + Canvas.Line(aRect.Right-w, aRect.Top, aRect.Right-w, aRect.Bottom+1); + Canvas.Pen.Color := clBtnShadow; + Canvas.Line(aRect.Left, aRect.Bottom, aRect.Left+w, aRect.Bottom); + Canvas.Line(aRect.Left+w, aRect.Top, aRect.Left+w, aRect.Bottom+1); + Canvas.Line(aRect.Right-w, aRect.Bottom, aRect.Right, aRect.Bottom); + Canvas.Line(aRect.Right, aRect.Top, aRect.Right, aRect.Bottom+1); + end; + gsHorLines: begin + l := (aRect.Bottom-aRect.Top+1) div 3; + inc(aRect.Top); + Canvas.Pen.Color := clBtnShadow; + for w := 0 to l-1 do + Canvas.Line(aRect.Left, aRect.Top+w*3, aRect.Right, aRect.Top+w*3); + Canvas.Pen.Color := clBtnHighlight; + inc(aRect.Top); + for w := 0 to l-1 do + Canvas.Line(aRect.Left, aRect.Top+w*3, aRect.Right, aRect.Top+w*3); + end; + gsVerLines: begin + l := (aRect.Right-aRect.Left+1) div 3; + inc(aRect.Left); + Canvas.Pen.Color := clBtnShadow; + for w := 0 to l-1 do + Canvas.Line(aRect.Left+w*3, aRect.Top, aRect.Left+w*3, aRect.Bottom+1); + Canvas.Pen.Color := clBtnHighlight; + inc(aRect.Left); + for w := 0 to l-1 do + Canvas.Line(aRect.Left+w*3, aRect.Top, aRect.Left+w*3, aRect.Bottom+1); + end; + gsGripper: begin + dec(aRect.Top); + inc(aRect.Bottom); + Canvas.ClipRect := aRect; + Canvas.Clipping := True; + ThemeServices.DrawElement(Canvas.Handle, aGrabDetails, aRect); + Canvas.Clipping := False; + end; + gsButton: begin + dec(aRect.Top); + inc(aRect.Bottom); + ThemeServices.DrawElement(Canvas.Handle, aGrabDetails, aRect); + end; + end; end; + + procedure PaintSeparator(Y: Integer); + begin + //DebugLn('PaintSeparator'); + Canvas.Pen.Color := arBevel[aRaisedBevel]; + Canvas.Line(1, Y, ClientWidth-2, Y); + inc(Y); + Canvas.Pen.Color := arBevel[not aRaisedBevel]; + Canvas.Line(2, Y, ClientWidth-2, Y); + 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. + inherited Paint; + //DebugLn('TCoolBar.Paint'); + //Draw Bitmap Background + if FBitmap.Width > 0 then DrawTiledBitmap(ClientRect, FBitmap); + aCountM1 := length(FVisiBands)-1; + if aCountM1 >= 0 then begin 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); + aRaisedBevel := ((EdgeInner = esLowered) and (EdgeOuter = esRaised)); + aRowEnd := False; + case GrabStyle of + gsGripper: aGrabDetails := ThemeServices.GetElementDetails(trGripper); + gsButton: aGrabDetails := ThemeServices.GetElementDetails(tbPushButtonDisabled); end; - end; + if FShowText or assigned(FImages) then begin + if IsEnabled then + aDetails := ThemeServices.GetElementDetails(tbPushButtonNormal) + else + aDetails := ThemeServices.GetElementDetails(tbPushButtonDisabled); + aFlags := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX; + if IsRightToLeft then aFlags := aFlags or DT_RTLREADING; + end; + for i := 0 to aCountM1 do + begin + aLeft := FVisiBands[i].FLeft; + aTop := FVisiBands[i].FTop; + aRect := Rect(aLeft, aTop, aLeft+FVisiBands[i].FRealWidth+1, aTop+FVisiBands[i].FHeight); + //Paint Band Background + if FVisiBands[i].Bitmap.Width > 0 then begin + DrawTiledBitmap(aRect, FVisiBands[i].Bitmap); + end else begin + if not FVisiBands[i].FixedBackground and FVisiBands[i].ParentBitmap + and (Bitmap.Width > 0) then + DrawTiledBitmap(aRect, Bitmap) + else begin + aColor := FVisiBands[i].FColor; + if (aColor <> clDefault) and (aColor <> clNone) then begin + Canvas.Brush.Color := aColor; + Canvas.FillRect(aRect); + end; + end; + end; + //Paint a Grabber + x := aLeft+2; + PaintGrabber(Rect(x, aTop+2, x+GrabWidth-1, aTop+FVisiBands[i].FHeight-3)); + //Paint Image + x := aLeft+GrabWidth+2+TCoolBand.cHorSpacing; + if assigned(FImages) and (FVisiBands[i].ImageIndex >= 0) then begin + ThemeServices.DrawIcon(Canvas, aDetails, + Point(x, aTop+(FVisiBands[i].FHeight-FImages.Height) div 2), + FImages, FVisiBands[i].ImageIndex); + inc(x, FImages.Width+TCoolBand.cHorSpacing); + end; + //Paint Text + if FShowText then begin + aRect := Rect(x, aTop, x+FVisiBands[i].Width, aTop+FVisiBands[i].FHeight); + ThemeServices.DrawText(Canvas, aDetails, FVisiBands[i].Text, aRect, aFlags, 0); + end; + // Paint a Separator border below the row of bands ____ + inc(aLeft, FVisiBands[i].Width); + aRowEnd := IsRowEnd(aLeft, i); + if (aRowEnd or ((i = aCountM1) and not AutoSize) or (Align in [alLeft, alRight])) + and (FBandBorderStyle = bsSingle) + then PaintSeparator(aTop+FVisiBands[i].FHeight); + if not aRowEnd and (i < aCountM1) and (FBandBorderStyle = bsSingle) then begin + //Paint Divider | + Canvas.Pen.Color := arBevel[not aRaisedBevel]; + Canvas.Line(aLeft-1, aTop+1, aLeft-1, aTop+FVisiBands[i].FHeight-1); + Canvas.Pen.Color := arBevel[aRaisedBevel]; + Canvas.Line(aLeft-2, aTop+1, aLeft-2, aTop+FVisiBands[i].FHeight-1); + end; + end; + end; end; procedure TCustomCoolBar.Resize; -var - i: Integer; +var aWidth, aHeight: Integer; begin + //DebugLn('Resize'); 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; + aWidth := Width; + aHeight := Height; + if ((aWidth <> FPrevWidth) or (aHeight <> FPrevHeight)) + and (aWidth*aHeight > 0) and HandleAllocated then + begin + //DebugLn('Resize calls CalcAndAlign'); + CalculateAndAlign; + Invalidate; //Required by GTK2 + end; end; + |
|
comctrls.diff (12,002 bytes)
Index: comctrls.pp =================================================================== --- comctrls.pp (revision 42801) +++ comctrls.pp (working copy) @@ -2199,81 +2199,89 @@ property OnStartDrag; end; - { TCoolBar } + + TGrabStyle = (gsSimple, gsDouble, gsHorLines, gsVerLines, gsGripper, gsButton); + TDragBand = (dbNone, dbMove, dbResize); TCustomCoolBar = class; + { TCoolBand } + TCoolBand = class(TCollectionItem) private FCoolBar: TCustomCoolBar; FControl: TControl; // Associated control - FTextLabel: TLabel; // Possible text is shown in a Label + FBitmap: TBitmap; FBorderStyle: TBorderStyle; FBreak: Boolean; - FFixedSize: Boolean; - FVisible: Boolean; + FColor: TColor; + FFixedBackground: Boolean; + FFixedSize: Boolean; + FHeight: Integer; FHorizontalOnly: Boolean; FImageIndex: TImageIndex; - FFixedBackground: Boolean; FMinHeight: Integer; FMinWidth: Integer; - FColor: TColor; - FParentColor: Boolean; FParentBitmap: Boolean; - FBitmap: TBitmap; + FParentColor: Boolean; + FText: TTranslateString; + FVisible: Boolean; + FWidth: Integer; + FLeft: Integer; FTop: Integer; - fCreatingTextLabel: Boolean; - function GetText: string; - function GetWidth: Integer; + FRealWidth: Integer; function IsBitmapStored: Boolean; function IsColorStored: Boolean; - function GetHeight: Integer; function GetVisible: Boolean; - procedure SetBorderStyle(aValue: TBorderStyle); - procedure SetBreak(aValue: Boolean); - procedure SetFixedSize(aValue: Boolean); - procedure SetMinHeight(aValue: Integer); - procedure SetMinWidth(aValue: Integer); - procedure SetVisible(aValue: Boolean); - procedure SetHorizontalOnly(aValue: Boolean); - procedure SetImageIndex(aValue: TImageIndex); - procedure SetFixedBackground(aValue: Boolean); - procedure SetColor(aValue: TColor); - procedure SetControlWidth; - procedure ResetControlProps; - procedure UpdControl(aLabelWidth: integer); - procedure SetControl(aValue: TControl); - procedure SetParentColor(aValue: Boolean); - procedure SetParentBitmap(aValue: Boolean); - procedure SetBitmap(aValue: TBitmap); - procedure SetText(const aValue: string); - procedure SetWidth(aValue: Integer); + procedure SetBitmap(AValue: TBitmap); + procedure SetBorderStyle(AValue: TBorderStyle); + procedure SetBreak(AValue: Boolean); + procedure SetColor(AValue: TColor); + procedure SetControl(AValue: TControl); + procedure SetFixedBackground(AValue: Boolean); + procedure SetHorizontalOnly(AValue: Boolean); + procedure SetImageIndex(AValue: TImageIndex); + procedure SetMinHeight(AValue: Integer); + procedure SetMinWidth(AValue: Integer); + procedure SetParentBitmap(AValue: Boolean); + procedure SetParentColor(AValue: Boolean); + procedure SetText(const AValue: TTranslateString); + procedure SetVisible(AValue: Boolean); + procedure SetWidth(AValue: Integer); + protected const + cDefMinHeight = 25; + cDefMinWidth = 100; + cDefWidth = 180; + cHorSpacing = 7; + cVertSpacing = 3; protected + function CalcPreferredHeight: Integer; + function CalcPrefferedWidth: Integer; function GetDisplayName: string; override; - procedure SetIndex(aValue: Integer); override; public constructor Create(aCollection: TCollection); override; destructor Destroy; override; + procedure InvalidateCoolBar(Sender: TObject); procedure Assign(aSource: TPersistent); override; - property Height: Integer read GetHeight; + property Height: Integer read FHeight; published property Bitmap: TBitmap read FBitmap write SetBitmap stored IsBitmapStored; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; property Break: Boolean read FBreak write SetBreak default True; - property Color: TColor read FColor write SetColor stored IsColorStored default clBtnFace; + property Color: TColor read FColor write SetColor stored IsColorStored default clDefault; property Control: TControl read FControl write SetControl; property FixedBackground: Boolean read FFixedBackground write SetFixedBackground default True; - property FixedSize: Boolean read FFixedSize write SetFixedSize default False; + property FixedSize: Boolean read FFixedSize write FFixedSize default False; property HorizontalOnly: Boolean read FHorizontalOnly write SetHorizontalOnly default False; - property ImageIndex: TImageIndex read FImageIndex write SetImageIndex; - property MinHeight: Integer read FMinHeight write SetMinHeight default 25; - property MinWidth: Integer read FMinWidth write SetMinWidth default 0; + property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; + property MinHeight: Integer read FMinHeight write SetMinHeight default cDefMinHeight; + property MinWidth: Integer read FMinWidth write SetMinWidth default cDefMinWidth; property ParentColor: Boolean read FParentColor write SetParentColor default True; property ParentBitmap: Boolean read FParentBitmap write SetParentBitmap default True; - property Text: string read GetText write SetText; + property Text: TTranslateString read FText write SetText; property Visible: Boolean read GetVisible write SetVisible default True; - property Width: Integer read GetWidth write SetWidth; + property Width: Integer read FWidth write SetWidth default cDefWidth; end; { TCoolBands } @@ -2281,26 +2289,23 @@ TCoolBands = class(TCollection) private FCoolBar: TCustomCoolBar; - FVisibleCount: Longword; function GetItem(Index: Integer): TCoolBand; procedure SetItem(Index: Integer; aValue: TCoolBand); - procedure CalcPreferredSize(aAlsoUpdate: Boolean; var aPrefWidth, aPrefHeight: integer); protected function GetOwner: TPersistent; override; procedure Update(aItem: TCollectionItem); override; procedure Notify(aItem: TCollectionItem; aAction: TCollectionNotification); override; public - constructor Create(aCoolBar: TCustomCoolBar); + constructor Create(ACoolBar: TCustomCoolBar); function Add: TCoolBand; - function FindBand(aControl: TControl): TCoolBand; + function FindBand(AControl: TControl): TCoolBand; property Items[Index: Integer]: TCoolBand read GetItem write SetItem; default; - end; + end; - // BandMaximize is not used now but is needed for Delphi compatibility. // It is not used in Delphi's TCoolBar either. TCoolBandMaximize = (bmNone, bmClick, bmDblClick); - + { TCustomCoolBar } TCustomCoolBar = class(TToolWindow) @@ -2309,46 +2314,75 @@ FBandBorderStyle: TBorderStyle; FBandMaximize: TCoolBandMaximize; FBitmap: TBitmap; - FFixedSize: Boolean; + FFixedSize: Boolean; FFixedOrder: Boolean; + FGrabStyle: TGrabStyle; + FGrabWidth: Integer; FImages: TCustomImageList; - FImageChangeLink: TChangeLink; - FShowText: Boolean; - FVertical: Boolean; + FImageChangeLink: TChangeLink; + FShowText: Boolean; + FVertical: Boolean; FOnChange: TNotifyEvent; - function GrabLeft: integer; function GetAlign: TAlign; - procedure SetAlign(aValue: TAlign); reintroduce; - procedure SetBands(aValue: TCoolBands); + procedure SetBandBorderStyle(AValue: TBorderStyle); + procedure SetBands(AValue: TCoolBands); procedure SetBitmap(aValue: TBitmap); - procedure SetImages(aValue: TCustomImageList); - procedure SetShowText(aValue: Boolean); + procedure SetGrabStyle(AValue: TGrabStyle); + procedure SetGrabWidth(AValue: Integer); + procedure SetImages(AValue: TCustomImageList); + procedure SetShowText(AValue: Boolean); procedure SetVertical(aValue: Boolean); - procedure ImageListChange(Sender: TObject); + protected const + cBorderWidth = 2; + cDefGrabStyle = gsDouble; + cDefGrabWidth = 10; protected - procedure AlignControls(aControl: TControl; var aRect: TRect); override; + FVisiBands: array of TCoolBand; + FDefCursor: TCursor; + FDragBand: TDragBand; + FDraggedBandIndex: Integer; // -1 .. space below the last row; other negative .. invalid area + FDragInitPos: Integer; // Initial mouse X - position (for resizing Bands) + FPrevHeight: Integer; + FPrevWidth: Integer; + FTextHeight: Integer; + procedure BitmapOrImageListChange(Sender: TObject); procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; - WithThemeSpace: Boolean); override; + {%H-}WithThemeSpace: Boolean); override; + procedure CalculateAndAlign; + function CalculateRealIndex(AVisibleIndex: Integer): Integer; + procedure DoFontChanged; + procedure CreateWnd; override; + procedure DrawTiledBitmap(ARect: TRect; ABitmap: TBitmap); + procedure FontChanged(Sender: TObject); override; + function IsRowEnd(ALeft, AVisibleIndex: Integer): Boolean; + procedure Loaded; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure Loaded; override; - procedure Paint; override; - procedure Resize; override; + procedure Paint; override; + procedure Resize; override; + procedure SetAlign(aValue: TAlign); reintroduce; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure BeginUpdate; override; procedure EndUpdate; override; + procedure MouseToBandPos(X, Y: Integer; out ABand: Integer; out AGrabber: Boolean); procedure InsertControl(AControl: TControl; Index: integer); override; - procedure RemoveControl(AControl: TControl); override; - public + procedure RemoveControl(AControl: TControl); override; + public property Align read GetAlign write SetAlign default alTop; - property BandBorderStyle: TBorderStyle read FBandBorderStyle write FBandBorderStyle default bsSingle; + property BandBorderStyle: TBorderStyle read FBandBorderStyle write SetBandBorderStyle default bsSingle; property BandMaximize: TCoolBandMaximize read FBandMaximize write FBandMaximize default bmClick; property Bands: TCoolBands read FBands write SetBands; + property Bitmap: TBitmap read FBitmap write SetBitmap; property FixedSize: Boolean read FFixedSize write FFixedSize default False; property FixedOrder: Boolean read FFixedOrder write FFixedOrder default False; + property GrabStyle: TGrabStyle read FGrabStyle write SetGrabStyle default cDefGrabStyle; + property GrabWidth: Integer read FGrabWidth write SetGrabWidth default cDefGrabWidth; property Images: TCustomImageList read FImages write SetImages; - property Bitmap: TBitmap read FBitmap write SetBitmap; property ShowText: Boolean read FShowText write SetShowText default True; property Vertical: Boolean read FVertical write SetVertical default False; property OnChange: TNotifyEvent read FOnChange write FOnChange; @@ -2379,6 +2413,8 @@ property FixedSize; property FixedOrder; property Font; + property GrabStyle; + property GrabWidth; property Images; property ParentColor; property ParentFont; @@ -2407,7 +2443,7 @@ property OnStartDock; property OnStartDrag; property OnUnDock; - end; + end; { TCustomTrackBar } |
|
Works in Win32 |
|
I found one issue now. When I try to assign any control to band in OI, I get this error message: "TCoolBarControlPropertyEditor.CheckNewValue is called after all!" Assigning control from code works well (i.e. CoolBar1.Bands[0].Control:=Button1;). I have no idea how to solve it. |
|
> "TCoolBarControlPropertyEditor.CheckNewValue is called after all!" CheckNewValue was never called during my tests and I added the test version. I will remove it soon. [Removed in r42832] Your patch is impressive! It has one regression compared to my original version though: You can move a control around at design time even when it is bound to a band. I know the Delphi's COM-control wrapper has such a bug but there is no reason we should duplicate it now. I believe they tried to synchronize the underlying COM-control better at design time but they could not. If you look at the original source code in Delphi, you will get an idea... I can apply intermediate versions if it helps you continue with your patches. This can be considered bug fixing because CoolBar worked only partially, and thus be merged to the newly branched 1.2 version which is now feature-frozen. Before merging it will be tested in trunk for a while. |
|
> "TCoolBarControlPropertyEditor.CheckNewValue is called after all!" @ CheckNewValue was never called during my tests and I added the test version. I will remove it soon. [Removed in r42832] I tested with Lazarus 1.3 r.42832. Works well now. |
|
The "secret" for keeping a control in a fixed place was a protected AlignControls method : procedure AlignControls(aControl: TControl; var aRect: TRect); override; which calls : FBands.CalcPreferredSize(True, PrefWidth, PrefHeight); which also updates the control's location. Nothing else is needed for it. LCL calls AlignControls right when needed. You have removed AlignControls completely for some reason. I think you should add it again and refactor your code to use it. |
|
Vojtech, are you planning to fix the issue about moving controls? I would love to apply this patch but the regression must be fixed first. I remember pondering myself how to keep controls in place. Then I found AlignControls which is a gem, just right for this purpose. Please return it to the code. |
|
Yes, I'll look on it ASAP. |
|
I added patches comctrls1.diff, coolbar1.diff (against 43470) and full coolbar.inc file (named coolbar1.inc). Now controls cannot be moved at design-time. I used AnchorParallel() instead of SetBounds(). |
|
comctrls1.diff (11,945 bytes)
Index: comctrls.pp =================================================================== --- comctrls.pp (revision 43470) +++ comctrls.pp (working copy) @@ -2212,82 +2212,91 @@ property OnChangeBounds; property OnStartDrag; end; + - { TCoolBar } + TGrabStyle = (gsSimple, gsDouble, gsHorLines, gsVerLines, gsGripper, gsButton); + TDragBand = (dbNone, dbMove, dbResize); + TCustomCoolBar = class; + { TCoolBand } + TCoolBand = class(TCollectionItem) private FCoolBar: TCustomCoolBar; FControl: TControl; // Associated control - FTextLabel: TLabel; // Possible text is shown in a Label + FBitmap: TBitmap; FBorderStyle: TBorderStyle; FBreak: Boolean; - FFixedSize: Boolean; - FVisible: Boolean; + FColor: TColor; + FFixedBackground: Boolean; + FFixedSize: Boolean; + FHeight: Integer; FHorizontalOnly: Boolean; FImageIndex: TImageIndex; - FFixedBackground: Boolean; FMinHeight: Integer; FMinWidth: Integer; - FColor: TColor; - FParentColor: Boolean; FParentBitmap: Boolean; - FBitmap: TBitmap; + FParentColor: Boolean; + FText: TTranslateString; + FVisible: Boolean; + FWidth: Integer; + FLeft: Integer; FTop: Integer; - fCreatingTextLabel: Boolean; - function GetText: string; - function GetWidth: Integer; + FRealWidth: Integer; function IsBitmapStored: Boolean; function IsColorStored: Boolean; - function GetHeight: Integer; function GetVisible: Boolean; - procedure SetBorderStyle(aValue: TBorderStyle); - procedure SetBreak(aValue: Boolean); - procedure SetFixedSize(aValue: Boolean); - procedure SetMinHeight(aValue: Integer); - procedure SetMinWidth(aValue: Integer); - procedure SetVisible(aValue: Boolean); - procedure SetHorizontalOnly(aValue: Boolean); - procedure SetImageIndex(aValue: TImageIndex); - procedure SetFixedBackground(aValue: Boolean); - procedure SetColor(aValue: TColor); - procedure SetControlWidth; - procedure ResetControlProps; - procedure UpdControl(aLabelWidth: integer); - procedure SetControl(aValue: TControl); - procedure SetParentColor(aValue: Boolean); - procedure SetParentBitmap(aValue: Boolean); - procedure SetBitmap(aValue: TBitmap); - procedure SetText(const aValue: string); - procedure SetWidth(aValue: Integer); + procedure SetBitmap(AValue: TBitmap); + procedure SetBorderStyle(AValue: TBorderStyle); + procedure SetBreak(AValue: Boolean); + procedure SetColor(AValue: TColor); + procedure SetControl(AValue: TControl); + procedure SetFixedBackground(AValue: Boolean); + procedure SetHorizontalOnly(AValue: Boolean); + procedure SetImageIndex(AValue: TImageIndex); + procedure SetMinHeight(AValue: Integer); + procedure SetMinWidth(AValue: Integer); + procedure SetParentBitmap(AValue: Boolean); + procedure SetParentColor(AValue: Boolean); + procedure SetText(const AValue: TTranslateString); + procedure SetVisible(AValue: Boolean); + procedure SetWidth(AValue: Integer); + protected const + cDefMinHeight = 25; + cDefMinWidth = 100; + cDefWidth = 180; + cHorSpacing = 7; + cVertSpacing = 3; protected + function CalcPreferredHeight: Integer; + function CalcPrefferedWidth: Integer; function GetDisplayName: string; override; - procedure SetIndex(aValue: Integer); override; public constructor Create(aCollection: TCollection); override; destructor Destroy; override; + procedure InvalidateCoolBar(Sender: TObject); procedure Assign(aSource: TPersistent); override; - property Height: Integer read GetHeight; + property Height: Integer read FHeight; published property Bitmap: TBitmap read FBitmap write SetBitmap stored IsBitmapStored; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; property Break: Boolean read FBreak write SetBreak default True; - property Color: TColor read FColor write SetColor stored IsColorStored default clBtnFace; + property Color: TColor read FColor write SetColor stored IsColorStored default clDefault; property Control: TControl read FControl write SetControl; property FixedBackground: Boolean read FFixedBackground write SetFixedBackground default True; - property FixedSize: Boolean read FFixedSize write SetFixedSize default False; + property FixedSize: Boolean read FFixedSize write FFixedSize default False; property HorizontalOnly: Boolean read FHorizontalOnly write SetHorizontalOnly default False; - property ImageIndex: TImageIndex read FImageIndex write SetImageIndex; - property MinHeight: Integer read FMinHeight write SetMinHeight default 25; - property MinWidth: Integer read FMinWidth write SetMinWidth default 0; + property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; + property MinHeight: Integer read FMinHeight write SetMinHeight default cDefMinHeight; + property MinWidth: Integer read FMinWidth write SetMinWidth default cDefMinWidth; property ParentColor: Boolean read FParentColor write SetParentColor default True; property ParentBitmap: Boolean read FParentBitmap write SetParentBitmap default True; - property Text: string read GetText write SetText; + property Text: TTranslateString read FText write SetText; property Visible: Boolean read GetVisible write SetVisible default True; - property Width: Integer read GetWidth write SetWidth; + property Width: Integer read FWidth write SetWidth default cDefWidth; end; { TCoolBands } @@ -2295,22 +2304,19 @@ TCoolBands = class(TCollection) private FCoolBar: TCustomCoolBar; - FVisibleCount: Longword; function GetItem(Index: Integer): TCoolBand; procedure SetItem(Index: Integer; aValue: TCoolBand); - procedure CalcPreferredSize(aAlsoUpdate: Boolean; var aPrefWidth, aPrefHeight: integer); protected function GetOwner: TPersistent; override; procedure Update(aItem: TCollectionItem); override; procedure Notify(aItem: TCollectionItem; aAction: TCollectionNotification); override; public - constructor Create(aCoolBar: TCustomCoolBar); + constructor Create(ACoolBar: TCustomCoolBar); function Add: TCoolBand; - function FindBand(aControl: TControl): TCoolBand; + function FindBand(AControl: TControl): TCoolBand; property Items[Index: Integer]: TCoolBand read GetItem write SetItem; default; - end; + end; - // BandMaximize is not used now but is needed for Delphi compatibility. // It is not used in Delphi's TCoolBar either. TCoolBandMaximize = (bmNone, bmClick, bmDblClick); @@ -2323,46 +2329,75 @@ FBandBorderStyle: TBorderStyle; FBandMaximize: TCoolBandMaximize; FBitmap: TBitmap; - FFixedSize: Boolean; + FFixedSize: Boolean; FFixedOrder: Boolean; + FGrabStyle: TGrabStyle; + FGrabWidth: Integer; FImages: TCustomImageList; - FImageChangeLink: TChangeLink; - FShowText: Boolean; - FVertical: Boolean; + FImageChangeLink: TChangeLink; + FShowText: Boolean; + FVertical: Boolean; FOnChange: TNotifyEvent; - function GrabLeft: integer; function GetAlign: TAlign; - procedure SetAlign(aValue: TAlign); reintroduce; - procedure SetBands(aValue: TCoolBands); + procedure SetBandBorderStyle(AValue: TBorderStyle); + procedure SetBands(AValue: TCoolBands); procedure SetBitmap(aValue: TBitmap); - procedure SetImages(aValue: TCustomImageList); - procedure SetShowText(aValue: Boolean); + procedure SetGrabStyle(AValue: TGrabStyle); + procedure SetGrabWidth(AValue: Integer); + procedure SetImages(AValue: TCustomImageList); + procedure SetShowText(AValue: Boolean); procedure SetVertical(aValue: Boolean); - procedure ImageListChange(Sender: TObject); + protected const + cBorderWidth = 2; + cDefGrabStyle = gsDouble; + cDefGrabWidth = 10; protected - procedure AlignControls(aControl: TControl; var aRect: TRect); override; + FVisiBands: array of TCoolBand; + FDefCursor: TCursor; + FDragBand: TDragBand; + FDraggedBandIndex: Integer; // -1 .. space below the last row; other negative .. invalid area + FDragInitPos: Integer; // Initial mouse X - position (for resizing Bands) + FPrevHeight: Integer; + FPrevWidth: Integer; + FTextHeight: Integer; + procedure BitmapOrImageListChange(Sender: TObject); procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; - WithThemeSpace: Boolean); override; + {%H-}WithThemeSpace: Boolean); override; + procedure CalculateAndAlign; + function CalculateRealIndex(AVisibleIndex: Integer): Integer; + procedure DoFontChanged; + procedure CreateWnd; override; + procedure DrawTiledBitmap(ARect: TRect; ABitmap: TBitmap); + procedure FontChanged(Sender: TObject); override; + function IsRowEnd(ALeft, AVisibleIndex: Integer): Boolean; + procedure Loaded; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure Loaded; override; - procedure Paint; override; - procedure Resize; override; + procedure Paint; override; + procedure Resize; override; + procedure SetAlign(aValue: TAlign); reintroduce; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure BeginUpdate; override; procedure EndUpdate; override; + procedure MouseToBandPos(X, Y: Integer; out ABand: Integer; out AGrabber: Boolean); procedure InsertControl(AControl: TControl; Index: integer); override; - procedure RemoveControl(AControl: TControl); override; - public + procedure RemoveControl(AControl: TControl); override; + public property Align read GetAlign write SetAlign default alTop; - property BandBorderStyle: TBorderStyle read FBandBorderStyle write FBandBorderStyle default bsSingle; + property BandBorderStyle: TBorderStyle read FBandBorderStyle write SetBandBorderStyle default bsSingle; property BandMaximize: TCoolBandMaximize read FBandMaximize write FBandMaximize default bmClick; property Bands: TCoolBands read FBands write SetBands; + property Bitmap: TBitmap read FBitmap write SetBitmap; property FixedSize: Boolean read FFixedSize write FFixedSize default False; property FixedOrder: Boolean read FFixedOrder write FFixedOrder default False; + property GrabStyle: TGrabStyle read FGrabStyle write SetGrabStyle default cDefGrabStyle; + property GrabWidth: Integer read FGrabWidth write SetGrabWidth default cDefGrabWidth; property Images: TCustomImageList read FImages write SetImages; - property Bitmap: TBitmap read FBitmap write SetBitmap; property ShowText: Boolean read FShowText write SetShowText default True; property Vertical: Boolean read FVertical write SetVertical default False; property OnChange: TNotifyEvent read FOnChange write FOnChange; @@ -2393,6 +2428,8 @@ property FixedSize; property FixedOrder; property Font; + property GrabStyle; + property GrabWidth; property Images; property ParentColor; property ParentFont; @@ -2421,7 +2458,7 @@ property OnStartDock; property OnStartDrag; property OnUnDock; - end; + end; { TCustomTrackBar } |
|
coolbar1.diff (44,602 bytes)
Index: coolbar.inc =================================================================== --- coolbar.inc (revision 43470) +++ coolbar.inc (working copy) @@ -12,26 +12,28 @@ ***************************************************************************** } -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; + FColor := clDefault; + FControl := nil; FFixedBackground := True; FImageIndex := -1; - FMinHeight := 25; - FParentColor := True; + FMinHeight := cDefMinHeight; + FMinWidth := cDefMinWidth; FParentBitmap := True; + FParentColor := True; + FVisible := True; + FWidth := cDefWidth; + + inherited Create(aCollection); + Assert(aCollection is TCoolBands, 'TCoolBand.Create: aCollection is not TCoolBands'); + FCoolBar := TCoolBands(aCollection).FCoolBar; FBitmap := TBitmap.Create; - FVisible := True; + FBitmap.OnChange := @InvalidateCoolBar; end; destructor TCoolBand.Destroy; @@ -40,17 +42,58 @@ inherited Destroy; end; -function TCoolBand.GetWidth: Integer; +procedure TCoolBand.Assign(aSource: TPersistent); +var src: TCoolBand; + SrcCtrl: TWinControl; begin - Result := FCoolBar.Width; + 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; + SrcCtrl := Nil; + if Assigned(src.Control) then + SrcCtrl := FCoolBar.Owner.FindComponent(src.Control.Name) as TWinControl; + Control := SrcCtrl; + end else + inherited Assign(aSource); +end; + +function TCoolBand.CalcPreferredHeight: Integer; +begin + Result := FMinHeight; + if assigned(FControl) then + Result := max(Result, FControl.Height+2*cVertSpacing); + if FCoolBar.FShowText then + Result := max(Result, FCoolBar.FTextHeight+2*cVertSpacing); + if assigned(FCoolBar.Images) and (ImageIndex >= 0) then + Result := max(Result, FCoolBar.Images.Height+2*cVertSpacing); +end; + +function TCoolBand.CalcPrefferedWidth: Integer; +begin + Result := FCoolBar.GrabWidth+2*cHorSpacing; + if assigned(Control) then + inc(Result, Control.Width+cHorSpacing); + if (FText <> '') and FCoolBar.FShowText then + inc(Result, FCoolBar.Canvas.TextWidth(FText)+cHorSpacing); + Result := max(FMinWidth, Result); end; -function TCoolBand.GetText: string; +function TCoolBand.GetDisplayName: string; begin - if Assigned(FTextLabel) then - Result := FTextLabel.Caption - else - Result := ''; + Result := Text; + if Result = '' then Result := ClassName; end; function TCoolBand.IsBitmapStored: Boolean; @@ -63,403 +106,201 @@ Result := not ParentColor; end; -function TCoolBand.GetHeight: Integer; +procedure TCoolBand.InvalidateCoolBar(Sender: TObject); begin - if Assigned(FControl) then - Result := FControl.Height - else - Result := 20; -end; + Changed(False); +end; function TCoolBand.GetVisible: Boolean; begin Result := FVisible and not (FCoolBar.Vertical and FHorizontalOnly); end; -procedure TCoolBand.ResetControlProps; +procedure TCoolBand.SetBitmap(AValue: TBitmap); 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; + FParentBitmap := False; + FBitmap.Assign(AValue); Changed(False); -end; +end; -procedure TCoolBand.SetBreak(aValue: Boolean); +procedure TCoolBand.SetBorderStyle(AValue: TBorderStyle); begin - if FBreak = aValue then Exit; - FBreak := aValue; + if FBorderStyle = AValue then Exit; + FBorderStyle := AValue; Changed(False); end; -procedure TCoolBand.SetFixedSize(aValue: Boolean); +procedure TCoolBand.SetBreak(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; + if FBreak = AValue then Exit; + FBreak := AValue; Changed(True); end; -procedure TCoolBand.SetHorizontalOnly(aValue: Boolean); +procedure TCoolBand.SetColor(AValue: TColor); 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; + if FColor = AValue then Exit; + FColor := AValue; FParentColor := False; Changed(False); -end; +end; -procedure TCoolBand.SetControlWidth; -var - www: Integer; +procedure TCoolBand.SetControl(AValue: TControl); +var aBand: TCoolBand; 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; + if FControl = AValue then Exit; FCoolBar.BeginUpdate; try - if Assigned(aValue) then + 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; + AValue.Align := alNone; + aBand := TCoolBands(Collection).FindBand(AValue); + if assigned(aBand) and (aBand <> Self) then + aBand.SetControl(Nil); // Remove old association + AValue.Parent := FCoolBar; end; - FControl := aValue; + FControl := AValue; Changed(True); finally FCoolBar.EndUpdate; end; -end; +end; -procedure TCoolBand.SetParentColor(aValue: Boolean); +procedure TCoolBand.SetFixedBackground(AValue: Boolean); begin - if FParentColor = aValue then Exit; - FParentColor := aValue; + if FFixedBackground = AValue then Exit; + FFixedBackground := AValue; Changed(False); -end; +end; -procedure TCoolBand.SetParentBitmap(aValue: Boolean); +procedure TCoolBand.SetHorizontalOnly(AValue: Boolean); begin - if FParentBitmap = aValue then Exit; - FParentBitmap := aValue; + if FHorizontalOnly = AValue then Exit; + FHorizontalOnly := AValue; + Changed(FCoolBar.Vertical); end; -procedure TCoolBand.SetBitmap(aValue: TBitmap); +procedure TCoolBand.SetImageIndex(AValue: TImageIndex); begin - FParentBitmap := False; - FBitmap.Assign(aValue); + if FImageIndex = AValue then Exit; + FImageIndex := AValue; Changed(True); end; -procedure TCoolBand.SetText(const aValue: string); +procedure TCoolBand.SetMinHeight(AValue: Integer); 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); + if FMinHeight = AValue then Exit; + FMinHeight := AValue; + Changed(False); end; -procedure TCoolBand.SetWidth(aValue: Integer); +procedure TCoolBand.SetMinWidth(AValue: Integer); begin - // No operation currently + if FMinWidth = AValue then Exit; + FMinWidth := AValue; + Changed(False); end; -function TCoolBand.GetDisplayName: string; +procedure TCoolBand.SetParentBitmap(AValue: Boolean); begin - Result := Text; - if Result = '' then - Result := ClassName; -end; + if FParentBitmap = AValue then Exit; + FParentBitmap := AValue; + Changed(False); +end; -procedure TCoolBand.SetIndex(aValue: Integer); +procedure TCoolBand.SetParentColor(AValue: Boolean); begin - inherited SetIndex(aValue); + if FParentColor = AValue then Exit; + FParentColor := AValue; + Changed(False); end; -procedure TCoolBand.Assign(aSource: TPersistent); -var - src: TCoolBand; - SrcCtrl: TWinControl; +procedure TCoolBand.SetText(const AValue: TTranslateString); 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; + if AValue = FText then exit; + FText := AValue; + Changed(True); +end; -{ TCoolBands } - -constructor TCoolBands.Create(aCoolBar: TCustomCoolBar); +procedure TCoolBand.SetVisible(AValue: Boolean); begin - inherited Create(TCoolBand); - FCoolBar := aCoolBar; + if FVisible = AValue then Exit; + FVisible := AValue; + if assigned(FControl) then FControl.Visible := AValue; + Changed(True); end; -function TCoolBands.GetItem(Index: Integer): TCoolBand; +procedure TCoolBand.SetWidth(AValue: Integer); begin - Result := TCoolBand(inherited GetItem(Index)); + if AValue = FWidth then Exit; + if AValue < FMinWidth then AValue := FMinWidth; + FWidth := AValue; + Changed(True); end; -procedure TCoolBands.SetItem(Index: Integer; aValue: TCoolBand); +{ TCoolBands } + +constructor TCoolBands.Create(ACoolBar: TCustomCoolBar); begin - inherited SetItem(Index, aValue); + inherited Create(TCoolBand); + FCoolBar := ACoolBar; end; -function TCoolBands.GetOwner: TPersistent; +function TCoolBands.Add: TCoolBand; begin - Result := FCoolBar; + Result := TCoolBand(inherited Add); + //DebugLn('TCoolBands.Add'); end; -procedure TCoolBands.Update(aItem: TCollectionItem); -var - PrefWidth, PrefHeight: integer; +function TCoolBands.FindBand(AControl: TControl): TCoolBand; +var i: 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; + Result := nil; + for i := 0 to Count-1 do + if GetItem(i).FControl = AControl then + Exit(GetItem(i)); +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); + cnAdded: begin + //DebugLn('TCoolBands.Notify: aAction = cnAdded'); + TCoolBand(aItem).FCoolBar:=FCoolBar; end; + cnExtracting: begin + //DebugLn('TCoolBands.Notify: aAction = cnExtracting'); + end; cnDeleting: begin - DebugLn('TCoolBands.Notify: aAction = cnDeleting'); + //DebugLn('TCoolBands.Notify: aAction = cnDeleting'); end; end; -end; +end; -function TCoolBands.Add: TCoolBand; +procedure TCoolBands.Update(aItem: TCollectionItem); begin - Result := TCoolBand(inherited Add); - DebugLn('TCoolBands.Add'); + inherited Update(aItem); + if assigned(FCoolBar) then begin + //DebugLn('Bands.Update calls CalcAndAlign'); + if not assigned(aItem) then FCoolBar.CalculateAndAlign; + FCoolBar.Invalidate; + end; end; -function TCoolBands.FindBand(aControl: TControl): TCoolBand; -var - i: Integer; +function TCoolBands.GetItem(Index: Integer): TCoolBand; begin - Result := nil; - for i := 0 to Count-1 do - if GetItem(i).FControl = AControl then - Exit(GetItem(i)); + Result := TCoolBand(inherited GetItem(Index)); end; -procedure TCoolBands.CalcPreferredSize(aAlsoUpdate: Boolean; var aPrefWidth, aPrefHeight: integer); -var - i, BndWidth, hh: Integer; - LabWidth, CtrlWidth, xHeight: integer; - Band: TCoolBand; +function TCoolBands.GetOwner: TPersistent; begin - aPrefWidth := 0; - aPrefHeight := 3; - for i := 0 to Count-1 do - begin - Band := Items[i]; + Result := FCoolBar; +end; - // 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; +procedure TCoolBands.SetItem(Index: Integer; aValue: TCoolBand); +begin + inherited SetItem(Index, aValue); end; { TCustomCoolBar } @@ -467,19 +308,22 @@ constructor TCustomCoolBar.Create(AOwner: TComponent); begin inherited Create(AOwner); - ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, csOpaque, csDoubleClicks]; - DragMode := dmAutomatic; + ControlStyle := ControlStyle - [csSetCaption] + + [csAcceptsControls, csNoFocus, csOpaque, csParentBackground, csReplicatable]; + Align := alTop; Height := 75; - Align := alTop; ParentColor := True; ParentFont := True; FBandBorderStyle := bsSingle; FBandMaximize := bmClick; FBands := TCoolBands.Create(Self); FBitmap := TBitmap.Create; + FBitmap.OnChange:=@BitmapOrImageListChange; + FGrabStyle := cDefGrabStyle; + FGrabWidth := cDefGrabWidth; + FImageChangeLink := TChangeLink.Create; + FImageChangeLink.OnChange := @BitmapOrImageListChange; FShowText := True; - FImageChangeLink := TChangeLink.Create; - FImageChangeLink.OnChange := @ImageListChange; end; destructor TCustomCoolBar.Destroy; @@ -490,149 +334,285 @@ inherited Destroy; end; -procedure TCustomCoolBar.BeginUpdate; +function TCustomCoolBar.GetAlign: TAlign; begin - DisableAlign; - inherited BeginUpdate; + Result := inherited Align; end; -procedure TCustomCoolBar.EndUpdate; +procedure TCustomCoolBar.SetAlign(aValue: TAlign); +var Old: TAlign; begin - inherited EndUpdate; - EnableAlign; + Old := inherited Align; + if aValue = Old then Exit; + inherited Align := aValue; + if csReading in ComponentState then Exit; + Vertical := (aValue in [alLeft, alRight]); end; -function TCustomCoolBar.GrabLeft: integer; +procedure TCustomCoolBar.SetBandBorderStyle(AValue: TBorderStyle); begin - Result := 2; - if BiDiMode <> bdLeftToRight then - Result := Width - GrabWidth - Result; + if FBandBorderStyle = AValue then Exit; + FBandBorderStyle := AValue; + Invalidate; end; -function TCustomCoolBar.GetAlign: TAlign; +procedure TCustomCoolBar.SetBands(AValue: TCoolBands); begin - Result := inherited Align; + FBands.Assign(AValue); end; -procedure TCustomCoolBar.SetAlign(aValue: TAlign); -var - Old: TAlign; +procedure TCustomCoolBar.SetBitmap(aValue: TBitmap); 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; + FBitmap.Assign(aValue); end; -procedure TCustomCoolBar.SetBands(aValue: TCoolBands); +procedure TCustomCoolBar.SetGrabStyle(AValue: TGrabStyle); begin - FBands.Assign(aValue); + if FGrabStyle = AValue then Exit; + FGrabStyle := AValue; + Invalidate; end; -procedure TCustomCoolBar.SetBitmap(aValue: TBitmap); +procedure TCustomCoolBar.SetGrabWidth(AValue: Integer); begin - FBitmap.Assign(aValue); + if FGrabWidth = AValue then Exit; + FGrabWidth := AValue; + CalculateAndAlign; + Invalidate; end; -procedure TCustomCoolBar.SetImages(aValue: TCustomImageList); +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); + FImages := AValue; + if Assigned(FImages) then begin + AValue.RegisterChanges(FImageChangeLink); + AValue.FreeNotification(Self); end; + CalculateAndAlign; Invalidate; end; -procedure TCustomCoolBar.SetShowText(aValue: Boolean); +procedure TCustomCoolBar.SetShowText(AValue: Boolean); begin - if FShowText = aValue then Exit; - FShowText := aValue; - if not (csLoading in ComponentState) then - FBands.Update(Nil); + if FShowText = AValue then Exit; + FShowText := AValue; + CalculateAndAlign; + Invalidate; end; procedure TCustomCoolBar.SetVertical(aValue: Boolean); begin if FVertical = aValue then Exit; + FVertical := aValue; Invalidate; end; -procedure TCustomCoolBar.ImageListChange(Sender: TObject); +procedure TCustomCoolBar.BitmapOrImageListChange(Sender: TObject); begin Invalidate; end; -procedure TCustomCoolBar.AlignControls(aControl: TControl; var aRect: TRect); -var - PrefWidth, PrefHeight: integer; +procedure TCustomCoolBar.CalculateAndAlign; +var i, x, y, aCountM1, aHeight, aLeft, aStartIndex, aTop, aWidth: Integer; + aRowEnd: Boolean; begin - //DebugLn('TCoolBar.AlignControls'); - if FUpdateCount = 0 then + if (FUpdateCount > 0) or ([csLoading, csDestroying] * ComponentState <> []) then exit; + //DebugLn('CalculateAndAlign'); + aCountM1 := FBands.Count-1; + x := 0; + for i := 0 to aCountM1 do + if FBands[i].Visible then inc(x); + SetLength(FVisiBands, x); + x := 0; + for i := 0 to aCountM1 do + if FBands[i].Visible then begin + FVisiBands[x] := FBands[i]; + inc(x); + end; + aCountM1 := x-1; + //Do not use FBands from this point, only FVisiBands + aHeight := 0; + aStartIndex := 0; + aRowEnd := True; + if AutoSize and (aCountM1 >= 0) then DisableAutoSizing; + for i := 0 to aCountM1 do begin - FBands.CalcPreferredSize(True, PrefWidth, PrefHeight); - inherited AlignControls(aControl, aRect); + if (FVisiBands[i].Break or Vertical) or aRowEnd then aLeft := cBorderWidth; + aHeight := Max(aHeight, FVisiBands[i].CalcPreferredHeight); + inc(aLeft, FVisiBands[i].Width); + aRowEnd := (i = aCountM1) or ((i < aCountM1) + and ((FVisiBands[i+1].Break or Vertical) + or ((aLeft+FVisiBands[i+1].Width) > (ClientWidth-2*cBorderWidth)))); + //Set all Bands in row to uniform height + if aRowEnd then begin + for y := aStartIndex to i do + FVisiBands[y].FHeight := aHeight; + aHeight := 0; + aStartIndex := i+1; + end; end; + aTop := cBorderWidth; + aRowEnd := True; + for i := 0 to aCountM1 do + begin + if aRowEnd or (FVisiBands[i].Break or Vertical) then aLeft := cBorderWidth; + FVisiBands[i].FLeft := aLeft; + FVisiBands[i].FTop := aTop; + if assigned(FVisiBands[i].Control) then begin + x := 2+GrabWidth+TCoolBand.cHorSpacing; + if (FVisiBands[i].Text<>'') and FShowText then + inc(x, Canvas.TextWidth(FVisiBands[i].Text)+TCoolBand.cHorSpacing); + if assigned(FImages) and (FVisiBands[i].ImageIndex >=0) then + inc(x, FImages.Width+TCoolBand.cHorSpacing); + aWidth := FVisiBands[i].Width-x-TCoolBand.cHorSpacing-cBorderWidth; + inc(x, aLeft); + y := aTop+(FVisiBands[i].FHeight-FVisiBands[i].Control.Height) div 2; + FVisiBands[i].Control.Width:=aWidth; + FVisiBands[i].Control.AnchorParallel(akLeft, x-cBorderWidth, self); + FVisiBands[i].Control.AnchorParallel(akTop, y-cBorderWidth, self); + end; + x := FVisiBands[i].Width; + inc(aLeft, x); + aRowEnd := IsRowEnd(aLeft, i); + if aRowEnd or (i = aCountM1) then + FVisiBands[i].FRealWidth := x+ClientWidth-aLeft-cBorderWidth + else + FVisiBands[i].FRealWidth := x; + if aRowEnd then + inc(aTop, FVisiBands[i].FHeight+cBorderWidth); + end; + if AutoSize then begin + inc(FUpdateCount); + InvalidatePreferredSize; + AdjustSize; + if aCountM1 >= 0 then EnableAutoSizing; + dec(FUpdateCount); + end; + FPrevWidth := Width; + FPrevHeight := Height; end; -procedure TCustomCoolBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; +procedure TCustomCoolBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; WithThemeSpace: Boolean); -var - MinWidth, MinHeight: Integer; - PrefWidth, PrefHeight: Integer; +var i, aCountM1, aPrefWidth: Integer; begin - // Calculate preferred width and height - FBands.CalcPreferredSize(False, PrefWidth, PrefHeight); - PreferredWidth := Max(PreferredWidth, PrefWidth); - PreferredHeight := Max(PreferredHeight, PrefHeight); + aCountM1 := length(FVisiBands)-1; + if aCountM1 >= 0 then + PreferredHeight := FVisiBands[aCountM1].FTop+FVisiBands[aCountM1].FHeight+2 + else + PreferredHeight := TCoolBand.cDefMinHeight+4; + if not FVertical then + PreferredWidth := 0 + else begin + aPrefWidth := TCoolBand.cDefMinHeight+4; //min. Width is ~ 25 pixels + for i := 0 to aCountM1 do + aPrefWidth := max(aPrefWidth, FVisiBands[i].Width); + PreferredWidth := aPrefWidth; + end; end; -procedure TCustomCoolBar.Notification(AComponent: TComponent; Operation: TOperation); +function TCustomCoolBar.CalculateRealIndex(AVisibleIndex: Integer): Integer; +var i, aInvisibles, aVisibles: Integer; begin - inherited Notification(AComponent, Operation); - if csDestroying in ComponentState then Exit; - if Operation = opRemove then + aInvisibles := 0; + aVisibles := 0; + for i:=0 to FBands.Count-1 do begin - DebugLn('TCoolBar.Notification: Operation = opRemove'); - if AComponent = FImages then - Images := nil; + if not FBands[i].Visible then + inc(aInvisibles) + else + inc(aVisibles); + if aVisibles > AVisibleIndex then break; end; + Result := AVisibleIndex+aInvisibles; end; +procedure TCustomCoolBar.CreateWnd; +begin + inherited CreateWnd; + FDefCursor := Cursor; + DoFontChanged; +end; + +procedure TCustomCoolBar.DrawTiledBitmap(ARect: TRect; ABitmap: TBitmap); +var i, j, x, y, aWidth, aHeight: Integer; +begin + aWidth := ABitmap.Width; + aHeight := ABitmap.Height; + x := (ARect.Right-ARect.Left) div aWidth; + y := (ARect.Bottom-ARect.Top) div aHeight; + if ((ARect.Right-ARect.Left) mod aWidth) =0 then dec(x); + if ((ARect.Bottom-ARect.Top) mod aHeight) =0 then dec(y); + Canvas.Clipping := True; + Canvas.ClipRect := ARect; + for i := 0 to x do + for j := 0 to y do + Canvas.Draw(ARect.Left+i*aWidth, ARect.Top+j*aHeight, ABitmap); + Canvas.Clipping := False; +end; + +procedure TCustomCoolBar.DoFontChanged; +begin + FTextHeight := Canvas.TextHeight('Žy|'); +end; + +procedure TCustomCoolBar.EndUpdate; +begin + inherited EndUpdate; + //DebugLn('EndUpdate calls CalculateAndAlign'); + CalculateAndAlign; + Invalidate; +end; + +procedure TCustomCoolBar.FontChanged(Sender: TObject); +begin + inherited FontChanged(Sender); + DoFontChanged; + //DebugLn('FontChanged calls CalculateAndAlign'); + CalculateAndAlign; +end; + +function TCustomCoolBar.IsRowEnd(ALeft, AVisibleIndex: Integer): Boolean; +begin + Result := (AVisibleIndex < (length(FVisiBands)-1)) + and ((FVisiBands[AVisibleIndex+1].Break or Vertical) + or ((ALeft+FVisiBands[AVisibleIndex+1].Width) > ClientWidth)); +end; + procedure TCustomCoolBar.InsertControl(AControl: TControl; Index: integer); -var - Band: TCoolBand; +var aBand: 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 + //DebugLn('TCustomCoolBar.InsertControl'); + if (FUpdateCount = 0) and (AControl is TWinControl) and + not (csLoading in ComponentState) then begin - DebugLn('TCoolBar.InsertControl: Adding band for Comp=' + AControl.Name + ', class=' + AControl.ClassName); - Band := FBands.Add; - Band.Control := AControl; + aBand := Bands.FindBand(AControl); + if aBand = Nil then + begin + //DebugLn('TCoolBar.InsertControl: Adding band for Comp=' + AControl.Name + ', class=' + AControl.ClassName); + BeginUpdate; + aBand := FBands.Add; + aBand.Control := AControl; + aBand.Width := aBand.CalcPrefferedWidth; + EndUpdate; + end; end; - end; end; procedure TCustomCoolBar.RemoveControl(AControl: TControl); -var - Band: TCoolBand; +var aBand: TCoolBand; begin - Band := Bands.FindBand(AControl); - if Assigned(Band) then begin - DebugLn('TCoolBar.RemoveControl: Comp=' + AControl.Name + ', class=' + AControl.ClassName); - Band.FControl := nil; + inherited RemoveControl(AControl); + aBand := Bands.FindBand(AControl); + if assigned(aBand) then begin + //DebugLn('TCoolBar.RemoveControl: Comp=' + AControl.Name + ', class=' + AControl.ClassName); + aBand.FControl := nil; + CalculateAndAlign; + Invalidate; end; - inherited RemoveControl(AControl); end; procedure TCustomCoolBar.Loaded; @@ -642,49 +622,337 @@ FBands.Update(Nil); end; +procedure TCustomCoolBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var aBand: Integer; + aGrabber: Boolean; +begin + inherited MouseDown(Button, Shift, X, Y); + MouseToBandPos(X, Y, aBand, aGrabber); + FDraggedBandIndex := aBand; + if aBand >= 0 then begin //Hit any Band + if not aGrabber or (FVisiBands[aBand].FLeft = cBorderWidth) + or FFixedSize or FVisiBands[aBand-1].FFixedSize then begin + if not FFixedOrder then begin //Move Band + FDragBand := dbMove; + Cursor := crDrag; + end; + end else begin //Resize Band + if not FFixedSize and not FVisiBands[aBand-1].FFixedSize then begin + FDragBand := dbResize; + FDragInitPos := X-FVisiBands[aBand-1].FWidth-FVisiBands[aBand-1].FLeft; + end; + end; + end; +end; + +procedure TCustomCoolBar.MouseEnter; +begin + inherited MouseEnter; + FDefCursor := Cursor; +end; + +procedure TCustomCoolBar.MouseLeave; +begin + inherited MouseLeave; + Cursor := FDefCursor; +end; + +procedure TCustomCoolBar.MouseMove(Shift: TShiftState; X, Y: Integer); +var aBand: Integer; + aGrabber: Boolean; +begin + inherited MouseMove(Shift, X, Y); + if (FDragBand = dbNone) and not FFixedSize then begin + MouseToBandPos(X, Y, aBand, aGrabber); + if (aBand >= 1) and not FVisiBands[aBand-1].FFixedSize then begin + if aGrabber and (aBand > 0) and (FVisiBands[aBand].FLeft > cBorderWidth) then + Cursor := crHSplit + else + Cursor := FDefCursor; + end; + end else + if FDragBand = dbResize then begin + FVisiBands[FDraggedBandIndex-1].Width := X-FDragInitPos-FVisiBands[FDraggedBandIndex-1].FLeft; + end; +end; + +procedure TCustomCoolBar.MouseToBandPos(X, Y: Integer; out ABand: Integer; out AGrabber: Boolean); +var i, aCountM1, aLeft, aTop: Integer; +begin + ABand := low(Integer); + AGrabber := False; + aCountM1 := length(FVisiBands)-1; + if aCountM1 >= 0 then begin + if Y > (FVisiBands[aCountM1].FTop+FVisiBands[aCountM1].FHeight+cBorderWidth) then + ABand := -1 // new row, i.e. free space below the last row + else + for i := 0 to aCountM1 do + begin + aLeft := FVisiBands[i].FLeft; + aTop := FVisiBands[i].FTop; + if PtInRect(Rect(aLeft, aTop, aLeft+FVisiBands[i].FRealWidth, + aTop+FVisiBands[i].FHeight), Point(X, Y)) then + begin + ABand := i; + //DebugLn('Mouse over Band ', i); + AGrabber := (X <= (aLeft+GrabWidth+1)); + //DebugLn('Grabber '+BoolToStr(AGrabber), ' hit', ' not hit'); + exit; // EXIT! + end; + end; + end; +end; + +procedure TCustomCoolBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var aBand: Integer; + newRow, needRecalc: Boolean; +begin + inherited MouseUp(Button, Shift, X, Y); + if FDragBand = dbMove then begin + needRecalc := False; + MouseToBandPos(X, Y, aBand, newRow); //newRow is NOT used here + if aBand >= -1 then begin + newRow := (aBand = -1); + if newRow then aBand := length(FVisiBands)-1; + if aBand <> FDraggedBandIndex then begin //move to new position + if (FVisiBands[FDraggedBandIndex].Break or Vertical) + and (FDraggedBandIndex < (length(FVisiBands)-1)) + then FVisiBands[FDraggedBandIndex+1].FBreak := True; + if (X > (FVisiBands[aBand].FLeft+FVisiBands[aBand].Width)) then begin //beyond the last band in row + FVisiBands[FDraggedBandIndex].FBreak := False; + if FDraggedBandIndex > aBand then + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand+1) + else + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + if FDraggedBandIndex = (aBand+1) then needRecalc := True; + end else begin //on another Band + FVisiBands[FDraggedBandIndex].FBreak := FVisiBands[aBand].Break; + if FDraggedBandIndex > aBand then begin //move up or left + FVisiBands[aBand].FBreak := False; + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + end else begin //move down or right + if not newRow then begin + if (FVisiBands[FDraggedBandIndex].FTop = FVisiBands[aBand].FTop) then begin //the same row + FVisiBands[FDraggedBandIndex].FBreak := False; + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + end else begin //other row + if (not FVertical) and (FVisiBands[FDraggedBandIndex].FLeft > cBorderWidth) then + FVisiBands[aBand].FBreak := False; + if (FVisiBands[FDraggedBandIndex].FLeft = cBorderWidth) + and (FVisiBands[aBand].FLeft = cBorderWidth) + and (FVertical or ((aBand-FDraggedBandIndex) = 1) + or (length(FVisiBands) = (aBand+1)) + or (FVisiBands[aBand+1].FLeft = cBorderWidth)) then + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand) + else + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand-1); + if FDraggedBandIndex = (aBand-1) then needRecalc := True; + end; + end else begin //new row + FVisiBands[FDraggedBandIndex].FBreak := True; + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + end; + end; + end; + end else + if newRow then begin //last Band in last row moved to new row + FVisiBands[aBand].FBreak := True; + needRecalc:= True; + end; + if needRecalc then begin //necessary only when no Index is changed + CalculateAndAlign; + Invalidate; + end; + end; + end; + if FDragBand > dbNone then begin + Cursor := FDefCursor; + FDragBand := dbNone; + end; +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.Paint; +var i, x, aCountM1, aLeft, aTop: Integer; + aRowEnd, aRaisedBevel: Boolean; + aColor: TColor; + aDetails, aGrabDetails: TThemedElementDetails; + aFlags: Cardinal; + aRect: TRect; + +const arBevel: array[False..True] of TColor = (clBtnShadow, clBtnHighlight); procedure PaintGrabber(aRect: TRect); + var l, w: SmallInt; 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); + case FGrabStyle of + gsSimple: begin + Canvas.Pen.Color := clBtnHighlight; + Canvas.Line(aRect.Left, aRect.Top, aRect.Right, aRect.Top); + Canvas.Line(aRect.Left, aRect.Top, aRect.Left, aRect.Bottom+1); + Canvas.Pen.Color := clBtnShadow; + Canvas.Line(aRect.Left, aRect.Bottom, aRect.Right, aRect.Bottom); + Canvas.Line(aRect.Right, aRect.Top, aRect.Right, aRect.Bottom+1); + end; + gsDouble: begin + w := (FGrabWidth-2) div 2; + Canvas.Pen.Color := clBtnHighlight; + Canvas.Line(aRect.Left, aRect.Top, aRect.Left+w, aRect.Top); + Canvas.Line(aRect.Left, aRect.Top, aRect.Left, aRect.Bottom+1); + Canvas.Line(aRect.Right-w, aRect.Top, aRect.Right, aRect.Top); + Canvas.Line(aRect.Right-w, aRect.Top, aRect.Right-w, aRect.Bottom+1); + Canvas.Pen.Color := clBtnShadow; + Canvas.Line(aRect.Left, aRect.Bottom, aRect.Left+w, aRect.Bottom); + Canvas.Line(aRect.Left+w, aRect.Top, aRect.Left+w, aRect.Bottom+1); + Canvas.Line(aRect.Right-w, aRect.Bottom, aRect.Right, aRect.Bottom); + Canvas.Line(aRect.Right, aRect.Top, aRect.Right, aRect.Bottom+1); + end; + gsHorLines: begin + l := (aRect.Bottom-aRect.Top+1) div 3; + inc(aRect.Top); + Canvas.Pen.Color := clBtnShadow; + for w := 0 to l-1 do + Canvas.Line(aRect.Left, aRect.Top+w*3, aRect.Right, aRect.Top+w*3); + Canvas.Pen.Color := clBtnHighlight; + inc(aRect.Top); + for w := 0 to l-1 do + Canvas.Line(aRect.Left, aRect.Top+w*3, aRect.Right, aRect.Top+w*3); + end; + gsVerLines: begin + l := (aRect.Right-aRect.Left+1) div 3; + inc(aRect.Left); + Canvas.Pen.Color := clBtnShadow; + for w := 0 to l-1 do + Canvas.Line(aRect.Left+w*3, aRect.Top, aRect.Left+w*3, aRect.Bottom+1); + Canvas.Pen.Color := clBtnHighlight; + inc(aRect.Left); + for w := 0 to l-1 do + Canvas.Line(aRect.Left+w*3, aRect.Top, aRect.Left+w*3, aRect.Bottom+1); + end; + gsGripper: begin + dec(aRect.Top); + inc(aRect.Bottom); + Canvas.ClipRect := aRect; + Canvas.Clipping := True; + ThemeServices.DrawElement(Canvas.Handle, aGrabDetails, aRect); + Canvas.Clipping := False; + end; + gsButton: begin + dec(aRect.Top); + inc(aRect.Bottom); + ThemeServices.DrawElement(Canvas.Handle, aGrabDetails, aRect); + end; + end; end; + + procedure PaintSeparator(Y: Integer); + begin + //DebugLn('PaintSeparator'); + Canvas.Pen.Color := arBevel[aRaisedBevel]; + Canvas.Line(1, Y, ClientWidth-2, Y); + inc(Y); + Canvas.Pen.Color := arBevel[not aRaisedBevel]; + Canvas.Line(2, Y, ClientWidth-2, Y); + 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. + inherited Paint; + //DebugLn('TCoolBar.Paint'); + //Draw Bitmap Background + if FBitmap.Width > 0 then DrawTiledBitmap(ClientRect, FBitmap); + aCountM1 := length(FVisiBands)-1; + if aCountM1 >= 0 then begin 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); + aRaisedBevel := ((EdgeInner = esLowered) and (EdgeOuter = esRaised)); + aRowEnd := False; + case GrabStyle of + gsGripper: aGrabDetails := ThemeServices.GetElementDetails(trGripper); + gsButton: aGrabDetails := ThemeServices.GetElementDetails(tbPushButtonDisabled); end; - end; + if FShowText or assigned(FImages) then begin + if IsEnabled then + aDetails := ThemeServices.GetElementDetails(tbPushButtonNormal) + else + aDetails := ThemeServices.GetElementDetails(tbPushButtonDisabled); + aFlags := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX; + if IsRightToLeft then aFlags := aFlags or DT_RTLREADING; + end; + for i := 0 to aCountM1 do + begin + aLeft := FVisiBands[i].FLeft; + aTop := FVisiBands[i].FTop; + aRect := Rect(aLeft, aTop, aLeft+FVisiBands[i].FRealWidth+1, aTop+FVisiBands[i].FHeight); + //Paint Band Background + if FVisiBands[i].Bitmap.Width > 0 then begin + DrawTiledBitmap(aRect, FVisiBands[i].Bitmap); + end else begin + if not FVisiBands[i].FixedBackground and FVisiBands[i].ParentBitmap + and (Bitmap.Width > 0) then + DrawTiledBitmap(aRect, Bitmap) + else begin + aColor := FVisiBands[i].FColor; + if (aColor <> clDefault) and (aColor <> clNone) then begin + Canvas.Brush.Color := aColor; + Canvas.FillRect(aRect); + end; + end; + end; + //Paint a Grabber + x := aLeft+2; + PaintGrabber(Rect(x, aTop+2, x+GrabWidth-1, aTop+FVisiBands[i].FHeight-3)); + //Paint Image + x := aLeft+GrabWidth+2+TCoolBand.cHorSpacing; + if assigned(FImages) and (FVisiBands[i].ImageIndex >= 0) then begin + ThemeServices.DrawIcon(Canvas, aDetails, + Point(x, aTop+(FVisiBands[i].FHeight-FImages.Height) div 2), + FImages, FVisiBands[i].ImageIndex); + inc(x, FImages.Width+TCoolBand.cHorSpacing); + end; + //Paint Text + if FShowText then begin + aRect := Rect(x, aTop, x+FVisiBands[i].Width, aTop+FVisiBands[i].FHeight); + ThemeServices.DrawText(Canvas, aDetails, FVisiBands[i].Text, aRect, aFlags, 0); + end; + // Paint a Separator border below the row of bands ____ + inc(aLeft, FVisiBands[i].Width); + aRowEnd := IsRowEnd(aLeft, i); + if (aRowEnd or ((i = aCountM1) and not AutoSize) or (Align in [alLeft, alRight])) + and (FBandBorderStyle = bsSingle) + then PaintSeparator(aTop+FVisiBands[i].FHeight); + if not aRowEnd and (i < aCountM1) and (FBandBorderStyle = bsSingle) then begin + //Paint Divider | + Canvas.Pen.Color := arBevel[not aRaisedBevel]; + Canvas.Line(aLeft-1, aTop+1, aLeft-1, aTop+FVisiBands[i].FHeight-1); + Canvas.Pen.Color := arBevel[aRaisedBevel]; + Canvas.Line(aLeft-2, aTop+1, aLeft-2, aTop+FVisiBands[i].FHeight-1); + end; + end; + end; end; procedure TCustomCoolBar.Resize; -var - i: Integer; +var aWidth, aHeight: Integer; begin + //DebugLn('Resize'); 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; + aWidth := Width; + aHeight := Height; + if ((aWidth <> FPrevWidth) or (aHeight <> FPrevHeight)) + and (aWidth*aHeight > 0) and HandleAllocated then + begin + //DebugLn('Resize calls CalcAndAlign'); + CalculateAndAlign; + Invalidate; //Required by GTK2 + end; +end; + |
|
|
|
comctrls2.diff (11,270 bytes)
Index: comctrls.pp =================================================================== --- comctrls.pp (revision 44807) +++ comctrls.pp (working copy) @@ -2215,81 +2215,89 @@ property OnStartDrag; end; - { TCoolBar } + TGrabStyle = (gsSimple, gsDouble, gsHorLines, gsVerLines, gsGripper, gsButton); + TDragBand = (dbNone, dbMove, dbResize); + TCustomCoolBar = class; + { TCoolBand } + TCoolBand = class(TCollectionItem) private FCoolBar: TCustomCoolBar; FControl: TControl; // Associated control - FTextLabel: TLabel; // Possible text is shown in a Label + FBitmap: TBitmap; FBorderStyle: TBorderStyle; FBreak: Boolean; + FColor: TColor; + FFixedBackground: Boolean; FFixedSize: Boolean; - FVisible: Boolean; + FHeight: Integer; FHorizontalOnly: Boolean; FImageIndex: TImageIndex; - FFixedBackground: Boolean; FMinHeight: Integer; FMinWidth: Integer; - FColor: TColor; + FParentBitmap: Boolean; FParentColor: Boolean; - FParentBitmap: Boolean; - FBitmap: TBitmap; + FText: TTranslateString; + FVisible: Boolean; + FWidth: Integer; + FLeft: Integer; FTop: Integer; - fCreatingTextLabel: Boolean; - function GetText: string; - function GetWidth: Integer; + FRealWidth: Integer; function IsBitmapStored: Boolean; function IsColorStored: Boolean; - function GetHeight: Integer; function GetVisible: Boolean; - procedure SetBorderStyle(aValue: TBorderStyle); - procedure SetBreak(aValue: Boolean); - procedure SetFixedSize(aValue: Boolean); - procedure SetMinHeight(aValue: Integer); - procedure SetMinWidth(aValue: Integer); - procedure SetVisible(aValue: Boolean); - procedure SetHorizontalOnly(aValue: Boolean); - procedure SetImageIndex(aValue: TImageIndex); - procedure SetFixedBackground(aValue: Boolean); - procedure SetColor(aValue: TColor); - procedure SetControlWidth; - procedure ResetControlProps; - procedure UpdControl(aLabelWidth: integer); - procedure SetControl(aValue: TControl); - procedure SetParentColor(aValue: Boolean); - procedure SetParentBitmap(aValue: Boolean); - procedure SetBitmap(aValue: TBitmap); - procedure SetText(const aValue: string); - procedure SetWidth(aValue: Integer); + procedure SetBitmap(AValue: TBitmap); + procedure SetBorderStyle(AValue: TBorderStyle); + procedure SetBreak(AValue: Boolean); + procedure SetColor(AValue: TColor); + procedure SetControl(AValue: TControl); + procedure SetFixedBackground(AValue: Boolean); + procedure SetHorizontalOnly(AValue: Boolean); + procedure SetImageIndex(AValue: TImageIndex); + procedure SetMinHeight(AValue: Integer); + procedure SetMinWidth(AValue: Integer); + procedure SetParentBitmap(AValue: Boolean); + procedure SetParentColor(AValue: Boolean); + procedure SetText(const AValue: TTranslateString); + procedure SetVisible(AValue: Boolean); + procedure SetWidth(AValue: Integer); + protected const + cDefMinHeight = 25; + cDefMinWidth = 100; + cDefWidth = 180; + cHorSpacing = 7; + cVertSpacing = 3; protected + function CalcPreferredHeight: Integer; + function CalcPrefferedWidth: Integer; function GetDisplayName: string; override; - procedure SetIndex(aValue: Integer); override; public constructor Create(aCollection: TCollection); override; destructor Destroy; override; + procedure InvalidateCoolBar(Sender: TObject); procedure Assign(aSource: TPersistent); override; - property Height: Integer read GetHeight; + property Height: Integer read FHeight; published property Bitmap: TBitmap read FBitmap write SetBitmap stored IsBitmapStored; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; property Break: Boolean read FBreak write SetBreak default True; - property Color: TColor read FColor write SetColor stored IsColorStored default clBtnFace; + property Color: TColor read FColor write SetColor stored IsColorStored default clDefault; property Control: TControl read FControl write SetControl; property FixedBackground: Boolean read FFixedBackground write SetFixedBackground default True; - property FixedSize: Boolean read FFixedSize write SetFixedSize default False; + property FixedSize: Boolean read FFixedSize write FFixedSize default False; property HorizontalOnly: Boolean read FHorizontalOnly write SetHorizontalOnly default False; - property ImageIndex: TImageIndex read FImageIndex write SetImageIndex; - property MinHeight: Integer read FMinHeight write SetMinHeight default 25; - property MinWidth: Integer read FMinWidth write SetMinWidth default 0; + property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; + property MinHeight: Integer read FMinHeight write SetMinHeight default cDefMinHeight; + property MinWidth: Integer read FMinWidth write SetMinWidth default cDefMinWidth; property ParentColor: Boolean read FParentColor write SetParentColor default True; property ParentBitmap: Boolean read FParentBitmap write SetParentBitmap default True; - property Text: string read GetText write SetText; + property Text: TTranslateString read FText write SetText; property Visible: Boolean read GetVisible write SetVisible default True; - property Width: Integer read GetWidth write SetWidth; + property Width: Integer read FWidth write SetWidth default cDefWidth; end; { TCoolBands } @@ -2297,22 +2305,19 @@ TCoolBands = class(TCollection) private FCoolBar: TCustomCoolBar; - FVisibleCount: Longword; function GetItem(Index: Integer): TCoolBand; procedure SetItem(Index: Integer; aValue: TCoolBand); - procedure CalcPreferredSize(aAlsoUpdate: Boolean; var aPrefWidth, aPrefHeight: integer); protected function GetOwner: TPersistent; override; procedure Update(aItem: TCollectionItem); override; procedure Notify(aItem: TCollectionItem; aAction: TCollectionNotification); override; public - constructor Create(aCoolBar: TCustomCoolBar); + constructor Create(ACoolBar: TCustomCoolBar); function Add: TCoolBand; - function FindBand(aControl: TControl): TCoolBand; + function FindBand(AControl: TControl): TCoolBand; property Items[Index: Integer]: TCoolBand read GetItem write SetItem; default; end; - // BandMaximize is not used now but is needed for Delphi compatibility. // It is not used in Delphi's TCoolBar either. TCoolBandMaximize = (bmNone, bmClick, bmDblClick); @@ -2327,44 +2332,73 @@ FBitmap: TBitmap; FFixedSize: Boolean; FFixedOrder: Boolean; + FGrabStyle: TGrabStyle; + FGrabWidth: Integer; FImages: TCustomImageList; FImageChangeLink: TChangeLink; FShowText: Boolean; FVertical: Boolean; FOnChange: TNotifyEvent; - function GrabLeft: integer; function GetAlign: TAlign; - procedure SetAlign(aValue: TAlign); reintroduce; - procedure SetBands(aValue: TCoolBands); + procedure SetBandBorderStyle(AValue: TBorderStyle); + procedure SetBands(AValue: TCoolBands); procedure SetBitmap(aValue: TBitmap); - procedure SetImages(aValue: TCustomImageList); - procedure SetShowText(aValue: Boolean); + procedure SetGrabStyle(AValue: TGrabStyle); + procedure SetGrabWidth(AValue: Integer); + procedure SetImages(AValue: TCustomImageList); + procedure SetShowText(AValue: Boolean); procedure SetVertical(aValue: Boolean); - procedure ImageListChange(Sender: TObject); + protected const + cBorderWidth = 2; + cDefGrabStyle = gsDouble; + cDefGrabWidth = 10; protected - procedure AlignControls(aControl: TControl; var aRect: TRect); override; + FVisiBands: array of TCoolBand; + FDefCursor: TCursor; + FDragBand: TDragBand; + FDraggedBandIndex: Integer; // -1 .. space below the last row; other negative .. invalid area + FDragInitPos: Integer; // Initial mouse X - position (for resizing Bands) + FPrevHeight: Integer; + FPrevWidth: Integer; + FTextHeight: Integer; + procedure BitmapOrImageListChange(Sender: TObject); procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; - WithThemeSpace: Boolean); override; + {%H-}WithThemeSpace: Boolean); override; + procedure CalculateAndAlign; + function CalculateRealIndex(AVisibleIndex: Integer): Integer; + procedure DoFontChanged; + procedure CreateWnd; override; + procedure DrawTiledBitmap(ARect: TRect; ABitmap: TBitmap); + procedure FontChanged(Sender: TObject); override; + function IsRowEnd(ALeft, AVisibleIndex: Integer): Boolean; + procedure Loaded; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure Loaded; override; procedure Paint; override; procedure Resize; override; + procedure SetAlign(aValue: TAlign); reintroduce; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure BeginUpdate; override; procedure EndUpdate; override; + procedure MouseToBandPos(X, Y: Integer; out ABand: Integer; out AGrabber: Boolean); procedure InsertControl(AControl: TControl; Index: integer); override; procedure RemoveControl(AControl: TControl); override; public property Align read GetAlign write SetAlign default alTop; - property BandBorderStyle: TBorderStyle read FBandBorderStyle write FBandBorderStyle default bsSingle; + property BandBorderStyle: TBorderStyle read FBandBorderStyle write SetBandBorderStyle default bsSingle; property BandMaximize: TCoolBandMaximize read FBandMaximize write FBandMaximize default bmClick; property Bands: TCoolBands read FBands write SetBands; + property Bitmap: TBitmap read FBitmap write SetBitmap; property FixedSize: Boolean read FFixedSize write FFixedSize default False; property FixedOrder: Boolean read FFixedOrder write FFixedOrder default False; + property GrabStyle: TGrabStyle read FGrabStyle write SetGrabStyle default cDefGrabStyle; + property GrabWidth: Integer read FGrabWidth write SetGrabWidth default cDefGrabWidth; property Images: TCustomImageList read FImages write SetImages; - property Bitmap: TBitmap read FBitmap write SetBitmap; property ShowText: Boolean read FShowText write SetShowText default True; property Vertical: Boolean read FVertical write SetVertical default False; property OnChange: TNotifyEvent read FOnChange write FOnChange; @@ -2395,6 +2429,8 @@ property FixedSize; property FixedOrder; property Font; + property GrabStyle; + property GrabWidth; property Images; property ParentColor; property ParentFont; |
|
coolbar2.diff (44,602 bytes)
Index: coolbar.inc =================================================================== --- coolbar.inc (revision 44807) +++ coolbar.inc (working copy) @@ -12,26 +12,28 @@ ***************************************************************************** } -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; + FColor := clDefault; + FControl := nil; FFixedBackground := True; FImageIndex := -1; - FMinHeight := 25; - FParentColor := True; + FMinHeight := cDefMinHeight; + FMinWidth := cDefMinWidth; FParentBitmap := True; + FParentColor := True; + FVisible := True; + FWidth := cDefWidth; + + inherited Create(aCollection); + Assert(aCollection is TCoolBands, 'TCoolBand.Create: aCollection is not TCoolBands'); + FCoolBar := TCoolBands(aCollection).FCoolBar; FBitmap := TBitmap.Create; - FVisible := True; + FBitmap.OnChange := @InvalidateCoolBar; end; destructor TCoolBand.Destroy; @@ -40,17 +42,58 @@ inherited Destroy; end; -function TCoolBand.GetWidth: Integer; +procedure TCoolBand.Assign(aSource: TPersistent); +var src: TCoolBand; + SrcCtrl: TWinControl; begin - Result := FCoolBar.Width; + 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; + SrcCtrl := Nil; + if Assigned(src.Control) then + SrcCtrl := FCoolBar.Owner.FindComponent(src.Control.Name) as TWinControl; + Control := SrcCtrl; + end else + inherited Assign(aSource); +end; + +function TCoolBand.CalcPreferredHeight: Integer; +begin + Result := FMinHeight; + if assigned(FControl) then + Result := max(Result, FControl.Height+2*cVertSpacing); + if FCoolBar.FShowText then + Result := max(Result, FCoolBar.FTextHeight+2*cVertSpacing); + if assigned(FCoolBar.Images) and (ImageIndex >= 0) then + Result := max(Result, FCoolBar.Images.Height+2*cVertSpacing); +end; + +function TCoolBand.CalcPrefferedWidth: Integer; +begin + Result := FCoolBar.GrabWidth+2*cHorSpacing; + if assigned(Control) then + inc(Result, Control.Width+cHorSpacing); + if (FText <> '') and FCoolBar.FShowText then + inc(Result, FCoolBar.Canvas.TextWidth(FText)+cHorSpacing); + Result := max(FMinWidth, Result); end; -function TCoolBand.GetText: string; +function TCoolBand.GetDisplayName: string; begin - if Assigned(FTextLabel) then - Result := FTextLabel.Caption - else - Result := ''; + Result := Text; + if Result = '' then Result := ClassName; end; function TCoolBand.IsBitmapStored: Boolean; @@ -63,403 +106,201 @@ Result := not ParentColor; end; -function TCoolBand.GetHeight: Integer; +procedure TCoolBand.InvalidateCoolBar(Sender: TObject); begin - if Assigned(FControl) then - Result := FControl.Height - else - Result := 20; -end; + Changed(False); +end; function TCoolBand.GetVisible: Boolean; begin Result := FVisible and not (FCoolBar.Vertical and FHorizontalOnly); end; -procedure TCoolBand.ResetControlProps; +procedure TCoolBand.SetBitmap(AValue: TBitmap); 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; + FParentBitmap := False; + FBitmap.Assign(AValue); Changed(False); -end; +end; -procedure TCoolBand.SetBreak(aValue: Boolean); +procedure TCoolBand.SetBorderStyle(AValue: TBorderStyle); begin - if FBreak = aValue then Exit; - FBreak := aValue; + if FBorderStyle = AValue then Exit; + FBorderStyle := AValue; Changed(False); end; -procedure TCoolBand.SetFixedSize(aValue: Boolean); +procedure TCoolBand.SetBreak(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; + if FBreak = AValue then Exit; + FBreak := AValue; Changed(True); end; -procedure TCoolBand.SetHorizontalOnly(aValue: Boolean); +procedure TCoolBand.SetColor(AValue: TColor); 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; + if FColor = AValue then Exit; + FColor := AValue; FParentColor := False; Changed(False); -end; +end; -procedure TCoolBand.SetControlWidth; -var - www: Integer; +procedure TCoolBand.SetControl(AValue: TControl); +var aBand: TCoolBand; 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; + if FControl = AValue then Exit; FCoolBar.BeginUpdate; try - if Assigned(aValue) then + 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; + AValue.Align := alNone; + aBand := TCoolBands(Collection).FindBand(AValue); + if assigned(aBand) and (aBand <> Self) then + aBand.SetControl(Nil); // Remove old association + AValue.Parent := FCoolBar; end; - FControl := aValue; + FControl := AValue; Changed(True); finally FCoolBar.EndUpdate; end; -end; +end; -procedure TCoolBand.SetParentColor(aValue: Boolean); +procedure TCoolBand.SetFixedBackground(AValue: Boolean); begin - if FParentColor = aValue then Exit; - FParentColor := aValue; + if FFixedBackground = AValue then Exit; + FFixedBackground := AValue; Changed(False); -end; +end; -procedure TCoolBand.SetParentBitmap(aValue: Boolean); +procedure TCoolBand.SetHorizontalOnly(AValue: Boolean); begin - if FParentBitmap = aValue then Exit; - FParentBitmap := aValue; + if FHorizontalOnly = AValue then Exit; + FHorizontalOnly := AValue; + Changed(FCoolBar.Vertical); end; -procedure TCoolBand.SetBitmap(aValue: TBitmap); +procedure TCoolBand.SetImageIndex(AValue: TImageIndex); begin - FParentBitmap := False; - FBitmap.Assign(aValue); + if FImageIndex = AValue then Exit; + FImageIndex := AValue; Changed(True); end; -procedure TCoolBand.SetText(const aValue: string); +procedure TCoolBand.SetMinHeight(AValue: Integer); 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); + if FMinHeight = AValue then Exit; + FMinHeight := AValue; + Changed(False); end; -procedure TCoolBand.SetWidth(aValue: Integer); +procedure TCoolBand.SetMinWidth(AValue: Integer); begin - // No operation currently + if FMinWidth = AValue then Exit; + FMinWidth := AValue; + Changed(False); end; -function TCoolBand.GetDisplayName: string; +procedure TCoolBand.SetParentBitmap(AValue: Boolean); begin - Result := Text; - if Result = '' then - Result := ClassName; -end; + if FParentBitmap = AValue then Exit; + FParentBitmap := AValue; + Changed(False); +end; -procedure TCoolBand.SetIndex(aValue: Integer); +procedure TCoolBand.SetParentColor(AValue: Boolean); begin - inherited SetIndex(aValue); + if FParentColor = AValue then Exit; + FParentColor := AValue; + Changed(False); end; -procedure TCoolBand.Assign(aSource: TPersistent); -var - src: TCoolBand; - SrcCtrl: TWinControl; +procedure TCoolBand.SetText(const AValue: TTranslateString); 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; + if AValue = FText then exit; + FText := AValue; + Changed(True); +end; -{ TCoolBands } - -constructor TCoolBands.Create(aCoolBar: TCustomCoolBar); +procedure TCoolBand.SetVisible(AValue: Boolean); begin - inherited Create(TCoolBand); - FCoolBar := aCoolBar; + if FVisible = AValue then Exit; + FVisible := AValue; + if assigned(FControl) then FControl.Visible := AValue; + Changed(True); end; -function TCoolBands.GetItem(Index: Integer): TCoolBand; +procedure TCoolBand.SetWidth(AValue: Integer); begin - Result := TCoolBand(inherited GetItem(Index)); + if AValue = FWidth then Exit; + if AValue < FMinWidth then AValue := FMinWidth; + FWidth := AValue; + Changed(True); end; -procedure TCoolBands.SetItem(Index: Integer; aValue: TCoolBand); +{ TCoolBands } + +constructor TCoolBands.Create(ACoolBar: TCustomCoolBar); begin - inherited SetItem(Index, aValue); + inherited Create(TCoolBand); + FCoolBar := ACoolBar; end; -function TCoolBands.GetOwner: TPersistent; +function TCoolBands.Add: TCoolBand; begin - Result := FCoolBar; + Result := TCoolBand(inherited Add); + //DebugLn('TCoolBands.Add'); end; -procedure TCoolBands.Update(aItem: TCollectionItem); -var - PrefWidth, PrefHeight: integer; +function TCoolBands.FindBand(AControl: TControl): TCoolBand; +var i: 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; + Result := nil; + for i := 0 to Count-1 do + if GetItem(i).FControl = AControl then + Exit(GetItem(i)); +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); + cnAdded: begin + //DebugLn('TCoolBands.Notify: aAction = cnAdded'); + TCoolBand(aItem).FCoolBar:=FCoolBar; end; + cnExtracting: begin + //DebugLn('TCoolBands.Notify: aAction = cnExtracting'); + end; cnDeleting: begin - DebugLn('TCoolBands.Notify: aAction = cnDeleting'); + //DebugLn('TCoolBands.Notify: aAction = cnDeleting'); end; end; -end; +end; -function TCoolBands.Add: TCoolBand; +procedure TCoolBands.Update(aItem: TCollectionItem); begin - Result := TCoolBand(inherited Add); - DebugLn('TCoolBands.Add'); + inherited Update(aItem); + if assigned(FCoolBar) then begin + //DebugLn('Bands.Update calls CalcAndAlign'); + if not assigned(aItem) then FCoolBar.CalculateAndAlign; + FCoolBar.Invalidate; + end; end; -function TCoolBands.FindBand(aControl: TControl): TCoolBand; -var - i: Integer; +function TCoolBands.GetItem(Index: Integer): TCoolBand; begin - Result := nil; - for i := 0 to Count-1 do - if GetItem(i).FControl = AControl then - Exit(GetItem(i)); + Result := TCoolBand(inherited GetItem(Index)); end; -procedure TCoolBands.CalcPreferredSize(aAlsoUpdate: Boolean; var aPrefWidth, aPrefHeight: integer); -var - i, BndWidth, hh: Integer; - LabWidth, CtrlWidth, xHeight: integer; - Band: TCoolBand; +function TCoolBands.GetOwner: TPersistent; begin - aPrefWidth := 0; - aPrefHeight := 3; - for i := 0 to Count-1 do - begin - Band := Items[i]; + Result := FCoolBar; +end; - // 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; +procedure TCoolBands.SetItem(Index: Integer; aValue: TCoolBand); +begin + inherited SetItem(Index, aValue); end; { TCustomCoolBar } @@ -467,19 +308,22 @@ constructor TCustomCoolBar.Create(AOwner: TComponent); begin inherited Create(AOwner); - ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, csOpaque, csDoubleClicks]; - DragMode := dmAutomatic; + ControlStyle := ControlStyle - [csSetCaption] + + [csAcceptsControls, csNoFocus, csOpaque, csParentBackground, csReplicatable]; + Align := alTop; Height := 75; - Align := alTop; ParentColor := True; ParentFont := True; FBandBorderStyle := bsSingle; FBandMaximize := bmClick; FBands := TCoolBands.Create(Self); FBitmap := TBitmap.Create; + FBitmap.OnChange:=@BitmapOrImageListChange; + FGrabStyle := cDefGrabStyle; + FGrabWidth := cDefGrabWidth; + FImageChangeLink := TChangeLink.Create; + FImageChangeLink.OnChange := @BitmapOrImageListChange; FShowText := True; - FImageChangeLink := TChangeLink.Create; - FImageChangeLink.OnChange := @ImageListChange; end; destructor TCustomCoolBar.Destroy; @@ -490,149 +334,285 @@ inherited Destroy; end; -procedure TCustomCoolBar.BeginUpdate; +function TCustomCoolBar.GetAlign: TAlign; begin - DisableAlign; - inherited BeginUpdate; + Result := inherited Align; end; -procedure TCustomCoolBar.EndUpdate; +procedure TCustomCoolBar.SetAlign(aValue: TAlign); +var Old: TAlign; begin - inherited EndUpdate; - EnableAlign; + Old := inherited Align; + if aValue = Old then Exit; + inherited Align := aValue; + if csReading in ComponentState then Exit; + Vertical := (aValue in [alLeft, alRight]); end; -function TCustomCoolBar.GrabLeft: integer; +procedure TCustomCoolBar.SetBandBorderStyle(AValue: TBorderStyle); begin - Result := 2; - if BiDiMode <> bdLeftToRight then - Result := Width - GrabWidth - Result; + if FBandBorderStyle = AValue then Exit; + FBandBorderStyle := AValue; + Invalidate; end; -function TCustomCoolBar.GetAlign: TAlign; +procedure TCustomCoolBar.SetBands(AValue: TCoolBands); begin - Result := inherited Align; + FBands.Assign(AValue); end; -procedure TCustomCoolBar.SetAlign(aValue: TAlign); -var - Old: TAlign; +procedure TCustomCoolBar.SetBitmap(aValue: TBitmap); 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; + FBitmap.Assign(aValue); end; -procedure TCustomCoolBar.SetBands(aValue: TCoolBands); +procedure TCustomCoolBar.SetGrabStyle(AValue: TGrabStyle); begin - FBands.Assign(aValue); + if FGrabStyle = AValue then Exit; + FGrabStyle := AValue; + Invalidate; end; -procedure TCustomCoolBar.SetBitmap(aValue: TBitmap); +procedure TCustomCoolBar.SetGrabWidth(AValue: Integer); begin - FBitmap.Assign(aValue); + if FGrabWidth = AValue then Exit; + FGrabWidth := AValue; + CalculateAndAlign; + Invalidate; end; -procedure TCustomCoolBar.SetImages(aValue: TCustomImageList); +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); + FImages := AValue; + if Assigned(FImages) then begin + AValue.RegisterChanges(FImageChangeLink); + AValue.FreeNotification(Self); end; + CalculateAndAlign; Invalidate; end; -procedure TCustomCoolBar.SetShowText(aValue: Boolean); +procedure TCustomCoolBar.SetShowText(AValue: Boolean); begin - if FShowText = aValue then Exit; - FShowText := aValue; - if not (csLoading in ComponentState) then - FBands.Update(Nil); + if FShowText = AValue then Exit; + FShowText := AValue; + CalculateAndAlign; + Invalidate; end; procedure TCustomCoolBar.SetVertical(aValue: Boolean); begin if FVertical = aValue then Exit; + FVertical := aValue; Invalidate; end; -procedure TCustomCoolBar.ImageListChange(Sender: TObject); +procedure TCustomCoolBar.BitmapOrImageListChange(Sender: TObject); begin Invalidate; end; -procedure TCustomCoolBar.AlignControls(aControl: TControl; var aRect: TRect); -var - PrefWidth, PrefHeight: integer; +procedure TCustomCoolBar.CalculateAndAlign; +var i, x, y, aCountM1, aHeight, aLeft, aStartIndex, aTop, aWidth: Integer; + aRowEnd: Boolean; begin - //DebugLn('TCoolBar.AlignControls'); - if FUpdateCount = 0 then + if (FUpdateCount > 0) or ([csLoading, csDestroying] * ComponentState <> []) then exit; + //DebugLn('CalculateAndAlign'); + aCountM1 := FBands.Count-1; + x := 0; + for i := 0 to aCountM1 do + if FBands[i].Visible then inc(x); + SetLength(FVisiBands, x); + x := 0; + for i := 0 to aCountM1 do + if FBands[i].Visible then begin + FVisiBands[x] := FBands[i]; + inc(x); + end; + aCountM1 := x-1; + //Do not use FBands from this point, only FVisiBands + aHeight := 0; + aStartIndex := 0; + aRowEnd := True; + if AutoSize and (aCountM1 >= 0) then DisableAutoSizing; + for i := 0 to aCountM1 do begin - FBands.CalcPreferredSize(True, PrefWidth, PrefHeight); - inherited AlignControls(aControl, aRect); + if (FVisiBands[i].Break or Vertical) or aRowEnd then aLeft := cBorderWidth; + aHeight := Max(aHeight, FVisiBands[i].CalcPreferredHeight); + inc(aLeft, FVisiBands[i].Width); + aRowEnd := (i = aCountM1) or ((i < aCountM1) + and ((FVisiBands[i+1].Break or Vertical) + or ((aLeft+FVisiBands[i+1].Width) > (ClientWidth-2*cBorderWidth)))); + //Set all Bands in row to uniform height + if aRowEnd then begin + for y := aStartIndex to i do + FVisiBands[y].FHeight := aHeight; + aHeight := 0; + aStartIndex := i+1; + end; end; + aTop := cBorderWidth; + aRowEnd := True; + for i := 0 to aCountM1 do + begin + if aRowEnd or (FVisiBands[i].Break or Vertical) then aLeft := cBorderWidth; + FVisiBands[i].FLeft := aLeft; + FVisiBands[i].FTop := aTop; + if assigned(FVisiBands[i].Control) then begin + x := 2+GrabWidth+TCoolBand.cHorSpacing; + if (FVisiBands[i].Text<>'') and FShowText then + inc(x, Canvas.TextWidth(FVisiBands[i].Text)+TCoolBand.cHorSpacing); + if assigned(FImages) and (FVisiBands[i].ImageIndex >=0) then + inc(x, FImages.Width+TCoolBand.cHorSpacing); + aWidth := FVisiBands[i].Width-x-TCoolBand.cHorSpacing-cBorderWidth; + inc(x, aLeft); + y := aTop+(FVisiBands[i].FHeight-FVisiBands[i].Control.Height) div 2; + FVisiBands[i].Control.Width:=aWidth; + FVisiBands[i].Control.AnchorParallel(akLeft, x-cBorderWidth, self); + FVisiBands[i].Control.AnchorParallel(akTop, y-cBorderWidth, self); + end; + x := FVisiBands[i].Width; + inc(aLeft, x); + aRowEnd := IsRowEnd(aLeft, i); + if aRowEnd or (i = aCountM1) then + FVisiBands[i].FRealWidth := x+ClientWidth-aLeft-cBorderWidth + else + FVisiBands[i].FRealWidth := x; + if aRowEnd then + inc(aTop, FVisiBands[i].FHeight+cBorderWidth); + end; + if AutoSize then begin + inc(FUpdateCount); + InvalidatePreferredSize; + AdjustSize; + if aCountM1 >= 0 then EnableAutoSizing; + dec(FUpdateCount); + end; + FPrevWidth := Width; + FPrevHeight := Height; end; -procedure TCustomCoolBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; +procedure TCustomCoolBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; WithThemeSpace: Boolean); -var - MinWidth, MinHeight: Integer; - PrefWidth, PrefHeight: Integer; +var i, aCountM1, aPrefWidth: Integer; begin - // Calculate preferred width and height - FBands.CalcPreferredSize(False, PrefWidth, PrefHeight); - PreferredWidth := Max(PreferredWidth, PrefWidth); - PreferredHeight := Max(PreferredHeight, PrefHeight); + aCountM1 := length(FVisiBands)-1; + if aCountM1 >= 0 then + PreferredHeight := FVisiBands[aCountM1].FTop+FVisiBands[aCountM1].FHeight+2 + else + PreferredHeight := TCoolBand.cDefMinHeight+4; + if not FVertical then + PreferredWidth := 0 + else begin + aPrefWidth := TCoolBand.cDefMinHeight+4; //min. Width is ~ 25 pixels + for i := 0 to aCountM1 do + aPrefWidth := max(aPrefWidth, FVisiBands[i].Width); + PreferredWidth := aPrefWidth; + end; end; -procedure TCustomCoolBar.Notification(AComponent: TComponent; Operation: TOperation); +function TCustomCoolBar.CalculateRealIndex(AVisibleIndex: Integer): Integer; +var i, aInvisibles, aVisibles: Integer; begin - inherited Notification(AComponent, Operation); - if csDestroying in ComponentState then Exit; - if Operation = opRemove then + aInvisibles := 0; + aVisibles := 0; + for i:=0 to FBands.Count-1 do begin - DebugLn('TCoolBar.Notification: Operation = opRemove'); - if AComponent = FImages then - Images := nil; + if not FBands[i].Visible then + inc(aInvisibles) + else + inc(aVisibles); + if aVisibles > AVisibleIndex then break; end; + Result := AVisibleIndex+aInvisibles; end; +procedure TCustomCoolBar.CreateWnd; +begin + inherited CreateWnd; + FDefCursor := Cursor; + DoFontChanged; +end; + +procedure TCustomCoolBar.DrawTiledBitmap(ARect: TRect; ABitmap: TBitmap); +var i, j, x, y, aWidth, aHeight: Integer; +begin + aWidth := ABitmap.Width; + aHeight := ABitmap.Height; + x := (ARect.Right-ARect.Left) div aWidth; + y := (ARect.Bottom-ARect.Top) div aHeight; + if ((ARect.Right-ARect.Left) mod aWidth) =0 then dec(x); + if ((ARect.Bottom-ARect.Top) mod aHeight) =0 then dec(y); + Canvas.Clipping := True; + Canvas.ClipRect := ARect; + for i := 0 to x do + for j := 0 to y do + Canvas.Draw(ARect.Left+i*aWidth, ARect.Top+j*aHeight, ABitmap); + Canvas.Clipping := False; +end; + +procedure TCustomCoolBar.DoFontChanged; +begin + FTextHeight := Canvas.TextHeight('Žy|'); +end; + +procedure TCustomCoolBar.EndUpdate; +begin + inherited EndUpdate; + //DebugLn('EndUpdate calls CalculateAndAlign'); + CalculateAndAlign; + Invalidate; +end; + +procedure TCustomCoolBar.FontChanged(Sender: TObject); +begin + inherited FontChanged(Sender); + DoFontChanged; + //DebugLn('FontChanged calls CalculateAndAlign'); + CalculateAndAlign; +end; + +function TCustomCoolBar.IsRowEnd(ALeft, AVisibleIndex: Integer): Boolean; +begin + Result := (AVisibleIndex < (length(FVisiBands)-1)) + and ((FVisiBands[AVisibleIndex+1].Break or Vertical) + or ((ALeft+FVisiBands[AVisibleIndex+1].Width) > ClientWidth)); +end; + procedure TCustomCoolBar.InsertControl(AControl: TControl; Index: integer); -var - Band: TCoolBand; +var aBand: 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 + //DebugLn('TCustomCoolBar.InsertControl'); + if (FUpdateCount = 0) and (AControl is TWinControl) and + not (csLoading in ComponentState) then begin - DebugLn('TCoolBar.InsertControl: Adding band for Comp=' + AControl.Name + ', class=' + AControl.ClassName); - Band := FBands.Add; - Band.Control := AControl; + aBand := Bands.FindBand(AControl); + if aBand = Nil then + begin + //DebugLn('TCoolBar.InsertControl: Adding band for Comp=' + AControl.Name + ', class=' + AControl.ClassName); + BeginUpdate; + aBand := FBands.Add; + aBand.Control := AControl; + aBand.Width := aBand.CalcPrefferedWidth; + EndUpdate; + end; end; - end; end; procedure TCustomCoolBar.RemoveControl(AControl: TControl); -var - Band: TCoolBand; +var aBand: TCoolBand; begin - Band := Bands.FindBand(AControl); - if Assigned(Band) then begin - DebugLn('TCoolBar.RemoveControl: Comp=' + AControl.Name + ', class=' + AControl.ClassName); - Band.FControl := nil; + inherited RemoveControl(AControl); + aBand := Bands.FindBand(AControl); + if assigned(aBand) then begin + //DebugLn('TCoolBar.RemoveControl: Comp=' + AControl.Name + ', class=' + AControl.ClassName); + aBand.FControl := nil; + CalculateAndAlign; + Invalidate; end; - inherited RemoveControl(AControl); end; procedure TCustomCoolBar.Loaded; @@ -642,49 +622,337 @@ FBands.Update(Nil); end; +procedure TCustomCoolBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var aBand: Integer; + aGrabber: Boolean; +begin + inherited MouseDown(Button, Shift, X, Y); + MouseToBandPos(X, Y, aBand, aGrabber); + FDraggedBandIndex := aBand; + if aBand >= 0 then begin //Hit any Band + if not aGrabber or (FVisiBands[aBand].FLeft = cBorderWidth) + or FFixedSize or FVisiBands[aBand-1].FFixedSize then begin + if not FFixedOrder then begin //Move Band + FDragBand := dbMove; + Cursor := crDrag; + end; + end else begin //Resize Band + if not FFixedSize and not FVisiBands[aBand-1].FFixedSize then begin + FDragBand := dbResize; + FDragInitPos := X-FVisiBands[aBand-1].FWidth-FVisiBands[aBand-1].FLeft; + end; + end; + end; +end; + +procedure TCustomCoolBar.MouseEnter; +begin + inherited MouseEnter; + FDefCursor := Cursor; +end; + +procedure TCustomCoolBar.MouseLeave; +begin + inherited MouseLeave; + Cursor := FDefCursor; +end; + +procedure TCustomCoolBar.MouseMove(Shift: TShiftState; X, Y: Integer); +var aBand: Integer; + aGrabber: Boolean; +begin + inherited MouseMove(Shift, X, Y); + if (FDragBand = dbNone) and not FFixedSize then begin + MouseToBandPos(X, Y, aBand, aGrabber); + if (aBand >= 1) and not FVisiBands[aBand-1].FFixedSize then begin + if aGrabber and (aBand > 0) and (FVisiBands[aBand].FLeft > cBorderWidth) then + Cursor := crHSplit + else + Cursor := FDefCursor; + end; + end else + if FDragBand = dbResize then begin + FVisiBands[FDraggedBandIndex-1].Width := X-FDragInitPos-FVisiBands[FDraggedBandIndex-1].FLeft; + end; +end; + +procedure TCustomCoolBar.MouseToBandPos(X, Y: Integer; out ABand: Integer; out AGrabber: Boolean); +var i, aCountM1, aLeft, aTop: Integer; +begin + ABand := low(Integer); + AGrabber := False; + aCountM1 := length(FVisiBands)-1; + if aCountM1 >= 0 then begin + if Y > (FVisiBands[aCountM1].FTop+FVisiBands[aCountM1].FHeight+cBorderWidth) then + ABand := -1 // new row, i.e. free space below the last row + else + for i := 0 to aCountM1 do + begin + aLeft := FVisiBands[i].FLeft; + aTop := FVisiBands[i].FTop; + if PtInRect(Rect(aLeft, aTop, aLeft+FVisiBands[i].FRealWidth, + aTop+FVisiBands[i].FHeight), Point(X, Y)) then + begin + ABand := i; + //DebugLn('Mouse over Band ', i); + AGrabber := (X <= (aLeft+GrabWidth+1)); + //DebugLn('Grabber '+BoolToStr(AGrabber), ' hit', ' not hit'); + exit; // EXIT! + end; + end; + end; +end; + +procedure TCustomCoolBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var aBand: Integer; + newRow, needRecalc: Boolean; +begin + inherited MouseUp(Button, Shift, X, Y); + if FDragBand = dbMove then begin + needRecalc := False; + MouseToBandPos(X, Y, aBand, newRow); //newRow is NOT used here + if aBand >= -1 then begin + newRow := (aBand = -1); + if newRow then aBand := length(FVisiBands)-1; + if aBand <> FDraggedBandIndex then begin //move to new position + if (FVisiBands[FDraggedBandIndex].Break or Vertical) + and (FDraggedBandIndex < (length(FVisiBands)-1)) + then FVisiBands[FDraggedBandIndex+1].FBreak := True; + if (X > (FVisiBands[aBand].FLeft+FVisiBands[aBand].Width)) then begin //beyond the last band in row + FVisiBands[FDraggedBandIndex].FBreak := False; + if FDraggedBandIndex > aBand then + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand+1) + else + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + if FDraggedBandIndex = (aBand+1) then needRecalc := True; + end else begin //on another Band + FVisiBands[FDraggedBandIndex].FBreak := FVisiBands[aBand].Break; + if FDraggedBandIndex > aBand then begin //move up or left + FVisiBands[aBand].FBreak := False; + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + end else begin //move down or right + if not newRow then begin + if (FVisiBands[FDraggedBandIndex].FTop = FVisiBands[aBand].FTop) then begin //the same row + FVisiBands[FDraggedBandIndex].FBreak := False; + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + end else begin //other row + if (not FVertical) and (FVisiBands[FDraggedBandIndex].FLeft > cBorderWidth) then + FVisiBands[aBand].FBreak := False; + if (FVisiBands[FDraggedBandIndex].FLeft = cBorderWidth) + and (FVisiBands[aBand].FLeft = cBorderWidth) + and (FVertical or ((aBand-FDraggedBandIndex) = 1) + or (length(FVisiBands) = (aBand+1)) + or (FVisiBands[aBand+1].FLeft = cBorderWidth)) then + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand) + else + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand-1); + if FDraggedBandIndex = (aBand-1) then needRecalc := True; + end; + end else begin //new row + FVisiBands[FDraggedBandIndex].FBreak := True; + FVisiBands[FDraggedBandIndex].Index := CalculateRealIndex(aBand); + end; + end; + end; + end else + if newRow then begin //last Band in last row moved to new row + FVisiBands[aBand].FBreak := True; + needRecalc:= True; + end; + if needRecalc then begin //necessary only when no Index is changed + CalculateAndAlign; + Invalidate; + end; + end; + end; + if FDragBand > dbNone then begin + Cursor := FDefCursor; + FDragBand := dbNone; + end; +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.Paint; +var i, x, aCountM1, aLeft, aTop: Integer; + aRowEnd, aRaisedBevel: Boolean; + aColor: TColor; + aDetails, aGrabDetails: TThemedElementDetails; + aFlags: Cardinal; + aRect: TRect; + +const arBevel: array[False..True] of TColor = (clBtnShadow, clBtnHighlight); procedure PaintGrabber(aRect: TRect); + var l, w: SmallInt; 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); + case FGrabStyle of + gsSimple: begin + Canvas.Pen.Color := clBtnHighlight; + Canvas.Line(aRect.Left, aRect.Top, aRect.Right, aRect.Top); + Canvas.Line(aRect.Left, aRect.Top, aRect.Left, aRect.Bottom+1); + Canvas.Pen.Color := clBtnShadow; + Canvas.Line(aRect.Left, aRect.Bottom, aRect.Right, aRect.Bottom); + Canvas.Line(aRect.Right, aRect.Top, aRect.Right, aRect.Bottom+1); + end; + gsDouble: begin + w := (FGrabWidth-2) div 2; + Canvas.Pen.Color := clBtnHighlight; + Canvas.Line(aRect.Left, aRect.Top, aRect.Left+w, aRect.Top); + Canvas.Line(aRect.Left, aRect.Top, aRect.Left, aRect.Bottom+1); + Canvas.Line(aRect.Right-w, aRect.Top, aRect.Right, aRect.Top); + Canvas.Line(aRect.Right-w, aRect.Top, aRect.Right-w, aRect.Bottom+1); + Canvas.Pen.Color := clBtnShadow; + Canvas.Line(aRect.Left, aRect.Bottom, aRect.Left+w, aRect.Bottom); + Canvas.Line(aRect.Left+w, aRect.Top, aRect.Left+w, aRect.Bottom+1); + Canvas.Line(aRect.Right-w, aRect.Bottom, aRect.Right, aRect.Bottom); + Canvas.Line(aRect.Right, aRect.Top, aRect.Right, aRect.Bottom+1); + end; + gsHorLines: begin + l := (aRect.Bottom-aRect.Top+1) div 3; + inc(aRect.Top); + Canvas.Pen.Color := clBtnShadow; + for w := 0 to l-1 do + Canvas.Line(aRect.Left, aRect.Top+w*3, aRect.Right, aRect.Top+w*3); + Canvas.Pen.Color := clBtnHighlight; + inc(aRect.Top); + for w := 0 to l-1 do + Canvas.Line(aRect.Left, aRect.Top+w*3, aRect.Right, aRect.Top+w*3); + end; + gsVerLines: begin + l := (aRect.Right-aRect.Left+1) div 3; + inc(aRect.Left); + Canvas.Pen.Color := clBtnShadow; + for w := 0 to l-1 do + Canvas.Line(aRect.Left+w*3, aRect.Top, aRect.Left+w*3, aRect.Bottom+1); + Canvas.Pen.Color := clBtnHighlight; + inc(aRect.Left); + for w := 0 to l-1 do + Canvas.Line(aRect.Left+w*3, aRect.Top, aRect.Left+w*3, aRect.Bottom+1); + end; + gsGripper: begin + dec(aRect.Top); + inc(aRect.Bottom); + Canvas.ClipRect := aRect; + Canvas.Clipping := True; + ThemeServices.DrawElement(Canvas.Handle, aGrabDetails, aRect); + Canvas.Clipping := False; + end; + gsButton: begin + dec(aRect.Top); + inc(aRect.Bottom); + ThemeServices.DrawElement(Canvas.Handle, aGrabDetails, aRect); + end; + end; end; + + procedure PaintSeparator(Y: Integer); + begin + //DebugLn('PaintSeparator'); + Canvas.Pen.Color := arBevel[aRaisedBevel]; + Canvas.Line(1, Y, ClientWidth-2, Y); + inc(Y); + Canvas.Pen.Color := arBevel[not aRaisedBevel]; + Canvas.Line(2, Y, ClientWidth-2, Y); + 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. + inherited Paint; + //DebugLn('TCoolBar.Paint'); + //Draw Bitmap Background + if FBitmap.Width > 0 then DrawTiledBitmap(ClientRect, FBitmap); + aCountM1 := length(FVisiBands)-1; + if aCountM1 >= 0 then begin 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); + aRaisedBevel := ((EdgeInner = esLowered) and (EdgeOuter = esRaised)); + aRowEnd := False; + case GrabStyle of + gsGripper: aGrabDetails := ThemeServices.GetElementDetails(trGripper); + gsButton: aGrabDetails := ThemeServices.GetElementDetails(tbPushButtonDisabled); end; - end; + if FShowText or assigned(FImages) then begin + if IsEnabled then + aDetails := ThemeServices.GetElementDetails(tbPushButtonNormal) + else + aDetails := ThemeServices.GetElementDetails(tbPushButtonDisabled); + aFlags := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX; + if IsRightToLeft then aFlags := aFlags or DT_RTLREADING; + end; + for i := 0 to aCountM1 do + begin + aLeft := FVisiBands[i].FLeft; + aTop := FVisiBands[i].FTop; + aRect := Rect(aLeft, aTop, aLeft+FVisiBands[i].FRealWidth+1, aTop+FVisiBands[i].FHeight); + //Paint Band Background + if FVisiBands[i].Bitmap.Width > 0 then begin + DrawTiledBitmap(aRect, FVisiBands[i].Bitmap); + end else begin + if not FVisiBands[i].FixedBackground and FVisiBands[i].ParentBitmap + and (Bitmap.Width > 0) then + DrawTiledBitmap(aRect, Bitmap) + else begin + aColor := FVisiBands[i].FColor; + if (aColor <> clDefault) and (aColor <> clNone) then begin + Canvas.Brush.Color := aColor; + Canvas.FillRect(aRect); + end; + end; + end; + //Paint a Grabber + x := aLeft+2; + PaintGrabber(Rect(x, aTop+2, x+GrabWidth-1, aTop+FVisiBands[i].FHeight-3)); + //Paint Image + x := aLeft+GrabWidth+2+TCoolBand.cHorSpacing; + if assigned(FImages) and (FVisiBands[i].ImageIndex >= 0) then begin + ThemeServices.DrawIcon(Canvas, aDetails, + Point(x, aTop+(FVisiBands[i].FHeight-FImages.Height) div 2), + FImages, FVisiBands[i].ImageIndex); + inc(x, FImages.Width+TCoolBand.cHorSpacing); + end; + //Paint Text + if FShowText then begin + aRect := Rect(x, aTop, x+FVisiBands[i].Width, aTop+FVisiBands[i].FHeight); + ThemeServices.DrawText(Canvas, aDetails, FVisiBands[i].Text, aRect, aFlags, 0); + end; + // Paint a Separator border below the row of bands ____ + inc(aLeft, FVisiBands[i].Width); + aRowEnd := IsRowEnd(aLeft, i); + if (aRowEnd or ((i = aCountM1) and not AutoSize) or (Align in [alLeft, alRight])) + and (FBandBorderStyle = bsSingle) + then PaintSeparator(aTop+FVisiBands[i].FHeight); + if not aRowEnd and (i < aCountM1) and (FBandBorderStyle = bsSingle) then begin + //Paint Divider | + Canvas.Pen.Color := arBevel[not aRaisedBevel]; + Canvas.Line(aLeft-1, aTop+1, aLeft-1, aTop+FVisiBands[i].FHeight-1); + Canvas.Pen.Color := arBevel[aRaisedBevel]; + Canvas.Line(aLeft-2, aTop+1, aLeft-2, aTop+FVisiBands[i].FHeight-1); + end; + end; + end; end; procedure TCustomCoolBar.Resize; -var - i: Integer; +var aWidth, aHeight: Integer; begin + //DebugLn('Resize'); 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; + aWidth := Width; + aHeight := Height; + if ((aWidth <> FPrevWidth) or (aHeight <> FPrevHeight)) + and (aWidth*aHeight > 0) and HandleAllocated then + begin + //DebugLn('Resize calls CalcAndAlign'); + CalculateAndAlign; + Invalidate; //Required by GTK2 + end; +end; + |
|
I added patches comctrls2.diff, coolbar2.diff (against 44807). Now controls cannot be moved at design-time. I replaced SetBounds with AnchorParallel(). It seems my previous patches from November was omitted. |
|
Vojtech, sorry, somehow I missed your patches from November. I thought I followed all changes in my issues but apparently not. I will look at the new patches now ... |
|
I applied it. Thanks, and sorry for the delay. It is very nice, although there are some minor issues. For example the associated conrol's location goes wrong if you set its alignment. It did not happen when AlignControls was used. I believe you don't use AlignControls because it caused problems with drag'n'drop. (?) Drag cursor is wrong with QT but that is a QT widgetset issue. With GTK2 it is better, although the left-right resize cursor for 2 bands side by side is wrong while moving mouse. Please close if OK. Possible further improvements can have their own issue opened. |
|
@Drag cursor is wrong with QT but that is a QT widgetset issue. With GTK2 it is better, although the left-right resize cursor for 2 bands side by side is wrong while moving mouse. Unfortunately, I cannot reproduce it here. Cursors look fine in both Qt4 and GTK2. @For example the associated conrol's location goes wrong if you set its alignment. What does this mean: "set its alignment"? How can I see it? Do you mean changing control's --property Align when it is on band? I would like to repair it. Thanks. |
|
its look ok with grab style like delphi toolbar 2000, this problem, how to make drag band coolbar real time like toolbar 2000 or delphi coolbar. |
|
I moved the discussion into Lazarus mailing list, under title "TCoolBar improvements". Please answer there. Derit, please repeat your question in mailing list but rephrase it and explain better. I did not quite understand the question. |
|
Thanks for accepting patch. I tested with r. 44818. I will follow discussion on ML. |
Date Modified | Username | Field | Change |
---|---|---|---|
2013-09-15 13:27 | Vojtech Cihak | New Issue | |
2013-09-15 13:27 | Vojtech Cihak | File Added: coolbar.inc | |
2013-09-15 13:28 | Vojtech Cihak | File Added: coolbar.diff | |
2013-09-15 13:29 | Vojtech Cihak | File Added: comctrls.diff | |
2013-09-15 20:08 | Andrey Zubarev | Note Added: 0070086 | |
2013-09-15 20:36 | Vojtech Cihak | Note Added: 0070087 | |
2013-09-15 23:48 | Juha Manninen | Note Added: 0070092 | |
2013-09-15 23:52 | Juha Manninen | Note Edited: 0070092 | View Revisions |
2013-09-15 23:54 | Juha Manninen | Assigned To | => Juha Manninen |
2013-09-15 23:54 | Juha Manninen | Status | new => assigned |
2013-09-16 00:01 | Juha Manninen | Note Edited: 0070092 | View Revisions |
2013-09-16 07:10 | Juha Manninen | Note Edited: 0070092 | View Revisions |
2013-09-16 09:10 | Vojtech Cihak | Note Added: 0070100 | |
2013-09-19 23:33 | Juha Manninen | Note Added: 0070209 | |
2013-11-02 11:26 | Juha Manninen | LazTarget | => - |
2013-11-02 11:26 | Juha Manninen | Note Added: 0071099 | |
2013-11-02 11:26 | Juha Manninen | Status | assigned => feedback |
2013-11-02 12:06 | Vojtech Cihak | Note Added: 0071101 | |
2013-11-02 12:06 | Vojtech Cihak | Status | feedback => assigned |
2013-11-22 00:56 | Vojtech Cihak | Note Added: 0071474 | |
2013-11-22 00:56 | Vojtech Cihak | File Added: comctrls1.diff | |
2013-11-22 00:57 | Vojtech Cihak | File Added: coolbar1.diff | |
2013-11-22 00:57 | Vojtech Cihak | File Added: coolbar1.inc | |
2014-04-26 13:15 | Vojtech Cihak | File Added: comctrls2.diff | |
2014-04-26 13:15 | Vojtech Cihak | File Added: coolbar2.diff | |
2014-04-26 13:18 | Vojtech Cihak | Note Added: 0074595 | |
2014-04-26 14:55 | Juha Manninen | Note Added: 0074599 | |
2014-04-26 16:45 | Juha Manninen | Fixed in Revision | => r44812 |
2014-04-26 16:45 | Juha Manninen | Note Added: 0074606 | |
2014-04-26 16:45 | Juha Manninen | Status | assigned => resolved |
2014-04-26 16:45 | Juha Manninen | Resolution | open => fixed |
2014-04-26 17:04 | Vojtech Cihak | Note Added: 0074609 | |
2014-04-27 04:51 | Derit Agustin | Note Added: 0074613 | |
2014-04-27 13:45 | Juha Manninen | Note Added: 0074615 | |
2014-04-27 14:12 | Vojtech Cihak | Note Added: 0074618 | |
2014-04-27 14:12 | Vojtech Cihak | Status | resolved => closed |