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