home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / prezent / cb / data.z / BUTTONS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-16  |  40KB  |  1,437 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Buttons;
  11.  
  12. {$S-,W-,R-}
  13. {$C PRELOAD}
  14.  
  15. interface
  16.  
  17. uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls,
  18.   ExtCtrls, CommCtrl;
  19.  
  20. type
  21.   TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
  22.   TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive);
  23.   TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
  24.   TNumGlyphs = 1..4;
  25.  
  26.   TSpeedButton = class(TGraphicControl)
  27.   private
  28.     FGroupIndex: Integer;
  29.     FGlyph: Pointer;
  30.     FDown: Boolean;
  31.     FDragging: Boolean;
  32.     FAllowAllUp: Boolean;
  33.     FLayout: TButtonLayout;
  34.     FSpacing: Integer;
  35.     FMargin: Integer;
  36.     procedure GlyphChanged(Sender: TObject);
  37.     procedure UpdateExclusive;
  38.     function GetGlyph: TBitmap;
  39.     procedure SetGlyph(Value: TBitmap);
  40.     function GetNumGlyphs: TNumGlyphs;
  41.     procedure SetNumGlyphs(Value: TNumGlyphs);
  42.     procedure SetDown(Value: Boolean);
  43.     procedure SetAllowAllUp(Value: Boolean);
  44.     procedure SetGroupIndex(Value: Integer);
  45.     procedure SetLayout(Value: TButtonLayout);
  46.     procedure SetSpacing(Value: Integer);
  47.     procedure SetMargin(Value: Integer);
  48.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  49.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  50.     procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
  51.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  52.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  53.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  54.     procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
  55.   protected
  56.     FState: TButtonState;
  57.     function GetPalette: HPALETTE; override;
  58.     procedure Loaded; override;
  59.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  60.       X, Y: Integer); override;
  61.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  62.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  63.       X, Y: Integer); override;
  64.     procedure Paint; override;
  65.   public
  66.     constructor Create(AOwner: TComponent); override;
  67.     destructor Destroy; override;
  68.     procedure Click; override;
  69.   published
  70.     property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
  71.     property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
  72.     property Down: Boolean read FDown write SetDown default False;
  73.     property Caption;
  74.     property Enabled;
  75.     property Font;
  76.     property Glyph: TBitmap read GetGlyph write SetGlyph;
  77.     property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
  78.     property Margin: Integer read FMargin write SetMargin default -1;
  79.     property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
  80.     property ParentFont;
  81.     property ParentShowHint;
  82.     property ShowHint;
  83.     property Spacing: Integer read FSpacing write SetSpacing default 4;
  84.     property Visible;
  85.     property OnClick;
  86.     property OnDblClick;
  87.     property OnMouseDown;
  88.     property OnMouseMove;
  89.     property OnMouseUp;
  90.   end;
  91.  
  92.   TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, bkClose,
  93.     bkAbort, bkRetry, bkIgnore, bkAll);
  94.  
  95.   TBitBtn = class(TButton)
  96.   private
  97.     FCanvas: TCanvas;
  98.     FGlyph: Pointer;
  99.     FStyle: TButtonStyle;
  100.     FKind: TBitBtnKind;
  101.     FLayout: TButtonLayout;
  102.     FSpacing: Integer;
  103.     FMargin: Integer;
  104.     IsFocused: Boolean;
  105.     FModifiedGlyph: Boolean;
  106.  
  107.     procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
  108.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  109.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  110.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  111.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
  112.       message WM_LBUTTONDBLCLK;
  113.  
  114.     procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
  115.     procedure SetGlyph(Value: TBitmap);
  116.     function GetGlyph: TBitmap;
  117.     function GetNumGlyphs: TNumGlyphs;
  118.     procedure SetNumGlyphs(Value: TNumGlyphs);
  119.  
  120.     procedure GlyphChanged(Sender: TObject);
  121.     function IsCustom: Boolean;
  122.     function IsCustomCaption: Boolean;
  123.     procedure SetStyle(Value: TButtonStyle);
  124.     procedure SetKind(Value: TBitBtnKind);
  125.     function GetKind: TBitBtnKind;
  126.     procedure SetLayout(Value: TButtonLayout);
  127.     procedure SetSpacing(Value: Integer);
  128.     procedure SetMargin(Value: Integer);
  129.   protected
  130.     procedure CreateHandle; override;
  131.     procedure CreateParams(var Params: TCreateParams); override;
  132.     function GetPalette: HPALETTE; override;
  133.     procedure SetButtonStyle(ADefault: Boolean); override;
  134.   public
  135.     constructor Create(AOwner: TComponent); override;
  136.     destructor Destroy; override;
  137.     procedure Click; override;
  138.   published
  139.     property Cancel stored IsCustom;
  140.     property Caption stored IsCustomCaption;
  141.     property Default stored IsCustom;
  142.     property Enabled;
  143.     property Glyph: TBitmap read GetGlyph write SetGlyph stored IsCustom;
  144.     property Kind: TBitBtnKind read GetKind write SetKind default bkCustom;
  145.     property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
  146.     property Margin: Integer read FMargin write SetMargin default -1;
  147.     property ModalResult stored IsCustom;
  148.     property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs stored IsCustom default 1;
  149.     property ParentShowHint;
  150.     property ShowHint;
  151.     property Style: TButtonStyle read FStyle write SetStyle default bsAutoDetect;
  152.     property Spacing: Integer read FSpacing write SetSpacing default 4;
  153.     property TabOrder;
  154.     property TabStop;
  155.     property Visible;
  156.     property OnEnter;
  157.     property OnExit;
  158.   end;
  159.  
  160. function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
  161.   BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown,
  162.   IsFocused: Boolean): TRect;
  163.  
  164. implementation
  165.  
  166. uses Consts, SysUtils;
  167.  
  168. {$R BUTTONS.RES}
  169.  
  170. { TBitBtn data }
  171. const
  172.   BitBtnResNames: array[TBitBtnKind] of PChar = (
  173.     nil, 'BBOK', 'BBCANCEL', 'BBHELP', 'BBYES', 'BBNO', 'BBCLOSE',
  174.     'BBABORT', 'BBRETRY', 'BBIGNORE', 'BBALL');
  175.   BitBtnCaptions: array[TBitBtnKind] of Word = (
  176.     0, SOKButton, SCancelButton, SHelpButton, SYesButton, SNoButton,
  177.     SCloseButton, SAbortButton, SRetryButton, SIgnoreButton,
  178.     SAllButton);
  179.   BitBtnModalResults: array[TBitBtnKind] of TModalResult = (
  180.     0, mrOk, mrCancel, 0, mrYes, mrNo, 0, mrAbort, mrRetry, mrIgnore,
  181.     mrAll);
  182.  
  183. var
  184.   BitBtnGlyphs: array[TBitBtnKind] of TBitmap;
  185.  
  186. { DrawButtonFace - returns the remaining usable area inside the Client rect.}
  187. function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
  188.   BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown,
  189.   IsFocused: Boolean): TRect;
  190. var
  191.   NewStyle: Boolean;
  192.   R: TRect;
  193.   DC: THandle;
  194. begin
  195.   NewStyle := ((Style = bsAutoDetect) and NewStyleControls) or (Style = bsNew);
  196.  
  197.   R := Client;
  198.   with Canvas do
  199.   begin
  200.     if NewStyle then
  201.     begin
  202.       Brush.Color := clBtnFace;
  203.       Brush.Style := bsSolid;
  204.       DC := Canvas.Handle;    { Reduce calls to GetHandle }
  205.  
  206.       if IsDown then
  207.       begin    { DrawEdge is faster than Polyline }
  208.         DrawEdge(DC, R, BDR_SUNKENINNER, BF_TOPLEFT);              { black     }
  209.         DrawEdge(DC, R, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);          { btnhilite }
  210.         Dec(R.Bottom);
  211.         Dec(R.Right);
  212.         Inc(R.Top);
  213.         Inc(R.Left);
  214.         DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT or BF_MIDDLE); { btnshadow }
  215.       end
  216.       else
  217.       begin
  218.         DrawEdge(DC, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);          { black }
  219.         Dec(R.Bottom);
  220.         Dec(R.Right);
  221.         DrawEdge(DC, R, BDR_RAISEDINNER, BF_TOPLEFT);              { btnhilite }
  222.         Inc(R.Top);
  223.         Inc(R.Left);
  224.         DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_MIDDLE); { btnshadow }
  225.       end;
  226.     end
  227.     else
  228.     begin
  229.       Pen.Color := clWindowFrame;
  230.       Brush.Color := clBtnFace;
  231.       Brush.Style := bsSolid;
  232.       Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  233.  
  234.       { round the corners - only applies to Win 3.1 style buttons }
  235.       if IsRounded then
  236.       begin
  237.         Pixels[R.Left, R.Top] := clBtnFace;
  238.         Pixels[R.Left, R.Bottom - 1] := clBtnFace;
  239.         Pixels[R.Right - 1, R.Top] := clBtnFace;
  240.         Pixels[R.Right - 1, R.Bottom - 1] := clBtnFace;
  241.       end;
  242.  
  243.       if IsFocused then
  244.       begin
  245.         InflateRect(R, -1, -1);
  246.         Brush.Style := bsClear;
  247.         Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  248.       end;
  249.  
  250.       InflateRect(R, -1, -1);
  251.       if not IsDown then
  252.         Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, BevelWidth)
  253.       else
  254.       begin
  255.         Pen.Color := clBtnShadow;
  256.         PolyLine([Point(R.Left, R.Bottom - 1), Point(R.Left, R.Top),
  257.           Point(R.Right, R.Top)]);
  258.       end;
  259.     end;
  260.   end;
  261.  
  262.   Result := Rect(Client.Left + 1, Client.Top + 1,
  263.     Client.Right - 2, Client.Bottom - 2);
  264.   if IsDown then OffsetRect(Result, 1, 1);
  265. end;
  266.  
  267. function GetBitBtnGlyph(Kind: TBitBtnKind): TBitmap;
  268. begin
  269.   if BitBtnGlyphs[Kind] = nil then
  270.   begin
  271.     BitBtnGlyphs[Kind] := TBitmap.Create;
  272.     BitBtnGlyphs[Kind].Handle := LoadBitmap(HInstance, BitBtnResNames[Kind]);
  273.   end;
  274.   Result := BitBtnGlyphs[Kind];
  275. end;
  276.  
  277. type
  278.   TGlyphList = class(TImageList)
  279.   private
  280.     Used: TBits;
  281.     FCount: Integer;
  282.     function AllocateIndex: Integer;
  283.   public
  284.     constructor Create(AWidth, AHeight: Integer);
  285.     destructor Destroy; override;
  286.     function Add(Image, Mask: TBitmap): Integer;
  287.     function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
  288.     procedure Delete(Index: Integer);
  289.     property Count: Integer read FCount;
  290.   end;
  291.  
  292.   TGlyphCache = class
  293.   private
  294.     GlyphLists: TList;
  295.   public
  296.     constructor Create;
  297.     destructor Destroy; override;
  298.     function GetList(AWidth, AHeight: Integer): TGlyphList;
  299.     procedure ReturnList(List: TGlyphList);
  300.     function Empty: Boolean;
  301.   end;
  302.  
  303.   TButtonGlyph = class
  304.   private
  305.     FOriginal: TBitmap;
  306.     FGlyphList: TGlyphList;
  307.     FIndexs: array[TButtonState] of Integer;
  308.     FTransparentColor: TColor;
  309.     FNumGlyphs: TNumGlyphs;
  310.     FOnChange: TNotifyEvent;
  311.     procedure GlyphChanged(Sender: TObject);
  312.     procedure SetGlyph(Value: TBitmap);
  313.     procedure SetNumGlyphs(Value: TNumGlyphs);
  314.     procedure Invalidate;
  315.     function CreateButtonGlyph(State: TButtonState): Integer;
  316.     procedure DrawButtonGlyph(Canvas: TCanvas; X, Y: Integer;
  317.       State: TButtonState);
  318.     procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
  319.       TextBounds: TRect; State: TButtonState);
  320.     procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
  321.       const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  322.       var GlyphPos: TPoint; var TextBounds: TRect);
  323.   public
  324.     constructor Create;
  325.     destructor Destroy; override;
  326.     { return the text rectangle }
  327.     function Draw(Canvas: TCanvas; const Client: TRect;
  328.       const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  329.       State: TButtonState): TRect;
  330.     property Glyph: TBitmap read FOriginal write SetGlyph;
  331.     property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs;
  332.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  333.   end;
  334.  
  335. { TGlyphList }
  336.  
  337. constructor TGlyphList.Create(AWidth, AHeight: Integer);
  338. begin
  339.   inherited CreateSize(AWidth, AHeight);
  340.   Used := TBits.Create;
  341. end;
  342.  
  343. destructor TGlyphList.Destroy;
  344. begin
  345.   Used.Free;
  346.   inherited Destroy;
  347. end;
  348.  
  349. function TGlyphList.AllocateIndex: Integer;
  350. begin
  351.   Result := Used.OpenBit;
  352.   if Result >= Used.Size then
  353.   begin
  354.     Result := inherited Add(nil, nil);
  355.     Used.Size := Result + 1;
  356.   end;
  357.   Used[Result] := True;
  358. end;
  359.  
  360. function TGlyphList.Add(Image, Mask: TBitmap): Integer;
  361. begin
  362.   Result := AllocateIndex;
  363.   Replace(Result, Image, Mask);
  364.   Inc(FCount);
  365. end;
  366.  
  367. function TGlyphList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
  368. begin
  369.   Result := AllocateIndex;
  370.   ReplaceMasked(Result, Image, MaskColor);
  371.   Inc(FCount);
  372. end;
  373.  
  374. procedure TGlyphList.Delete(Index: Integer);
  375. begin
  376.   if Used[Index] then
  377.   begin
  378.     Dec(FCount);
  379.     Used[Index] := False;
  380.   end;
  381. end;
  382.  
  383. { TGlyphCache }
  384.  
  385. constructor TGlyphCache.Create;
  386. begin
  387.   inherited Create;
  388.   GlyphLists := TList.Create;
  389. end;
  390.  
  391. destructor TGlyphCache.Destroy;
  392. begin
  393.   GlyphLists.Free;
  394.   inherited Destroy;
  395. end;
  396.  
  397. function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList;
  398. var
  399.   I: Integer;
  400. begin
  401.   for I := GlyphLists.Count - 1 downto 0 do
  402.   begin
  403.     Result := GlyphLists[I];
  404.     with Result do
  405.       if (AWidth = Width) and (AHeight = Height) then Exit;
  406.   end;
  407.   Result := TGlyphList.Create(AWidth, AHeight);
  408.   GlyphLists.Add(Result);
  409. end;
  410.  
  411. procedure TGlyphCache.ReturnList(List: TGlyphList);
  412. begin
  413.   if List = nil then Exit;
  414.   if List.Count = 0 then
  415.   begin
  416.     GlyphLists.Remove(List);
  417.     List.Free;
  418.   end;
  419. end;
  420.  
  421. function TGlyphCache.Empty: Boolean;
  422. begin
  423.   Result := GlyphLists.Count = 0;
  424. end;
  425.  
  426. var
  427.   GlyphCache: TGlyphCache = nil;
  428.   Pattern: TBitmap = nil;
  429.   ButtonCount: Integer = 0;
  430.  
  431. procedure CreateBrushPattern;
  432. var
  433.   X, Y: Integer;
  434. begin
  435.   Pattern := TBitmap.Create;
  436.   Pattern.Width := 8;
  437.   Pattern.Height := 8;
  438.   with Pattern.Canvas do
  439.   begin
  440.     Brush.Style := bsSolid;
  441.     Brush.Color := clBtnFace;
  442.     FillRect(Rect(0, 0, Pattern.Width, Pattern.Height));
  443.     for Y := 0 to 7 do
  444.       for X := 0 to 7 do
  445.         if (Y mod 2) = (X mod 2) then  { toggles between even/odd pixles }
  446.           Pixels[X, Y] := clWhite;     { on even/odd rows }
  447.   end;
  448. end;
  449.  
  450. { TButtonGlyph }
  451.  
  452. constructor TButtonGlyph.Create;
  453. var
  454.   I: TButtonState;
  455. begin
  456.   inherited Create;
  457.   FOriginal := TBitmap.Create;
  458.   FOriginal.OnChange := GlyphChanged;
  459.   FTransparentColor := clOlive;
  460.   FNumGlyphs := 1;
  461.   for I := Low(I) to High(I) do
  462.     FIndexs[I] := -1;
  463.   if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
  464. end;
  465.  
  466. destructor TButtonGlyph.Destroy;
  467. begin
  468.   FOriginal.Free;
  469.   Invalidate;
  470.   if Assigned(GlyphCache) and GlyphCache.Empty then
  471.   begin
  472.     GlyphCache.Free;
  473.     GlyphCache := nil;
  474.   end;
  475.   inherited Destroy;
  476. end;
  477.  
  478. procedure TButtonGlyph.Invalidate;
  479. var
  480.   I: TButtonState;
  481. begin
  482.   for I := Low(I) to High(I) do
  483.   begin
  484.     if FIndexs[I] <> -1 then FGlyphList.Delete(FIndexs[I]);
  485.     FIndexs[I] := -1;
  486.   end;
  487.   GlyphCache.ReturnList(FGlyphList);
  488.   FGlyphList := nil;
  489. end;
  490.  
  491. procedure TButtonGlyph.GlyphChanged(Sender: TObject);
  492. begin
  493.   if Sender = FOriginal then
  494.   begin
  495.     FTransparentColor := FOriginal.TransparentColor;
  496.     Invalidate;
  497.     if Assigned(FOnChange) then FOnChange(Self);
  498.   end;
  499. end;
  500.  
  501. procedure TButtonGlyph.SetGlyph(Value: TBitmap);
  502. var
  503.   Glyphs: Integer;
  504. begin
  505.   Invalidate;
  506.   FOriginal.Assign(Value);
  507.   if (Value <> nil) and (Value.Height > 0) then
  508.   begin
  509.     FTransparentColor := Value.TransparentColor;
  510.     if Value.Width mod Value.Height = 0 then
  511.     begin
  512.       Glyphs := Value.Width div Value.Height;
  513.       if Glyphs > 4 then Glyphs := 1;
  514.       SetNumGlyphs(Glyphs);
  515.     end;
  516.   end;
  517. end;
  518.  
  519. procedure TButtonGlyph.SetNumGlyphs(Value: TNumGlyphs);
  520. begin
  521.   if (Value <> FNumGlyphs) and (Value > 0) then
  522.   begin
  523.     Invalidate;
  524.     FNumGlyphs := Value;
  525.   end;
  526. end;
  527.  
  528. function TButtonGlyph.CreateButtonGlyph(State: TButtonState): Integer;
  529. const
  530.   ROP_DSPDxax = $00E20746;
  531. var
  532.   TmpImage, MonoBmp: TBitmap;
  533.   IWidth, IHeight: Integer;
  534.   IRect, ORect: TRect;
  535.   I: TButtonState;
  536.   DestDC: HDC;
  537. begin
  538.   if (State = bsDown) and (NumGlyphs < 3) then State := bsUp;
  539.   Result := FIndexs[State];
  540.   if Result <> -1 then Exit;
  541.   if (FOriginal.Width or FOriginal.Height) = 0 then Exit;
  542.   IWidth := FOriginal.Width div FNumGlyphs;
  543.   IHeight := FOriginal.Height;
  544.   if FGlyphList = nil then
  545.   begin
  546.     if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
  547.     FGlyphList := GlyphCache.GetList(IWidth, IHeight);
  548.   end;
  549.   TmpImage := TBitmap.Create;
  550.   try
  551.     TmpImage.Width := IWidth;
  552.     TmpImage.Height := IHeight;
  553.     IRect := Rect(0, 0, IWidth, IHeight);
  554.     TmpImage.Canvas.Brush.Color := clBtnFace;
  555.     I := State;
  556.     if Ord(I) >= NumGlyphs then I := bsUp;
  557.     ORect := Rect(Ord(I) * IWidth, 0, (Ord(I) + 1) * IWidth, IHeight);
  558.     case State of
  559.       bsUp, bsDown:
  560.         begin
  561.           TmpImage.Canvas.BrushCopy(IRect, FOriginal, ORect, FTransparentColor);
  562.           FIndexs[State] := FGlyphList.Add(TmpImage, nil);
  563.         end;
  564.       bsExclusive:
  565.         begin
  566.           TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  567.           FIndexs[State] := FGlyphList.AddMasked(TmpImage, FTransparentColor);
  568.         end;
  569.       bsDisabled:
  570.         begin
  571.           MonoBmp := TBitmap.Create;
  572.           try
  573.             if NumGlyphs > 1 then
  574.             with TmpImage.Canvas do
  575.             begin    { Change white & gray to clBtnHighlight and clBtnShadow }
  576.               CopyRect(IRect, FOriginal.Canvas, ORect);
  577.               MonoBmp.Width := IWidth;
  578.               MonoBmp.Height := IHeight;
  579.               MonoBmp.Monochrome := True;
  580.  
  581.               { Convert white to clBtnHighlight }
  582.               FOriginal.Canvas.Brush.Color := clWhite;
  583.               MonoBmp.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  584.               Brush.Color := clBtnHighlight;
  585.               DestDC := Handle;
  586.               SetTextColor(DestDC, clBlack);
  587.               SetBkColor(DestDC, clWhite);
  588.               BitBlt(DestDC, 0, 0, IWidth, IHeight,
  589.                      MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  590.  
  591.               { Convert gray to clBtnShadow }
  592.               FOriginal.Canvas.Brush.Color := clGray;
  593.               MonoBmp.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  594.               Brush.Color := clBtnShadow;
  595.               DestDC := Handle;
  596.               SetTextColor(DestDC, clBlack);
  597.               SetBkColor(DestDC, clWhite);
  598.               BitBlt(DestDC, 0, 0, IWidth, IHeight,
  599.                      MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  600.  
  601.               { Convert transparent color to clBtnFace }
  602.               FOriginal.Canvas.Brush.Color := ColorToRGB(FTransparentColor);
  603.               MonoBmp.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  604.               Brush.Color := clBtnFace;
  605.               DestDC := Handle;
  606.               SetTextColor(DestDC, clBlack);
  607.               SetBkColor(DestDC, clWhite);
  608.               BitBlt(DestDC, 0, 0, IWidth, IHeight,
  609.                      MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  610.             end
  611.             else
  612.             begin
  613.               { Create a disabled version }
  614.               with MonoBmp do
  615.               begin
  616.                 Assign(FOriginal);
  617.                 Canvas.Brush.Color := clBlack;
  618.                 Width := IWidth;
  619.                 if Monochrome then
  620.                 begin
  621.                   Canvas.Font.Color := clWhite;
  622.                   Monochrome := False;
  623.                   Canvas.Brush.Color := clWhite;
  624.                 end;
  625.                 Monochrome := True;
  626.               end;
  627.               with TmpImage.Canvas do
  628.               begin
  629.                 Brush.Color := clBtnFace;
  630.                 FillRect(IRect);
  631.                 Brush.Color := clBtnHighlight;
  632.                 SetTextColor(Handle, clBlack);
  633.                 SetBkColor(Handle, clWhite);
  634.                 BitBlt(Handle, 1, 1, IWidth, IHeight,
  635.                   MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  636.                 Brush.Color := clBtnShadow;
  637.                 SetTextColor(Handle, clBlack);
  638.                 SetBkColor(Handle, clWhite);
  639.                 BitBlt(Handle, 0, 0, IWidth, IHeight,
  640.                   MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  641.               end;
  642.             end;
  643.             FIndexs[State] := FGlyphList.Add(TmpImage, nil);
  644.           finally
  645.             MonoBmp.Free;
  646.           end;
  647.        end;
  648.     end;
  649.   finally
  650.     TmpImage.Free;
  651.   end;
  652.   Result := FIndexs[State];
  653.   FOriginal.Dormant;
  654. end;
  655.  
  656. procedure TButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; X, Y: Integer;
  657.   State: TButtonState);
  658. var
  659.   Index: Integer;
  660. begin
  661.   if FOriginal = nil then Exit;
  662.   if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
  663.   Index := CreateButtonGlyph(State);
  664.   if State = bsExclusive then
  665.     ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
  666.       clNone, clNone, ILD_Transparent)
  667.   else
  668.     ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
  669.       ColorToRGB(clBtnFace), clNone, ILD_Normal);
  670. end;
  671.  
  672. procedure TButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string;
  673.   TextBounds: TRect; State: TButtonState);
  674. begin
  675.   with Canvas do
  676.   begin
  677.     Brush.Style := bsClear;
  678.     if State = bsDisabled then
  679.     begin
  680.       OffsetRect(TextBounds, 1, 1);
  681.       Font.Color := clWhite;
  682.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
  683.       OffsetRect(TextBounds, -1, -1);
  684.       Font.Color := clDkGray;
  685.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
  686.     end else
  687.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
  688.         DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  689.   end;
  690. end;
  691.  
  692. procedure TButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
  693.   const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  694.   var GlyphPos: TPoint; var TextBounds: TRect);
  695. var
  696.   TextPos: TPoint;
  697.   ClientSize, GlyphSize, TextSize: TPoint;
  698.   TotalSize: TPoint;
  699. begin
  700.   { calculate the item sizes }
  701.   ClientSize := Point(Client.Right - Client.Left, Client.Bottom -
  702.     Client.Top);
  703.  
  704.   if FOriginal <> nil then
  705.     GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height) else
  706.     GlyphSize := Point(0, 0);
  707.  
  708.   if Length(Caption) > 0 then
  709.   begin
  710.     TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
  711.     DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CALCRECT);
  712.     TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
  713.       TextBounds.Top);
  714.   end
  715.   else
  716.   begin
  717.     TextBounds := Rect(0, 0, 0, 0);
  718.     TextSize := Point(0,0);
  719.   end;
  720.  
  721.   { If the layout has the glyph on the right or the left, then both the
  722.     text and the glyph are centered vertically.  If the glyph is on the top
  723.     or the bottom, then both the text and the glyph are centered horizontally.}
  724.   if Layout in [blGlyphLeft, blGlyphRight] then
  725.   begin
  726.     GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
  727.     TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  728.   end
  729.   else
  730.   begin
  731.     GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
  732.     TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  733.   end;
  734.  
  735.   { if there is no text or no bitmap, then Spacing is irrelevant }
  736.   if (TextSize.X = 0) or (GlyphSize.X = 0) then
  737.     Spacing := 0;
  738.  
  739.   { adjust Margin and Spacing }
  740.   if Margin = -1 then
  741.   begin
  742.     if Spacing = -1 then
  743.     begin
  744.       TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
  745.       if Layout in [blGlyphLeft, blGlyphRight] then
  746.         Margin := (ClientSize.X - TotalSize.X) div 3
  747.       else
  748.         Margin := (ClientSize.Y - TotalSize.Y) div 3;
  749.       Spacing := Margin;
  750.     end
  751.     else
  752.     begin
  753.       TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y +
  754.         Spacing + TextSize.Y);
  755.       if Layout in [blGlyphLeft, blGlyphRight] then
  756.         Margin := (ClientSize.X - TotalSize.X + 1) div 2
  757.       else
  758.         Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
  759.     end;
  760.   end
  761.   else
  762.   begin
  763.     if Spacing = -1 then
  764.     begin
  765.       TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y -
  766.         (Margin + GlyphSize.Y));
  767.       if Layout in [blGlyphLeft, blGlyphRight] then
  768.         Spacing := (TotalSize.X - TextSize.X) div 2
  769.       else
  770.         Spacing := (TotalSize.Y - TextSize.Y) div 2;
  771.     end;
  772.   end;
  773.  
  774.   case Layout of
  775.     blGlyphLeft:
  776.       begin
  777.         GlyphPos.X := Margin;
  778.         TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
  779.       end;
  780.     blGlyphRight:
  781.       begin
  782.         GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
  783.         TextPos.X := GlyphPos.X - Spacing - TextSize.X;
  784.       end;
  785.     blGlyphTop:
  786.       begin
  787.         GlyphPos.Y := Margin;
  788.         TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
  789.       end;
  790.     blGlyphBottom:
  791.       begin
  792.         GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
  793.         TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
  794.       end;
  795.   end;
  796.  
  797.   { fixup the result variables }
  798.   Inc(GlyphPos.X, Client.Left);
  799.   Inc(GlyphPos.Y, Client.Top);
  800.   OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top);
  801. end;
  802.  
  803. function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
  804.   const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  805.   State: TButtonState): TRect;
  806. var
  807.   GlyphPos: TPoint;
  808. begin
  809.   CalcButtonLayout(Canvas, Client, Caption, Layout, Margin, Spacing,
  810.     GlyphPos, Result);
  811.   DrawButtonGlyph(Canvas, GlyphPos.X, GlyphPos.Y, State);
  812.   DrawButtonText(Canvas, Caption, Result, State);
  813. end;
  814.  
  815. { TSpeedButton }
  816. constructor TSpeedButton.Create(AOwner: TComponent);
  817. begin
  818.   inherited Create(AOwner);
  819.   SetBounds(0, 0, 25, 25);
  820.   ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
  821.   FGlyph := TButtonGlyph.Create;
  822.   TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  823.   ParentFont := True;
  824.   FSpacing := 4;
  825.   FMargin := -1;
  826.   FLayout := blGlyphLeft;
  827.   Inc(ButtonCount);
  828. end;
  829.  
  830. destructor TSpeedButton.Destroy;
  831. begin
  832.   TButtonGlyph(FGlyph).Free;
  833.   Dec(ButtonCount);
  834.   if ButtonCount = 0 then
  835.   begin
  836.     Pattern.Free;
  837.     Pattern := nil;
  838.   end;
  839.   inherited Destroy;
  840. end;
  841.  
  842. procedure TSpeedButton.Paint;
  843. var
  844.   PaintRect: TRect;
  845. begin
  846.   if not Enabled and not (csDesigning in ComponentState) then
  847.   begin
  848.     FState := bsDisabled;
  849.     FDragging := False;
  850.   end
  851.   else if FState = bsDisabled then
  852.     if FDown and (GroupIndex <> 0) then
  853.       FState := bsExclusive
  854.     else
  855.       FState := bsUp;
  856.  
  857.   Canvas.Font := Self.Font;
  858.  
  859.   PaintRect := DrawButtonFace(Canvas, Rect(0, 0, Width, Height), 1, bsNew,
  860.     False, FState in [bsDown, bsExclusive], False);
  861.  
  862.   if FState = bsExclusive then
  863.   begin
  864.     if Pattern = nil then CreateBrushPattern;
  865.     Canvas.Brush.Bitmap := Pattern;
  866.     Dec(PaintRect.Right);
  867.     Dec(PaintRect.Bottom);
  868.     Canvas.FillRect(PaintRect);
  869.   end;
  870.  
  871.   TButtonGlyph(FGlyph).Draw(Canvas, PaintRect, Caption, FLayout, FMargin, FSpacing,
  872.     FState);
  873. end;
  874.  
  875. procedure TSpeedButton.Loaded;
  876. var
  877.   State: TButtonState;
  878. begin
  879.   inherited Loaded;
  880.   if Enabled then
  881.     State := bsUp
  882.   else
  883.     State := bsDisabled;
  884.   TButtonGlyph(FGlyph).CreateButtonGlyph(State);
  885. end;
  886.  
  887. procedure TSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  888.   X, Y: Integer);
  889. begin
  890.   inherited MouseDown(Button, Shift, X, Y);
  891.   if (Button = mbLeft) and Enabled then
  892.   begin
  893.     if not FDown then
  894.     begin
  895.       FState := bsDown;
  896.       Repaint;
  897.     end;
  898.     FDragging := True;
  899.   end;
  900. end;
  901.  
  902. procedure TSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer);
  903. var
  904.   NewState: TButtonState;
  905. begin
  906.   inherited MouseMove(Shift, X, Y);
  907.   if FDragging then
  908.   begin
  909.     if not FDown then NewState := bsUp
  910.     else NewState := bsExclusive;
  911.     if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
  912.       if FDown then NewState := bsExclusive else NewState := bsDown;
  913.     if NewState <> FState then
  914.     begin
  915.       FState := NewState;
  916.       Repaint;
  917.     end;
  918.   end;
  919. end;
  920.  
  921. procedure TSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  922.   X, Y: Integer);
  923. var
  924.   DoClick: Boolean;
  925. begin
  926.   inherited MouseUp(Button, Shift, X, Y);
  927.   if FDragging then
  928.   begin
  929.     FDragging := False;
  930.     DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
  931.     FState := bsUp;
  932.     if FGroupIndex = 0 then
  933.       Repaint
  934.     else
  935.       if DoClick then SetDown(not FDown)
  936.       else
  937.       begin
  938.         if FDown then FState := bsExclusive;
  939.         Repaint;
  940.       end;
  941.     if DoClick then Click;
  942.   end;
  943. end;
  944.  
  945. procedure TSpeedButton.Click;
  946. begin
  947.   inherited Click;
  948. end;
  949.  
  950. function TSpeedButton.GetPalette: HPALETTE;
  951. begin
  952.   Result := Glyph.Palette;
  953. end;
  954.  
  955. function TSpeedButton.GetGlyph: TBitmap;
  956. begin
  957.   Result := TButtonGlyph(FGlyph).Glyph;
  958. end;
  959.  
  960. procedure TSpeedButton.SetGlyph(Value: TBitmap);
  961. begin
  962.   TButtonGlyph(FGlyph).Glyph := Value;
  963.   Invalidate;
  964. end;
  965.  
  966. function TSpeedButton.GetNumGlyphs: TNumGlyphs;
  967. begin
  968.   Result := TButtonGlyph(FGlyph).NumGlyphs;
  969. end;
  970.  
  971. procedure TSpeedButton.SetNumGlyphs(Value: TNumGlyphs);
  972. begin
  973.   if Value < 0 then Value := 1
  974.   else if Value > 4 then Value := 4;
  975.   if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  976.   begin
  977.     TButtonGlyph(FGlyph).NumGlyphs := Value;
  978.     Invalidate;
  979.   end;
  980. end;
  981.  
  982. procedure TSpeedButton.GlyphChanged(Sender: TObject);
  983. begin
  984.   Invalidate;
  985. end;
  986.  
  987. procedure TSpeedButton.UpdateExclusive;
  988. var
  989.   Msg: TMessage;
  990. begin
  991.   if (FGroupIndex <> 0) and (Parent <> nil) then
  992.   begin
  993.     Msg.Msg := CM_BUTTONPRESSED;
  994.     Msg.WParam := FGroupIndex;
  995.     Msg.LParam := Longint(Self);
  996.     Msg.Result := 0;
  997.     Parent.Broadcast(Msg);
  998.   end;
  999. end;
  1000.  
  1001. procedure TSpeedButton.SetDown(Value: Boolean);
  1002. begin
  1003.   if FGroupIndex = 0 then Value := False;
  1004.   if Value <> FDown then
  1005.   begin
  1006.     if FDown and (not FAllowAllUp) then Exit;
  1007.     FDown := Value;
  1008.     if Value then FState := bsExclusive
  1009.     else FState := bsUp;
  1010.     Invalidate;
  1011.     if Value then UpdateExclusive;
  1012.   end;
  1013. end;
  1014.  
  1015. procedure TSpeedButton.SetGroupIndex(Value: Integer);
  1016. begin
  1017.   if FGroupIndex <> Value then
  1018.   begin
  1019.     FGroupIndex := Value;
  1020.     UpdateExclusive;
  1021.   end;
  1022. end;
  1023.  
  1024. procedure TSpeedButton.SetLayout(Value: TButtonLayout);
  1025. begin
  1026.   if FLayout <> Value then
  1027.   begin
  1028.     FLayout := Value;
  1029.     Invalidate;
  1030.   end;
  1031. end;
  1032.  
  1033. procedure TSpeedButton.SetMargin(Value: Integer);
  1034. begin
  1035.   if (Value <> FMargin) and (Value >= -1) then
  1036.   begin
  1037.     FMargin := Value;
  1038.     Invalidate;
  1039.   end;
  1040. end;
  1041.  
  1042. procedure TSpeedButton.SetSpacing(Value: Integer);
  1043. begin
  1044.   if Value <> FSpacing then
  1045.   begin
  1046.     FSpacing := Value;
  1047.     Invalidate;
  1048.   end;
  1049. end;
  1050.  
  1051. procedure TSpeedButton.SetAllowAllUp(Value: Boolean);
  1052. begin
  1053.   if FAllowAllUp <> Value then
  1054.   begin
  1055.     FAllowAllUp := Value;
  1056.     UpdateExclusive;
  1057.   end;
  1058. end;
  1059.  
  1060. procedure TSpeedButton.WMLButtonDblClk(var Message: TWMLButtonDown);
  1061. begin
  1062.   inherited;
  1063.   if FDown then DblClick;
  1064. end;
  1065.  
  1066. procedure TSpeedButton.CMEnabledChanged(var Message: TMessage);
  1067. const
  1068.   NewState: array[Boolean] of TButtonState = (bsDisabled, bsUp);
  1069. begin
  1070.   TButtonGlyph(FGlyph).CreateButtonGlyph(NewState[Enabled]);
  1071.   Invalidate;
  1072. end;
  1073.  
  1074. procedure TSpeedButton.CMButtonPressed(var Message: TMessage);
  1075. var
  1076.   Sender: TSpeedButton;
  1077. begin
  1078.   if Message.WParam = FGroupIndex then
  1079.   begin
  1080.     Sender := TSpeedButton(Message.LParam);
  1081.     if Sender <> Self then
  1082.     begin
  1083.       if Sender.Down and FDown then
  1084.       begin
  1085.         FDown := False;
  1086.         FState := bsUp;
  1087.         Invalidate;
  1088.       end;
  1089.       FAllowAllUp := Sender.AllowAllUp;
  1090.     end;
  1091.   end;
  1092. end;
  1093.  
  1094. procedure TSpeedButton.CMDialogChar(var Message: TCMDialogChar);
  1095. begin
  1096.   with Message do
  1097.     if IsAccel(CharCode, Caption) and Enabled then
  1098.     begin
  1099.       Click;
  1100.       Result := 1;
  1101.     end else
  1102.       inherited;
  1103. end;
  1104.  
  1105. procedure TSpeedButton.CMFontChanged(var Message: TMessage);
  1106. begin
  1107.   Invalidate;
  1108. end;
  1109.  
  1110. procedure TSpeedButton.CMTextChanged(var Message: TMessage);
  1111. begin
  1112.   Invalidate;
  1113. end;
  1114.  
  1115. procedure TSpeedButton.CMSysColorChange(var Message: TMessage);
  1116. begin
  1117.   with TButtonGlyph(FGlyph) do
  1118.   begin
  1119.     Invalidate;
  1120.     CreateButtonGlyph(FState);
  1121.   end;
  1122. end;
  1123.  
  1124. { TBitBtn }
  1125.  
  1126. constructor TBitBtn.Create(AOwner: TComponent);
  1127. begin
  1128.   inherited Create(AOwner);
  1129.   FGlyph := TButtonGlyph.Create;
  1130.   TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  1131.   FCanvas := TCanvas.Create;
  1132.   FStyle := bsAutoDetect;
  1133.   FKind := bkCustom;
  1134.   FLayout := blGlyphLeft;
  1135.   FSpacing := 4;
  1136.   FMargin := -1;
  1137. end;
  1138.  
  1139. destructor TBitBtn.Destroy;
  1140. begin
  1141.   TButtonGlyph(FGlyph).Free;
  1142.   FCanvas.Free;
  1143.   inherited Destroy;
  1144. end;
  1145.  
  1146. procedure TBitBtn.CreateHandle;
  1147. var
  1148.   State: TButtonState;
  1149. begin
  1150.   if Enabled then
  1151.     State := bsUp
  1152.   else
  1153.     State := bsDisabled;
  1154.   inherited CreateHandle;
  1155.   TButtonGlyph(FGlyph).CreateButtonGlyph(State);
  1156. end;
  1157.  
  1158. procedure TBitBtn.CreateParams(var Params: TCreateParams);
  1159. begin
  1160.   inherited CreateParams(Params);
  1161.   with Params do Style := Style or BS_OWNERDRAW;
  1162. end;
  1163.  
  1164. procedure TBitBtn.SetButtonStyle(ADefault: Boolean);
  1165. begin
  1166.   if ADefault <> IsFocused then
  1167.   begin
  1168.     IsFocused := ADefault;
  1169.     Refresh;
  1170.   end;
  1171. end;
  1172.  
  1173. procedure TBitBtn.Click;
  1174. var
  1175.   Form: TForm;
  1176.   Control: TWinControl;
  1177. begin
  1178.   case FKind of
  1179.     bkClose:
  1180.       begin
  1181.         Form := GetParentForm(Self);
  1182.         if Form <> nil then Form.Close
  1183.         else inherited Click;
  1184.       end;
  1185.     bkHelp:
  1186.       begin
  1187.         Control := Self;
  1188.         while (Control <> nil) and (Control.HelpContext = 0) do
  1189.           Control := Control.Parent;
  1190.         if Control <> nil then Application.HelpContext(Control.HelpContext)
  1191.         else inherited Click;
  1192.       end;
  1193.     else
  1194.       inherited Click;
  1195.   end;
  1196. end;
  1197.  
  1198. procedure TBitBtn.CNMeasureItem(var Message: TWMMeasureItem);
  1199. begin
  1200.   with Message.MeasureItemStruct^ do
  1201.   begin
  1202.     itemWidth := Width;
  1203.     itemHeight := Height;
  1204.   end;
  1205. end;
  1206.  
  1207. procedure TBitBtn.CNDrawItem(var Message: TWMDrawItem);
  1208. begin
  1209.   DrawItem(Message.DrawItemStruct^);
  1210. end;
  1211.  
  1212. procedure TBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct);
  1213. var
  1214.   IsDown, IsDefault: Boolean;
  1215.   State: TButtonState;
  1216.   R: TRect;
  1217.   Flags: Longint;
  1218. begin
  1219.   FCanvas.Handle := DrawItemStruct.hDC;
  1220.   R := ClientRect;
  1221.  
  1222.   with DrawItemStruct do
  1223.   begin
  1224.     IsDown := itemState and ODS_SELECTED <> 0;
  1225.     IsDefault := itemState and ODS_FOCUS <> 0;
  1226.  
  1227.     if not Enabled then State := bsDisabled
  1228.     else if IsDown then State := bsDown
  1229.     else State := bsUp;
  1230.   end;
  1231.  
  1232.   Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  1233.   if IsDown then Flags := Flags or DFCS_PUSHED;
  1234.   if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
  1235.     Flags := Flags or DFCS_INACTIVE;
  1236.  
  1237.   { DrawFrameControl doesn't allow for drawing a button as the
  1238.       default button, so it must be done here. }
  1239.   if IsFocused or IsDefault then
  1240.   begin
  1241.     FCanvas.Pen.Color := clWindowFrame;
  1242.     FCanvas.Pen.Width := 1;
  1243.     FCanvas.Brush.Style := bsClear;
  1244.     FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  1245.  
  1246.     { DrawFrameControl must draw within this border }
  1247.     InflateRect(R, -1, -1);
  1248.   end;
  1249.  
  1250.   { DrawFrameControl does not draw a pressed button correctly }
  1251.   if IsDown then
  1252.   begin
  1253.     FCanvas.Pen.Color := clBtnShadow;
  1254.     FCanvas.Pen.Width := 1;
  1255.     FCanvas.Brush.Color := clBtnFace;
  1256.     FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  1257.     InflateRect(R, -1, -1);
  1258.   end
  1259.   else
  1260.     DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
  1261.  
  1262.   if IsFocused then
  1263.   begin
  1264.     R := ClientRect;
  1265.     InflateRect(R, -1, -1);
  1266.   end;
  1267.  
  1268.   FCanvas.Font := Self.Font;
  1269.   if IsDown then
  1270.     OffsetRect(R, 1, 1);
  1271.   TButtonGlyph(FGlyph).Draw(FCanvas, R, Caption, FLayout,
  1272.     FMargin, FSpacing, State);
  1273.  
  1274.   if IsFocused then
  1275.   begin
  1276.     R := ClientRect;
  1277.     InflateRect(R, -4, -4);
  1278.     FCanvas.Pen.Color := clWindowFrame;
  1279.     FCanvas.Brush.Color := clBtnFace;
  1280.     DrawFocusRect(FCanvas.Handle, R);
  1281.   end;
  1282.  
  1283.   FCanvas.Handle := 0;
  1284. end;
  1285.  
  1286. procedure TBitBtn.CMFontChanged(var Message: TMessage);
  1287. begin
  1288.   inherited;
  1289.   Invalidate;
  1290. end;
  1291.  
  1292. procedure TBitBtn.CMEnabledChanged(var Message: TMessage);
  1293. begin
  1294.   inherited;
  1295.   Invalidate;
  1296. end;
  1297.  
  1298. procedure TBitBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1299. begin
  1300.   Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
  1301. end;
  1302.  
  1303. function TBitBtn.GetPalette: HPALETTE;
  1304. begin
  1305.   Result := Glyph.Palette;
  1306. end;
  1307.  
  1308. procedure TBitBtn.SetGlyph(Value: TBitmap);
  1309. begin
  1310.   TButtonGlyph(FGlyph).Glyph := Value as TBitmap;
  1311.   FModifiedGlyph := True;
  1312.   Invalidate;
  1313. end;
  1314.  
  1315. function TBitBtn.GetGlyph: TBitmap;
  1316. begin
  1317.   Result := TButtonGlyph(FGlyph).Glyph;
  1318. end;
  1319.  
  1320. procedure TBitBtn.GlyphChanged(Sender: TObject);
  1321. begin
  1322.   Invalidate;
  1323. end;
  1324.  
  1325. function TBitBtn.IsCustom: Boolean;
  1326. begin
  1327.   Result := Kind = bkCustom;
  1328. end;
  1329.  
  1330. procedure TBitBtn.SetStyle(Value: TButtonStyle);
  1331. begin
  1332.   if Value <> FStyle then
  1333.   begin
  1334.     FStyle := Value;
  1335.     Invalidate;
  1336.   end;
  1337. end;
  1338.  
  1339. procedure TBitBtn.SetKind(Value: TBitBtnKind);
  1340. begin
  1341.   if Value <> FKind then
  1342.   begin
  1343.     if Value <> bkCustom then
  1344.     begin
  1345.       Default := Value in [bkOK, bkYes];
  1346.       Cancel := Value in [bkCancel, bkNo];
  1347.  
  1348.       if ((csLoading in ComponentState) and (Caption = '')) or
  1349.         (not (csLoading in ComponentState)) then
  1350.       begin
  1351.         if BitBtnCaptions[Value] > 0 then
  1352.           Caption := LoadStr(BitBtnCaptions[Value]);
  1353.       end;
  1354.  
  1355.       ModalResult := BitBtnModalResults[Value];
  1356.       TButtonGlyph(FGlyph).Glyph := GetBitBtnGlyph(Value);
  1357.       NumGlyphs := 2;
  1358.       FModifiedGlyph := False;
  1359.     end;
  1360.     FKind := Value;
  1361.     Invalidate;
  1362.   end;
  1363. end;
  1364.  
  1365. function TBitBtn.IsCustomCaption: Boolean;
  1366. begin
  1367.   Result := CompareStr(Caption, LoadStr(BitBtnCaptions[FKind])) <> 0;
  1368. end;
  1369.  
  1370. function TBitBtn.GetKind: TBitBtnKind;
  1371. begin
  1372.   if FKind <> bkCustom then
  1373.     if ((FKind in [bkOK, bkYes]) xor Default) or
  1374.       ((FKind in [bkCancel, bkNo]) xor Cancel) or
  1375.       (ModalResult <> BitBtnModalResults[FKind]) or
  1376.       FModifiedGlyph then
  1377.       FKind := bkCustom;
  1378.   Result := FKind;
  1379. end;
  1380.  
  1381. procedure TBitBtn.SetLayout(Value: TButtonLayout);
  1382. begin
  1383.   if FLayout <> Value then
  1384.   begin
  1385.     FLayout := Value;
  1386.     Invalidate;
  1387.   end;
  1388. end;
  1389.  
  1390. function TBitBtn.GetNumGlyphs: TNumGlyphs;
  1391. begin
  1392.   Result := TButtonGlyph(FGlyph).NumGlyphs;
  1393. end;
  1394.  
  1395. procedure TBitBtn.SetNumGlyphs(Value: TNumGlyphs);
  1396. begin
  1397.   if Value < 0 then Value := 1
  1398.   else if Value > 4 then Value := 4;
  1399.   if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  1400.   begin
  1401.     TButtonGlyph(FGlyph).NumGlyphs := Value;
  1402.     Invalidate;
  1403.   end;
  1404. end;
  1405.  
  1406. procedure TBitBtn.SetSpacing(Value: Integer);
  1407. begin
  1408.   if FSpacing <> Value then
  1409.   begin
  1410.     FSpacing := Value;
  1411.     Invalidate;
  1412.   end;
  1413. end;
  1414.  
  1415. procedure TBitBtn.SetMargin(Value: Integer);
  1416. begin
  1417.   if (Value <> FMargin) and (Value >= - 1) then
  1418.   begin
  1419.     FMargin := Value;
  1420.     Invalidate;
  1421.   end;
  1422. end;
  1423.  
  1424. procedure DestroyLocals; far;
  1425. var
  1426.   I: TBitBtnKind;
  1427. begin
  1428.   for I := Low(TBitBtnKind) to High(TBitBtnKind) do
  1429.     BitBtnGlyphs[I].Free;
  1430. end;
  1431.  
  1432. initialization
  1433.   FillChar(BitBtnGlyphs, SizeOf(BitBtnGlyphs), 0);
  1434. finalization
  1435.   DestroyLocals;
  1436. end.
  1437.