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