1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 {******************************* CONTRIBUTOR(S) ******************************
3 - Edivando S. Santos Brasil | mailedivando@gmail.com
4   (Compatibility with delphi VCL 11/2018)
5 
6 ***************************** END CONTRIBUTOR(S) *****************************}
7 unit BCMDButtonFocus;
8 
9 {$I bgracontrols.inc}
10 
11 // Set this to show number of repaint in each MDBUTTON
12 { $DEFINE MDBUTTON_DEBUG}
13 
14 // Set this to animate only a MDBUTTON at a time
15 { $DEFINE MDBUTTON_ANIMATEONLYONE}
16 
17 interface
18 
19 uses
20   Classes, SysUtils, Types, {$IFDEF FPC}LCLType, LResources, LMessages,{$ENDIF}
21   Forms, Controls, Graphics, Dialogs,
22   {$IFNDEF FPC}Windows, Messages, BGRAGraphics, GraphType, FPImage, {$ENDIF}
23   BCBaseCtrls, BGRABitmap, BGRABitmapTypes, ExtCtrls, Math, BGRABlend, BCMDButton;
24 
25 type
26 
27   { TCustomBCMDButtonFocus }
28 
29   TCustomBCMDButtonFocus = class(TBGRACustomCtrl)
30   private
31     FChecked: boolean;
32     FKind: TBCMDButtonKind;
33     {$IFDEF INDEBUG}
34     FCount: integer;
35     {$ENDIF}
36     FRounding: integer;
37     FTextAutoSize: boolean;
38     FTextProportional: boolean;
39     FTextProportionalRatio: single;
40     FTimer: TTimer;
41     FPercent: double;
42     FCircleSize: double;
43     FCX, FCY: integer;
44     FAlphaPercent: double;
45     FAlignment: TAlignment;
46     FAnimation: boolean;
47     FState: TBCMDButtonState;
48     FStyleActive: TBCMDButtonStyle;
49     FStyleDisabled: TBCMDButtonStyle;
50     FStyleHover: TBCMDButtonStyle;
51     FStyleNormal: TBCMDButtonStyle;
52     FTextLayout: TTextLayout;
53     procedure OnChangeStyle(Sender: TObject);
54     procedure SetFAlignment(AValue: TAlignment);
55     procedure SetFAnimation(AValue: boolean);
56     procedure SetFChecked(AValue: boolean);
57     procedure SetFKind(AValue: TBCMDButtonKind);
58     procedure SetFStyleActive(AValue: TBCMDButtonStyle);
59     procedure SetFStyleDisabled(AValue: TBCMDButtonStyle);
60     procedure SetFStyleHover(AValue: TBCMDButtonStyle);
61     procedure SetFStyleNormal(AValue: TBCMDButtonStyle);
62     procedure SetFTextAutoSize(AValue: boolean);
63     procedure SetFTextLayout(AValue: TTextLayout);
64     procedure SetFTextProportional(AValue: boolean);
65     procedure SetFTextProportionalRatio(AValue: single);
66   protected
67     // START / MDBUTTONFOCUS ONLY
68     procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMKillFocus{$ENDIF}); message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
69     procedure WMKillFocus(var Message: {$IFDEF FPC}TLMKillFocus{$ELSE}TWMKillFocus{$ENDIF}); message {$IFDEF FPC}LM_KILLFOCUS{$ELSE}WM_KILLFOCUS{$ENDIF};
70     procedure UpdateFocus(AFocused: boolean);
71     procedure KeyDown(var Key: word; Shift: TShiftState); override;
72     procedure KeyUp(var Key: word; Shift: TShiftState); override;
73     // END / MDBUTTONFOCUS ONLY
74     procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
75     {%H-}WithThemeSpace: boolean); override;
76     procedure Paint; override;
77     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
78       X, Y: integer); override;
79     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
80     procedure MouseEnter; override;
81     procedure MouseLeave; override;
82     procedure RealSetText(const Value: TCaption); override;
83     procedure OnTimer(Sender: TObject);
84     procedure OnStartTimer(Sender: TObject);
85     procedure OnStopTimer(Sender: TObject);
easeInOutQuadnull86     function easeInOutQuad(t: double): double;
easeOutQuadnull87     function easeOutQuad(t: double): double;
88     procedure UncheckOthers;
GetControlClassDefaultSizenull89     class function GetControlClassDefaultSize: TSize;override;
90   public
91     constructor Create(AOwner: TComponent); override;
92     destructor Destroy; override;
93     procedure SelectAll;
94     procedure UnselectAll;
95     procedure InvertSelection;
GetSelectednull96     function GetSelected: TStringList;
97   published
98     property Animation: boolean read FAnimation write SetFAnimation default False;
99     property Alignment: TAlignment read FAlignment write SetFAlignment default taCenter;
100     property TextLayout: TTextLayout
101       read FTextLayout write SetFTextLayout default tlCenter;
102     property StyleNormal: TBCMDButtonStyle read FStyleNormal write SetFStyleNormal;
103     property StyleHover: TBCMDButtonStyle read FStyleHover write SetFStyleHover;
104     property StyleActive: TBCMDButtonStyle read FStyleActive write SetFStyleActive;
105     property StyleDisabled: TBCMDButtonStyle read FStyleDisabled write SetFStyleDisabled;
106     property Checked: boolean read FChecked write SetFChecked default False;
107     property Kind: TBCMDButtonKind read FKind write SetFKind default mdbkNormal;
108     // If text size is used to measure buttons
109     // Disable it if you use the buttons in a grid, for example
110     property TextAutoSize: boolean read FTextAutoSize write SetFTextAutoSize;
111     // Enable it if you want that text size grows with height
112     property TextProportional: boolean read FTextProportional write SetFTextProportional;
113     // Each character font height proportional to height of control
114     // Set it in conjunction with TextProportional, values recommended between 0...1
115     property TextProportionalRatio: single read FTextProportionalRatio
116       write SetFTextProportionalRatio;
117   end;
118 
119   TBCMDButtonFocus = class(TCustomBCMDButtonFocus)
120     property Action;
121     property Align;
122     property Anchors;
123     property AutoSize;
124     property BidiMode;
125     property BorderSpacing;
126     {$IFDEF FPC} //#
127     property OnChangeBounds;
128     {$ENDIF}
129     //property Cancel;
130     property Caption;
131     property Color;
132     property Constraints;
133     //property Default;
134     property DragCursor;
135     property DragKind;
136     property DragMode;
137     property Enabled;
138     property Font;
139     property ParentBidiMode;
140     //property ModalResult;
141     property OnClick;
142     property OnContextPopup;
143     property OnDragDrop;
144     property OnDragOver;
145     property OnEndDrag;
146     //property OnEnter;
147     //property OnExit;
148     //property OnKeyDown;
149     //property OnKeyPress;
150     //property OnKeyUp;
151     property OnMouseDown;
152     property OnMouseEnter;
153     property OnMouseLeave;
154     property OnMouseMove;
155     property OnMouseUp;
156     property OnMouseWheel;
157     property OnMouseWheelDown;
158     property OnMouseWheelUp;
159     property OnResize;
160     property OnStartDrag;
161     //property OnUTF8KeyPress;
162     property ParentFont;
163     property ParentShowHint;
164     property PopupMenu;
165     property ShowHint;
166     //property TabOrder;
167     //property TabStop;
168     property Visible;
169   end;
170 
171 {$IFDEF FPC}procedure Register;{$ENDIF}
172 
173 implementation
174 
175 {$IFDEF MDBUTTON_ANIMATEONLYONE}
176 var
177   MDAnimating: TCustomMDButtonFocus;
178 
179 {$ENDIF}
180 
181 {$IFDEF FPC}
182 procedure Register;
183 begin
184   RegisterComponents('BGRA Button Controls', [TBCMDButtonFocus]);
185 end;
186 {$ENDIF}
187 
188 { TCustomBCMDButtonFocus }
189 
190 procedure TCustomBCMDButtonFocus.SetFStyleActive(AValue: TBCMDButtonStyle);
191 begin
192   if FStyleActive = AValue then
193     Exit;
194   FStyleActive := AValue;
195 end;
196 
197 procedure TCustomBCMDButtonFocus.SetFAlignment(AValue: TAlignment);
198 begin
199   if FAlignment = AValue then
200     Exit;
201   FAlignment := AValue;
202   Invalidate;
203 end;
204 
205 procedure TCustomBCMDButtonFocus.SetFAnimation(AValue: boolean);
206 begin
207   if FAnimation = AValue then
208     Exit;
209   FAnimation := AValue;
210   Invalidate;
211 end;
212 
213 procedure TCustomBCMDButtonFocus.SetFChecked(AValue: boolean);
214 begin
215   if FChecked = AValue then
216     Exit;
217   FChecked := AValue;
218   if FChecked and (FKind in [mdbkToggleGroup, mdbkRadioButton, mdbkTab]) then
219     UncheckOthers;
220   Invalidate;
221 end;
222 
223 procedure TCustomBCMDButtonFocus.SetFKind(AValue: TBCMDButtonKind);
224 begin
225   if FKind = AValue then
226     Exit;
227   FKind := AValue;
228   Invalidate;
229 end;
230 
231 procedure TCustomBCMDButtonFocus.OnChangeStyle(Sender: TObject);
232 begin
233   Invalidate;
234 end;
235 
236 procedure TCustomBCMDButtonFocus.SetFStyleDisabled(AValue: TBCMDButtonStyle);
237 begin
238   if FStyleDisabled = AValue then
239     Exit;
240   FStyleDisabled := AValue;
241 end;
242 
243 procedure TCustomBCMDButtonFocus.SetFStyleHover(AValue: TBCMDButtonStyle);
244 begin
245   if FStyleHover = AValue then
246     Exit;
247   FStyleHover := AValue;
248 end;
249 
250 procedure TCustomBCMDButtonFocus.SetFStyleNormal(AValue: TBCMDButtonStyle);
251 begin
252   if FStyleNormal = AValue then
253     Exit;
254   FStyleNormal := AValue;
255 end;
256 
257 procedure TCustomBCMDButtonFocus.SetFTextAutoSize(AValue: boolean);
258 begin
259   if FTextAutoSize = AValue then
260     Exit;
261   FTextAutoSize := AValue;
262 end;
263 
264 procedure TCustomBCMDButtonFocus.SetFTextLayout(AValue: TTextLayout);
265 begin
266   if FTextLayout = AValue then
267     Exit;
268   FTextLayout := AValue;
269   Invalidate;
270 end;
271 
272 procedure TCustomBCMDButtonFocus.SetFTextProportional(AValue: boolean);
273 begin
274   if FTextProportional = AValue then
275     Exit;
276   FTextProportional := AValue;
277   Invalidate;
278 end;
279 
280 procedure TCustomBCMDButtonFocus.SetFTextProportionalRatio(AValue: single);
281 begin
282   if FTextProportionalRatio = AValue then
283     Exit;
284   FTextProportionalRatio := AValue;
285   Invalidate;
286 end;
287 
288 procedure TCustomBCMDButtonFocus.WMSetFocus(var Message:  {$IFDEF FPC}TLMSetFocus{$ELSE}TWMKillFocus{$ENDIF});
289 begin
290   inherited;
291 
292   UpdateFocus(True);
293 end;
294 
295 procedure TCustomBCMDButtonFocus.WMKillFocus(var Message: {$IFDEF FPC}TLMKillFocus{$ELSE}TWMKillFocus{$ENDIF});
296 begin
297   inherited;
298 
299   if Message.FocusedWnd <> Handle then
300     UpdateFocus(False);
301 end;
302 
303 procedure TCustomBCMDButtonFocus.UpdateFocus(AFocused: boolean);
304 var
305   lForm: TCustomForm;
306 begin
307   lForm := GetParentForm(Self);
308   if lForm = nil then
309     exit;
310 
311 {$IFDEF FPC}//#
312   if AFocused then
313     ActiveDefaultControlChanged(lForm.ActiveControl)
314   else
315     ActiveDefaultControlChanged(nil);
316 {$ENDIF}
317   Invalidate;
318 end;
319 
320 procedure TCustomBCMDButtonFocus.KeyDown(var Key: word; Shift: TShiftState);
321 begin
322   inherited KeyDown(Key, Shift);
323 
324   if (Key = VK_SPACE) or (Key = VK_RETURN) then
325     MouseDown(mbLeft, [], Width div 2, Height div 2);
326 end;
327 
328 procedure TCustomBCMDButtonFocus.KeyUp(var Key: word; Shift: TShiftState);
329 begin
330   if (Key = VK_SPACE) or (Key = VK_RETURN) then
331   begin
332     MouseLeave;
333     Self.Click;
334   end;
335 
336   inherited KeyUp(Key, Shift);
337 end;
338 
339 procedure TCustomBCMDButtonFocus.CalculatePreferredSize(
340   var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
341 var
342   bmp: TBGRABitmap;
343   s: TSize;
344 begin
345   bmp := TBGRABitmap.Create;
346   bmp.FontName := Font.Name;
347   if FTextProportional then
348     bmp.FontHeight := Round(Height * FTextProportionalRatio)
349   else
350     bmp.FontHeight := 0;
351   bmp.FontAntialias := True;
352   bmp.FontQuality := fqSystemClearType;
353   bmp.FontStyle := Font.Style;
354   s := bmp.TextSize(Caption);
355   if FTextAutoSize then
356   begin
357     PreferredWidth := s.Width + 26 {$IFDEF FPC}+ BorderSpacing.InnerBorder{$ENDIF};
358     PreferredHeight := s.Height + 10 {$IFDEF FPC}+ BorderSpacing.InnerBorder{$ENDIF};
359   end
360   else
361   begin
362     {$IFDEF FPC}//#
363     PreferredWidth := BorderSpacing.InnerBorder;
364     PreferredHeight := BorderSpacing.InnerBorder;
365     {$ENDIF}
366   end;
367   bmp.Free;
368 end;
369 
370 procedure TCustomBCMDButtonFocus.Paint;
371 var
372   bmp: TBGRABitmap;
373   iTemp: integer;
374   alpha: byte;
375   tempState: TBCMDButtonState;
376   tempText: string;
377   tempRounding: integer;
378   tempColor, hoverColor: TBGRAPixel;
379 begin
380   bmp := TBGRABitmap.Create(Width, Height);
381   bmp.FontName := Font.Name;
382   if FTextProportional then
383     bmp.FontHeight := Round(Height * FTextProportionalRatio)
384   else
385     bmp.FontHeight := 0;
386   bmp.FontAntialias := True;
387   bmp.FontQuality := fqSystemClearType;
388   bmp.FontStyle := Font.Style;
389   tempState := FState;
390 
391   if Kind = mdbkTab then
392     tempRounding := 0
393   else
394     tempRounding := FRounding;
395 
396   if FChecked then
397     tempState := mdbsActive
398   else
399     tempState := FState;
400 
401   // START / MDBUTTONFOCUS ONLY
402   if Focused and (tempState = mdbsNormal) then
403     tempState := mdbsHover;
404   // END / MDBUTTONFOCUS ONLY
405 
406   tempText := Caption;
407 
408   case FKind of
409     mdbkCheckBox:
410     begin
411       if Length(Caption) > 0 then
412         tempText := ' ' + Caption;
413       if FChecked then
414         tempText := BCMDBUTTONBALLOTBOXWITHCHECK + tempText
415       else
416         tempText := BCMDBUTTONBALLOTBOX + tempText;
417     end;
418     mdbkRadioButton:
419     begin
420       if Length(Caption) > 0 then
421         tempText := ' ' + Caption;
422       if FChecked then
423         tempText := BCMDBUTTONRADIOBUTTON + tempText
424       else
425         tempText := BCMDBUTTONRADIOBUTTONCIRCLE + tempText;
426     end;
427   end;
428 
429   // Enabled
430   if Enabled then
431   begin
432     if not FTimer.Enabled then
433     begin
434       case tempState of
435         mdbsNormal:
436         begin
437           bmp.RoundRect(0, 0, Width, Height, tempRounding, tempRounding,
438             FStyleNormal.Color,
439             FStyleNormal.Color);
440           {$IFDEF FPC}
441           bmp.TextRect(Rect(BorderSpacing.InnerBorder, BorderSpacing.InnerBorder,
442             Width - BorderSpacing.InnerBorder, Height - BorderSpacing.InnerBorder),
443             tempText, Alignment,
444             TextLayout, FStyleNormal.TextColor);
445           {$ELSE}
446           bmp.TextRect(Rect(0, 0, Width, Height), tempText, Alignment, TextLayout, FStyleNormal.TextColor);
447           {$ENDIF}
448         end;
449         mdbsHover:
450         begin
451           bmp.RoundRect(0, 0, Width, Height, tempRounding, tempRounding,
452             FStyleHover.Color, FStyleHover.Color);
453           {$IFDEF FPC}
454           bmp.TextRect(Rect(BorderSpacing.InnerBorder, BorderSpacing.InnerBorder,
455             Width - BorderSpacing.InnerBorder, Height - BorderSpacing.InnerBorder),
456             tempText, Alignment,
457             TextLayout, FStyleHover.TextColor);
458           {$ELSE}
459           bmp.TextRect(Rect(0, 0, Width, Height), tempText, Alignment, TextLayout, FStyleHover.TextColor);
460           {$ENDIF}
461         end;
462         mdbsActive:
463         begin
464           if not FAnimation then
465           begin
466             if FKind in [mdbkNormal] then
467               bmp.RoundRect(0, 0, Width, Height, tempRounding,
468                 tempRounding, FStyleActive.Color,
469                 FStyleActive.Color)
470             else
471               bmp.RoundRect(0, 0, Width, Height, tempRounding,
472                 tempRounding, FStyleHover.Color,
473                 FStyleHover.Color);
474           end
475           else
476             bmp.RoundRect(0, 0, Width, Height, tempRounding, tempRounding,
477               FStyleHover.Color,
478               FStyleHover.Color);
479           {$IFDEF FPC}
480           bmp.TextRect(Rect(BorderSpacing.InnerBorder, BorderSpacing.InnerBorder,
481             Width - BorderSpacing.InnerBorder, Height - BorderSpacing.InnerBorder),
482             tempText, Alignment,
483             TextLayout, FStyleActive.TextColor);
484           {$ELSE}
485           bmp.TextRect(Rect(0, 0, Width, Height), tempText, Alignment, TextLayout, FStyleActive.TextColor);
486           {$ENDIF}
487         end;
488       end;
489     end
490     else
491     begin
492       iTemp := round(FCircleSize * easeOutQuad(FPercent));
493       alpha := round(easeInOutQuad(FAlphaPercent) * 255);
494       case tempState of
495         mdbsNormal:
496         begin
497           bmp.RoundRect(0, 0, Width, Height, tempRounding, tempRounding,
498             FStyleNormal.Color,
499             FStyleNormal.Color);
500           if FPercent < 1 then
501             tempColor := FStyleHover.Color
502           else
503           begin
504             tempColor := FStyleNormal.Color;
505             hoverColor := ColorToBGRA(FStyleHover.Color, alpha);
506             PutPixels(@tempColor, @hoverColor, 1, dmDrawWithTransparency, 255);
507           end;
508           bmp.FillEllipseAntialias(FCX, FCY, iTemp,
509             iTemp, tempColor);
510           {$IFDEF FPC}
511           bmp.TextRect(Rect(BorderSpacing.InnerBorder, BorderSpacing.InnerBorder,
512             Width - BorderSpacing.InnerBorder, Height - BorderSpacing.InnerBorder),
513             tempText, Alignment,
514             TextLayout, FStyleNormal.TextColor);
515           {$ELSE}
516           bmp.TextRect(Rect(0, 0, Width, Height), tempText, Alignment, TextLayout, FStyleNormal.TextColor);
517           {$ENDIF}
518         end;
519         mdbsHover, mdbsActive:
520         begin
521           bmp.RoundRect(0, 0, Width, Height, tempRounding, tempRounding,
522             FStyleHover.Color, FStyleHover.Color);
523           if FPercent < 1 then
524             tempColor := FStyleActive.Color
525           else
526           begin
527             tempColor := FStyleHover.Color;
528             hoverColor := ColorToBGRA(FStyleActive.Color, alpha);
529             PutPixels(@tempColor, @hoverColor, 1, dmDrawWithTransparency, 255);
530           end;
531           bmp.FillEllipseAntialias(FCX, FCY, iTemp,
532             iTemp, tempColor);
533           {$IFDEF FPC}
534           bmp.TextRect(Rect(BorderSpacing.InnerBorder, BorderSpacing.InnerBorder,
535             Width - BorderSpacing.InnerBorder, Height - BorderSpacing.InnerBorder),
536             tempText, Alignment,
537             TextLayout, FStyleHover.TextColor);
538           {$ELSE}
539           bmp.TextRect(Rect(0, 0, Width, Height), tempText, Alignment, TextLayout, FStyleHover.TextColor);
540           {$ENDIF}
541         end;
542       end;
543     end;
544   end
545   // Disabled
546   else
547   begin
548     if FChecked then
549     begin
550       bmp.RoundRect(0, 0, Width, Height, tempRounding, tempRounding,
551         FStyleHover.Color, FStyleHover.Color);
552     end
553     else
554       bmp.RoundRect(0, 0, Width, Height, tempRounding, tempRounding,
555         FStyleDisabled.Color, FStyleDisabled.Color);
556     {$IFDEF FPC}
557     bmp.TextRect(Rect(BorderSpacing.InnerBorder, BorderSpacing.InnerBorder,
558       Width - BorderSpacing.InnerBorder, Height - BorderSpacing.InnerBorder),
559       tempText, Alignment,
560       TextLayout, FStyleDisabled.TextColor);
561     {$ELSE}
562     bmp.TextRect(Rect(0, 0, Width, Height), tempText, Alignment, TextLayout, FStyleDisabled.TextColor);
563     {$ENDIF}
564   end;
565 
566   // Tab
567   if Kind = mdbkTab then
568   begin
569     if FTimer.Enabled then
570     begin
571       iTemp := round((bmp.Width div 2) * easeInOutQuad(FPercent));
572       bmp.Rectangle((bmp.Width div 2) - iTemp, bmp.Height - 2,
573         (bmp.Width div 2) + iTemp, bmp.Height, $00BB513F, dmSet);
574     end
575     else
576     begin
577       if FChecked then
578         bmp.Rectangle(0, bmp.Height - 2, bmp.Width, bmp.Height, $00BB513F, dmSet);
579     end;
580   end;
581 
582   {$IFDEF MDBUTTON_DEBUG}
583   bmp.FontHeight := 10;
584   bmp.TextOut(0, 0, FCount.ToString, BGRA(255, 0, 0, 255));
585   FCount += 1;
586   {$ENDIF}
587   bmp.Draw(Canvas, 0, 0, False);
588   bmp.Free;
589   inherited Paint;
590 end;
591 
592 procedure TCustomBCMDButtonFocus.MouseDown(Button: TMouseButton;
593   Shift: TShiftState; X, Y: integer);
594 begin
595   inherited MouseDown(Button, Shift, X, Y);
596   FState := mdbsActive;
597   if FAnimation and BCMDBUTTONANIMATION then
598   begin
599     FCircleSize := max(round(Width / 1.5) + abs((Width div 2) - X),
600       round(Height / 1.5) + abs((Height div 2) - Y));
601     FCX := X;
602     FCY := Y;
603     FTimer.Enabled := False;
604     FTimer.Enabled := True;
605     {$IFDEF MDBUTTON_ANIMATEONLYONE}
606     MDAnimating := Self;
607     {$ENDIF}
608   end;
609   if FKind in [mdbkToggle, mdbkToggleGroup, mdbkCheckBox, mdbkRadioButton, mdbkTab] then
610   begin
611     FChecked := not FChecked;
612     if FKind in [mdbkToggleGroup, mdbkRadioButton, mdbkTab] then
613     begin
614       FChecked := True;
615       UncheckOthers;
616     end;
617   end;
618   Invalidate;
619 end;
620 
621 procedure TCustomBCMDButtonFocus.MouseUp(Button: TMouseButton;
622   Shift: TShiftState; X, Y: integer);
623 begin
624   inherited MouseUp(Button, Shift, X, Y);
625   if (x > 0) and (x < Width) and (y > 0) and (y < Height) and (FState = mdbsActive) then
626     FState := mdbsHover
627   else
628     FState := mdbsNormal;
629   Invalidate;
630 end;
631 
632 procedure TCustomBCMDButtonFocus.MouseEnter;
633 begin
634   inherited MouseEnter;
635   FState := mdbsHover;
636   Invalidate;
637 end;
638 
639 procedure TCustomBCMDButtonFocus.MouseLeave;
640 begin
641   inherited MouseLeave;
642   FState := mdbsNormal;
643   Invalidate;
644 end;
645 
646 procedure TCustomBCMDButtonFocus.RealSetText(const Value: TCaption);
647 begin
648   inherited RealSetText(Value);
649   InvalidatePreferredSize;
650   Invalidate;
651 end;
652 
653 procedure TCustomBCMDButtonFocus.OnTimer(Sender: TObject);
654 begin
655   {$IFDEF MDBUTTON_ANIMATEONLYONE}
656   if MDAnimating = Self then
657   begin
658   {$ENDIF}
659     FPercent := FPercent + BCMDBUTTONANIMATIONSPEED;
660     if FPercent < 0 then
661       FPercent := 0
662     else if FPercent > 1 then
663       FPercent := 1;
664 
665     if FPercent = 1 then
666     begin
667       FAlphaPercent := FAlphaPercent - BCMDBUTTONANIMATIONSPEED;
668       if FAlphaPercent < 0 then
669         FAlphaPercent := 0
670       else if FAlphaPercent > 1 then
671         FAlphaPercent := 1;
672     end;
673   {$IFDEF MDBUTTON_ANIMATEONLYONE}
674   end
675   else
676     FTimer.Enabled := False;
677   {$ENDIF}
678 
679   Invalidate;
680   if (FPercent >= 1) and (FAlphaPercent <= 0) then
681     FTimer.Enabled := False;
682 end;
683 
684 procedure TCustomBCMDButtonFocus.OnStartTimer(Sender: TObject);
685 begin
686   FPercent := 0;
687   FAlphaPercent := 1;
688 end;
689 
690 procedure TCustomBCMDButtonFocus.OnStopTimer(Sender: TObject);
691 begin
692 
693 end;
694 
easeInOutQuadnull695 function TCustomBCMDButtonFocus.easeInOutQuad(t: double): double;
696 begin
697   if t < 0.5 then
698     Result := 2 * t * t
699   else
700     Result := -1 + (4 - 2 * t) * t;
701 end;
702 
TCustomBCMDButtonFocus.easeOutQuadnull703 function TCustomBCMDButtonFocus.easeOutQuad(t: double): double;
704 begin
705   Result := t * (2 - t);
706 end;
707 
708 procedure TCustomBCMDButtonFocus.UncheckOthers;
709 var
710   i: integer;
711   control: TWinControl;
712 begin
713   if Parent is TWinControl then
714   begin
715     control := TWinControl(Parent);
716     for i := 0 to control.ControlCount - 1 do
717       if (control.Controls[i] <> Self) and (control.Controls[i] is
718         TCustomBCMDButtonFocus) then
719         if (TCustomBCMDButtonFocus(control.Controls[i]).Kind in
720           [mdbkToggleGroup, mdbkRadioButton, mdbkTab]) then
721           TCustomBCMDButtonFocus(control.Controls[i]).Checked := False;
722   end;
723 end;
724 
TCustomBCMDButtonFocus.GetControlClassDefaultSizenull725 class function TCustomBCMDButtonFocus.GetControlClassDefaultSize: TSize;
726 begin
727   Result.CX := 75;
728   Result.CY := 25;
729 end;
730 
731 constructor TCustomBCMDButtonFocus.Create(AOwner: TComponent);
732 begin
733   inherited Create(AOwner);
734   // START / MDBUTTONFOCUS ONLY
735   TabStop := True;
736   ControlStyle := ControlStyle + [csAcceptsControls, csParentBackground];
737   DoubleBuffered := True;
738   // END / MDBUTTONFOCUS ONLY
739   {$IFDEF INDEBUG}
740   FCount := 0;
741   {$ENDIF}
742   // State
743   FState := mdbsNormal;
744   FChecked := False;
745   FKind := mdbkNormal;
746   // Text
747   FTextAutoSize := True;
748   FAlignment := taCenter;
749   FTextLayout := tlCenter;
750   FTextProportional := False;
751   FTextProportionalRatio := 0.5;
752   // Style
753   FRounding := 6;
754   FStyleNormal := TBCMDButtonStyle.Create;
755   FStyleNormal.OnChange := OnChangeStyle;
756   FStyleHover := TBCMDButtonStyle.Create;
757   FStyleHover.OnChange := OnChangeStyle;
758   FStyleActive := TBCMDButtonStyle.Create;
759   FStyleActive.OnChange := OnChangeStyle;
760   FStyleDisabled := TBCMDButtonStyle.Create;
761   FStyleDisabled.OnChange := OnChangeStyle;
762   // Default Style
763   FStyleHover.Color := RGBToColor(220, 220, 220);
764   FStyleActive.Color := RGBToColor(198, 198, 198);
765   FStyleDisabled.TextColor := RGBToColor(163, 163, 163);
766   // Animation
767   FAnimation := False;
768   FTimer := TTimer.Create(Self);
769   FTimer.Enabled := False;
770   FTimer.Interval := BCMDBUTTONTIMERSPEED;
771   FTimer.OnTimer := OnTimer;
772   {$IFDEF FPC}//#
773   FTimer.OnStartTimer := OnStartTimer;
774   FTimer.OnStopTimer := OnStopTimer;
775   {$ENDIF}
776 
777   // Setup default sizes
778   with GetControlClassDefaultSize do
779     SetInitialBounds(0, 0, CX, CY);
780 end;
781 
782 destructor TCustomBCMDButtonFocus.Destroy;
783 begin
784   FTimer.OnTimer := nil;
785   {$IFDEF FPC}//#
786   FTimer.OnStartTimer := nil;
787   FTimer.OnStopTimer := nil;
788   {$ENDIF}
789   FTimer.Enabled := False;
790   FStyleNormal.Free;
791   FStyleHover.Free;
792   FStyleActive.Free;
793   FStyleDisabled.Free;
794   inherited Destroy;
795 end;
796 
797 procedure TCustomBCMDButtonFocus.SelectAll;
798 var
799   i: integer;
800   control: TWinControl;
801 begin
802   if Parent is TWinControl then
803   begin
804     control := TWinControl(Parent);
805     for i := 0 to control.ControlCount - 1 do
806       if (control.Controls[i] is TCustomBCMDButtonFocus) then
807         if (TCustomBCMDButtonFocus(control.Controls[i]).Kind in
808           [mdbkToggle, mdbkCheckBox]) then
809           TCustomBCMDButtonFocus(control.Controls[i]).Checked := True;
810   end;
811 end;
812 
813 procedure TCustomBCMDButtonFocus.UnselectAll;
814 var
815   i: integer;
816   control: TWinControl;
817 begin
818   if Parent is TWinControl then
819   begin
820     control := TWinControl(Parent);
821     for i := 0 to control.ControlCount - 1 do
822       if (control.Controls[i] is TCustomBCMDButtonFocus) then
823         if (TCustomBCMDButtonFocus(control.Controls[i]).Kind in
824           [mdbkToggle, mdbkCheckBox]) then
825           TCustomBCMDButtonFocus(control.Controls[i]).Checked := False;
826   end;
827 end;
828 
829 procedure TCustomBCMDButtonFocus.InvertSelection;
830 var
831   i: integer;
832   control: TWinControl;
833 begin
834   if Parent is TWinControl then
835   begin
836     control := TWinControl(Parent);
837     for i := 0 to control.ControlCount - 1 do
838       if (control.Controls[i] is TCustomBCMDButtonFocus) then
839         if (TCustomBCMDButtonFocus(control.Controls[i]).Kind in
840           [mdbkToggle, mdbkCheckBox]) then
841           TCustomBCMDButtonFocus(control.Controls[i]).Checked :=
842             not TCustomBCMDButtonFocus(control.Controls[i]).Checked;
843   end;
844 end;
845 
GetSelectednull846 function TCustomBCMDButtonFocus.GetSelected: TStringList;
847 var
848   i: integer;
849   control: TWinControl;
850 begin
851   Result := TStringList.Create;
852   if Parent is TWinControl then
853   begin
854     control := TWinControl(Parent);
855     for i := 0 to control.ControlCount - 1 do
856       if (control.Controls[i] is TCustomBCMDButtonFocus) then
857         if TCustomBCMDButtonFocus(control.Controls[i]).Checked then
858           Result.AddObject(TCustomBCMDButtonFocus(control.Controls[i]).Caption,
859             TCustomBCMDButtonFocus(control.Controls[i]));
860   end;
861 end;
862 
863 end.
864