Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

TRibbon Tab Disable

Tags:

delphi

ribbon

When I set a RibbonPage to false, I need the tab at the top to be disabled also. It must be grayed out and the user must not be able to navigate to it. I was able to it with a PageControl, but I cannot find a way to do it with a RibbonPage.

The image below shows my page control with a disabled page. I need to do the same with a Ribbon page.

pagecontrol with disabled page

So after a lot of struggling I finally got my answer. I'll post my code just in case someone have the same issue. I created my a new ribbon that inherits from TCustomRibbon. Through this I am able to get to the canvas of the TRibbon. Finally I copied the code from the TCustomRibbon's DrawTab procedure and edited it to draw a tab that looks disabled.

ribboncontrol with disabled page

type
  // Grouped by the element that they below to.
  TSkinRibbon = (srBackground, srBackgroundDisabled, srHeader, srBody,
    srPage, srHelp);

  TMyRibbon = class(TCustomRibbon)
  private
    { Private declarations }
    FTabDataInitialised: Boolean;
    function GetFirstVisibleIndex():Integer;
    function GetLastVisibleIndex():Integer;
    procedure DrawDisabled();



  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    procedure DrawTabDisabled(Index: Integer);
  published
    { Published declarations }
     property ActionManager;
    property ScreenTips;
    property Align default alTop;
    property Anchors;
    property ApplicationMenu;
    property BiDiMode;
    property Caption;
    property DocumentName;
    property Enabled;
    property Font;
    property Height default TCustomRibbon.cRibbonHeight;
    property HideTabs;
    property ParentBiDiMode;
    property ParentFont;
    property QuickAccessToolbar;
    property ShowHelpButton;
    property Style;
    property Tabs;
    // Tab Index must be streamed after the Tabs collection
    property TabIndex;
    property UseCustomFrame;
    property OnHelpButtonClick;
    property OnRecentItemClick;
    property OnTabChange;
    property OnTabVisibleChanged;
  end;



implementation
uses
system.Types, vcl.graphics, Vcl.RibbonActnCtrls, Vcl.RibbonStyleActnCtrls, Winapi.Windows;


{ TMyRibbon }


//procedure TMyRibbon.DrawTab(const Index: Integer);
procedure TMyRibbon.DrawDisabled;
var
I : Integer;
begin
    for I := 0 to tabs.Count-1 do
      if (Tabs[I].Page.Enabled = false) then
        DrawTabDisabled(I);

end;

procedure TMyRibbon.DrawTabDisabled(Index: Integer);
procedure AdjustRect(var Rect: TRect; const ALeft, ATop, ARight, ABottom: Integer); inline;
begin
  Rect := System.Types.Rect(Rect.Left + ALeft, Rect.Top + ATop,
    Rect.Right + ARight, Rect.Bottom + ABottom);
end;
function CenterInRect(ACanvas: TCanvas; const ARect: TRect; const ACaption: string): TPoint;
var
  LTextWidth: Integer;
begin
  LTextWidth := ACanvas.TextWidth(ACaption);
  if LTextWidth > ARect.Right - ARect.Left then
    Result.X := 0
  else
    Result.X := (ARect.Right - ARect.Left) div 2 - (LTextWidth div 2);
  Result.Y := (ARect.Bottom - ARect.Top) div 2 - (ACanvas.TextHeight(ACaption) div 2);
end;
var
  LRect: TRect;
  LPt: TPoint;
  LSeparatorRect: TRect;
  LStyle: TRibbonStyleActionBars;
  LModifyRect: Boolean;
  LTabWidth: Integer;
begin
  if not ValidTab(Index) then
    Exit;
  LStyle := Style;
  LRect := GetTabRect(Index);
  LTabWidth := LRect.Right - LRect.Left;
  begin
    if not Minimized then
      AdjustRect(LRect, -2, 0, 2, -1)
    else
      AdjustRect(LRect, -2, 0, 2, 0);
    LStyle.DrawElement(stNormal, Canvas, LRect);
    if not Minimized then
      AdjustRect(LRect, 2, 0, -2, 1)
    else
      AdjustRect(LRect, 2, 0, -2, 0)
  end;
  Canvas.Brush.Style := bsClear;
  Canvas.Font.Assign(Font);
  Canvas.Font.Size := GetRibbonMetric(rmFontSize);
  if TabIndex = Index then
    Canvas.Font.Color := TCustomRibbonColorMap(ColorMap).ActiveTabFontColor
  else
    Canvas.Font.Color := TCustomRibbonColorMap(ColorMap).InactiveTabFontColor;
  LPt := CenterInRect(Canvas, LRect, Tabs[Index].Caption);
  LRect := Rect(LRect.Left + LPt.X, LRect.Top + LPt.Y, LRect.Right, LRect.Bottom);
  LModifyRect := LTabWidth - 6 - Tabs[Index].MinTabwidth <= 0;
  if LModifyRect then
    AdjustRect(LRect, 4, 0, -4, 0);
  Canvas.Font.Color := clGray;
  DrawText(Canvas.Handle, Tabs[Index].Caption, -1, LRect, DT_LEFT);
  if LModifyRect then
    AdjustRect(LRect, -4, 0, 4, 0);
end;

function TMyRibbon.GetFirstVisibleIndex: Integer;
var I,ind:integer;
begin
    ind := 0;
    for I := 0 to Tabs.Count -1 do
      if (Tabs[I].Visible = true) then
      begin
        ind := I;
        break;
      end;
     Result := ind;
end;

function TMyRibbon.GetLastVisibleIndex: Integer;
var I,ind:integer;
begin
    ind := 0;
    for I := 0 to Tabs.Count -1 do
      if (Tabs[Tabs.Count - 1 - I].Visible = true) then
      begin
        ind := I;
        break;
      end;
     Result := ind;
end;

procedure TMyRibbon.Paint;
begin
  inherited;
  DrawDisabled();
end;

end.
like image 740
Christo Avatar asked Nov 18 '25 13:11

Christo


1 Answers

After ripping the TRibbon control apart I finally found a way to do it. The tabs are actually draw in the Paint event of the Ribbon and not the Paint event of the Tab (Page). I have edited my question and added my source code.

@Whosrdaddy, it might a better user experience to hide the tab, but sometimes one cannot argue with a client.

like image 190
Christo Avatar answered Nov 21 '25 09:11

Christo