Delphi 自制Office风格按键

unit MyOfficeButton;

interface

uses
  SysUtils, Classes, Controls,Ribbon,RibbonActnCtrls,RibbonStyleActnCtrls,forms,Windows,Math,
    Dialogs,Graphics,ActnMan,ActnMenus,Messages;
type
  TMyOfficeButton = class(TOffice2007Button)
  private
    FCaptionHeight: Integer;
     FDefaultColorMap: TCustomActionBarColorMap;
      FColorMap: TCustomActionBarColorMap;
    FActionManager: TCustomActionManager;
    FActive: Boolean;
    procedure SetColorMap(const Value: TCustomActionBarColorMap);
    function GetColorMap: TCustomActionBarColorMap;
    function SetupDefaultColorMap: TCustomActionBarColorMap;
    procedure SetActionManager(const Value: TCustomActionManager);
    procedure SetActive(const Value: Boolean);


    { Private declarations }
        type
      TSystemMenuButton = (smbNone, smbMinimize, smbRestore, smbHelp, smbClose);
  protected
    { Protected declarations }
      FSystemMenuButton : TSystemMenuButton;
    procedure DrawBackground; override;
    procedure DrawCaption; virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); reintroduce;
    property ColorMap: TCustomActionBarColorMap read GetColorMap write SetColorMap;
     property ActionManager: TCustomActionManager read FActionManager write SetActionManager;
    property Active: Boolean read FActive write SetActive default true;
  published
    { Published declarations }
    procedure DoClick;
    property OnClick ;
    property font;
    property Caption;
            // Font used to draw the Ribbon Caption

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TMyOfficeButton]);
end;

{ TMyOfficeButton }

constructor TMyOfficeButton.Create(AOwner: TComponent);
begin
 inherited

  Create(AOwner);
   Active:=true;
  SetDesignVisible(False);

end;

procedure TMyOfficeButton.DoClick;
begin
  inherited;
end;

procedure TMyOfficeButton.DrawBackground;
begin
  inherited;
 if MouseInControl then
  begin
    if IsLeftMouseButtonPressed(Self) then
     //RibbonStyle.DrawElement(sfButtonPressed, Canvas, ClientRect, -1)
    else
      //RibbonStyle.DrawElement(sfButtonHover, Canvas, ClientRect,-1);
  end
  else
  RibbonStyle.DrawElement(sfButtonPressed, Canvas, ClientRect, -1);

  DrawCaption;
end;



procedure TMyOfficeButton.DrawCaption;
const
  TextFlags: Cardinal = DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
  CaptionFmt: array [Boolean] of string = ('%s', ' - %s');

  procedure CalcWidth(var CaptionWidth: Integer); overload;   //计算字符串宽度
  var
    LCalcRect: TRect;
  begin
    LCalcRect := Rect(0,0,0,0);
    Canvas.Font := Screen.CaptionFont;
    DrawText(Canvas.Handle,Caption,
      -1, LCalcRect, TextFlags or DT_CALCRECT);
    CaptionWidth := LCalcRect.Right;
  end;

  procedure FixRect(var Rect: TRect; TextWidth: Integer);  //重新定义定符串显示的坐标
  begin

      //Adjust Rect to find Center
      if ((ClientWidth + TextWidth) div 2 < Rect.Right) and
         ((ClientWidth - TextWidth) div 2 > Rect.Left) then
      begin
        Rect.Left := (ClientWidth - TextWidth) div 2;
      end
     // else if TextWidth <= RectWidth(Rect) then
     //   Inc(Rect.Left, (RectWidth(Rect)-TextWidth) div 2);
  end;
var
 LRect:TRect;
 LCaptionWidth:integer;
begin
     LRect := Rect(0,0, ClientWidth, ClientHeight);
     CalcWidth(LCaptionWidth) ;
      FixRect(LRect,LCaptionWidth) ;
     Canvas.Brush.Style:=bsClear;
     Canvas.Font := Screen.CaptionFont;
    // if Active then
       canvas.Font.Color :=TCustomRibbonColorMap(ColorMap).DocumentFontColor;
     //   else
      //  canvas.Font.Color :=ColorMap.DisabledFontColor;//
     DrawText(canvas.Handle,Caption,-1, LRect, DT_LEFT or TextFlags or DT_END_ELLIPSIS);
end;



procedure TMyOfficeButton.SetActionManager(const Value: TCustomActionManager);
var
  I: Integer;
begin
  if FActionManager <> Value then
  begin
    FActionManager := Value;
    if Value <> nil then
      FActionManager.FreeNotification(Value);
  end;
end;

procedure TMyOfficeButton.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    Invalidate ;
  end;
end;

procedure TMyOfficeButton.SetColorMap(const Value: TCustomActionBarColorMap);
var
  I: Integer;
  J: Integer;
  LPage: TCustomRibbonPage;
begin
  FreeAndNil(FDefaultColorMap);
  FColorMap := Value;
  if Value <> nil then
    Value.FreeNotification(Self)
  else
    FColorMap := FDefaultColorMap;
end;

function TMyOfficeButton.GetColorMap: TCustomActionBarColorMap;
begin
  if FColorMap = nil then
  begin
    // Setup default
    SetupDefaultColorMap;
    FColorMap := FDefaultColorMap;
  end;
  Result := FColorMap;
end;

function TMyOfficeButton.SetupDefaultColorMap: TCustomActionBarColorMap;
var
  LColorMapClass: TCustomColorMapClass;
begin
  FreeAndNil(FDefaultColorMap);
  if ActionManager = nil then
    LColorMapClass := TRibbonLunaColorMap
  else
    LColorMapClass := (ActionManager.Style as TActionBarStyleEx).GetColorMapClass(nil);
  if LColorMapClass = nil then
    LColorMapClass := TRibbonLunaColorMap;
  FDefaultColorMap := LColorMapClass.Create(Self);
  FDefaultColorMap.Name := 'DefaultColorMap'; // do not localise
  FDefaultColorMap.SetSubComponent(True);
  Result := FDefaultColorMap;
end;


end.