1 {
2 Copyright (C) Alexey Torgashin, uvviewsoft.com
3 License: MPL 2.0 or LGPL
4 }
5 
6 unit ATButtons;
7 
8 {$ifdef FPC}
9 {$mode delphi}
10 {$endif}
11 
12 interface
13 
14 uses
15   Classes, SysUtils, Graphics, Controls, Menus,
16   Types, Math, Forms, ExtCtrls,
17   {$ifdef FPC}
18   LCLType,
19   {$else}
20   Windows, Messages,
21   System.UITypes, //solve H2443 Inline function 'CanvasLine' has not been expanded
22   {$endif}
23   ATFlatThemes,
24   ATCanvasPrimitives;
25 
26 
27 type
28   TATButtonKind = (
29     abuTextOnly,
30     abuIconOnly,
31     abuTextIconHorz,
32     abuTextIconVert,
33     abuSeparatorHorz,
34     abuSeparatorVert,
35     abuTextChoice
36     );
37 
38 const
39   cATButtonKindValues: array[TATButtonKind] of string = (
40     'text',
41     'icon',
42     'text_icon_h',
43     'text_icon_v',
44     'sep_h',
45     'sep_v',
46     'text_choice'
47     );
48 
49 const
50   cDefaultButtonPadding = 4;
51   cDefaultButtonPaddingBig = 5;
52 
53 type
54   TATButtonArrowKind = (
55     abakArrowDown,
56     abakArrowLeft,
57     abakArrowRight,
58     abakCross
59     );
60 
61 type
62   { TATButton }
63 
64   TATButton = class(TCustomControl)
65   private
66     {$ifndef FPC}
67     FOnMouseLeave: TNotifyEvent;
68     FOnMouseEnter: TNotifyEvent;
69     {$endif}
70 
71     FPressed: boolean;
72     FOver: boolean;
73     FChecked: boolean;
74     FCheckable: boolean;
75     FFocusable: boolean;
76     FPicture: TPicture;
77     FImages: TImageList;
78     FImageIndex: integer;
79     FArrow: boolean;
80     FArrowKind: TATButtonArrowKind;
81     FArrowAlign: TAlignment;
82     FFlat: boolean;
83     FKind: TATButtonKind;
84     FBoldBorder: boolean;
85     FBoldFont: boolean;
86     FDataString: string;
87     FDataString2: string;
88     FDataString3: string;
89     FItems: TStringList;
90     FItemsShort: TStringList;
91     FItemIndex: integer;
92     FPopup: TPopupMenu;
93     FPadding: integer;
94     FPaddingBig: integer;
95     FTheme: PATFlatTheme;
96     FWidthInitial: integer;
97     FTextOverlay: string;
98     FTextAlign: TAlignment;
99     FShowShortItems: boolean;
100     FColorLine: TColor;
101     FColorLine2: TColor;
102 
103     {$ifndef FPC}
104     procedure CMMouseEnter(var msg: TMessage);
105       message CM_MOUSEENTER;
106     procedure CMMouseLeave(var msg: TMessage);
107       message CM_MOUSELEAVE;
108     {$endif}
109 
110     procedure DoChoiceClick(Sender: TObject);
GetIconHeightnull111     function GetIconHeight: integer;
GetIconWidthnull112     function GetIconWidth: integer;
GetTextItemnull113     function GetTextItem(AIndex: integer; const ADefault: string): string;
114     procedure PaintBorder(C: TCanvas; R: TRect; AColor: TColor; AWidth: integer);
115     procedure PaintIcon(C: TCanvas; AX, AY: integer);
116     procedure PaintArrow(C: TCanvas; AX, AY: integer; AColorBg, AColorArrow: TColor);
117     procedure PaintTo(C: TCanvas);
118     procedure SetBoldFont(AValue: boolean);
119     procedure SetChecked(AValue: boolean);
120     procedure SetFlat(AValue: boolean);
121     procedure SetFocusable(AValue: boolean);
122     procedure SetImageIndex(AValue: integer);
123     procedure SetImages(AValue: TImageList);
124     procedure SetItemIndex(AValue: integer);
125     procedure SetKind(AValue: TATButtonKind);
126     procedure SetBoldBorder(AValue: boolean);
127     procedure SetTextOverlay(const AValue: string);
128     procedure SetTheme(AValue: PATFlatTheme);
129     procedure ShowChoiceMenu;
130   protected
131     procedure Paint; override;
132     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
133     {$ifdef FPC}
134     procedure MouseLeave; override;
135     procedure MouseEnter; override;
136     procedure TextChanged; override;
137     {$else}
138     procedure DoMouseEnter; dynamic;
139     procedure DoMouseLeave; dynamic;
140     {$endif}
141 
142     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
143     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
144     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
145     procedure DoEnter; override;
146     procedure DoExit; override;
147     procedure Resize; override;
148     procedure SetAutoSize(AValue: boolean); override;
149   public
150     constructor Create(AOwner: TComponent); override;
151     destructor Destroy; override;
152     procedure Click; override;
CanFocusnull153     function CanFocus: boolean; override;
IsPressednull154     function IsPressed: boolean;
155     property IsMouseOver: boolean read FOver;
156     property DataString: string read FDataString write FDataString;
157     property DataString2: string read FDataString2 write FDataString2;
158     property DataString3: string read FDataString3 write FDataString3;
GetTextSizenull159     function GetTextSize(C: TCanvas; const S: string): TSize;
160     property Items: TStringList read FItems;
161     property ItemsShort: TStringList read FItemsShort;
162     property ItemIndex: integer read FItemIndex write SetItemIndex;
163     property Theme: PATFlatTheme read FTheme write SetTheme;
164     property WidthInitial: integer read FWidthInitial write FWidthInitial;
165     property TextOverlay: string read FTextOverlay write SetTextOverlay;
166     property ShowShortItems: boolean read FShowShortItems write FShowShortItems;
167     property ColorLine: TColor read FColorLine write FColorLine;
168     property ColorLine2: TColor read FColorLine2 write FColorLine2;
169 
170   published
171     property Align;
172     property Anchors;
173     {$ifdef FPC}
174     property BorderSpacing;
175     {$endif}
176 
177     {$ifndef FPC}
178     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
179     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
180     {$endif}
181 
182     property Caption;
183     property TabStop;
184     property TabOrder;
185     property Enabled;
186     property Visible;
187     property ShowHint;
188     property ParentShowHint;
189     property PopupMenu;
190     property Checked: boolean read FChecked write SetChecked default false;
191     property Checkable: boolean read FCheckable write FCheckable default false;
192     property Images: TImageList read FImages write SetImages;
193     property ImageIndex: integer read FImageIndex write SetImageIndex default -1;
194     property Focusable: boolean read FFocusable write SetFocusable default true;
195     property Flat: boolean read FFlat write SetFlat default false;
196     property Arrow: boolean read FArrow write FArrow default false;
197     property ArrowKind: TATButtonArrowKind read FArrowKind write FArrowKind default abakArrowDown;
198     property ArrowAlign: TAlignment read FArrowAlign write FArrowAlign default taRightJustify;
199     property TextAlign: TAlignment read FTextAlign write FTextAlign default taLeftJustify;
200     property Kind: TATButtonKind read FKind write SetKind default abuTextOnly;
201     property BoldBorder: boolean read FBoldBorder write SetBoldBorder default false;
202     property BoldFont: boolean read FBoldFont write SetBoldFont default false;
203     property Picture: TPicture read FPicture write FPicture;
204     property Padding: integer read FPadding write FPadding default cDefaultButtonPadding;
205     property PaddingBig: integer read FPaddingBig write FPaddingBig default cDefaultButtonPaddingBig;
206     property OnClick;
207     property OnDblClick;
208     property OnResize;
209     property OnContextPopup;
210     property OnMouseDown;
211     property OnMouseUp;
212     property OnMouseMove;
213     {$ifdef FPC}
214     property OnMouseEnter;
215     property OnMouseLeave;
216     {$endif}
217     property OnMouseWheel;
218     property OnMouseWheelDown;
219     property OnMouseWheelUp;
220   end;
221 
222 implementation
223 
224 { TATButton }
225 
226 {$ifndef FPC}
227 procedure TATButton.CMMouseEnter(var msg: TMessage);
228 begin
229   DoMouseEnter;
230 end;
231 
232 procedure TATButton.CMMouseLeave(var msg: TMessage);
233 begin
234   DoMouseLeave;
235 end;
236 
237 procedure TATButton.DoMouseEnter;
238 begin
239   FOver:= true;
240   Invalidate;
241   if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
242 end;
243 
244 procedure TATButton.DoMouseLeave;
245 begin
246   FOver:= false;
247   Invalidate;
248   if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
249 end;
250 {$endif}
251 
252 procedure TATButton.SetChecked(AValue: boolean);
253 begin
254   if FChecked=AValue then Exit;
255   FChecked:= AValue;
256   Invalidate;
257 end;
258 
259 procedure TATButton.SetFlat(AValue: boolean);
260 begin
261   if FFlat=AValue then Exit;
262   FFlat:= AValue;
263   Invalidate;
264   if FFlat then
265     Focusable:= false;
266 end;
267 
268 procedure TATButton.SetFocusable(AValue: boolean);
269 begin
270   if FFocusable=AValue then Exit;
271   FFocusable:= AValue;
272   TabStop:= AValue;
273 end;
274 
275 procedure TATButton.SetImageIndex(AValue: integer);
276 begin
277   if FImageIndex=AValue then Exit;
278   FImageIndex:= AValue;
279   Invalidate;
280 end;
281 
282 procedure TATButton.SetImages(AValue: TImageList);
283 begin
284   if FImages=AValue then Exit;
285   FImages:= AValue;
286   Invalidate;
287 end;
288 
289 procedure TATButton.SetItemIndex(AValue: integer);
290 begin
291   if FItemIndex=AValue then Exit;
292   FItemIndex:= AValue;
293   if FCheckable then
294     FChecked:= FItemIndex>0;
295 end;
296 
297 procedure TATButton.SetKind(AValue: TATButtonKind);
298 begin
299   if FKind=AValue then Exit;
300   FKind:= AValue;
301   Invalidate;
302 end;
303 
304 procedure TATButton.SetBoldBorder(AValue: boolean);
305 begin
306   if FBoldBorder=AValue then Exit;
307   FBoldBorder:= AValue;
308   Invalidate;
309 end;
310 
311 procedure TATButton.SetTextOverlay(const AValue: string);
312 begin
313   if FTextOverlay=AValue then Exit;
314   FTextOverlay:= AValue;
315   Invalidate;
316 end;
317 
318 procedure TATButton.SetTheme(AValue: PATFlatTheme);
319 begin
320   if FTheme=AValue then Exit;
321   FTheme:= AValue;
322   Invalidate;
323 end;
324 
325 procedure TATButton.Click;
326 begin
327   if FKind=abuTextChoice then
328   begin
329     ShowChoiceMenu;
330     exit
331   end;
332 
333   inherited;
334   if FCheckable then
335     FChecked:= not FChecked;
336   Invalidate;
337 end;
338 
CanFocusnull339 function TATButton.CanFocus: boolean;
340 begin
341   Result:= FFocusable;
342 end;
343 
IsPressednull344 function TATButton.IsPressed: boolean;
345 begin
346   Result:= FPressed and FOver;
347 end;
348 
349 procedure TATButton.PaintBorder(C: TCanvas; R: TRect; AColor: TColor; AWidth: integer);
350 var
351   i: integer;
352 begin
353   C.Brush.Style:= bsClear;
354   C.Pen.Color:= ColorToRGB(AColor);
355   C.Rectangle(R);
356 
357   for i:= 1 to AWidth-1 do
358   begin
359     InflateRect(R, -1, -1);
360     C.Rectangle(R);
361   end;
362 
363   C.Brush.Style:= bsSolid;
364 end;
365 
366 procedure TATButton.Paint;
367 begin
368   inherited;
369 
370   //override value set by LCL scaling to make all buttons look the same
371   Canvas.Font.PixelsPerInch:= Screen.PixelsPerInch;
372 
373   PaintTo(Canvas);
374 end;
375 
376 type
377   TControlCracker = class(TControl); //for Delphi
378 
379 procedure TATButton.PaintTo(C: TCanvas);
380 var
381   NWidth, NHeight: integer;
382   NSize, NSizeArrow: integer;
383   bUseBack, bUseBorder: boolean;
384   NColorBg, NColor: TColor;
385   TextSize: TSize;
386   pnt1, pnt2: TPoint;
387   RectAll, RectText: TRect;
388   CurCaption, S: string;
389 begin
390   NWidth:= ClientWidth;
391   NHeight:= ClientHeight;
392   RectAll:= ClientRect;
393   CurCaption:= Caption;
394 
395   if FArrow then
396     NSizeArrow:= Theme^.DoScale(4*Theme^.ArrowSize)
397   else
398     NSizeArrow:= 0;
399 
400   if not Theme^.EnableColorBgOver then
401     FOver:= false;
402 
403   bUseBack:=
404     (not FFlat)
405     or FChecked
406     or (FOver and not (FKind in [abuSeparatorHorz, abuSeparatorVert]));
407 
408   bUseBorder:= bUseBack
409     or (FKind=abuTextChoice);
410 
411   if bUseBack then
412   begin
413     if not Enabled then
414       NColorBg:= Theme^.ColorBgDisabled
415     else
416     if FChecked then
417       NColorBg:= Theme^.ColorBgChecked
418     else
419     if FOver then
420       NColorBg:= Theme^.ColorBgOver
421     else
422       NColorBg:= Theme^.ColorBgPassive;
423 
424     NColorBg:= ColorToRGB(NColorBg);
425     C.Brush.Color:= NColorBg;
426     C.FillRect(RectAll);
427   end
428   else
429   begin
430     {$ifdef FPC}
431     //Flat style - don't paint any background (FPC)
432     NColorBg:= clNone;
433     {$else}
434     //Flat style - don't paint any background (delphi)
435     if Parent <> nil then
436     if Parent is TControl then
437     begin
438       Self.Canvas.Brush.Color:= TControlCracker(Parent).Color;
439       Self.Canvas.FillRect(Self.Canvas.ClipRect);
440     end;
441     {$endif}
442   end;
443 
444   if FColorLine<>clNone then
445   begin
446     C.Brush.Color:= FColorLine;
447     C.FillRect(Rect(
448       0,
449       0,
450       Width,
451       FTheme^.DoScale(FTheme^.ColoredLineWidth)));
452   end;
453 
454   if FColorLine2<>clNone then
455   begin
456     C.Brush.Color:= FColorLine2;
457     C.FillRect(Rect(
458       0,
459       Height-FTheme^.DoScale(FTheme^.ColoredLineWidth),
460       Width,
461       Height));
462   end;
463 
464   if bUseBorder then
465   begin
466     if FOver then
467       NColor:= Theme^.ColorBorderOver
468     else
469     if Focused then
470       NColor:= Theme^.ColorBorderFocused
471     else
472       NColor:= Theme^.ColorBorderPassive;
473 
474     NSize:= 1;
475     if IsPressed then
476       NSize:= Theme^.PressedBorderWidth
477     else
478     if BoldBorder then
479       NSize:= Theme^.BoldBorderWidth
480     else
481     if Kind=abuTextChoice then
482       NSize:= Theme^.ChoiceBorderWidth
483     else
484     if FOver then
485       NSize:= Theme^.MouseoverBorderWidth;
486 
487     PaintBorder(C, RectAll, NColor, NSize);
488   end;
489 
490   C.Font.Name:= Theme^.FontName;
491   C.Font.Color:= ColorToRGB(IfThen(Enabled, Theme^.ColorFont, Theme^.ColorFontDisabled));
492   C.Font.Size:= Theme^.DoScaleFont(Theme^.FontSize);
493 
494   if BoldFont then
495     C.Font.Style:= [fsBold]
496   else
497     C.Font.Style:= Theme^.FontStyles;
498   C.Brush.Style:= bsClear;
499 
500   case FKind of
501     abuIconOnly:
502       begin
503         pnt1.x:= (NWidth-GetIconWidth) div 2 +
504           IfThen(IsPressed, Theme^.PressedCaptionShiftX) -
505           IfThen(Arrow, Padding);
506         pnt1.y:= (NHeight-GetIconHeight) div 2 +
507           IfThen(IsPressed, Theme^.PressedCaptionShiftY);
508         PaintIcon(C, pnt1.x, pnt1.y);
509       end;
510 
511     abuTextOnly:
512       begin
513         TextSize:= GetTextSize(C, CurCaption);
514         pnt1.x:= (NWidth-TextSize.cx-NSizeArrow) div 2 +
515           IfThen(IsPressed, Theme^.PressedCaptionShiftX);
516         pnt1.y:= (NHeight-TextSize.cy) div 2 +
517           IfThen(IsPressed, Theme^.PressedCaptionShiftY);
518         C.TextOut(pnt1.x, pnt1.y, CurCaption);
519       end;
520 
521     abuTextIconHorz:
522       begin
523         TextSize:= GetTextSize(C, CurCaption);
524         pnt1.x:= FPadding +
525           IfThen(IsPressed, Theme^.PressedCaptionShiftX);
526         pnt1.y:= (NHeight-GetIconHeight) div 2 +
527           IfThen(IsPressed, Theme^.PressedCaptionShiftY);
528         PaintIcon(C, pnt1.x, pnt1.y);
529 
530         Inc(pnt1.x, GetIconWidth+FPadding);
531         pnt1.y:= (NHeight-TextSize.cy) div 2 +
532           IfThen(IsPressed, Theme^.PressedCaptionShiftY);
533         C.TextOut(pnt1.x, pnt1.y, CurCaption);
534       end;
535 
536     abuTextIconVert:
537       begin
538         TextSize:= GetTextSize(C, CurCaption);
539         pnt1.x:= (NWidth-GetIconWidth-NSizeArrow) div 2+
540           IfThen(IsPressed, Theme^.PressedCaptionShiftX);
541         pnt1.y:= FPadding +
542           IfThen(IsPressed, Theme^.PressedCaptionShiftY);
543         PaintIcon(C, pnt1.x, pnt1.y);
544 
545         Inc(pnt1.y, GetIconHeight+FPadding);
546         pnt1.x:= (NWidth-TextSize.cx-NSizeArrow) div 2 +
547           IfThen(IsPressed, Theme^.PressedCaptionShiftX);
548         C.TextOut(pnt1.x, pnt1.y, CurCaption);
549       end;
550 
551     abuTextChoice:
552       begin
553         S:= GetTextItem(FItemIndex, '?');
554         TextSize:= C.TextExtent(S);
555 
556         RectText.Top:= 0;
557         RectText.Bottom:= NHeight;
558         RectText.Left:= IfThen(IsPressed, Theme^.PressedCaptionShiftX);
559         RectText.Right:= NWidth;
560 
561         if FArrowAlign=taLeftJustify then
562           Inc(RectText.Left, NSizeArrow)
563         else
564           Dec(RectText.Right, NSizeArrow);
565 
566         case FTextAlign of
567           taLeftJustify:
568             pnt1.x:= RectText.Left+FPadding;
569           taCenter:
570             pnt1.x:= (RectText.Width-TextSize.cx) div 2;
571           taRightJustify:
572             pnt1.x:= RectText.Right-FPadding-TextSize.cx;
573         end;
574 
575         pnt1.y:= (NHeight-TextSize.cy) div 2 +
576           IfThen(IsPressed, Theme^.PressedCaptionShiftY);
577 
578         C.TextOut(pnt1.x, pnt1.y, S);
579       end;
580 
581     abuSeparatorVert:
582       begin
583         for NSize:= 0 to Theme^.DoScale(1)-1 do
584         begin
585           pnt1:= Point(Theme^.SeparatorOffset, NHeight div 2+NSize);
586           pnt2:= Point(NWidth-Theme^.SeparatorOffset+NSize, NHeight div 2+NSize);
587           CanvasLine(C, pnt1, pnt2, Theme^.ColorSeparators);
588         end;
589       end;
590 
591     abuSeparatorHorz:
592       begin
593         for NSize:= 0 to Theme^.DoScale(1)-1 do
594         begin
595           pnt1:= Point(NWidth div 2+NSize, Theme^.SeparatorOffset);
596           pnt2:= Point(NWidth div 2+NSize, NHeight-Theme^.SeparatorOffset);
597           CanvasLine(C, pnt1, pnt2, Theme^.ColorSeparators);
598         end;
599       end;
600   end;
601 
602   if FArrow then
603   begin
604     case FArrowAlign of
605       taLeftJustify:
606         pnt1.x:= NSizeArrow;
607       taRightJustify:
608         pnt1.x:= NWidth-NSizeArrow;
609       taCenter:
610         pnt1.x:= (NWidth-NSizeArrow div 4) div 2;
611     end;
612 
613     pnt1.y:= NHeight div 2 +
614       IfThen(IsPressed, Theme^.PressedCaptionShiftY);
615 
616     PaintArrow(C, pnt1.x, pnt1.y, clNone{NColorBg}, Theme^.ColorArrows);
617   end;
618 
619   if FTextOverlay<>'' then
620   begin
621     TextSize:= C.TextExtent(FTextOverlay);
622     C.Brush.Color:= Theme^.ColorBgOverlay;
623     C.Font.Color:= Theme^.ColorFontOverlay;
624 
625     case Theme^.TextOverlayPosition of
626       bopLeftTop:
627         begin
628           pnt1.x:= 0;
629           pnt1.y:= 0;
630         end;
631       bopRightTop:
632         begin
633           pnt1.x:= NWidth-TextSize.cx;
634           pnt1.y:= 0;
635         end;
636       bopLeftBottom:
637         begin
638           pnt1.x:= 0;
639           pnt1.y:= NHeight-TextSize.cy;
640         end;
641       bopRightBottom:
642         begin
643           pnt1.x:= NWidth-TextSize.cx;
644           pnt1.y:= NHeight-TextSize.cy;
645         end;
646     end;
647 
648     C.TextOut(pnt1.x, pnt1.y, FTextOverlay);
649   end;
650 end;
651 
652 procedure TATButton.PaintIcon(C: TCanvas; AX, AY: integer);
653 begin
654   if Assigned(FImages) and (FImageIndex>=0) and (FImageIndex<FImages.Count) then
655     FImages.Draw(C, AX, AY, FImageIndex, Enabled)
656   else
657   if Assigned(FPicture) then
658     C.Draw(AX, AY, FPicture.Graphic);
659 end;
660 
661 procedure TATButton.PaintArrow(C: TCanvas; AX, AY: integer; AColorBg, AColorArrow: TColor);
662 var
663   NSize: integer;
664   R: TRect;
665 begin
666   NSize:= Theme^.DoScale(Theme^.ArrowSize);
667   R:= Rect(
668     AX-NSize*2-1,
669     AY-NSize*2-1,
670     AX+NSize*2+2,
671     AY+NSize*2+1);
672 
673   if AColorBg<>clNone then
674   begin
675     C.Brush.Color:= AColorBg;
676     C.FillRect(R);
677   end;
678 
679   case FArrowKind of
680     abakArrowDown:
681       CanvasPaintTriangleDown(C, AColorArrow, Point(AX, AY), NSize);
682     abakArrowLeft:
683       CanvasPaintTriangleLeft(C, AColorArrow, Point(AX, AY), NSize);
684     abakArrowRight:
685       CanvasPaintTriangleRight(C, AColorArrow, Point(AX, AY), NSize);
686     abakCross:
687       begin
688         NSize:= (R.Right-R.Left - Theme^.DoScale(FTheme^.XMarkWidth - FTheme^.XMarkOffsetLeft - FTheme^.XMarkOffsetRight)) div 2;
689         CanvasPaintXMark(C, R, AColorArrow,
690           NSize,
691           NSize,
692           Theme^.DoScale(FTheme^.XMarkLineWidth));
693       end;
694   end;
695 end;
696 
697 procedure TATButton.SetBoldFont(AValue: boolean);
698 begin
699   if FBoldFont=AValue then Exit;
700   FBoldFont:= AValue;
701   AutoSize:= AutoSize;
702   Invalidate;
703 end;
704 
GetIconWidthnull705 function TATButton.GetIconWidth: integer;
706 begin
707   if Assigned(FImages) then
708     Result:= FImages.Width
709   else
710   if Assigned(FPicture) then
711     Result:= FPicture.Width
712   else
713     Result:= 0;
714 end;
715 
GetIconHeightnull716 function TATButton.GetIconHeight: integer;
717 begin
718   if Assigned(FImages) then
719     Result:= FImages.Height
720   else
721   if Assigned(FPicture) then
722     Result:= FPicture.Height
723   else
724     Result:= 0;
725 end;
726 
727 procedure TATButton.MouseMove(Shift: TShiftState; X, Y: Integer);
728 var
729   bOver: boolean;
730 begin
731   inherited;
732 
733   bOver:= PtInRect(ClientRect, Point(X, Y));
734   if bOver<>FOver then
735   begin
736     FOver:= bOver;
737     Invalidate;
738   end;
739 end;
740 
741 {$ifdef FPC}
742 procedure TATButton.MouseLeave;
743 begin
744   inherited;
745   FOver:= false;
746   Invalidate;
747 end;
748 
749 procedure TATButton.MouseEnter;
750 begin
751   inherited;
752   FOver:= true;
753   Invalidate;
754 end;
755 {$endif}
756 
757 procedure TATButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
758 begin
759   inherited;
760 
761   if Shift=[ssLeft] then
762   begin
763     FPressed:= true;
764     if FFocusable then
765       SetFocus;
766   end;
767 
768   Invalidate;
769 end;
770 
771 procedure TATButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
772 begin
773   inherited;
774   FPressed:= false;
775   Invalidate;
776 end;
777 
778 procedure TATButton.KeyDown(var Key: Word; Shift: TShiftState);
779 begin
780   inherited;
781   if ((Key=VK_SPACE) or (Key=VK_RETURN)) and (Shift=[]) then
782   begin
783     Click;
784     Key:= 0;
785   end;
786 end;
787 
788 procedure TATButton.DoEnter;
789 begin
790   inherited;
791   Invalidate;
792 end;
793 
794 procedure TATButton.DoExit;
795 begin
796   inherited;
797   Invalidate;
798 end;
799 
800 {$ifdef FPC}
801 procedure TATButton.TextChanged;
802 begin
803   inherited;
804   Invalidate; //paint caption
805 end;
806 {$endif}
807 
808 procedure TATButton.Resize;
809 begin
810   inherited;
811   Invalidate;
812 end;
813 
814 procedure TATButton.SetAutoSize(AValue: boolean);
815 var
816   C: TCanvas;
817   NText, NIcon, NGap: integer;
818 begin
819   inherited;
820   if not AValue then exit;
821 
822   C:= Canvas;
823   C.Font.Name:= Theme^.FontName;
824   C.Font.Size:= Theme^.DoScaleFont(Theme^.FontSize);
825   C.Font.Style:= [];
826 
827   //if FBoldFont then
828   //  C.Font.Style:= [fsBold]
829   //else
830   //  C.Font.Style:= [];
831 
832   NText:= C.TextWidth(Caption);
833   NIcon:= GetIconWidth;
834   NGap:= Theme^.GapForAutoSize;
835 
836   case FKind of
837     abuTextOnly:
838       Width:= NText+NGap;
839     abuIconOnly:
840       Width:= NIcon+NGap;
841     abuTextIconHorz:
842       Width:= NText+NGap+NIcon+NGap;
843     abuTextIconVert:
844       Width:= Max(NIcon, NText)+NGap;
845   end;
846 end;
847 
848 constructor TATButton.Create(AOwner: TComponent);
849 begin
850   inherited;
851 
852   ControlStyle:= ControlStyle
853     +[csOpaque]
854     -[csDoubleClicks {$ifdef FPC}, csTripleClicks{$endif}];
855 
856   TabStop:= true;
857   Width:= 100;
858   Height:= 25;
859 
860   Caption:= 'Button';
861   FPicture:= TPicture.Create;
862   FPressed:= false;
863   FOver:= false;
864   FChecked:= false;
865   FCheckable:= false;
866   FFocusable:= true;
867   FFlat:= false;
868   FImages:= nil;
869   FImageIndex:= -1;
870   FKind:= abuTextOnly;
871   FBoldBorder:= false;
872   FArrow:= false;
873   FArrowKind:= abakArrowDown;
874   FArrowAlign:= taRightJustify;
875   FTextAlign:= taLeftJustify;
876   FPadding:= cDefaultButtonPadding;
877   FPaddingBig:= cDefaultButtonPaddingBig;
878   FItems:= TStringList.Create;
879   FItemsShort:= TStringList.Create;
880   FItemIndex:= -1;
881   FTheme:= @ATFlatTheme;
882   FWidthInitial:= 0;
883   FColorLine:= clNone;
884   FColorLine2:= clNone;
885 end;
886 
887 destructor TATButton.Destroy;
888 begin
889   FItemsShort.Free;
890   FItems.Free;
891   FPicture.Free;
892 
893   inherited;
894 end;
895 
GetTextSizenull896 function TATButton.GetTextSize(C: TCanvas; const S: string): TSize;
897 begin
898   Result.cx:= 0;
899   Result.cy:= 0;
900   if S='' then exit;
901 
902   if BoldFont then
903     C.Font.Style:= [fsBold]
904   else
905     C.Font.Style:= Theme^.FontStyles;
906 
907   Result:= C.TextExtent(S);
908 end;
909 
910 procedure TATButton.DoChoiceClick(Sender: TObject);
911 begin
912   ItemIndex:= (Sender as TComponent).Tag;
913   Invalidate;
914   inherited Click;
915 end;
916 
917 procedure TATButton.ShowChoiceMenu;
918 var
919   mi: TMenuItem;
920   i: integer;
921   P: TPoint;
922 begin
923   if not Assigned(FPopup) then
924     FPopup:= TPopupMenu.Create(Self);
925 
926   FPopup.Items.Clear;
927   for i:= 0 to FItems.Count-1 do
928   begin
929     mi:= TMenuItem.Create(Self);
930     mi.Caption:= FItems[i];
931     mi.Tag:= i;
932     mi.RadioItem:= true;
933     mi.Checked:= i=FItemIndex;
934 
935     mi.OnClick:= DoChoiceClick;
936 
937     FPopup.Items.Add(mi);
938   end;
939 
940   P:= ClientToScreen(Point(0, Height));
941   FPopup.PopUp(P.X, P.Y);
942 end;
943 
TATButton.GetTextItemnull944 function TATButton.GetTextItem(AIndex: integer; const ADefault: string): string;
945 begin
946   Result:= ADefault;
947   if FShowShortItems then
948   begin
949     if (AIndex>=0) and (AIndex<FItemsShort.Count) then
950       Result:= FItemsShort[AIndex];
951   end
952   else
953   begin
954     if (AIndex>=0) and (AIndex<FItems.Count) then
955       Result:= FItems[AIndex];
956   end;
957 end;
958 
959 end.
960 
961