{ Copyright (C) <06.06.2021> Many thanks to the members of the German Lazarus Forum! For some improvements see https://www.lazarusforum.de/viewtopic.php?f=29&t=13252 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version with the following modification: As a special exception, the copyright holders of this library give you permission to link this library with independent modules to produce an executable, regardless of the license terms of these independent modules,and to copy and distribute the resulting executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions of the license of that module. An independent module is a module which is not derived from or based on this library. If you modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do not wish to do so, delete this exception statement from your version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. } unit MultiButton; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FPImage, LResources, Controls, Graphics, Dialogs, GraphType, LcLIntf, PropEdits, GraphPropEdits, PtIn, LMessages, IntfGraphics, LCLType, Forms, ImgList, LCLProc; type TMButtonStyle = (mbsRect,mbsRoundRect,mbsCircle,mbsEllipse); type TMBAlignment = (alNW,alN,alNE,alE,alSE,alS,alSW,alW,alRightIn,alLeftIn, alTopIn,alBottomIn,alRightOut,alLeftOut,alTopOut,alBottomOut); //Position MessageButton type TGradientCourse = (gcHorizontal,gcVertical,gcSpreat,gcRadiant); //für Hintergrundfarbe type TClickEvent = procedure(Sender: TObject) of object; type TMouseMoveEvent = procedure(Sender: TObject;Shift: TShiftState; X,Y: Integer) of Object; type TMouseEvent = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of Object; type TMouseEnterLeave = procedure(Sender: TObject) of object; type TNotifyEvent = procedure(Sender: TObject) of object; type TKeyEvent = procedure(Sender: TObject; var Key: Word; Shift: TShiftState) of Object; type TKeyPressEvent = procedure(Sender: TObject; var Key: char) of Object; type TBlSp = (bsEllipse,bsRect,bsRoundRect,bsCircle); TBlendShape = record BlendShape : TBlSp; Rectangle : TRect; Rad : integer; end; type { TMessageButton } TMessageButton = class(TPersistent) private FAlignment : TMBAlignment; FBorderColor : TColor; FBorderWidth : integer; FCalculateAlthoughInvisible: boolean; FCapLeft : integer; FCaption : TCaption; FCapTop : integer; FColorStart : TColor; FColorEnd : TColor; FGradient : TGradientCourse; FHeight : integer; FHoverColor : TColor; FHoverOn : boolean; FImageIndex : TImageIndex; FImageLeft : integer; FImageList : TCustomImageList; FImageListChangeLink: TChangeLink; FImageTop : integer; FImageWidth : integer; FOnClick : TClickEvent; FOnMouseMove : TMouseMoveEvent; FOwner : TCustomControl; FPositionFactor: integer; FPressedColor: TColor; FPressedColorBlVl: byte; FRRRadius : integer; FShowBorder : boolean; FShowPressed: boolean; FStyle : TMButtonStyle; FFont : TFont; FMessageButtonFontColor : TColor; FTextStyle : TTextStyle; FVisible : boolean; FWidth : integer; pressed : boolean; Hotspot : TRect; procedure ImagesChanged(Sender: TObject); procedure SetAlignment(AValue: TMBAlignment); procedure SetBorderColor(AValue: TColor); procedure SetBorderWidth(AValue: integer); procedure SetCalculateAlthoughInvisible(AValue: boolean); procedure SetCapLeft(AValue: integer); procedure SetCaption(AValue: TCaption); procedure SetCapTop(AValue: integer); procedure SetColorStart(AValue: TColor); procedure SetFPressedColorBlVl(AValue: byte); procedure SetColorEnd(AValue: TColor); procedure SetGradient(AValue: TGradientCourse); procedure SetHeight(AValue: integer); procedure SetHoverColor(AValue: TColor); procedure SetHoverOn(AValue: boolean); procedure SetImageIndex(AValue: TImageIndex); procedure SetImageLeft(AValue: integer); procedure SetImageList(AValue: TCustomImageList); procedure SetImageTop(AValue: integer); procedure SetImageWidth(AValue: integer); procedure SetPositionFactor(AValue: integer); procedure SetPressedColor(AValue: TColor); procedure SetRRRadius(AValue: integer); procedure SetShowBorder(AValue: boolean); procedure SetShowPressed(AValue: boolean); procedure SetStyle(AValue: TMButtonStyle); procedure SetFont(AValue: TFont); procedure SetTextStyle(AValue: TTextStyle); procedure SetLayout(AValue: TTextLayout); procedure SetCapAlignment(AValue: TAlignment); procedure SetVisible(AValue: boolean); procedure SetWidth(AValue: integer); protected property RRRadius : integer read FRRRadius write SetRRRadius default 6; public constructor create(aOwner:TCustomControl); property TextStyle: TTextStyle read FTextStyle write SetTextStyle; published //The geometric shape of the button //Die geometrische Form des Buttons property Style : TMButtonStyle read FStyle write SetStyle default mbsRoundRect; //The start color of the button ( for color gradient) //Die Startfarbe des Buttons (für Farbverlauf) property ColorStart : TColor read FColorStart write SetColorStart default clWhite; //The end color of the button ( for color gradient) //Die Endfarbe des Buttons (für Farbverlauf) property ColorEnd : TColor read FColorEnd write SetColorEnd default clSilver; //The direction of the gradient //Die Richtung des Farbverlaufs property ColorGradient : TGradientCourse read FGradient write SetGradient default gcRadiant; //Allows to show or hide the pressedoption //Ermöglicht das Ein- oder Ausblenden der Gedrücktoption property ShowPressed : boolean read FShowPressed write SetShowPressed default true; //The color of the button when it is pressed //Die Farbe des Buttons wenn er gedrückt wird property PressedColor : TColor read FPressedColor write SetPressedColor default clMedGray; //How translucent the pressedcolor is (0=transparent, 255=opaque). //Wie transparent die PressedColor ist (0=transparent, 255=undurchsichtig) property PresdColBlendVal : byte read FPressedColorBlVl write SetFPressedColorBlVl default 120; //The text that the user writes in the button //Der Text den der Benutzer in den Button schreibt property Caption : TCaption read FCaption write SetCaption; //The font to be used for text display in this button. //Die Schrift die für die Textanzeige in diesem Button verwendet werden soll. property Font: TFont read fFont write SetFont; //Alignment of the text in the caption (left, center, right) //Ausrichtung des Textes in der Caption (Links,Mitte,Rechts) property CaptionAlignment:TAlignment read FTextStyle.Alignment write SetCapAlignment default taCenter; //Alignment of the text in the caption (top, center, bottom) //Ausrichtung des Textes in der Caption (Oben,Mitte,Unten) property CaptionLayout:TTextLayout read FTextStyle.Layout write SetLayout default tlCenter; //The horizontal distance of the text in the text rectangle (only effective with taLeftJustify) //Der horizontale Abstand des Textes im Textrechteck (nur wirksam mit taLeftJustify) property CaptionHorMargin : integer read FCapLeft write SetCapLeft default 0; //The vertical distance of the text in the text rectangle (only effective with tlTop) //Der vertikale Abstand des Textes im Textrechteck (nur wirksam mit tlTop) property CaptionVerMargin : integer read FCapTop write SetCapTop default 0; //The Index of a Image in a ImageList //Der Index eines Bildes in einer ImageList //A list for including images //Eine Liste zum Einfügen von Bildern property Images : TCustomImageList read FImageList write SetImageList default nil; property ImageIndex : TImageIndex read FImageIndex write SetImageIndex default -1; //The unique width of all images in the list. //Die einmalige Breite aller Bilder in der Liste. property ImageWidth : integer read FImageWidth write SetImageWidth default 0; //The coordinate of the left edge of a Image //Die Koordinate der linken Ecke des Bildes property ImageLeft : integer read FImageLeft write SetImageLeft default 2; //The coordinate of the top edge of a Image //Die Koordinate der oberen Ecke des Bildes property ImageTop : integer read FImageTop write SetImageTop default 2; //Allows to show or hide the control, and all of its children //Ermöglicht das Ein- oder Ausblenden des Steuerelements und aller seiner untergeordneten Elemente property Visible : boolean read FVisible write SetVisible default false; //The horizontal extent of the control //Die horizontale Ausdehnung des Buttons property Width : integer read FWidth write SetWidth default 30; // The vertical size of the control. //Die vertikale Ausdehnung des Buttons property Height: integer read FHeight write SetHeight default 15; //The position of the Button //Die Position des Buttons property Alignment : TMBAlignment read FAlignment write SetAlignment default alSE; //Allows to show or hide a border //Ermöglicht das Ein- oder Ausblenden eines Rahmens property ShowBorder : boolean read FShowBorder write SetShowBorder default false; //The color of the border //Die Farbe des Rahmens property BorderColor : TColor read FBorderColor write SetBorderColor default clBlack; //The whidth of the border //Die Dicke des Rahmens property BorderWidth : integer read FBorderWidth write SetBorderWidth default 1; //Allows to show or hide a hoverevent //Ermöglicht das Ein- oder Ausblenden eines Hoverereignisses property HoverOn : boolean read FHoverOn write SetHoverOn default true; //The color of a hoverevent //Die Farbe eines Hoverereignisses property HoverColor : TColor read FHoverColor write SetHoverColor default clOlive; //Is required if the MessagButton is only visible at runtime //Wird benötigt wenn der MessagButton erst zur Laufzeit sichtbar wird property CalculateAlthoughInvisible : boolean read FCalculateAlthoughInvisible write SetCalculateAlthoughInvisible default false; //Position factor, only active if alSE,alSW,alNW,alNE,alW,alE,alN,alS //Positionsfaktor, nur aktive wenn alSE,alSW,alNW,alNE,alW,alE,alN,alS property PositionFactor : integer read FPositionFactor write SetPositionFactor default 4; property OnClick : TClickEvent read FOnClick write FOnClick; property OnMouseMove : TMouseMoveEvent read FOnMouseMove write FOnMouseMove; end; type { TMultiButton } TMultiButton = class (TCustomControl) private FAllowsUp : boolean; FBorderColor : TColor; FBorderWidth : integer; FCapLeft : integer; FCaptionWordbreak : boolean; FCapTop : integer; FColorEnd : TColor; FDisabledAlpBV : integer; FDisabledColor : TColor; FDown : boolean; FEnabled : boolean; FFocusColor : TColor; FFocusedOn : boolean; FGradient : TGradientCourse; FFocusAlBlVal : byte; FGRoupIndex : integer; FHoverEndColor : TColor; FHoverFontColor : TColor; FFocusFrameWidth : integer; FHoverImageIndex : TImageIndex; FHoverOn : boolean; FHoverStartColor : TColor; FMessageButton : TMessageButton; FColorStart : TColor; FPressedEnCol : TColor; FPressedFoCol : TColor; FPressedImageIndex: TImageIndex; FPressedStCol : TColor; FShowBorder : boolean; FShowMsgButtonInGroup: boolean; FStyle : TMButtonStyle; FBWidth : integer; FBHeight : integer; FBLeft : integer; FBTop : integer; FImageIndex : TImageIndex; FImageLeft : integer; FImageList : TCustomImageList; FImageTop : integer; FImageWidth : integer; FRRRadius : integer; FCaption : TCaption; FVisible : boolean; Hotspot : TRect; Hover : boolean; MessageHover : boolean; CaptionChange : boolean; pressed : boolean; FFont : TFont; FTextStyle : TTextStyle; FOnClick : TClickEvent; FOnMouseMove : TMouseMoveEvent; FOnMouseDown : TMouseEvent; FOnMouseUp : TMouseEvent; FOnMouseEnter : TMouseEnterLeave; FOnMouseLeave : TMouseEnterLeave; FOnEnter : TNotifyEvent; FOnExit : TNotifyEvent; FOnKeyPress : TKeyPressEvent; FOnKeyDown : TKeyEvent; FOnKeyUp : TKeyEvent; MessagePressedBmp : TBitmap; SC,EC : TColor; FImageListChangeLink: TChangeLink; au : integer; procedure DrawTheButton; procedure DrawABorder; procedure DrawMessageButton; procedure DrawMessageBorder; procedure DrawMessageHover; procedure CalculateDimensions; procedure CheckTheGroup; procedure ImagesChanged(Sender: TObject); procedure SetAllowsUp(AValue: boolean); procedure SetBorderColor(AValue: TColor); procedure SetBorderWidth(AValue: integer); procedure SetCapLeft(AValue: integer); procedure SetCaptionWordbreak(AValue: boolean); procedure SetCapTop(AValue: integer); procedure SetColorEnd(AValue: TColor); procedure SetDisabledAlpBV(AValue: integer); procedure SetDisabledColor(AValue: TColor); procedure SetDown(AValue: boolean); procedure SetFocusColor(AValue: TColor); procedure SetFocusedOn(AValue: boolean); procedure SetGradient(AValue: TGradientCourse); procedure SetFocusAlBlVal(AValue: byte); procedure SetGroupIndex(AValue: integer); procedure SetHoverEndColor(AValue: TColor); procedure SetHoverFontColor(AValue: TColor); procedure SetFocusFrameWidth(AValue: integer); procedure SetHoverImageIndex(AValue: TImageIndex); procedure SetHoverOn(AValue: boolean); procedure SetHoverStartColor(AValue: TColor); procedure SetImageIndex(const aValue: TImageIndex); procedure SetImageLeft(AValue: integer); procedure SetImageList(AValue: TCustomImageList ); procedure SetImageTop(AValue: integer); procedure SetImageWidth(AValue: integer); procedure SetPressedEnCol(AValue: TColor); procedure SetPressedFoCol(AValue: TColor); procedure SetPressedImageIndex(AValue: TImageIndex); procedure SetPressedStCol(AValue: TColor); procedure SetRRRadius(AValue: integer); procedure SetShowBorder(AValue: boolean); procedure SetShowMsgButtonInGroup(AValue: boolean); procedure SetStyle(AValue: TMButtonStyle); procedure SetMessageButton(AValue: TMessageButton); procedure SetFont(AValue: TFont); procedure SetAlignment(AValue: TAlignment); procedure SetLayout(AValue: TTextLayout); procedure SetTextStyle(AValue: TTextStyle); procedure FontPropertyChanged(Sender:TObject); procedure MessageFontPropertyChanged(Sender:TObject); procedure SetCaption(AValue: TCaption); procedure SetVisible(aValue: boolean);reintroduce; procedure SetEnabled(aValue: boolean);reintroduce; protected procedure SetColorStart(aColor: TColor);//reintroduce; procedure BoundsChanged;override; procedure KeyPress(var Key: char);override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyUp(var Key: Word; Shift: TShiftState); override; procedure CNKeyDown (var Message: TLMKeyDown); message CN_KEYDOWN; procedure DoExit; override; procedure DoEnter; override; procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double);override; procedure Notification(AComponent: TComponent;Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Paint; override; procedure Loaded; override; procedure MouseEnter; override; procedure MouseLeave; override; procedure MouseMove({%H-}Shift: TShiftState; X, Y: Integer);override; procedure MouseDown({%H-}Button: TMouseButton;{%H-}Shift: TShiftState; X, Y: Integer);override; procedure MouseUp({%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);override; property TextStyle: TTextStyle read FTextStyle write SetTextStyle; property DisabledColor : TColor read FDisabledColor write SetDisabledColor; property DisabledAlphaBValue : integer read FDisabledAlpBV write SetDisabledAlpBV; published //The Index of a Image in a ImageList //Der Index eines Bildes in einer ImageList property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; //A list for including images //Eine Liste zum Einfügen von Bildern property Images : TCustomImageList read FImageList write SetImageList default nil; //The unique width of all images in the list. //Die einmalige Breite aller Bilder in der Liste. property ImageWidth : integer read FImageWidth write SetImageWidth default 0; //The coordinate of the left edge of a Image //Die Koordinate der linken Ecke des Bildes property ImageLeft : integer read FImageLeft write SetImageLeft default 2; //The coordinate of the top edge of a Image //Die Koordinate der oberen Ecke des Bildes property ImageTop : integer read FImageTop write SetImageTop default 2; //The geometric shape of the button //Die geometrische Form des Buttons property Style : TMButtonStyle read FStyle write SetStyle default mbsRoundRect; //The start color of the button ( for color gradient) //Die Startfarbe des Buttons (für Farbverlauf) property ColorStart : TColor read FColorStart write SetColorStart default clGray; //The end color of the button ( for color gradient) //Die Endfarbe des Buttons (für Farbverlauf) property ColorEnd : TColor read FColorEnd write SetColorEnd default clSilver; //The direction of the gradient //Die Richtung des Farbverlaufs property ColorGradient : TGradientCourse read FGradient write SetGradient default gcSpreat; //Corner diameter if the geometric shape is RoundRect //Eckendurchmesser wenn geometrische Form ist RoundRect property RndRctRadius : integer read FRRRadius write SetRRRadius default 10; //A message button to display information or to provide a second integrated button //Ein Message Button um Infos anzuzeigen bzw. um einen zweiten integrierten Button bereit zustellen property MessageButton : TMessageButton read FMessageButton write SetMessageButton; //The text that the user writes in the button //Der Text den der Benutzer in den Button schreibt property Caption : TCaption read FCaption write SetCaption; //The font to be used for text display in this button. //Die Schrift die für die Textanzeige in diesem Button verwendet werden soll. property Font: TFont read FFont write SetFont; //Alignment of the text in the caption (left, center, right) //Ausrichtung des Textes in der Caption (Links,Mitte,Rechts) property CaptionAlignment:TAlignment read FTextStyle.Alignment write SetAlignment default taCenter; //Alignment of the text in the caption (top, center, bottom) //Ausrichtung des Textes in der Caption (Oben,Mitte,Unten) property CaptionLayout:TTextLayout read FTextStyle.Layout write SetLayout default tlCenter; //Allows a line break in the caption //Ermöglicht einen Zeilenumbruch in der Caption property CaptionWordbreak : boolean read FCaptionWordbreak write SetCaptionWordbreak default true; //The horizontal distance of the text in the text rectangle (only effective with taLeftJustify) //Der horizontale Abstand des Textes im Textrechteck (nur wirksam mit taLeftJustify) property CaptionHorMargin : integer read FCapLeft write SetCapLeft default 0; //The vertical distance of the text in the text rectangle (only effective with tlTop) //Der vertikale Abstand des Textes im Textrechteck (nur wirksam mit tlTop) property CaptionVerMargin : integer read FCapTop write SetCapTop default 0; //Allows to show or hide the control, and all of its children //Ermöglicht das Ein- oder Ausblenden des Steuerelements und aller seiner untergeordneten Elemente property Visible : boolean read FVisible write SetVisible default true; //Allows to show or hide a border //Ermöglicht das Ein- oder Ausblenden eines Rahmens property ShowBorder : boolean read FShowBorder write SetShowBorder default false; //The color of the border //Die Farbe des Rahmens property BorderColor : TColor read FBorderColor write SetBorderColor default clBlack; //The whidth of the border //Die Dicke des Rahmens property BorderWidth : integer read FBorderWidth write SetBorderWidth default 1; //Allows to show or hide a hoverevent //Ermöglicht das Ein- oder Ausblenden eines Hoverereignisses property HoverOn : boolean read FHoverOn write SetHoverOn default true; //The startcolor of a hoverevent //Die Startfarbe eines Hoverereignisses property HoverStartColor : TColor read FHoverStartColor write SetHoverStartColor default clSilver; //The endcolor of a hoverevent //Die Endfarbe eines Hoverereignisses property HoverEndColor : TColor read FHoverEndColor write SetHoverEndColor default clSilver; //The color of the Caption during one hoverevent //Die Farbe der Caption während eines Hoverereignisses property HoverFontColor :TColor read FHoverFontColor write SetHoverFontColor default clOlive; //The Index of a Image in a ImageList when during one hoverevent //Der Index eines Bildes in einer ImageList während eines Hoverereignisses property HoverImageIndex : TImageIndex read FHoverImageIndex write SetHoverImageIndex default -1; //The whidth of the focus-frame //Die Dicke des Fokus-Rahmens property FocusFrameWidth : integer read FFocusFrameWidth write SetFocusFrameWidth default 5; //How translucent the hover is (0=transparent, 255=opaque). //Wie transparent der Hover ist (0=transparent, 255=undurchsichtig). property FocusAlphaBValue : byte read FFocusAlBlVal write SetFocusAlBlVal default 125; //Determines whether the control reacts on mouse or keyboard input. //Legt fest, ob das Steuerelement auf Maus- oder Tastatureingaben reagiert. property Enabled : boolean read FEnabled write SetEnabled default true; //The starting color of the button when it is pressed (for color gradient) //Die Startfarbe des Buttons wenn er gedrückt wird (für Farbverlauf) property PressedStartColor : TColor read FPressedStCol write SetPressedStCol default $505050; //The end color of the button when it is pressed (for color gradient) //Die Endfarbe des Buttons wenn er gedrückt wird (für Farbverlauf) property PressedEndColor : TColor read FPressedEnCol write SetPressedEnCol default $969696; //The color of the text of the caption when the button is pressed //Die Farbe des Textes der Caption wenn der Button gedrückt wird property PressedFontColor : TColor read FPressedFoCol write SetPressedFoCol default clWhite; //The Index of a Image in a ImageList when the Button is pressed //Der Index eines Bildes in einer ImageList wenn der Button gedrückt ist property PressedImageIndex : TImageIndex read FPressedImageIndex write SetPressedImageIndex default -1; //The color of the Fokusframe when the Control has the focus //Die Farbe des Fokusrahmens wenn das Control den Fokus hat property FocusColor : TColor read FFocusColor write SetFocusColor default clOlive; //Allows the control to maintain focus //Ermöglicht dem Control den Fokus zuerhalten property FocusedOn : boolean read FFocusedOn write SetFocusedOn default true; //The Button has been set in the Down state //Der Button bleibt gedrückt property Down : boolean read FDown write SetDown default false; //Allows a pressed button to be set to not pressed //Erlaubt eine gedrückte Schaltfäche auf nicht gedrückt zu setzen property AllowsUp : boolean read FAllowsUp write SetAllowsUp default false; //The Index within the group of MultiButtons //Der Index der Gruppe zu der der MultiButton gehört property GroupIndex : integer read FGRoupIndex write SetGroupIndex default 0; //Shows the message button on the MultiButton in a group //Zeigt den Message Button auf einem MultiButton in einer Gruppe property ShowMsgButtonInGroup : boolean read FShowMsgButtonInGroup write SetShowMsgButtonInGroup default false; //When True, the Hint text is shown when the mouse hovers over the control //Wenn True, wird der Hinweistext angezeigt, wenn sich die Maus über dem Steuerelement befindet property ShowHint; //Allows the user to navigate to this control, by pressing the Tab key //Ermöglicht dem Benutzer das Navigieren zu diesem Steuerelement durch Drücken der Tabulatortaste property TabStop default TRUE; //A context-sensitive menu that pops up when the right mouse button is clicked over this control //Ein Menü das angezeigt wird, wenn Sie mit der rechten Maustaste auf dieses Steuerelement klicken property PopupMenu; //The vertical size of the control.The height of the MultiButton is minus HoverFrameWidth //Die Höhe des Controls. Die Höhe des MultiButtons ist minus HoverFrameWidth property Height; //The horizontal size of the control.The width of the MultiButton is minus HoverFrameWidth //Die Breite des Controls. Die Breite des MultiButtons ist minus HoverFrameWidth property Width; property OnClick : TClickEvent read FOnClick write FOnClick; property OnMouseMove : TMouseMoveEvent read FOnMouseMove write FOnMouseMove; property OnMouseDown : TMouseEvent read FOnMouseDown write FOnMouseDown; property OnMouseUp : TMouseEvent read FOnMouseUp write FOnMouseUp; property OnMouseEnter : TMouseEnterLeave read FOnMouseEnter write FOnMouseEnter; property OnMouseLeave : TMouseEnterLeave read FOnMouseLeave write FOnMouseLeave; property OnEnter : TNotifyEvent read FOnEnter write FOnEnter; property OnExit : TNotifyEvent read FOnExit write FOnExit; property OnKeyPress :TKeyPressEvent read FOnKeyPress write FOnKeyPress; property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp; property DragMode; property DragKind; property DragCursor; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnStartDrag; property Align; property Anchors; property Action; property BidiMode; property BorderSpacing; property Constraints; property HelpType; property TabOrder; end; procedure Register; implementation {xxxxxxxxxxxxxxxxx TImageIndexPropertyEditor xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx} type TMultiButtonImageIndexPropertyEditor = class(TImageIndexPropertyEditor) protected function GetImageList: TCustomImageList; override; end; function TMultiButtonImageIndexPropertyEditor.GetImageList: TCustomImagelist; begin Result := TMultiButton(GetComponent(0)).Images; end; type TMessageButtonImageIndexPropertyEditor = class(TImageIndexPropertyEditor) protected function GetImageList: TCustomImageList; override; end; function TMessageButtonImageIndexPropertyEditor.GetImageList: TCustomImagelist; begin Result := TMessageButton(GetComponent(0)).Images; end; procedure Register; begin {$I multibutton_icon.lrs} RegisterComponents('Standard',[TMultiButton]); RegisterPropertyEditor(TypeInfo(TImageIndex), TMultiButton, 'ImageIndex', TMultiButtonImageIndexPropertyEditor); RegisterPropertyEditor(TypeInfo(TImageIndex), TMultiButton, 'PressedImageIndex', TMultiButtonImageIndexPropertyEditor); RegisterPropertyEditor(TypeInfo(TImageIndex), TMultiButton, 'HoverImageIndex', TMultiButtonImageIndexPropertyEditor); RegisterPropertyEditor(TypeInfo(TImageIndex), TMessageButton, 'ImageIndex', TMessageButtonImageIndexPropertyEditor); end; procedure AlphaBlende(var AlBlBmp:TBitmap;BlendVal:byte;aBlendShape:TBlendShape); var dest, trBmp, mask, bmp : TBitmap; Image1 : TLazIntfImage; Image2 : TLazIntfImage; valR,valG,valB : byte; x,y : integer; P : TPoint; begin try trBmp := TBitmap.Create; trBmp.SetSize(AlBlBmp.Width,AlBlBmp.Height); trBmp.TransparentColor:= clblack; trBmp.Transparent:= true; trBmp.Canvas.Brush.Color:=clwhite; trBmp.Canvas.FillRect(0,0,trBmp.Width,trBmp.Height); trBmp.Canvas.Pen.Color:=clblack; trBmp.Canvas.Brush.Color:=clblack; case aBlendShape.BlendShape of bsRoundRect : trBmp.Canvas.RoundRect(aBlendShape.Rectangle,aBlendShape.Rad,aBlendShape.Rad); bsRect : trBmp.Canvas.Rectangle(aBlendShape.Rectangle); bsEllipse : trBmp.Canvas.Ellipse(aBlendShape.Rectangle); bsCircle : trBmp.Canvas.Ellipse(aBlendShape.Rectangle); end; mask := TBitmap.Create; mask.SetSize(AlBlBmp.Width,AlBlBmp.Height); mask.Canvas.Brush.Color:=clwhite; mask.Canvas.FillRect(0,0,mask.Width,mask.Height); mask.Canvas.Brush.Color:=clblack; case aBlendShape.BlendShape of bsRoundRect : mask.Canvas.RoundRect(aBlendShape.Rectangle,aBlendShape.Rad,aBlendShape.Rad); bsRect : mask.Canvas.Rectangle(aBlendShape.Rectangle); bsEllipse : mask.Canvas.Ellipse(aBlendShape.Rectangle); bsCircle : mask.Canvas.Ellipse(aBlendShape.Rectangle); end; dest := TBitmap.Create; dest.SetSize(AlBlBmp.Width,AlBlBmp.Height); Dest.Canvas.copymode:=cmSrcCopy; Dest.Assign(alblbmp); Dest.Canvas.Draw(0,0,trBmp); Dest.Canvas.copymode:=cmSrcInvert; Dest.Canvas.Draw(0,0,mask); Bmp := TBitmap.Create; Bmp.Assign(Dest); Image1:= Bmp.CreateIntfImage; Image2:= TLazIntfImage.Create(0,0, [riqfRGB, riqfAlpha]); Image2.SetSize(Bmp.Width,Bmp.Height); for y := 0 to Image1.height - 1 do begin for x := 0 to Image1.width - 1 do begin P.X:=x;P.Y:=y; valR:= PRGBQUAD(Image1.GetDataLineStart(P.Y))[P.X].rgbRed; valG:= PRGBQuad(Image1.GetDataLineStart(P.Y))[P.X].rgbGreen; valB:= PRGBQuad(Image1.GetDataLineStart(P.Y))[P.X].rgbBlue; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbRed := valR; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbGreen := valG; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbBlue := valB; if (valB+valG+valR) <> 0 then PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbReserved:=BlendVal else PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbReserved:=0; end;//for x end;//for y AlBlBmp.LoadFromIntfImage(Image2); finally Image1.Free; Image2.Free; Bmp.Free; trBmp.Free; mask.Free; dest.Free; end; end; procedure GradientBmp(var aBmp: TBitmap; aStart, AStop: TColor; aCourse: TGradientCourse); var lv:integer; StartR,StartG,StartB : integer; StopR,StopG,StopB : integer; delR,delG,delB : integer; fR,fG,fb : double; valR,valG,valB : integer; greater,radius: integer; function System_ToRGB(clSys:TColor):TColor; var FPCol : TFPColor; begin FPCol:=TColorToFPColor(ColorToRGB(clSys)); result :=FPColorToTColor(FPCol); end; begin aStart:=System_ToRGB(aStart); aStop:=System_ToRGB(aStop); if aStart=clBlack then aStart:=rgb(1,0,0); if aStop=clBlack then aStop:=rgb(1,0,0); StartR:=getRvalue(aStart); StartG:=getGvalue(aStart); StartB:=getBvalue(aStart); StopR:=getRvalue(aStop); StopG:=getGvalue(aStop); StopB:=getBvalue(aStop); delR:= StartR-StopR; delG:= StartG-StopG; delB:= StartB-StopB; if aCourse = gcSpreat then begin if aBmp.Height >= aBmp.Width then greater := round(aBmp.Height/2) else greater := round(aBmp.Width/2); radius:= round(sqrt(sqr((aBmp.Width/2))+sqr((aBmp.Height/2)))); fR := delR /radius; fG := delG /radius; fB := delB /radius; for Lv:=radius downto 0 do begin valR:= StopR+round(lv*fR); valG:= StopG+round(lv*fG); valB:= StopB+round(lv*fB); if valR <0 then valR:=0; if valG <0 then valG:=0; if valB <0 then valB:=0; if valR >255 then valR:=255; if valG >255 then valG:=255; if valB >255 then valB:=255; aBmp.Canvas.Brush.Color:=rgb(valR,valG,valB); aBmp.Canvas.Pen.Color:=rgb(valR,valG,valB); aBmp.Canvas.Ellipse((aBmp.width div 2) -lv,(aBmp.height div 2)-lv, (aBmp.width div 2)+lv,(aBmp.height div 2)+lv); end; end; //gcSpreat if aCourse = gcRadiant then begin if aBmp.Height >= aBmp.Width then greater := round(aBmp.Height/2) else greater := round(aBmp.Width/2); fR := delR /greater; fG := delG /greater; fB := delB /greater; for Lv:=greater downto 0 do begin valR:= StartR-round(lv*fR); valG:= StartG-round(lv*fG); valB:= StartB-round(lv*fB); if valR <0 then valR:=0; if valG <0 then valG:=0; if valB <0 then valB:=0; if valR >255 then valR:=255; if valG >255 then valG:=255; if valB >255 then valB:=255; aBmp.Canvas.Brush.Color:=rgb(valR,valG,valB); aBmp.Canvas.FillRect((aBmp.width div 2) -lv,(aBmp.height div 2)-lv, (aBmp.width div 2)+lv,(aBmp.height div 2)+lv); end; end; //gcRadiant if aCourse = gcVertical then begin fR := delR /aBmp.Height; fG := delG /aBmp.Height; fB := delB /aBmp.Height; for Lv:=0 to aBmp.Height do begin valR:= StartR-round(lv*fR); valG:= StartG-round(lv*fG); valB:= StartB-round(lv*fB); if valR <0 then valR:=0; if valG <0 then valG:=0; if valB <0 then valB:=0; if valR >255 then valR:=255; if valG >255 then valG:=255; if valB >255 then valB:=255; aBmp.Canvas.Brush.Color:=rgb(valR,valG,valB); aBmp.Canvas.FillRect(0,lv,aBmp.Width,lv+1); end; end;//gcVertical if aCourse = gcHorizontal then begin fR := delR /aBmp.Width; fG := delG /aBmp.Width; fB := delB /aBmp.Width; for Lv:=0 to aBmp.Width do begin valR:= StartR-round(lv*fR); valG:= StartG-round(lv*fG); valB:= StartB-round(lv*fB); if valR <0 then valR:=0; if valG <0 then valG:=0; if valB <0 then valB:=0; if valR >255 then valR:=255; if valG >255 then valG:=255; if valB >255 then valB:=255; aBmp.Canvas.Brush.Color:=rgb(valR,valG,valB); aBmp.Canvas.FillRect(lv,0,lv+1,aBmp.Height); end; end;//gcHorizontal end; procedure BmpToAlphaBmp(var AlphaBmp :TBitmap;BlendValue : byte); var Image1 : TLazIntfImage; Image2 : TLazIntfImage; Bmp : TBitmap; valR,valG,valB,valTmp : byte; x,y : integer; P : TPoint; begin try // für Windows muss AlphaBmp.PixelFormat:=pf32bit gesetzt werden! Bmp := TBitmap.Create; Bmp.Assign(AlphaBmp); Image1:= Bmp.CreateIntfImage; Image2:= TLazIntfImage.Create(0,0, [riqfRGB, riqfAlpha]); Image2.SetSize(Bmp.Width,Bmp.Height); {$IFDEF LINUX} for y := 0 to Image1.height - 1 do begin for x := 0 to Image1.width - 1 do begin P.X:=x;P.Y:=y; valR:= PRGBQUAD(Image1.GetDataLineStart(P.Y))[P.X].rgbRed; valG:= PRGBQuad(Image1.GetDataLineStart(P.Y))[P.X].rgbGreen; valB:= PRGBQuad(Image1.GetDataLineStart(P.Y))[P.X].rgbBlue; {$IFDEF LCLQt5 or LCLQt} valTmp := valR; valR := valB; valB := valTmp; {$ENDIF} PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbRed := valB; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbGreen := valG; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbBlue := valR; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbReserved:=BlendValue; end;//for x end;//for y AlphaBmp.LoadFromIntfImage(Image2); {$ENDIF} {$IFDEF WINDOWS} if BlendValue = 0 then BlendValue:=1; //oder Bmp auf Transparenz setzen for y := 0 to Image1.height - 1 do begin for x := 0 to Image1.width - 1 do begin P.X:=x;P.Y:=y; valR:= PRGBQuad(Image1.GetDataLineStart(P.Y))[P.X].rgbRed; valG:= PRGBQuad(Image1.GetDataLineStart(P.Y))[P.X].rgbGreen; valB:= PRGBQuad(Image1.GetDataLineStart(P.Y))[P.X].rgbBlue; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbRed := valR; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbGreen := valG; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbBlue := valB; PRGBQuad(Image2.GetDataLineStart(P.Y))[P.X].rgbReserved:= BlendValue; end;//for x end;//for y AlphaBmp.LoadFromIntfImage(Image2); {$ENDIF} finally Image1.Free; Image2.Free; Bmp.Free; end; end; //XXXXXXXXXXXXXXXXXXXXXX--- MESSAGEBUTTON ---XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX { TMessageButton } constructor TMessageButton.create(aOwner: TCustomControl); begin FOwner:=aOwner; inherited create; end; procedure TMessageButton.SetColorStart(AValue: TColor); begin if FColorStart=AValue then Exit; FColorStart:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetFPressedColorBlVl(AValue: byte); begin if FPressedColorBlVl=AValue then Exit; FPressedColorBlVl:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetColorEnd(AValue: TColor); begin if FColorEnd=AValue then Exit; FColorEnd:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetGradient(AValue: TGradientCourse); begin if FGradient=AValue then Exit; FGradient:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.ImagesChanged(Sender: TObject); begin if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetAlignment(AValue: TMBAlignment); begin if FAlignment=AValue then Exit; FAlignment:=AValue; (FOwner as TMultiButton).CalculateDimensions; end; procedure TMessageButton.SetBorderColor(AValue: TColor); begin if FBorderColor=AValue then Exit; FBorderColor:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetBorderWidth(AValue: integer); begin if FBorderWidth=AValue then Exit; FBorderWidth:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetCalculateAlthoughInvisible(AValue: boolean); begin if FCalculateAlthoughInvisible=AValue then Exit; FCalculateAlthoughInvisible:=AValue; (FOwner as TMultiButton).CalculateDimensions; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetFont(AValue: TFont); begin if fFont=AValue then Exit; fFont.Assign(aValue); //nicht := !!! FMessageButtonFontColor := aValue.Color; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetTextStyle(AValue: TTextStyle); begin //if FTextStyle=AValue then Exit; muss auskommentiert werden! FTextStyle:=AValue; end; procedure TMessageButton.SetLayout(AValue: TTextLayout); begin if fTextStyle.Layout=AValue then exit; fTextStyle.Layout:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetCapAlignment(AValue: TAlignment); begin if fTextStyle.Alignment=AValue then exit; fTextStyle.Alignment:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetCapLeft(AValue: integer); begin if FCapLeft=AValue then Exit; FCapLeft:=AValue; (FOwner as TMultiButton).CalculateDimensions; end; procedure TMessageButton.SetCaption(AValue: TCaption); begin if FCaption=AValue then Exit; FCaption:=AValue; (FOwner as TMultiButton).CalculateDimensions; end; procedure TMessageButton.SetCapTop(AValue: integer); begin if FCapTop=AValue then Exit; FCapTop:=AValue; (FOwner as TMultiButton).CalculateDimensions; end; procedure TMessageButton.SetHeight(AValue: integer); begin if FHeight=AValue then Exit; if aValue< 1 then exit; FHeight:=AValue; (FOwner as TMultiButton).CalculateDimensions; end; procedure TMessageButton.SetHoverColor(AValue: TColor); begin if FHoverColor=AValue then Exit; FHoverColor:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetHoverOn(AValue: boolean); begin if FHoverOn=AValue then Exit; FHoverOn:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetImageIndex(AValue: TImageIndex); begin if FImageIndex=AValue then Exit; FImageIndex:=AValue; ImagesChanged(nil); end; procedure TMessageButton.SetImageLeft(AValue: integer); begin if FImageLeft=AValue then Exit; FImageLeft:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetImageList(AValue: TCustomImageList); begin if FImageList = AValue then Exit; if FImageList <> nil then begin FImageList.UnRegisterChanges(FImageListChangeLink); end; FImageList := AValue; if FImageList <> nil then begin FImageList.RegisterChanges(FImageListChangeLink); end; ImagesChanged(Self); end; procedure TMessageButton.SetImageTop(AValue: integer); begin if FImageTop=AValue then Exit; FImageTop:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetImageWidth(AValue: integer); begin if FImageWidth=AValue then Exit; FImageWidth:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetPositionFactor(AValue: integer); begin if FPositionFactor=AValue then Exit; FPositionFactor:=AValue; (FOwner as TMultiButton).CalculateDimensions; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetPressedColor(AValue: TColor); begin if FPressedColor=AValue then Exit; FPressedColor:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetRRRadius(AValue: integer); begin if FRRRadius=AValue then Exit; FRRRadius:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetShowBorder(AValue: boolean); begin if FShowBorder=AValue then Exit; FShowBorder:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetShowPressed(AValue: boolean); begin if FShowPressed=AValue then Exit; FShowPressed:=AValue; end; procedure TMessageButton.SetStyle(AValue: TMButtonStyle); begin if FStyle=AValue then Exit; FStyle:=AValue; (FOwner as TMultiButton).CalculateDimensions; end; procedure TMessageButton.SetVisible(AValue: boolean); begin if FVisible=AValue then Exit; FVisible:=AValue; (FOwner as TMultiButton).CalculateDimensions; if Assigned(FOwner) then FOwner.Invalidate; end; procedure TMessageButton.SetWidth(AValue: integer); begin if FWidth=AValue then Exit; if aValue< 1 then exit; FWidth:=AValue; if Assigned(FOwner) then FOwner.Invalidate; end; {xxxxxxxxxxxxxxxxxxxxxxxx TMultiButton xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx} constructor TMultiButton.Create(AOwner: TComponent); begin inherited Create(AOwner); FMessageButton := TMessageButton.create(self); FMessageButton.FStyle := mbsRoundRect; FMessageButton.FVisible := false; FMessageButton.FWidth := 30; FMessageButton.FHeight := 15; FMessageButton.FRRRadius := 6; FMessageButton.FAlignment:= alSE; FMessageButton.FColorStart:= clWhite; FMessageButton.FColorEnd := clSilver; FMessageButton.FGradient := gcRadiant; FMessageButton.FCapLeft := 0; FMessageButton.FCapTop := 0; FMessageButton.FPositionFactor:= 4; FMessageButton.FShowBorder := false; FMessageButton.FBorderColor := clBlack; FMessageButton.FBorderWidth := 1; FMessageButton.FHoverOn := true; FMessageButton.FHoverColor := clOlive; FMessageButton.FShowPressed := true; FMessageButton.FCalculateAlthoughInvisible:= false; FMessageButton.FFont := TFont.Create; FMessageButton.FFont.OnChange:= @MessageFontPropertyChanged; FMessageButton.FImageListChangeLink := TChangeLink.Create; FMessageButton.FImageListChangeLink.OnChange := @ImagesChanged; FMessageButton.FTextStyle.Alignment := taCenter; FMessageButton.FTextStyle.Layout := tlCenter; FMessageButton.FTextStyle.SingleLine:= false; FMessageButton.FTextStyle.Wordbreak := true; FMessageButton.FImageIndex := -1; FMessageButton.FImageWidth := 0; FMessageButton.FImageLeft := 0; FMessageButton.FImageTop := 0; FMessageButton.FPressedColor := clMedGray; FMessageButton.FPressedColorBlVl := 120; MessagePressedBmp := TBitmap.Create; FImageListChangeLink := TChangeLink.Create; FImageListChangeLink.OnChange := @ImagesChanged; FImageIndex := -1; FPressedImageIndex := -1; FHoverImageIndex := -1; FImageWidth := 0; FImageLeft := 2; FImageTop := 2; Width := 110; Height := 50; FFocusFrameWidth:= 5; FBWidth := 110-FFocusFrameWidth; FBHeight := 50-FFocusFrameWidth; FBLeft := FFocusFrameWidth; FBTop := FFocusFrameWidth; FRRRadius := 10; FColorStart := clGray; FColorEnd := clSilver; FGradient := gcSpreat; FStyle := mbsRoundRect; FCapLeft := 0; FCapTop := 0; FVisible := true; FShowBorder := false; FBorderColor := clBlack; FBorderWidth := 1; FHoverOn := true; FHoverStartColor:= clSilver; FHoverEndColor := clSilver; FFocusColor := clOlive; FFocusedOn := true; FHoverFontColor := clOlive; FFocusAlBlVal := 125; FEnabled := true; FDisabledColor := $D2D2D2; FDisabledAlpBV := 180; FPressedStCol := $505050; FPressedEnCol := $969696; FPressedFoCol := clWhite; FDown := false; FAllowsUp := false; FGRoupIndex := 0; TabStop := TRUE; Hotspot := rect(0,0,width,height); FShowMsgButtonInGroup := false; FCaption := self.Name; FCaptionWordbreak := true; fFont := TFont.Create; ffont.OnChange:= @FontPropertyChanged; FTextStyle.Alignment := taCenter; FTextStyle.Layout := tlCenter; FTextStyle.SingleLine:= false; FTextStyle.Wordbreak := true; FTextStyle.Clipping := true; end; destructor TMultiButton.Destroy; begin inherited Destroy; FMessageButton.FImageListChangeLink.Free; FImageListChangeLink.Free; FMessageButton.FFont.Free; MessageButton.Free; MessagePressedBmp.Free; FFont.Free; end; procedure TMultiButton.Loaded; begin inherited Loaded; if not FEnabled then begin FFocusedOn := false; FHoverOn := false; end; //für Schalter AllowsUp if FDown then au:=0 else au:=1; if FMessageButton.FVisible = false then begin FBWidth := width -(FFocusFrameWidth*2); FBHeight:= height - (FFocusFrameWidth*2); end; if FMessageButton.FVisible then CalculateDimensions; if FMessageButton.FCalculateAlthoughInvisible then CalculateDimensions; end; procedure TMultiButton.BoundsChanged; begin inherited BoundsChanged; if width < (FFocusFrameWidth*2) then width:=(FFocusFrameWidth*2)+10; if height < (FFocusFrameWidth*2) then height :=(FFocusFrameWidth*2)+10; if FStyle = mbsRoundRect then begin if FRRRadius > FBWidth then RndRctRadius := FBWidth; if FRRRadius > FBHeight then RndRctRadius := FBHeight; FRRRadius:=RndRctRadius; end; CalculateDimensions; end; procedure TMultiButton.KeyPress(var Key: char); begin inherited KeyPress(Key); if Assigned(OnKeyPress) then OnKeyPress(self,Key); end; procedure TMultiButton.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if Assigned(OnKeyDown) then OnKeyDown(self,Key,Shift); end; procedure TMultiButton.KeyUp(var Key: Word; Shift: TShiftState); begin inherited KeyUp(Key, Shift); pressed := false; Invalidate; if Assigned(OnKeyUp) then OnKeyUp(self,Key,Shift); end; procedure TMultiButton.CNKeyDown(var Message: TLMKeyDown); begin with Message do begin Result := 1; case CharCode of VK_Return : begin if not FEnabled then exit; pressed := true; if FAllowsUp then begin if au=0 then au:=1 else au:=0; if au=1 then Down := false; if au=0 then Down := true; end; Invalidate; if Assigned(OnClick) then OnClick(self); if FGroupIndex <> 0 then CheckTheGroup; end else begin Result := 0; end; end; end; inherited; end; procedure TMultiButton.DoEnter; begin invalidate; inherited; if Assigned(OnEnter) then OnEnter(self); end; procedure TMultiButton.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion); if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin FImageLeft := round(FImageLeft*AXProportion); FBLeft := round(FBLeft *AXProportion); FImageTop := round(FImageTop *AYProportion); FBTop := round(FBTop * AYProportion); FCapLeft := round(FCapLeft *AXProportion); FCapTop := round(FCapTop * AYProportion); Hotspot.Left := round(Hotspot.Left*AXProportion); Hotspot.Top := round(Hotspot.Top*AYProportion); FBorderWidth := round(FBorderWidth*AXProportion); Font.Height := round(Font.Height*AXProportion); FFocusFrameWidth:= round(FFocusFrameWidth*AXProportion); FRRRadius := round(FRRRadius*AXProportion); with FMessageButton do begin FImageLeft := round(FImageLeft*AXProportion); FImageTop := round(FImageTop *AYProportion); FCapLeft := round(FCapLeft *AXProportion); FCapTop := round(FCapTop * AYProportion); Hotspot.Left := round(Hotspot.Left*AXProportion); Hotspot.Top := round(Hotspot.Top*AYProportion); FBorderWidth := round(FBorderWidth*AXProportion); FRRRadius := round(FRRRadius*AXProportion); FWidth := round(FWidth*AXProportion); FHeight := round(FHeight*AYProportion); Font.Height := round(Font.Height*AXProportion); end; CalculateDimensions; end; end; procedure TMultiButton.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = FImageList) then begin Images := nil; FMessageButton.Images := nil; end; end; procedure TMultiButton.DoExit; begin pressed := false; invalidate; inherited; if Assigned(OnExit) then OnExit(self); end; procedure TMultiButton.MouseEnter; begin inherited MouseEnter; if not FEnabled then exit; if Assigned(OnMouseEnter) then OnMouseEnter(self); Invalidate; end; procedure TMultiButton.MouseLeave; begin inherited MouseLeave; if not FEnabled then exit; Hover :=false; MessageHover :=false; if Assigned(OnMouseLeave) then OnMouseLeave(self); Invalidate; end; procedure TMultiButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var MulBIn, MesBIn : boolean; begin inherited MouseDown(Button, Shift, X, Y); if not FEnabled then exit; if FMessageButton.FVisible then begin MesBIn := false; case FMessageButton.FStyle of mbsRoundRect : if PointInRoundRect(FMessageButton.Hotspot,x,y, FMessageButton.FRRRadius,FMessageButton.FRRRadius) then MesBIn :=true; mbsRect : if PtInRect(MessageButton.Hotspot,Point(x,y)) then MesBIn := true; mbsEllipse : if PointInEllipse(MessageButton.Hotspot,x,y) then MesBIn := true; mbsCircle : if PointInCircle(MessageButton.Hotspot,x,y) then MesBIn := true; end; if MesBIn then begin Hover := false; FMessageButton.pressed := true; Invalidate; exit; end; end; MulBIn := false; case FStyle of mbsRoundRect : if PointInRoundRect(Hotspot,x,y,FRRRadius,FRRRadius) then MulBIn :=true; mbsRect : if PtInRect(Hotspot,Point(x,y)) then MulBIn := true; mbsEllipse : if PointInEllipse(Hotspot,x,y) then MulBIn := true; mbsCircle : if PointInCircle(Hotspot,x,y) then MulBIn := true; end; if MulBIn then begin Hover := false; pressed := true; if Assigned(OnMouseDown) then OnMouseDown(self,Button,Shift,x,y); Invalidate; exit; end; end; procedure TMultiButton.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited mousemove(Shift, X, Y); if not FEnabled then exit; if FMessageButton.FVisible then begin Hover := false; MessageHover := false; case FMessageButton.FStyle of mbsRoundRect : debugln('FMessageStyle:mbsRoundRect'); mbsRect : debugln('FMessageStyle:mbsRect'); mbsEllipse : debugln('FMessageStyle:mbsEllipse'); mbsCircle : debugln('FMessageStyle:mbsCircle'); end; debugln(inttostr(FMessageButton.Hotspot.Width)); if FMessageButton.Hotspot.Width <=0 then DrawMessageButton; case FMessageButton.FStyle of mbsRoundRect : if PointInRoundRect(FMessageButton.Hotspot,x,y, FMessageButton.FRRRadius,FMessageButton.FRRRadius) then MessageHover:=true; mbsRect : if PtInRect(MessageButton.Hotspot,Point(x,y)) then MessageHover:=true; mbsEllipse : if PointInEllipse(MessageButton.Hotspot,x,y) then MessageHover:=true; mbsCircle : if PointInCircle(MessageButton.Hotspot,x,y) then MessageHover:=true; end; Invalidate; if MessageHover then begin if Assigned(FMessageButton.OnMouseMove) then begin FMessageButton.OnMouseMove(self,Shift,x,y); exit; end; end; end; if Assigned(OnMouseMove) then OnMouseMove(self,Shift,x,y); Hover := false; if MessageHover then exit; case FStyle of mbsRoundRect : debugln('FStyle:mbsRoundRect'); mbsRect : debugln('FStyle:mbsRect'); mbsEllipse : debugln('FStyle:mbsEllipse'); mbsCircle : debugln('FStyle:mbsCircle'); end; case FStyle of mbsRoundRect : if PointInRoundRect(Hotspot,x,y, FRRRadius,FRRRadius) then Hover:=true; mbsRect : if PtInRect(Hotspot,Point(x,y)) then Hover:=true; mbsEllipse : if PointInEllipse(Hotspot,x,y) then Hover:=true; mbsCircle : if PointInCircle(Hotspot,x,y) then Hover:=true; end; Invalidate; end; procedure TMultiButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var MulBIn,MesBIn : boolean; begin inherited MouseUp(Button, Shift, X, Y); if not FEnabled then exit; pressed := false; FMessageButton.pressed := false; Invalidate; if FMessageButton.FVisible then begin MesBIn := false; case FMessageButton.FStyle of mbsRoundRect : if PointInRoundRect(FMessageButton.Hotspot,x,y, FMessageButton.FRRRadius,FMessageButton.FRRRadius) then MesBIn :=true; mbsRect : if PtInRect(MessageButton.Hotspot,Point(x,y)) then MesBIn := true; mbsEllipse : if PointInEllipse(MessageButton.Hotspot,x,y) then MesBIn := true; mbsCircle : if PointInCircle(MessageButton.Hotspot,x,y) then MesBIn := true; end; if MesBIn then begin if Assigned(MessageButton.OnClick) then MessageButton.OnClick(self); Invalidate; exit; end; end; MulBIn := false; case FStyle of mbsRoundRect : if PointInRoundRect(Hotspot,x,y,FRRRadius,FRRRadius) then MulBIn :=true; mbsRect : if PtInRect(Hotspot,Point(x,y)) then MulBIn := true; mbsEllipse : if PointInEllipse(Hotspot,x,y) then MulBIn := true; mbsCircle : if PointInCircle(Hotspot,x,y) then MulBIn := true; end; if MulBIn then begin if FAllowsUp then begin if au=0 then au:=1 else au:=0; if au=1 then Down := false; if au=0 then Down := true; end; if FGroupIndex <> 0 then CheckTheGroup; if Assigned(OnClick) then OnClick(self); if parent.Visible then setfocus; if Assigned(OnMouseUp) then OnMouseUp(self,Button,Shift,x,y); Invalidate; exit; end; Invalidate; end; //sssssssssssssssssssssss MultiButton Setter ssssssssssssssssssssssssssssss procedure TMultiButton.SetMessageButton(AValue: TMessageButton); begin if FMessageButton=AValue then Exit; FMessageButton:=AValue; Invalidate; end; procedure TMultiButton.SetImageList(AValue: TCustomImageList); begin if FImageList = AValue then Exit; if FImageList <> nil then begin FImageList.UnRegisterChanges(FImageListChangeLink); FImageList.RemoveFreeNotification(Self); end; FImageList := AValue; if FImageList <> nil then begin FImageList.FreeNotification(Self); FImageList.RegisterChanges(FImageListChangeLink); end; ImagesChanged(Self); end; procedure TMultiButton.SetImageTop(AValue: integer); begin if FImageTop=AValue then Exit; FImageTop:=AValue; Invalidate; end; procedure TMultiButton.SetImageWidth(AValue: integer); begin if FImageWidth=AValue then Exit; FImageWidth:=AValue; Invalidate; end; procedure TMultiButton.SetPressedEnCol(AValue: TColor); begin if FPressedEnCol=AValue then Exit; FPressedEnCol:=AValue; Invalidate; end; procedure TMultiButton.SetPressedFoCol(AValue: TColor); begin if FPressedFoCol=AValue then Exit; FPressedFoCol:=AValue; Invalidate; end; procedure TMultiButton.SetPressedImageIndex(AValue: TImageIndex); begin if FPressedImageIndex=AValue then Exit; FPressedImageIndex:=AValue; ImagesChanged(nil); end; procedure TMultiButton.SetPressedStCol(AValue: TColor); begin if FPressedStCol=AValue then Exit; FPressedStCol:=AValue; Invalidate; end; procedure TMultiButton.SetColorStart(aColor: TColor); begin if FColorStart = aColor then Exit; FColorStart:=aColor; Invalidate; end; procedure TMultiButton.SetColorEnd(AValue: TColor); begin if FColorEnd=AValue then Exit; FColorEnd:=AValue; Invalidate; end; procedure TMultiButton.SetDisabledAlpBV(AValue: integer); begin if FDisabledAlpBV=AValue then Exit; FDisabledAlpBV:=AValue; Invalidate; end; procedure TMultiButton.SetDisabledColor(AValue: TColor); begin if FDisabledColor=AValue then Exit; FDisabledColor:=AValue; Invalidate; end; procedure TMultiButton.SetDown(AValue: boolean); begin if FDown=AValue then Exit; FDown:=AValue; Invalidate; end; procedure TMultiButton.SetFocusColor(AValue: TColor); begin if FFocusColor=AValue then Exit; FFocusColor:=AValue; Invalidate; end; procedure TMultiButton.SetFocusedOn(AValue: boolean); begin if FFocusedOn=AValue then Exit; FFocusedOn:=AValue; Invalidate; end; procedure TMultiButton.SetFont(AValue: TFont); begin if fFont=AValue then Exit; fFont.Assign(aValue); //nicht := !!! canvas.Font.Assign(aValue); Invalidate; end; procedure TMultiButton.FontPropertyChanged(Sender: TObject); begin canvas.Font.Assign(FFont); Invalidate; end; procedure TMultiButton.MessageFontPropertyChanged(Sender: TObject); begin Invalidate; end; procedure TMultiButton.SetTextStyle(AValue: TTextStyle); begin FTextStyle:=AValue; end; procedure TMultiButton.SetAlignment(AValue: TAlignment); begin if fTextStyle.Alignment=AValue then exit; fTextStyle.Alignment:=AValue; if aValue <> taLeftJustify then FCapLeft:=0; Invalidate; end; procedure TMultiButton.SetLayout(AValue: TTextLayout); begin if fTextStyle.Layout=AValue then exit; fTextStyle.Layout:=AValue; if aValue <> tlTop then FCapTop:=0; Invalidate; end; procedure TMultiButton.SetGradient(AValue: TGradientCourse); begin if FGradient=AValue then Exit; FGradient:=AValue; Invalidate; end; procedure TMultiButton.SetFocusAlBlVal(AValue: byte); begin if FFocusAlBlVal=AValue then Exit; FFocusAlBlVal:=AValue; Invalidate; end; procedure TMultiButton.SetGroupIndex(AValue: integer); begin if FGRoupIndex=AValue then Exit; FGRoupIndex:=AValue; Invalidate; end; procedure TMultiButton.SetHoverEndColor(AValue: TColor); begin if FHoverEndColor=AValue then Exit; FHoverEndColor:=AValue; Invalidate; end; procedure TMultiButton.SetHoverFontColor(AValue: TColor); begin if FHoverFontColor=AValue then Exit; FHoverFontColor:=AValue; Invalidate; end; procedure TMultiButton.SetFocusFrameWidth(AValue: integer); begin if FFocusFrameWidth=AValue then Exit; FFocusFrameWidth:=AValue; CalculateDimensions; end; procedure TMultiButton.SetHoverImageIndex(AValue: TImageIndex); begin if FHoverImageIndex=AValue then Exit; FHoverImageIndex:=AValue; ImagesChanged(nil); end; procedure TMultiButton.SetHoverOn(AValue: boolean); begin if FHoverOn=AValue then Exit; FHoverOn:=AValue; Invalidate; end; procedure TMultiButton.SetHoverStartColor(AValue: TColor); begin if FHoverStartColor=AValue then Exit; FHoverStartColor:=AValue; Invalidate; end; procedure TMultiButton.SetImageIndex(const aValue: TImageIndex); begin if FImageIndex=AValue then Exit; FImageIndex:=AValue; FPressedImageIndex := aValue; FHoverImageIndex := aValue; ImagesChanged(nil); end; procedure TMultiButton.SetImageLeft(AValue: integer); begin if FImageLeft=AValue then Exit; FImageLeft:=AValue; Invalidate; end; procedure TMultiButton.SetStyle(AValue: TMButtonStyle); begin if FStyle=AValue then Exit; FStyle:=AValue; if FStyle = mbsCircle then Height:=Width; Invalidate; end; procedure TMultiButton.SetRRRadius(AValue: integer); begin if FRRRadius=AValue then Exit; (*wegen PointinRoundRect*) if aValue > FBHeight then aValue := FBHeight; if aValue > FBWidth then aValue := FBWidth; FRRRadius:=AValue; Invalidate; end; procedure TMultiButton.SetShowBorder(AValue: boolean); begin if FShowBorder=AValue then Exit; FShowBorder:=AValue; Invalidate; end; procedure TMultiButton.SetShowMsgButtonInGroup(AValue: boolean); begin if FShowMsgButtonInGroup=AValue then Exit; FShowMsgButtonInGroup:=AValue; end; procedure TMultiButton.SetBorderColor(AValue: TColor); begin if FBorderColor=AValue then Exit; FBorderColor:=AValue; Invalidate; end; procedure TMultiButton.SetBorderWidth(AValue: integer); begin if FBorderWidth=AValue then Exit; FBorderWidth:=AValue; Invalidate; end; procedure TMultiButton.SetVisible(aValue: boolean); begin if FVisible=AValue then Exit; FVisible:=AValue; Invalidate; end; procedure TMultiButton.SetEnabled(aValue: boolean); begin if FEnabled = aValue then Exit; FEnabled:=aValue; if not FEnabled then FFocusedOn:= false else FFocusedOn := true; if not FEnabled then FHoverOn:= false else FHoverOn := true; Invalidate; end; procedure TMultiButton.SetCaption(AValue: TCaption); begin if aValue = '' then aValue:=' '; if FCaption=AValue then Exit; FCaption:=AValue; CaptionChange:=true; Invalidate; end; procedure TMultiButton.SetCapLeft(AValue: integer); begin if csDesigning in ComponentState then if FTextStyle.Alignment <> taLeftJustify then begin showmessage('only effective with taLeftJustify'); exit; end; if FCapLeft=AValue then Exit; FCapLeft:=AValue; Invalidate; end; procedure TMultiButton.SetCaptionWordbreak(AValue: boolean); begin if FCaptionWordbreak=AValue then Exit; FCaptionWordbreak:=AValue; if not FCaptionWordbreak then begin FTextStyle.SingleLine:= true; FTextStyle.Wordbreak := false; end else begin FTextStyle.SingleLine:= false; FTextStyle.Wordbreak := true; end; Invalidate; end; procedure TMultiButton.SetCapTop(AValue: integer); begin if csDesigning in ComponentState then if FTextStyle.Layout <> tlTop then begin showmessage('only effective with tlTop'); exit; end; if FCapTop=AValue then Exit; FCapTop:=AValue; Invalidate; end; procedure TMultiButton.SetAllowsUp(AValue: boolean); begin if FAllowsUp=AValue then Exit; FAllowsUp:=AValue; end; procedure TMultiButton.CheckTheGroup; var comp : TComponent; CurButton : TMultiButton; CurForm : TForm; CurControl : TControl; lv : integer; exitflag : boolean; begin lv:=0; exitflag := false; CurControl := Parent; repeat if CurControl is TForm then exitflag := true else CurControl := CurControl.Parent; //zurück bis zur Form inc(lv); until (lv =100) or (exitflag = true); CurForm := (CurControl as TForm); for comp in CurForm do begin if comp is TMultiButton then begin CurButton := comp as TMultiButton; if FShowMsgButtonInGroup and (CurButton.GroupIndex = FGroupIndex) then begin CurButton.MessageButton.FVisible:= false; CurButton.invalidate; end; if CurButton = self then begin FDown:=true; if FShowMsgButtonInGroup then CurButton.MessageButton.FVisible:= true; end; if (CurButton <> self) and (CurButton.GroupIndex = FGroupIndex) then begin CurButton.Down:= false; if FShowMsgButtonInGroup then CurButton.MessageButton.FVisible:= false; end; end;//comp is end;//comp in end; procedure TMultiButton.ImagesChanged(Sender: TObject); begin Invalidate; end; //xxxxxxxxxxxxxxxxxxxxxxx zeichnen xxxxxxxxxxxxxxxxxxxxxxxxxx procedure TMultiButton.CalculateDimensions; var PF : integer; begin FBWidth := Width - (FFocusFrameWidth*2) ; FBHeight:= Height - (FFocusFrameWidth*2); PF := FMessageButton.FPositionFactor; if FStyle = mbsCircle then begin FBHeight := FBWidth; Height := FBHeight + (FFocusFrameWidth*2); end; FBLeft:= FFocusFrameWidth; FBTop := FFocusFrameWidth; Hotspot := rect(FFocusFrameWidth,FFocusFrameWidth,Width-FFocusFrameWidth,Height-FFocusFrameWidth); Invalidate; if not FMessageButton.FCalculateAlthoughInvisible then //wenn MessageButton zum Start unsichtbar if FMessageButton.FVisible = false then exit; if FMessageButton.FAlignment = alSE then begin FBWidth := (width - FMessageButton.FWidth div PF)-(FFocusFrameWidth*2); FBHeight:= (height- FMessageButton.FHeight div PF)-(FFocusFrameWidth*2); FBLeft:=FFocusFrameWidth; FBTop :=FFocusFrameWidth; end; if FMessageButton.FAlignment = alSW then begin FBWidth := (width - FMessageButton.FWidth div PF)-(FFocusFrameWidth*2); FBHeight:= (height- FMessageButton.FHeight div PF)-(FFocusFrameWidth*2); FBLeft:= (FMessageButton.FWidth div 4)+FFocusFrameWidth; FBTop := FFocusFrameWidth; end; if FMessageButton.FAlignment = alNW then begin FBWidth := (width - FMessageButton.FWidth div PF)-(FFocusFrameWidth*2); FBHeight:= (height- FMessageButton.FHeight div PF)-(FFocusFrameWidth*2); FBLeft:= (FMessageButton.FWidth div PF)+FFocusFrameWidth; FBTop := (FMessageButton.FHeight div PF)+FFocusFrameWidth; end; if FMessageButton.FAlignment = alNE then begin FBWidth := (width - FMessageButton.FWidth div PF)-(FFocusFrameWidth*2); FBHeight:= (height- FMessageButton.FHeight div PF)-(FFocusFrameWidth*2); FBLeft:= FFocusFrameWidth; FBTop := (FMessageButton.FHeight div PF)+FFocusFrameWidth; end; if FMessageButton.FAlignment = alW then begin FBWidth := (width - FMessageButton.FWidth div PF)-(FFocusFrameWidth*2); FBHeight:= Height -(FFocusFrameWidth*2); FBLeft:= (FMessageButton.FWidth div PF)+FFocusFrameWidth; FBTop := FFocusFrameWidth; end; if FMessageButton.FAlignment = alE then begin FBWidth := (width - FMessageButton.FWidth div PF)-(FFocusFrameWidth*2); FBHeight:= Height-(FFocusFrameWidth*2); FBLeft:= FFocusFrameWidth; FBTop := FFocusFrameWidth; end; if (FMessageButton.FAlignment= alRightIn) or (FMessageButton.FAlignment = alLeftIn) or (FMessageButton.FAlignment = alTopIn) or(FMessageButton.FAlignment = alBottomIn) then begin FBWidth := width -(FFocusFrameWidth*2); FBHeight:= Height-(FFocusFrameWidth*2); FBLeft:= FFocusFrameWidth; FBTop := FFocusFrameWidth; end; if FMessageButton.FAlignment = alN then begin FBWidth := width-(FFocusFrameWidth*2); FBHeight:= (Height- FMessageButton.FHeight div PF)-(FFocusFrameWidth*2); FBLeft:= FFocusFrameWidth; FBTop := (FMessageButton.FHeight div PF)+FFocusFrameWidth; end; if FMessageButton.FAlignment = alS then begin FBWidth := width-(FFocusFrameWidth*2); FBHeight:= (Height- FMessageButton.FHeight div PF)-(FFocusFrameWidth*2); FBLeft:= FFocusFrameWidth; FBTop := FFocusFrameWidth; end; if FMessageButton.FAlignment = alRightOut then begin FBWidth := (width - FMessageButton.FWidth)-(FFocusFrameWidth*2); FBHeight:= Height-(FFocusFrameWidth*2); FBLeft:= FFocusFrameWidth; FBTop := FFocusFrameWidth; end; if FMessageButton.FAlignment = alLeftOut then begin FBWidth := (width - FMessageButton.FWidth)-(FFocusFrameWidth*2); FBHeight:= Height-(FFocusFrameWidth*2); FBLeft:= width-FFocusFrameWidth-FBWidth; FBTop := FFocusFrameWidth; end; if FMessageButton.FAlignment = alTopOut then begin FBWidth := width-(FFocusFrameWidth*2); FBHeight:= (Height- FMessageButton.FHeight)-(FFocusFrameWidth*2); FBLeft:= FFocusFrameWidth; FBTop := FMessageButton.FHeight+FFocusFrameWidth; end; if FMessageButton.FAlignment = alBottomOut then begin FBWidth := width-(FFocusFrameWidth*2); FBHeight:= (Height- FMessageButton.FHeight)-(FFocusFrameWidth*2); FBLeft:= FFocusFrameWidth; FBTop := FFocusFrameWidth; end; if FStyle = mbsCircle then begin FBHeight := FBWidth; FBLeft:= (width div 2) - (FBWidth div 2); FBTop := (height div 2) - (FBHeight div 2); end; Hotspot := rect(FBLeft,FBTop,FBLeft+FBWidth,FBTop+FBHeight); if FBWidth < 5 then FBWidth:=5; if FBHeight < 5 then FBHeight:=5; Invalidate; end; procedure TMultiButton.DrawTheButton; var bkBmp : TBitmap; trBmp : TBitmap; mask : TBitmap; Dest : TBitmap; begin bkBmp := TBitmap.Create; bkBmp.SetSize(FBWidth,FBHeight); if not pressed then GradientBmp(bkBmp,SC,EC,FGradient) else GradientBmp(bkBmp,FPressedStCol,FPressedEnCol,FGradient); if down then GradientBmp(bkBmp,FPressedStCol,FPressedEnCol,FGradient); trBmp := TBitmap.Create; trBmp.SetSize(FBWidth,FBHeight); trBmp.TransparentColor:=clblack; trBmp.Transparent:= true; trBmp.Canvas.Brush.Color:=clwhite; trBmp.Canvas.FillRect(0,0,FBWidth,FBHeight); trBmp.Canvas.Brush.Color:=clBlack; case FStyle of mbsRoundRect : trBmp.Canvas.RoundRect(0,0,FBwidth,FBheight,FRRRadius,FRRRadius); mbsRect : trBmp.Canvas.Rectangle(0,0,FBwidth,FBheight); mbsEllipse : trBmp.Canvas.Ellipse(0,0,FBwidth,FBheight); mbsCircle : trBmp.Canvas.Ellipse(0,0,FBWidth,FBHeight); end; mask := TBitmap.Create; mask.SetSize(FBWidth,FBHeight); mask.Canvas.Brush.Color:=clwhite; mask.Canvas.FillRect(0,0,FBWidth,FBHeight); mask.Canvas.Brush.Color:=clBlack; case FStyle of mbsRoundRect : mask.Canvas.RoundRect(0,0,FBwidth,FBheight,FRRRadius,FRRRadius); mbsRect : mask.Canvas.Rectangle(0,0,FBwidth,FBheight); mbsEllipse : mask.Canvas.Ellipse(0,0,FBwidth,FBheight); mbsCircle : mask.Canvas.Ellipse(0,0,FBWidth,FBHeight); end; Dest := TBitmap.Create; Dest.SetSize(FBWidth,FBHeight); Dest.Transparent:= true; Dest.TransparentColor:= clBlack; Dest.Canvas.Brush.Color:=clBlack; Dest.Canvas.FillRect(0,0,100,100); Dest.Canvas.copymode:=cmSrcCopy; Dest.Canvas.Draw(0,0,bkBmp); Dest.Canvas.Draw(0,0,trBmp); Dest.Canvas.copymode:=cmSrcInvert; Dest.Canvas.Draw(0,0,mask); canvas.Draw(FBLeft,FBTop,Dest); bkBmp.Free; trBmp.Free; mask.Free; Dest.Free; end; procedure TMultiButton.DrawABorder; begin Canvas.Brush.Style:= bsClear; Canvas.Pen.Color:=FBorderColor; Canvas.Pen.Width:= FBorderWidth; case FStyle of mbsRoundRect : Canvas.RoundRect(Hotspot,FRRRadius,FRRRadius); mbsRect : Canvas.Rectangle(Hotspot); mbsEllipse : Canvas.Ellipse(Hotspot); mbsCircle : Canvas.Ellipse(Hotspot); end; end; procedure TMultiButton.DrawMessageBorder; begin Canvas.Brush.Style:= bsClear; Canvas.Pen.Color:=FMessageButton.FBorderColor; Canvas.Pen.Width:= FMessageButton.FBorderWidth; case FMessageButton.FStyle of mbsRoundRect : Canvas.RoundRect(FMessageButton.Hotspot,FMessageButton.FRRRadius,FMessageButton.FRRRadius); mbsRect : Canvas.Rectangle(FMessageButton.Hotspot); mbsEllipse : Canvas.Ellipse(FMessageButton.Hotspot); mbsCircle : Canvas.Ellipse(FMessageButton.Hotspot); end; end; procedure TMultiButton.DrawMessageHover; begin Canvas.Brush.Style:= bsClear; Canvas.Pen.Color:=FMessageButton.FHoverColor; Canvas.Pen.Width:= FMessageButton.FBorderWidth; case MessageButton.FStyle of mbsRoundRect : Canvas.RoundRect(FMessageButton.Hotspot,FMessageButton.FRRRadius,FMessageButton.FRRRadius); mbsRect : Canvas.Rectangle(FMessageButton.Hotspot); mbsEllipse : Canvas.Ellipse(FMessageButton.Hotspot); mbsCircle : Canvas.Ellipse(FMessageButton.Hotspot); end; end; procedure TMultiButton.DrawMessageButton; var bkBmp : TBitmap; trBmp : TBitmap; mask : TBitmap; Dest : TBitmap; aBlSp : TBlendShape; begin if FMessageButton.FStyle = mbsCircle then FMessageButton.FHeight:=FMessageButton.FWidth; if FMessageButton.FAlignment = alSE then FMessageButton.Hotspot := rect(width-FMessageButton.FWidth,height-FMessageButton.FHeight, width,height); if FMessageButton.FAlignment = alSW then FMessageButton.Hotspot := rect(0,height-FMessageButton.FHeight, FMessageButton.Width,height); if FMessageButton.FAlignment = alNW then FMessageButton.Hotspot := rect(0,0, FMessageButton.Width,FMessageButton.height); if FMessageButton.FAlignment = alNE then FMessageButton.Hotspot := rect(width-FMessageButton.FWidth,0, Width,FMessageButton.height); if FMessageButton.FAlignment = alW then FMessageButton.Hotspot := rect(0,(height div 2)-(FMessageButton.height div 2), FMessageButton.Width,(height div 2)+(FMessageButton.height div 2)); if FMessageButton.FAlignment = alE then FMessageButton.Hotspot := rect(width-FMessageButton.FWidth,(height div 2)-(FMessageButton.height div 2), Width,(height div 2)+(FMessageButton.height div 2)); if FMessageButton.FAlignment = alN then FMessageButton.Hotspot := rect((width div 2)-(FMessageButton.width div 2),0, (width div 2)+(FMessageButton.width div 2),FMessageButton.height); if FMessageButton.FAlignment = alS then FMessageButton.Hotspot := rect((width div 2)-(FMessageButton.width div 2),height-FMessageButton.FHeight, (width div 2)+(FMessageButton.width div 2),height); if FMessageButton.FAlignment = alRightIn then FMessageButton.Hotspot := rect(width-FMessageButton.FWidth-FFocusFrameWidth-1,(height div 2)-(FMessageButton.height div 2), Width-FFocusFrameWidth-1,(height div 2)+(FMessageButton.height div 2)); if FMessageButton.FAlignment = alLeftIn then FMessageButton.Hotspot := rect(FFocusFrameWidth+1,(height div 2)-(FMessageButton.height div 2), FMessageButton.FWidth+FFocusFrameWidth+1,(height div 2)+(FMessageButton.height div 2)); if FMessageButton.FAlignment = alTopIn then FMessageButton.Hotspot := rect((width div 2)-(FMessageButton.width div 2),FFocusFrameWidth+1, (width div 2)+(FMessageButton.width div 2),FMessageButton.height+FFocusFrameWidth+1); if FMessageButton.FAlignment = alBottomIn then FMessageButton.Hotspot := rect((width div 2)-(FMessageButton.width div 2),height-(FMessageButton.height+FFocusFrameWidth+1), (width div 2)+(FMessageButton.width div 2),height-FFocusFrameWidth+1); if FMessageButton.FAlignment = alRightOut then FMessageButton.Hotspot := rect(width-FMessageButton.FWidth-FFocusFrameWidth,(height div 2)-(FMessageButton.height div 2), Width-FFocusFrameWidth,(height div 2)+(FMessageButton.height div 2)); if FMessageButton.FAlignment = alLeftOut then FMessageButton.Hotspot := rect(FFocusFrameWidth,(height div 2)-(FMessageButton.height div 2), FMessageButton.FWidth+FFocusFrameWidth,(height div 2)+(FMessageButton.height div 2)); if FMessageButton.FAlignment = alTopOut then FMessageButton.Hotspot := rect((width div 2)-(FMessageButton.width div 2),FFocusFrameWidth, (width div 2)+(FMessageButton.width div 2),FFocusFrameWidth+FMessageButton.height); if FMessageButton.FAlignment = alBottomOut then FMessageButton.Hotspot := rect((width div 2)-(FMessageButton.width div 2),height-FFocusFrameWidth-FMessageButton.height, (width div 2)+(FMessageButton.width div 2),height-FFocusFrameWidth); try bkBmp := TBitmap.Create; bkBmp.SetSize(FMessageButton.FWidth,FMessageButton.FHeight); GradientBmp(bkBmp,FMessageButton.FColorStart,FMessageButton.FColorEnd,FMessageButton.FGradient); trBmp := TBitmap.Create; trBmp.SetSize(FMessageButton.FWidth,FMessageButton.FHeight); trBmp.TransparentColor:=clblack; trBmp.Transparent:= true; trBmp.Canvas.Brush.Color:=clwhite; trBmp.Canvas.FillRect(0,0,FMessageButton.FWidth,FMessageButton.FHeight); trBmp.Canvas.Brush.Color:=clBlack; case FMessageButton.FStyle of mbsRoundRect : trBmp.Canvas.RoundRect(0,0,FMessageButton.FWidth,FMessageButton.FHeight,FMessageButton.FRRRadius,FMessageButton.FRRRadius); mbsRect : trBmp.Canvas.Rectangle(0,0,FMessageButton.FWidth,FMessageButton.FHeight); mbsEllipse : trBmp.Canvas.Ellipse(0,0,FMessageButton.FWidth,FMessageButton.FHeight); mbsCircle : trBmp.Canvas.Ellipse(0,0,FMessageButton.FWidth,FMessageButton.FHeight); end; mask := TBitmap.Create; mask.SetSize(FMessageButton.FWidth,FMessageButton.FHeight); mask.Canvas.Brush.Color:=clwhite; mask.Canvas.FillRect(0,0,FMessageButton.FWidth,FMessageButton.FHeight); mask.Canvas.Brush.Color:=clBlack; case FMessageButton.FStyle of mbsRoundRect : mask.Canvas.RoundRect(0,0,FMessageButton.FWidth,FMessageButton.FHeight,FMessageButton.FRRRadius,FMessageButton.FRRRadius); mbsRect : mask.Canvas.Rectangle(0,0,FMessageButton.FWidth,FMessageButton.FHeight); mbsEllipse : mask.Canvas.Ellipse(0,0,FMessageButton.FWidth,FMessageButton.FHeight); mbsCircle : mask.Canvas.Ellipse(0,0,FMessageButton.FWidth,FMessageButton.FHeight); end; Dest := TBitmap.Create; Dest.SetSize(FMessageButton.FWidth,FMessageButton.FHeight); Dest.Transparent:= true; Dest.TransparentColor:= clBlack; Dest.Canvas.Brush.Color:=clBlack; Dest.Canvas.FillRect(0,0,100,100); Dest.Canvas.copymode:=cmSrcCopy; Dest.Canvas.Draw(0,0,bkBmp); Dest.Canvas.Draw(0,0,trBmp); Dest.Canvas.copymode:=cmSrcInvert; Dest.Canvas.Draw(0,0,mask); canvas.Draw(FMessageButton.Hotspot.Left,FMessageButton.Hotspot.Top,Dest); finally bkBmp.Free; trBmp.Free; mask.Free; Dest.Free; end; //Pressed MessagePressedBmp.PixelFormat:=pf32bit; MessagePressedBmp.SetSize(FMessageButton.Hotspot.Width,FMessageButton.Hotspot.Height); MessagePressedBmp.Canvas.Brush.Color:=FMessageButton.FPressedColor; MessagePressedBmp.Canvas.FillRect(0,0,FMessageButton.Hotspot.Width,FMessageButton.Hotspot.Height); case FMessageButton.FStyle of mbsRoundRect : aBlSp.BlendShape:=bsRoundRect; mbsRect : aBlSp.BlendShape:=bsRect; mbsEllipse : aBlSp.BlendShape:=bsEllipse; mbsCircle : aBlSp.BlendShape:=bsEllipse; end; aBlSp.Rad:=FMessageButton.FRRRadius; aBlSp.Rectangle:= rect(0,0,FMessageButton.Hotspot.Width,FMessageButton.Hotspot.Height); AlphaBlende(MessagePressedBmp,FMessageButton.FPressedColorBlVl,aBlSp); //umso niedriger umso transparenter end; procedure TMultiButton.Paint; var tmpBmp : TBitmap; TeRec : TRect; ImgIdx : TImageIndex; ImgIdxFlag : integer; begin if FVisible = false then exit; if (csDesigning in ComponentState) and (FVisible = false) then left:= -100; canvas.Font.Assign(FFont); if canvas.Font <> FFont then Canvas.Font.Color:= Font.Color; //zeichnet den Fokusrahmen if (Focused=true) and (FFocusedOn = true) then begin try tmpBmp := TBitmap.Create; {$IFDEF WINDOWS} tmpBmp.PixelFormat := pf32bit; {$ENDIF} tmpBmp.SetSize(width,height); tmpBmp.Canvas.Brush.Color:= FFocusColor; tmpBmp.Canvas.FillRect(0,0,width,height); BmpToAlphaBmp(tmpBmp,FFocusAlBlVal); canvas.Draw(0,0,tmpBmp); finally tmpBmp.Free; end; end; //Hover Schriftfarbe if ((HoverOn=true) and (Hover=true)) then canvas.Font.Color:= FHoverFontColor; //Hoverfarbe if ((HoverOn=true) and (Hover=true)) then begin SC := FHoverStartColor; EC := FHoverEndColor; end else begin SC := FColorStart; EC := FColorEnd; end; //Zeichnet den Button mit Hintergrund DrawTheButton; //Komponentenname if not CaptionChange then FCaption := self.Name; //Caption if pressed or (down=true) then canvas.Font.Color:= FPressedFoCol; TeRec:= rect(Hotspot.Left+FBorderWidth,Hotspot.Top+FBorderWidth, Hotspot.Right-FBorderWidth,Hotspot.Bottom-FBorderWidth); canvas.TextRect(TeRec,TeRec.Left+FCapLeft,TeRec.Top+FCapTop, FCaption,FTextStyle); //Zeichnet die Border if FShowBorder then DrawABorder; //weist den ImageIndex zu ImgIdxFlag := 0; if ((HoverOn=true) and (Hover=true)) then ImgIdxFlag := 2; if pressed or (down=true) then ImgIdxFlag := 1; case ImgIdxFlag of 0 : ImgIdx := FImageIndex; 1 : ImgIdx := FPressedImageIndex; 2 : ImgIdx := FHoverImageIndex; end; //Zeichnet das Bild if (FImageList <> nil) and (ImgIdx > -1) and (ImgIdx < FImageList.Count) then FImageList.ResolutionForPPI[FImageWidth, Font.PixelsPerInch, GetCanvasScaleFactor].Draw(Canvas, FImageLeft+FBLeft,FImageTop+FBTop,ImgIdx); //XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX---ab hier MessageButton---XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX //zeichnet den MessageButton if FMessageButton.FVisible then begin with FMessageButton do begin DrawMessageButton; //zeichnet die Caption canvas.Font.Assign(FFont); if (HoverOn=true) and (MessageHover=true) then Canvas.Font.Color:= FHoverFontColor ; canvas.TextRect(Hotspot,Hotspot.Left+FCapLeft,Hotspot.Top+FCapTop, FCaption,FTextStyle); //Zeichnet das Bild if (FImageList <> nil) and (FImageIndex > -1) and (FImageIndex < FImageList.Count) then FImageList.ResolutionForPPI[FImageWidth, Font.PixelsPerInch, GetCanvasScaleFactor].Draw(Canvas, Hotspot.Left+FImageLeft,Hotspot.Top+FImageTop,FImageIndex); //Zeichnet die Border if FShowBorder then DrawMessageBorder; if (FHoverOn=true) and (MessageHover=true) then DrawMessageHover; if pressed and FShowPressed then self.canvas.Draw(Hotspot.Left,Hotspot.Top,MessagePressedBmp); end; end; //Enable if not FEnabled then begin try tmpBmp := TBitmap.Create; tmpBmp.PixelFormat := pf32bit; tmpBmp.SetSize(width,height); tmpBmp.Canvas.Brush.Color:= FDisabledColor; tmpBmp.Canvas.FillRect(0,0,width,height); BmpToAlphaBmp(tmpBmp,FDisabledAlpBV); canvas.Draw(0,0,tmpBmp); finally tmpBmp.Free; end; end; end; end.