home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 February / DPPCPRO0299.ISO / February / Delphi / Runimage / DELPHI20 / SOURCE / VCL / BUTTONS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1996-06-08  |  38.8 KB  |  1,438 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.  
  451. { TButtonGlyph }
  452.  
  453. constructor TButtonGlyph.Create;
  454. var
  455.   I: TButtonState;
  456. begin
  457.   inherited Create;
  458.   FOriginal := TBitmap.Create;
  459.   FOriginal.OnChange := GlyphChanged;
  460.   FTransparentColor := clOlive;
  461.   FNumGlyphs := 1;
  462.   for I := Low(I) to High(I) do
  463.     FIndexs[I] := -1;
  464.   if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
  465. end;
  466.  
  467. destructor TButtonGlyph.Destroy;
  468. begin
  469.   FOriginal.Free;
  470.   Invalidate;
  471.   if Assigned(GlyphCache) and GlyphCache.Empty then
  472.   begin
  473.     GlyphCache.Free;
  474.     GlyphCache := nil;
  475.   end;
  476.   inherited Destroy;
  477. end;
  478.  
  479. procedure TButtonGlyph.Invalidate;
  480. var
  481.   I: TButtonState;
  482. begin
  483.   for I := Low(I) to High(I) do
  484.   begin
  485.     if FIndexs[I] <> -1 then FGlyphList.Delete(FIndexs[I]);
  486.     FIndexs[I] := -1;
  487.   end;
  488.   GlyphCache.ReturnList(FGlyphList);
  489.   FGlyphList := nil;
  490. end;
  491.  
  492. procedure TButtonGlyph.GlyphChanged(Sender: TObject);
  493. begin
  494.   if Sender = FOriginal then
  495.   begin
  496.     FTransparentColor := FOriginal.TransparentColor;
  497.     Invalidate;
  498.     if Assigned(FOnChange) then FOnChange(Self);
  499.   end;
  500. end;
  501.  
  502. procedure TButtonGlyph.SetGlyph(Value: TBitmap);
  503. var
  504.   Glyphs: Integer;
  505. begin
  506.   Invalidate;
  507.   FOriginal.Assign(Value);
  508.   if (Value <> nil) and (Value.Height > 0) then
  509.   begin
  510.     FTransparentColor := Value.TransparentColor;
  511.     if Value.Width mod Value.Height = 0 then
  512.     begin
  513.       Glyphs := Value.Width div Value.Height;
  514.       if Glyphs > 4 then Glyphs := 1;
  515.       SetNumGlyphs(Glyphs);
  516.     end;
  517.   end;
  518. end;
  519.  
  520. procedure TButtonGlyph.SetNumGlyphs(Value: TNumGlyphs);
  521. begin
  522.   if (Value <> FNumGlyphs) and (Value > 0) then
  523.   begin
  524.     Invalidate;
  525.     FNumGlyphs := Value;
  526.   end;
  527. end;
  528.  
  529. function TButtonGlyph.CreateButtonGlyph(State: TButtonState): Integer;
  530. const
  531.   ROP_DSPDxax = $00E20746;
  532. var
  533.   TmpImage, MonoBmp: TBitmap;
  534.   IWidth, IHeight: Integer;
  535.   IRect, ORect: TRect;
  536.   I: TButtonState;
  537.   DestDC: HDC;
  538. begin
  539.   if (State = bsDown) and (NumGlyphs < 3) then State := bsUp;
  540.   Result := FIndexs[State];
  541.   if Result <> -1 then Exit;
  542.   if (FOriginal.Width or FOriginal.Height) = 0 then Exit;
  543.   IWidth := FOriginal.Width div FNumGlyphs;
  544.   IHeight := FOriginal.Height;
  545.   if FGlyphList = nil then
  546.   begin
  547.     if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
  548.     FGlyphList := GlyphCache.GetList(IWidth, IHeight);
  549.   end;
  550.   TmpImage := TBitmap.Create;
  551.   try
  552.     TmpImage.Width := IWidth;
  553.     TmpImage.Height := IHeight;
  554.     IRect := Rect(0, 0, IWidth, IHeight);
  555.     TmpImage.Canvas.Brush.Color := clBtnFace;
  556.     I := State;
  557.     if Ord(I) >= NumGlyphs then I := bsUp;
  558.     ORect := Rect(Ord(I) * IWidth, 0, (Ord(I) + 1) * IWidth, IHeight);
  559.     case State of
  560.       bsUp, bsDown:
  561.         begin
  562.           TmpImage.Canvas.BrushCopy(IRect, FOriginal, ORect, FTransparentColor);
  563.           FIndexs[State] := FGlyphList.Add(TmpImage, nil);
  564.         end;
  565.       bsExclusive:
  566.         begin
  567.           TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  568.           FIndexs[State] := FGlyphList.AddMasked(TmpImage, FTransparentColor);
  569.         end;
  570.       bsDisabled:
  571.         begin
  572.           MonoBmp := TBitmap.Create;
  573.           try
  574.             if NumGlyphs > 1 then
  575.             with TmpImage.Canvas do
  576.             begin    { Change white & gray to clBtnHighlight and clBtnShadow }
  577.               CopyRect(IRect, FOriginal.Canvas, ORect);
  578.               MonoBmp.Width := IWidth;
  579.               MonoBmp.Height := IHeight;
  580.               MonoBmp.Monochrome := True;
  581.  
  582.               { Convert white to clBtnHighlight }
  583.               FOriginal.Canvas.Brush.Color := clWhite;
  584.               MonoBmp.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  585.               Brush.Color := clBtnHighlight;
  586.               DestDC := Handle;
  587.               SetTextColor(DestDC, clBlack);
  588.               SetBkColor(DestDC, clWhite);
  589.               BitBlt(DestDC, 0, 0, IWidth, IHeight,
  590.                      MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  591.  
  592.               { Convert gray to clBtnShadow }
  593.               FOriginal.Canvas.Brush.Color := clGray;
  594.               MonoBmp.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  595.               Brush.Color := clBtnShadow;
  596.               DestDC := Handle;
  597.               SetTextColor(DestDC, clBlack);
  598.               SetBkColor(DestDC, clWhite);
  599.               BitBlt(DestDC, 0, 0, IWidth, IHeight,
  600.                      MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  601.  
  602.               { Convert transparent color to clBtnFace }
  603.               FOriginal.Canvas.Brush.Color := ColorToRGB(FTransparentColor);
  604.               MonoBmp.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  605.               Brush.Color := clBtnFace;
  606.               DestDC := Handle;
  607.               SetTextColor(DestDC, clBlack);
  608.               SetBkColor(DestDC, clWhite);
  609.               BitBlt(DestDC, 0, 0, IWidth, IHeight,
  610.                      MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  611.             end
  612.             else
  613.             begin
  614.               { Create a disabled version }
  615.               with MonoBmp do
  616.               begin
  617.                 Assign(FOriginal);
  618.                 Canvas.Brush.Color := clBlack;
  619.                 Width := IWidth;
  620.                 if Monochrome then
  621.                 begin
  622.                   Canvas.Font.Color := clWhite;
  623.                   Monochrome := False;
  624.                   Canvas.Brush.Color := clWhite;
  625.                 end;
  626.                 Monochrome := True;
  627.               end;
  628.               with TmpImage.Canvas do
  629.               begin
  630.                 Brush.Color := clBtnFace;
  631.                 FillRect(IRect);
  632.                 Brush.Color := clBtnHighlight;
  633.                 SetTextColor(Handle, clBlack);
  634.                 SetBkColor(Handle, clWhite);
  635.                 BitBlt(Handle, 1, 1, IWidth, IHeight,
  636.                   MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  637.                 Brush.Color := clBtnShadow;
  638.                 SetTextColor(Handle, clBlack);
  639.                 SetBkColor(Handle, clWhite);
  640.                 BitBlt(Handle, 0, 0, IWidth, IHeight,
  641.                   MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  642.               end;
  643.             end;
  644.             FIndexs[State] := FGlyphList.Add(TmpImage, nil);
  645.           finally
  646.             MonoBmp.Free;
  647.           end;
  648.        end;
  649.     end;
  650.   finally
  651.     TmpImage.Free;
  652.   end;
  653.   Result := FIndexs[State];
  654.   FOriginal.Dormant;
  655. end;
  656.  
  657. procedure TButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; X, Y: Integer;
  658.   State: TButtonState);
  659. var
  660.   Index: Integer;
  661. begin
  662.   if FOriginal = nil then Exit;
  663.   if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
  664.   Index := CreateButtonGlyph(State);
  665.   if State = bsExclusive then
  666.     ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
  667.       clNone, clNone, ILD_Transparent)
  668.   else
  669.     ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
  670.       ColorToRGB(clBtnFace), clNone, ILD_Normal);
  671. end;
  672.  
  673. procedure TButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string;
  674.   TextBounds: TRect; State: TButtonState);
  675. begin
  676.   with Canvas do
  677.   begin
  678.     Brush.Style := bsClear;
  679.     if State = bsDisabled then
  680.     begin
  681.       OffsetRect(TextBounds, 1, 1);
  682.       Font.Color := clWhite;
  683.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
  684.       OffsetRect(TextBounds, -1, -1);
  685.       Font.Color := clDkGray;
  686.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
  687.     end else
  688.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
  689.         DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  690.   end;
  691. end;
  692.  
  693. procedure TButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
  694.   const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  695.   var GlyphPos: TPoint; var TextBounds: TRect);
  696. var
  697.   TextPos: TPoint;
  698.   ClientSize, GlyphSize, TextSize: TPoint;
  699.   TotalSize: TPoint;
  700. begin
  701.   { calculate the item sizes }
  702.   ClientSize := Point(Client.Right - Client.Left, Client.Bottom -
  703.     Client.Top);
  704.  
  705.   if FOriginal <> nil then
  706.     GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height) else
  707.     GlyphSize := Point(0, 0);
  708.  
  709.   if Length(Caption) > 0 then
  710.   begin
  711.     TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
  712.     DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CALCRECT);
  713.     TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
  714.       TextBounds.Top);
  715.   end
  716.   else
  717.   begin
  718.     TextBounds := Rect(0, 0, 0, 0);
  719.     TextSize := Point(0,0);
  720.   end;
  721.  
  722.   { If the layout has the glyph on the right or the left, then both the
  723.     text and the glyph are centered vertically.  If the glyph is on the top
  724.     or the bottom, then both the text and the glyph are centered horizontally.}
  725.   if Layout in [blGlyphLeft, blGlyphRight] then
  726.   begin
  727.     GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
  728.     TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  729.   end
  730.   else
  731.   begin
  732.     GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
  733.     TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  734.   end;
  735.  
  736.   { if there is no text or no bitmap, then Spacing is irrelevant }
  737.   if (TextSize.X = 0) or (GlyphSize.X = 0) then
  738.     Spacing := 0;
  739.  
  740.   { adjust Margin and Spacing }
  741.   if Margin = -1 then
  742.   begin
  743.     if Spacing = -1 then
  744.     begin
  745.       TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
  746.       if Layout in [blGlyphLeft, blGlyphRight] then
  747.         Margin := (ClientSize.X - TotalSize.X) div 3
  748.       else
  749.         Margin := (ClientSize.Y - TotalSize.Y) div 3;
  750.       Spacing := Margin;
  751.     end
  752.     else
  753.     begin
  754.       TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y +
  755.         Spacing + TextSize.Y);
  756.       if Layout in [blGlyphLeft, blGlyphRight] then
  757.         Margin := (ClientSize.X - TotalSize.X + 1) div 2
  758.       else
  759.         Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
  760.     end;
  761.   end
  762.   else
  763.   begin
  764.     if Spacing = -1 then
  765.     begin
  766.       TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y -
  767.         (Margin + GlyphSize.Y));
  768.       if Layout in [blGlyphLeft, blGlyphRight] then
  769.         Spacing := (TotalSize.X - TextSize.X) div 2
  770.       else
  771.         Spacing := (TotalSize.Y - TextSize.Y) div 2;
  772.     end;
  773.   end;
  774.  
  775.   case Layout of
  776.     blGlyphLeft:
  777.       begin
  778.         GlyphPos.X := Margin;
  779.         TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
  780.       end;
  781.     blGlyphRight:
  782.       begin
  783.         GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
  784.         TextPos.X := GlyphPos.X - Spacing - TextSize.X;
  785.       end;
  786.     blGlyphTop:
  787.       begin
  788.         GlyphPos.Y := Margin;
  789.         TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
  790.       end;
  791.     blGlyphBottom:
  792.       begin
  793.         GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
  794.         TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
  795.       end;
  796.   end;
  797.  
  798.   { fixup the result variables }
  799.   Inc(GlyphPos.X, Client.Left);
  800.   Inc(GlyphPos.Y, Client.Top);
  801.   OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top);
  802. end;
  803.  
  804. function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
  805.   const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  806.   State: TButtonState): TRect;
  807. var
  808.   GlyphPos: TPoint;
  809. begin
  810.   CalcButtonLayout(Canvas, Client, Caption, Layout, Margin, Spacing,
  811.     GlyphPos, Result);
  812.   DrawButtonGlyph(Canvas, GlyphPos.X, GlyphPos.Y, State);
  813.   DrawButtonText(Canvas, Caption, Result, State);
  814. end;
  815.  
  816. { TSpeedButton }
  817. constructor TSpeedButton.Create(AOwner: TComponent);
  818. begin
  819.   inherited Create(AOwner);
  820.   SetBounds(0, 0, 25, 25);
  821.   ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
  822.   FGlyph := TButtonGlyph.Create;
  823.   TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  824.   ParentFont := True;
  825.   FSpacing := 4;
  826.   FMargin := -1;
  827.   FLayout := blGlyphLeft;
  828.   Inc(ButtonCount);
  829. end;
  830.  
  831. destructor TSpeedButton.Destroy;
  832. begin
  833.   TButtonGlyph(FGlyph).Free;
  834.   Dec(ButtonCount);
  835.   if ButtonCount = 0 then
  836.   begin
  837.     Pattern.Free;
  838.     Pattern := nil;
  839.   end;
  840.   inherited Destroy;
  841. end;
  842.  
  843. procedure TSpeedButton.Paint;
  844. var
  845.   PaintRect: TRect;
  846. begin
  847.   if not Enabled and not (csDesigning in ComponentState) then
  848.   begin
  849.     FState := bsDisabled;
  850.     FDragging := False;
  851.   end
  852.   else if FState = bsDisabled then
  853.     if FDown and (GroupIndex <> 0) then
  854.       FState := bsExclusive
  855.     else
  856.       FState := bsUp;
  857.  
  858.   Canvas.Font := Self.Font;
  859.  
  860.   PaintRect := DrawButtonFace(Canvas, Rect(0, 0, Width, Height), 1, bsNew,
  861.     False, FState in [bsDown, bsExclusive], False);
  862.  
  863.   if FState = bsExclusive then
  864.   begin
  865.     if Pattern = nil then CreateBrushPattern;
  866.     Canvas.Brush.Bitmap := Pattern;
  867.     Dec(PaintRect.Right);
  868.     Dec(PaintRect.Bottom);
  869.     Canvas.FillRect(PaintRect);
  870.   end;
  871.  
  872.   TButtonGlyph(FGlyph).Draw(Canvas, PaintRect, Caption, FLayout, FMargin, FSpacing,
  873.     FState);
  874. end;
  875.  
  876. procedure TSpeedButton.Loaded;
  877. var
  878.   State: TButtonState;
  879. begin
  880.   inherited Loaded;
  881.   if Enabled then
  882.     State := bsUp
  883.   else
  884.     State := bsDisabled;
  885.   TButtonGlyph(FGlyph).CreateButtonGlyph(State);
  886. end;
  887.  
  888. procedure TSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  889.   X, Y: Integer);
  890. begin
  891.   inherited MouseDown(Button, Shift, X, Y);
  892.   if (Button = mbLeft) and Enabled then
  893.   begin
  894.     if not FDown then
  895.     begin
  896.       FState := bsDown;
  897.       Repaint;
  898.     end;
  899.     FDragging := True;
  900.   end;
  901. end;
  902.  
  903. procedure TSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer);
  904. var
  905.   NewState: TButtonState;
  906. begin
  907.   inherited MouseMove(Shift, X, Y);
  908.   if FDragging then
  909.   begin
  910.     if not FDown then NewState := bsUp
  911.     else NewState := bsExclusive;
  912.     if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
  913.       if FDown then NewState := bsExclusive else NewState := bsDown;
  914.     if NewState <> FState then
  915.     begin
  916.       FState := NewState;
  917.       Repaint;
  918.     end;
  919.   end;
  920. end;
  921.  
  922. procedure TSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  923.   X, Y: Integer);
  924. var
  925.   DoClick: Boolean;
  926. begin
  927.   inherited MouseUp(Button, Shift, X, Y);
  928.   if FDragging then
  929.   begin
  930.     FDragging := False;
  931.     DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
  932.     FState := bsUp;
  933.     if FGroupIndex = 0 then
  934.       Repaint
  935.     else
  936.       if DoClick then SetDown(not FDown)
  937.       else
  938.       begin
  939.         if FDown then FState := bsExclusive;
  940.         Repaint;
  941.       end;
  942.     if DoClick then Click;
  943.   end;
  944. end;
  945.  
  946. procedure TSpeedButton.Click;
  947. begin
  948.   inherited Click;
  949. end;
  950.  
  951. function TSpeedButton.GetPalette: HPALETTE;
  952. begin
  953.   Result := Glyph.Palette;
  954. end;
  955.  
  956. function TSpeedButton.GetGlyph: TBitmap;
  957. begin
  958.   Result := TButtonGlyph(FGlyph).Glyph;
  959. end;
  960.  
  961. procedure TSpeedButton.SetGlyph(Value: TBitmap);
  962. begin
  963.   TButtonGlyph(FGlyph).Glyph := Value;
  964.   Invalidate;
  965. end;
  966.  
  967. function TSpeedButton.GetNumGlyphs: TNumGlyphs;
  968. begin
  969.   Result := TButtonGlyph(FGlyph).NumGlyphs;
  970. end;
  971.  
  972. procedure TSpeedButton.SetNumGlyphs(Value: TNumGlyphs);
  973. begin
  974.   if Value < 0 then Value := 1
  975.   else if Value > 4 then Value := 4;
  976.   if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  977.   begin
  978.     TButtonGlyph(FGlyph).NumGlyphs := Value;
  979.     Invalidate;
  980.   end;
  981. end;
  982.  
  983. procedure TSpeedButton.GlyphChanged(Sender: TObject);
  984. begin
  985.   Invalidate;
  986. end;
  987.  
  988. procedure TSpeedButton.UpdateExclusive;
  989. var
  990.   Msg: TMessage;
  991. begin
  992.   if (FGroupIndex <> 0) and (Parent <> nil) then
  993.   begin
  994.     Msg.Msg := CM_BUTTONPRESSED;
  995.     Msg.WParam := FGroupIndex;
  996.     Msg.LParam := Longint(Self);
  997.     Msg.Result := 0;
  998.     Parent.Broadcast(Msg);
  999.   end;
  1000. end;
  1001.  
  1002. procedure TSpeedButton.SetDown(Value: Boolean);
  1003. begin
  1004.   if FGroupIndex = 0 then Value := False;
  1005.   if Value <> FDown then
  1006.   begin
  1007.     if FDown and (not FAllowAllUp) then Exit;
  1008.     FDown := Value;
  1009.     if Value then FState := bsExclusive
  1010.     else FState := bsUp;
  1011.     Invalidate;
  1012.     if Value then UpdateExclusive;
  1013.   end;
  1014. end;
  1015.  
  1016. procedure TSpeedButton.SetGroupIndex(Value: Integer);
  1017. begin
  1018.   if FGroupIndex <> Value then
  1019.   begin
  1020.     FGroupIndex := Value;
  1021.     UpdateExclusive;
  1022.   end;
  1023. end;
  1024.  
  1025. procedure TSpeedButton.SetLayout(Value: TButtonLayout);
  1026. begin
  1027.   if FLayout <> Value then
  1028.   begin
  1029.     FLayout := Value;
  1030.     Invalidate;
  1031.   end;
  1032. end;
  1033.  
  1034. procedure TSpeedButton.SetMargin(Value: Integer);
  1035. begin
  1036.   if (Value <> FMargin) and (Value >= -1) then
  1037.   begin
  1038.     FMargin := Value;
  1039.     Invalidate;
  1040.   end;
  1041. end;
  1042.  
  1043. procedure TSpeedButton.SetSpacing(Value: Integer);
  1044. begin
  1045.   if Value <> FSpacing then
  1046.   begin
  1047.     FSpacing := Value;
  1048.     Invalidate;
  1049.   end;
  1050. end;
  1051.  
  1052. procedure TSpeedButton.SetAllowAllUp(Value: Boolean);
  1053. begin
  1054.   if FAllowAllUp <> Value then
  1055.   begin
  1056.     FAllowAllUp := Value;
  1057.     UpdateExclusive;
  1058.   end;
  1059. end;
  1060.  
  1061. procedure TSpeedButton.WMLButtonDblClk(var Message: TWMLButtonDown);
  1062. begin
  1063.   inherited;
  1064.   if FDown then DblClick;
  1065. end;
  1066.  
  1067. procedure TSpeedButton.CMEnabledChanged(var Message: TMessage);
  1068. const
  1069.   NewState: array[Boolean] of TButtonState = (bsDisabled, bsUp);
  1070. begin
  1071.   TButtonGlyph(FGlyph).CreateButtonGlyph(NewState[Enabled]);
  1072.   Invalidate;
  1073. end;
  1074.  
  1075. procedure TSpeedButton.CMButtonPressed(var Message: TMessage);
  1076. var
  1077.   Sender: TSpeedButton;
  1078. begin
  1079.   if Message.WParam = FGroupIndex then
  1080.   begin
  1081.     Sender := TSpeedButton(Message.LParam);
  1082.     if Sender <> Self then
  1083.     begin
  1084.       if Sender.Down and FDown then
  1085.       begin
  1086.         FDown := False;
  1087.         FState := bsUp;
  1088.         Invalidate;
  1089.       end;
  1090.       FAllowAllUp := Sender.AllowAllUp;
  1091.     end;
  1092.   end;
  1093. end;
  1094.  
  1095. procedure TSpeedButton.CMDialogChar(var Message: TCMDialogChar);
  1096. begin
  1097.   with Message do
  1098.     if IsAccel(CharCode, Caption) and Enabled then
  1099.     begin
  1100.       Click;
  1101.       Result := 1;
  1102.     end else
  1103.       inherited;
  1104. end;
  1105.  
  1106. procedure TSpeedButton.CMFontChanged(var Message: TMessage);
  1107. begin
  1108.   Invalidate;
  1109. end;
  1110.  
  1111. procedure TSpeedButton.CMTextChanged(var Message: TMessage);
  1112. begin
  1113.   Invalidate;
  1114. end;
  1115.  
  1116. procedure TSpeedButton.CMSysColorChange(var Message: TMessage);
  1117. begin
  1118.   with TButtonGlyph(FGlyph) do
  1119.   begin
  1120.     Invalidate;
  1121.     CreateButtonGlyph(FState);
  1122.   end;
  1123. end;
  1124.  
  1125. { TBitBtn }
  1126.  
  1127. constructor TBitBtn.Create(AOwner: TComponent);
  1128. begin
  1129.   inherited Create(AOwner);
  1130.   FGlyph := TButtonGlyph.Create;
  1131.   TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  1132.   FCanvas := TCanvas.Create;
  1133.   FStyle := bsAutoDetect;
  1134.   FKind := bkCustom;
  1135.   FLayout := blGlyphLeft;
  1136.   FSpacing := 4;
  1137.   FMargin := -1;
  1138. end;
  1139.  
  1140. destructor TBitBtn.Destroy;
  1141. begin
  1142.   TButtonGlyph(FGlyph).Free;
  1143.   FCanvas.Free;
  1144.   inherited Destroy;
  1145. end;
  1146.  
  1147. procedure TBitBtn.CreateHandle;
  1148. var
  1149.   State: TButtonState;
  1150. begin
  1151.   if Enabled then
  1152.     State := bsUp
  1153.   else
  1154.     State := bsDisabled;
  1155.   inherited CreateHandle;
  1156.   TButtonGlyph(FGlyph).CreateButtonGlyph(State);
  1157. end;
  1158.  
  1159. procedure TBitBtn.CreateParams(var Params: TCreateParams);
  1160. begin
  1161.   inherited CreateParams(Params);
  1162.   with Params do Style := Style or BS_OWNERDRAW;
  1163. end;
  1164.  
  1165. procedure TBitBtn.SetButtonStyle(ADefault: Boolean);
  1166. begin
  1167.   if ADefault <> IsFocused then
  1168.   begin
  1169.     IsFocused := ADefault;
  1170.     Refresh;
  1171.   end;
  1172. end;
  1173.  
  1174. procedure TBitBtn.Click;
  1175. var
  1176.   Form: TForm;
  1177.   Control: TWinControl;
  1178. begin
  1179.   case FKind of
  1180.     bkClose:
  1181.       begin
  1182.         Form := GetParentForm(Self);
  1183.         if Form <> nil then Form.Close
  1184.         else inherited Click;
  1185.       end;
  1186.     bkHelp:
  1187.       begin
  1188.         Control := Self;
  1189.         while (Control <> nil) and (Control.HelpContext = 0) do
  1190.           Control := Control.Parent;
  1191.         if Control <> nil then Application.HelpContext(Control.HelpContext)
  1192.         else inherited Click;
  1193.       end;
  1194.     else
  1195.       inherited Click;
  1196.   end;
  1197. end;
  1198.  
  1199. procedure TBitBtn.CNMeasureItem(var Message: TWMMeasureItem);
  1200. begin
  1201.   with Message.MeasureItemStruct^ do
  1202.   begin
  1203.     itemWidth := Width;
  1204.     itemHeight := Height;
  1205.   end;
  1206. end;
  1207.  
  1208. procedure TBitBtn.CNDrawItem(var Message: TWMDrawItem);
  1209. begin
  1210.   DrawItem(Message.DrawItemStruct^);
  1211. end;
  1212.  
  1213. procedure TBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct);
  1214. var
  1215.   IsDown, IsDefault: Boolean;
  1216.   State: TButtonState;
  1217.   R: TRect;
  1218.   Flags: Longint;
  1219. begin
  1220.   FCanvas.Handle := DrawItemStruct.hDC;
  1221.   R := ClientRect;
  1222.  
  1223.   with DrawItemStruct do
  1224.   begin
  1225.     IsDown := itemState and ODS_SELECTED <> 0;
  1226.     IsDefault := itemState and ODS_FOCUS <> 0;
  1227.  
  1228.     if not Enabled then State := bsDisabled
  1229.     else if IsDown then State := bsDown
  1230.     else State := bsUp;
  1231.   end;
  1232.  
  1233.   Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  1234.   if IsDown then Flags := Flags or DFCS_PUSHED;
  1235.   if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
  1236.     Flags := Flags or DFCS_INACTIVE;
  1237.  
  1238.   { DrawFrameControl doesn't allow for drawing a button as the
  1239.       default button, so it must be done here. }
  1240.   if IsFocused or IsDefault then
  1241.   begin
  1242.     FCanvas.Pen.Color := clWindowFrame;
  1243.     FCanvas.Pen.Width := 1;
  1244.     FCanvas.Brush.Style := bsClear;
  1245.     FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  1246.  
  1247.     { DrawFrameControl must draw within this border }
  1248.     InflateRect(R, -1, -1);
  1249.   end;
  1250.  
  1251.   { DrawFrameControl does not draw a pressed button correctly }
  1252.   if IsDown then
  1253.   begin
  1254.     FCanvas.Pen.Color := clBtnShadow;
  1255.     FCanvas.Pen.Width := 1;
  1256.     FCanvas.Brush.Color := clBtnFace;
  1257.     FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  1258.     InflateRect(R, -1, -1);
  1259.   end
  1260.   else
  1261.     DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
  1262.  
  1263.   if IsFocused then
  1264.   begin
  1265.     R := ClientRect;
  1266.     InflateRect(R, -1, -1);
  1267.   end;
  1268.  
  1269.   FCanvas.Font := Self.Font;
  1270.   if IsDown then
  1271.     OffsetRect(R, 1, 1);
  1272.   TButtonGlyph(FGlyph).Draw(FCanvas, R, Caption, FLayout,
  1273.     FMargin, FSpacing, State);
  1274.  
  1275.   if IsFocused then
  1276.   begin
  1277.     R := ClientRect;
  1278.     InflateRect(R, -4, -4);
  1279.     FCanvas.Pen.Color := clWindowFrame;
  1280.     FCanvas.Brush.Color := clBtnFace;
  1281.     DrawFocusRect(FCanvas.Handle, R);
  1282.   end;
  1283.  
  1284.   FCanvas.Handle := 0;
  1285. end;
  1286.  
  1287. procedure TBitBtn.CMFontChanged(var Message: TMessage);
  1288. begin
  1289.   inherited;
  1290.   Invalidate;
  1291. end;
  1292.  
  1293. procedure TBitBtn.CMEnabledChanged(var Message: TMessage);
  1294. begin
  1295.   inherited;
  1296.   Invalidate;
  1297. end;
  1298.  
  1299. procedure TBitBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1300. begin
  1301.   Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
  1302. end;
  1303.  
  1304. function TBitBtn.GetPalette: HPALETTE;
  1305. begin
  1306.   Result := Glyph.Palette;
  1307. end;
  1308.  
  1309. procedure TBitBtn.SetGlyph(Value: TBitmap);
  1310. begin
  1311.   TButtonGlyph(FGlyph).Glyph := Value as TBitmap;
  1312.   FModifiedGlyph := True;
  1313.   Invalidate;
  1314. end;
  1315.  
  1316. function TBitBtn.GetGlyph: TBitmap;
  1317. begin
  1318.   Result := TButtonGlyph(FGlyph).Glyph;
  1319. end;
  1320.  
  1321. procedure TBitBtn.GlyphChanged(Sender: TObject);
  1322. begin
  1323.   Invalidate;
  1324. end;
  1325.  
  1326. function TBitBtn.IsCustom: Boolean;
  1327. begin
  1328.   Result := Kind = bkCustom;
  1329. end;
  1330.  
  1331. procedure TBitBtn.SetStyle(Value: TButtonStyle);
  1332. begin
  1333.   if Value <> FStyle then
  1334.   begin
  1335.     FStyle := Value;
  1336.     Invalidate;
  1337.   end;
  1338. end;
  1339.  
  1340. procedure TBitBtn.SetKind(Value: TBitBtnKind);
  1341. begin
  1342.   if Value <> FKind then
  1343.   begin
  1344.     if Value <> bkCustom then
  1345.     begin
  1346.       Default := Value in [bkOK, bkYes];
  1347.       Cancel := Value in [bkCancel, bkNo];
  1348.  
  1349.       if ((csLoading in ComponentState) and (Caption = '')) or
  1350.         (not (csLoading in ComponentState)) then
  1351.       begin
  1352.         if BitBtnCaptions[Value] > 0 then
  1353.           Caption := LoadStr(BitBtnCaptions[Value]);
  1354.       end;
  1355.  
  1356.       ModalResult := BitBtnModalResults[Value];
  1357.       TButtonGlyph(FGlyph).Glyph := GetBitBtnGlyph(Value);
  1358.       NumGlyphs := 2;
  1359.       FModifiedGlyph := False;
  1360.     end;
  1361.     FKind := Value;
  1362.     Invalidate;
  1363.   end;
  1364. end;
  1365.  
  1366. function TBitBtn.IsCustomCaption: Boolean;
  1367. begin
  1368.   Result := CompareStr(Caption, LoadStr(BitBtnCaptions[FKind])) <> 0;
  1369. end;
  1370.  
  1371. function TBitBtn.GetKind: TBitBtnKind;
  1372. begin
  1373.   if FKind <> bkCustom then
  1374.     if ((FKind in [bkOK, bkYes]) xor Default) or
  1375.       ((FKind in [bkCancel, bkNo]) xor Cancel) or
  1376.       (ModalResult <> BitBtnModalResults[FKind]) or
  1377.       FModifiedGlyph then
  1378.       FKind := bkCustom;
  1379.   Result := FKind;
  1380. end;
  1381.  
  1382. procedure TBitBtn.SetLayout(Value: TButtonLayout);
  1383. begin
  1384.   if FLayout <> Value then
  1385.   begin
  1386.     FLayout := Value;
  1387.     Invalidate;
  1388.   end;
  1389. end;
  1390.  
  1391. function TBitBtn.GetNumGlyphs: TNumGlyphs;
  1392. begin
  1393.   Result := TButtonGlyph(FGlyph).NumGlyphs;
  1394. end;
  1395.  
  1396. procedure TBitBtn.SetNumGlyphs(Value: TNumGlyphs);
  1397. begin
  1398.   if Value < 0 then Value := 1
  1399.   else if Value > 4 then Value := 4;
  1400.   if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  1401.   begin
  1402.     TButtonGlyph(FGlyph).NumGlyphs := Value;
  1403.     Invalidate;
  1404.   end;
  1405. end;
  1406.  
  1407. procedure TBitBtn.SetSpacing(Value: Integer);
  1408. begin
  1409.   if FSpacing <> Value then
  1410.   begin
  1411.     FSpacing := Value;
  1412.     Invalidate;
  1413.   end;
  1414. end;
  1415.  
  1416. procedure TBitBtn.SetMargin(Value: Integer);
  1417. begin
  1418.   if (Value <> FMargin) and (Value >= - 1) then
  1419.   begin
  1420.     FMargin := Value;
  1421.     Invalidate;
  1422.   end;
  1423. end;
  1424.  
  1425. procedure DestroyLocals; far;
  1426. var
  1427.   I: TBitBtnKind;
  1428. begin
  1429.   for I := Low(TBitBtnKind) to High(TBitBtnKind) do
  1430.     BitBtnGlyphs[I].Free;
  1431. end;
  1432.  
  1433. initialization
  1434.   FillChar(BitBtnGlyphs, SizeOf(BitBtnGlyphs), 0);
  1435. finalization
  1436.   DestroyLocals;
  1437. end.
  1438.