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.
Delphi 自制Office风格按键
最新推荐文章于 2023-05-20 03:00:32 发布