unit TB97Ctls;

{
  Toolbar97
  Copyright (C) 1998-99 by Jordan Russell
  For conditions of distribution and use, see LICENSE.TXT.

  TToolbarButton97 & TEdit97
}

interface

{$I TB97Ver.inc}

uses
  Windows, Messages, Classes, Controls, Forms, Menus, Graphics, Buttons,
  {$IFDEF TB97D4} ImgList, ActnList, {$ENDIF} StdCtrls, ExtCtrls,
  TB97Vers;

const
  DefaultDropdownArrowWidth = 9;
type
  { TToolbarButton97 }

  TButtonDisplayMode = (dmBoth, dmGlyphOnly, dmTextOnly);
  TButtonState97 = (bsUp, bsDisabled, bsDown, bsExclusive, bsMouseIn);
  TNumGlyphs97 = 1..5;
  TButtonDropdownEvent = procedure(Sender: TObject;
    var ShowMenu, RemoveClicks: Boolean) of object;

  TToolbarButton97 = class(TGraphicControl)
  private
    FAllowAllUp: Boolean;
    FAlignment: TAlignment;
    FCancel: Boolean;
    FDefault: Boolean;
    FDisplayMode: TButtonDisplayMode;
    FDown: Boolean;
    FDropdownAlways: Boolean;
    FDropdownArrow: Boolean;
    FDropdownArrowWidth: Integer;
    FDropdownCombo: Boolean;
    FDropdownMenu: TPopupMenu;
    FFlat: Boolean;
    FGlyph: Pointer;
    FGroupIndex: Integer;
    FHelpContext: THelpContext;
    FHighlightWhenDown: Boolean;
    FLayout: TButtonLayout;
    FMargin: Integer;
    FModalResult: TModalResult;
    FNoBorder: Boolean;
    FOldDisabledStyle: Boolean;
    FOpaque: Boolean;
    FRepeating: Boolean;
    FRepeatDelay, FRepeatInterval: Integer;
    FShowBorderWhenInactive: Boolean;
    FSpacing: Integer;
    FWordWrap: Boolean;
    FOnDropdown: TButtonDropdownEvent;
    FOnMouseEnter, FOnMouseExit: TNotifyEvent;
    { Internal }
    FInClick: Boolean;
    FMouseInControl: Boolean;
    FMouseIsDown: Boolean;
    FMenuIsDown: Boolean;
    FUsesDropdown: Boolean;
    FRepeatTimer: TTimer;
    procedure GlyphChanged(Sender: TObject);
    procedure UpdateExclusive;
    procedure SetAlignment (Value: TAlignment);
    procedure SetAllowAllUp (Value: Boolean);
    function GetCallDormant: Boolean;
    procedure SetCallDormant (Value: Boolean);
    procedure SetDown (Value: Boolean);
    procedure SetDisplayMode (Value: TButtonDisplayMode);
    procedure SetDropdownAlways (Value: Boolean);
    procedure SetDropdownArrow (Value: Boolean);
    procedure SetDropdownArrowWidth (Value: Integer);
    procedure SetDropdownCombo (Value: Boolean);
    procedure SetDropdownMenu (Value: TPopupMenu);
    procedure SetFlat (Value: Boolean);
    function GetGlyph: TBitmap;
    procedure SetGlyph (Value: TBitmap);
    function GetGlyphMask: TBitmap;
    procedure SetGlyphMask (Value: TBitmap);
    procedure SetGroupIndex (Value: Integer);
    procedure SetHighlightWhenDown (Value: Boolean);
    function GetImageIndex: Integer;
    procedure SetImageIndex (Value: Integer);
    function GetImages: TCustomImageList;
    procedure SetImages (Value: TCustomImageList);
    procedure SetLayout (Value: TButtonLayout);
    procedure SetMargin (Value: Integer);
    procedure SetNoBorder (Value: Boolean);
    function GetNumGlyphs: TNumGlyphs97;
    procedure SetNumGlyphs (Value: TNumGlyphs97);
    procedure SetOldDisabledStyle (Value: Boolean);
    procedure SetOpaque (Value: Boolean);
    procedure SetSpacing (Value: Integer);
    function GetVersion: TToolbar97Version;
    procedure SetVersion (const Value: TToolbar97Version);
    procedure SetWordWrap (Value: Boolean);
    procedure RemoveButtonMouseTimer;
    procedure Redraw (const Erase: Boolean);
    function PointInButton (X, Y: Integer): Boolean;
    procedure ButtonMouseTimerHandler (Sender: TObject);
    procedure RepeatTimerHandler (Sender: TObject);
    {$IFDEF TB97D4}
    function IsCheckedStored: Boolean;
    function IsHelpContextStored: Boolean;
    function IsImageIndexStored: Boolean;
    {$ENDIF}
    procedure WMLButtonDblClk (var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMDialogChar (var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMDialogKey (var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure WMCancelMode (var Message: TWMCancelMode); message WM_CANCELMODE;
  protected
    FState: TButtonState97;
    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove (Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp (Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
    {$IFDEF TB97D4}
    procedure ActionChange (Sender: TObject; CheckDefaults: Boolean); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure AssignTo (Dest: TPersistent); override;
    {$ENDIF}
  public
    property CallDormant: Boolean read GetCallDormant write SetCallDormant;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
    procedure MouseEntered;
    procedure MouseLeft;
  published
    {$IFDEF TB97D4}
    property Action;
    {$ENDIF}
    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    {$IFDEF TB97D4}
    property Anchors;
    {$ENDIF}
    property Cancel: Boolean read FCancel write FCancel default False;
    property Color default clBtnFace;
    {$IFDEF TB97D4}
    property Constraints;
    {$ENDIF}
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property Default: Boolean read FDefault write FDefault default False;
    property DisplayMode: TButtonDisplayMode read FDisplayMode write SetDisplayMode default dmBoth;
    property Down: Boolean read FDown write SetDown {$IFDEF TB97D4} stored IsCheckedStored {$ENDIF} default False;
    property DragCursor;
    property DragMode;
    property DropdownAlways: Boolean read FDropdownAlways write SetDropdownAlways default False;
    property DropdownArrow: Boolean read FDropdownArrow write SetDropdownArrow default True;
    property DropdownArrowWidth: Integer read FDropdownArrowWidth write SetDropdownArrowWidth default DefaultDropdownArrowWidth;
    property DropdownCombo: Boolean read FDropdownCombo write SetDropdownCombo default False;
    property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu;
    property Caption;
    property Enabled;
    property Flat: Boolean read FFlat write SetFlat default True;
    property Font;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GlyphMask: TBitmap read GetGlyphMask write SetGlyphMask;
    property HelpContext: THelpContext read FHelpContext write FHelpContext {$IFDEF TB97D4} stored IsHelpContextStored {$ENDIF} default 0;
    property HighlightWhenDown: Boolean read FHighlightWhenDown write SetHighlightWhenDown default True;
    property ImageIndex: Integer read GetImageIndex write SetImageIndex {$IFDEF TB97D4} stored IsImageIndexStored {$ENDIF} default -1;
    property Images: TCustomImageList read GetImages write SetImages;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property ModalResult: TModalResult read FModalResult write FModalResult default 0;
    property NoBorder: Boolean read FNoBorder write SetNoBorder default False;
    property NumGlyphs: TNumGlyphs97 read GetNumGlyphs write SetNumGlyphs default 1;
    property OldDisabledStyle: Boolean read FOldDisabledStyle write SetOldDisabledStyle default False;
    property Opaque: Boolean read FOpaque write SetOpaque default True;
    property ParentFont;
    property ParentColor default False;
    property ParentShowHint;
    property Repeating: Boolean read FRepeating write FRepeating default False;
    property RepeatDelay: Integer read FRepeatDelay write FRepeatDelay default 400;
    property RepeatInterval: Integer read FRepeatInterval write FRepeatInterval default 100;
    property ShowBorderWhenInactive: Boolean read FShowBorderWhenInactive write FShowBorderWhenInactive default False;
    property ShowHint;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Version: TToolbar97Version read GetVersion write SetVersion stored False;
    property Visible;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropdown: TButtonDropdownEvent read FOnDropdown write FOnDropdown;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  { TToolButtonActionLink }

  {$IFDEF TB97D4}
  TToolbarButton97ActionLink = class(TControlActionLink)
  protected
    FClient: TToolbarButton97;
    procedure AssignClient (AClient: TObject); override;
    function IsCheckedLinked: Boolean; override;
    function IsHelpContextLinked: Boolean; override;
    function IsImageIndexLinked: Boolean; override;
    procedure SetChecked (Value: Boolean); override;
    procedure SetHelpContext (Value: THelpContext); override;
    procedure SetImageIndex (Value: Integer); override;
  end;

  TToolbarButton97ActionLinkClass = class of TToolbarButton97ActionLink;
  {$ENDIF}

  { TEdit97 }

  TEdit97 = class(TCustomEdit)
  private
    MouseInControl: Boolean;
    function GetVersion: TToolbar97Version;
    procedure SetVersion (const Value: TToolbar97Version);
    procedure DrawNCArea (const DrawToDC: Boolean; const ADC: HDC;
      const Clip: HRGN);
    procedure NewAdjustHeight;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMKillFocus (var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure WMPrint (var Message: TMessage); message WM_PRINT;
    procedure WMPrintClient (var Message: TMessage); message WM_PRINTCLIENT;
    procedure WMSetFocus (var Message: TWMSetFocus); message WM_SETFOCUS;
  protected
    procedure Loaded; override;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AutoSelect;
    {$IFDEF TB97D4}
    property Anchors;
    {$ENDIF}
    property Align;
    {$IFDEF TB97D4}
    property BiDiMode;
    {$ENDIF}
    property CharCase;
    {$IFDEF TB97D4}
    property Constraints;
    {$ENDIF}
    property DragCursor;
    {$IFDEF TB97D4}
    property DragKind;
    {$ENDIF}
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    {$IFDEF TB97D3}
    property ImeMode;
    property ImeName;
    {$ENDIF}
    property MaxLength;
    property OEMConvert;
    {$IFDEF TB97D4}
    property ParentBiDiMode;
    {$ENDIF}
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Version: TToolbar97Version read GetVersion write SetVersion stored False;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    {$IFDEF TB97D4}
    property OnEndDock;
    {$ENDIF}
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    {$IFDEF TB97D4}
    property OnStartDock;
    {$ENDIF}
    property OnStartDrag;
  end;

var
  ButtonsStayDown: Boolean = True;
  ButtonMouseInControl: TToolbarButton97 = nil;

function ControlIs97Control (AControl: TControl): Boolean;
procedure Register97ControlClass (AClass: TClass);
procedure Unregister97ControlClass (AClass: TClass);

implementation

uses
  SysUtils, Consts, CommCtrl, TB97Cmn;

var
  { See TToolbarButton97.ButtonMouseTimerHandler for info on this }
  ButtonMouseTimer: TTimer = nil;

  Control97List: TList = nil;

  Edit97Count: Integer = 0;

const
  DropdownComboSpace = 2;

function ControlIs97Control (AControl: TControl): Boolean;
var
  I: Integer;
begin
  Result := False;
  if Assigned(AControl) and Assigned(Control97List) then
    for I := 0 to Control97List.Count-1 do
      if AControl is TClass(Control97List[I]) then begin
        Result := True;
        Break;
      end;
end;

procedure Register97ControlClass (AClass: TClass);
begin
  if Control97List = nil then Control97List := TList.Create;
  Control97List.Add (AClass);
end;

procedure Unregister97ControlClass (AClass: TClass);
begin
  if Assigned(Control97List) then begin
    Control97List.Remove (AClass);
    if Control97List.Count = 0 then begin
      Control97List.Free;
      Control97List := nil;
    end;
  end;
end;

{ TToolbarButton97ActionLink - internal }

{$IFDEF TB97D4}
procedure TToolbarButton97ActionLink.AssignClient (AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TToolbarButton97;
end;

function TToolbarButton97ActionLink.IsCheckedLinked: Boolean;
begin
  Result := inherited IsCheckedLinked and
    (FClient.Down = (Action as TCustomAction).Checked);
end;

function TToolbarButton97ActionLink.IsHelpContextLinked: Boolean;
begin
  Result := inherited IsHelpContextLinked and
    (FClient.HelpContext = (Action as TCustomAction).HelpContext);
end;

function TToolbarButton97ActionLink.IsImageIndexLinked: Boolean;
begin
  Result := inherited IsImageIndexLinked and
    (FClient.ImageIndex = (Action as TCustomAction).ImageIndex);
end;

procedure TToolbarButton97ActionLink.SetChecked (Value: Boolean);
begin
  if IsCheckedLinked then FClient.Down := Value;
end;

procedure TToolbarButton97ActionLink.SetHelpContext (Value: THelpContext);
begin
  if IsHelpContextLinked then FClient.HelpContext := Value;
end;

procedure TToolbarButton97ActionLink.SetImageIndex (Value: Integer);
begin
  if IsImageIndexLinked then FClient.ImageIndex := Value;
end;
{$ENDIF}


{ TToolbarButton97 - internal }

type
  TGlyphList = class(TImageList)
  private
    Used: TBits;
    FCount: Integer;
    function AllocateIndex: Integer;
  public
    constructor CreateSize (AWidth, AHeight: Integer);
    destructor Destroy; override;
    function Add (Image, Mask: TBitmap): Integer;
    function AddMasked (Image: TBitmap; MaskColor: TColor): Integer;
    procedure Delete (Index: Integer);
    property Count: Integer read FCount;
  end;

  TGlyphCache = class
  private
    GlyphLists: TList;
  public
    constructor Create;
    destructor Destroy; override;
    function GetList(AWidth, AHeight: Integer): TGlyphList;
    procedure ReturnList(List: TGlyphList);
    function Empty: Boolean;
  end;

  TBoolInt = record
    B: Boolean;
    I: Integer;
  end;

  TCustomImageListAccess = class(TCustomImageList);

  TButtonGlyph = class
  private
    FOriginal, FOriginalMask: TBitmap;
    FCallDormant: Boolean;
    FGlyphList: array[Boolean] of TGlyphList;
    FImageIndex: Integer;
    FImageList: TCustomImageList;
    FImageChangeLink: TChangeLink;
    FIndexs: array[Boolean, TButtonState97] of Integer;
    FTransparentColor: TColor;
    FNumGlyphs: TNumGlyphs97;
    FOnChange: TNotifyEvent;
    FOldDisabledStyle: Boolean;
    procedure GlyphChanged (Sender: TObject);
    procedure SetGlyph (Value: TBitmap);
    procedure SetGlyphMask (Value: TBitmap);
    procedure SetNumGlyphs (Value: TNumGlyphs97);
    procedure UpdateNumGlyphs;
    procedure Invalidate;
    function CreateButtonGlyph (State: TButtonState97): TBoolInt;
    procedure DrawButtonGlyph (Canvas: TCanvas; const GlyphPos: TPoint;
      State: TButtonState97);
    procedure DrawButtonText (Canvas: TCanvas;
      const Caption: string; TextBounds: TRect;
      WordWrap: Boolean; Alignment: TAlignment; State: TButtonState97);
    procedure DrawButtonDropArrow (Canvas: TCanvas; const X, Y, AWidth: Integer;
      State: TButtonState97);
    procedure CalcButtonLayout (Canvas: TCanvas; const Client: TRect;
      const Offset: TPoint; DrawGlyph, DrawCaption: Boolean;
      const Caption: string; WordWrap: Boolean;
      Layout: TButtonLayout; Margin, Spacing: Integer; DropArrow: Boolean;
      DropArrowWidth: Integer; var GlyphPos, ArrowPos: TPoint;
      var TextBounds: TRect);
  public
    constructor Create;
    destructor Destroy; override;
    { returns the text rectangle }
    function Draw (Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      DrawGlyph, DrawCaption: Boolean; const Caption: string; WordWrap: Boolean;
      Alignment: TAlignment; Layout: TButtonLayout; Margin, Spacing: Integer;
      DropArrow: Boolean; DropArrowWidth: Integer; State: TButtonState97): TRect;
    property Glyph: TBitmap read FOriginal write SetGlyph;
    property GlyphMask: TBitmap read FOriginalMask write SetGlyphMask;
    property NumGlyphs: TNumGlyphs97 read FNumGlyphs write SetNumGlyphs;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;


{ TGlyphList }

constructor TGlyphList.CreateSize(AWidth, AHeight: Integer);
begin
  inherited CreateSize (AWidth, AHeight);
  Used := TBits.Create;
end;

destructor TGlyphList.Destroy;
begin
  Used.Free;
  inherited;
end;

function TGlyphList.AllocateIndex: Integer;
begin
  Result := Used.OpenBit;
  if Result >= Used.Size then
  begin
    Result := inherited Add(nil, nil);
    Used.Size := Result + 1;
  end;
  Used[Result] := True;
end;

function TGlyphList.Add (Image, Mask: TBitmap): Integer;
begin
  Result := AllocateIndex;
  Replace (Result, Image, Mask);
  Inc (FCount);
end;

function TGlyphList.AddMasked (Image: TBitmap; MaskColor: TColor): Integer;
  procedure BugfreeReplaceMasked (Index: Integer; NewImage: TBitmap; MaskColor: TColor);
    procedure CheckImage (Image: TGraphic);
    begin
      if Image = nil then Exit;
      if (Image.Height < Height) or (Image.Width < Width) then
        raise EInvalidOperation.Create({$IFNDEF TB97D3}LoadStr{$ENDIF}(SInvalidImageSize));
    end;
  var
    TempIndex: Integer;
    Image, Mask: TBitmap;
  begin
    if HandleAllocated then begin
      CheckImage(NewImage);
      TempIndex := inherited AddMasked(NewImage, MaskColor);
      if TempIndex <> -1 then
        try
          Image := nil;
          Mask := nil;
          try
            Image := TBitmap.Create;
            Image.Height := Height;
            Image.Width := Width;
            Mask := TBitmap.Create;
            Mask.Monochrome := True;
            { ^ Prevents the "invisible glyph" problem when used with certain
                color schemes. (Fixed in Delphi 3.01) }
            Mask.Height := Height;
            Mask.Width := Width;
            ImageList_Draw (Handle, TempIndex, Image.Canvas.Handle, 0, 0, ILD_NORMAL);
            ImageList_Draw (Handle, TempIndex, Mask.Canvas.Handle, 0, 0, ILD_MASK);
            if not ImageList_Replace(Handle, Index, Image.Handle, Mask.Handle) then
              raise EInvalidOperation.Create({$IFNDEF TB97D3}LoadStr{$ENDIF}(SReplaceImage));
          finally
            Image.Free;
            Mask.Free;
          end;
        finally
          inherited Delete(TempIndex);
        end
      else
        raise EInvalidOperation.Create({$IFNDEF TB97D3}LoadStr{$ENDIF}(SReplaceImage));
    end;
    Change;
  end;
begin
  Result := AllocateIndex;
  { This works two very serious bugs in the Delphi 2/BCB and Delphi 3
    implementations of the ReplaceMasked method. In the Delphi 2 and BCB
    versions of the ReplaceMasked method, it incorrectly uses ILD_NORMAL as
    the last parameter for the second ImageList_Draw call, in effect causing
    all white colors to be considered transparent also. And in the Delphi 2/3
    and BCB versions it doesn't set Monochrome to True on the Mask bitmap,
    causing the bitmaps to be invisible on certain color schemes. }
  BugfreeReplaceMasked (Result, Image, MaskColor);
  Inc (FCount);
end;

procedure TGlyphList.Delete (Index: Integer);
begin
  if Used[Index] then begin
    Dec(FCount);
    Used[Index] := False;
  end;
end;

{ TGlyphCache }

constructor TGlyphCache.Create;
begin
  inherited;
  GlyphLists := TList.Create;
end;

destructor TGlyphCache.Destroy;
begin
  GlyphLists.Free;
  inherited;
end;

function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList;
var
  I: Integer;
begin
  for I := GlyphLists.Count - 1 downto 0 do begin
    Result := GlyphLists[I];
    with Result do
      if (AWidth = Width) and (AHeight = Height) then Exit;
  end;
  Result := TGlyphList.CreateSize(AWidth, AHeight);
  GlyphLists.Add(Result);
end;

procedure TGlyphCache.ReturnList(List: TGlyphList);
begin
  if List = nil then Exit;
  if List.Count = 0 then begin
    GlyphLists.Remove(List);
    List.Free;
  end;
end;

function TGlyphCache.Empty: Boolean;
begin
  Result := GlyphLists.Count = 0;
end;

var
  GlyphCache: TGlyphCache = nil;
  Pattern: TBitmap = nil;
  PatternBtnFace, PatternBtnHighlight: TColor;
  ButtonCount: Integer = 0;

procedure CreateBrushPattern;
var
  X, Y: Integer;
begin
  PatternBtnFace := GetSysColor(COLOR_BTNFACE);
  PatternBtnHighlight := GetSysColor(COLOR_BTNHIGHLIGHT);
  Pattern := TBitmap.Create;
  with Pattern do begin
    Width := 8;
    Height := 8;
    with Canvas do begin
      Brush.Style := bsSolid;
      Brush.Color := clBtnFace;
      FillRect (Rect(0, 0, Width, Height));
      for Y := 0 to 7 do
        for X := 0 to 7 do
          if Odd(Y) = Odd(X) then  { toggles between even/odd pixels }
            Pixels[X, Y] := clBtnHighlight;     { on even/odd rows }
    end;
  end;
end;


{ TButtonGlyph }

constructor TButtonGlyph.Create;
var
  B: Boolean;
  I: TButtonState97;
begin
  inherited;
  FCallDormant := True;
  FImageIndex := -1;
  FOriginal := TBitmap.Create;
  FOriginal.OnChange := GlyphChanged;
  FOriginalMask := TBitmap.Create;
  FOriginalMask.OnChange := GlyphChanged;
  FNumGlyphs := 1;
  for B := False to True do
    for I := Low(I) to High(I) do
      FIndexs[B, I] := -1;
  if GlyphCache = nil then
    GlyphCache := TGlyphCache.Create;
end;

destructor TButtonGlyph.Destroy;
begin
  FOriginalMask.Free;
  FOriginal.Free;
  FImageChangeLink.Free;
  Invalidate;
  if Assigned(GlyphCache) and GlyphCache.Empty then begin
    GlyphCache.Free;
    GlyphCache := nil;
  end;
  inherited;
end;

procedure TButtonGlyph.Invalidate;
var
  B: Boolean;
  I: TButtonState97;
begin
  for B := False to True do begin
    for I := Low(I) to High(I) do 
      if FIndexs[B, I] <> -1 then begin
        FGlyphList[B].Delete (FIndexs[B, I]);
        FIndexs[B, I] := -1;
      end;
    GlyphCache.ReturnList (FGlyphList[B]);
    FGlyphList[B] := nil;
  end;
end;

procedure TButtonGlyph.GlyphChanged (Sender: TObject);
begin
  if (Sender = FOriginal) and (FOriginal.Width <> 0) and (FOriginal.Height <> 0) then
    FTransparentColor := FOriginal.Canvas.Pixels[0, FOriginal.Height-1] or $02000000;
  Invalidate;
  if Assigned(FOnChange) then FOnChange (Self);
end;

procedure TButtonGlyph.UpdateNumGlyphs;
var
  Glyphs: Integer;
begin
  if (FOriginal.Width <> 0) and (FOriginal.Height <> 0) and
     (FOriginal.Width mod FOriginal.Height = 0) then begin
    Glyphs := FOriginal.Width div FOriginal.Height;
    if Glyphs > High(TNumGlyphs97) then Glyphs := 1;
  end
  else
    Glyphs := 1;
  SetNumGlyphs (Glyphs);
end;

procedure TButtonGlyph.SetGlyph (Value: TBitmap);
begin
  Invalidate;
  FOriginal.Assign (Value);
  UpdateNumGlyphs;
end;

procedure TButtonGlyph.SetGlyphMask (Value: TBitmap);
begin
  Invalidate;
  FOriginalMask.Assign (Value);
end;

procedure TButtonGlyph.SetNumGlyphs (Value: TNumGlyphs97);
begin
  Invalidate;
  if (FImageList <> nil) or (Value < Low(TNumGlyphs97)) or
     (Value > High(TNumGlyphs97)) then
    FNumGlyphs := 1
  else
    FNumGlyphs := Value;
  GlyphChanged (nil);
end;

function TButtonGlyph.CreateButtonGlyph (State: TButtonState97): TBoolInt;
const
  ROP_DSPDxax = $00E20746;
  ROP_PSDPxax = $00B8074A;
  ROP_DSna = $00220326;  { D & ~S }

  procedure GenerateMaskBitmapFromDIB (const MaskBitmap, SourceBitmap: TBitmap;
    const SourceOffset, SourceSize: TPoint; TransColors: array of TColor);
  { This a special procedure meant for generating monochrome masks from
    >4 bpp color DIB sections. Because each video driver seems to sport its own
    interpretation of how to handle DIB sections, a workaround procedure like
    this was necessary. }
  type
    TColorArray = array[0..536870910] of TColorRef;
  var
    Info: packed record
      Header: TBitmapInfoHeader;
      Colors: array[0..1] of TColorRef;
    end;
    W, H: Integer;
    I, Y, X: Integer;
    Pixels: ^TColorArray;
    Pixel: ^TColorRef;
    MonoPixels: Pointer;
    MonoPixel, StartMonoPixel: ^Byte;
    MonoScanLineSize, CurBit: Integer;
    DC: HDC;
    MaskBmp: HBITMAP;
  begin
    W := SourceBitmap.Width;
    H := SourceBitmap.Height;
    MonoScanLineSize := SourceSize.X div 8;
    if SourceSize.X mod 8 <> 0 then
      Inc (MonoScanLineSize);
    if MonoScanLineSize mod 4 <> 0 then  { Compensate for scan line boundary }
      MonoScanLineSize := (MonoScanLineSize and not 3) + 4;
    MonoPixels := AllocMem(MonoScanLineSize * SourceSize.Y);  { AllocMem is used because it initializes to zero }
    try
      GetMem (Pixels, W * H * 4);
      try
        FillChar (Info, SizeOf(Info), 0);
        with Info do begin
          with Header do begin
            biSize := SizeOf(TBitmapInfoHeader);
            biWidth := W;
            biHeight := -H;  { negative number makes it a top-down DIB }
            biPlanes := 1;
            biBitCount := 32;
            {biCompression := BI_RGB;}  { implied due to the FillChar zeroing }
          end;
          {Colors[0] := clBlack;}  { implied due to the FillChar zeroing }
          Colors[1] := clWhite;
        end;
        DC := CreateCompatibleDC(0);
        GetDIBits (DC, SourceBitmap.Handle, 0, H, Pixels, PBitmapInfo(@Info)^,
          DIB_RGB_COLORS);
        DeleteDC (DC);

        for I := 0 to High(TransColors) do
          if TransColors[I] = -1 then
            TransColors[I] := Pixels[W * (H-1)] and $FFFFFF;
              { ^ 'and' operation is necessary because the high byte is undefined }

        MonoPixel := MonoPixels;
        for Y := SourceOffset.Y to SourceOffset.Y+SourceSize.Y-1 do begin
          StartMonoPixel := MonoPixel;
          CurBit := 7;
          Pixel := @Pixels[(Y * W) + SourceOffset.X];
          for X := 0 to SourceSize.X-1 do begin
            for I := 0 to High(TransColors) do
              if Pixel^ and $FFFFFF = Cardinal(TransColors[I]) then begin
                { ^ 'and' operation is necessary because the high byte is undefined }
                MonoPixel^ := MonoPixel^ or (1 shl CurBit);
                Break;
              end;
            Dec (CurBit);
            if CurBit < 0 then begin
              Inc (Integer(MonoPixel));
              CurBit := 7;
            end;
            Inc (Integer(Pixel), SizeOf(Longint));  { proceed to the next pixel }
          end;
          Integer(MonoPixel) := Integer(StartMonoPixel) + MonoScanLineSize;
        end;
      finally
        FreeMem (Pixels);
      end;

      { Write new bits into a new HBITMAP, and assign this handle to MaskBitmap }
      MaskBmp := CreateBitmap(SourceSize.X, SourceSize.Y, 1, 1, nil);
      with Info.Header do begin
        biWidth := SourceSize.X;
        biHeight := -SourceSize.Y;  { negative number makes it a top-down DIB }
        biPlanes := 1;
        biBitCount := 1;
      end;
      DC := CreateCompatibleDC(0);
      SetDIBits (DC, MaskBmp, 0, SourceSize.Y, MonoPixels, PBitmapInfo(@Info)^,
        DIB_RGB_COLORS);
      DeleteDC (DC);
    finally
      FreeMem (MonoPixels);
    end;

    MaskBitmap.Handle := MaskBmp;
  end;
  procedure GenerateMaskBitmap (const MaskBitmap, SourceBitmap: TBitmap;
    const SourceOffset, SourceSize: TPoint; const TransColors: array of TColor);
  { Returns handle of a monochrome bitmap, with pixels in SourceBitmap of color
    TransColor set to white in the resulting bitmap. All other colors of
    SourceBitmap are set to black in the resulting bitmap. This uses the
    regular ROP_DSPDxax BitBlt method. }
  var
    CanvasHandle: HDC;
    SaveBkColor: TColorRef;
    DC: HDC;
    MaskBmp, SaveBmp: HBITMAP;
    I: Integer;
  const
    ROP: array[Boolean] of DWORD = (SRCPAINT, SRCCOPY);
  begin
    CanvasHandle := SourceBitmap.Canvas.Handle;

    MaskBmp := CreateBitmap(SourceSize.X, SourceSize.Y, 1, 1, nil);
    DC := CreateCompatibleDC(0);
    SaveBmp := SelectObject(DC, MaskBmp);
    SaveBkColor := GetBkColor(CanvasHandle);
    for I := 0 to High(TransColors) do begin
      SetBkColor (CanvasHandle, ColorToRGB(TransColors[I]));
      BitBlt (DC, 0, 0, SourceSize.X, SourceSize.Y, CanvasHandle,
        SourceOffset.X, SourceOffset.Y, ROP[I = 0]);
    end;
    SetBkColor (CanvasHandle, SaveBkColor);
    SelectObject (DC, SaveBmp);
    DeleteDC (DC);

    MaskBitmap.Handle := MaskBmp;
  end;
  procedure ReplaceBitmapColorsFromMask (const MaskBitmap, DestBitmap: TBitmap;
    const DestOffset, DestSize: TPoint; const ReplaceColor: TColor);
  var
    DestDC: HDC;
    SaveBrush: HBRUSH;
    SaveTextColor, SaveBkColor: TColorRef;
  begin
    DestDC := DestBitmap.Canvas.Handle;

    SaveBrush := SelectObject(DestDC, CreateSolidBrush(ColorToRGB(ReplaceColor)));
    SaveTextColor := SetTextColor(DestDC, clBlack);
    SaveBkColor := SetBkColor(DestDC, clWhite);
    BitBlt (DestDC, DestOffset.X, DestOffset.Y, DestSize.X, DestSize.Y,
      MaskBitmap.Canvas.Handle, 0, 0, ROP_DSPDxax);
    SetBkColor (DestDC, SaveBkColor);
    SetTextColor (DestDC, SaveTextColor);
    DeleteObject (SelectObject(DestDC, SaveBrush));
  end;
  function CopyBitmapToDDB (const SourceBitmap: TBitmap): TBitmap;
  { Makes a device-dependent duplicate of SourceBitmap. The color palette,
    if any, is preserved. }
  var
    SB: HBITMAP;
    SavePalette: HPALETTE;
    DC: HDC;
    BitmapInfo: packed record
      Header: TBitmapInfoHeader;
      Colors: array[0..255] of TColorRef;
    end;
    Bits: Pointer;
  begin
    Result := TBitmap.Create;
    try
      Result.Palette := CopyPalette(SourceBitmap.Palette);
      Result.Width := SourceBitmap.Width;
      Result.Height := SourceBitmap.Height;
      SB := SourceBitmap.Handle;
      if SB = 0 then Exit;  { it would have a null handle if its width or height was zero }
      SavePalette := 0;
      DC := CreateCompatibleDC(0);
      try
        if Result.Palette <> 0 then begin
          SavePalette := SelectPalette(DC, Result.Palette, False);
          RealizePalette (DC);
        end;
        BitmapInfo.Header.biSize := SizeOf(TBitmapInfoHeader);
        BitmapInfo.Header.biBitCount := 0;  { instructs GetDIBits not to fill in the color table }
        { First retrieve the BitmapInfo header only }
        if GetDIBits(DC, SB, 0, 0, nil, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS) <> 0 then begin
          GetMem (Bits, BitmapInfo.Header.biSizeImage);
          try
            { Then read the actual bits }
            if GetDIBits(DC, SB, 0, SourceBitmap.Height, Bits, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS) <> 0 then
              { And copy them to the resulting bitmap }
              SetDIBits (DC, Result.Handle, 0, SourceBitmap.Height, Bits, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS);
          finally
            FreeMem (Bits);
          end;
        end;
      finally
        if SavePalette <> 0 then SelectPalette (DC, SavePalette, False);
        DeleteDC (DC);
      end;
    except
      Result.Free;
      raise;
    end;
  end;
const
  ROPs: array[Boolean] of DWORD = (ROP_PSDPxax, ROP_DSPDxax);
var
  OriginalBmp, OriginalMaskBmp, TmpImage, DDB, MonoBmp, MaskBmp, UseMaskBmp: TBitmap;
  I: TButtonState97;
  B: Boolean;
  AddPixels, IWidth, IHeight, IWidthA, IHeightA: Integer;
  IRect, IRectA, SourceRect, R: TRect;
  DC: HDC;
  UsesMask: Boolean;
{$IFDEF TB97D3}
  IsHighColorDIB: Boolean;
{$ELSE}
const
  IsHighColorDIB = False;
{$ENDIF}
begin
  if (State <> bsDisabled) and (Ord(State) >= NumGlyphs) then
    State := bsUp;
  Result.B := True;
  Result.I := FIndexs[True, State];
  if Result.I = -1 then begin
    Result.B := False;
    Result.I := FIndexs[False, State];
  end;
  if Result.I <> -1 then Exit;
  if FImageList = nil then begin
    if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
    UsesMask := (FOriginalMask.Width <> 0) and (FOriginalMask.Height <> 0);
  end
  else begin
    if (FImageIndex < 0) or (FImageIndex >= FImageList.Count) then Exit;
    UsesMask := False;
  end;
  B := State <> bsDisabled;
  { + AddPixels is to make sure the highlight color on generated disabled glyphs
    doesn't get cut off }
  if FImageList = nil then begin
    IWidthA := FOriginal.Width div FNumGlyphs;
    IHeightA := FOriginal.Height;
  end
  else begin
    IWidthA := TCustomImageListAccess(FImageList).Width;
    IHeightA := TCustomImageListAccess(FImageList).Height;
  end;
  IRectA := Rect(0, 0, IWidthA, IHeightA);
  AddPixels := Ord(State = bsDisabled);
  IWidth := IWidthA + AddPixels;
  IHeight := IHeightA + AddPixels;
  IRect := Rect(0, 0, IWidth, IHeight);
  if FGlyphList[B] = nil then begin
    if GlyphCache = nil then
      GlyphCache := TGlyphCache.Create;
    FGlyphList[B] := GlyphCache.GetList(IWidth, IHeight);
  end;
  {$IFDEF TB97D3}
  IsHighColorDIB := (FImageList = nil) and (FOriginal.PixelFormat > pf4bit);
  {$ENDIF}
  OriginalBmp := nil;
  OriginalMaskBmp := nil;
  TmpImage := nil;
  MaskBmp := nil;
  try
    OriginalBmp := TBitmap.Create;
    OriginalBmp.Assign (FOriginal);
    OriginalMaskBmp := TBitmap.Create;
    OriginalMaskBmp.Assign (FOriginalMask);
    TmpImage := TBitmap.Create;
    TmpImage.Width := IWidth;
    TmpImage.Height := IHeight;
    TmpImage.Canvas.Brush.Color := clBtnFace;
    if FImageList = nil then
      TmpImage.Palette := CopyPalette(OriginalBmp.Palette);
    I := State;
    if Ord(I) >= NumGlyphs then I := bsUp;
    SourceRect := Bounds(Ord(I) * IWidthA, 0, IWidthA, IHeightA);
    if FImageList <> nil then begin
      MaskBmp := TBitmap.Create;
      MaskBmp.Monochrome := True;
      MaskBmp.Width := IWidthA;
      MaskBmp.Height := IHeightA;
      ImageList_Draw (FImageList.Handle, FImageIndex, MaskBmp.Canvas.Handle,
        0, 0, ILD_MASK);
    end;

    if State <> bsDisabled then begin
      if FImageList = nil then begin
        TmpImage.Canvas.CopyRect (IRectA, OriginalBmp.Canvas, SourceRect);
        if not UsesMask then begin
          {$IFDEF TB97D3}
          { Use clDefault instead of FTransparentColor whereever possible to
            ensure compatibility with all video drivers when using high-color
            (> 4 bpp) DIB glyphs }
          FIndexs[B, State] := FGlyphList[B].AddMasked(TmpImage, clDefault);
          {$ELSE}
          FIndexs[B, State] := FGlyphList[B].AddMasked(TmpImage, FTransparentColor);
          {$ENDIF}
        end
        else begin
          MonoBmp := TBitmap.Create;
          try
            MonoBmp.Monochrome := True;
            MonoBmp.Width := IWidth;
            MonoBmp.Height := IHeight;
            MonoBmp.Canvas.CopyRect (IRectA, OriginalMaskBmp.Canvas, SourceRect);
            FIndexs[B, State] := FGlyphList[B].Add(TmpImage, MonoBmp);
          finally
            MonoBmp.Free;
          end;
        end;
      end
      else begin
        ImageList_Draw (FImageList.Handle, FImageIndex, TmpImage.Canvas.Handle,
          0, 0, ILD_NORMAL);
        FIndexs[B, State] := FGlyphList[B].Add(TmpImage, MaskBmp);
      end;
    end
    else begin
      MonoBmp := nil;
      DDB := nil;
      try
        MonoBmp := TBitmap.Create;
        { Uses the CopyBitmapToDDB to work around a Delphi 3 flaw. If you copy
          a DIB to a second bitmap via Assign, change the HandleType of the
          second bitmap to bmDDB, then try to read the Handle property, Delphi
          converts it back to a DIB. }
        if FImageList = nil then
          DDB := CopyBitmapToDDB(OriginalBmp)
        else begin
          DDB := TBitmap.Create;
          DDB.Width := IWidthA;
          DDB.Height := IHeightA;
          ImageList_Draw (FImageList.Handle, FImageIndex, DDB.Canvas.Handle,
            0, 0, ILD_NORMAL);
        end;
        if NumGlyphs > 1 then
          with TmpImage.Canvas do begin
            CopyRect (IRectA, DDB.Canvas, SourceRect);

            { Convert white to clBtnHighlight }
            if not IsHighColorDIB then
              GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft,
                IRectA.BottomRight, [GetNearestColor(OriginalBmp.Canvas.Handle, clWhite)])
            else
              GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp, SourceRect.TopLeft,
                IRectA.BottomRight, [clWhite]);
            ReplaceBitmapColorsFromMask (MonoBmp, TmpImage, IRectA.TopLeft,
              IRectA.BottomRight, clBtnHighlight);

            { Convert gray to clBtnShadow }
            if not IsHighColorDIB then
              GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft,
                IRectA.BottomRight, [GetNearestColor(OriginalBmp.Canvas.Handle, clGray)])
            else
              GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp, SourceRect.TopLeft,
                IRectA.BottomRight, [clGray]);
            ReplaceBitmapColorsFromMask (MonoBmp, TmpImage, IRectA.TopLeft,
              IRectA.BottomRight, clBtnShadow);

            if not UsesMask then begin
              { Generate the transparent mask in MonoBmp. The reason why
                it doesn't just use a mask color is because the mask needs
                to be of the glyph -before- the clBtnHighlight/Shadow were
                translated }
              if not IsHighColorDIB then
                GenerateMaskBitmap (MonoBmp, DDB,
                  SourceRect.TopLeft, IRectA.BottomRight, FTransparentColor)
              else
                GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp,
                  SourceRect.TopLeft, IRectA.BottomRight, [-1]);
            end
            else
              MonoBmp.Canvas.CopyRect (IRectA, OriginalMaskBmp.Canvas, SourceRect);
            with MonoBmp do begin
              Width := Width + AddPixels;
              Height := Height + AddPixels;
              { Set the additional bottom and right row on disabled glyph
                masks to white so that it always shines through, since the
                bottom and right row on TmpImage was left uninitialized }
              Canvas.Pen.Color := clWhite;
              Canvas.PolyLine ([Point(0, Height-1), Point(Width-1, Height-1),
                Point(Width-1, -1)]);
            end;

            FIndexs[B, State] := FGlyphList[B].Add(TmpImage, MonoBmp);
          end
        else begin
          { Create a disabled version }
          if FOldDisabledStyle then begin
            { "Old" TSpeedButton style }
            if FImageList = nil then begin
              if not UsesMask then begin
                if IsHighColorDIB then
                  GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp,
                    SourceRect.TopLeft, IRectA.BottomRight, [clBlack])
                else begin
                  with MonoBmp do begin
                    Assign (DDB);  { must be a DDB for this to work right }
                    Canvas.Brush.Color := clBlack;
                    Monochrome := True;
                  end;
                end;
              end
              else begin
                MonoBmp.Assign (DDB);  { must be a DDB for this to work right }
                with TBitmap.Create do
                  try
                    Monochrome := True;
                    Width := OriginalMaskBmp.Width;
                    Height := OriginalMaskBmp.Height;
                    R := Rect(0, 0, Width, Height);
                    Canvas.CopyRect (R, OriginalMaskBmp.Canvas, R);
                    DC := Canvas.Handle;
                    with MonoBmp.Canvas do begin
                      BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
                        SourceRect.Left, SourceRect.Top, ROP_DSna);
                      BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
                        SourceRect.Left, SourceRect.Top, SRCPAINT);
                    end;
                  finally
                    Free;
                  end;
                MonoBmp.Canvas.Brush.Color := clBlack;
                MonoBmp.Monochrome := True;
              end
            end
            else begin
              with MonoBmp do begin
                Width := IWidthA;
                Height := IHeightA;
                Canvas.Brush.Color := clWhite;
                Canvas.FillRect (IRectA);
                ImageList_Draw (FImageList.Handle, FImageIndex, Canvas.Handle,
                  0, 0, ILD_TRANSPARENT);
                Canvas.Brush.Color := clBlack;
                Monochrome := True;
              end;
            end;
          end
          else begin
            { The new Office 97 / MFC look }
            if not UsesMask and (FImageList = nil) then begin
              with TmpImage.Canvas do begin
                if not IsHighColorDIB then
                  GenerateMaskBitmap (MonoBmp, DDB, IRectA.TopLeft,
                    IRectA.BottomRight, [FTransparentColor, clWhite, clSilver])
                else
                  GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp,
                    SourceRect.TopLeft, IRectA.BottomRight, [-1, clWhite, clSilver]);
              end;
            end
            else begin
              { Generate the mask in MonoBmp. Make clWhite and clSilver transparent. }
              if not IsHighColorDIB then
                GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft,
                  IRectA.BottomRight, [clWhite, clSilver])
              else
                GenerateMaskBitmapFromDIB (MonoBmp, OriginalBmp, SourceRect.TopLeft,
                  IRectA.BottomRight, [clWhite, clSilver]);
              if FImageList = nil then
                UseMaskBmp := OriginalMaskBmp
              else
                UseMaskBmp := MaskBmp;
              { and all the white colors in UseMaskBmp }
              with TBitmap.Create do
                try
                  Monochrome := True;
                  Width := UseMaskBmp.Width;
                  Height := UseMaskBmp.Height;
                  R := Rect(0, 0, Width, Height);
                  Canvas.CopyRect (R, UseMaskBmp.Canvas, R);
                  DC := Canvas.Handle;
                  with MonoBmp.Canvas do begin
                    BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
                      SourceRect.Left, SourceRect.Top, ROP_DSna);
                    BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
                      SourceRect.Left, SourceRect.Top, SRCPAINT);
                  end;
                finally
                  Free;
                end;
            end;
          end;

          with TmpImage.Canvas do begin
            Brush.Color := clBtnFace;
            FillRect (IRect);
            Brush.Color := clBtnHighlight;
            DC := Handle;
            SetTextColor (DC, clBlack);
            SetBkColor (DC, clWhite);
            BitBlt (DC, 1, 1, IWidthA, IHeightA,
              MonoBmp.Canvas.Handle, 0, 0, ROPs[FOldDisabledStyle]);
            Brush.Color := clBtnShadow;
            DC := Handle;
            SetTextColor (DC, clBlack);
            SetBkColor (DC, clWhite);
            BitBlt (DC, 0, 0, IWidthA, IHeightA,
              MonoBmp.Canvas.Handle, 0, 0, ROPs[FOldDisabledStyle]);
          end;

          FIndexs[B, State] := FGlyphList[B].AddMasked(TmpImage, clBtnFace);
        end;
      finally
        DDB.Free;
        MonoBmp.Free;
      end;
    end;
  finally
    MaskBmp.Free;
    TmpImage.Free;
    OriginalMaskBmp.Free;
    OriginalBmp.Free;
  end;
  Result.B := B;
  Result.I := FIndexs[B, State];
  { Note: Due to a bug in graphics.pas, Delphi 2's VCL crashes if Dormant is
    called on an empty bitmap, so to prevent this it must check Width/Height
    first }
  if {$IFNDEF TB97D3} (FOriginal.Width <> 0) and (FOriginal.Height <> 0) and {$ENDIF}
     FCallDormant then
    FOriginal.Dormant;
  {$IFNDEF TB97D3} if (FOriginalMask.Width <> 0) and (FOriginalMask.Height <> 0) then {$ENDIF}
    FOriginalMask.Dormant;
end;

procedure TButtonGlyph.DrawButtonGlyph (Canvas: TCanvas; const GlyphPos: TPoint;
  State: TButtonState97);
var
  Index: TBoolInt;
begin
  Index := CreateButtonGlyph(State);
  if Index.I <> -1 then
    ImageList_DrawEx (FGlyphList[Index.B].Handle, Index.I, Canvas.Handle,
      GlyphPos.X, GlyphPos.Y, 0, 0, CLR_NONE, CLR_NONE, ILD_TRANSPARENT);
end;

procedure TButtonGlyph.DrawButtonText (Canvas: TCanvas; const Caption: string;
  TextBounds: TRect; WordWrap: Boolean; Alignment: TAlignment;
  State: TButtonState97);
const
  AlignmentFlags: array[TAlignment] of UINT = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  Format: UINT;
begin
  Format := DT_VCENTER or AlignmentFlags[Alignment];
  if not WordWrap then
    Format := Format or DT_SINGLELINE
  else
    Format := Format or DT_WORDBREAK;
  with Canvas do begin
    Brush.Style := bsClear;
    if State = bsDisabled then begin
      OffsetRect (TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText (Handle, PChar(Caption), Length(Caption), TextBounds, Format);
      OffsetRect (TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText (Handle, PChar(Caption), Length(Caption), TextBounds, Format);
    end
    else
      DrawText (Handle, PChar(Caption), Length(Caption), TextBounds, Format);
  end;
end;

procedure TButtonGlyph.DrawButtonDropArrow (Canvas: TCanvas;
  const X, Y, AWidth: Integer; State: TButtonState97);
var
  X2: Integer;
begin
  with Canvas do begin
    X2 := X + AWidth div 2;
    if State = bsDisabled then begin
      Pen.Color := clBtnHighlight;
      Brush.Color := clBtnHighlight;
      Polygon ([Point(X2-1, Y+1), Point(X2+3, Y+1), Point(X2+1, Y+3)]);
      Pen.Color := clBtnShadow;
      Brush.Color := clBtnShadow;
      Polygon ([Point(X2-2, Y), Point(X2+2, Y), Point(X2, Y+2)]);
    end
    else begin
      Pen.Color := Font.Color;
      Brush.Color := Font.Color;
      Polygon ([Point(X2-2, Y), Point(X2+2, Y), Point(X2, Y+2)]);
    end;
  end;
end;

procedure TButtonGlyph.CalcButtonLayout (Canvas: TCanvas; const Client: TRect;
  const Offset: TPoint; DrawGlyph, DrawCaption: Boolean; const Caption: string;
  WordWrap: Boolean; Layout: TButtonLayout; Margin, Spacing: Integer;
  DropArrow: Boolean; DropArrowWidth: Integer; var GlyphPos, ArrowPos: TPoint;
  var TextBounds: TRect);
var
  TextPos: TPoint;
  ClientSize, GlyphSize, TextSize, ArrowSize: TPoint;
  HasGlyph: Boolean;
  TotalSize: TPoint;
  Format: UINT;
  Margin1, Spacing1: Integer;
  LayoutLeftOrRight: Boolean;
begin
  { calculate the item sizes }
  ClientSize := Point(Client.Right-Client.Left, Client.Bottom-Client.Top);

  GlyphSize.X := 0;
  GlyphSize.Y := 0;
  if DrawGlyph then begin
    if FImageList = nil then begin
      if FOriginal <> nil then begin
        GlyphSize.X := FOriginal.Width div FNumGlyphs;
        GlyphSize.Y := FOriginal.Height;
      end;
    end
    else begin
      GlyphSize.X := TCustomImageListAccess(FImageList).Width;
      GlyphSize.Y := TCustomImageListAccess(FImageList).Height;
    end;
  end;
  HasGlyph := (GlyphSize.X <> 0) and (GlyphSize.Y <> 0);

  if DropArrow then begin
    ArrowSize.X := DropArrowWidth;
    ArrowSize.Y := 3;
  end
  else begin
    ArrowSize.X := 0;
    ArrowSize.Y := 0;
  end;

  LayoutLeftOrRight := Layout in [blGlyphLeft, blGlyphRight];
  if not LayoutLeftOrRight and not HasGlyph then begin
    Layout := blGlyphLeft;
    LayoutLeftOrRight := True;
  end;

  if DrawCaption and (Caption <> '') then begin
    TextBounds := Rect(0, 0, Client.Right-Client.Left, 0);
    if LayoutLeftOrRight then
      Dec (TextBounds.Right, ArrowSize.X);
    Format := DT_CALCRECT;
    if WordWrap then begin
      Format := Format or DT_WORDBREAK;
      Margin1 := 4;
      if LayoutLeftOrRight and HasGlyph then begin
        if Spacing = -1 then
          Spacing1 := 4
        else
          Spacing1 := Spacing;
        Dec (TextBounds.Right, GlyphSize.X + Spacing1);
        if Margin <> -1 then
          Margin1 := Margin
        else
        if Spacing <> -1 then
          Margin1 := Spacing;
      end;
      Dec (TextBounds.Right, Margin1 * 2);
    end;
    DrawText (Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, Format);
    TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
      TextBounds.Top);
  end
  else begin
    TextBounds := Rect(0, 0, 0, 0);
    TextSize := Point(0,0);
  end;

  { If the layout has the glyph on the right or the left, then both the
    text and the glyph are centered vertically.  If the glyph is on the top
    or the bottom, then both the text and the glyph are centered horizontally.}
  if LayoutLeftOrRight then begin
    GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
    TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  end
  else begin
    GlyphPos.X := (ClientSize.X - GlyphSize.X - ArrowSize.X + 1) div 2;
    TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
    if not HasGlyph then
      ArrowPos.X := TextPos.X + TextSize.X
    else
      ArrowPos.X := GlyphPos.X + GlyphSize.X;
  end;

  { if there is no text or no bitmap, then Spacing is irrelevant }
  if (TextSize.X = 0) or (TextSize.Y = 0) or not HasGlyph then
    Spacing := 0;

  { adjust Margin and Spacing }
  if Margin = -1 then begin
    if Spacing = -1 then begin
      TotalSize := Point(GlyphSize.X + TextSize.X + ArrowSize.X,
        GlyphSize.Y + TextSize.Y);
      if LayoutLeftOrRight then
        Margin := (ClientSize.X - TotalSize.X) div 3
      else
        Margin := (ClientSize.Y - TotalSize.Y) div 3;
      Spacing := Margin;
    end
    else begin
      TotalSize := Point(GlyphSize.X + Spacing + TextSize.X + ArrowSize.X,
        GlyphSize.Y + Spacing + TextSize.Y);
      if LayoutLeftOrRight then
        Margin := (ClientSize.X - TotalSize.X + 1) div 2
      else
        Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
    end;
  end
  else begin
    if Spacing = -1 then begin
      TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X + ArrowSize.X),
        ClientSize.Y - (Margin + GlyphSize.Y));
      if LayoutLeftOrRight then
        Spacing := (TotalSize.X - TextSize.X) div 2
      else
        Spacing := (TotalSize.Y - TextSize.Y) div 2;
    end;
  end;

  case Layout of
    blGlyphLeft: begin
        GlyphPos.X := Margin;
        TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
        ArrowPos.X := TextPos.X + TextSize.X;
      end;
    blGlyphRight: begin
        ArrowPos.X := ClientSize.X - Margin - ArrowSize.X;
        GlyphPos.X := ArrowPos.X - GlyphSize.X;
        TextPos.X := GlyphPos.X - Spacing - TextSize.X;
      end;
    blGlyphTop: begin
        GlyphPos.Y := Margin;
        TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
      end;
    blGlyphBottom: begin
        GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
        TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
      end;
  end;
  Inc (ArrowPos.X);
  if not HasGlyph then
    ArrowPos.Y := TextPos.Y + (TextSize.Y - ArrowSize.Y) div 2
  else
    ArrowPos.Y := GlyphPos.Y + (GlyphSize.Y - ArrowSize.Y) div 2;

  { fixup the result variables }
  with GlyphPos do begin
    Inc (X, Client.Left + Offset.X);
    Inc (Y, Client.Top + Offset.Y);
  end;
  with ArrowPos do begin
    Inc (X, Client.Left + Offset.X);
    Inc (Y, Client.Top + Offset.Y);
  end;
  OffsetRect (TextBounds, TextPos.X + Client.Left + Offset.X,
    TextPos.Y + Client.Top + Offset.X);
end;

function TButtonGlyph.Draw (Canvas: TCanvas; const Client: TRect;
  const Offset: TPoint; DrawGlyph, DrawCaption: Boolean; const Caption: string;
  WordWrap: Boolean; Alignment: TAlignment; Layout: TButtonLayout;
  Margin, Spacing: Integer; DropArrow: Boolean; DropArrowWidth: Integer;
  State: TButtonState97): TRect;
var
  GlyphPos, ArrowPos: TPoint;
begin
  CalcButtonLayout (Canvas, Client, Offset, DrawGlyph, DrawCaption, Caption,
    WordWrap, Layout, Margin, Spacing, DropArrow, DropArrowWidth, GlyphPos,
    ArrowPos, Result);
  if DrawGlyph then
    DrawButtonGlyph (Canvas, GlyphPos, State);
  if DrawCaption then
    DrawButtonText (Canvas, Caption, Result, WordWrap, Alignment, State);
  if DropArrow then
    DrawButtonDropArrow (Canvas, ArrowPos.X, ArrowPos.Y, DropArrowWidth, State);
end;


{ TDropdownList }

{$IFNDEF TB97D4}

type
  TDropdownList = class(TComponent)
  private
    List: TList;
    Window: HWND;
    procedure WndProc (var Message: TMessage);
  protected
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddMenu (Menu: TPopupMenu);
  end;
var
  DropdownList: TDropdownList;

constructor TDropdownList.Create (AOwner: TComponent);
begin
  inherited;
  List := TList.Create;
end;

destructor TDropdownList.Destroy;
begin
  List.Free;
  inherited;
end;

procedure TDropdownList.WndProc (var Message: TMessage);
{ This procedure is based on code from TPopupList.WndProc (menus.pas) }
var
  I: Integer;
  MenuItem: TMenuItem;
  FindKind: TFindItemKind;
  ContextID: Integer;
begin
  try
    with List do
      case Message.Msg of
        WM_COMMAND:
          for I := 0 to Count-1 do
            if TPopupMenu(Items[I]).DispatchCommand(TWMCommand(Message).ItemID) then
              Exit;
        WM_INITMENUPOPUP:
          for I := 0 to Count-1 do
            if TPopupMenu(Items[I]).DispatchPopup(TWMInitMenuPopup(Message).MenuPopup) then
              Exit;
        WM_MENUSELECT:
          with TWMMenuSelect(Message) do begin
            FindKind := fkCommand;
            if MenuFlag and MF_POPUP <> 0 then
              FindKind := fkHandle;
            for I := 0 to Count-1 do begin
              MenuItem := TPopupMenu(Items[I]).FindItem(IDItem, FindKind);
              if MenuItem <> nil then begin
                Application.Hint := MenuItem.Hint;
                Exit;
              end;
            end;
            Application.Hint := '';
          end;
        WM_HELP:
          with TWMHelp(Message).HelpInfo^ do begin
            for I := 0 to Count-1 do
              if TPopupMenu(Items[I]).Handle = hItemHandle then begin
                ContextID := TPopupMenu(Items[I]).GetHelpContext(iCtrlID, True);
                if ContextID = 0 then
                  ContextID := TPopupMenu(Items[I]).GetHelpContext(hItemHandle, False);
                if Screen.ActiveForm = nil then Exit;
                if (biHelp in Screen.ActiveForm.BorderIcons) then
                  Application.HelpCommand (HELP_CONTEXTPOPUP, ContextID)
                else
                  Application.HelpContext (ContextID);
                Exit;
              end;
          end;
      end;
    with Message do
      Result := DefWindowProc(Window, Msg, wParam, lParam);
  except
    Application.HandleException (Self);
  end;
end;

procedure TDropdownList.AddMenu (Menu: TPopupMenu);
begin
  if List.IndexOf(Menu) = -1 then begin
    if List.Count = 0 then
      Window := AllocateHWnd(WndProc);
    Menu.FreeNotification (Self);
    List.Add (Menu);
  end;
end;

procedure TDropdownList.Notification (AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    List.Remove (AComponent);
    if List.Count = 0 then
      DeallocateHWnd (Window);
  end;
end;

{$ENDIF}


{ TToolbarButton97 }

procedure ButtonHookProc (Code: THookProcCode; Wnd: HWND; WParam: WPARAM; LParam: LPARAM);
var
  P: TPoint;
begin
  case Code of
    hpSendActivateApp:
      if (WParam = 0) and Assigned(ButtonMouseInControl) and
         not ButtonMouseInControl.FShowBorderWhenInactive then
        ButtonMouseInControl.MouseLeft;
    hpPostMouseMove: begin
        if Assigned(ButtonMouseInControl) then begin
          GetCursorPos (P);
          if FindDragTarget(P, True) <> ButtonMouseInControl then
            ButtonMouseInControl.MouseLeft;
        end;
      end;
  end;
end;

constructor TToolbarButton97.Create (AOwner: TComponent);
begin
  inherited;

  if ButtonMouseTimer = nil then begin
    ButtonMouseTimer := TTimer.Create(nil);
    ButtonMouseTimer.Enabled := False;
    ButtonMouseTimer.Interval := 125;  { 8 times a second }
  end;

  InstallHookProc (ButtonHookProc, [hpSendActivateApp, hpPostMouseMove],
    csDesigning in ComponentState);

  SetBounds (Left, Top, 23, 22);
  ControlStyle := [csCaptureMouse, csDoubleClicks, csOpaque];
  Color := clBtnFace;
  FGlyph := TButtonGlyph.Create;
  TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  ParentFont := True;
  FAlignment := taCenter;
  FFlat := True;
  FHighlightWhenDown := True;
  FOpaque := True;
  FSpacing := 4;
  FMargin := -1;
  FLayout := blGlyphLeft;
  FDropdownArrow := True;
  FDropdownArrowWidth := DefaultDropdownArrowWidth;
  FRepeatDelay := 400;
  FRepeatInterval := 100;
  Inc (ButtonCount);
end;

destructor TToolbarButton97.Destroy;
begin
  RemoveButtonMouseTimer;
  TButtonGlyph(FGlyph).Free;
  { The Notification method, which is sometimes called while the component is
    being destroyed, reads FGlyph and expects it to be valid, so it must be
    reset to nil }
  FGlyph := nil;
  UninstallHookProc (ButtonHookProc);
  Dec (ButtonCount);
  if ButtonCount = 0 then begin
    Pattern.Free;
    Pattern := nil;
    ButtonMouseTimer.Free;
    ButtonMouseTimer := nil;
  end;
  inherited;
end;

procedure TToolbarButton97.Paint;
const
  EdgeStyles: array[Boolean, Boolean] of UINT = (
    (EDGE_RAISED, EDGE_SUNKEN),
    (BDR_RAISEDINNER, BDR_SUNKENOUTER));
  FlagStyles: array[Boolean] of UINT = (BF_RECT or BF_SOFT or BF_MIDDLE, BF_RECT);
var
  UseBmp: Boolean;
  Bmp: TBitmap;
  DrawCanvas: TCanvas;
  PaintRect, R: TRect;
  Offset: TPoint;
  StateDownOrExclusive, DropdownComboShown, UseDownAppearance, DrawBorder: Boolean;
begin
  UseBmp := FOpaque or not FFlat;
  if UseBmp then
    Bmp := TBitmap.Create
  else
    Bmp := nil;
  try
    if UseBmp then begin
      Bmp.Width := Width;
      Bmp.Height := Height;
      DrawCanvas := Bmp.Canvas;
      with DrawCanvas do begin
        Brush.Color := Color;
        FillRect (ClientRect);
      end;
    end
    else
      DrawCanvas := Canvas;
    DrawCanvas.Font := Self.Font;
    PaintRect := Rect(0, 0, Width, Height);

    StateDownOrExclusive := FState in [bsDown, bsExclusive];
    DropdownComboShown := FDropdownCombo and FUsesDropdown;
    UseDownAppearance := StateDownOrExclusive and
      (not DropdownComboShown or not FMenuIsDown);
    DrawBorder := (csDesigning in ComponentState) or
      (not FNoBorder and (not FFlat or StateDownOrExclusive or (FMouseInControl and (FState <> bsDisabled))));

    if DropdownComboShown then begin
      if DrawBorder then begin
        R := PaintRect;
        Dec (R.Right, DropdownComboSpace);
        R.Left := R.Right - DropdownArrowWidth;
        DrawEdge (DrawCanvas.Handle, R,
          EdgeStyles[FFlat, StateDownOrExclusive and FMenuIsDown],
          FlagStyles[FFlat]);
      end;
      Dec (PaintRect.Right, DropdownArrowWidth + DropdownComboSpace);
    end;
    if DrawBorder then
      DrawEdge (DrawCanvas.Handle, PaintRect, EdgeStyles[FFlat, UseDownAppearance],
        FlagStyles[FFlat]);
    if not FNoBorder then begin
      if FFlat then
        InflateRect (PaintRect, -1, -1)
      else
        InflateRect (PaintRect, -2, -2);
    end;

    if UseDownAppearance then begin
      if (FState = bsExclusive) and (not FFlat or not FMouseInControl) and
         FHighlightWhenDown then begin
        if Pattern = nil then CreateBrushPattern;
        DrawCanvas.Brush.Bitmap := Pattern;
        DrawCanvas.FillRect(PaintRect);
      end;
      Offset.X := 1;
      Offset.Y := 1;
    end
    else begin
      Offset.X := 0;
      Offset.Y := 0;
    end;

    TButtonGlyph(FGlyph).Draw (DrawCanvas, PaintRect, Offset,
      FDisplayMode <> dmTextOnly, FDisplayMode <> dmGlyphOnly,
      Caption, FWordWrap, FAlignment, FLayout, FMargin, FSpacing,
      FDropdownArrow and not FDropdownCombo and FUsesDropdown,
      DropdownArrowWidth, FState);
    if DropdownComboShown then
      TButtonGlyph(FGlyph).DrawButtonDropArrow (DrawCanvas, Width-DropdownArrowWidth-2,
        Height div 2 - 1, DropdownArrowWidth, FState);

    if UseBmp then
      Canvas.Draw (0, 0, Bmp);
  finally
    Bmp.Free;
  end;
end;

procedure TToolbarButton97.RemoveButtonMouseTimer;
begin
  if ButtonMouseInControl = Self then begin
    ButtonMouseTimer.Enabled := False;
    ButtonMouseInControl := nil;
  end;
end;

(* no longer used
procedure TToolbarButton97.UpdateTracking;
var
  P: TPoint;
begin
  if Enabled then begin
    GetCursorPos (P);
    { Use FindDragTarget instead of PtInRect since we want to check based on
      the Z order }
    FMouseInControl := not (FindDragTarget(P, True) = Self);
    if FMouseInControl then
      MouseLeft
    else
      MouseEntered;
  end;
end;
*)

procedure TToolbarButton97.Loaded;
var
  State: TButtonState97;
begin
  inherited;
  if Enabled then
    State := bsUp
  else
    State := bsDisabled;
  TButtonGlyph(FGlyph).CreateButtonGlyph (State);
end;

procedure TToolbarButton97.Notification (AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    if AComponent = DropdownMenu then DropdownMenu := nil;
    if Assigned(FGlyph) and (AComponent = Images) then Images := nil;
  end;
end;

function TToolbarButton97.PointInButton (X, Y: Integer): Boolean;
begin
  Result := (X >= 0) and
    (X < ClientWidth-((DropdownArrowWidth+DropdownComboSpace) * Ord(FDropdownCombo and FUsesDropdown))) and
    (Y >= 0) and (Y < ClientHeight);
end;

procedure TToolbarButton97.MouseDown (Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if not Enabled then begin
    inherited;
    Exit;
  end;
  if Button <> mbLeft then begin
    MouseEntered;
    inherited;
  end
  else begin
    { We know mouse has to be over the control if the mouse went down. }
    MouseEntered;
    FMenuIsDown := FUsesDropdown and (not FDropdownCombo or
      (X >= Width-(DropdownArrowWidth+DropdownComboSpace)));
    try
      if not FDown then begin
        FState := bsDown;
        Redraw (True);
      end
      else
        if FAllowAllUp then
          Redraw (True);
      if not FMenuIsDown then
        FMouseIsDown := True;
      inherited;
      if FMenuIsDown then
        Click
      else
        if FRepeating then begin
          Click;
          if not Assigned(FRepeatTimer) then
            FRepeatTimer := TTimer.Create(Self);
          FRepeatTimer.Enabled := False;
          FRepeatTimer.Interval := FRepeatDelay;
          FRepeatTimer.OnTimer := RepeatTimerHandler;
          FRepeatTimer.Enabled := True;
        end;
    finally
      FMenuIsDown := False;
    end;
  end;
end;

procedure TToolbarButton97.MouseMove (Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
  NewState: TButtonState97;
  PtInButton: Boolean;
begin
  inherited;

  { Check if mouse just entered the control. It works better to check this
    in MouseMove rather than using CM_MOUSEENTER, since the VCL doesn't send
    a CM_MOUSEENTER in all cases
    Use FindDragTarget instead of PtInRect since we want to check based on
    the Z order }
  P := ClientToScreen(Point(X, Y));
  if (ButtonMouseInControl <> Self) and (FindDragTarget(P, True) = Self) then begin
    if Assigned(ButtonMouseInControl) then
      ButtonMouseInControl.MouseLeft;
    { Like Office 97, only draw the active borders when the application is active }
    if FShowBorderWhenInactive or ApplicationIsActive then begin
      ButtonMouseInControl := Self;
      ButtonMouseTimer.OnTimer := ButtonMouseTimerHandler;
      ButtonMouseTimer.Enabled := True;
      MouseEntered;
    end;
  end;

  if FMouseIsDown then begin
    PtInButton := PointInButton(X, Y);
    if PtInButton and Assigned(FRepeatTimer) then
      FRepeatTimer.Enabled := True;
    if FDown then
      NewState := bsExclusive
    else begin
      if PtInButton then
        NewState := bsDown
      else
        NewState := bsUp;
    end;
    if NewState <> FState then begin
      FState := NewState;
      Redraw (True);
    end;
  end;
end;

procedure TToolbarButton97.RepeatTimerHandler (Sender: TObject);
var
  P: TPoint;
begin
  FRepeatTimer.Interval := FRepeatInterval;
  GetCursorPos (P);
  P := ScreenToClient(P);
  if Repeating and FMouseIsDown and MouseCapture and PointInButton(P.X, P.Y) then
    Click
  else
    FRepeatTimer.Enabled := False;
end;

procedure TToolbarButton97.WMCancelMode (var Message: TWMCancelMode);
begin
  FRepeatTimer.Free;
  FRepeatTimer := nil;
  if FMouseIsDown then begin
    FMouseIsDown := False;
    MouseLeft;
  end;
  { Delphi's default processing of WM_CANCELMODE sends a "fake" WM_LBUTTONUP
    message to the control, so inherited must only be called after setting
    FMouseIsDown to False }
  inherited;
end;

procedure TToolbarButton97.MouseUp (Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  FRepeatTimer.Free;
  FRepeatTimer := nil;
  { Remove active border when right button is clicked }
  if (Button = mbRight) and Enabled then begin
    FMouseIsDown := False;
    MouseLeft;
  end;
  inherited;
  if (Button = mbLeft) and FMouseIsDown then begin
    FMouseIsDown := False;
    if PointInButton(X, Y) and not FRepeating then
      Click
    else
      MouseLeft;
  end;
end;

procedure TToolbarButton97.Click;
{$IFNDEF TB97D4}
const
  { TPM_RIGHTBUTTON works better on Windows 3.x }
  ButtonFlags: array[Boolean] of UINT = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
  AlignFlags: array[TPopupAlignment] of UINT = (TPM_LEFTALIGN, TPM_RIGHTALIGN,
    TPM_CENTERALIGN);
{$ENDIF}
var
  ShowMenu, RemoveClicks: Boolean;
  SaveAlignment: TPopupAlignment;
  {$IFDEF TB97D4}
  SaveTrackButton: TTrackButton;
  {$ENDIF}
  PopupPoint: TPoint;
  RepostList: TList; {pointers to TMsg's}
  Msg: TMsg;
  Repost: Boolean;
  I: Integer;
  P: TPoint;
  Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  DockPos: TGetToolbarDockPosType;
begin
  if FRepeating and not FMenuIsDown then begin
    inherited;
    Exit;
  end;
  FInClick := True;
  try
    if (GroupIndex <> 0) and not FMenuIsDown then
      SetDown (not FDown);

    if ButtonsStayDown then begin
      if FState in [bsUp, bsMouseIn] then begin
        FState := bsDown;
        Redraw (True);
      end;
    end
    else begin
      if FState = bsDown then begin
        if FDown and (FGroupIndex <> 0) then
          FState := bsExclusive
        else
          FState := bsUp;
        Redraw (True);
      end;
    end;

    { Stop tracking }
    MouseLeft;
    if (not FUsesDropdown) or (FDropdownCombo and not FMenuIsDown) then begin
      Form := GetParentForm(Self);
      if Form <> nil then Form.ModalResult := ModalResult;
      inherited;
    end
    else begin
      if not FDropdownCombo then
        inherited;
      { It must release its capture before displaying the popup menu since
        this control uses csCaptureMouse. If it doesn't, the VCL seems to
        get confused and think the mouse is still captured even after the
        popup menu is displayed, causing mouse problems after the menu is
        dismissed. }
      MouseCapture := False;
      ShowMenu := Assigned(FDropdownMenu);
      RemoveClicks := True;
      if Assigned(FOnDropdown) then
        FOnDropdown (Self, ShowMenu, RemoveClicks);
      try
        if Assigned(FDropdownMenu) and ShowMenu then begin
          SaveAlignment := DropdownMenu.Alignment;
          {$IFDEF TB97D4}
          SaveTrackButton := DropdownMenu.TrackButton;
          {$ENDIF}
          try
            DropdownMenu.Alignment := paLeft;
            PopupPoint := Point(0, Height);
            if Assigned(GetToolbarDockPosProc) then begin
              DockPos := GetToolbarDockPosProc(Parent);
              { Drop out right or left side }
              case DockPos of
                gtpLeft: PopupPoint := Point(Width, 0);
                gtpRight: begin
                    PopupPoint := Point(0, 0);
                    DropdownMenu.Alignment := paRight;
                  end;
              end;
            end;
            PopupPoint := ClientToScreen(PopupPoint);
            with DropdownMenu do begin
              PopupComponent := Self;
              { In Delphi versions prior to 4 it avoids using the Popup method
                of TPopupMenu because it always uses the "track right button"
                flag (which disallowed the "click and drag" selecting motion many
                people are accustomed to). Delphi 4 has a TrackButton property
                to control the tracking button, so it can use the Popup method. }
              {$IFNDEF TB97D4}
              if (ClassType = TPopupMenu) and Assigned(DropdownList) then begin
                if Assigned(OnPopup) then
                  OnPopup (DropdownMenu);
                TrackPopupMenu (Handle, AlignFlags[Alignment] or ButtonFlags[NewStyleControls],
                  PopupPoint.X, PopupPoint.Y, 0, DropdownList.Window, nil)
              end
              else begin
              {$ELSE}
                if NewStyleControls then
                  TrackButton := tbLeftButton
                else
                  TrackButton := tbRightButton;
              {$ENDIF}
                Popup (PopupPoint.X, PopupPoint.Y);
              {$IFNDEF TB97D4}
              end;
              {$ENDIF}
            end;
          finally
            DropdownMenu.Alignment := SaveAlignment;
            {$IFDEF TB97D4}
            DropdownMenu.TrackButton := SaveTrackButton;
            {$ENDIF}
          end;
        end;
      finally
        if RemoveClicks then begin
          { To prevent a mouse click from redisplaying the menu, filter all
            mouse up/down messages, and repost the ones that don't need
            removing. This is sort of bulky, but it's the only way I could
            find that works perfectly and like Office 97. }
          RepostList := TList.Create;
          try
            while PeekMessage(Msg, 0, WM_LBUTTONDOWN, WM_MBUTTONDBLCLK,
               PM_REMOVE or PM_NOYIELD) do
               { ^ The WM_LBUTTONDOWN to WM_MBUTTONDBLCLK range encompasses all
                 of the DOWN and DBLCLK messages for the three buttons }
              with Msg do begin
                Repost := True;
                case Message of
                  WM_QUIT: begin
                      { Throw back any WM_QUIT messages }
                      PostQuitMessage (wParam);
                      Break;
                    end;
                  WM_LBUTTONDOWN, WM_LBUTTONDBLCLK,
                  WM_RBUTTONDOWN, WM_RBUTTONDBLCLK,
                  WM_MBUTTONDOWN, WM_MBUTTONDBLCLK: begin
                      P := SmallPointToPoint(TSmallPoint(lParam));
                      Windows.ClientToScreen (hwnd, P);
                      if FindDragTarget(P, True) = Self then
                        Repost := False;
                    end;
                end;
                if Repost then begin
                  RepostList.Add (AllocMem(SizeOf(TMsg)));
                  PMsg(RepostList.Last)^ := Msg;
                end;
              end;
          finally
            for I := 0 to RepostList.Count-1 do begin
              with PMsg(RepostList[I])^ do
                PostMessage (hwnd, message, wParam, lParam);
              FreeMem (RepostList[I]);
            end;
            RepostList.Free;
          end;
        end;
      end;
    end;
  finally
    FInClick := False;
    if FState = bsDown then
      FState := bsUp;
    { Need to check if it's destroying in case the OnClick handler freed
      the button. If it doesn't check this here, it can sometimes cause an
      access violation }
    if not(csDestroying in ComponentState) then begin
      Redraw (True);
      MouseLeft;
    end;
  end;
end;

function TToolbarButton97.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;

function TToolbarButton97.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;

procedure TToolbarButton97.SetGlyph (Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value;
  Redraw (True);
end;

function TToolbarButton97.GetGlyphMask: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).GlyphMask;
end;

procedure TToolbarButton97.SetGlyphMask (Value: TBitmap);
begin
  TButtonGlyph(FGlyph).GlyphMask := Value;
  Redraw (True);
end;

procedure TToolbarButton97.SetHighlightWhenDown (Value: Boolean);
begin
  if FHighlightWhenDown <> Value then begin
    FHighlightWhenDown := Value;
    if Down then
      Redraw (True);
  end;
end;

function TToolbarButton97.GetImageIndex: Integer;
begin
  Result := TButtonGlyph(FGlyph).FImageIndex;
end;

procedure TToolbarButton97.SetImageIndex (Value: Integer);
begin
  if TButtonGlyph(FGlyph).FImageIndex <> Value then begin
    TButtonGlyph(FGlyph).FImageIndex := Value;
    if Assigned(TButtonGlyph(FGlyph).FImageList) then
      TButtonGlyph(FGlyph).GlyphChanged (nil);
  end;
end;

function TToolbarButton97.GetImages: TCustomImageList;
begin
  Result := TButtonGlyph(FGlyph).FImageList;
end;

procedure TToolbarButton97.SetImages (Value: TCustomImageList);
begin
  with TButtonGlyph(FGlyph) do
    if FImageList <> Value then begin
      if FImageList <> nil then
        FImageList.UnRegisterChanges (FImageChangeLink);
      FImageList := Value;
      if FImageList <> nil then begin
        if FImageChangeLink = nil then begin
          FImageChangeLink := TChangeLink.Create;
          FImageChangeLink.OnChange := GlyphChanged;
        end;
        FImageList.RegisterChanges (FImageChangeLink);
        FImageList.FreeNotification (Self);
      end
      else begin
        FImageChangeLink.Free;
        FImageChangeLink := nil;
      end;
      UpdateNumGlyphs;
    end;
end;

function TToolbarButton97.GetNumGlyphs: TNumGlyphs97;
begin
  Result := TButtonGlyph(FGlyph).NumGlyphs;
end;

procedure TToolbarButton97.SetNumGlyphs (Value: TNumGlyphs97);
begin
  if Value < Low(TNumGlyphs97) then
    Value := Low(TNumGlyphs97)
  else
  if Value > High(TNumGlyphs97) then
    Value := High(TNumGlyphs97);
  if Value <> TButtonGlyph(FGlyph).NumGlyphs then begin
    TButtonGlyph(FGlyph).NumGlyphs := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.GlyphChanged(Sender: TObject);
begin
  Redraw (True);
end;

procedure TToolbarButton97.UpdateExclusive;
var
  I: Integer;
  Ctl: TControl;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
    with Parent do
      for I := 0 to ControlCount-1 do begin
        Ctl := Controls[I];
        if (Ctl <> Self) and (Ctl is TToolbarButton97) then
          with TToolbarButton97(Ctl) do
            if FGroupIndex = Self.FGroupIndex then begin
              if Self.Down and FDown then begin
                FDown := False;
                FState := bsUp;
                Redraw (True);
              end;
              FAllowAllUp := Self.AllowAllUp;
            end;
      end;
end;

procedure TToolbarButton97.SetDown (Value: Boolean);
begin
  if FGroupIndex = 0 then
    Value := False;
  if Value <> FDown then begin
    if FDown and (not FAllowAllUp) then Exit;
    FDown := Value;
    if not Enabled then
      FState := bsDisabled
    else begin
      if Value then
        FState := bsExclusive
      else
        FState := bsUp;
    end;
    Redraw (True);
    if Value then UpdateExclusive;
  end;
end;

procedure TToolbarButton97.SetFlat (Value: Boolean);
begin
  if FFlat <> Value then begin
    FFlat := Value;
    if FOpaque or not FFlat then
      ControlStyle := ControlStyle + [csOpaque]
    else
      ControlStyle := ControlStyle - [csOpaque];
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetGroupIndex (Value: Integer);
begin
  if FGroupIndex <> Value then begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

procedure TToolbarButton97.SetLayout (Value: TButtonLayout);
begin
  if FLayout <> Value then begin
    FLayout := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetMargin (Value: Integer);
begin
  if (FMargin <> Value) and (Value >= -1) then begin
    FMargin := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetNoBorder (Value: Boolean);
begin
  if FNoBorder <> Value then begin
    FNoBorder := Value;
    Invalidate;
  end;
end;

procedure TToolbarButton97.SetOldDisabledStyle (Value: Boolean);
begin
  if FOldDisabledStyle <> Value then begin
    FOldDisabledStyle := Value;
    with TButtonGlyph(FGlyph) do begin
      FOldDisabledStyle := Value;
      Invalidate;
    end;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetOpaque (Value: Boolean);
begin
  if FOpaque <> Value then begin
    FOpaque := Value;
    if FOpaque or not FFlat then
      ControlStyle := ControlStyle + [csOpaque]
    else
      ControlStyle := ControlStyle - [csOpaque];
    Invalidate;
  end;
end;

procedure TToolbarButton97.Redraw (const Erase: Boolean);
var
  AddedOpaque: Boolean;
begin
  if FOpaque or not FFlat or not Erase then begin
    { Temporarily add csOpaque to the style. This prevents Invalidate from
      erasing, which isn't needed when Erase is false. }
    AddedOpaque := False;
    if not(csOpaque in ControlStyle) then begin
      AddedOpaque := True;
      ControlStyle := ControlStyle + [csOpaque];
    end;
    try
      Invalidate;
    finally
      if AddedOpaque then
        ControlStyle := ControlStyle - [csOpaque];
    end;
  end
  else
  if not(FOpaque or not FFlat) then
    Invalidate;
end;

procedure TToolbarButton97.SetSpacing (Value: Integer);
begin
  if Value <> FSpacing then begin
    FSpacing := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetAllowAllUp (Value: Boolean);
begin
  if FAllowAllUp <> Value then begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;

procedure TToolbarButton97.SetDropdownMenu (Value: TPopupMenu);
var
  NewUsesDropdown: Boolean;
begin
  if FDropdownMenu <> Value then begin
    FDropdownMenu := Value;
    if Assigned(Value) then begin
      Value.FreeNotification (Self);
      {$IFNDEF TB97D4}
      if DropdownList = nil then
        DropdownList := TDropdownList.Create(nil);
      DropdownList.AddMenu (Value);
      {$ENDIF}
    end;
    NewUsesDropdown := FDropdownAlways or Assigned(Value);
    if FUsesDropdown <> NewUsesDropdown then begin
      FUsesDropdown := NewUsesDropdown;
      if FDropdownArrow or FDropdownCombo then
        Redraw (True);
    end;
  end;
end;

procedure TToolbarButton97.SetWordWrap (Value: Boolean);
begin
  if FWordWrap <> Value then begin
    FWordWrap := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetAlignment (Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetDropdownAlways (Value: Boolean);
var
  NewUsesDropdown: Boolean;
begin
  if FDropdownAlways <> Value then begin
    FDropdownAlways := Value;
    NewUsesDropdown := Value or Assigned(FDropdownMenu);
    if FUsesDropdown <> NewUsesDropdown then begin
      FUsesDropdown := NewUsesDropdown;
      if FDropdownArrow or FDropdownCombo then
        Redraw (True);
    end;
  end;
end;

procedure TToolbarButton97.SetDropdownArrow (Value: Boolean);
begin
  if FDropdownArrow <> Value then begin
    FDropdownArrow := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetDropdownArrowWidth (Value: Integer);
var
  Diff: Integer;
begin
  if Value < 7 then Value := 7;
  if FDropdownArrowWidth <> Value then begin
    Diff := Value - FDropdownArrowWidth;
    FDropdownArrowWidth := Value;
    if not(csLoading in ComponentState) and FDropdownCombo then
      Width := Width + Diff;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetDropdownCombo (Value: Boolean);
var
  W: Integer;
begin
  if FDropdownCombo <> Value then begin
    FDropdownCombo := Value;
    if not(csLoading in ComponentState) then begin
      if Value then
        Width := Width + (DropdownArrowWidth + DropdownComboSpace)
      else begin
        W := Width - (DropdownArrowWidth + DropdownComboSpace);
        if W < 1 then W := 1;
        Width := W;
      end;
    end;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetDisplayMode (Value: TButtonDisplayMode);
begin
  if FDisplayMode <> Value then begin
    FDisplayMode := Value;
    Redraw (True);
  end;
end;

function TToolbarButton97.GetCallDormant: Boolean;
begin
  Result := TButtonGlyph(FGlyph).FCallDormant;
end;

procedure TToolbarButton97.SetCallDormant (Value: Boolean);
begin
  TButtonGlyph(FGlyph).FCallDormant := Value;
end;

function TToolbarButton97.GetVersion: TToolbar97Version;
begin
  Result := Toolbar97VersionPropText;
end;

procedure TToolbarButton97.SetVersion (const Value: TToolbar97Version);
begin
  { write method required for the property to show up in Object Inspector }
end;

{$IFDEF TB97D4}
function TToolbarButton97.IsCheckedStored: Boolean;
begin
  Result := (ActionLink = nil) or not TToolbarButton97ActionLink(ActionLink).IsCheckedLinked;
end;

function TToolbarButton97.IsHelpContextStored: Boolean;
begin
  Result := (ActionLink = nil) or not TToolbarButton97ActionLink(ActionLink).IsHelpContextLinked;
end;

function TToolbarButton97.IsImageIndexStored: Boolean;
begin
  Result := (ActionLink = nil) or not TToolbarButton97ActionLink(ActionLink).IsImageIndexLinked;
end;

procedure TToolbarButton97.ActionChange (Sender: TObject; CheckDefaults: Boolean);
begin
  inherited;
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults or (Self.Down = False) then
        Self.Down := Checked;
      if not CheckDefaults or (Self.HelpContext = 0) then
        Self.HelpContext := HelpContext;
      if not CheckDefaults or (Self.ImageIndex = -1) then
        Self.ImageIndex := ImageIndex;
    end;
end;

function TToolbarButton97.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TToolbarButton97ActionLink;
end;

procedure TToolbarButton97.AssignTo (Dest: TPersistent);
begin
  inherited;
  if Dest is TCustomAction then
    TCustomAction(Dest).Checked := Self.Down;
end;
{$ENDIF}

procedure TToolbarButton97.WMLButtonDblClk (var Message: TWMLButtonDblClk);
begin
  inherited;
  if FDown then DblClick;
end;

procedure TToolbarButton97.CMEnabledChanged (var Message: TMessage);
begin
  if not Enabled then begin
    FState := bsDisabled;
    FMouseInControl := False;
    FMouseIsDown := False;
    RemoveButtonMouseTimer;
    Perform (WM_CANCELMODE, 0, 0);
  end
  else
  if FState = bsDisabled then
    if FDown and (FGroupIndex <> 0) then
      FState := bsExclusive
    else
      FState := bsUp;
  Redraw (True);
end;

procedure TToolbarButton97.CMDialogChar (var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Assigned(Parent) and Parent.CanFocus and
       Enabled and Visible and (DisplayMode <> dmGlyphOnly) then begin
      { NOTE: There is a bug in TSpeedButton where accelerator keys are still
        processed even when the button is not visible. The 'and Visible'
        corrects it, so TToolbarButton97 doesn't have this problem. }
      Click;
      Result := 1;
    end
    else
      inherited;
end;

procedure TToolbarButton97.CMDialogKey (var Message: TCMDialogKey);
begin
  with Message do
    if (((CharCode = VK_RETURN) and FDefault) or
        ((CharCode = VK_ESCAPE) and FCancel)) and
       (KeyDataToShiftState(Message.KeyData) = []) and
       Assigned(Parent) and Parent.CanFocus and Enabled and Visible then begin
      Click;
      Result := 1;
    end
    else
      inherited;
end;

procedure TToolbarButton97.CMFontChanged (var Message: TMessage);
begin
  Redraw (True);
end;

procedure TToolbarButton97.CMTextChanged (var Message: TMessage);
begin
  Redraw (True);
end;

procedure TToolbarButton97.CMSysColorChange (var Message: TMessage);
begin
  inherited;
  if Assigned(Pattern) and
     ((PatternBtnFace <> TColor(GetSysColor(COLOR_BTNFACE))) or
      (PatternBtnHighlight <> TColor(GetSysColor(COLOR_BTNHIGHLIGHT)))) then begin
    Pattern.Free;
    Pattern := nil;
  end;
  with TButtonGlyph(FGlyph) do begin
    Invalidate;
    CreateButtonGlyph (FState);
  end;
end;

procedure TToolbarButton97.MouseEntered;
begin
  if Enabled and not FMouseInControl then begin
    FMouseInControl := True;
    if FState = bsUp then
      FState := bsMouseIn;
    if FFlat or (NumGlyphs >= 5) then
      Redraw (FDown or (NumGlyphs >= 5));
    if Assigned(FOnMouseEnter) then
      FOnMouseEnter (Self);
  end;
end;

procedure TToolbarButton97.MouseLeft;
var
  OldState: TButtonState97;
begin
  if Enabled and FMouseInControl and not FMouseIsDown then begin
    FMouseInControl := False;
    RemoveButtonMouseTimer;
    OldState := FState;
    if (FState = bsMouseIn) or (not FInClick and (FState = bsDown)) then begin
      if FDown and (FGroupIndex <> 0) then
        FState := bsExclusive
      else
        FState := bsUp;
    end;
    if FFlat or ((NumGlyphs >= 5) or ((OldState = bsMouseIn) xor (FState <> OldState))) then
      Redraw (True);
    if Assigned(FOnMouseExit) then
      FOnMouseExit (Self);
  end;
end;

procedure TToolbarButton97.ButtonMouseTimerHandler (Sender: TObject);
var
  P: TPoint;
begin
  { The button mouse timer is used to periodically check if mouse has left.
    Normally it receives a CM_MOUSELEAVE, but the VCL does not send a
    CM_MOUSELEAVE if the mouse is moved quickly from the button to another
    application's window. For some reason, this problem doesn't seem to occur
    on Windows NT 4 -- only 95 and 3.x.

    The timer (which ticks 8 times a second) is only enabled when the
    application is active and the mouse is over a button, so it uses virtually
    no processing power.

    For something interesting to try: If you want to know just how often this
    is called, try putting a Beep call in here }

  GetCursorPos (P);
  if FindDragTarget(P, True) <> Self then
    MouseLeft;
end;


{ TEdit97 - internal }

constructor TEdit97.Create (AOwner: TComponent);
begin
  inherited;
  AutoSize := False;
  Ctl3D := False;
  BorderStyle := bsNone;
  ControlStyle := ControlStyle - [csFramed]; {fixes a VCL bug with Win 3.x}
  Height := 19;
  if Edit97Count = 0 then
    Register97ControlClass (TEdit97);
  Inc (Edit97Count);
end;

destructor TEdit97.Destroy;
begin
  Dec (Edit97Count);
  if Edit97Count = 0 then
    Unregister97ControlClass (TEdit97);
  inherited;
end;

procedure TEdit97.CMMouseEnter (var Message: TMessage);
begin
  inherited;
  MouseInControl := True;
  DrawNCArea (False, 0, 0);
end;

procedure TEdit97.CMMouseLeave (var Message: TMessage);
begin
  inherited;
  MouseInControl := False;
  DrawNCArea (False, 0, 0);
end;

procedure TEdit97.NewAdjustHeight;
var
  DC: HDC;
  SaveFont: HFONT;
  Metrics: TTextMetric;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics (DC, Metrics);
  SelectObject (DC, SaveFont);
  ReleaseDC (0, DC);

  Height := Metrics.tmHeight + 6;
end;

procedure TEdit97.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    NewAdjustHeight;
end;

procedure TEdit97.CMEnabledChanged (var Message: TMessage);
const
  EnableColors: array[Boolean] of TColor = (clBtnFace, clWindow);
begin
  inherited;
  Color := EnableColors[Enabled];
end;

procedure TEdit97.CMFontChanged (var Message: TMessage);
begin
  inherited;
  if not((csDesigning in ComponentState) and (csLoading in ComponentState)) then
    NewAdjustHeight;
end;

procedure TEdit97.WMSetFocus (var Message: TWMSetFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    DrawNCArea (False, 0, 0);
end;

procedure TEdit97.WMKillFocus (var Message: TWMKillFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    DrawNCArea (False, 0, 0);
end;

procedure TEdit97.WMNCCalcSize (var Message: TWMNCCalcSize);
begin
  InflateRect (Message.CalcSize_Params^.rgrc[0], -3, -3);
end;

procedure TEdit97.WMNCPaint (var Message: TMessage);
begin
  DrawNCArea (False, 0, HRGN(Message.WParam));
end;

procedure TEdit97.DrawNCArea (const DrawToDC: Boolean; const ADC: HDC;
  const Clip: HRGN);
var
  DC: HDC;
  R: TRect;
  BtnFaceBrush, WindowBrush: HBRUSH;
begin
  if not DrawToDC then
    DC := GetWindowDC(Handle)
  else
    DC := ADC;
  try
    { Use update region }
    if not DrawToDC then
      SelectNCUpdateRgn (Handle, DC, Clip);

    { This works around WM_NCPAINT problem described at top of source code }
    {no!  R := Rect(0, 0, Width, Height);}
    GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
    BtnFaceBrush := GetSysColorBrush(COLOR_BTNFACE);
    WindowBrush := GetSysColorBrush(COLOR_WINDOW);
    if ((csDesigning in ComponentState) and Enabled) or
       (not(csDesigning in ComponentState) and
        (Focused or (MouseInControl and not ControlIs97Control(Screen.ActiveControl)))) then begin
      DrawEdge (DC, R, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
      with R do begin
        FillRect (DC, Rect(Left, Top, Left+1, Bottom-1), BtnFaceBrush);
        FillRect (DC, Rect(Left, Top, Right-1, Top+1), BtnFaceBrush);
      end;
      DrawEdge (DC, R, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
      InflateRect (R, -1, -1);
      FrameRect (DC, R, WindowBrush);
    end
    else begin
      FrameRect (DC, R, BtnFaceBrush);
      InflateRect (R, -1, -1);
      FrameRect (DC, R, BtnFaceBrush);
      InflateRect (R, -1, -1);
      FrameRect (DC, R, WindowBrush);
    end;
  finally
    if not DrawToDC then
      ReleaseDC (Handle, DC);
  end;
end;

procedure EditNCPaintProc (Wnd: HWND; DC: HDC; AppData: Longint);
begin
  TEdit97(AppData).DrawNCArea (True, DC, 0);
end;

procedure TEdit97.WMPrint (var Message: TMessage);
begin
  HandleWMPrint (Handle, Message, EditNCPaintProc, Longint(Self));
end;

procedure TEdit97.WMPrintClient (var Message: TMessage);
begin
  HandleWMPrintClient (Self, Message);
end;

function TEdit97.GetVersion: TToolbar97Version;
begin
  Result := Toolbar97VersionPropText;
end;

procedure TEdit97.SetVersion (const Value: TToolbar97Version);
begin
  { write method required for the property to show up in Object Inspector }
end;


{$IFNDEF TB97D4}
initialization
finalization
  DropdownList.Free;
{$ENDIF}
end.
