home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmSpeedBtns.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  53KB  |  1,885 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmSpeedBtns
  5. Purpose  : This unit provides enhanced speed button controls and
  6.            is required by various other rmControls
  7. Date     : 09-03-1998
  8. Author   : Ryan J. Mills
  9. Version  : 1.80
  10. ================================================================================}
  11.  
  12. unit rmSpeedBtns;
  13.  
  14. interface
  15.  
  16. {$I CompilerDefines.INC}
  17.  
  18. uses
  19.     Windows, Messages, Forms, Controls, Graphics, Classes, Buttons, CommCtrl,
  20.     extctrls, Menus, rmLibrary;
  21.  
  22. const
  23.   InitRepeatPause = 400;  { pause before repeat timer (ms) }
  24.   RepeatPause     = 100;  { pause before hint window displays (ms)}
  25.  
  26. type
  27.   TrmButtonState = (bsUp, bsDisabled, bsDown, bsExclusive, bsMenu);
  28.  
  29.   TrmSpeedButtonStyle = (sbsNormal, sbsComboButton, sbsMenu);
  30.  
  31.   TrmCustomSpeedButton = class(TGraphicControl)
  32.   private
  33.     FGroupIndex: Integer;
  34.     FGlyph: Pointer;
  35.     FDown: Boolean;
  36.     FDragging: Boolean;
  37.     FAllowAllUp: Boolean;
  38.     FLayout: TButtonLayout;
  39.     FSpacing: Integer;
  40.     FTransparent: Boolean;
  41.     FMargin: Integer;
  42.     FFlat: Boolean;
  43.     FMouseInControl: Boolean;
  44.  
  45.     fStyle : TrmSpeedButtonStyle;
  46.     FMenuBtnWidth: integer;
  47.     FMenuDropDown : boolean;
  48.     FDropDownMenu : TPopUpMenu;
  49.     procedure GlyphChanged(Sender: TObject);
  50.     procedure UpdateExclusive;
  51.     function GetGlyph: TBitmap;
  52.     procedure SetGlyph(Value: TBitmap);
  53.     function GetNumGlyphs: TNumGlyphs;
  54.     procedure SetNumGlyphs(Value: TNumGlyphs);
  55.     procedure SetDown(Value: Boolean);
  56.     procedure SetFlat(Value: Boolean);
  57.     procedure SetAllowAllUp(Value: Boolean);
  58.     procedure SetGroupIndex(Value: Integer);
  59.     procedure SetLayout(Value: TButtonLayout);
  60.     procedure SetSpacing(Value: Integer);
  61.     procedure SetTransparent(Value: Boolean);
  62.     procedure SetMargin(Value: Integer);
  63.     procedure UpdateTracking;
  64.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  65.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  66.     procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
  67.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  68.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  69.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  70.     procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
  71.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  72.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  73.     procedure SetDropDownMenu(const Value: TPopupMenu);
  74.     procedure SetMenuBtnWidth(const Value: integer);
  75.     procedure SetStyle(const Value: TrmSpeedButtonStyle);
  76.     procedure MenuPaint;
  77.     procedure StandardPaint;
  78.   protected
  79.     FState: TrmButtonState;
  80.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  81.     function GetPalette: HPALETTE; override;
  82.     procedure Loaded; override;
  83.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  84.       X, Y: Integer); override;
  85.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  86.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  87.       X, Y: Integer); override;
  88.     procedure Paint; override;
  89.     property MouseInControl: Boolean read FMouseInControl;
  90.  
  91.     property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
  92.     property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
  93.     property Down: Boolean read FDown write SetDown default False;
  94.     property Flat: Boolean read FFlat write SetFlat default False;
  95.     property Glyph: TBitmap read GetGlyph write SetGlyph;
  96.     property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
  97.     property Margin: Integer read FMargin write SetMargin default -1;
  98.     property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
  99.     property Spacing: Integer read FSpacing write SetSpacing default 4;
  100.     property Transparent: Boolean read FTransparent write SetTransparent default True;
  101.  
  102.     property MenuButtonWidth : integer read FMenuBtnWidth write SetMenuBtnWidth default 11;
  103.     property DropDownMenu : TPopupMenu read FDropDownMenu write SetDropDownMenu;
  104.     property Style : TrmSpeedButtonStyle read fstyle write SetStyle default sbsNormal;
  105.   public
  106.     constructor Create(AOwner: TComponent); override;
  107.     destructor Destroy; override;
  108.     procedure Click; override;
  109.   end;
  110.  
  111.   TrmSpeedButton = class(TrmCustomSpeedButton)
  112.   published
  113.     property Action;
  114.     property AllowAllUp;
  115.     property Anchors;
  116.     property BiDiMode;
  117.     property Constraints;
  118.     property DropDownMenu;
  119.     property GroupIndex;
  120.     property Down;
  121.     property Caption;
  122.     property Enabled;
  123.     property Flat;
  124.     property Font;
  125.     property Glyph;
  126.     property Layout;
  127.     property Margin;
  128.     property MenuButtonWidth;
  129.     property NumGlyphs;
  130.     property ParentFont;
  131.     property ParentShowHint;
  132.     property ParentBiDiMode;
  133.     property PopupMenu;
  134.     property ShowHint;
  135.     property Spacing;
  136.     property Style;
  137.     property Transparent;
  138.     property Visible;
  139.     property OnClick;
  140.     property OnDblClick;
  141.     property OnMouseDown;
  142.     property OnMouseMove;
  143.     property OnMouseUp;
  144.   end;
  145.  
  146. { TrmTimerSpeedButton }
  147.  
  148.   TrmTimeBtnState = set of (tbFocusRect, tbAllowTimer);
  149.  
  150.   TrmTimerSpeedButton = class(TrmSpeedButton)
  151.   private
  152.     FTimeBtnState: TrmTimeBtnState;
  153.     procedure TimerExpired(Sender: TObject);
  154.   protected
  155.     procedure Paint; override;
  156.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  157.       X, Y: Integer); override;
  158.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  159.       X, Y: Integer); override;
  160.   public
  161.     destructor Destroy; override;
  162.     property TimeBtnState: TrmTimeBtnState read FTimeBtnState write FTimeBtnState;
  163.   end;
  164.  
  165. { TrmSpinButton }
  166.  
  167.   TrmSpinButton = class (TWinControl)
  168.   private
  169.     FUpButton: TrmTimerSpeedButton;
  170.     FDownButton: TrmTimerSpeedButton;
  171.     FFocusedButton: TrmTimerSpeedButton;
  172.     FFocusControl: TWinControl;
  173.     fUpEnabled : boolean;
  174.     fDownEnabled : boolean;
  175.     FOnUpClick: TNotifyEvent;
  176.     FOnDownClick: TNotifyEvent;
  177.     fDownGlyphDefault : Boolean;
  178.     fUpGlyphDefault : boolean;
  179.     function CreateButton: TrmTimerSpeedButton;
  180.     function GetUpGlyph: TBitmap;
  181.     function GetDownGlyph: TBitmap;
  182.     procedure SetUpGlyph(Value: TBitmap);
  183.     procedure SetDownGlyph(Value: TBitmap);
  184.     function GetUpNumGlyphs: TNumGlyphs;
  185.     function GetDownNumGlyphs: TNumGlyphs;
  186.     procedure SetUpNumGlyphs(Value: TNumGlyphs);
  187.     procedure SetDownNumGlyphs(Value: TNumGlyphs);
  188.     procedure BtnClick(Sender: TObject);
  189.     procedure BtnMouseDown (Sender: TObject; Button: TMouseButton;
  190.       Shift: TShiftState; X, Y: Integer);
  191.     procedure SetFocusBtn (Btn: TrmTimerSpeedButton);
  192.     procedure AdjustSize (var W, H: Integer); reintroduce;
  193.     procedure WMSize(var Message: TWMSize);  message WM_SIZE;
  194.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  195.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  196.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  197.     function GetDownEnabled: boolean;
  198.     function GetUpEnabled: boolean;
  199.     procedure SetDownEnabled(const Value: boolean);
  200.     procedure SetUpEnabled(const Value: boolean);
  201.     procedure CMSysColorChange(var Message:TMessage); message CM_SYSCOLORCHANGE;
  202.   protected
  203.     procedure Loaded; override;
  204.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  205.     procedure Notification(AComponent: TComponent;
  206.       Operation: TOperation); override;
  207.     procedure SetEnabled(value:boolean); override;
  208.   public
  209.     constructor Create(AOwner: TComponent); override;
  210.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  211.   published
  212.     property Align;
  213.     property Anchors;
  214.     property Constraints;
  215.     property Ctl3D;
  216.     property DownGlyph: TBitmap read GetDownGlyph write SetDownGlyph;
  217.     property DownNumGlyphs: TNumGlyphs read GetDownNumGlyphs write SetDownNumGlyphs default 1;
  218.     property DownEnabled: boolean read GetDownEnabled write SetDownEnabled;
  219.     property DragCursor;
  220.     property DragKind;
  221.     property DragMode;
  222.     property Enabled;
  223.     property FocusControl: TWinControl read FFocusControl write FFocusControl;
  224.     property ParentCtl3D;
  225.     property ParentShowHint;
  226.     property PopupMenu;
  227.     property ShowHint;
  228.     property TabOrder;
  229.     property TabStop;
  230.     property UpGlyph: TBitmap read GetUpGlyph write SetUpGlyph;
  231.     property UpNumGlyphs: TNumGlyphs read GetUpNumGlyphs write SetUpNumGlyphs default 1;
  232.     property UpEnabled: boolean read GetUpEnabled write SetUpEnabled;
  233.     property Visible;
  234.     property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
  235.     property OnDragDrop;
  236.     property OnDragOver;
  237.     property OnEndDock;
  238.     property OnEndDrag;
  239.     property OnEnter;
  240.     property OnExit;
  241.     property OnStartDock;
  242.     property OnStartDrag;
  243.     property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
  244.   end;
  245.  
  246. implementation
  247.  
  248. {$R rmSBSpin.res}
  249.  
  250. uses Consts, SysUtils, ActnList, ImgList;
  251.  
  252. type
  253.   TGlyphList = class(TImageList)
  254.   private
  255.     Used: TBits;
  256.     FCount: Integer;
  257.     function AllocateIndex: Integer;
  258.   public
  259.     constructor CreateSize(AWidth, AHeight: Integer);
  260.     destructor Destroy; override;
  261.     function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
  262.     procedure Delete(Index: Integer);
  263.     property Count: Integer read FCount;
  264.   end;
  265.  
  266.   TGlyphCache = class
  267.   private
  268.     GlyphLists: TList;
  269.   public
  270.     constructor Create;
  271.     destructor Destroy; override;
  272.     function GetList(AWidth, AHeight: Integer): TGlyphList;
  273.     procedure ReturnList(List: TGlyphList);
  274.     function Empty: Boolean;
  275.   end;
  276.  
  277.   TButtonGlyph = class
  278.   private
  279.     FOriginal: TBitmap;
  280.     FGlyphList: TGlyphList;
  281.     FIndexs: array[TrmButtonState] of Integer;
  282.     FTransparentColor: TColor;
  283.     FNumGlyphs: TNumGlyphs;
  284.     FOnChange: TNotifyEvent;
  285.     procedure GlyphChanged(Sender: TObject);
  286.     procedure SetGlyph(Value: TBitmap);
  287.     procedure SetNumGlyphs(Value: TNumGlyphs);
  288.     procedure Invalidate;
  289.     function CreateButtonGlyph(State: TrmButtonState): Integer;
  290.     procedure DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint;
  291.       State: TrmButtonState; Transparent: Boolean);
  292.     procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
  293.       TextBounds: TRect; State: TrmButtonState; BiDiFlags: Longint);
  294.     procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
  295.       const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
  296.       Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
  297.       BiDiFlags: Longint);
  298.   public
  299.     constructor Create;
  300.     destructor Destroy; override;
  301.     { return the text rectangle }
  302.     function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
  303.       const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  304.       State: TrmButtonState; Style: TrmSpeedButtonStyle; Transparent: Boolean; BiDiFlags: Longint): TRect;
  305.     property Glyph: TBitmap read FOriginal write SetGlyph;
  306.     property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs;
  307.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  308.   end;
  309.  
  310. var
  311.    FUnitTimer : TTimer;
  312.  
  313. { TGlyphList }
  314.     
  315. constructor TGlyphList.CreateSize(AWidth, AHeight: Integer);
  316. begin
  317.   inherited CreateSize(AWidth, AHeight);
  318.   Used := TBits.Create;
  319. end;
  320.     
  321. destructor TGlyphList.Destroy;
  322. begin
  323.   Used.Free;
  324.   inherited Destroy;
  325. end;
  326.     
  327. function TGlyphList.AllocateIndex: Integer;
  328. begin
  329.   Result := Used.OpenBit;
  330.   if Result >= Used.Size then
  331.   begin
  332.     Result := inherited Add(nil, nil);
  333.     Used.Size := Result + 1;
  334.   end;
  335.   Used[Result] := True;
  336. end;
  337.     
  338. function TGlyphList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
  339. begin
  340.   Result := AllocateIndex;
  341.   ReplaceMasked(Result, Image, MaskColor);
  342.   Inc(FCount);
  343. end;
  344.     
  345. procedure TGlyphList.Delete(Index: Integer);
  346. begin
  347.   if Used[Index] then
  348.   begin
  349.     Dec(FCount);
  350.     Used[Index] := False;
  351.   end;
  352. end;
  353.  
  354. { TGlyphCache }
  355.     
  356. constructor TGlyphCache.Create;
  357. begin
  358.   inherited Create;
  359.   GlyphLists := TList.Create;
  360. end;
  361.     
  362. destructor TGlyphCache.Destroy;
  363. begin
  364.   GlyphLists.Free;
  365.   inherited Destroy;
  366. end;
  367.     
  368. function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList;
  369. var
  370.   I: Integer;
  371. begin
  372.   for I := GlyphLists.Count - 1 downto 0 do
  373.   begin
  374.     Result := GlyphLists[I];
  375.     with Result do
  376.       if (AWidth = Width) and (AHeight = Height) then Exit;
  377.   end;
  378.   Result := TGlyphList.CreateSize(AWidth, AHeight);
  379.   GlyphLists.Add(Result);
  380. end;
  381.     
  382. procedure TGlyphCache.ReturnList(List: TGlyphList);
  383. begin
  384.   if List = nil then Exit;
  385.   if List.Count = 0 then
  386.   begin
  387.     GlyphLists.Remove(List);
  388.     List.Free;
  389.   end;
  390. end;
  391.     
  392. function TGlyphCache.Empty: Boolean;
  393. begin
  394.   Result := GlyphLists.Count = 0;
  395. end;
  396.     
  397. var
  398.   GlyphCache: TGlyphCache = nil;
  399.   ButtonCount: Integer = 0;
  400.  
  401. { TButtonGlyph }
  402.     
  403. constructor TButtonGlyph.Create;
  404. var
  405.   I: TrmButtonState;
  406. begin
  407.   inherited Create;
  408.   FOriginal := TBitmap.Create;
  409.   FOriginal.OnChange := GlyphChanged;
  410.   FTransparentColor := clOlive;
  411.   FNumGlyphs := 1;
  412.   for I := Low(I) to High(I) do
  413.     FIndexs[I] := -1;
  414.   if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
  415. end;
  416.     
  417. destructor TButtonGlyph.Destroy;
  418. begin
  419.   FOriginal.Free;
  420.   Invalidate;
  421.   if Assigned(GlyphCache) and GlyphCache.Empty then
  422.   begin
  423.     GlyphCache.Free;
  424.     GlyphCache := nil;
  425.   end;
  426.   inherited Destroy;
  427. end;
  428.     
  429. procedure TButtonGlyph.Invalidate;
  430. var
  431.   I: TrmButtonState;
  432. begin
  433.   for I := Low(I) to High(I) do
  434.   begin
  435.     if FIndexs[I] <> -1 then FGlyphList.Delete(FIndexs[I]);
  436.     FIndexs[I] := -1;
  437.   end;
  438.   GlyphCache.ReturnList(FGlyphList);
  439.   FGlyphList := nil;
  440. end;
  441.     
  442. procedure TButtonGlyph.GlyphChanged(Sender: TObject);
  443. begin
  444.   if Sender = FOriginal then
  445.   begin
  446.     FTransparentColor := FOriginal.TransparentColor;
  447.     Invalidate;
  448.     if Assigned(FOnChange) then FOnChange(Self);
  449.   end;
  450. end;
  451.     
  452. procedure TButtonGlyph.SetGlyph(Value: TBitmap);
  453. var
  454.   Glyphs: Integer;
  455. begin
  456.   Invalidate;
  457.   FOriginal.Assign(Value);
  458.   if (Value <> nil) and (Value.Height > 0) then
  459.   begin
  460.     FTransparentColor := Value.TransparentColor;
  461.     if Value.Width mod Value.Height = 0 then
  462.     begin
  463.       Glyphs := Value.Width div Value.Height;
  464.       if Glyphs > 4 then Glyphs := 1;
  465.       SetNumGlyphs(Glyphs);
  466.     end;
  467.   end;
  468. end;
  469.     
  470. procedure TButtonGlyph.SetNumGlyphs(Value: TNumGlyphs);
  471. begin
  472.   if (Value <> FNumGlyphs) and (Value > 0) then
  473.   begin
  474.     Invalidate;
  475.     FNumGlyphs := Value;
  476.     GlyphChanged(Glyph);
  477.   end;
  478. end;
  479.  
  480. function TButtonGlyph.CreateButtonGlyph(State: TrmButtonState): Integer;
  481. const
  482.   ROP_DSPDxax = $00E20746;
  483. var
  484.   TmpImage, DDB, MonoBmp: TBitmap;
  485.   IWidth, IHeight: Integer;
  486.   IRect, ORect: TRect;
  487.   I: TrmButtonState;
  488.   DestDC: HDC;
  489. begin
  490.   if (State = bsDown) and (NumGlyphs < 3) then State := bsUp;
  491.   Result := FIndexs[State];
  492.   if Result <> -1 then Exit;
  493.   if (FOriginal.Width or FOriginal.Height) = 0 then Exit;
  494.   IWidth := FOriginal.Width div FNumGlyphs;
  495.   IHeight := FOriginal.Height;
  496.   if FGlyphList = nil then
  497.   begin
  498.     if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
  499.     FGlyphList := GlyphCache.GetList(IWidth, IHeight);
  500.   end;
  501.   TmpImage := TBitmap.Create;
  502.   try
  503.     TmpImage.Width := IWidth;
  504.     TmpImage.Height := IHeight;
  505.     IRect := Rect(0, 0, IWidth, IHeight);
  506.     TmpImage.Canvas.Brush.Color := clBtnFace;
  507.     TmpImage.Palette := CopyPalette(FOriginal.Palette);
  508.     I := State;
  509.     if Ord(I) >= NumGlyphs then I := bsUp;
  510.     ORect := Rect(Ord(I) * IWidth, 0, (Ord(I) + 1) * IWidth, IHeight);
  511.     case State of
  512.       bsUp, bsDown,
  513.       bsMenu:
  514.         begin
  515.           TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  516.           if FOriginal.TransparentMode = tmFixed then
  517.             FIndexs[State] := FGlyphList.AddMasked(TmpImage, FTransparentColor)
  518.           else
  519.             FIndexs[State] := FGlyphList.AddMasked(TmpImage, clDefault);
  520.         end;
  521.       bsDisabled:
  522.         begin
  523.           MonoBmp := nil;
  524.           DDB := nil;
  525.           try
  526.             MonoBmp := TBitmap.Create;
  527.             DDB := TBitmap.Create;
  528.             DDB.Assign(FOriginal);
  529.             DDB.HandleType := bmDDB;
  530.             if NumGlyphs > 1 then
  531.             with TmpImage.Canvas do
  532.             begin    { Change white & gray to clBtnHighlight and clBtnShadow }
  533.               CopyRect(IRect, DDB.Canvas, ORect);
  534.               MonoBmp.Monochrome := True;
  535.               MonoBmp.Width := IWidth;
  536.               MonoBmp.Height := IHeight;
  537.     
  538.               { Convert white to clBtnHighlight }
  539.               DDB.Canvas.Brush.Color := clWhite;
  540.               MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect);
  541.               Brush.Color := clBtnHighlight;
  542.               DestDC := Handle;
  543.               SetTextColor(DestDC, clBlack);
  544.               SetBkColor(DestDC, clWhite);
  545.               BitBlt(DestDC, 0, 0, IWidth, IHeight,
  546.                      MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  547.     
  548.               { Convert gray to clBtnShadow }
  549.               DDB.Canvas.Brush.Color := clGray;
  550.               MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect);
  551.               Brush.Color := clBtnShadow;
  552.               DestDC := Handle;
  553.               SetTextColor(DestDC, clBlack);
  554.               SetBkColor(DestDC, clWhite);
  555.               BitBlt(DestDC, 0, 0, IWidth, IHeight,
  556.                      MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  557.     
  558.               { Convert transparent color to clBtnFace }
  559.               DDB.Canvas.Brush.Color := ColorToRGB(FTransparentColor);
  560.               MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect);
  561.               Brush.Color := clBtnFace;
  562.               DestDC := Handle;
  563.               SetTextColor(DestDC, clBlack);
  564.               SetBkColor(DestDC, clWhite);
  565.               BitBlt(DestDC, 0, 0, IWidth, IHeight,
  566.                      MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  567.             end
  568.             else
  569.             begin
  570.               { Create a disabled version }
  571.               with MonoBmp do
  572.               begin
  573.                 Assign(FOriginal);
  574.                 HandleType := bmDDB;
  575.                 Canvas.Brush.Color := clBlack;
  576.                 Width := IWidth;
  577.                 if Monochrome then
  578.                 begin
  579.                   Canvas.Font.Color := clWhite;
  580.                   Monochrome := False;
  581.                   Canvas.Brush.Color := clWhite;
  582.                 end;
  583.                 Monochrome := True;
  584.               end;
  585.               with TmpImage.Canvas do
  586.               begin
  587.                 Brush.Color := clBtnFace;
  588.                 FillRect(IRect);
  589.                 Brush.Color := clBtnHighlight;
  590.                 SetTextColor(Handle, clBlack);
  591.                 SetBkColor(Handle, clWhite);
  592.                 BitBlt(Handle, 1, 1, IWidth, IHeight,
  593.                   MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  594.                 Brush.Color := clBtnShadow;
  595.                 SetTextColor(Handle, clBlack);
  596.                 SetBkColor(Handle, clWhite);
  597.                 BitBlt(Handle, 0, 0, IWidth, IHeight,
  598.                   MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  599.               end;
  600.             end;
  601.           finally
  602.             DDB.Free;
  603.             MonoBmp.Free;
  604.           end;
  605.           FIndexs[State] := FGlyphList.AddMasked(TmpImage, clDefault);
  606.         end;
  607.     end;
  608.   finally
  609.     TmpImage.Free;
  610.   end;
  611.   Result := FIndexs[State];
  612.   FOriginal.Dormant;
  613. end;
  614.  
  615. procedure TButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint;
  616.   State: TrmButtonState; Transparent: Boolean);
  617. var
  618.   Index: Integer;
  619. begin
  620.   if FOriginal = nil then Exit;
  621.   if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
  622.   Index := CreateButtonGlyph(State);
  623.   with GlyphPos do
  624.     if Transparent then
  625.       ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
  626.         clNone, clNone, ILD_Transparent)
  627.     else
  628.       ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
  629.         ColorToRGB(clBtnFace), clNone, ILD_Normal);
  630. end;
  631.     
  632. procedure TButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string;
  633.   TextBounds: TRect; State: TrmButtonState; BiDiFlags: LongInt);
  634. begin
  635.   with Canvas do
  636.   begin
  637.     Brush.Style := bsClear;
  638.     if State = bsDisabled then
  639.     begin
  640.       OffsetRect(TextBounds, 1, 1);
  641.       Font.Color := clBtnHighlight;
  642.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
  643.         DT_CENTER or DT_VCENTER or BiDiFlags);
  644.       OffsetRect(TextBounds, -1, -1);
  645.       Font.Color := clBtnShadow;
  646.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
  647.         DT_CENTER or DT_VCENTER or BiDiFlags);
  648.     end else
  649.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
  650.         DT_CENTER or DT_VCENTER or BiDiFlags);
  651.   end;
  652. end;
  653.     
  654. procedure TButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
  655.   const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin,
  656.   Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
  657.   BiDiFlags: LongInt);
  658. var
  659.   TextPos: TPoint;
  660.   ClientSize, GlyphSize, TextSize: TPoint;
  661.   TotalSize: TPoint;
  662. begin
  663.   if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
  664.     if Layout = blGlyphLeft then Layout := blGlyphRight
  665.     else 
  666.       if Layout = blGlyphRight then Layout := blGlyphLeft;
  667.   { calculate the item sizes }
  668.   ClientSize := Point(Client.Right - Client.Left, Client.Bottom -
  669.     Client.Top);
  670.     
  671.   if FOriginal <> nil then
  672.     GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height) else
  673.     GlyphSize := Point(0, 0);
  674.     
  675.   if Length(Caption) > 0 then
  676.   begin
  677.     TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
  678.     DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds,
  679.       DT_CALCRECT or BiDiFlags);
  680.     TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
  681.       TextBounds.Top);
  682.   end
  683.   else
  684.   begin
  685.     TextBounds := Rect(0, 0, 0, 0);
  686.     TextSize := Point(0,0);
  687.   end;
  688.  
  689.   { If the layout has the glyph on the right or the left, then both the
  690.     text and the glyph are centered vertically.  If the glyph is on the top
  691.     or the bottom, then both the text and the glyph are centered horizontally.}
  692.   if Layout in [blGlyphLeft, blGlyphRight] then
  693.   begin
  694.     GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
  695.     TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  696.   end
  697.   else
  698.   begin
  699.     GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
  700.     TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  701.   end;
  702.     
  703.   { if there is no text or no bitmap, then Spacing is irrelevant }
  704.   if (TextSize.X = 0) or (GlyphSize.X = 0) then
  705.     Spacing := 0;
  706.     
  707.   { adjust Margin and Spacing }
  708.   if Margin = -1 then
  709.   begin
  710.     if Spacing = -1 then
  711.     begin
  712.       TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
  713.       if Layout in [blGlyphLeft, blGlyphRight] then
  714.         Margin := (ClientSize.X - TotalSize.X) div 3
  715.       else
  716.         Margin := (ClientSize.Y - TotalSize.Y) div 3;
  717.       Spacing := Margin;
  718.     end
  719.     else
  720.     begin
  721.       TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y +
  722.         Spacing + TextSize.Y);
  723.       if Layout in [blGlyphLeft, blGlyphRight] then
  724.         Margin := (ClientSize.X - TotalSize.X + 1) div 2
  725.       else
  726.         Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
  727.     end;
  728.   end
  729.   else
  730.   begin
  731.     if Spacing = -1 then
  732.     begin
  733.       TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y -
  734.         (Margin + GlyphSize.Y));
  735.       if Layout in [blGlyphLeft, blGlyphRight] then
  736.         Spacing := (TotalSize.X - TextSize.X) div 2
  737.       else
  738.         Spacing := (TotalSize.Y - TextSize.Y) div 2;
  739.     end;
  740.   end;
  741.     
  742.   case Layout of
  743.     blGlyphLeft:
  744.       begin
  745.         GlyphPos.X := Margin;
  746.         TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
  747.       end;
  748.     blGlyphRight:
  749.       begin
  750.         GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
  751.         TextPos.X := GlyphPos.X - Spacing - TextSize.X;
  752.       end;
  753.     blGlyphTop:
  754.       begin
  755.         GlyphPos.Y := Margin;
  756.         TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
  757.       end;
  758.     blGlyphBottom:
  759.       begin
  760.         GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
  761.         TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
  762.       end;
  763.   end;
  764.     
  765.   { fixup the result variables }
  766.   with GlyphPos do
  767.   begin
  768.     Inc(X, Client.Left + Offset.X);
  769.     Inc(Y, Client.Top + Offset.Y);
  770.   end;
  771.   OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X,
  772.     TextPos.Y + Client.Top + Offset.X);
  773. end;
  774.  
  775. function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
  776.       const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  777.       State: TrmButtonState; Style: TrmSpeedButtonStyle; Transparent: Boolean; BiDiFlags: Longint): TRect;
  778. var
  779.   GlyphPos: TPoint;
  780.   bmp : TBitmap;
  781. begin
  782.   if Style = sbsMenu then
  783.   begin
  784.     bmp := tbitmap.create;
  785.     try
  786.        bmp.canvas.font.assign(canvas.font);
  787.        bmp.Height := client.bottom-client.top;
  788.        bmp.width := client.right-client.left;
  789.  
  790.        CalcButtonLayout(bmp.Canvas, Client, Offset, Caption, Layout, Margin, Spacing,
  791.          GlyphPos, Result, BiDiFlags);
  792.  
  793.        bmp.transparent := true;
  794.        bmp.TransparentColor := bmp.canvas.Font.color + $010101;
  795.        bmp.canvas.brush.color := bmp.TransparentColor;
  796.        bmp.Canvas.FillRect(client);
  797.  
  798.        DrawButtonGlyph(bmp.Canvas, GlyphPos, State, true);
  799.        DrawButtonText(bmp.Canvas, Caption, Result, State, BiDiFlags);
  800.        Canvas.Draw(1,1,bmp);
  801.     finally
  802.        bmp.free;
  803.     end;
  804.   end
  805.   else
  806.   begin
  807.     CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin, Spacing,
  808.       GlyphPos, Result, BiDiFlags);
  809.     DrawButtonGlyph(Canvas, GlyphPos, State, true);
  810.     DrawButtonText(Canvas, Caption, Result, State, BiDiFlags);
  811.   end;
  812. end;
  813.  
  814. { TrmCustomSpeedButton }
  815.  
  816. constructor TrmCustomSpeedButton.Create(AOwner: TComponent);
  817. begin
  818.   FGlyph := TButtonGlyph.Create;
  819.   TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  820.   inherited Create(AOwner);
  821.   FMenuDropDown := false;
  822.   fMenuBtnWidth := 11;
  823.   FDropDownMenu := nil;
  824.   SetBounds(0, 0, 23, 22);
  825.   ControlStyle := [csCaptureMouse, csDoubleClicks];
  826.   ParentFont := True;
  827.   Color := clBtnFace;
  828.   FSpacing := 4;
  829.   FMargin := -1;
  830.   FLayout := blGlyphLeft;
  831.   FTransparent := True;
  832.   Inc(ButtonCount);
  833. end;
  834.  
  835. destructor TrmCustomSpeedButton.Destroy;
  836. begin
  837.   Dec(ButtonCount);
  838.   inherited Destroy;
  839.   TButtonGlyph(FGlyph).Free;
  840. end;
  841.  
  842. procedure TrmCustomSpeedButton.StandardPaint;
  843. const
  844.   DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  845.   FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
  846. var
  847.   PaintRect: TRect;
  848.   DrawFlags: Integer;
  849.   Offset: TPoint;
  850. begin
  851.   if not Enabled then
  852.   begin
  853.     FState := bsDisabled;
  854.     FDragging := False;
  855.   end
  856.   else if FState = bsDisabled then
  857.     if FDown and (GroupIndex <> 0) then
  858.       FState := bsExclusive
  859.     else
  860.       FState := bsUp;
  861.   Canvas.Font := Self.Font;
  862.   PaintRect := Rect(0, 0, Width, Height);
  863.   if not FFlat then
  864.   begin
  865.     if Style = sbsNormal then
  866.     begin
  867.          DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  868.          if FState in [bsDown, bsExclusive] then
  869.            DrawFlags := DrawFlags or DFCS_PUSHED;
  870.          DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
  871.     end
  872.     else
  873.     begin
  874.          if fstate in [bsDown, bsExclusive] then
  875.             frame3d(canvas,paintrect,clbtnshadow,clbtnshadow,1)
  876.          else
  877.          begin
  878.               frame3d(canvas,paintrect,clbtnface,cl3ddkshadow,1);
  879.               frame3d(canvas,paintrect,clbtnhighlight,clbtnshadow,1);
  880.          end;
  881.          canvas.Brush.color := clbtnface;
  882.          canvas.fillrect(PaintRect);
  883.     end;
  884.   end
  885.   else
  886.   begin
  887.     if (FState in [bsDown, bsExclusive]) or
  888.       (FMouseInControl and (FState <> bsDisabled)) or
  889.       (csDesigning in ComponentState) then
  890.       DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
  891.         FillStyles[FFlat] or BF_RECT);
  892.     InflateRect(PaintRect, -1, -1);
  893.   end;
  894.   if FState in [bsDown, bsExclusive] then
  895.   begin
  896.     if (FState = bsExclusive) and (not FFlat or not FMouseInControl) then
  897.     begin
  898.       Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
  899.       Canvas.FillRect(PaintRect);
  900.     end;
  901.     Offset.X := 0;
  902.     Offset.Y := 0;
  903.     if fStyle = sbsNormal then
  904.     begin
  905.          Offset.X := 1;
  906.          Offset.Y := 1;
  907.     end;
  908.   end
  909.   else
  910.   begin
  911.     Offset.X := 0;
  912.     Offset.Y := 0;
  913.     if fStyle = sbsComboButton then
  914.     begin
  915.          offset.x := -1;
  916.          offset.y := -1;
  917.     end;
  918.   end;
  919.   TButtonGlyph(FGlyph).Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin,
  920.     FSpacing, FState, fStyle, FFlat, DrawTextBiDiModeFlags(0));
  921. end;
  922.  
  923. procedure TrmCustomSpeedButton.MenuPaint;
  924. const
  925.   DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  926.   FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
  927. var
  928.   PaintRect1,         //Main Button
  929.   PaintRect2: TRect; //Drop down Button
  930.   DrawFlags: Integer;
  931.   Offset: TPoint;
  932. begin
  933.   PaintRect1 := Rect(0, 0, Width-MenuButtonWidth, Height);
  934.   PaintRect2 := Rect((Width-MenuButtonWidth), 0, Width, Height);
  935.  
  936.   if not Enabled then
  937.   begin
  938.     FState := bsDisabled;
  939.     FDragging := False;
  940.   end
  941.   else if FState = bsDisabled then
  942.       FState := bsUp;
  943.   Canvas.Font := Self.Font;
  944.   if not FFlat then
  945.   begin
  946.     DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  947.     if FState in [bsDown] then
  948.        DrawFlags := DrawFlags or DFCS_PUSHED;
  949.  
  950.     DrawFrameControl(Canvas.Handle, PaintRect1, DFC_BUTTON, DrawFlags);
  951.  
  952.     if FState in [bsDown, bsMenu] then
  953.        DrawFlags := DrawFlags or DFCS_PUSHED;
  954.  
  955.     DrawFrameControl(Canvas.Handle, PaintRect2, DFC_BUTTON, DrawFlags);
  956.   end
  957.   else
  958.   begin
  959.     if (FState in [bsDown, bsMenu]) or
  960.       (FMouseInControl and (FState <> bsDisabled)) or
  961.       (csDesigning in ComponentState) then
  962.     begin
  963.       DrawEdge(Canvas.Handle, PaintRect1, DownStyles[FState in [bsDown]],
  964.         FillStyles[Transparent] or BF_RECT);
  965.  
  966.       DrawEdge(Canvas.Handle, PaintRect2, DownStyles[FState in [bsDown, bsMenu]],
  967.         FillStyles[Transparent] or BF_RECT);
  968.     end
  969.     else if not Transparent then
  970.     begin
  971.       Canvas.Brush.Color := Color;
  972.       Canvas.FillRect(PaintRect1);
  973.       Canvas.FillRect(PaintRect2);
  974.     end;
  975.     InflateRect(PaintRect1, -1, -1);
  976.   end;
  977.   if FState in [bsDown] then
  978.   begin
  979.     Offset.X := 1;
  980.     Offset.Y := 1;
  981.   end
  982.   else
  983.   begin
  984.     Offset.X := 0;
  985.     Offset.Y := 0;
  986.   end;
  987.  
  988.   TButtonGlyph(FGlyph).Draw(Canvas, PaintRect1, Offset, Caption, FLayout, FMargin,
  989.     FSpacing, FState, FStyle, Transparent, DrawTextBiDiModeFlags(0));
  990.  
  991.   Canvas.Font.Name := 'Marlett';
  992.   try
  993.      Canvas.brush.style := bsclear;
  994.      PaintRect2 := Rect((Width-MenuButtonWidth), 0, Width, Height);
  995.  
  996.      InflateRect(PaintRect2, -1, -1);
  997.      Canvas.Font.height := (PaintRect2.right - PaintRect2.left);
  998.  
  999.      if FState in [bsDown, bsMenu] then
  1000.      begin
  1001.        PaintRect2.bottom := paintRect2.Bottom+1;
  1002.        if fflat then
  1003.        begin
  1004.           paintrect2.left := paintrect2.Left + 1;
  1005.           paintrect2.right := paintrect2.right + 1;
  1006.        end;
  1007.      end
  1008.      else
  1009.      begin
  1010.        if not fflat then
  1011.           PaintRect2.Left := paintRect2.left - 1;
  1012.      end;
  1013.  
  1014.      canvas.font.style := [];
  1015.      canvas.font.color := clBtnText;
  1016.  
  1017.      if FState in [bsDisabled] then
  1018.         DrawGrayText(canvas, '6', PaintRect2, DT_CENTER or DT_VCENTER or DT_SINGLELINE)
  1019.      else
  1020.         DrawText(canvas.handle,'6', 1, PaintRect2, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  1021.  
  1022.   finally
  1023.      Canvas.Font.assign(Font);
  1024.   end;
  1025. end;
  1026.  
  1027. procedure TrmCustomSpeedButton.Paint;
  1028. begin
  1029.   case fStyle of
  1030.      sbsNormal, sbsComboButton: StandardPaint;
  1031.      sbsMenu  : MenuPaint;
  1032.   else
  1033.      raise exception.create('Unknown button style.');
  1034.   end;
  1035. end;
  1036.  
  1037. procedure TrmCustomSpeedButton.UpdateTracking;
  1038. var
  1039.   P: TPoint;
  1040. begin
  1041.   if FFlat then
  1042.   begin
  1043.     if Enabled then
  1044.     begin
  1045.       GetCursorPos(P);
  1046.       FMouseInControl := not (FindDragTarget(P, True) = Self);
  1047.       if FMouseInControl then
  1048.         Perform(CM_MOUSELEAVE, 0, 0)
  1049.       else
  1050.         Perform(CM_MOUSEENTER, 0, 0);
  1051.     end;
  1052.   end;
  1053. end;
  1054.     
  1055. procedure TrmCustomSpeedButton.Loaded;
  1056. var
  1057.   State: TrmButtonState;
  1058. begin
  1059.   inherited Loaded;
  1060.   if Enabled then
  1061.     State := bsUp
  1062.   else
  1063.     State := bsDisabled;
  1064.   TButtonGlyph(FGlyph).CreateButtonGlyph(State);
  1065. end;
  1066.  
  1067. procedure TrmCustomSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1068.   X, Y: Integer);
  1069. begin
  1070.   inherited MouseDown(Button, Shift, X, Y);
  1071.   if (Button = mbLeft) and Enabled then
  1072.   begin
  1073.     if fStyle in [sbsNormal, sbsComboButton] then
  1074.     begin
  1075.        if not fDown then
  1076.        begin
  1077.          FState := bsDown;
  1078.          Invalidate;
  1079.        end;
  1080.     end
  1081.     else if fstyle = sbsmenu then
  1082.     begin
  1083.        if ptinrect(Rect((Width-MenuButtonWidth), 0, Width, Height), point(x,y)) then
  1084.        begin
  1085.           FState := bsMenu;
  1086.           FMenuDropDown := true;
  1087.        end
  1088.        else
  1089.           FState := bsDown;
  1090.        Invalidate;
  1091.     end;
  1092.     FDragging := True;
  1093.   end;
  1094. end;
  1095.  
  1096. procedure TrmCustomSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer);
  1097. var
  1098.   NewState: TrmButtonState;
  1099.   UpdateState : boolean;
  1100. begin
  1101.   inherited MouseMove(Shift, X, Y);
  1102.   if FDragging then
  1103.   begin
  1104.     if fstyle = sbsmenu then
  1105.     begin
  1106.        NewState := bsUp;
  1107.  
  1108.        if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y < ClientHeight) then
  1109.        begin
  1110.           if ptinrect(Rect(0, 0, Width-MenuButtonWidth, Height), point(x,y)) then
  1111.              NewState := bsDown
  1112.           else
  1113.              NewState := bsMenu;
  1114.  
  1115.           if ((newState = bsDown) and FMenuDropDown) then
  1116.           begin
  1117.              if fState = bsMenu then
  1118.                 newState := bsup
  1119.              else
  1120.                 newState := fState;
  1121.           end
  1122.           else
  1123.           if ((newState = bsMenu) and not FMenuDropDown) then
  1124.              newState := bsDown;
  1125.        end;
  1126.  
  1127.        updatestate := (NewState <> FState) and not
  1128.                       (((newState = bsDown) and (fState = bsMenu)) or
  1129.                        ((newState = bsMenu) and (fState = bsDown)));
  1130.     end
  1131.     else //[sbsNormal, sbsComboButton]
  1132.     begin
  1133.        if not FDown then
  1134.           NewState := bsUp
  1135.        else
  1136.           NewState := bsExclusive;
  1137.  
  1138.        if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
  1139.          if FDown then
  1140.             NewState := bsExclusive
  1141.          else
  1142.             NewState := bsDown;
  1143.  
  1144.        updatestate := (NewState <> FState);
  1145.     end;
  1146.  
  1147.     if updatestate then
  1148.     begin
  1149.       FState := NewState;
  1150.       Invalidate;
  1151.     end;
  1152.  
  1153.   end
  1154.   else if not FMouseInControl then
  1155.     UpdateTracking;
  1156. end;
  1157.     
  1158. procedure TrmCustomSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  1159.   X, Y: Integer);
  1160. var
  1161.   DoClick: Boolean;
  1162.   DoMenuClick : Boolean;
  1163.   DisplayPos : TPoint;
  1164. begin
  1165.   inherited MouseUp(Button, Shift, X, Y);
  1166.   if FDragging then
  1167.   begin
  1168.     FDragging := False;
  1169.  
  1170.     if fStyle in [sbsNormal, sbsComboButton] then
  1171.     begin
  1172.        DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
  1173.  
  1174.        if FGroupIndex = 0 then
  1175.        begin
  1176.          { Redraw face in-case mouse is captured }
  1177.          FState := bsUp;
  1178.          FMouseInControl := False;
  1179.          if DoClick and not (FState in [bsExclusive, bsDown]) then
  1180.            Invalidate;
  1181.        end
  1182.        else
  1183.          if DoClick then
  1184.          begin
  1185.            SetDown(not FDown);
  1186.            if FDown then Repaint;
  1187.          end
  1188.          else
  1189.          begin
  1190.            if FDown then FState := bsExclusive;
  1191.            Repaint;
  1192.          end;
  1193.     end
  1194.     else
  1195.     begin
  1196.        DoClick := ((X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y < ClientHeight)) and
  1197.                   not FMenuDropDown;
  1198.  
  1199.        DoMenuClick := (ptinrect(Rect((Width-MenuButtonWidth), 0, Width, Height), point(x,y)) and fMenuDropDown);
  1200.  
  1201.        if DoMenuClick then
  1202.        begin
  1203.           displaypos := parent.clienttoscreen(point(left, top+height));
  1204.           if assigned(FDropDownMenu) then
  1205.              FDropDownMenu.popup(displaypos.x, displaypos.y);
  1206.        end;
  1207.  
  1208.        FState := bsUp;
  1209.        FMenuDropDown := false;
  1210.        FMouseInControl := False;
  1211.  
  1212.        if (DoClick or DoMenuClick) and not (FState in [bsMenu, bsDown]) then
  1213.           Invalidate;
  1214.     end;
  1215.  
  1216.     if DoClick then
  1217.        Click;
  1218.  
  1219.     UpdateTracking;
  1220.   end;
  1221. end;
  1222.     
  1223. procedure TrmCustomSpeedButton.Click;
  1224. begin
  1225.   inherited Click;
  1226. end;
  1227.     
  1228. function TrmCustomSpeedButton.GetPalette: HPALETTE;
  1229. begin
  1230.   Result := Glyph.Palette;
  1231. end;
  1232.     
  1233. function TrmCustomSpeedButton.GetGlyph: TBitmap;
  1234. begin
  1235.   Result := TButtonGlyph(FGlyph).Glyph;
  1236. end;
  1237.     
  1238. procedure TrmCustomSpeedButton.SetGlyph(Value: TBitmap);
  1239. begin
  1240.   TButtonGlyph(FGlyph).Glyph := Value;
  1241.   Invalidate;
  1242. end;
  1243.     
  1244. function TrmCustomSpeedButton.GetNumGlyphs: TNumGlyphs;
  1245. begin
  1246.   Result := TButtonGlyph(FGlyph).NumGlyphs;
  1247. end;
  1248.     
  1249. procedure TrmCustomSpeedButton.SetNumGlyphs(Value: TNumGlyphs);
  1250. begin
  1251.   if Value < 0 then Value := 1
  1252.   else if Value > 4 then Value := 4;
  1253.   if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  1254.   begin
  1255.     TButtonGlyph(FGlyph).NumGlyphs := Value;
  1256.     Invalidate;
  1257.   end;
  1258. end;
  1259.     
  1260. procedure TrmCustomSpeedButton.GlyphChanged(Sender: TObject);
  1261. begin
  1262.   Invalidate;
  1263. end;
  1264.     
  1265. procedure TrmCustomSpeedButton.UpdateExclusive;
  1266. var
  1267.   Msg: TMessage;
  1268. begin
  1269.   if (FGroupIndex <> 0) and (Parent <> nil) then
  1270.   begin
  1271.     Msg.Msg := CM_BUTTONPRESSED;
  1272.     Msg.WParam := FGroupIndex;
  1273.     Msg.LParam := Longint(Self);
  1274.     Msg.Result := 0;
  1275.     Parent.Broadcast(Msg);
  1276.   end;
  1277. end;
  1278.     
  1279. procedure TrmCustomSpeedButton.SetDown(Value: Boolean);
  1280. begin
  1281.   if FGroupIndex = 0 then Value := False;
  1282.   if FStyle = sbsMenu then value := false;
  1283.   if Value <> FDown then
  1284.   begin
  1285.     if FDown and (not FAllowAllUp) then Exit;
  1286.     FDown := Value;
  1287.     if Value then
  1288.     begin
  1289.       if FState = bsUp then Invalidate;
  1290.       FState := bsExclusive
  1291.     end
  1292.     else
  1293.     begin
  1294.       FState := bsUp;
  1295.       Repaint;
  1296.     end;
  1297.     if Value then UpdateExclusive;
  1298.   end;
  1299. end;
  1300.     
  1301. procedure TrmCustomSpeedButton.SetFlat(Value: Boolean);
  1302. begin
  1303.   if fStyle = sbsComboButton then value := false;   
  1304.   if Value <> FFlat then
  1305.   begin
  1306.     FFlat := Value;
  1307.     Invalidate;
  1308.   end;
  1309. end;
  1310.     
  1311. procedure TrmCustomSpeedButton.SetGroupIndex(Value: Integer);
  1312. begin
  1313.   if FStyle in [sbsMenu, sbsComboButton] then value := 0;
  1314.   if (FGroupIndex <> Value) then
  1315.   begin
  1316.     FGroupIndex := Value;
  1317.     UpdateExclusive;
  1318.   end;
  1319. end;
  1320.     
  1321. procedure TrmCustomSpeedButton.SetLayout(Value: TButtonLayout);
  1322. begin
  1323.   if FLayout <> Value then
  1324.   begin
  1325.     FLayout := Value;
  1326.     Invalidate;
  1327.   end;
  1328. end;
  1329.     
  1330. procedure TrmCustomSpeedButton.SetMargin(Value: Integer);
  1331. begin
  1332.   if (Value <> FMargin) and (Value >= -1) then
  1333.   begin
  1334.     FMargin := Value;
  1335.     Invalidate;
  1336.   end;
  1337. end;
  1338.     
  1339. procedure TrmCustomSpeedButton.SetSpacing(Value: Integer);
  1340. begin
  1341.   if Value <> FSpacing then
  1342.   begin
  1343.     FSpacing := Value;
  1344.     Invalidate;
  1345.   end;
  1346. end;
  1347.  
  1348. procedure TrmCustomSpeedButton.SetTransparent(Value: Boolean);
  1349. begin
  1350.   if FStyle = sbsComboButton then value := false;
  1351.   if Value <> FTransparent then
  1352.   begin
  1353.     FTransparent := Value;
  1354.     if Value then
  1355.       ControlStyle := ControlStyle - [csOpaque] else
  1356.       ControlStyle := ControlStyle + [csOpaque];
  1357.     Invalidate;
  1358.   end;
  1359. end;
  1360.  
  1361. procedure TrmCustomSpeedButton.SetAllowAllUp(Value: Boolean);
  1362. begin
  1363.   if FStyle in [sbsMenu, sbsComboButton] then value := false;
  1364.  
  1365.   if FAllowAllUp <> Value then
  1366.   begin
  1367.     FAllowAllUp := Value;
  1368.     UpdateExclusive;
  1369.   end;
  1370. end;
  1371.     
  1372. procedure TrmCustomSpeedButton.WMLButtonDblClk(var Message: TWMLButtonDown);
  1373. begin
  1374.   inherited;
  1375.   if FDown then DblClick;
  1376. end;
  1377.     
  1378. procedure TrmCustomSpeedButton.CMEnabledChanged(var Message: TMessage);
  1379. const
  1380.   NewState: array[Boolean] of TrmButtonState = (bsDisabled, bsUp);
  1381. begin
  1382.   TButtonGlyph(FGlyph).CreateButtonGlyph(NewState[Enabled]);
  1383.   UpdateTracking;
  1384.   Repaint;
  1385. end;
  1386.     
  1387. procedure TrmCustomSpeedButton.CMButtonPressed(var Message: TMessage);
  1388. var
  1389.   Sender: TrmCustomSpeedButton;
  1390. begin
  1391.   if Message.WParam = FGroupIndex then
  1392.   begin
  1393.     Sender := TrmCustomSpeedButton(Message.LParam);
  1394.     if Sender <> Self then
  1395.     begin
  1396.       if Sender.Down and FDown then
  1397.       begin
  1398.         FDown := False;
  1399.         FState := bsUp;
  1400.         Invalidate;
  1401.       end;
  1402.       FAllowAllUp := Sender.AllowAllUp;
  1403.     end;
  1404.   end;
  1405. end;
  1406.     
  1407. procedure TrmCustomSpeedButton.CMDialogChar(var Message: TCMDialogChar);
  1408. begin
  1409.   with Message do
  1410.     if IsAccel(CharCode, Caption) and Enabled and Visible and
  1411.       (Parent <> nil) and Parent.Showing then
  1412.     begin
  1413.       Click;
  1414.       Result := 1;
  1415.     end else
  1416.       inherited;
  1417. end;
  1418.     
  1419. procedure TrmCustomSpeedButton.CMFontChanged(var Message: TMessage);
  1420. begin
  1421.   Invalidate;
  1422. end;
  1423.     
  1424. procedure TrmCustomSpeedButton.CMTextChanged(var Message: TMessage);
  1425. begin
  1426.   Invalidate;
  1427. end;
  1428.     
  1429. procedure TrmCustomSpeedButton.CMSysColorChange(var Message: TMessage);
  1430. begin
  1431.   with TButtonGlyph(FGlyph) do
  1432.   begin
  1433.     Invalidate;
  1434.     CreateButtonGlyph(FState);
  1435.   end;
  1436. end;
  1437.     
  1438. procedure TrmCustomSpeedButton.CMMouseEnter(var Message: TMessage);
  1439. begin
  1440.   inherited;
  1441.   { Don't draw a border if DragMode <> dmAutomatic since this button is meant to 
  1442.     be used as a dock client. }
  1443.   if FFlat and not FMouseInControl and Enabled and (DragMode <> dmAutomatic) 
  1444.     and (GetCapture = 0) then
  1445.   begin
  1446.     FMouseInControl := True;
  1447.     Repaint;
  1448.   end;
  1449. end;
  1450.  
  1451. procedure TrmCustomSpeedButton.CMMouseLeave(var Message: TMessage);
  1452. begin
  1453.   inherited;
  1454.   if FFlat and FMouseInControl and Enabled and not FDragging then
  1455.   begin
  1456.     FMouseInControl := False;
  1457.     Invalidate;
  1458.   end;
  1459. end;
  1460.  
  1461. procedure TrmCustomSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
  1462.  
  1463.   procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
  1464.   begin
  1465.     with Glyph do
  1466.     begin
  1467.       Width := ImageList.Width;
  1468.       Height := ImageList.Height;
  1469.       Canvas.Brush.Color := clFuchsia;//! for lack of a better color
  1470.       Canvas.FillRect(Rect(0,0, Width, Height));
  1471.       ImageList.Draw(Canvas, 0, 0, Index);
  1472.     end;
  1473.   end;
  1474.  
  1475. begin
  1476.   inherited ActionChange(Sender, CheckDefaults);
  1477.   if Sender is TCustomAction then
  1478.     with TCustomAction(Sender) do
  1479.     begin
  1480.       { Copy image from action's imagelist }
  1481.       if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
  1482.         (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
  1483.         CopyImage(ActionList.Images, ImageIndex);
  1484.     end;
  1485. end;
  1486.  
  1487. procedure TrmCustomSpeedButton.SetDropDownMenu(const Value: TPopupMenu);
  1488. begin
  1489.   FDropDownMenu := Value;
  1490. end;
  1491.  
  1492. procedure TrmCustomSpeedButton.SetMenuBtnWidth(const Value: integer);
  1493. begin
  1494.   if FMenuBtnWidth <> Value then
  1495.   begin
  1496.      FMenuBtnWidth := Value;
  1497.      invalidate;
  1498.   end;
  1499. end;
  1500.  
  1501. procedure TrmCustomSpeedButton.SetStyle(const Value: TrmSpeedButtonStyle);
  1502. begin
  1503.   if value <> fstyle then
  1504.   begin
  1505.     fstyle := value;
  1506.     if fstyle = sbsMenu then
  1507.     begin
  1508.        FGroupIndex := 0;
  1509.        FDown := false;
  1510.        FAllowAllUp := false;
  1511.        UpdateExclusive;
  1512.     end;
  1513.     if fstyle = sbsComboButton then
  1514.     begin
  1515.        FGroupIndex := 0;
  1516.        FDown := false;
  1517.        FAllowAllUp := false;
  1518.        FFlat := false;
  1519.        FTransparent := false;
  1520.        UpdateExclusive;
  1521.     end;
  1522.     repaint;
  1523.   end;
  1524. end;
  1525.  
  1526. {TrmTimerSpeedButton}
  1527.  
  1528. destructor TrmTimerSpeedButton.Destroy;
  1529. begin
  1530.   inherited Destroy;
  1531. end;
  1532.  
  1533. procedure TrmTimerSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1534.   X, Y: Integer);
  1535. begin
  1536.   inherited MouseDown (Button, Shift, X, Y);
  1537.   if tbAllowTimer in FTimeBtnState then
  1538.   begin
  1539.     FUnitTimer.OnTimer := TimerExpired;
  1540.     FUnitTimer.Interval := InitRepeatPause;
  1541.     FUnitTimer.Enabled  := True;
  1542.   end;
  1543. end;
  1544.  
  1545. procedure TrmTimerSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  1546.                                   X, Y: Integer);
  1547. begin
  1548.   inherited MouseUp (Button, Shift, X, Y);
  1549.   FUnitTimer.Enabled := false;
  1550.   FUnitTimer.OnTimer := nil;
  1551. end;
  1552.  
  1553. procedure TrmTimerSpeedButton.TimerExpired(Sender: TObject);
  1554. begin
  1555.   FUnitTimer.Interval := RepeatPause;
  1556.   if (FState = bsDown) and MouseCapture then
  1557.   begin
  1558.     try
  1559.       Click;
  1560.     except
  1561.       FUnitTimer.Enabled := False;
  1562.       raise;
  1563.     end;
  1564.   end;
  1565. end;
  1566.  
  1567. procedure TrmTimerSpeedButton.Paint;
  1568. var
  1569.   R: TRect;
  1570. begin
  1571.   inherited Paint;
  1572.   if tbFocusRect in FTimeBtnState then
  1573.   begin
  1574.     R := Bounds(0, 0, Width, Height);
  1575.     InflateRect(R, -3, -3);
  1576.     if FState = bsDown then
  1577.       OffsetRect(R, 1, 1);
  1578.     DrawFocusRect(Canvas.Handle, R);
  1579.   end;
  1580. end;
  1581.  
  1582. { TrmSpinButton }
  1583.  
  1584. constructor TrmSpinButton.Create(AOwner: TComponent);
  1585. begin
  1586.   inherited Create(AOwner);
  1587.   ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] +
  1588.     [csOpaque];
  1589.  
  1590.   FUpButton := CreateButton;
  1591.   FDownButton := CreateButton;
  1592.  
  1593.   fDownGlyphDefault := true;
  1594.   fUpGlyphDefault := true;
  1595.  
  1596.   UpGlyph := nil;
  1597.   DownGlyph := nil;
  1598.  
  1599.   Width := 20;
  1600.   Height := 2;
  1601.   fUpEnabled := true;
  1602.   fDownEnabled := true;
  1603.  
  1604.   FFocusedButton := FUpButton;
  1605. end;
  1606.  
  1607. function TrmSpinButton.CreateButton: TrmTimerSpeedButton;
  1608. begin
  1609.   Result := TrmTimerSpeedButton.Create (Self);
  1610.   Result.OnClick := BtnClick;
  1611.   Result.OnMouseDown := BtnMouseDown;
  1612.   Result.Visible := True;
  1613.   Result.Enabled := True;
  1614.   Result.TimeBtnState := [tbAllowTimer];
  1615.   Result.Parent := Self;
  1616.   Result.Style := sbsComboButton;
  1617.   Result.Layout := blGlyphTop;
  1618. end;
  1619.  
  1620. procedure TrmSpinButton.Notification(AComponent: TComponent;
  1621.   Operation: TOperation);
  1622. begin
  1623.   inherited Notification(AComponent, Operation);
  1624.   if (Operation = opRemove) and (AComponent = FFocusControl) then
  1625.     FFocusControl := nil;
  1626. end;
  1627.  
  1628. procedure TrmSpinButton.AdjustSize (var W, H: Integer);
  1629. begin
  1630.   if (FUpButton = nil) or (csLoading in ComponentState) then
  1631.     Exit;
  1632.   if W < 15 then W := 15;
  1633.   FUpButton.SetBounds (0, 0, W, H div 2);
  1634.   FDownButton.SetBounds (0, FUpButton.Height, W, (H div 2) + (h mod 2));
  1635. end;
  1636.  
  1637. procedure TrmSpinButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  1638. var
  1639.   W, H: Integer;
  1640. begin
  1641.   W := AWidth;
  1642.   H := AHeight;
  1643.   AdjustSize (W, H);
  1644.   inherited SetBounds (ALeft, ATop, W, H);
  1645. end;
  1646.  
  1647. procedure TrmSpinButton.WMSize(var Message: TWMSize);
  1648. var
  1649.   W, H: Integer;
  1650. begin
  1651.   inherited;
  1652.  
  1653.   { check for minimum size }
  1654.   W := Width;
  1655.   H := Height;
  1656.   AdjustSize (W, H);
  1657.   if (W <> Width) or (H <> Height) then
  1658.     inherited SetBounds(Left, Top, W, H);
  1659.   Message.Result := 0;
  1660. end;
  1661.  
  1662. procedure TrmSpinButton.WMSetFocus(var Message: TWMSetFocus);
  1663. begin
  1664.   FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
  1665.   FFocusedButton.Invalidate;
  1666. end;
  1667.  
  1668. procedure TrmSpinButton.WMKillFocus(var Message: TWMKillFocus);
  1669. begin
  1670.   FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
  1671.   FFocusedButton.Invalidate;
  1672. end;
  1673.  
  1674. procedure TrmSpinButton.KeyDown(var Key: Word; Shift: TShiftState);
  1675. begin
  1676.   case Key of
  1677.     VK_UP:
  1678.       begin
  1679.         SetFocusBtn (FUpButton);
  1680.         FUpButton.Click;
  1681.       end;
  1682.     VK_DOWN:
  1683.       begin
  1684.         SetFocusBtn (FDownButton);
  1685.         FDownButton.Click;
  1686.       end;
  1687.     VK_SPACE:
  1688.       FFocusedButton.Click;
  1689.   end;
  1690. end;
  1691.  
  1692. procedure TrmSpinButton.BtnMouseDown (Sender: TObject; Button: TMouseButton;
  1693.   Shift: TShiftState; X, Y: Integer);
  1694. begin
  1695.   if Button = mbLeft then
  1696.   begin
  1697.     SetFocusBtn (TrmTimerSpeedButton (Sender));
  1698.     if (FFocusControl <> nil) and FFocusControl.TabStop and 
  1699.         FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then
  1700.       FFocusControl.SetFocus
  1701.     else if TabStop and (GetFocus <> Handle) and CanFocus then
  1702.       SetFocus;
  1703.   end;
  1704. end;
  1705.  
  1706. procedure TrmSpinButton.BtnClick(Sender: TObject);
  1707. begin
  1708.   if Sender = FUpButton then
  1709.   begin
  1710.     if Assigned(FOnUpClick) then FOnUpClick(Self);
  1711.   end
  1712.   else
  1713.     if Assigned(FOnDownClick) then FOnDownClick(Self);
  1714. end;
  1715.  
  1716. procedure TrmSpinButton.SetFocusBtn (Btn: TrmTimerSpeedButton);
  1717. begin
  1718.   if TabStop and CanFocus and  (Btn <> FFocusedButton) then
  1719.   begin
  1720.     FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
  1721.     FFocusedButton := Btn;
  1722.     if (GetFocus = Handle) then 
  1723.     begin
  1724.        FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
  1725.        Invalidate;
  1726.     end;
  1727.   end;
  1728. end;
  1729.  
  1730. procedure TrmSpinButton.WMGetDlgCode(var Message: TWMGetDlgCode);
  1731. begin
  1732.   Message.Result := DLGC_WANTARROWS;
  1733. end;
  1734.  
  1735. procedure TrmSpinButton.Loaded;
  1736. var
  1737.   W, H: Integer;
  1738. begin
  1739.   inherited Loaded;
  1740.   W := Width;
  1741.   H := Height;
  1742.   AdjustSize (W, H);
  1743.   if (W <> Width) or (H <> Height) then
  1744.     inherited SetBounds (Left, Top, W, H);
  1745. end;
  1746.  
  1747. function TrmSpinButton.GetUpGlyph: TBitmap;
  1748. begin
  1749.   Result := FUpButton.Glyph;
  1750. end;
  1751.  
  1752. procedure TrmSpinButton.SetUpGlyph(Value: TBitmap);
  1753. var
  1754.    bmp : TBitmap;
  1755. begin
  1756.   if Value <> nil then
  1757.   begin
  1758.     FUpButton.Glyph := Value;
  1759.     fUpGlyphDefault := false;
  1760.   end
  1761.   else
  1762.   begin
  1763.     bmp := tbitmap.create;
  1764.     try
  1765.        fUpGlyphDefault := true;
  1766.        bmp.LoadFromResourceName(HInstance, 'rm_SpinUp');
  1767.        ReplaceColors(bmp, clBtnFace, clBtnText);
  1768.        FUpButton.Glyph := bmp;
  1769.     finally
  1770.        bmp.free;
  1771.     end;
  1772.   end;
  1773. end;
  1774.  
  1775. function TrmSpinButton.GetUpNumGlyphs: TNumGlyphs;
  1776. begin
  1777.   Result := FUpButton.NumGlyphs;
  1778. end;
  1779.  
  1780. procedure TrmSpinButton.SetUpNumGlyphs(Value: TNumGlyphs);
  1781. begin
  1782.   FUpButton.NumGlyphs := Value;
  1783. end;
  1784.  
  1785. function TrmSpinButton.GetDownGlyph: TBitmap;
  1786. begin
  1787.   Result := FDownButton.Glyph;
  1788. end;
  1789.  
  1790. procedure TrmSpinButton.SetDownGlyph(Value: TBitmap);
  1791. var
  1792.    bmp : TBitmap;
  1793. begin
  1794.   if Value <> nil then
  1795.   begin
  1796.     FDownButton.Glyph := Value;
  1797.     fDownGlyphDefault := false;
  1798.   end
  1799.   else
  1800.   begin
  1801.     bmp := tbitmap.create;
  1802.     try
  1803.        fDownGlyphDefault := true;
  1804.        bmp.LoadFromResourceName(HInstance, 'rm_SpinDown');
  1805.        ReplaceColors(bmp, clBtnFace, clBtnText);
  1806.        FDownButton.Glyph := bmp;
  1807.     finally
  1808.        bmp.free;
  1809.     end;
  1810.   end;
  1811. end;
  1812.  
  1813. function TrmSpinButton.GetDownNumGlyphs: TNumGlyphs;
  1814. begin
  1815.   Result := FDownButton.NumGlyphs;
  1816. end;
  1817.  
  1818. procedure TrmSpinButton.SetDownNumGlyphs(Value: TNumGlyphs);
  1819. begin
  1820.   FDownButton.NumGlyphs := Value;
  1821. end;
  1822.  
  1823. function TrmSpinButton.GetDownEnabled: boolean;
  1824. begin
  1825.    result := FDownButton.Enabled;  
  1826. end;
  1827.  
  1828. function TrmSpinButton.GetUpEnabled: boolean;
  1829. begin
  1830.    result := FUpButton.Enabled;
  1831. end;
  1832.  
  1833. procedure TrmSpinButton.SetDownEnabled(const Value: boolean);
  1834. begin
  1835.    if FDownEnabled <> value then
  1836.    begin
  1837.       fDownEnabled := value;
  1838.       FDownButton.Enabled := fDownEnabled and enabled;
  1839.    end;
  1840. end;
  1841.  
  1842. procedure TrmSpinButton.SetUpEnabled(const Value: boolean);
  1843. begin
  1844.    if fUpEnabled <> value then
  1845.    begin
  1846.       fUpEnabled := value;
  1847.       FUpButton.Enabled := fUpEnabled and enabled;
  1848.    end;
  1849. end;
  1850.  
  1851. procedure TrmSpinButton.CMSysColorChange(var Message: TMessage);
  1852. begin
  1853.    if fUpGlyphDefault then
  1854.       SetUpGlyph(nil);
  1855.  
  1856.    if fDownGlyphDefault then
  1857.       SetDownGlyph(nil);
  1858. end;
  1859.  
  1860. procedure TrmSpinButton.SetEnabled(value: boolean);
  1861. begin
  1862.   if value <> Enabled then
  1863.   begin
  1864.      if value = false then
  1865.      begin
  1866.         fUpButton.enabled := false;
  1867.         fDownButton.enabled := false;
  1868.      end
  1869.      else
  1870.      begin
  1871.         FUpButton.Enabled := fUpEnabled;
  1872.         FDownButton.enabled := fDownEnabled;
  1873.      end;
  1874.   end;
  1875.   inherited;
  1876. end;
  1877.  
  1878. initialization
  1879.   fUnitTimer := TTimer.create(nil);
  1880.  
  1881. finalization
  1882.   fUnitTimer.Free;
  1883.  
  1884. end.
  1885.