Night Owl 25/nopv25.iso/040A/CAPCTRL.ZIP/SOURCE/CAPCTRL.PAS

Pascal/Delphi Source File | 1997-03-21 | 42.1 KB | 1,424 lines

(******************************************************************************)
(* CaptionControl                   Development tool: Borland Delphi 2.0      *)
(* version 1.00                     Operating system: Microsoft Windows 95    *)
(*                                                                            *)
(* Read the accompanying documentation for information.                       *)
(*                                                                            *)
(* Copyright 1996, 1997 Yorai Aminov                                          *)
(*                                                                            *)
(*              [e-mail] (preffered)                           *)
(*              CompuServe - 100274,720                                       *)
(******************************************************************************)

unit CapCtrl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DsgnIntf, Menus;

type
  { Exceptions }
  ECaptionError = class(Exception);

  { Types }
  TDirection = (dirLeft, dirRight);
  TCaptionButtonKind = (cbkCustom, cbkOk, cbkRollUp, cbkRollDown, cbkDocument,
    cbkFolder, cbkWindow, cbkMail, cbkDownArrow, cbkUpArrow, cbkLeftArrow,
    cbkRightArrow, cbkMore, cbkFlag, cbkCool);
  TCaptionGradient = (cgNone, cgActive, cgAlways);

  { Events }
  TDrawCaptionEvent = procedure(Sender: TObject; var CaptionText: String;
    DC: HDC; Rect: TRect; var Drawn: boolean) of object;
  TCaptionButtonDrawEvent = procedure(Sender: TObject; ButtonIndex: Integer;
    DC: HDC; Rect: TRect; var Drawn: boolean) of object;
  TCaptionButtonClickEvent = procedure(Sender: TObject; ButtonIndex: Integer;
    var Pushed: Boolean) of object;

  { TCaptionButton }
  TCaptionButton = class
  private
    FCaption: String;
    FEnabled: Boolean;
    FVisible: Boolean;
    FPushed: Boolean;
    FKind: TCaptionButtonKind;
  public
    constructor Create;
    function Draw(DC: HDC; Rect: TRect): Boolean; virtual;
    function GetBtnKindStr: String;
    procedure SetBtnKindStr(KindStr: String);
  published
    property Caption: String read FCaption write FCaption;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property Visible: Boolean read FVisible write FVisible default True;
    property Pushed: Boolean read FPushed write FPushed default False;
    property Kind: TCaptionButtonKind read FKind write FKind default cbkCustom;
  end;

  { TCaptionButtonsList }
  TCaptionButtonsList = class(TPersistent)
  private
    FButtonsList: TStringList;
    procedure SetButton(Index: Integer; Value: TCaptionButton);
    function GetButton(Index: Integer): TCaptionButton;
    function GetCount: Integer;
  protected
    { property storage }
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadButtons(Reader: TReader);
    procedure WriteButtons(Writer: TWriter);
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
    procedure Add(Button: TCaptionButton);
    procedure Insert(Index: Integer; Button: TCaptionButton);
    procedure Delete(Index: Integer);
    procedure Clear;
    procedure AddButton(Caption: String; Enabled, Visible, Pushed: Boolean;
      Kind: TCaptionButtonKind);
    property Buttons[Index: Integer]: TCaptionButton read GetButton write SetButton; default;
    property Count: Integer read GetCount;
  published
  end;

  { TCaptionButtonsListProperty }
  TCaptionButtonsListProperty = class(TClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: String; override;
  end;

  { TCaptionControl }
  TCaptionControl = class(TComponent)
  private
    { Internal fields }
    Colors: array[0..1, 0..255] of TColorRef;
    CaptionFont: HFONT;
    DefWinProc: TFarProc;
    DefWinProcInstance: Pointer;
    FOnFormDestroy: TNotifyEvent;
    BtnWidth: Integer;
    DrawPushed: Boolean;
    Pushed: Integer;
    RestoreWndProc: Boolean;
    rgn: HRGN;
    FWindowActive: Boolean;
    FMaximized: Boolean;
    FButtonsLeft: Integer;
    FRightPushed: Boolean;
    { Property fields }
    FEnabled: Boolean;
    FCaptionGradient: TCaptionGradient;
    FColorBands: Integer;
    FShowButtons: Boolean;
    FCaptionDirection: TDirection;
    FButtonsDirection: TDirection;
    FWindowDirection: TDirection;
    FRtlReading: Boolean;
    FButtons: TCaptionButtonsList;
    FPopupMenu: TPopupMenu;
    { Event fields }
    FOnDrawCaption: TDrawCaptionEvent;
    FOnButtonDraw: TCaptionButtonDrawEvent;
    FOnButtonClick: TCaptionButtonClickEvent;
    { Internal methods }
    procedure CalculateColors;
    function GetCaptionRect: TRect;
    procedure OnCaptionControlDestroy(Sender: TObject);
    procedure WinProc(var Message: TMessage);
    function GetCoordButton(Point: TPoint): Integer;
    { Drawing }
    function DrawAllCaption(FormDC: HDC): TRect;
    procedure DrawMenuIcon(DC: HDC; var R: TRect);
    procedure FillRectGradient(DC: HDC; const R: TRect; Active: boolean);
    procedure FillRectCaption(DC: HDC; const R: TRect; Active: boolean);
    procedure DrawCaptionText(DC: HDC; R: TRect);
    procedure DrawCaptionButtons(DC: HDC; var R: TRect);
    { Property methods }
    procedure SetCaptionGradient(Value: TCaptionGradient);
    procedure SetShowButtons(Value: Boolean);
    procedure SetCaptionDirection(Value: TDirection);
    procedure SetButtonsDirection(Value: TDirection);
    procedure SetWindowDirection(Value: TDirection);
    procedure SetRtlReading(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
    procedure SetColorBands(Value: Integer);
    procedure SetPopupMenu(Value: TPopupMenu);
  public
    { Public methods }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Refresh;
  published
    { Value properties }
    property CaptionGradient: TCaptionGradient read FCaptionGradient write SetCaptionGradient default cgActive;
    property ShowButtons: Boolean read FShowButtons write SetShowButtons default True;
    property CaptionDirection: TDirection read FCaptionDirection write SetCaptionDirection default dirLeft;
    property ButtonsDirection: TDirection read FButtonsDirection write SetButtonsDirection default dirRight;
    property WindowDirection: TDirection read FWindowDirection write SetWindowDirection default dirLeft;
    property RtlReading: Boolean read FRtlReading write SetRtlReading default False;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Buttons: TCaptionButtonsList read FButtons write FButtons;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property ColorBands: Integer read FColorBands write SetColorBands default 64;
    { Events }
    property OnDrawCaption: TDrawCaptionEvent read FOnDrawCaption write FOnDrawCaption;
    property OnButtonDraw: TCaptionButtonDrawEvent read FOnButtonDraw write FOnButtonDraw;
    property OnButtonClick: TCaptionButtonClickEvent read FOnButtonClick write FOnButtonClick;
  end;

procedure Register;

implementation

uses
  CapEdit;

type
  TRGBRec = packed record
    case Integer of
      1: (RGBVal: LongInt);
      0: (Red, Green, Blue, None: Byte);
  end;

procedure Register;
begin
  RegisterComponents('Extended', [TCaptionControl]);
  RegisterPropertyEditor(TypeInfo(TCaptionButtonsList), nil, '', TCaptionButtonsListProperty);
end;

{ TCaptionButton }
constructor TCaptionButton.Create;
begin
  inherited;
  FEnabled := True;
  FVisible := True;
  FPushed := False;
  FKind := cbkCustom;
end;

function TCaptionButton.Draw(DC: HDC; Rect: TRect): Boolean;
var
  NCM: TNonClientMetrics;
  WingFont, ButtonFont, OldFont: HFont;
  WingLogFont: TLogFont;
  OldColor: TColorRef;
  OldMode: Integer;
  S: String;
  Brush: HBrush;
  R: TRect;
  Pen, GrayPen: HPen;
  ROffset: Integer;

procedure BeginDraw;
begin
  if FEnabled then
  begin
    Pen := SelectObject(DC, GetStockObject(BLACK_PEN));
    Brush := SelectObject(DC, GetStockObject(BLACK_BRUSH));
    GrayPen := 0;
  end else
  begin
    Pen := SelectObject(DC, GetStockObject(WHITE_PEN));
    GrayPen := CreatePen(PS_SOLID, 0, GetSysColor(COLOR_BTNSHADOW));
    Brush := SelectObject(DC, GetStockObject(WHITE_BRUSH));
  end;
  R := Rect;
  ROffset := (Rect.Right - Rect.Left)*17 div 100;
  R.Left := Rect.Left+ROffset;
  R.Top := Rect.Top+ROffset;
  R.Right := Rect.Right-ROffset-1;
  R.Bottom := Rect.Bottom-ROffset-1;
end;

procedure EndDraw;
begin
  SelectObject(DC, Pen);
  SelectObject(DC, Brush);
  if GrayPen<>0 then DeleteObject(GrayPen);
end;

procedure DrawRoll(Down: Boolean);
begin
  BeginDraw;
  if not(FEnabled) then
  begin
    OffsetRect(R, 1, 1);
    Rectangle(DC, R.Left, R.Top, R.Right, R.Top+ROffset);
    if Down then
      Rectangle(DC, R.Left, R.Bottom-ROffset, R.Right, R.Bottom);
    OffsetRect(R, -1, -1);
    SelectObject(DC, GrayPen);
    SelectObject(DC, GetStockObject(DKGRAY_BRUSH));
  end;
  Rectangle(DC, R.Left, R.Top, R.Right, R.Top+ROffset);
  if Down then
    Rectangle(DC, R.Left, R.Bottom-ROffset, R.Right, R.Bottom);
  EndDraw;
end;

procedure DrawOk;
var
  p: array[0..6] of TPoint;
  i: Integer;
begin
  BeginDraw;
  p[0].x := R.Left;
  p[0].y := R.top + (R.Bottom-R.Top) div 2;
  p[1].x := R.Left + (R.Right-R.Left) div 2 - ROffset;
  p[1].y := R.bottom;
  p[2].x := p[1].x + ROffset-1;
  P[2].y := p[1].y;
  p[3].x := R.Right;
  p[3].y := R.top;
  p[4].x := p[3].x-ROffset+1;
  p[4].y := p[3].y;
  p[5].x := p[1].x + (ROffset) div 3;
  p[5].y := p[1].y - ROffset;
  p[6].x := p[0].x + ROffset;
  p[6].y := p[0].y;
  if not(FEnabled) then
  begin
    for i:=0 to 6 do
    begin
      Inc(p[i].x);
      Inc(p[i].y);
    end;
    Polygon(DC, p, 7);
    for i:=0 to 6 do
    begin
      Dec(p[i].x);
      Dec(p[i].y);
    end;
    SelectObject(DC, GrayPen);
    SelectObject(DC, GetStockObject(DKGRAY_BRUSH));
  end;
  Polygon(DC, p, 7);
  EndDraw;
end;

procedure DrawWindow;
var
  ColorBrush, SaveBrush: HBrush;
begin
  BeginDraw;
  if not(FEnabled) then
  begin
    OffsetRect(R, 1, 1);
    SelectObject(DC, GetStockObject(LTGRAY_BRUSH));
    Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom);
    Rectangle(DC, R.Left, R.Top, R.Right, R.Top+ROffset+1);
    OffsetRect(R, -1, -1);
    SelectObject(DC, GrayPen);
    Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom);
    SelectObject(DC, GetStockObject(DKGRAY_BRUSH));
    Rectangle(DC, R.Left, R.Top, R.Right, R.Top+ROffset+1);
  end else
  begin
    SelectObject(DC, GetStockObject(BLACK_PEN));
    SelectObject(DC, GetStockObject(WHITE_BRUSH));
    Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom);
    ColorBrush := CreateSolidBrush(GetSysColor(COLOR_ACTIVECAPTION));
    SaveBrush := SelectObject(DC, ColorBrush);
    Rectangle(DC, R.Left, R.Top, R.Right, R.Top+ROffset+1);
    SelectObject(DC, SaveBrush);
    DeleteObject(ColorBrush);
  end;
  EndDraw;
end;

begin
  Result := True;
  NCM.cbSize := SizeOf(NCM);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0) then
    ButtonFont := CreateFontIndirect(NCM.lfSmCaptionFont)
  else
    ButtonFont := 0;
  FillChar(WingLogFont, SizeOf(WingLogFont), 0);
  with WingLogFont do
  begin
    lfHeight := ((Rect.Top-Rect.Bottom)*31) div 40;
    lfCharSet := SYMBOL_CHARSET;
    lfOutPrecision := OUT_DEFAULT_PRECIS;
    lfClipPrecision := CLIP_DEFAULT_PRECIS;
    lfQuality := DEFAULT_QUALITY;
    lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE;
    lfFaceName := 'Wingdings'
  end;
  WingFont := CreateFontIndirect(WingLogFont);
  if (WingFont<>0) and
     (FKind in [cbkOk, cbkDocument, cbkFolder, cbkMail,
                cbkDownArrow, cbkUpArrow, cbkLeftArrow, cbkRightArrow,
                cbkFlag, cbkCool]) then
  begin
    if ButtonFont<>0 then
      DeleteObject(ButtonFont);
    ButtonFont := WingFont;
  end;
  if FKind in [cbkRollUp, cbkRollDown, cbkWindow, cbkOk] then
  begin
    if ButtonFont<>0 then
      DeleteObject(ButtonFont);
    Result := True;
    case FKind of
      cbkRollUp: DrawRoll(False);
      cbkRollDown: DrawRoll(True);
      cbkWindow: DrawWindow;
      cbkOk: DrawOk;
    else
      Result := False;
    end;
  end else
  begin
    Result := False;
    case FKind of
      cbkOk: S := #252;
      cbkDocument: S := '2';
      cbkFolder: S := '0';
      cbkMail: S := '+';
      cbkDownArrow: S := #234;
      cbkUpArrow: S := #233;
      cbkLeftArrow: S := #231;
      cbkRightArrow: S := #232;
      cbkMore: S := '...';
      cbkFlag: S := 'O';
      cbkCool: S := 'J';
      cbkCustom: S := FCaption;
    else
      S := ' ';
    end;
    if ButtonFont<>0 then
    begin
      OldFont := SelectObject(DC, ButtonFont);
      OldMode := SetBkMode(DC, TRANSPARENT);
      OldColor := SetTextColor(DC, GetSysColor(COLOR_BTNTEXT));
      if not(FEnabled) then
      begin
        SetTextColor(DC, GetSysColor(COLOR_BTNHILIGHT));
        OffsetRect(Rect, 1, 1);
      end;
      DrawText(DC, PChar(S), -1, Rect,
        DT_CENTER or DT_VCENTER or DT_SINGLELINE);
      if not(FEnabled) then
      begin
        OffsetRect(Rect, -1, -1);
        SetTextColor(DC, GetSysColor(COLOR_BTNSHADOW));
        DrawText(DC, PChar(S), -1, Rect,
          DT_CENTER or DT_VCENTER or DT_SINGLELINE);
      end;
      SetTextColor(DC, OldColor);
      SetBkMode(DC, OldMode);
      SelectObject(DC, OldFont);
      DeleteObject(ButtonFont);
      Result := True;
    end;
  end;
end;

function TCaptionButton.GetBtnKindStr: String;
begin
  case FKind of
    cbkCustom: Result := 'cbkCustom';
    cbkOk: Result := 'cbkOk';
    cbkRollUp: Result := 'cbkRollUp';
    cbkRollDown: Result := 'cbkRollDown';
    cbkDocument: Result := 'cbkDocument';
    cbkFolder: Result := 'cbkFolder';
    cbkWindow: Result := 'cbkWindow';
    cbkMail: Result := 'cbkMail';
    cbkDownArrow: Result := 'cbkDownArrow';
    cbkUpArrow: Result := 'cbkUpArrow';
    cbkLeftArrow: Result := 'cbkLeftArrow';
    cbkRightArrow: Result := 'cbkRightArrow';
    cbkMore: Result := 'cbkMore';
    cbkFlag: Result := 'cbkFlag';
    cbkCool: Result := 'cbkCool';
  else
    Result := 'cbkCustom';
  end;
end;

procedure TCaptionButton.SetBtnKindStr(KindStr: String);
begin
  if KindStr='cbkCustom' then FKind := cbkCustom else
  if KindStr='cbkOk' then FKind := cbkOk else
  if KindStr='cbkRollUp' then FKind := cbkRollUp else
  if KindStr='cbkRollDown' then FKind := cbkRollDown else
  if KindStr='cbkDocument' then FKind := cbkDocument else
  if KindStr='cbkFolder' then FKind := cbkFolder else
  if KindStr='cbkWindow' then FKind := cbkWindow else
  if KindStr='cbkMail' then FKind := cbkMail else
  if KindStr='cbkDownArrow' then FKind := cbkDownArrow else
  if KindStr='cbkUpArrow' then FKind := cbkUpArrow else
  if KindStr='cbkLeftArrow' then FKind := cbkLeftArrow else
  if KindStr='cbkRightArrow' then FKind := cbkRightArrow else
  if KindStr='cbkMore' then FKind := cbkMore else
  if KindStr='cbkFlag' then FKind := cbkFlag else
  if KindStr='cbkCool' then FKind := cbkCool else
  FKind := cbkCustom;
end;

{ TCaptionButtonsList }
constructor TCaptionButtonsList.Create(AOwner: TComponent);
begin
  inherited Create;
  FButtonsList := TStringList.Create;
end;

destructor TCaptionButtonsList.Destroy;
begin
  Clear;
  FButtonsList.Free;
  inherited;
end;

procedure TCaptionButtonsList.SetButton(Index: Integer; Value: TCaptionButton);
begin
  if Index>=FButtonsList.Count then exit;
  TCaptionButton(FButtonsList.Objects[Index]).Free;
  FButtonsList.Objects[Index] := Value;
end;

function TCaptionButtonsList.GetButton(Index: Integer): TCaptionButton;
begin
  if Index>=FButtonsList.Count then Result := nil else
    Result := TCaptionButton(FButtonsList.Objects[Index]);
end;

function TCaptionButtonsList.GetCount: Integer;
begin
  Result := FButtonsList.Count;
end;

procedure TCaptionButtonsList.Add(Button: TCaptionButton);
begin
  FButtonsList.AddObject('', Button);
end;

procedure TCaptionButtonsList.Insert(Index: Integer; Button: TCaptionButton);
begin
  if Index<FButtonsList.Count then
    FButtonsList.InsertObject(Index, '', Button);
end;

procedure TCaptionButtonsList.Delete(Index: Integer);
begin
  if Index<FButtonsList.Count then
  begin
    if FButtonsList.Objects[Index]<>nil then
      TCaptionButton(FButtonsList.Objects[Index]).Free;
    FButtonsList.Delete(Index);
  end;
end;

procedure TCaptionButtonsList.Clear;
begin
  while FButtonsList.Count>0 do
    Delete(0);
end;

procedure TCaptionButtonsList.AddButton(Caption: String;
  Enabled, Visible, Pushed: Boolean; Kind: TCaptionButtonKind);
var
  b: TCaptionButton;
begin
  b := TCaptionButton.Create;
  b.Caption := Caption;
  b.Enabled := Enabled;
  b.Visible := Visible;
  b.Pushed := Pushed;
  b.Kind := Kind;
  Add(b);
end;

procedure TCaptionButtonsList.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('Buttons', ReadButtons, WriteButtons, Count>0);
end;

procedure TCaptionButtonsList.ReadButtons(Reader: TReader);
begin
  Clear;
  Reader.ReadListBegin;
  while not Reader.EndOfList do
  begin
    Add(TCaptionButton.Create);
    with Buttons[Count-1] do
    begin
      Caption := Reader.ReadString;
      Enabled := Reader.ReadBoolean;
      Visible := Reader.ReadBoolean;
      Pushed := Reader.ReadBoolean;
      SetBtnKindStr(Reader.ReadString);
    end;
  end;
  Reader.ReadListEnd;
end;

procedure TCaptionButtonsList.WriteButtons(Writer: TWriter);
var
  i: Integer;
begin
  Writer.WriteListBegin;
  if FButtonsList.Count>0 then
    for i:=0 to FButtonsList.Count-1 do
      with FButtonsList.Objects[i] as TCaptionButton do
      begin
        Writer.WriteString(Caption);
        Writer.WriteBoolean(Enabled);
        Writer.WriteBoolean(Visible);
        Writer.WriteBoolean(Pushed);
        Writer.WriteString(GetBtnKindStr);
      end;
  Writer.WriteListEnd;
end;

{ TCaptionButtonListProperty }
procedure TCaptionButtonsListProperty.Edit;
begin
  if EditCaptionButtons(TCaptionButtonsList(GetOrdValue),
    TCaptionControl(GetComponent(0))) then Modified;
end;

function TCaptionButtonsListProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

function TCaptionButtonsListProperty.GetValue: String;
begin
  Result := '(Buttons)';
end;

{ TCaptionControl }
constructor TCaptionControl.Create(AOwner: TComponent);
var
  NCM: TNonClientMetrics;
  VI: TOSVersionInfo;
  iCount: Integer;
begin
  inherited;
  FButtons := TCaptionButtonsList.Create(Self);
  DrawPushed := False;
  Pushed := -1;
  FRightPushed := False;
  rgn := 0;
  FEnabled := True;
  FColorBands := 64;
  if not (Owner is TForm) then
    raise ECaptionError.Create('Owner must be a form.');
  if TForm(Owner).ComponentCount>0 then
    for iCount := 0 to TForm(Owner).ComponentCount-1 do
      if (TForm(Owner).Components[iCount] is TCaptionControl) and
         (TForm(Owner).Components[iCount]<>Self) then
        raise ECaptionError.Create('Only one TCaptionControl per form is allowed.');
  FillChar(VI, SizeOf(VI), 0);
  VI.dwOSVersionInfoSize := SizeOf(VI);
  GetVersionEx(VI);
  if (VI.dwMajorVersion<4) or (VI.dwPlatformId=VER_PLATFORM_WIN32S) then
    raise ECaptionError.Create('Operating system must be Windows 95/NT 4.0 or greater.');
  FWindowActive := False;
  FMaximized := False;
  FEnabled := True;
  FCaptionDirection := dirLeft;
  FButtonsDirection := dirRight;
  FWindowDirection := dirLeft;
  FRtlReading := False;
  with TForm(Owner) do
  begin
    DefWinProcInstance := MakeObjectInstance(WinProc);
    DefWinProc := Pointer(SetWindowLong(Handle, GWL_WNDPROC, Longint(DefWinProcInstance)));
    FOnFormDestroy := OnDestroy;
    OnDestroy := OnCaptionControlDestroy;
    FCaptionGradient := cgActive;
    CalculateColors;
    NCM.cbSize := SizeOf(NCM);
    if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0) then begin
      if BorderStyle in [bsToolWindow, bsSizeToolWin] then
        CaptionFont := CreateFontIndirect(NCM.lfSmCaptionFont)
      else
        CaptionFont := CreateFontIndirect(NCM.lfCaptionFont);
    end else
      CaptionFont := 0;
  end;
end;

destructor TCaptionControl.Destroy;
var
  proc: TNotifyEvent;
begin
  try
    if not RestoreWndProc then
    begin
      SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, Longint(DefWinProc));
      FreeObjectInstance(DefWinProcInstance);
      RestoreWndProc := True;
    end;
    proc := OnCaptionControlDestroy;
    if Assigned(Owner) and (@proc = @TForm(Owner).OnDestroy) then
      TForm(Owner).OnDestroy := FOnFormDestroy;
  finally
    if rgn <> 0 then
      DeleteObject( rgn );
    if CaptionFont <> 0 then
      DeleteObject(CaptionFont);
    FButtons.Free;
    inherited;
  end;
end;

procedure TCaptionControl.OnCaptionControlDestroy(Sender: TObject);
begin
  try
    if not RestoreWndProc then
    begin
      SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, Longint(DefWinProc));
      FreeObjectInstance(DefWinProcInstance);
      RestoreWndProc := True;
    end;
    if Assigned(FOnFormDestroy) then
      FOnFormDestroy(Sender);
  except end;
end;

procedure TCaptionControl.SetShowButtons(Value: Boolean);
begin
  if Value <> FShowButtons then
  begin
    FShowButtons := Value;
    Refresh;
  end;
end;

procedure TCaptionControl.WinProc(var Message: TMessage);
var
  DC: HDC;
  WR, R: TRect;
  MyRgn: HRGN;
  DeleteRgn: boolean;
  PushState: Boolean;

  procedure DefaultProc;
  begin
    with Message do
      Result := CallWindowProc(DefWinProc, TForm(Owner).Handle, Msg, wParam, lParam);
  end;

  function InButton(InClient: Boolean): Boolean;
  var
    p: TPoint;
  begin
    p.x := Message.lParamLo;
    p.y := Smallint(Message.lParamHi);
    if InClient then
      ClientToScreen(TForm(Owner).Handle, p);
    Dec(p.x, TForm(Owner).Left);
    Dec(p.y, TForm(Owner).Top);
    Result := Pushed=GetCoordButton(p);
  end;

  function InAnyButton(InClient: Boolean): Boolean;
  var
    p: TPoint;
  begin
    p.x := Message.lParamLo;
    p.y := Smallint(Message.lParamHi);
    if InClient then
      ClientToScreen(TForm(Owner).Handle, p);
    Dec(p.x, TForm(Owner).Left);
    Dec(p.y, TForm(Owner).Top);
    Pushed := GetCoordButton(p);
    Result := Pushed>=0;
  end;

  procedure ShowPopup(InClient: Boolean);
  var
    sp: TSmallPoint;
    p: Tpoint;
  begin
    sp := TWMMouse(Message).Pos;
    p.x := sp.x;
    p.y := sp.y;
    if InClient then
      ClientToScreen(TForm(Owner).Handle, p);
    FPopupMenu.Popup(p.x, p.y);
  end;

begin
  with Message do
    case Msg of
      WM_NCACTIVATE:
      begin
        FWindowActive := (Message.wParam<>0);
        DefaultProc;
        if not(Enabled) then Exit;
        DC := GetWindowDC(TForm(Owner).Handle);
        try
          DrawAllCaption(DC);
        except end;
        ReleaseDC(TForm(Owner).Handle, DC);
      end;
      WM_NCPAINT:
      begin
        if not(Enabled) then
        begin
          DefaultProc;
          Exit;
        end;
        DeleteRgn := FALSE;
        MyRgn := Message.wParam;
        DC := GetWindowDC(TForm(Owner).Handle);
        try
          GetWindowRect(TForm(Owner).Handle, WR);
          if SelectClipRgn(DC, MyRgn) = ERROR then
          begin
             with WR do
               MyRgn := CreateRectRgn(Left, Top, Right, Bottom);
             SelectClipRgn(DC, MyRgn);
             DeleteRgn := TRUE;
          end;
          OffsetClipRgn(DC, -WR.Left, -WR.Top);
          R := DrawAllCaption(DC);
          ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
          OffsetClipRgn(DC, WR.Left, WR.Top);
          GetClipRgn(DC, MyRgn);
          with Message do
            Result := CallWindowProc(DefWinProc, TForm(Owner).Handle, Msg, MyRgn, lParam);
        finally
          if DeleteRgn then
            DeleteObject(MyRgn);
          ReleaseDC(TForm(Owner).Handle, DC);
        end;
      end;
      WM_SIZE:
      begin
        FMaximized := (wParam=SIZE_MAXIMIZED);
        DefaultProc;
        if not(Enabled) then Exit;
        // Redraw to set proper maximize/restore icon
        DC := GetWindowDC(TForm(Owner).Handle);
        try
          DrawAllCaption(DC);
        except end;
        ReleaseDC(TForm(Owner).Handle, DC);
      end;
      WM_MOUSEMOVE:
      begin
        if not(Enabled) then
        begin
          DefaultProc;
          Exit;
        end;
        if Pushed>=0 then
        begin
          if not InButton(True) then
          begin
            if DrawPushed then
            begin
              DrawPushed := False;
              Refresh;
            end;
          end
          else
          begin
            if not DrawPushed then
            begin
              DrawPushed := True;
              Refresh;
            end;
          end;
          Result := 1;
        end
        else
          DefaultProc;
      end;
      WM_LBUTTONUP, WM_LBUTTONDBLCLK:
      begin
        if not(Enabled) then
        begin
          DefaultProc;
          Exit;
        end;
        DrawPushed := False;
        if Pushed>=0 then
        begin
          if InButton(True) then
          begin
            PushState := Buttons[Pushed].Pushed;
            if Assigned(FOnButtonClick) then
              FOnButtonClick(Self, Pushed, PushState);
            Buttons[Pushed].Pushed := PushState;
          end;
          Refresh;
          Result := 1;
        end
        else
          DefaultProc;
        Pushed := -1;
        ReleaseCapture;
      end;
      WM_NCLBUTTONDOWN, WM_NCLBUTTONDBLCLK:
      begin
        if not(Enabled) then
        begin
          DefaultProc;
          Exit;
        end;
        if InAnyButton(False) then
        begin
          SetCapture(TForm(Owner).Handle);
          if (not(Buttons[Pushed].Enabled)) or (Buttons[Pushed].Caption='-') then DrawPushed := True;
          Refresh;
          Result := 1;
        end
        else if Msg = WM_NCLBUTTONDBLCLK then
          DefaultProc;
        if Msg = WM_NCLBUTTONDOWN then
          DefaultProc;
      end;
      WM_RBUTTONUP, WM_RBUTTONDBLCLK:
      begin
        if not(Enabled) then
        begin
          DefaultProc;
          Exit;
        end;
        if FRightPushed and Assigned(FPopupMenu) and (FPopupMenu.AutoPopup) then
        begin
          ShowPopup(True);
          Result := 1;
        end else
          DefaultProc;
        FRightPushed := False;
        ReleaseCapture;
      end;
      WM_NCRBUTTONDOWN:
      begin
        if not(Enabled) then DefaultProc else
        begin
          SetCapture(TForm(Owner).Handle);
          FRightPushed := True;
          Result := 1;
        end;
      end;
      WM_SYSCOLORCHANGE:
      begin
        CalculateColors;
        DefaultProc;
      end;
      WM_SETTEXT:
      begin
        DefaultProc;
        Refresh;
      end;
      // magic number
      $003F:
      begin
        DefaultProc;
        Refresh;
      end;
      else
        DefaultProc;
    end;
end;

procedure TCaptionControl.SetCaptionGradient(Value: TCaptionGradient);
begin
  if FCaptionGradient = Value then exit;
  FCaptionGradient := Value;
  Refresh;
end;

procedure TCaptionControl.CalculateColors;
var
  SysColor: TRGBRec;
  RedPercent,
  GreenPercent,
  BluePercent: Extended;
  x, Band: Byte;
begin
  for x := 0 to 1 do begin
    if x = 0 then
      SysColor.RGBVal := GetSysColor(COLOR_INACTIVECAPTION)
    else
      SysColor.RGBVal := GetSysColor(COLOR_ACTIVECAPTION);
    with SysColor do begin
      RedPercent   := Red / (FColorBands-1);
      GreenPercent := Green / (FColorBands-1);
      BluePercent  := Blue / (FColorBands-1);
    end;
    for Band := 0 to FColorBands-1 do
      Colors[x][Band] := RGB(round(RedPercent * (Band)),
                             round(GreenPercent * (Band)),
                             round(BluePercent * (Band)));
  end;
end;

function TCaptionControl.GetCaptionRect: TRect;
begin
  with TForm(Owner) do
  begin
    if BorderStyle = bsNone then
      SetRectEmpty(Result)
    else begin
      GetWindowRect(Handle, Result);
      OffsetRect(Result, -Result.Left, -Result.Top);
      case BorderStyle of
        bsToolWindow, bsSingle, bsDialog:
            InflateRect(Result, -GetSystemMetrics(SM_CXFIXEDFRAME),
                                -GetSystemMetrics(SM_CYFIXEDFRAME));
        bsSizeable, bsSizeToolWin:
            InflateRect(Result, -GetSystemMetrics(SM_CXSIZEFRAME),
                                -GetSystemMetrics(SM_CYSIZEFRAME));
      end;
      if BorderStyle in [bsToolWindow, bsSizeToolWin] then
        Result.Bottom := Result.Top + GetSystemMetrics(SM_CYSMCAPTION) - 1
      else
        Result.Bottom := Result.Top + GetSystemMetrics(SM_CYCAPTION) - 1;
    end;
  end; {with}
end;

// Paint the icon for the system menu
procedure TCaptionControl.DrawMenuIcon(DC: HDC; var R: TRect);
var
  Size: Integer;
  TempBmp: TBitmap;
begin
  // Draw system icon by using Windows' DrawCaption function
  // Original source code contributed by Rolf Frei
  with R do
  begin
    Size := Bottom-Top;
    // Drawing is done on a Delphi bitmap.
    TempBmp := TBitmap.Create;
    try
      with TempBmp do
      begin
        Width := Size;
        Height := Size;
        if (FCaptionGradient=cgNone) then
        begin
          if FWindowActive then
            Canvas.Brush.Color := GetSysColor(COLOR_ACTIVECAPTION) else
            Canvas.Brush.Color := GetSysColor(COLOR_INACTIVECAPTION);
        end else
          Canvas.Brush.Color := clBlack;
        DrawCaption(TForm(Owner).Handle, Canvas.Handle, R, DC_ICON);
        if not((FCaptionGradient=cgActive) and (not(FWindowActive))) then
          Canvas.BrushCopy(Canvas.ClipRect, TempBmp, Canvas.Cliprect, clInactiveCaption);
      end;
      BitBlt(DC, Left-2, Top, Size, Size, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      TempBmp.Free;
    end;
    Inc(R.Left, Size-1);
  end;
end;

// Paint the given rectangle with the gradient pattern.
procedure TCaptionControl.FillRectGradient(DC: HDC; const R: TRect; Active: boolean);
var
  OldBrush,
  Brush: HBrush;
  Step: real;
  Band: integer;
  H: integer;
begin
  // Determine how large each band should be in order to cover the
  // rectangle (one band for every color intensity level).
  Step := (R.Right - R.Left) / FColorBands;
  H := R.Bottom - R.Top;
  // Start filling bands
  for Band := 0 to FColorBands-1 do begin
    // Create a brush with the appropriate color for this band
    Brush := CreateSolidBrush(Colors[ord(Active)][Band]);
    // Select that brush into the temporary DC.
    OldBrush := SelectObject(DC, Brush);
    try
      // Fill the rectangle using the selected brush -- PatBlt is faster than FillRect
      PatBlt(DC, round(Band*Step), 0, round((Band+1)*Step), H, PATCOPY);
    finally
      // Clean up the brush
      SelectObject(DC, OldBrush);
      DeleteObject(Brush);
    end;
  end; // for
end;

// Paint the given rectangle with the caption color
procedure TCaptionControl.FillRectCaption(DC: HDC; const R: TRect; Active: boolean);
var
  OldBrush,
  Brush: HBrush;
begin
  if Active then
    Brush := CreateSolidBrush(GetSysColor(COLOR_ACTIVECAPTION))
  else
    Brush := CreateSolidBrush(GetSysColor(COLOR_INACTIVECAPTION));
  OldBrush := SelectObject(DC, Brush);
  PatBlt(DC, R.Left, 0, R.Right, R.Bottom-R.top, PATCOPY);
  SelectObject(DC, OldBrush);
  DeleteObject(Brush);
end;

procedure TCaptionControl.DrawCaptionText(DC: HDC; R: TRect);
var
  OldColor: TColorRef;
  OldMode: integer;
  OldFont: HFont;
  FmtOpt: LongInt;
  Drawn: Boolean;
  Text: String;
begin
  with TForm(Owner) do
  begin
    Inc(R.Left, 2);
    // text color should be white ONLY when there's a gradient
    if (FCaptionGradient=cgNone) then
    begin
      if FWindowActive then
        OldColor := SetTextColor(DC, GetSysColor(COLOR_CAPTIONTEXT)) else
        OldColor := SetTextColor(DC, GetSysColor(COLOR_INACTIVECAPTIONTEXT));
    end else
    if (FCaptionGradient=cgActive) and (not(FWindowActive)) then
      OldColor := SetTextColor(DC, GetSysColor(COLOR_INACTIVECAPTIONTEXT)) else
      OldColor := SetTextColor(DC, RGB(255,255,255));
    OldMode := SetBkMode(DC, TRANSPARENT);
    // Select in the system defined caption font (see Create constructor).
    if CaptionFont <> 0 then
      OldFont := SelectObject(DC, CaptionFont)
    else
      OldFont := 0;
    try
      if FCaptionDirection=dirLeft then
        FmtOpt := DT_LEFT else
        FmtOpt := DT_RIGHT;
      if FRtlReading then FmtOpt := FmtOpt or DT_RTLREADING;
      // Draw the text making it centered vertically, allowing no line breaks.
      Text := Caption;
      if Assigned(FOnDrawCaption) then
      begin
        Drawn := False;
        FOnDrawCaption(Self, Text, DC, R, Drawn);
      end;
      if not(Drawn) then
        DrawText(DC, PChar(Text), -1, R,
          FmtOpt or DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or DT_MODIFYSTRING);
    finally
      // Clean up all the drawing objects.
      if OldFont <> 0 then
        SelectObject(DC, OldFont);
      SetBkMode(DC, OldMode);
      SetTextColor(DC, OldColor);
    end;
  end;
end;

procedure TCaptionControl.DrawCaptionButtons(DC: HDC; var R: TRect);
var
  Flag: UINT;
  TempR: TRect;
  i: Integer;
  Style: LongInt;
  Drawn: Boolean;
  SendR: TRect;
begin
  TempR := R;
  with TForm(Owner) do
  begin
    InflateRect(TempR, -2, -2);
    if BorderStyle in [bsToolWindow, bsSizeToolWin] then begin
      // Tool windows only have the close button, nothing else.
      TempR.Left := TempR.Right - GetSystemMetrics(SM_CXSMSIZE) + 2;
      DrawFrameControl(DC, TempR, DFC_CAPTION, DFCS_CAPTIONCLOSE);
      Dec(R.Right, R.Right-TempR.Left+2);
    end else begin
      { Apparent Window 95 bug - SM_CXSMSIZE and SM_CYSMSIZE always return
        15 - even after size change. We're using the icon's size instead.
        The old line read:
       BtnWidth := GetSystemMetrics(SM_CXSMSIZE)-1;}
      BtnWidth := GetSystemMetrics(SM_CXSMICON)-2;
      TempR.Left := TempR.Right - BtnWidth - 2;
      // if it has system menu, it has a close button.
      if biSystemMenu in BorderIcons then begin
        DrawFrameControl(DC, TempR, DFC_CAPTION, DFCS_CAPTIONCLOSE);
      end;
      // Minimize and Maximized don't show up at all if BorderStyle is bsDialog
      if BorderStyle <> bsDialog then begin
        if (biSystemMenu in BorderIcons) and
          ((biMaximize in BorderIcons) or (biMinimize in BorderIcons)) then
        begin
          if biSystemMenu in BorderIcons then OffsetRect(TempR, -BtnWidth-4, 0);
          if FMaximized then
            Flag := DFCS_CAPTIONRESTORE else
            Flag := DFCS_CAPTIONMAX;
          if not (biMaximize in BorderIcons) then
            Flag := Flag or DFCS_INACTIVE;
          DrawFrameControl(DC, TempR, DFC_CAPTION, Flag);
          OffsetRect(TempR, -BtnWidth-2, 0);

          Flag := DFCS_CAPTIONMIN;
          if not (biMinimize in BorderIcons) then
            Flag := Flag or DFCS_INACTIVE;
          DrawFrameControl(DC, TempR, DFC_CAPTION, Flag);
        end;
      end;
      // Help appears only if no Min/Max buttons appear
      if ((GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_CONTEXTHELP)<>0) and
         ((GetWindowLong(Handle, GWL_STYLE) and (WS_MINIMIZEBOX or WS_MAXIMIZEBOX))=0) then
      begin
        if biSystemMenu in BorderIcons then OffsetRect(TempR, -BtnWidth-4, 0);
        DrawFrameControl(DC, TempR, DFC_CAPTION, DFCS_CAPTIONHELP);
      end;
      if biSystemMenu in BorderIcons then
        Dec(R.Right, R.Right-TempR.Left+2);
      if (FShowButtons) and (Buttons.Count>0) then
      begin
        if FButtonsDirection=dirRight then
        begin
          for i:=0 to Buttons.Count-1 do
            if Buttons[i].Caption='-' then
              Dec(TempR.Left, 4) else
              Dec(TempR.Left, BtnWidth+2);
          R.Right := TempR.Left - 2;
        end else
        begin
          TempR := R;
          InflateRect(TempR, -2, -2);
        end;
        FButtonsLeft := TempR.Left;
        TempR.Right := TempR.Left + BtnWidth + 2;
        for i:=0 to Buttons.Count-1 do
        begin
          Style := DFCS_BUTTONPUSH;
          if (Buttons[i].Pushed) or
             ((Pushed=i) and (DrawPushed) and (Buttons[i].Enabled)) then
            Style := Style or DFCS_PUSHED;
          if Buttons[i].Caption<>'-' then
          begin
            if Buttons[i].Visible then
            begin
              DrawFrameControl(DC, TempR, DFC_BUTTON, Style);
              Drawn := False;
              SendR := TempR;
              if (Buttons[i].Pushed) or
                 ((Pushed=i) and (DrawPushed) and (Buttons[i].Enabled)) then
              begin
                Inc(SendR.Left, 2);
                Inc(SendR.Top, 2);
              end;
              if Assigned(FOnButtonDraw) then
                FOnButtonDraw(Self, i, DC, SendR, Drawn);
              if not(Drawn) then
                Buttons[i].Draw(DC, SendR);
            end;
            if i<Buttons.Count-1 then
              OffsetRect(TempR, BtnWidth+2, 0);
          end else
          begin
            if i<Buttons.Count-1 then
              OffsetRect(TempR, 2, 0);
          end;
        end;
        if FButtonsDirection=dirLeft then
          Inc(R.Left, TempR.Right-R.Left+2);
      end;
    end;
  end;
end;

function TCaptionControl.DrawAllCaption(FormDC: HDC): TRect;
var
  R: TRect;
  OldBmp,
  Bmp: HBitmap;
  BmpDC: HDC;
  W, H: Integer;
begin
  with TForm(Owner) do
  begin
    R := GetCaptionRect;
    Result := R;
    OffsetRect(R, -R.Left, -R.Top);
    W := R.Right - R.Left;
    H := R.Bottom - R.Top;
    { Create a temporary device context to draw on }
    BmpDC := CreateCompatibleDC(FormDC);
    Bmp := CreateCompatibleBitmap(FormDC, W, H);
    OldBmp := SelectObject(BmpDC, Bmp);
    try
      if (FCaptionGradient=cgNone) or
        ((FCaptionGradient=cgActive) and (not(FWindowActive))) then
        FillRectCaption(BmpDC, R, FWindowActive)
      else
        FillRectGradient(BmpDC, R, FWindowActive);
      Inc(R.Left, 1);
      if (biSystemMenu in BorderIcons) and (BorderStyle in [bsSingle, bsSizeable]) then
        DrawMenuIcon(BmpDC, R);
      DrawCaptionButtons(BmpDC, R);
      DrawCaptionText(BmpDC, R);
      BitBlt(FormDC, Result.Left, Result.Top, W, H, BmpDC, 0, 0, SRCCOPY);
    finally
      SelectObject(BmpDC, OldBmp);
      DeleteObject(Bmp);
      DeleteDC(BmpDC);
    end;
  end;
end;

procedure TCaptionControl.SetCaptionDirection(Value: TDirection);
var
  l: LongInt;
begin
  if FCaptionDirection<>Value then
  begin
    FCaptionDirection := Value;
    with Owner as TForm do
    begin
      l:=GetWindowLong(Handle, GWL_EXSTYLE);
      if FCaptionDirection = dirRight then
        l:=(l or WS_EX_RIGHT) else
        l := l and (not(WS_EX_RIGHT));
      SetWindowLong(Handle, GWL_EXSTYLE, l);
    end;
  end;
end;

procedure TCaptionControl.SetButtonsDirection(Value: TDirection);
begin
  if FButtonsDirection<>Value then
  begin
    FButtonsDirection := Value;
    Refresh;
  end;
end;

procedure TCaptionControl.SetWindowDirection(Value: TDirection);
var
  l: LongInt;
begin
  if GetSystemMetrics(SM_MIDEASTENABLED)=0 then
  begin
    if FWindowDirection=dirLeft then Exit;
    FWindowDirection := dirLeft;
    Refresh;
  end;
  if FWindowDirection<>Value then
  begin
    FWindowDirection := Value;
    with Owner as TForm do
    begin
      l:=GetWindowLong(Handle, GWL_EXSTYLE);
      if FWindowDirection = dirRight then
        l:=(l or WS_EX_LEFTSCROLLBAR) else
        l := l and (not(WS_EX_LEFTSCROLLBAR));
      SetWindowLong(Handle, GWL_EXSTYLE, l);
    end;
  end;
end;

procedure TCaptionControl.SetRtlReading(Value: Boolean);
var
  l: LongInt;
begin
  if GetSystemMetrics(SM_MIDEASTENABLED)=0 then
  begin
    if not(FRtlReading) then Exit;
    FRtlReading := False;
    Refresh;
  end;
  if FRtlReading<>Value then
  begin
    FRtlReading := Value;
    with Owner as TForm do
    begin
      l:=GetWindowLong(Handle, GWL_EXSTYLE);
      if FRtlReading=True then
        l:=(l or WS_EX_RTLREADING) else
        l := l and (not (WS_EX_RTLREADING));
      SetWindowLong(Handle, GWL_EXSTYLE, l);
    end;
  end;
end;

procedure TCaptionControl.SetEnabled(Value: Boolean);
begin
  if FEnabled<>Value then
  begin
    FEnabled := Value;
    Refresh;
  end;
end;

procedure TCaptionControl.SetColorBands(Value: Integer);
begin
  if (FColorBands<>Value) and (Value>=8) and (Value<=255) then
  begin
    FColorBands := Value;
    CalculateColors;
    Refresh;
  end;
end;

procedure TCaptionControl.SetPopupMenu(Value: TPopupMenu);
begin
  if Value<>FPopupMenu then
    FPopupMenu := Value;
end;

procedure TCaptionControl.Refresh;
begin
  SetWindowPos(TForm(Owner).Handle, 0, 0, 0, 0, 0,
    SWP_DRAWFRAME or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;

function TCaptionControl.GetCoordButton(Point: TPoint): Integer;
var
  i: Integer;
  R: TRect;
  RealR: TRect;
begin
  Result := -1;
  if Buttons.Count=0 then Exit;
  R := GetCaptionRect;
  R.Left := FButtonsLeft + 2;

  R.Right := R.Left + BtnWidth + 2;
  RealR := R;
  i:=0;
  if (Buttons[i].Caption='-') or
     (not(Buttons[i].Visible)) then
  begin
    RealR.Left := Point.X+1;
    RealR.Top := Point.Y+1;
    RealR.Right := RealR.Left+1;
    RealR.Bottom := RealR.Top+1;
  end;
  while (i<Buttons.Count) and (not(PtInRect(RealR, Point))) do
  begin
    Inc(i);
    if i=Buttons.Count then break;
    if Buttons[i].Caption='-' then
      OffsetRect(R, 2, 0) else
      OffsetRect(R, BtnWidth+2, 0);
    RealR := R;
    if (Buttons[i].Caption='-') or
       (not(Buttons[i].Visible)) then
    begin
      RealR.Left := Point.X+1;
      RealR.Top := Point.Y+1;
      RealR.Right := RealR.Left+1;
      RealR.Bottom := RealR.Top+1;
    end;
  end;
  if i<Buttons.Count then Result := i;
end;

end.