1{ $Id: buttons.pp 64623 2021-02-19 02:18:02Z martin $}
2
3{
4 /***************************************************************************
5                                 buttons.pp
6                                 ----------
7                             Component Library Code
8
9
10                   Initial Revision : Sun Mar 28 23:15:32 CST 1999
11                   Revised: Sat Jul 3 1999
12
13 ***************************************************************************/
14
15 *****************************************************************************
16  This file is part of the Lazarus Component Library (LCL)
17
18  See the file COPYING.modifiedLGPL.txt, included in this distribution,
19  for details about the license.
20 *****************************************************************************
21}
22
23unit Buttons;
24
25{$mode objfpc}{$H+}
26
27interface
28
29{$ifdef Trace}
30{$ASSERTIONS ON}
31{$endif}
32
33uses
34  Types, Classes, SysUtils, Math,
35  // LCL
36  LCLType, LCLProc, LCLIntf, LCLStrConsts,
37  GraphType, Graphics, ImgList, ActnList, Controls, StdCtrls, LMessages, Forms,
38  Themes, Menus, LResources, ImageListCache,
39  // LazUtils
40  LazUtilities;
41
42type
43  TButtonLayout =
44  (
45    blGlyphLeft,
46    blGlyphRight,
47    blGlyphTop,
48    blGlyphBottom
49  );
50
51  TButtonState =
52  (
53    bsUp,       // button is up
54    bsDisabled, // button disabled (grayed)
55    bsDown,     // button is down
56    bsExclusive,// button is the only down in his group
57    bsHot       // button is under mouse
58  );
59
60  {
61   TNumGlyphs holds the number of glyphs in an image.
62   If we change this the code in SetNumGlyphs for @link(TCustomSpeedButton)
63   needs to be changed
64  }
65  TNumGlyphs = 1..5;
66
67  { TButtonGlyph }
68  TGlyphTransparencyMode = (
69    gtmGlyph,       // transparency is defined by the glyph itself (bitbtn)
70    gtmOpaque,      // transparent = false is defined by the owner (speedbutton)
71    gtmTransparent  // transparent = true
72  );
73
74  TButtonGlyph = class(TObject, IUnknown, IImageCacheListener)
75  private
76    FIsDesigning: Boolean;
77    FShowMode: TGlyphShowMode;
78    FImageIndexes: array[TButtonState] of Integer;
79    FImages: TCustomImageList;
80    FExternalImages: TCustomImageList;
81    FExternalImageIndex: Integer;
82    FExternalImageWidth: Integer;
83    FLCLGlyphResourceName: string;
84    FOriginal: TBitmap;
85    FNumGlyphs: TNumGlyphs;
86    FOnChange: TNotifyEvent;
87    FImagesCache: TImageListCache;
88    FTransparentMode: TGlyphTransparencyMode;         // set by our owner to indicate that the glyphbitmap should be transparent
89    FLCLGlyphName: string;
90    function GetHeight: Integer;
91    function GetNumGlyphs: TNumGlyphs;
92    function GetWidth: Integer;
93    procedure SetExternalImageIndex(const AExternalImageIndex: Integer);
94    procedure SetExternalImages(const AExternalImages: TCustomImageList);
95    procedure SetExternalImageWidth(const AExternalImageWidth: Integer);
96    procedure SetGlyph(Value: TBitmap);
97    procedure SetNumGlyphs(Value: TNumGlyphs);
98    procedure SetShowMode(const AValue: TGlyphShowMode);
99    procedure ClearImages;
100    procedure ClearLCLGlyph;
101    procedure SetLCLGlyphName(const ALCLGlyphName: string);
102  public
103    // IUnknown
104    function QueryInterface(constref iid: TGuid; out obj): LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
105    function _AddRef: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
106    function _Release: LongInt; {$IFDEF WINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
107    // IImageCacheListener
108    procedure CacheSetImageList(AImageList: TCustomImageList);
109    procedure CacheSetImageIndex(AIndex, AImageIndex: Integer);
110  protected
111    function CanShow: Boolean;
112    function CanShowGlyph: Boolean;
113    procedure DoChange; virtual;
114    procedure GlyphChanged(Sender: TObject);
115    procedure SetTransparentMode(AValue: TGlyphTransparencyMode);
116
117    property TransparentMode: TGlyphTransparencyMode read FTransparentMode;
118  public
119    constructor Create;
120    destructor Destroy; override;
121    procedure GetImageIndexAndEffect(State: TButtonState;
122      APPI: Integer; const ACanvasScaleFactor: Double;
123      out AImageResolution: TScaledImageListResolution;
124      out AIndex: Integer; out AEffect: TGraphicsDrawEffect);
125    function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
126                  State: TButtonState; Transparent: Boolean;
127                  BiDiFlags: Longint): TRect;
128    function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
129                  State: TButtonState; Transparent: Boolean;
130                  BiDiFlags, PPI: Longint; const ScaleFactor: Double): TRect;
131    procedure Refresh;
132    property Glyph: TBitmap read FOriginal write SetGlyph;
133    property IsDesigning: Boolean read FIsDesigning write FIsDesigning;
134    property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs;
135    property Images: TCustomImageList read FImages;
136    property LCLGlyphName: string read FLCLGlyphName write SetLCLGlyphName;
137    property ExternalImages: TCustomImageList read FExternalImages write SetExternalImages;
138    property ExternalImageIndex: Integer read FExternalImageIndex write SetExternalImageIndex;
139    property ExternalImageWidth: Integer read FExternalImageWidth write SetExternalImageWidth;
140    property Width: Integer read GetWidth;
141    property Height: Integer read GetHeight;
142    property ShowMode: TGlyphShowMode read FShowMode write SetShowMode;
143  public
144    property OnChange: TNotifyEvent read FOnChange write FOnChange;
145  end;
146
147
148  { TCustomBitBtn }
149
150  // when adding items here, also update TBitBtn.GetCaptionOfKind
151  TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo,
152                 bkClose, bkAbort, bkRetry, bkIgnore, bkAll,
153                 bkNoToAll, bkYesToAll);
154  TBitBtnKinds = set of TBitBtnKind;
155
156  TCustomBitBtn = class(TCustomButton)
157  private
158    FDefaultCaption: Boolean;
159    FKind: TBitBtnKind;
160    FLayout: TButtonLayout;
161    FMargin: integer;
162    FSpacing: Integer;
163    FImageChangeLink: TChangeLink;
164    function GetGlyph: TBitmap;
165    function GetGlyphShowMode: TGlyphShowMode;
166    function GetNumGlyphs: Integer;
167    procedure ImageListChange(Sender: TObject);
168    function IsGlyphStored: Boolean;
169    procedure SetGlyph(AValue: TBitmap);
170    procedure SetGlyphShowMode(const AValue: TGlyphShowMode);
171    procedure SetKind(AValue: TBitBtnKind);
172    procedure SetLayout(AValue: TButtonLayout);
173    procedure SetMargin(const AValue: integer);
174    procedure SetNumGlyphs(AValue: Integer);
175    procedure SetSpacing(AValue: Integer);
176    procedure RealizeKind(ForceDefaults: Boolean);
177    //Return the caption associated with the aKind value.
178    function GetCaptionOfKind(AKind: TBitBtnKind): String;
179    function GetImages: TCustomImageList;
180    procedure SetImages(const aImages: TCustomImageList);
181    function GetImageIndex: TImageIndex;
182    procedure SetImageIndex(const aImageIndex: TImageIndex);
183    function GetImageWidth: Integer;
184    procedure SetImageWidth(const aImageWidth: Integer);
185  protected
186    FButtonGlyph: TButtonGlyph;
187    class procedure WSRegisterClass; override;
188    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
189    procedure GlyphChanged(Sender: TObject);
190    procedure InitializeWnd; override;
191    function IsCaptionStored: Boolean;
192    procedure Loaded; override;
193    procedure Notification(AComponent: TComponent;
194      Operation: TOperation); override;
195    procedure TextChanged; override;
196    class function GetControlClassDefaultSize: TSize; override;
197    procedure CMAppShowBtnGlyphChanged(var Message: TLMessage); message CM_APPSHOWBTNGLYPHCHANGED;
198  public
199    constructor Create(TheOwner: TComponent); override;
200    destructor Destroy; override;
201    procedure Click; override;
202    procedure LoadGlyphFromResourceName(Instance: THandle; const AName: String);
203    procedure LoadGlyphFromLazarusResource(const AName: String);
204    procedure LoadGlyphFromStock(idButton: Integer);
205    function CanShowGlyph(const AWithShowMode: Boolean = False): Boolean;
206  public
207    property Caption stored IsCaptionStored;
208    property DefaultCaption: Boolean read FDefaultCaption write FDefaultCaption default False;
209    property Glyph: TBitmap read GetGlyph write SetGlyph stored IsGlyphStored;
210    property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs default 1;
211    property Images: TCustomImageList read GetImages write SetImages;
212    property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex default -1;
213    property ImageWidth: Integer read GetImageWidth write SetImageWidth default 0;
214    property Kind: TBitBtnKind read FKind write SetKind default bkCustom;
215    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
216    property Margin: integer read FMargin write SetMargin default -1;
217    property Spacing: Integer read FSpacing write SetSpacing default 4;
218    property GlyphShowMode: TGlyphShowMode read GetGlyphShowMode write SetGlyphShowMode default gsmApplication;
219  end;
220
221  { TBitBtn }
222  { To set custom bitbtn glyphs for the whole application, see below for
223    GetDefaultBitBtnGlyph }
224
225  TBitBtn = class(TCustomBitBtn)
226  published
227    property Action;
228    property Align;
229    property Anchors;
230    property AutoSize;
231    property BidiMode;
232    property BorderSpacing;
233    property Cancel;
234    property Caption;
235    property Color;
236    property Constraints;
237    property Default;
238    property DefaultCaption;
239    property Enabled;
240    property Font;
241    property Glyph;
242    property GlyphShowMode;
243    property Kind;
244    property Layout;
245    property Margin;
246    property ModalResult;
247    property NumGlyphs;
248    property Images;
249    property ImageIndex;
250    property ImageWidth;
251    property OnChangeBounds;
252    property OnClick;
253    property OnContextPopup;
254    property OnDragDrop;
255    property OnDragOver;
256    property OnEndDrag;
257    property OnEnter;
258    property OnExit;
259    property OnKeyDown;
260    property OnKeyPress;
261    property OnKeyUp;
262    property OnMouseDown;
263    property OnMouseEnter;
264    property OnMouseLeave;
265    property OnMouseMove;
266    property OnMouseUp;
267    property OnMouseWheel;
268    property OnMouseWheelDown;
269    property OnMouseWheelUp;
270    property OnResize;
271    property OnStartDrag;
272    property OnUTF8KeyPress;
273    property ParentBidiMode;
274    property ParentFont;
275    property ParentShowHint;
276    property PopupMenu;
277    property ShowHint;
278    property Spacing;
279    property TabOrder;
280    property TabStop;
281    property Visible;
282  end;
283
284
285  { TSpeedButtonActionLink }
286
287  TSpeedButtonActionLink = class(TControlActionLink)
288  protected
289    procedure AssignClient(AClient: TObject); override;
290    procedure SetGroupIndex(Value: Integer); override;
291    procedure SetChecked(Value: Boolean); override;
292    procedure SetImageIndex(Value: Integer); override;
293  public
294    function IsCheckedLinked: Boolean; override;
295    function IsGroupIndexLinked: Boolean; override;
296    function IsImageIndexLinked: Boolean; override;
297  end;
298
299  { TCustomSpeedButton }
300
301  TCustomSpeedButton = class(TGraphicControl)
302  private
303    FGlyph: TButtonGlyph;
304    FGroupIndex: Integer;
305    FImageChangeLink: TChangeLink;
306    FLastDrawDetails: TThemedElementDetails;
307    FLayout: TButtonLayout;
308    FMargin: integer;
309    FSpacing: integer;
310    FShortcut: TShortCut;
311    FShowAccelChar: boolean;
312    FShowCaption: boolean;
313    FAllowAllUp: Boolean;
314    FDown: Boolean;
315    FDownLoaded : Boolean;// value of Down set during loading
316    FDragging: Boolean;
317    FFlat: Boolean;
318    FMouseInControl: Boolean;
319    function GetGlyph: TBitmap;
320    procedure ImageListChange(Sender: TObject);
321    function IsGlyphStored: Boolean;
322    procedure SetShowCaption(const AValue: boolean);
323    procedure UpdateExclusive;
324    function  GetTransparent: Boolean;
325    procedure SetAllowAllUp(Value: Boolean);
326    procedure SetGlyph(Value: TBitmap);
327    procedure SetLayout(const Value: TButtonLayout);
328    procedure SetShowAccelChar(Value: boolean);
329    procedure SetTransparent(const AValue: boolean);
330    procedure CMButtonPressed(var Message: TLMessage); message CM_BUTTONPRESSED;
331    procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
332  private
333    procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton);
334    procedure WMLButtonDown(Var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
335    procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
336    procedure WMLButtonDBLCLK(Var Message: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
337    function GetImages: TCustomImageList;
338    procedure SetImages(const aImages: TCustomImageList);
339    function GetImageIndex: TImageIndex;
340    procedure SetImageIndex(const aImageIndex: TImageIndex);
341    function GetImageWidth: Integer;
342    procedure SetImageWidth(const aImageWidth: Integer);
343  protected
344    FState: TButtonState;
345    class procedure WSRegisterClass; override;
346    function ButtonGlyph: TButtonGlyph;
347    function GetNumGlyphs: Integer;
348    procedure GlyphChanged(Sender: TObject); virtual;
349    function  DialogChar(var Message: TLMKey): boolean; override;
350    procedure CalculatePreferredSize(var PreferredWidth,
351      PreferredHeight: integer; WithThemeSpace: Boolean); override;
352    procedure MeasureDraw(Draw: boolean; PaintRect: TRect;
353                          out PreferredWidth, PreferredHeight: integer);
354    procedure MouseEnter; override;
355    procedure MouseLeave; override;
356    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
357      X, Y: Integer); override;
358    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
359    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
360      X, Y: Integer); override;
361    procedure Notification(AComponent: TComponent;
362      Operation: TOperation); override;
363    procedure Paint; override;
364    procedure PaintBackground(var PaintRect: TRect); virtual;
365    procedure SetDown(Value: Boolean);
366    procedure SetGroupIndex(const Value: Integer);
367    procedure SetFlat(const Value: Boolean);
368    procedure SetMargin(const Value: integer);
369    procedure SetNumGlyphs(Value: integer);
370    procedure SetSpacing(const Value: integer);
371    procedure RealSetText(const Value: TCaption); override;
372    procedure UpdateState(InvalidateOnChange: boolean); virtual;
373    function GetDrawDetails: TThemedElementDetails; virtual;
374    property MouseInControl: Boolean read FMouseInControl;
375    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
376    function GetActionLinkClass: TControlActionLinkClass; override;
377    class function GetControlClassDefaultSize: TSize; override;
378    procedure Loaded; override;
379  protected
380    function GetGlyphSize(Drawing: boolean; PaintRect: TRect): TSize; virtual;
381    function GetTextSize(Drawing: boolean; PaintRect: TRect): TSize; virtual;
382    function DrawGlyph(ACanvas: TCanvas; const AClient: TRect; const AOffset: TPoint;
383      AState: TButtonState; ATransparent: Boolean; BiDiFlags: Longint): TRect; virtual;
384  public
385    constructor Create(AOwner: TComponent); override;
386    destructor Destroy; override;
387    function FindDownButton: TCustomSpeedButton;
388    procedure Click; override; // make Click public
389    procedure LoadGlyphFromResourceName(Instance: THandle; const AName: String);
390    procedure LoadGlyphFromLazarusResource(const AName: String);
391  public
392    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default false;
393    property Color default clBtnFace;
394    property Down: Boolean read FDown write SetDown default false;
395    property Flat: Boolean read FFlat write SetFlat default false;
396    property Glyph: TBitmap read GetGlyph write SetGlyph stored IsGlyphStored;
397    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
398    property Images: TCustomImageList read GetImages write SetImages;
399    property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex default -1;
400    property ImageWidth: Integer read GetImageWidth write SetImageWidth default 0;
401    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
402    property Margin: integer read FMargin write SetMargin default -1;
403    property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs default 1;
404    property ShowAccelChar: boolean read FShowAccelChar write SetShowAccelChar default true;
405    property ShowCaption: boolean read FShowCaption write SetShowCaption default true;
406    property Spacing: integer read FSpacing write SetSpacing default 4;
407    property Transparent: Boolean read GetTransparent write SetTransparent default true;
408  end;
409
410
411  { TSpeedButton }
412
413  TSpeedButton = class(TCustomSpeedButton)
414  published
415    property Action;
416    property Align;
417    property AllowAllUp;
418    property Anchors;
419    property AutoSize;
420    property BidiMode;
421    property BorderSpacing;
422    property Constraints;
423    property Caption;
424    property Color;
425    property Down;
426    property Enabled;
427    property Flat;
428    property Font;
429    property Glyph;
430    property GroupIndex;
431    property Images;
432    property ImageIndex;
433    property ImageWidth;
434    property Layout;
435    property Margin;
436    property NumGlyphs;
437    property Spacing;
438    property Transparent;
439    property Visible;
440    property OnClick;
441    property OnContextPopup;
442    property OnDblClick;
443    property OnMouseDown;
444    property OnMouseEnter;
445    property OnMouseLeave;
446    property OnMouseMove;
447    property OnMouseUp;
448    property OnMouseWheel;
449    property OnMouseWheelDown;
450    property OnMouseWheelUp;
451    property OnPaint;
452    property OnResize;
453    property OnChangeBounds;
454    property ShowCaption;
455    property ShowHint;
456    property ParentBidiMode;
457    property ParentFont;
458    property ParentShowHint;
459    property PopupMenu;
460  end;
461
462  { To override the default TBitBtn glyphs set GetDefaultBitBtnGlyph below.
463    Example:
464
465    function GetBitBtnGlyph(Kind: TBitBtnKind): TBitmap;
466    begin
467      if Kind in [bkOK, bkCancel] then begin
468        Result:=TBitmap.Create;
469        case Kind of
470          bkOk:      Result.Assign(MyOkGlyph);
471          bkCancel:  Result.Assign(MyCancelGlyph);
472        end;
473      end else
474        Result:=nil;
475    end;
476    }
477type
478  TGetDefaultBitBtnGlyph = function(Kind: TBitBtnKind; var Handled: Boolean): TBitmap;
479var
480  GetDefaultBitBtnGlyph: TGetDefaultBitBtnGlyph = nil;
481
482function GetLCLDefaultBtnGlyph(Kind: TBitBtnKind): TGraphic;
483procedure LoadGlyphFromResourceName(AGlyph: TButtonGlyph; Instance: THandle; const AName: String);
484procedure LoadGlyphFromLazarusResource(AGlyph: TButtonGlyph; const AName: String);
485procedure LoadGlyphFromStock(AGlyph: TButtonGlyph; idButton: Integer);
486
487// helper functions (search LCLType for idButton)
488function GetButtonCaption(idButton: Integer): String;
489function GetDefaultButtonIcon(idButton: Integer; ScalePercent: Integer = 100): TCustomBitmap;
490function GetButtonIcon(idButton: Integer): TCustomBitmap;
491function BidiAdjustButtonLayout(IsRightToLeft: Boolean; Layout: TButtonLayout): TButtonLayout;
492
493function dbgs(Kind: TBitBtnKind): string; overload;
494
495procedure Register;
496
497const
498  BitBtnModalResults: array[TBitBtnKind] of TModalResult = (
499    0, mrOK, mrCancel, 0, mrYes, mrNo,
500    mrClose, mrAbort, mrRetry, mrIgnore, mrAll,
501    mrNoToAll, mrYesToAll);
502
503  BitBtnImages: array[TBitBtnKind] of Longint = (
504    idButtonBase, idButtonOk, idButtonCancel, idButtonHelp, idButtonYes,
505    idButtonNo, idButtonClose, idButtonAbort, idButtonRetry, idButtonIgnore,
506    idButtonAll, idButtonNoToAll, idButtonYesToAll);
507
508  BitBtnResNames: array[idButtonOk..idButtonNoToAll] of String =
509  (
510{idButtonOk      } 'btn_ok',
511{idButtonCancel  } 'btn_cancel',
512{idButtonHelp    } 'btn_help',
513{idButtonYes     } 'btn_yes',
514{idButtonNo      } 'btn_no',
515{idButtonClose   } 'btn_close',
516{idButtonAbort   } 'btn_abort',
517{idButtonRetry   } 'btn_retry',
518{idButtonIgnore  } 'btn_ignore',
519{idButtonAll     } 'btn_all',
520{idButtonYesToAll} 'btn_all',
521{idButtonNoToAll } 'btn_no'
522  );
523
524implementation
525
526{$R btn_icons.res}
527
528uses
529  WSButtons;
530
531function GetLCLDefaultBtnGlyph(Kind: TBitBtnKind): TGraphic;
532begin
533  Result := GetDefaultButtonIcon(BitBtnImages[Kind]);
534end;
535
536function GetDefaultButtonIcon(idButton: Integer;
537  ScalePercent: Integer): TCustomBitmap;
538var
539  ResName: string;
540begin
541  Result := nil;
542  if (idButton < Low(BitBtnResNames)) or (idButton > High(BitBtnResNames)) then
543    Exit;
544  if BitBtnResNames[idButton] = '' then
545    Exit;
546  Result := GetDefaultGlyph(BitBtnResNames[idButton], ScalePercent);
547end;
548
549procedure LoadGlyphFromResourceName(AGlyph: TButtonGlyph; Instance: THandle; const AName: String);
550var
551  C: TCustomBitmap;
552begin
553  if AName = '' then
554    C := nil
555  else
556    C := CreateBitmapFromResourceName(Instance, AName);
557
558  try
559    AGlyph.Glyph.Assign(C);
560  finally
561    C.Free;
562  end;
563end;
564
565procedure LoadGlyphFromLazarusResource(AGlyph: TButtonGlyph; const AName: String);
566var
567  C: TCustomBitmap;
568begin
569  if AName = '' then
570    C := nil
571  else
572    C := CreateBitmapFromLazarusResource(AName);
573
574  try
575    AGlyph.Glyph.Assign(C);
576  finally
577    C.Free;
578  end;
579end;
580
581procedure LoadGlyphFromStock(AGlyph: TButtonGlyph; idButton: Integer);
582var
583  C: TCustomBitmap;
584begin
585  C := GetButtonIcon(idButton);
586  try
587    AGlyph.Glyph.Assign(C);
588  finally
589    C.Free;
590  end;
591end;
592
593function GetButtonCaption(idButton: Integer): String;
594begin
595  case idButton of
596    idButtonOk       : Result := rsmbOK;
597    idButtonCancel   : Result := rsmbCancel;
598    idButtonHelp     : Result := rsmbHelp;
599    idButtonYes      : Result := rsmbYes;
600    idButtonNo       : Result := rsmbNo;
601    idButtonClose    : Result := rsmbClose;
602    idButtonAbort    : Result := rsmbAbort;
603    idButtonRetry    : Result := rsmbRetry;
604    idButtonIgnore   : Result := rsmbIgnore;
605    idButtonAll      : Result := rsmbAll;
606    idButtonYesToAll : Result := rsmbYesToAll;
607    idButtonNoToAll  : Result := rsmbNoToAll;
608    idButtonOpen     : Result := rsmbOpen;
609    idButtonSave     : Result := rsmbSave;
610    idButtonShield   : Result := rsmbUnlock;
611  else
612    Result := '?';
613  end;
614end;
615
616function GetButtonIcon(idButton: Integer): TCustomBitmap;
617var
618  BitmapHandle, MaskHandle: HBitmap;
619begin
620  if ThemeServices.GetStockImage(idButton, BitmapHandle, MaskHandle) then
621  begin
622    Result := TBitmap.Create;
623    Result.Handle := BitmapHandle;
624    if MaskHandle <> 0 then
625      Result.MaskHandle := MaskHandle;
626  end
627  else
628    Result := GetDefaultButtonIcon(idButton);
629end;
630
631const
632  BtnBidiLayout: array[Boolean, TButtonLayout] of TButtonLayout =
633  (
634    (
635      blGlyphLeft,
636      blGlyphRight,
637      blGlyphTop,
638      blGlyphBottom
639    ),
640    (
641      blGlyphRight,
642      blGlyphLeft,
643      blGlyphTop,
644      blGlyphBottom
645    )
646  );
647
648function BidiAdjustButtonLayout(IsRightToLeft: Boolean; Layout: TButtonLayout): TButtonLayout;
649begin
650  Result := BtnBidiLayout[IsRightToLeft, Layout];
651end;
652
653function dbgs(Kind: TBitBtnKind): string;
654begin
655  Result:='';
656  writestr(Result,Kind);
657end;
658
659procedure Register;
660begin
661  RegisterComponents('Additional',[TBitBtn,TSpeedButton]);
662end;
663
664{$I bitbtn.inc}
665{$I buttonglyph.inc}
666{$I speedbutton.inc}
667
668end.
669