Fix TRibbon Bug - نسخة قابلة للطباعة

PHP كود :
unit RibbonFix;
{ Fix Bug when you change Ribbon Style }

interface

uses

{$IF CompilerVersion >= 23}
  WinApi.Messages, Vcl.Ribbon,
  Vcl.RibbonStyleActnCtrls,
  Vcl.RibbonLunaStyleActnCtrls;
{$ELSE}
  Messages, Ribbon, RibbonStyleActnCtrls,
  RibbonLunaStyleActnCtrls;
{$IFEND}

type
  TRibbon = class(Vcl.Ribbon.TRibbon)
  private

    FCurrentStyle: TRibbonStyleActionBars;
    function GetStyle: TRibbonStyleActionBars;
    procedure SetStyle(const Value: TRibbonStyleActionBars);

  published
    property Style: TRibbonStyleActionBars read GetStyle write SetStyle;

  end;

implementation

{ --------> By SMP3 <----------- }

function TRibbon.GetStyle: TRibbonStyleActionBars;
begin
  if (ActionManager <> nil) and (ActionManager.Style is TRibbonStyleActionBars)
  then
    begin
      Result := TRibbonStyleActionBars(ActionManager.Style);
    end
  else
    begin
      Result := RibbonLunaStyle;
      SetStyle(Result);
    end;
  if FCurrentStyle <> Result then
    Invalidate;
  FCurrentStyle := Result;
end;

procedure TRibbon.SetStyle(const Value: TRibbonStyleActionBars);
var
  i: integer;
begin
  if ActionManager <> nil then
    begin
      if (Value = nil) or not(Value is TRibbonStyleActionBars) then
        ActionManager.Style := RibbonLunaStyle
      else
        ActionManager.Style := Value;
      // Force the recreation of the correct colormap for the selected style
      // SetColorMap(nil);
      ColorMap := nil;
      Invalidate;
      DoGroupStyleChanged;
      Parent.Perform(WM_NCPAINT, 0, 0);

      for i := 0 to Tabs.Count - 1 do
        Tabs.Items[i].Page.Refresh; { Refresh All Pages }

    end;

end;

end.