Стартовый пул

ToolBar 2000/Source/.cvsignore

@@ -0,0 +1,5 @@
+*.dcu
+*.dcuil
+*.obj
+*.hpp
+_*

ToolBar 2000/Source/TB2Anim.pas

@@ -0,0 +1,325 @@
+unit TB2Anim;
+
+{$MODE Delphi}
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2008 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2Anim.pas,v 1.13 2008/09/19 16:41:00 jr Exp $
+}
+
+interface
+
+{$I TB2Ver.inc}
+{$Q-}
+
+uses
+  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes;
+
+const
+  WM_TB2K_ANIMATIONENDED = WM_USER + $556;
+
+type
+  TTBAnimationDirection = set of (tbadLeft, tbadRight, tbadDown, tbadUp);
+
+procedure TBStartAnimation(const AWnd: HWND; const ABlend: Boolean;
+  const ADirection: TTBAnimationDirection);
+procedure TBUpdateAnimation;
+procedure TBEndAnimation(const Wnd: HWND);
+function TBIsAnimationInProgress: Boolean;
+
+implementation
+
+uses
+  {$IFDEF CLR} System.Security, System.Runtime.InteropServices, System.Threading, {$ENDIF}
+  TB2Common;
+
+{ Notes to self:
+  - It originally had the NOMIRRORBITMAP flag on the BitBlt calls, because
+    Windows 2000's AnimateWindow function has it. But it had to be removed
+    because on Windows 98 with the Standard VGA or VMware video driver, it
+    caused no bits to be blitted, even though Windows 98 is supposed to
+    support NOMIRRORBITMAP according to the documentation. I don't think it's
+    necessary anyway.
+}
+
+const
+  DCX_USESTYLE = $10000;
+  WS_EX_LAYERED = $80000;
+  NOMIRRORBITMAP = $80000000;
+  ULW_ALPHA = 2;
+
+type
+  PAnimateThreadFuncData = ^TAnimateThreadFuncData;
+  TAnimateThreadFuncData = record
+    FRunning: Boolean;
+    FWnd: HWND;
+    FTime: Integer;
+    FBlending: Boolean;
+    FStartStep, FCurStep: Integer;
+    FStartTime, FLastFrameTime: DWORD;
+    FWndDC, FBmpDC: HDC;
+    FBmp: HBITMAP;
+    FScreenClientRect: TRect;
+    FSize: TSize;
+    FLastPos: TPoint;
+    FDirection: TTBAnimationDirection;
+  end;
+  { Delphi.NET 2007 note: Because TRect/TSize/TPoint are wrongly declared as
+    'packed', fields of these types must be preceded by an Integer- or
+    IntPtr-sized field to ensure correct alignment and avoid an alignment
+    fault on IA-64. }
+
+{$IFNDEF CLR}
+var
+  UpdateLayeredWindowProc: function(Handle: HWND; hdcDest: HDC;
+    pptDst: PPoint; _psize: PSize; hdcSrc: HDC; pptSrc: PPoint;
+    crKey: COLORREF; var pblend: TBLENDFUNCTION; dwFlags: DWORD): BOOL; stdcall;
+{$ELSE}
+{ We can't use Borland.Vcl.Windows' UpdateLayeredWindow because the "pblend"
+  parameter is misdeclared (see QC #25130) }
+[SuppressUnmanagedCodeSecurity, DllImport(user32, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'UpdateLayeredWindow')]
+function UpdateLayeredWindowProc(Handle: HWND; hdcDest: HDC; const pptDst: TPoint;
+  const _psize: TSize; hdcSrc: HDC; const pptSrc: TPoint;
+  crKey: COLORREF; [in] var pblend: TBLENDFUNCTION; dwFlags: DWORD): BOOL; overload; external;
+[SuppressUnmanagedCodeSecurity, DllImport(user32, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'UpdateLayeredWindow')]
+function UpdateLayeredWindowProc(Handle: HWND; hdcDest: HDC; pptDst: IntPtr;
+  _psize: IntPtr; hdcSrc: HDC; pptSrc: IntPtr;
+  crKey: COLORREF; [in] var pblend: TBLENDFUNCTION; dwFlags: DWORD): BOOL; overload; external;
+{$ENDIF}
+
+threadvar
+  AnimateData: TAnimateThreadFuncData;
+
+procedure FinalizeAnimation;
+begin
+  {$IFNDEF CLR}
+  with PAnimateThreadFuncData(@AnimateData)^ do begin
+  {$ELSE}
+  with AnimateData do begin
+  {$ENDIF}
+    FRunning := False;
+    if FBmpDC <> 0 then begin
+      if FBlending then
+        SetWindowLong(FWnd, GWL_EXSTYLE,
+          GetWindowLong(FWnd, GWL_EXSTYLE) and not WS_EX_LAYERED)
+      else
+        SetWindowRgn(FWnd, 0, False);
+      BitBlt(FWndDC, 0, 0, FSize.cx, FSize.cy, FBmpDC, 0, 0, SRCCOPY);
+      DeleteDC(FBmpDC);
+      FBmpDC := 0;
+    end;
+    if FBmp <> 0 then begin
+      DeleteObject(FBmp);
+      FBmp := 0;
+    end;
+    if FWndDC <> 0 then begin
+      ReleaseDC(FWnd, FWndDC);
+      FWndDC := 0;
+    end;
+    if FWnd <> 0 then begin
+      SendNotifyMessage(FWnd, WM_TB2K_ANIMATIONENDED, 0, 0);
+      FWnd := 0;
+    end;
+  end;
+end;
+
+function TBIsAnimationInProgress: Boolean;
+begin
+  Result := AnimateData.FRunning;
+end;
+
+procedure TBEndAnimation(const Wnd: HWND);
+begin
+  if AnimateData.FRunning and
+     ((Wnd = 0) or (AnimateData.FWnd = Wnd)) then
+    FinalizeAnimation;
+end;
+
+procedure TBStartAnimation(const AWnd: HWND; const ABlend: Boolean;
+  const ADirection: TTBAnimationDirection);
+var
+  ZeroPt: TPoint;
+  R: TRect;
+  Blend: TBlendFunction;
+  Rgn: HRGN;
+begin
+  FinalizeAnimation;
+
+  ZeroPt.X := 0;
+  ZeroPt.Y := 0;
+
+  try
+    {$IFNDEF CLR}
+    { Note: The pointer cast avoids GetTls calls for every field access }
+    with PAnimateThreadFuncData(@AnimateData)^ do begin
+    {$ELSE}
+    with AnimateData do begin
+    {$ENDIF}
+      FWnd := AWnd;
+      FBlending := ABlend and {$IFNDEF CLR} Assigned(UpdateLayeredWindowProc)
+        {$ELSE} (Win32MajorVersion >= 5) {$ENDIF};
+      FDirection := ADirection;
+      GetCursorPos(FLastPos);
+      GetClientRect(FWnd, FScreenClientRect);
+      MapWindowPoints(FWnd, 0, FScreenClientRect, 2);
+      GetWindowRect(FWnd, R);
+      FWndDC := GetDCEx(FWnd, 0, DCX_WINDOW or DCX_CACHE {or DCX_USESTYLE ?});
+      if FWndDC = 0 then
+        RaiseLastOSError;
+      FSize.cx := R.Right - R.Left;
+      FSize.cy := R.Bottom - R.Top;
+      FBmp := CreateCompatibleBitmap(FWndDC, FSize.cx, FSize.cy {or $01000000 ?});
+      if FBmp = 0 then
+        RaiseLastOSError;
+      FBmpDC := CreateCompatibleDC(FWndDC);
+      if FBmpDC = 0 then
+        RaiseLastOSError;
+      // AnimateWindow calls SetLayout, but I'm not sure that we need to.
+      //if Assigned(SetLayoutProc) then
+      //  SetLayoutProc(FBmpDC, 0);
+      SelectObject(FBmpDC, FBmp);
+      //SetBoundsRect(FBmpDC, nil, DCB_RESET or DCB_ENABLE);
+      SendMessage(FWnd, WM_PRINT, WPARAM(FBmpDC), PRF_NONCLIENT or PRF_CLIENT or
+        PRF_ERASEBKGND or PRF_CHILDREN);
+      //GetBoundsRect
+      if FBlending then begin
+        SetWindowLong(FWnd, GWL_EXSTYLE, GetWindowLong(FWnd, GWL_EXSTYLE) or WS_EX_LAYERED);
+        FTime := 175;  { actually more like ~147 because FCurStep starts at 40 }
+        FCurStep := 40;
+        Blend.BlendOp := AC_SRC_OVER;
+        Blend.BlendFlags := 0;
+        Blend.SourceConstantAlpha := FCurStep;
+        Blend.AlphaFormat := 0;
+        Win32Check(UpdateLayeredWindowProc(FWnd, 0, {$IFNDEF CLR}@{$ENDIF} R.TopLeft,
+          {$IFNDEF CLR}@{$ENDIF} FSize, FBmpDC, {$IFNDEF CLR}@{$ENDIF} ZeroPt,
+          0, Blend, ULW_ALPHA));
+      end
+      else begin
+        FTime := 150;
+        FCurStep := 0;
+        Rgn := CreateRectRgn(0, 0, 0, 0);
+        if not BOOL(SetWindowRgn(FWnd, Rgn, False)) then
+          DeleteObject(Rgn);  { just in case }
+      end;
+      FStartStep := FCurStep;
+      FStartTime := GetTickCount;
+      FLastFrameTime := FStartTime;
+      { These are the same flags AnimateWindow uses. SWP_ASYNCWINDOWPOS is
+        needed or else it doesn't "save bits" properly.
+        Note: SWP_ASYNCWINDOWPOS seems to have no effect on Windows 95 & NT 4.0,
+        so bits behind the window are not saved & restored correctly. }
+      SetWindowPos(FWnd, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or
+        SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOREDRAW or
+        SWP_NOOWNERZORDER or SWP_ASYNCWINDOWPOS);
+      FRunning := True;
+    end;
+  except
+    FinalizeAnimation;
+    raise;
+  end;
+end;
+
+procedure TBUpdateAnimation;
+var
+  ThisFrameTime: DWORD;
+  ElapsedTime, NewStep: Integer;
+  P: TPoint;
+  Blend: TBlendFunction;
+  X, Y: Integer;
+  Rgn: HRGN;
+begin
+  {$IFNDEF CLR}
+  with PAnimateThreadFuncData(@AnimateData)^ do begin
+  {$ELSE}
+  with AnimateData do begin
+  {$ENDIF}
+    if not FRunning then
+      Exit;
+
+    { If 10 msec hasn't passed since the last call, exit. We don't want to
+      monopolize the CPU. }
+    ThisFrameTime := GetTickCount;
+    if ThisFrameTime - FLastFrameTime < 10 then
+      Exit;
+    FLastFrameTime := ThisFrameTime;
+
+    ElapsedTime := ThisFrameTime - FStartTime;
+    if (ElapsedTime < 0) or (ElapsedTime >= FTime) then begin
+      FinalizeAnimation;
+      Exit;
+    end;
+    NewStep := FStartStep + ((255 * ElapsedTime) div FTime);
+    if (NewStep < 0) or (NewStep >= 255) then begin
+      FinalizeAnimation;
+      Exit;
+    end;
+
+    GetCursorPos(P);
+    if (P.X <> FLastPos.X) or (P.Y <> FLastPos.Y) then begin
+      if PtInRect(FScreenClientRect, P) then begin
+        FinalizeAnimation;
+        Exit;
+      end;
+      FLastPos := P;
+    end;
+
+    if NewStep > FCurStep then begin
+      FCurStep := NewStep;
+      if FBlending then begin
+        Blend.BlendOp := AC_SRC_OVER;
+        Blend.BlendFlags := 0;
+        Blend.SourceConstantAlpha := NewStep;
+        Blend.AlphaFormat := 0;
+        UpdateLayeredWindowProc(FWnd, 0, nil, nil, 0, nil, 0, Blend, ULW_ALPHA);
+      end
+      else begin
+        if tbadDown in FDirection then
+          Y := MulDiv(FSize.cy, NewStep, 255) - FSize.cy
+        else if tbadUp in FDirection then
+          Y := FSize.cy - MulDiv(FSize.cy, NewStep, 255)
+        else
+          Y := 0;
+        if tbadRight in FDirection then
+          X := MulDiv(FSize.cx, NewStep, 255) - FSize.cx
+        else if tbadLeft in FDirection then
+          X := FSize.cx - MulDiv(FSize.cx, NewStep, 255)
+        else
+          X := 0;
+        Rgn := CreateRectRgn(X, Y, X + FSize.cx, Y + FSize.cy);
+        if not BOOL(SetWindowRgn(FWnd, Rgn, False)) then
+          DeleteObject(Rgn);  { just in case }
+        BitBlt(FWndDC, X, Y, FSize.cx, FSize.cy, FBmpDC, 0, 0, SRCCOPY);
+      end;
+    end;
+  end;
+end;
+
+initialization
+  {$IFNDEF CLR}
+  UpdateLayeredWindowProc := GetProcAddress(GetModuleHandle(user32),
+    'UpdateLayeredWindow');
+  {$ENDIF}
+finalization
+  FinalizeAnimation;
+end.

ToolBar 2000/Source/TB2Consts.pas

@@ -0,0 +1,37 @@
+unit TB2Consts;
+
+{$MODE Delphi}
+
+{ $jrsoftware: tb2k/Source/TB2Consts.pas,v 1.8 2006/03/12 23:11:58 jr Exp $ }
+
+interface
+
+{$I TB2Ver.inc}
+
+resourcestring
+  { Exceptions }
+  STBToolbarIndexOutOfBounds = 'Toolbar item index out of range';
+  STBToolbarItemReinserted = 'Toolbar item already inserted';
+  STBToolbarItemParentInvalid = 'Toolbar item cannot be inserted into container of type %s'; 
+  STBViewerNotFound = 'An item viewer associated the specified item could not be found';
+
+  { TTBChevronItem }
+  STBChevronItemMoreButtonsHint = 'More Buttons|';
+
+  { TTBMRUListItem }
+  STBMRUListItemDefCaption = '(MRU List)';
+
+  { TTBMDIWindowItem }
+  STBMDIWindowItemDefCaption = '(Window List)';
+
+  { TTBDock exception messages }
+  STBDockParentNotAllowed = 'A TTBDock control cannot be placed inside a tool window or another TTBDock';
+  STBDockCannotChangePosition = 'Cannot change Position of a TTBDock if it already contains controls';
+
+  { TTBCustomDockableWindow exception messages }
+  STBToolwinNameNotSet = 'Cannot save dockable window''s position because Name property is not set';
+  STBToolwinDockedToNameNotSet = 'Cannot save dockable window''s position because DockedTo''s Name property not set';
+
+implementation
+
+end.

ToolBar 2000/Source/TB2DsgnConvertOptions.dfm.txt

@@ -0,0 +1,65 @@
+object TBConvertOptionsForm: TTBConvertOptionsForm
+  Left = 225
+  Top = 133
+  BorderIcons = [biSystemMenu, biMinimize]
+  BorderStyle = bsDialog
+  Caption = 'Convert Menu'
+  ClientHeight = 90
+  ClientWidth = 249
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poScreenCenter
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Label1: TLabel
+    Left = 8
+    Top = 8
+    Width = 81
+    Height = 13
+    Caption = '&Menu to convert:'
+    FocusControl = MenuCombo
+  end
+  object MenuCombo: TComboBox
+    Left = 8
+    Top = 24
+    Width = 233
+    Height = 21
+    Style = csDropDownList
+    ItemHeight = 13
+    TabOrder = 0
+  end
+  object ConvertButton: TButton
+    Left = 8
+    Top = 57
+    Width = 73
+    Height = 23
+    Caption = '&Convert'
+    Default = True
+    ModalResult = 1
+    TabOrder = 1
+  end
+  object HelpButton: TButton
+    Left = 168
+    Top = 57
+    Width = 73
+    Height = 23
+    Caption = '&Help'
+    TabOrder = 2
+    OnClick = HelpButtonClick
+  end
+  object Button1: TButton
+    Left = 88
+    Top = 57
+    Width = 73
+    Height = 23
+    Cancel = True
+    Caption = 'Cancel'
+    ModalResult = 2
+    TabOrder = 3
+  end
+end

ToolBar 2000/Source/TB2DsgnConvertOptions.pas

@@ -0,0 +1,67 @@
+unit TB2DsgnConvertOptions;
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2005 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2DsgnConvertOptions.pas,v 1.6 2005/01/06 03:56:50 jr Exp $
+}
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls;
+
+type
+  TTBConvertOptionsForm = class(TForm)
+    MenuCombo: TComboBox;
+    Label1: TLabel;
+    ConvertButton: TButton;
+    HelpButton: TButton;
+    Button1: TButton;
+    procedure HelpButtonClick(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+implementation
+
+{$R *.DFM}
+
+procedure TTBConvertOptionsForm.HelpButtonClick(Sender: TObject);
+const
+  SMsg1 = 'This will import the contents of a TMainMenu or TPopupMenu ' +
+    'component on the form.'#13#10#13#10 +
+    'The new items will take the names of the old menu ' +
+    'items. The old menu items will have "_OLD" appended to the end of ' +
+    'their names.'#13#10#13#10 +
+    'After the conversion process completes, you should verify that ' +
+    'everything was copied correctly. Afterward, you may delete the ' +
+    'old menu component.';
+begin
+  Application.MessageBox(SMsg1, 'Convert Help', MB_OK or MB_ICONINFORMATION);
+end;
+
+end.

ToolBar 2000/Source/TB2DsgnConverter.dfm.txt

@@ -0,0 +1,51 @@
+object TBConverterForm: TTBConverterForm
+  Left = 200
+  Top = 104
+  AutoScroll = False
+  Caption = 'Conversion Status'
+  ClientHeight = 218
+  ClientWidth = 425
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = True
+  Position = poScreenCenter
+  OnClose = FormClose
+  PixelsPerInch = 96
+  TextHeight = 13
+  object MessageList: TListBox
+    Left = 8
+    Top = 8
+    Width = 409
+    Height = 169
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    ItemHeight = 13
+    TabOrder = 0
+  end
+  object CloseButton: TButton
+    Left = 176
+    Top = 185
+    Width = 73
+    Height = 23
+    Anchors = [akRight, akBottom]
+    Cancel = True
+    Caption = '&Close'
+    Enabled = False
+    TabOrder = 1
+    OnClick = CloseButtonClick
+  end
+  object CopyButton: TButton
+    Left = 256
+    Top = 185
+    Width = 161
+    Height = 23
+    Anchors = [akRight, akBottom]
+    Caption = 'C&opy Messages to Clipboard'
+    Enabled = False
+    TabOrder = 2
+    OnClick = CopyButtonClick
+  end
+end

ToolBar 2000/Source/TB2DsgnConverter.pas

@@ -0,0 +1,217 @@
+unit TB2DsgnConverter;
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2005 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2DsgnConverter.pas,v 1.16 2005/01/06 03:56:50 jr Exp $
+}
+
+interface
+
+{$I TB2Ver.inc}
+
+uses
+  Windows, SysUtils, Classes, Controls, Forms, Menus, StdCtrls,
+  TB2Item;
+
+type
+  TTBConverterForm = class(TForm)
+    MessageList: TListBox;
+    CloseButton: TButton;
+    CopyButton: TButton;
+    procedure CloseButtonClick(Sender: TObject);
+    procedure CopyButtonClick(Sender: TObject);
+    procedure FormClose(Sender: TObject; var Action: TCloseAction);
+  end;
+
+procedure DoConvert(const ParentItem: TTBCustomItem; const Owner: TComponent);
+
+implementation
+
+{$R *.DFM}
+
+uses
+  Clipbrd, TB2DsgnConvertOptions;
+
+procedure DoConvert(const ParentItem: TTBCustomItem; const Owner: TComponent);
+const
+  SPropNotTransferred = 'Warning: %s property not transferred on ''%s''.';
+var
+  ConverterForm: TTBConverterForm;
+
+  procedure Log(const S: String);
+  begin
+    ConverterForm.MessageList.Items.Add(S);
+    ConverterForm.MessageList.TopIndex := ConverterForm.MessageList.Items.Count-1; 
+    ConverterForm.Update;
+  end;
+
+  procedure Recurse(MenuItem: TMenuItem; TBItem: TTBCustomItem);
+  var
+    I: Integer;
+    Src: TMenuItem;
+    IsSep, IsSubmenu: Boolean;
+    Dst: TTBCustomItem;
+    N: String;
+  begin
+    for I := 0 to MenuItem.Count-1 do begin
+      Src := MenuItem[I];
+      IsSep := (Src.Caption = '-');
+      IsSubmenu := False;
+      if not IsSep then begin
+        if Src.Count > 0 then
+          IsSubmenu := True;
+        if not IsSubmenu then
+          Dst := TTBItem.Create(Owner)
+        else
+          Dst := TTBSubmenuItem.Create(Owner);
+        Dst.Action := Src.Action;
+        {$IFDEF JR_D6}
+        Dst.AutoCheck := Src.AutoCheck;
+        {$ENDIF}
+        Dst.Caption := Src.Caption;
+        Dst.Checked := Src.Checked;
+        if Src.Default then
+          Dst.Options := Dst.Options + [tboDefault];
+        Dst.Enabled := Src.Enabled;
+        Dst.GroupIndex := Src.GroupIndex;
+        Dst.HelpContext := Src.HelpContext;
+        Dst.ImageIndex := Src.ImageIndex;
+        Dst.RadioItem := Src.RadioItem;
+        Dst.ShortCut := Src.ShortCut;
+        {$IFDEF JR_D5}
+        Dst.SubMenuImages := Src.SubMenuImages;
+        {$ENDIF}
+        Dst.OnClick := Src.OnClick;
+      end
+      else begin
+        Dst := TTBSeparatorItem.Create(Owner);
+      end;
+      Dst.Hint := Src.Hint;
+      Dst.Tag := Src.Tag;
+      Dst.Visible := Src.Visible;
+      if not IsSep then
+        { Temporarily clear the menu item's OnClick property, so that renaming
+          the menu item doesn't cause the function name to change }
+        Src.OnClick := nil;
+      try
+        N := Src.Name;
+        Src.Name := N + '_OLD';
+        Dst.Name := N;
+      finally
+        if not IsSep then
+          Src.OnClick := Dst.OnClick;
+      end;
+      TBItem.Add(Dst);
+      {$IFDEF JR_D5}
+      if @Src.OnAdvancedDrawItem <> nil then
+        Log(Format(SPropNotTransferred, ['OnAdvancedDrawItem', Dst.Name]));
+      {$ENDIF}
+      if @Src.OnDrawItem <> nil then
+        Log(Format(SPropNotTransferred, ['OnDrawItem', Dst.Name]));
+      if @Src.OnMeasureItem <> nil then
+        Log(Format(SPropNotTransferred, ['OnMeasureItem', Dst.Name]));
+      if IsSubmenu then
+        Recurse(Src, Dst);
+    end;
+  end;
+
+var
+  OptionsForm: TTBConvertOptionsForm;
+  I: Integer;
+  C: TComponent;
+  Menu: TMenu;
+begin
+  Menu := nil;
+  OptionsForm := TTBConvertOptionsForm.Create(Application);
+  try
+    for I := 0 to Owner.ComponentCount-1 do begin
+      C := Owner.Components[I];
+      if (C is TMenu) and not(C is TTBPopupMenu) then
+        OptionsForm.MenuCombo.Items.AddObject(C.Name, C);
+    end;
+    if OptionsForm.MenuCombo.Items.Count = 0 then
+      raise Exception.Create('Could not find any menus on the form to convert');
+    OptionsForm.MenuCombo.ItemIndex := 0;
+    if (OptionsForm.ShowModal <> mrOK) or (OptionsForm.MenuCombo.ItemIndex < 0) then
+      Exit;
+    Menu := TMenu(OptionsForm.MenuCombo.Items.Objects[OptionsForm.MenuCombo.ItemIndex]);
+  finally
+    OptionsForm.Free;
+  end;
+  ParentItem.SubMenuImages := Menu.Images;
+  ConverterForm := TTBConverterForm.Create(Application);
+  ConverterForm.Show;
+  ConverterForm.Update;
+  Log(Format('Converting ''%s'', please wait...', [Menu.Name]));
+  ParentItem.ViewBeginUpdate;
+  try
+    Recurse(Menu.Items, ParentItem);
+  finally
+    ParentItem.ViewEndUpdate;
+  end;
+  Log('Done!');
+  ConverterForm.CloseButton.Enabled := True;
+  ConverterForm.CopyButton.Enabled := True;
+end;
+
+
+{ TTBConverterForm }
+
+procedure TTBConverterForm.FormClose(Sender: TObject;
+  var Action: TCloseAction);
+begin
+  Action := caFree;
+end;
+
+procedure TTBConverterForm.CloseButtonClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TTBConverterForm.CopyButtonClick(Sender: TObject);
+begin
+  Clipboard.AsText := MessageList.Items.Text;
+end;
+
+
+procedure FreeConverterForms;
+var
+  I: Integer;
+  Form: TCustomForm;
+label Restart;
+begin
+  Restart:
+  for I := 0 to Screen.CustomFormCount-1 do begin
+    Form := Screen.CustomForms[I];
+    if Form is TTBConverterForm then begin
+      Form.Free;
+      goto Restart;
+    end;
+  end;
+end;
+
+initialization
+finalization
+  FreeConverterForms;
+end.

ToolBar 2000/Source/TB2DsgnItemEditor.dfm.txt

@@ -0,0 +1,184 @@
+object TBItemEditForm: TTBItemEditForm
+  Left = 200
+  Top = 104
+  AutoScroll = False
+  BorderIcons = [biSystemMenu, biMinimize]
+  ClientHeight = 247
+  ClientWidth = 440
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = True
+  Position = poScreenCenter
+  OnActivate = FormActivate
+  OnClose = FormClose
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Splitter1: TSplitter
+    Left = 129
+    Top = 19
+    Width = 3
+    Height = 228
+    Cursor = crHSplit
+    ResizeStyle = rsUpdate
+  end
+  object TreeView: TTreeView
+    Left = 0
+    Top = 19
+    Width = 129
+    Height = 228
+    Align = alLeft
+    HideSelection = False
+    Indent = 19
+    ReadOnly = True
+    ShowRoot = False
+    TabOrder = 2
+    OnChange = TreeViewChange
+    OnDragDrop = TreeViewDragDrop
+    OnDragOver = TreeViewDragOver
+    OnEnter = TreeViewEnter
+    OnKeyDown = TreeViewKeyDown
+    OnKeyPress = TreeViewKeyPress
+  end
+  object ListView: TListView
+    Left = 132
+    Top = 19
+    Width = 308
+    Height = 228
+    Align = alClient
+    Columns = <
+      item
+        Caption = 'Caption'
+        Width = 160
+      end
+      item
+        Caption = 'Type'
+        Width = 120
+      end>
+    ColumnClick = False
+    DragMode = dmAutomatic
+    HideSelection = False
+    MultiSelect = True
+    ReadOnly = True
+    RowSelect = True
+    PopupMenu = TBPopupMenu1
+    TabOrder = 1
+    ViewStyle = vsReport
+    OnChange = ListViewChange
+    OnDblClick = ListViewDblClick
+    OnEnter = ListViewEnter
+    OnDragDrop = ListViewDragDrop
+    OnDragOver = ListViewDragOver
+    OnKeyDown = ListViewKeyDown
+    OnKeyPress = ListViewKeyPress
+  end
+  object Toolbar: TTBToolbar
+    Left = 0
+    Top = 0
+    Width = 440
+    Height = 19
+    Align = alTop
+    Caption = 'Toolbar'
+    DockPos = 0
+    FullSize = True
+    LinkSubitems = ToolbarItems
+    ParentShowHint = False
+    ShowHint = True
+    TabOrder = 0
+  end
+  object TBPopupMenu1: TTBPopupMenu
+    LinkSubitems = ToolbarItems
+    Left = 256
+    Top = 120
+  end
+  object TBItemContainer1: TTBItemContainer
+    Left = 224
+    Top = 120
+    object ToolbarItems: TTBSubmenuItem
+      object NewItemButton: TTBItem
+        Caption = 'New &Item'
+        Hint = 'New Item'
+        ImageIndex = 0
+        ShortCut = 45
+        OnClick = NewItemButtonClick
+      end
+      object NewSubmenuButton: TTBItem
+        Caption = 'New &Submenu'
+        Hint = 'New Submenu'
+        ImageIndex = 1
+        ShortCut = 16429
+        OnClick = NewSubmenuButtonClick
+      end
+      object NewSepButton: TTBItem
+        Caption = 'New Se&parator'
+        Hint = 'New Separator'
+        ImageIndex = 2
+        ShortCut = 189
+        OnClick = NewSepButtonClick
+      end
+      object MoreMenu: TTBSubmenuItem
+        Caption = '&More'
+        Options = [tboDropdownArrow]
+      end
+      object TBSeparatorItem1: TTBSeparatorItem
+      end
+      object CutButton: TTBItem
+        Caption = 'Cu&t'
+        Enabled = False
+        Hint = 'Cut'
+        ImageIndex = 5
+        OnClick = CutButtonClick
+      end
+      object CopyButton: TTBItem
+        Caption = '&Copy'
+        Enabled = False
+        Hint = 'Copy'
+        ImageIndex = 4
+        OnClick = CopyButtonClick
+      end
+      object PasteButton: TTBItem
+        Caption = '&Paste'
+        Hint = 'Paste'
+        ImageIndex = 6
+        OnClick = PasteButtonClick
+      end
+      object DeleteButton: TTBItem
+        Caption = '&Delete Item'
+        Enabled = False
+        Hint = 'Delete Item'
+        ImageIndex = 3
+        ShortCut = 46
+        OnClick = DeleteButtonClick
+      end
+      object TBSeparatorItem2: TTBSeparatorItem
+      end
+      object MoveUpButton: TTBItem
+        Caption = 'Move &Up'
+        Hint = 'Move Up'
+        ImageIndex = 7
+        ShortCut = 32806
+        OnClick = MoveUpButtonClick
+      end
+      object MoveDownButton: TTBItem
+        Caption = 'Move D&own'
+        Hint = 'Move Down'
+        ImageIndex = 8
+        ShortCut = 32808
+        OnClick = MoveDownButtonClick
+      end
+      object TBSeparatorItem3: TTBSeparatorItem
+      end
+      object TBSubmenuItem1: TTBSubmenuItem
+        Caption = '&Tools'
+        Options = [tboDropdownArrow]
+        object TConvertMenu: TTBItem
+          Caption = '&Convert TMainMenu/TPopupMenu...'
+          OnClick = TConvertMenuClick
+        end
+      end
+    end
+  end
+end

ToolBar 2000/Source/TB2ExtItems.pas

@@ -0,0 +1,992 @@
+unit TB2ExtItems;
+
+{$MODE Delphi}
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2008 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2ExtItems.pas,v 1.68 2008/04/10 21:51:12 jr Exp $
+}
+
+interface
+
+{$I TB2Ver.inc}
+
+uses
+  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, CommCtrl, Menus, ActnList,
+  TB2Item;
+
+type
+  TTBEditItemOption = (tboUseEditWhenVertical);
+  TTBEditItemOptions = set of TTBEditItemOption;
+
+const
+  EditItemDefaultEditOptions = [];
+  EditItemDefaultEditWidth = 64;
+
+type
+  TTBEditItem = class;
+  TTBEditItemViewer = class;
+
+  TTBAcceptTextEvent = procedure(Sender: TObject; var NewText: String;
+    var Accept: Boolean) of object;
+  TTBBeginEditEvent = procedure(Sender: TTBEditItem; Viewer: TTBEditItemViewer;
+    EditControl: TEdit) of object;
+
+  TTBEditAction = class(TAction)
+  private
+    FEditOptions: TTBEditItemOptions;
+    FEditCaption: String;
+    FEditWidth: Integer;
+    FOnAcceptText: TTBAcceptTextEvent;
+    FText: String;
+    procedure SetEditCaption(Value: String);
+    procedure SetEditOptions(Value: TTBEditItemOptions);
+    procedure SetEditWidth(Value: Integer);
+    procedure SetOnAcceptText(Value: TTBAcceptTextEvent);
+    procedure SetText(Value: String);
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property EditCaption: String read FEditCaption write SetEditCaption;
+    property EditOptions: TTBEditItemOptions read FEditOptions write SetEditOptions default EditItemDefaultEditOptions;
+    property EditWidth: Integer read FEditWidth write SetEditWidth default EditItemDefaultEditWidth;
+    property Text: String read FText write SetText;
+
+    property OnAcceptText: TTBAcceptTextEvent read FOnAcceptText write SetOnAcceptText;
+  end;
+
+  TTBEditItemActionLink = class(TTBCustomItemActionLink)
+  protected
+    procedure AssignClient(AClient: TObject); override;
+    function IsEditCaptionLinked: Boolean; virtual;
+    function IsEditOptionsLinked: Boolean; virtual;
+    function IsEditWidthLinked: Boolean; virtual;
+    function IsOnAcceptTextLinked: Boolean; virtual;
+    function IsTextLinked: Boolean; virtual;
+    procedure SetEditCaption(const Value: String); virtual;
+    procedure SetEditOptions(Value: TTBEditItemOptions); virtual;
+    procedure SetEditWidth(const Value: Integer); virtual;
+    procedure SetOnAcceptText(Value: TTBAcceptTextEvent); virtual;
+    procedure SetText(const Value: String); virtual;
+  end;
+
+  TTBEditItem = class(TTBCustomItem)
+  private
+    FCharCase: TEditCharCase;
+    FEditCaption: String;
+    FEditOptions: TTBEditItemOptions;
+    FEditWidth: Integer;
+    FMaxLength: Integer;
+    FOnAcceptText: TTBAcceptTextEvent;
+    FOnBeginEdit: TTBBeginEditEvent;
+    FText: String;
+    function IsEditCaptionStored: Boolean;
+    function IsEditOptionsStored: Boolean;
+    function IsEditWidthStored: Boolean;
+    function IsTextStored: Boolean;
+    procedure SetCharCase(Value: TEditCharCase);
+    procedure SetEditCaption(Value: String);
+    procedure SetEditOptions(Value: TTBEditItemOptions);
+    procedure SetEditWidth(Value: Integer);
+    procedure SetMaxLength(Value: Integer);
+    procedure SetText(Value: String);
+  protected
+    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+    procedure DoBeginEdit(Viewer: TTBEditItemViewer); virtual;
+    function GetActionLinkClass: TTBCustomItemActionLinkClass; override;
+    function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
+    function NeedToRecreateViewer(AViewer: TTBItemViewer): Boolean; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Clear;
+    procedure Click; override;
+  published
+    property Action;
+    property AutoCheck;
+    property Caption;
+    property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
+    property Checked;
+    property DisplayMode;
+    property EditCaption: String read FEditCaption write SetEditCaption stored IsEditCaptionStored;
+    property EditOptions: TTBEditItemOptions read FEditOptions write SetEditOptions stored IsEditOptionsStored;
+    property EditWidth: Integer read FEditWidth write SetEditWidth stored IsEditWidthStored;
+    property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
+    property Enabled;
+    property GroupIndex;
+    property HelpContext;
+    property Hint;
+    property ImageIndex;
+    property InheritOptions;
+    property MaskOptions;
+    property Options;
+    property RadioItem;
+    property ShortCut;
+    property Text: String read FText write SetText stored IsTextStored;
+    property Visible;
+
+    property OnAcceptText: TTBAcceptTextEvent read FOnAcceptText write FOnAcceptText;
+    property OnBeginEdit: TTBBeginEditEvent read FOnBeginEdit write FOnBeginEdit;
+    property OnClick;
+    property OnSelect;
+  end;
+
+  TTBEditItemViewer = class(TTBItemViewer)
+  private
+    FEditControl: TEdit;
+    FEditControlStatus: set of (ecsContinueLoop, ecsAccept, ecsClose);
+    function EditLoop(const CapHandle: HWND): Boolean;
+    procedure EditWndProc(var Message: TMessage);
+    procedure MouseBeginEdit;
+  protected
+    procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer);
+      override;
+    function CaptionShown: Boolean; override;
+    function DoExecute: Boolean; override;
+    function GetAccRole: Integer; override;
+    function GetAccValue(var Value: WideString): Boolean; override;
+    function GetCaptionText: String; override;
+    procedure GetCursor(const Pt: TPoint; var ACursor: HCURSOR); override;
+    procedure GetEditRect(var R: TRect); virtual;
+    procedure MouseDown(Shift: TShiftState; X, Y: Integer;
+      var MouseDownOnMenu: Boolean); override;
+    procedure MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean); override;
+    procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect;
+      IsSelected, IsPushed, UseDisabledShadow: Boolean); override;
+    function UsesSameWidth: Boolean; override;
+  public
+    property EditControl: TEdit read FEditControl;
+  end;
+
+  { TTBVisibilityToggleItem }
+
+  TTBVisibilityToggleItem = class(TTBCustomItem)
+  private
+    FControl: TControl;
+    procedure SetControl(Value: TControl);
+    procedure UpdateProps;
+  protected
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  public
+    procedure Click; override;
+    procedure InitiateAction; override;
+  published
+    property Caption;
+    property Control: TControl read FControl write SetControl;
+    property DisplayMode;
+    property Enabled;
+    property HelpContext;
+    property Hint;
+    property ImageIndex;
+    property Images;
+    property InheritOptions;
+    property MaskOptions;
+    property Options;
+    property ShortCut;
+    property Visible;
+
+    property OnClick;
+    property OnSelect;
+  end;
+  
+
+implementation
+
+uses
+  TB2Common, TB2Consts;
+
+const
+  EditMenuTextMargin = 3;
+  EditMenuMidWidth = 4;
+
+type
+  TControlAccess = class(TControl);
+  TEditAccess = {$IFNDEF CLR} class(TEdit) {$ELSE} IControl {$ENDIF};
+
+
+{ TTBEditAction }
+
+constructor TTBEditAction.Create(AOwner: TComponent);
+begin
+  inherited;
+  FEditOptions := EditItemDefaultEditOptions;
+  FEditWidth := EditItemDefaultEditWidth;
+  DisableIfNoHandler := False;
+end;
+
+procedure TTBEditAction.SetEditCaption(Value: String);
+var
+  I: Integer;
+begin
+  if FEditCaption <> Value then begin
+    for I := 0 to FClients.Count - 1 do
+      if TBasicActionLink(FClients[I]) is TTBEditItemActionLink then
+        TTBEditItemActionLink(FClients[I]).SetEditCaption(Value);
+    FEditCaption := Value;
+    Change;
+  end;
+end;
+
+procedure TTBEditAction.SetEditOptions(Value: TTBEditItemOptions);
+var
+  I: Integer;
+begin
+  if FEditOptions <> Value then begin
+    for I := 0 to FClients.Count - 1 do
+      if TBasicActionLink(FClients[I]) is TTBEditItemActionLink then
+        TTBEditItemActionLink(FClients[I]).SetEditOptions(Value);
+    FEditOptions := Value;
+    Change;
+  end;
+end;
+
+procedure TTBEditAction.SetEditWidth(Value: Integer);
+var
+  I: Integer;
+begin
+  if FEditWidth <> Value then begin
+    for I := 0 to FClients.Count - 1 do
+      if TBasicActionLink(FClients[I]) is TTBEditItemActionLink then
+        TTBEditItemActionLink(FClients[I]).SetEditWidth(Value);
+    FEditWidth := Value;
+    Change;
+  end;
+end;
+
+procedure TTBEditAction.SetOnAcceptText(Value: TTBAcceptTextEvent);
+var
+  I: Integer;
+begin
+  {$IFNDEF CLR}
+  if not MethodsEqual(TMethod(FOnAcceptText), TMethod(Value)) then begin
+  {$ELSE}
+  if @FOnAcceptText <> @Value then begin
+  {$ENDIF}
+    for I := 0 to FClients.Count - 1 do
+      if TBasicActionLink(FClients[I]) is TTBEditItemActionLink then
+        TTBEditItemActionLink(FClients[I]).SetOnAcceptText(Value);
+    FOnAcceptText := Value;
+    Change;
+  end;
+end;
+
+procedure TTBEditAction.SetText(Value: String);
+var
+  I: Integer;
+begin
+  if FText <> Value then begin
+    for I := 0 to FClients.Count - 1 do
+      if TBasicActionLink(FClients[I]) is TTBEditItemActionLink then
+        TTBEditItemActionLink(FClients[I]).SetText(Value);
+    FText := Value;
+    Change;
+  end;
+end;
+
+
+{ TTBEditItemActionLink }
+
+procedure TTBEditItemActionLink.AssignClient(AClient: TObject);
+begin
+  FClient := AClient as TTBEditItem;
+end;
+
+function TTBEditItemActionLink.IsEditCaptionLinked: Boolean;
+begin
+  if Action is TTBEditAction then
+    Result := TTBEditItem(FClient).EditCaption = TTBEditAction(Action).EditCaption
+  else
+    Result := False;
+end;
+
+function TTBEditItemActionLink.IsEditOptionsLinked: Boolean;
+begin
+  if Action is TTBEditAction then
+    Result := TTBEditItem(FClient).EditOptions = TTBEditAction(Action).EditOptions
+  else
+    Result := False;
+end;
+
+function TTBEditItemActionLink.IsEditWidthLinked: Boolean;
+begin
+  if Action is TTBEditAction then
+    Result := TTBEditItem(FClient).EditWidth = TTBEditAction(Action).EditWidth
+  else
+    Result := False;
+end;
+
+function TTBEditItemActionLink.IsOnAcceptTextLinked: Boolean;
+begin
+  if Action is TTBEditAction then
+    {$IFNDEF CLR}
+    Result := MethodsEqual(TMethod(TTBEditItem(FClient).OnAcceptText),
+      TMethod(TTBEditAction(Action).OnAcceptText))
+    {$ELSE}
+    Result := @TTBEditItem(FClient).OnAcceptText = @TTBEditAction(Action).OnAcceptText
+    {$ENDIF}
+  else
+    Result := False;
+end;
+
+function TTBEditItemActionLink.IsTextLinked: Boolean;
+begin
+  if Action is TTBEditAction then
+    Result := TTBEditItem(FClient).Text = TTBEditAction(Action).Text
+  else
+    Result := False;
+end;
+
+procedure TTBEditItemActionLink.SetEditCaption(const Value: String);
+begin
+  if IsEditCaptionLinked then TTBEditItem(FClient).EditCaption := Value;
+end;
+
+procedure TTBEditItemActionLink.SetEditOptions(Value: TTBEditItemOptions);
+begin
+  if IsEditOptionsLinked then TTBEditItem(FClient).EditOptions := Value;
+end;
+
+procedure TTBEditItemActionLink.SetEditWidth(const Value: Integer);
+begin
+  if IsEditWidthLinked then TTBEditItem(FClient).EditWidth := Value;
+end;
+
+procedure TTBEditItemActionLink.SetOnAcceptText(Value: TTBAcceptTextEvent);
+begin
+  if IsOnAcceptTextLinked then TTBEditItem(FClient).OnAcceptText := Value;
+end;
+
+procedure TTBEditItemActionLink.SetText(const Value: String);
+begin
+  if IsTextLinked then TTBEditItem(FClient).Text := Value;
+end;
+
+
+{ TTBEditItem }
+
+constructor TTBEditItem.Create(AOwner: TComponent);
+begin
+  inherited;
+  FEditOptions := EditItemDefaultEditOptions;
+  FEditWidth := EditItemDefaultEditWidth;
+end;
+
+procedure TTBEditItem.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+  inherited;
+  if Action is TTBEditAction then
+    with TTBEditAction(Sender) do
+    begin
+      if not CheckDefaults or (Self.EditCaption = '') then
+        Self.EditCaption := EditCaption;
+      if not CheckDefaults or (Self.EditOptions = []) then
+        Self.EditOptions := EditOptions;
+      if not CheckDefaults or (Self.Text = '') then
+        Self.Text := Text;
+      if not CheckDefaults or not Assigned(Self.OnAcceptText) then
+        Self.OnAcceptText := OnAcceptText;
+    end;
+end;
+
+function TTBEditItem.GetActionLinkClass: TTBCustomItemActionLinkClass;
+begin
+  Result := TTBEditItemActionLink;
+end;
+
+function TTBEditItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
+begin
+  if not(tboUseEditWhenVertical in EditOptions) and
+     (AView.Orientation = tbvoVertical) then
+    Result := inherited GetItemViewerClass(AView)
+  else
+    Result := TTBEditItemViewer;
+end;
+
+function TTBEditItem.NeedToRecreateViewer(AViewer: TTBItemViewer): Boolean;
+begin
+  Result := GetItemViewerClass(AViewer.View) <> AViewer.ClassType;
+end;
+
+procedure TTBEditItem.Clear;
+begin
+  Text := '';
+end;
+
+procedure TTBEditItem.Click;
+begin
+  inherited;
+end;
+
+procedure TTBEditItem.DoBeginEdit(Viewer: TTBEditItemViewer);
+begin
+  if Assigned(FOnBeginEdit) then
+    FOnBeginEdit(Self, Viewer, Viewer.EditControl);
+end;
+
+function TTBEditItem.IsEditOptionsStored: Boolean;
+begin
+  Result := (EditOptions <> EditItemDefaultEditOptions) and
+    ((ActionLink = nil) or not(ActionLink is TTBEditItemActionLink) or
+     not TTBEditItemActionLink(ActionLink).IsEditOptionsLinked);
+end;
+
+function TTBEditItem.IsEditCaptionStored: Boolean;
+begin
+  Result := (ActionLink = nil) or not(ActionLink is TTBEditItemActionLink) or
+    not TTBEditItemActionLink(ActionLink).IsEditCaptionLinked;
+end;
+
+function TTBEditItem.IsEditWidthStored: Boolean;
+begin
+  Result := (EditWidth <> EditItemDefaultEditWidth) and
+    ((ActionLink = nil) or not(ActionLink is TTBEditItemActionLink) or
+     not TTBEditItemActionLink(ActionLink).IsEditWidthLinked);
+end;
+
+function TTBEditItem.IsTextStored: Boolean;
+begin
+  Result := (ActionLink = nil) or not(ActionLink is TTBEditItemActionLink) or
+    not TTBEditItemActionLink(ActionLink).IsTextLinked;
+end;
+
+procedure TTBEditItem.SetCharCase(Value: TEditCharCase);
+begin
+  if FCharCase <> Value then begin
+    FCharCase := Value;
+    Text := Text;  { update case }
+  end;
+end;
+
+procedure TTBEditItem.SetEditOptions(Value: TTBEditItemOptions);
+begin
+  if FEditOptions <> Value then begin
+    FEditOptions := Value;
+    Change(True);
+  end;
+end;
+
+procedure TTBEditItem.SetEditCaption(Value: String);
+begin
+  if FEditCaption <> Value then begin
+    FEditCaption := Value;
+    Change(True);
+  end;
+end;
+
+procedure TTBEditItem.SetEditWidth(Value: Integer);
+begin
+  if FEditWidth <> Value then begin
+    FEditWidth := Value;
+    Change(True);
+  end;
+end;
+
+procedure TTBEditItem.SetMaxLength(Value: Integer);
+begin
+  if FMaxLength <> Value then begin
+    FMaxLength := Value;
+    Change(False);
+  end;
+end;
+
+procedure TTBEditItem.SetText(Value: String);
+begin
+  case FCharCase of
+    ecUpperCase: Value := {$IFNDEF CLR} AnsiUpperCase {$ELSE} UpperCase {$ENDIF} (Value);
+    ecLowerCase: Value := {$IFNDEF CLR} AnsiLowerCase {$ELSE} LowerCase {$ENDIF} (Value);
+  end;
+  if FText <> Value then begin
+    FText := Value;
+    Change(False);
+  end;
+end;
+
+
+{ TTBEditItemViewer }
+
+procedure TTBEditItemViewer.EditWndProc(var Message: TMessage);
+var
+  Item: TTBEditItem;
+
+  procedure AcceptText;
+  var
+    S: String;
+    Accept: Boolean;
+  begin
+    S := FEditControl.Text;
+    Accept := True;
+    if Assigned(Item.FOnAcceptText) then
+      Item.FOnAcceptText(Self, S, Accept);
+    if Accept then
+      Item.Text := S;
+  end;
+
+begin
+  Item := TTBEditItem(Self.Item);
+  if Message.Msg = WM_CHAR then
+    case Word(Message.WParam) of
+      VK_TAB: begin
+          FEditControlStatus := [ecsAccept];
+          AcceptText;
+          Exit;
+        end;
+      VK_RETURN: begin
+          FEditControlStatus := [ecsAccept, ecsClose];
+          AcceptText;
+          Exit;
+        end;
+      VK_ESCAPE: begin
+          FEditControlStatus := [];
+          Exit;
+        end;
+    end;
+  TEditAccess(FEditControl).WndProc(Message);
+  if Message.Msg = WM_KILLFOCUS then begin
+    { Someone has stolen the focus from us, so 'cancel mode'. (We have to
+      handle WM_KILLFOCUS in addition to the upstream WM_CANCELMODE handling
+      since we don't always hold the mouse capture.) }
+    View.CancelMode;
+    FEditControlStatus := [ecsClose];
+  end;
+end;
+
+procedure TTBEditItemViewer.GetEditRect(var R: TRect);
+var
+  Item: TTBEditItem;
+  DC: HDC;
+begin
+  Item := TTBEditItem(Self.Item);
+  DC := GetDC(0);
+  try
+    SelectObject(DC, View.GetFont.Handle);
+    R := BoundsRect;
+    if not View.IsToolbar and (Item.EditCaption <> '') then begin
+      Inc(R.Left, GetTextWidth(DC, Item.EditCaption, True) +
+        EditMenuMidWidth + EditMenuTextMargin * 2);
+    end;
+  finally
+    ReleaseDC(0, DC);
+  end;
+end;
+
+procedure TTBEditItemViewer.CalcSize(const Canvas: TCanvas;
+  var AWidth, AHeight: Integer);
+var
+  Item: TTBEditItem;
+  DC: HDC;
+begin
+  Item := TTBEditItem(Self.Item);
+  DC := Canvas.Handle;
+  AWidth := Item.FEditWidth;
+  AHeight := GetTextHeight(DC) + (EditMenuTextMargin * 2) + 1;
+  if not IsToolbarStyle and (Item.EditCaption <> '') then begin
+    Inc(AWidth, GetTextWidth(DC, Item.EditCaption, True) + EditMenuMidWidth +
+      EditMenuTextMargin * 2);
+  end;
+  { Review: Should the height include external leading on fonts that use it,
+    such as the default menu font on Windows Me Trad. Chinese? Office 2000
+    seems to insist on using Tahoma on Chinese Windows, so I'm not sure how it
+    handles external leading on edit items. }
+end;
+
+function TTBEditItemViewer.CaptionShown: Boolean;
+begin
+  Result := not IsToolbarStyle and inherited CaptionShown;
+end;
+
+function TTBEditItemViewer.GetCaptionText: String;
+begin
+  Result := TTBEditItem(Item).EditCaption;
+end;
+
+procedure TTBEditItemViewer.Paint(const Canvas: TCanvas;
+  const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean);
+const
+  FillColors: array[Boolean] of TColor = (clBtnFace, clWindow);
+  TextColors: array[Boolean] of TColor = (clGrayText, clWindowText);
+var
+  Item: TTBEditItem;
+  S: String;
+  R: TRect;
+  W: Integer;
+begin
+  Item := TTBEditItem(Self.Item);
+  R := ClientAreaRect;
+
+  { Caption }
+  if not IsToolbarStyle and (Item.EditCaption <> '') then begin
+    S := Item.EditCaption;
+    W := GetTextWidth(Canvas.Handle, S, True) + EditMenuTextMargin * 2;
+    R.Right := R.Left + W;
+    if IsSelected then
+      Canvas.FillRect(R);
+    Inc(R.Left, EditMenuTextMargin);
+    DrawItemCaption(Canvas, R, S, UseDisabledShadow, DT_SINGLELINE or
+      DT_LEFT or DT_VCENTER);
+    R := ClientAreaRect;
+    Inc(R.Left, W + EditMenuMidWidth);
+  end;
+
+  { Border }
+  if IsSelected and Item.Enabled then
+    DrawEdge(Canvas.Handle, R, BDR_SUNKENOUTER, BF_RECT);
+  InflateRect(R, -1, -1);
+  Canvas.Brush.Color := FillColors[not Item.Enabled];
+  Canvas.FrameRect(R);
+  InflateRect(R, -1, -1);
+
+  { Fill }
+  Canvas.Brush.Color := FillColors[Item.Enabled];
+  Canvas.FillRect(R);
+  InflateRect(R, -1, -1);
+
+  { Text }
+  if Item.Text <> '' then begin
+    S := Item.Text;
+    Canvas.Brush.Style := bsClear;  { speed optimization }
+    Canvas.Font.Color := TextColors[Item.Enabled];
+    DrawTextStr(Canvas.Handle, S, R, DT_SINGLELINE or DT_NOPREFIX);
+  end;
+end;
+
+procedure TTBEditItemViewer.GetCursor(const Pt: TPoint; var ACursor: HCURSOR);
+var
+  R: TRect;
+begin
+  if not Item.Enabled then
+    Exit;
+  GetEditRect(R);
+  OffsetRect(R, -BoundsRect.Left, -BoundsRect.Top);
+  InflateRect(R, -2, -2);
+  if PtInRect(R, Pt) then
+    ACursor := LoadCursor(0, IDC_IBEAM);
+end;
+
+function TTBEditItemViewer.EditLoop(const CapHandle: HWND): Boolean;
+
+  procedure ControlMessageLoop;
+
+    function PointInWindow(const Wnd: HWND; const P: TPoint): Boolean;
+    var
+      W: HWND;
+    begin
+      Result := False;
+      W := WindowFromPoint(P);
+      if W = 0 then Exit;
+      if W = Wnd then
+        Result := True
+      else
+        if IsChild(Wnd, W) then
+          Result := True;
+    end;
+
+    function ContinueLoop: Boolean;
+    begin
+      Result := (ecsContinueLoop in FEditControlStatus) and
+        not View.IsModalEnding and FEditControl.Focused and Item.Enabled;
+      { Note: View.IsModalEnding is checked since TTBView.CancelMode doesn't
+        destroy popup windows; it merely hides them and calls EndModal. So if
+        IsModalEnding returns True we can infer that CancelMode was likely
+        called. }
+    end;
+
+  var
+    Msg: TMsg;
+    IsKeypadDigit: Boolean;
+    ScanCode: Byte;
+    V: Integer;
+  begin
+    try
+      while ContinueLoop do begin
+        { Examine the next message before popping it out of the queue }
+        if not PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then begin
+          WaitMessage;
+          Continue;
+        end;
+        case Msg.message of
+          WM_SYSKEYDOWN: begin
+              { Exit immediately if Alt+[key] or F10 are pressed, but not
+                Alt+Shift, Alt+`, or Alt+[keypad digit] }
+              if not(Word(Msg.wParam) in [VK_MENU, VK_SHIFT, VK_HANJA]) then begin
+                IsKeypadDigit := False;
+                { This detect digits regardless of whether Num Lock is on: }
+                ScanCode := Byte(Msg.lParam shr 16);
+                if ScanCode <> 0 then
+                  for V := VK_NUMPAD0 to VK_NUMPAD9 do
+                    if MapVirtualKey(V, 0) = ScanCode then begin
+                      IsKeypadDigit := True;
+                      Break;
+                    end;
+                if not IsKeypadDigit then begin
+                  FEditControlStatus := [ecsClose];
+                  Exit;
+                end;
+              end;
+            end;
+          WM_SYSKEYUP: begin
+              { Exit when Alt is released by itself }
+              if Word(Msg.wParam) = VK_MENU then begin
+                FEditControlStatus := [ecsClose];
+                Exit;
+              end;
+            end;
+          WM_LBUTTONDOWN, WM_LBUTTONDBLCLK,
+          WM_RBUTTONDOWN, WM_RBUTTONDBLCLK,
+          WM_MBUTTONDOWN, WM_MBUTTONDBLCLK,
+          WM_NCLBUTTONDOWN, WM_NCLBUTTONDBLCLK,
+          WM_NCRBUTTONDOWN, WM_NCRBUTTONDBLCLK,
+          WM_NCMBUTTONDOWN, WM_NCMBUTTONDBLCLK: begin
+              { If a mouse click outside the edit control is in the queue,
+                exit and let the upstream message loop deal with it }
+              if Msg.hwnd <> FEditControl.Handle then
+                Exit;
+            end;
+          WM_MOUSEMOVE, WM_NCMOUSEMOVE: begin
+              if GetCapture = CapHandle then begin
+                if PointInWindow(FEditControl.Handle, Msg.pt) then
+                  ReleaseCapture;
+              end
+              else if GetCapture = 0 then begin
+                if not PointInWindow(FEditControl.Handle, Msg.pt) then
+                  SetCapture(CapHandle);
+              end;
+              if GetCapture = CapHandle then
+                SetCursor(LoadCursor(0, IDC_ARROW));
+            end;
+        end;
+        { Now pop the message out of the queue }
+        if not PeekMessage(Msg, 0, Msg.message, Msg.message, PM_REMOVE or PM_NOYIELD) then
+          Continue;
+        if ((Msg.message >= WM_MOUSEFIRST) and (Msg.message <= WM_MOUSELAST)) and
+           (Msg.hwnd = CapHandle) then
+          { discard, so that the selection doesn't get changed }
+        else begin
+          TranslateMessage(Msg);
+          DispatchMessage(Msg);
+        end;
+      end;
+    finally
+      { Make sure there are no outstanding WM_*CHAR messages }
+      RemoveMessages(WM_CHAR, WM_DEADCHAR);
+      RemoveMessages(WM_SYSCHAR, WM_SYSDEADCHAR);
+    end;
+  end;
+
+  procedure RestoreEditControlWndProc;
+  {$IFNDEF CLR}
+  var
+    OrigWndProc: TWndMethod;
+  begin
+    { NOTE: We can't assign WndProc to WindowProc directly because on Delphi 4
+      and 5, the compiler generates incorrect code, causing an AV at run-time }
+    OrigWndProc := TEditAccess(FEditControl).WndProc;
+    FEditControl.WindowProc := OrigWndProc;
+  end;
+  {$ELSE}
+  begin
+    IControl(FEditControl).RestoreWndProc;
+  end;
+  {$ENDIF}
+
+var
+  Item: TTBEditItem;
+  R: TRect;
+  ActiveWnd, FocusWnd: HWND;
+begin
+  Item := TTBEditItem(Self.Item);
+  GetEditRect(R);
+  if IsRectEmpty(R) then begin
+    Result := False;
+    Exit;
+  end;
+
+  ActiveWnd := GetActiveWindow;
+  FocusWnd := GetFocus;
+
+  { Create the edit control }
+  InflateRect(R, -3, -3);
+  //View.FreeNotification(Self);
+  FEditControl := TEdit.Create(nil);
+  try
+    FEditControl.Visible := False;
+    FEditControl.BorderStyle := bsNone;
+    FEditControl.AutoSize := False;
+    FEditControl.Font.Assign(View.GetFont);
+    FEditControl.Text := Item.Text;
+    FEditControl.CharCase := Item.FCharCase;
+    FEditControl.MaxLength := Item.FMaxLength;
+    FEditControl.BoundsRect := R;
+    FEditControl.WindowProc := EditWndProc;
+    FEditControl.ParentWindow := View.Window.Handle;
+    FEditControl.SelectAll;
+    Item.DoBeginEdit(Self);
+    FEditControl.Visible := True;
+    FEditControl.SetFocus;
+    if GetActiveWindow <> ActiveWnd then
+      { don't gray out title bar of old active window }
+      SendMessage(ActiveWnd, WM_NCACTIVATE, 1, 0)
+    else
+      ActiveWnd := 0;
+
+    FEditControlStatus := [ecsContinueLoop];
+    ControlMessageLoop;
+  finally
+    { Restore the original window procedure before destroying the control so
+      it doesn't see a WM_KILLFOCUS message }
+    RestoreEditControlWndProc;
+    FreeAndNil(FEditControl);
+  end;
+
+  { ensure the area underneath the edit control is repainted immediately }
+  View.Window.Update;
+  { If app is still active, set focus to previous control and restore capture
+    to CapHandle if another control hasn't taken it }
+  if GetActiveWindow <> 0 then begin
+    SetFocus(FocusWnd);
+    if GetCapture = 0 then
+      SetCapture(CapHandle);
+  end;
+  if ActiveWnd <> 0 then
+    SendMessage(ActiveWnd, WM_NCACTIVATE, Ord(GetActiveWindow = ActiveWnd), 0);
+  { The SetFocus call above can change the Z order of windows. If the parent
+    window is a popup window, reassert its topmostness. }
+  if View.Window is TTBPopupWindow then
+    SetWindowPos(View.Window.Handle, HWND_TOPMOST, 0, 0, 0, 0,
+      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
+  { Send an MSAA "focus" event now that we're returning to the regular modal loop }
+  View.NotifyFocusEvent;
+
+  Result := ecsClose in FEditControlStatus;
+  if not Result and (GetCapture = CapHandle) then begin
+    if ecsAccept in FEditControlStatus then
+      { if we are accepting but not closing, Tab must have been pressed }
+      View.Selected := View.NextSelectable(View.Selected,
+        GetKeyState(VK_SHIFT) >= 0);
+  end;
+end;
+
+function TTBEditItemViewer.DoExecute: Boolean;
+begin
+  { Close any delay-close popup menus before entering the edit loop }
+  View.CancelChildPopups;
+  Result := False;
+  if EditLoop(View.GetCaptureWnd) then begin
+    View.EndModal;
+    if ecsAccept in FEditControlStatus then
+      Result := True;
+  end;
+end;
+
+procedure TTBEditItemViewer.MouseBeginEdit;
+begin
+  if Item.Enabled then
+    Execute(True)
+  else begin
+    if (View.ParentView = nil) and not View.IsPopup then
+      View.EndModal;
+  end;
+end;
+
+procedure TTBEditItemViewer.MouseDown(Shift: TShiftState; X, Y: Integer;
+  var MouseDownOnMenu: Boolean);
+begin
+  if IsPtInButtonPart(X, Y) then  { for TBX... }
+    MouseBeginEdit
+  else
+    inherited;
+end;
+
+procedure TTBEditItemViewer.MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean);
+begin
+  if IsPtInButtonPart(X, Y) then  { for TBX... }
+    MouseBeginEdit
+  else
+    inherited;
+end;
+
+function TTBEditItemViewer.UsesSameWidth: Boolean;
+begin
+  Result := False;
+end;
+
+function TTBEditItemViewer.GetAccRole: Integer;
+const
+  ROLE_SYSTEM_TEXT = $2a;  { from OleAcc.h }
+begin
+  Result := ROLE_SYSTEM_TEXT;
+end;
+
+function TTBEditItemViewer.GetAccValue(var Value: WideString): Boolean;
+begin
+  Value := TTBEditItem(Item).Text;
+  Result := True;
+end;
+
+
+{ TTBToolbarVisibilityItem }
+
+procedure TTBVisibilityToggleItem.Click;
+begin
+  if Assigned(FControl) then
+    FControl.Visible := not FControl.Visible;
+  inherited;
+end;
+
+procedure TTBVisibilityToggleItem.InitiateAction;
+begin
+  UpdateProps;
+end;
+
+procedure TTBVisibilityToggleItem.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited;
+  if (Operation = opRemove) and (AComponent = FControl) then
+    Control := nil;
+end;
+
+procedure TTBVisibilityToggleItem.SetControl(Value: TControl);
+begin
+  if FControl <> Value then begin
+    FControl := Value;
+    if Assigned(Value) then begin
+      Value.FreeNotification(Self);
+      if (Caption = '') and not(csLoading in ComponentState) then
+        {$IFNDEF CLR}
+        Caption := TControlAccess(Value).Caption;
+        {$ELSE}
+        Caption := Value.GetText;
+        {$ENDIF}
+    end;
+    UpdateProps;
+  end;
+end;
+
+procedure TTBVisibilityToggleItem.UpdateProps;
+begin
+  if (ComponentState * [csDesigning, csLoading, csDestroying] = []) then
+    Checked := Assigned(FControl) and FControl.Visible;
+end;
+
+end.

ToolBar 2000/Source/TB2Hook.pas

@@ -0,0 +1,346 @@
+unit TB2Hook;
+
+{$MODE Delphi}
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2006 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2Hook.pas,v 1.17 2006/03/12 23:11:59 jr Exp $
+}
+
+interface
+
+uses
+  LCLIntf, LCLType, LMessages;
+
+type
+  THookProcCode = (hpSendActivate, hpSendActivateApp, hpSendWindowPosChanged,
+    hpPreDestroy, hpGetMessage);
+  THookProcCodes = set of THookProcCode;
+
+  THookProc = procedure(Code: THookProcCode; Wnd: HWND; WParam: WPARAM; LParam: LPARAM);
+
+procedure InstallHookProc(AUser: TObject; AProc: THookProc; ACodes: THookProcCodes);
+procedure UninstallHookProc(AUser: TObject; AProc: THookProc);
+
+implementation
+
+uses
+  {$IFDEF CLR} System.Runtime.InteropServices, {$ENDIF} 
+  SysUtils, Classes, Messages, TB2Common;
+
+type
+  THookType = (htCallWndProc, htCBT, htGetMessage);
+  THookTypes = set of THookType;
+
+  THookUserData = class
+    Prev: THookUserData;
+    User: TObject;
+    InstalledHookTypes: THookTypes;
+  end;
+
+  THookProcData = class
+    Proc: THookProc;
+    Codes: THookProcCodes;
+    LastUserData: THookUserData;
+  end;
+
+  THookInfo = class
+    Handles: array[THookType] of HHOOK;
+    Counts: array[THookType] of Longint;
+  end;
+
+threadvar
+  HookInfo: THookInfo;
+  HookProcList: TList;
+
+
+function CallWndProcHook(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;
+{$IFNDEF CLR} stdcall; {$ENDIF}
+type
+  THookProcCodeMsgs = hpSendActivate..hpSendWindowPosChanged;
+const
+  MsgMap: array[THookProcCodeMsgs] of UINT =
+    (WM_ACTIVATE, WM_ACTIVATEAPP, WM_WINDOWPOSCHANGED);
+var
+  J: THookProcCodeMsgs;
+  I: Integer;
+  CWPStruct: {$IFNDEF CLR} PCWPStruct {$ELSE} TCWPStruct {$ENDIF};
+begin
+  if Assigned(HookProcList) and (Code = HC_ACTION) then begin
+    {$IFNDEF CLR}
+    CWPStruct := PCWPStruct(LParam);
+    {$ELSE}
+    CWPStruct := TCWPStruct(Marshal.PtrToStructure(IntPtr(LParam), TypeOf(TCWPStruct)));
+    {$ENDIF}
+    for J := Low(J) to High(J) do
+      if CWPStruct.Message = MsgMap[J] then begin
+        for I := 0 to HookProcList.Count-1 do
+          try
+            with THookProcData(HookProcList.List[I]) do
+              if J in Codes then
+                Proc(J, CWPStruct.hwnd, CWPStruct.WParam, CWPStruct.LParam);
+          except
+          end;
+        Break;
+      end;
+  end;
+  Result := CallNextHookEx(HookInfo.Handles[htCallWndProc], Code, WParam, LParam);
+end;
+
+function CBTHook(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;
+{$IFNDEF CLR} stdcall; {$ENDIF}
+var
+  I: Integer;
+begin
+  if Assigned(HookProcList) and (Code = HCBT_DESTROYWND) then
+    for I := 0 to HookProcList.Count-1 do
+      try
+        with THookProcData(HookProcList.List[I]) do
+          if hpPreDestroy in Codes then
+            Proc(hpPreDestroy, HWND(WParam), 0, 0);
+      except
+      end;
+  Result := CallNextHookEx(HookInfo.Handles[htCBT], Code, WParam, LParam);
+end;
+
+function GetMessageHook(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;
+{$IFNDEF CLR} stdcall; {$ENDIF}
+var
+  I: Integer;
+begin
+  if Assigned(HookProcList) and (Code = HC_ACTION) then
+    for I := 0 to HookProcList.Count-1 do
+      try
+        with THookProcData(HookProcList.List[I]) do
+          if hpGetMessage in Codes then
+            Proc(hpGetMessage, 0, WParam, LParam);
+      except
+      end;
+  Result := CallNextHookEx(HookInfo.Handles[htGetMessage], Code, WParam, LParam);
+end;
+
+function HookCodesToTypes(Codes: THookProcCodes): THookTypes;
+const
+  HookCodeToType: array[THookProcCode] of THookType =
+    (htCallWndProc, htCallWndProc, htCallWndProc, htCBT, htGetMessage);
+var
+  J: THookProcCode;
+begin
+  Result := [];
+  for J := Low(J) to High(J) do
+    if J in Codes then
+      Include(Result, HookCodeToType[J]);
+end;
+
+var
+  HookProcs: array[THookType] of TFNHookProc;
+const
+  HookIDs: array[THookType] of Integer =
+    (WH_CALLWNDPROC, WH_CBT, WH_GETMESSAGE);
+
+procedure InstallHooks(ATypes: THookTypes; var InstalledTypes: THookTypes);
+var
+  T: THookType;
+begin
+  if HookInfo = nil then
+    HookInfo := THookInfo.Create;
+
+  { Don't increment reference counts for hook types that were already
+    installed previously } 
+  ATypes := ATypes - InstalledTypes;
+
+  { Increment reference counts first. This should never raise an exception. }
+  for T := Low(T) to High(T) do
+    if T in ATypes then begin
+      Inc(HookInfo.Counts[T]);
+      Include(InstalledTypes, T);
+    end;
+
+  { Then install the hooks }
+  for T := Low(T) to High(T) do
+    if T in InstalledTypes then begin
+      if HookInfo.Handles[T] = 0 then begin
+        { On Windows NT platforms, SetWindowsHookExW is used to work around an
+          apparent bug in Windows NT/2000/XP: if an 'ANSI' WH_GETMESSAGE hook
+          is called *before* a 'wide' WH_GETMESSAGE hook, then WM_*CHAR
+          messages passed to the 'wide' hook use ANSI character codes.
+          This is needed for compatibility with the combination of Tnt Unicode
+          Controls and Keyman. See "Widechar's and tb2k" thread on the
+          newsgroup from 2003-09-23 for more information. }
+        if Win32Platform = VER_PLATFORM_WIN32_NT then
+          HookInfo.Handles[T] := SetWindowsHookExW(HookIDs[T], HookProcs[T],
+            0, GetCurrentThreadId)
+        else
+          HookInfo.Handles[T] := SetWindowsHookEx(HookIDs[T], HookProcs[T],
+            0, GetCurrentThreadId);
+        { .NET note: A reference to the delegate passed to SetWindowsHookEx
+          must exist for as long as the hook is installed, otherwise the GC
+          will collect it and the app will crash. Hence we always pass a
+          global variable (HookProcs[]) to SetWindowsHookEx. }
+      end;
+    end;
+end;
+
+procedure UninstallHooks(const ATypes: THookTypes; const Force: Boolean);
+var
+  T: THookType;
+begin
+  { HookInfo can be nil if InstallHooks was never called previously (e.g. when
+    we're being called with Force=True), or if it was called but failed with
+    an exception }
+  if HookInfo = nil then
+    Exit;
+
+  { Decrement reference counts first. This should never raise an exception. }
+  if not Force then
+    for T := Low(T) to High(T) do
+      if T in ATypes then
+        Dec(HookInfo.Counts[T]);
+
+  { Then uninstall the hooks }
+  for T := Low(T) to High(T) do
+    if T in ATypes then begin
+      if (Force or (HookInfo.Counts[T] = 0)) and (HookInfo.Handles[T] <> 0) then begin
+        UnhookWindowsHookEx(HookInfo.Handles[T]);
+        HookInfo.Handles[T] := 0;
+      end;
+    end;
+
+  { If all hooks are uninstalled, free HookInfo }
+  for T := Low(T) to High(T) do
+    if (HookInfo.Counts[T] <> 0) or (HookInfo.Handles[T] <> 0) then
+      Exit;
+  FreeAndNil(HookInfo);
+end;
+
+procedure InstallHookProc(AUser: TObject; AProc: THookProc; ACodes: THookProcCodes);
+var
+  Found: Boolean;
+  I: Integer;
+  UserData: THookUserData;
+  ProcData: THookProcData;
+label 1;
+begin
+  if HookProcList = nil then
+    HookProcList := TList.Create;
+  Found := False;
+  UserData := nil;  { avoid warning }
+  for I := 0 to HookProcList.Count-1 do begin
+    ProcData := THookProcData(HookProcList[I]);
+    if @ProcData.Proc = @AProc then begin
+      UserData := ProcData.LastUserData;
+      while Assigned(UserData) do begin
+        if UserData.User = AUser then begin
+          { InstallHookProc was already called for AUser/AProc. Go ahead and
+            call InstallHooks again just in case the hooks weren't successfully
+            installed last time. }
+          goto 1;
+        end;
+        UserData := UserData.Prev;
+      end;
+      UserData := THookUserData.Create;
+      UserData.Prev := ProcData.LastUserData;
+      UserData.User := AUser;
+      UserData.InstalledHookTypes := [];
+      ProcData.LastUserData := UserData;
+      Found := True;
+      Break;
+    end;
+  end;
+  if not Found then begin
+    UserData := THookUserData.Create;
+    try
+      UserData.Prev := nil;
+      UserData.User := AUser;
+      UserData.InstalledHookTypes := [];
+      HookProcList.Expand;
+      ProcData := THookProcData.Create;
+    except
+      UserData.Free;
+      raise;
+    end;
+    ProcData.Proc := AProc;
+    ProcData.Codes := ACodes;
+    ProcData.LastUserData := UserData;
+    HookProcList.Add(ProcData);
+  end;
+1:InstallHooks(HookCodesToTypes(ACodes), UserData.InstalledHookTypes);
+end;
+
+procedure UninstallHookProc(AUser: TObject; AProc: THookProc);
+var
+  I: Integer;
+  ProcData: THookProcData;
+  NextUserData, UserData: THookUserData;
+  T: THookTypes;
+begin
+  if HookProcList = nil then Exit;
+  for I := 0 to HookProcList.Count-1 do begin
+    ProcData := THookProcData(HookProcList[I]);
+    if @ProcData.Proc = @AProc then begin
+      { Locate the UserData record }
+      NextUserData := nil;
+      UserData := ProcData.LastUserData;
+      while Assigned(UserData) and (UserData.User <> AUser) do begin
+        NextUserData := UserData;
+        UserData := UserData.Prev;
+      end;
+      if UserData = nil then
+        Exit;
+
+      { Remove record from linked list }
+      if NextUserData = nil then begin
+        { It's the last item in the list }
+        if UserData.Prev = nil then begin
+          { It's the only item in the list, so destroy the ProcData record }
+          HookProcList.Delete(I);
+          ProcData.Free;
+        end
+        else
+          ProcData.LastUserData := UserData.Prev;
+      end
+      else
+        NextUserData.Prev := UserData.Prev;
+
+      T := UserData.InstalledHookTypes;
+      UserData.Free;
+      UninstallHooks(T, False);
+      Break;
+    end;
+  end;
+  if HookProcList.Count = 0 then
+    FreeAndNil(HookProcList);
+end;
+
+
+initialization
+  { Work around Delphi.NET 2005 bug: declaring a constant array of procedural
+    types crashes the compiler (see QC #10381; 2006 fixes it). So we instead
+    declare HookProcs as a variable, and initialize the elements here. }
+  HookProcs[htCallWndProc] := CallWndProcHook;
+  HookProcs[htCBT] := CBTHook;
+  HookProcs[htGetMessage] := GetMessageHook;
+finalization
+  UninstallHooks([Low(THookType)..High(THookType)], True);
+end.

ToolBar 2000/Source/TB2MDI.pas

@@ -0,0 +1,716 @@
+unit TB2MDI;
+
+{$MODE Delphi}
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2008 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2MDI.pas,v 1.15 2008/04/23 21:54:37 jr Exp $
+}
+
+interface
+
+{$I TB2Ver.inc}
+
+uses
+  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  Menus, TB2Item, TB2Toolbar;
+
+type
+  TTBMDIButtonsItem = class;
+  TTBMDISystemMenuItem = class;
+
+  TTBMDIHandler = class(TComponent)
+  private
+    FButtonsItem: TTBMDIButtonsItem;
+    FSystemMenuItem: TTBMDISystemMenuItem;
+    FToolbar: TTBCustomToolbar;
+    procedure SetToolbar(Value: TTBCustomToolbar);
+  protected
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property Toolbar: TTBCustomToolbar read FToolbar write SetToolbar;
+  end;
+
+  TTBMDIWindowItem = class(TTBCustomItem)
+  private
+    FForm: TForm;
+    FOnUpdate: TNotifyEvent;
+    FWindowMenu: TMenuItem;
+    procedure ItemClick(Sender: TObject);
+    procedure SetForm(AForm: TForm);
+  protected
+    procedure EnabledChanged; override;
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure InitiateAction; override;
+  published
+    property Enabled;
+    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
+  end;
+
+  TTBMDISystemMenuItem = class(TTBCustomItem)
+  private
+    FImageList: TImageList;
+    procedure CommandClick(Sender: TObject);
+  protected
+    function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Click; override;
+  end;
+
+  TTBMDISystemMenuItemViewer = class(TTBItemViewer)
+  protected
+    procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer);
+      override;
+    procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect;
+      IsSelected, IsPushed, UseDisabledShadow: Boolean); override;
+  end;
+
+  TTBMDIButtonType = (tbmbMinimize, tbmbRestore, tbmbClose);
+
+  TTBMDIButtonItem = class(TTBCustomItem)
+  private
+    FButtonType: TTBMDIButtonType;
+  protected
+    function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+  TTBMDIButtonItemViewer = class(TTBItemViewer)
+  protected
+    procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer);
+      override;
+    procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect;
+      IsSelected, IsPushed, UseDisabledShadow: Boolean); override;
+  end;
+
+  TTBMDISepItem = class(TTBSeparatorItem)
+  protected
+    function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
+  end;
+
+  TTBMDISepItemViewer = class(TTBSeparatorItemViewer)
+  protected
+    procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer);
+      override;
+  end;
+
+  TTBMDIButtonsItem = class(TTBCustomItem)
+  private
+    FMinimizeItem: TTBMDIButtonItem;
+    FRestoreItem: TTBMDIButtonItem;
+    FCloseItem: TTBMDIButtonItem;
+    FSep1, FSep2: TTBMDISepItem;
+    procedure InvalidateSystemMenuItem;
+    procedure ItemClick(Sender: TObject);
+    procedure UpdateState(W: HWND; Maximized: Boolean);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses
+  {$IFDEF CLR} System.Text, System.Runtime.InteropServices, WinUtils, {$ENDIF}
+  TB2Common, TB2Consts, CommCtrl;
+
+type
+  TTBCustomToolbarAccess = class(TTBCustomToolbar);
+
+function GetMenuItemStr(const AMenu: HMENU; const APos: Integer): String;
+{$IFNDEF CLR}
+var
+  Buf: array[0..1023] of Char;
+begin
+  if GetMenuString(AMenu, APos, Buf, SizeOf(Buf) div SizeOf(Buf[0]), MF_BYPOSITION) > 0 then
+    Result := Buf
+  else
+    Result := '';
+end;
+{$ELSE}
+var
+  Buf: StringBuilder;
+begin
+  Buf := StringBuilder.Create(1024);
+  if GetMenuString(AMenu, APos, Buf, Buf.Capacity, MF_BYPOSITION) > 0 then
+    Result := Buf.ToString
+  else
+    Result := '';
+end;
+{$ENDIF}
+
+
+{ TTBMDIHandler }
+
+constructor TTBMDIHandler.Create(AOwner: TComponent);
+begin
+  inherited;
+  FSystemMenuItem := TTBMDISystemMenuItem.Create(Self);
+  FButtonsItem := TTBMDIButtonsItem.Create(Self);
+end;
+
+destructor TTBMDIHandler.Destroy;
+begin
+  Toolbar := nil;
+  inherited;
+end;
+
+procedure TTBMDIHandler.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited;
+  if (AComponent = FToolbar) and (Operation = opRemove) then
+    Toolbar := nil;
+end;
+
+procedure TTBMDIHandler.SetToolbar(Value: TTBCustomToolbar);
+var
+  Rebuild: Boolean;
+begin
+  if FToolbar <> Value then begin
+    if Assigned(FToolbar) then begin
+      Rebuild := False;
+      if TTBCustomToolbarAccess(FToolbar).FMDIButtonsItem = FButtonsItem then begin
+        TTBCustomToolbarAccess(FToolbar).FMDIButtonsItem := nil;
+        Rebuild := True;
+      end;
+      if TTBCustomToolbarAccess(FToolbar).FMDISystemMenuItem = FSystemMenuItem then begin
+        TTBCustomToolbarAccess(FToolbar).FMDISystemMenuItem := nil;
+        Rebuild := True;
+      end;
+      if Rebuild and Assigned(FToolbar.View) then
+        FToolbar.View.RecreateAllViewers;
+    end;
+    FToolbar := Value;
+    if Assigned(Value) then begin
+      Value.FreeNotification(Self);
+      TTBCustomToolbarAccess(Value).FMDIButtonsItem := FButtonsItem;
+      TTBCustomToolbarAccess(Value).FMDISystemMenuItem := FSystemMenuItem;
+      Value.View.RecreateAllViewers;
+    end;
+  end;
+end;
+
+
+{ TTBMDISystemMenuItem }
+
+constructor TTBMDISystemMenuItem.Create(AOwner: TComponent);
+begin
+  inherited;
+  ItemStyle := ItemStyle + [tbisSubMenu, tbisDontSelectFirst] -
+    [tbisRedrawOnSelChange, tbisRedrawOnMouseOverChange];
+  Caption := '&-';
+
+  {$R TB2MDI.res}
+  FImageList := TImageList.Create(Self);
+  FImageList.Handle := ImageList_LoadBitmap(HInstance, 'TB2SYSMENUIMAGES',
+    16, 0, clSilver);
+  SubMenuImages := FImageList;
+end;
+
+function TTBMDISystemMenuItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
+begin
+  Result := TTBMDISystemMenuItemViewer;
+end;
+
+procedure TTBMDISystemMenuItem.Click;
+var
+  I: Integer;
+  Form: TForm;
+  M: HMENU;
+  State: UINT;
+  ID: Word;
+  Item: TTBCustomItem;
+begin
+  inherited;
+  Clear;
+  if Application.MainForm = nil then
+    Exit;
+  Form := Application.MainForm.ActiveMDIChild;
+  if Form = nil then
+    Exit;
+  M := GetSystemMenu(Form.Handle, False);
+  for I := 0 to GetMenuItemCount(M)-1 do begin
+    State := GetMenuState(M, I, MF_BYPOSITION);
+    if State and MF_SEPARATOR <> 0 then
+      Add(TTBSeparatorItem.Create(Self))
+    else begin
+      Item := TTBCustomItem.Create(Self);
+      if State and MF_GRAYED <> 0 then
+        Item.Enabled := False;
+      Item.Caption := GetMenuItemStr(M, I);
+      ID := Word(GetMenuItemID(M, I));
+      Item.Tag := {$IFDEF CLR}TTag{$ENDIF}(ID);
+      case ID and $FFF0 of
+        SC_RESTORE: Item.ImageIndex := 3;
+        SC_MINIMIZE: Item.ImageIndex := 2;
+        SC_MAXIMIZE: Item.ImageIndex := 1;
+        SC_CLOSE: begin
+            Item.ImageIndex := 0;
+            Item.Options := Item.Options + [tboDefault];
+          end;
+      end;
+      Item.OnClick := CommandClick;
+      Add(Item);
+    end;
+  end;
+end;
+
+procedure TTBMDISystemMenuItem.CommandClick(Sender: TObject);
+var
+  Form: TForm;
+begin
+  if Assigned(Application.MainForm) then begin
+    Form := Application.MainForm.ActiveMDIChild;
+    if Assigned(Form) then
+      SendMessage(Form.Handle, WM_SYSCOMMAND, Word(TTBCustomItem(Sender).Tag),
+        LPARAM(GetMessagePos()));
+  end;
+end;
+
+
+{ TTBMDISystemMenuItemViewer }
+
+procedure TTBMDISystemMenuItemViewer.CalcSize(const Canvas: TCanvas;
+  var AWidth, AHeight: Integer);
+begin
+  AWidth := GetSystemMetrics(SM_CXSMICON) + 2;
+  AHeight := GetSystemMetrics(SM_CYSMICON) + 2;
+end;
+
+procedure TTBMDISystemMenuItemViewer.Paint(const Canvas: TCanvas;
+  const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean);
+
+  function GetIconHandle: HICON;
+  var
+    Form: TForm;
+  begin
+    Result := 0;
+    if Assigned(Application.MainForm) then begin
+      Form := Application.MainForm.ActiveMDIChild;
+      if Assigned(Form) then
+        Result := Form.Icon.Handle;
+    end;
+    if Result = 0 then
+      Result := Application.Icon.Handle;
+    if Result = 0 then
+      Result := LoadIcon(0, IDI_APPLICATION);
+  end;
+
+var
+  R: TRect;
+  TempIcon: HICON;
+begin
+  R := ClientAreaRect;
+  InflateRect(R, -1, -1);
+  TempIcon := CopyImage(GetIconHandle, IMAGE_ICON, R.Right - R.Left,
+    R.Bottom - R.Top, LR_COPYFROMRESOURCE);
+  DrawIconEx(Canvas.Handle, R.Left, R.Top, TempIcon, 0, 0, 0, 0, DI_NORMAL);
+  DestroyIcon(TempIcon);
+end;
+
+
+{ TTBMDIButtonItem }
+
+constructor TTBMDIButtonItem.Create(AOwner: TComponent);
+begin
+  inherited;
+  ItemStyle := ItemStyle - [tbisSelectable, tbisRedrawOnSelChange] +
+    [tbisRightAlign];
+end;
+
+function TTBMDIButtonItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
+begin
+  Result := TTBMDIButtonItemViewer;
+end;
+
+
+{ TTBMDIButtonItemViewer }
+
+procedure TTBMDIButtonItemViewer.CalcSize(const Canvas: TCanvas;
+  var AWidth, AHeight: Integer);
+begin
+  if NewStyleControls then begin
+    AWidth := GetSystemMetrics(SM_CXMENUSIZE) - 2;
+    if AWidth < 0 then AWidth := 0;
+    AHeight := GetSystemMetrics(SM_CYMENUSIZE) - 4;
+    if AHeight < 0 then AHeight := 0;
+  end
+  else begin
+    AWidth := 16;
+    AHeight := 14;
+  end;
+end;
+
+procedure TTBMDIButtonItemViewer.Paint(const Canvas: TCanvas;
+  const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean);
+const
+  ButtonTypeFlags: array[TTBMDIButtonType] of UINT = (DFCS_CAPTIONMIN,
+    DFCS_CAPTIONRESTORE, DFCS_CAPTIONCLOSE);
+  PushedFlags: array[Boolean] of UINT = (0, DFCS_PUSHED);
+  EnabledFlags: array[Boolean] of UINT = (DFCS_INACTIVE, 0);
+begin
+  DrawFrameControl(Canvas.Handle, ClientAreaRect, DFC_CAPTION,
+    ButtonTypeFlags[TTBMDIButtonItem(Item).FButtonType] or
+    PushedFlags[IsPushed] or EnabledFlags[Item.Enabled]);
+end;
+
+
+{ TTBMDISepItem }
+
+function TTBMDISepItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
+begin
+  Result := TTBMDISepItemViewer;
+end;
+
+
+{ TTBMDISepItemViewer }
+
+procedure TTBMDISepItemViewer.CalcSize(const Canvas: TCanvas;
+  var AWidth, AHeight: Integer);
+begin
+  if View.Orientation <> tbvoVertical then begin
+    AWidth := 2;
+    AHeight := 6;
+  end
+  else begin
+    AWidth := 6;
+    AHeight := 2;
+  end;
+end;
+
+
+{ TTBMDIButtonsItem }
+
+var
+  CBTHookHandle: HHOOK;
+  MDIButtonsItems: TList;
+
+function WindowIsMDIChild(W: HWND): Boolean;
+var
+  I: Integer;
+  MainForm, ChildForm: TForm;
+begin
+  MainForm := Application.MainForm;
+  if Assigned(MainForm) then
+    for I := 0 to MainForm.MDIChildCount-1 do begin
+      ChildForm := MainForm.MDIChildren[I];
+      if ChildForm.HandleAllocated and (ChildForm.Handle = W) then begin
+        Result := True;
+        Exit;
+      end;
+    end;
+  Result := False;
+end;
+
+function CBTHook(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;
+{$IFNDEF CLR} stdcall; {$ENDIF}
+var
+  Maximizing: Boolean;
+  WindowPlacement: TWindowPlacement;
+  I: Integer;
+begin
+  case Code of
+    HCBT_SETFOCUS: begin
+        if WindowIsMDIChild(HWND(WParam)) and Assigned(MDIButtonsItems) then begin
+          for I := 0 to MDIButtonsItems.Count-1 do
+            TTBMDIButtonsItem(MDIButtonsItems[I]).InvalidateSystemMenuItem;
+        end;
+      end;
+    HCBT_MINMAX: begin
+        if WindowIsMDIChild(HWND(WParam)) and Assigned(MDIButtonsItems) and
+           (Word(LParam) in [SW_SHOWNORMAL, SW_SHOWMAXIMIZED, SW_MINIMIZE, SW_RESTORE]) then begin
+          Maximizing := (Word(LParam) = SW_MAXIMIZE);
+          if (Word(LParam) = SW_RESTORE) and not IsZoomed(HWND(WParam)) then begin
+            {$IFNDEF CLR}
+            WindowPlacement.length := SizeOf(WindowPlacement);
+            {$ELSE}
+            WindowPlacement.length := Marshal.SizeOf(TypeOf(TWindowPlacement));
+            {$ENDIF}
+            GetWindowPlacement(HWND(WParam), {$IFNDEF CLR}@{$ENDIF} WindowPlacement);
+            Maximizing := (WindowPlacement.flags and WPF_RESTORETOMAXIMIZED <> 0);
+          end;
+          for I := 0 to MDIButtonsItems.Count-1 do
+            TTBMDIButtonsItem(MDIButtonsItems[I]).UpdateState(HWND(WParam),
+              Maximizing);
+        end;
+      end;
+    HCBT_DESTROYWND: begin
+        if WindowIsMDIChild(HWND(WParam)) and Assigned(MDIButtonsItems) then begin
+          for I := 0 to MDIButtonsItems.Count-1 do
+            TTBMDIButtonsItem(MDIButtonsItems[I]).UpdateState(HWND(WParam),
+              False);
+        end;
+      end;
+  end;
+  Result := CallNextHookEx(CBTHookHandle, Code, WParam, LParam);
+end;
+
+const
+  { Note: On .NET, we must keep a reference to the delegate alive for as long
+    as the hook is installed, otherwise the GC will collect it and the app
+    will crash. Storing the delegate in a typed constant will do the trick. }
+  CBTHookDelegate: TFNHookProc = CBTHook;
+
+constructor TTBMDIButtonsItem.Create(AOwner: TComponent);
+
+  function CreateItem(const AType: TTBMDIButtonType): TTBMDIButtonItem;
+  begin
+    Result := TTBMDIButtonItem.Create(Self);
+    Result.FButtonType := AType;
+    Result.OnClick := ItemClick;
+  end;
+
+begin
+  inherited;
+  ItemStyle := ItemStyle + [tbisEmbeddedGroup];
+  FMinimizeItem := CreateItem(tbmbMinimize);
+  FRestoreItem := CreateItem(tbmbRestore);
+  FCloseItem := CreateItem(tbmbClose);
+  FSep1 := TTBMDISepItem.Create(Self);
+  FSep1.Blank := True;
+  FSep1.ItemStyle := FSep1.ItemStyle + [tbisRightAlign, tbisNoLineBreak];
+  FSep2 := TTBMDISepItem.Create(Self);
+  FSep2.Blank := True;
+  FSep2.ItemStyle := FSep2.ItemStyle + [tbisRightAlign, tbisNoLineBreak];
+  Add(FSep1);
+  Add(FMinimizeItem);
+  Add(FRestoreItem);
+  Add(FSep2);
+  Add(FCloseItem);
+  UpdateState(0, False);
+  if not(csDesigning in ComponentState) then begin
+    AddToList(MDIButtonsItems, Self);
+    if CBTHookHandle = 0 then
+      CBTHookHandle := SetWindowsHookEx(WH_CBT, CBTHookDelegate, 0, GetCurrentThreadId);
+  end;
+end;
+
+destructor TTBMDIButtonsItem.Destroy;
+begin
+  RemoveFromList(MDIButtonsItems, Self);
+  if (MDIButtonsItems = nil) and (CBTHookHandle <> 0) then begin
+    UnhookWindowsHookEx(CBTHookHandle);
+    CBTHookHandle := 0;
+  end;
+  inherited;
+end;
+
+procedure TTBMDIButtonsItem.UpdateState(W: HWND; Maximized: Boolean);
+var
+  HasMaxChild, VisibilityChanged: Boolean;
+
+  procedure UpdateVisibleEnabled(const Item: TTBCustomItem;
+    const AEnabled: Boolean);
+  begin
+    if (Item.Visible <> HasMaxChild) or (Item.Enabled <> AEnabled) then begin
+      Item.Visible := HasMaxChild;
+      Item.Enabled := AEnabled;
+      VisibilityChanged := True;
+    end;
+  end;
+
+var
+  MainForm, ActiveMDIChild, ChildForm: TForm;
+  I: Integer;
+begin
+  HasMaxChild := False;
+  ActiveMDIChild := nil;
+  if not(csDesigning in ComponentState) then begin
+    MainForm := Application.MainForm;
+    if Assigned(MainForm) then begin
+      for I := 0 to MainForm.MDIChildCount-1 do begin
+        ChildForm := MainForm.MDIChildren[I];
+        if ChildForm.HandleAllocated and
+           (((ChildForm.Handle = W) and Maximized) or
+            ((ChildForm.Handle <> W) and IsZoomed(ChildForm.Handle))) then begin
+          HasMaxChild := True;
+          Break;
+        end;
+      end;
+      ActiveMDIChild := MainForm.ActiveMDIChild;
+    end;
+  end;
+
+  VisibilityChanged := False;
+  UpdateVisibleEnabled(TTBMDIHandler(Owner).FSystemMenuItem, True);
+  UpdateVisibleEnabled(FSep1, True);
+  UpdateVisibleEnabled(FMinimizeItem, (ActiveMDIChild = nil) or
+    (GetWindowLong(ActiveMDIChild.Handle, GWL_STYLE) and WS_MINIMIZEBOX <> 0));
+  UpdateVisibleEnabled(FRestoreItem, True);
+  UpdateVisibleEnabled(FSep2, True);
+  UpdateVisibleEnabled(FCloseItem, True);
+
+  if VisibilityChanged and Assigned((Owner as TTBMDIHandler).FToolbar) then begin
+    TTBMDIHandler(Owner).FToolbar.View.InvalidatePositions;
+    TTBMDIHandler(Owner).FToolbar.View.TryValidatePositions;
+  end;
+end;
+
+procedure TTBMDIButtonsItem.ItemClick(Sender: TObject);
+var
+  MainForm, ChildForm: TForm;
+  Cmd: WPARAM;
+begin
+  MainForm := Application.MainForm;
+  if Assigned(MainForm) then begin
+    ChildForm := MainForm.ActiveMDIChild;
+    if Assigned(ChildForm) then begin
+      { Send WM_SYSCOMMAND messages so that we get sounds }
+      if Sender = FRestoreItem then
+        Cmd := SC_RESTORE
+      else if Sender = FCloseItem then
+        Cmd := SC_CLOSE
+      else
+        Cmd := SC_MINIMIZE;
+      SendMessage(ChildForm.Handle, WM_SYSCOMMAND, Cmd, LPARAM(GetMessagePos()));
+    end;
+  end;
+end;
+
+procedure TTBMDIButtonsItem.InvalidateSystemMenuItem;
+var
+  View: TTBView;
+begin
+  if Assigned((Owner as TTBMDIHandler).FToolbar) then begin
+    View := TTBMDIHandler(Owner).FToolbar.View;
+    View.Invalidate(View.Find(TTBMDIHandler(Owner).FSystemMenuItem));
+  end;
+end;
+
+
+{ TTBMDIWindowItem }
+
+constructor TTBMDIWindowItem.Create(AOwner: TComponent);
+var
+  Form: TForm;
+begin
+  inherited;
+  ItemStyle := ItemStyle + [tbisEmbeddedGroup];
+  Caption := STBMDIWindowItemDefCaption;
+  FWindowMenu := TMenuItem.Create(Self);
+
+  if not(csDesigning in ComponentState) then begin
+    { Need to set WindowMenu before MDI children are created. Otherwise the
+      list incorrectly shows the first 9 child windows, even if window 10+ is
+      active. }  
+    Form := Application.MainForm;
+    if (Form = nil) and (Screen.FormCount > 0) then
+      Form := Screen.Forms[0];
+    SetForm(Form);
+  end;
+end;
+
+procedure TTBMDIWindowItem.GetChildren(Proc: TGetChildProc; Root: TComponent);
+begin
+end;
+
+procedure TTBMDIWindowItem.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited;
+  if (Operation = opRemove) and (AComponent = FForm) then
+    SetForm(nil);
+end;
+
+procedure TTBMDIWindowItem.SetForm(AForm: TForm);
+begin
+  if FForm <> AForm then begin
+    if Assigned(FForm) and (FForm.WindowMenu = FWindowMenu) then
+      FForm.WindowMenu := nil;
+    FForm := AForm;
+    if Assigned(FForm) then
+      FForm.FreeNotification(Self);
+  end;
+  if Assigned(FForm) then
+    FForm.WindowMenu := FWindowMenu;
+end;
+
+procedure TTBMDIWindowItem.EnabledChanged;
+var
+  I: Integer;
+begin
+  inherited;
+  for I := 0 to Count-1 do
+    Items[I].Enabled := Enabled;
+end;
+
+procedure TTBMDIWindowItem.InitiateAction;
+var
+  MainForm: TForm;
+  I: Integer;
+  M: HMENU;
+  Item: TTBCustomItem;
+  ItemCount: Integer;
+begin
+  inherited;
+  if csDesigning in ComponentState then
+    Exit;
+  MainForm := Application.MainForm;
+  if Assigned(MainForm) then
+    SetForm(MainForm);
+  if FForm = nil then
+    Exit;
+  if FForm.ClientHandle <> 0 then
+    { This is needed, otherwise windows selected on the More Windows dialog
+      don't move back into the list } 
+    SendMessage(FForm.ClientHandle, WM_MDIREFRESHMENU, 0, 0);
+  M := FWindowMenu.Handle;
+  ItemCount := GetMenuItemCount(M) - 1;
+  if ItemCount < 0 then
+    ItemCount := 0;
+  while Count < ItemCount do begin
+    Item := TTBCustomItem.Create(Self);
+    Item.Enabled := Enabled;
+    Item.OnClick := ItemClick;
+    Add(Item);
+  end;
+  while Count > ItemCount do
+    Items[Count-1].Free;
+  for I := 0 to ItemCount-1 do begin
+    Item := Items[I];
+    Item.Tag := {$IFDEF CLR}TTag{$ENDIF}(Word(GetMenuItemID(M, I+1)));
+    Item.Caption := GetMenuItemStr(M, I+1);
+    Item.Checked := GetMenuState(M, I+1, MF_BYPOSITION) and MF_CHECKED <> 0;
+  end;
+  if Assigned(FOnUpdate) then
+    FOnUpdate(Self);
+end;
+
+procedure TTBMDIWindowItem.ItemClick(Sender: TObject);
+var
+  Form: TForm;
+begin
+  Form := Application.MainForm;
+  if Assigned(Form) then
+    PostMessage(Form.Handle, WM_COMMAND, Word(TTBCustomItem(Sender).Tag), 0);
+end;
+
+end.

ToolBar 2000/Source/TB2MRU.pas

@@ -0,0 +1,419 @@
+unit TB2MRU;
+
+{$MODE Delphi}
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2006 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2MRU.pas,v 1.24 2006/03/12 23:11:59 jr Exp $
+}
+
+interface
+
+{$I TB2Ver.inc}
+
+uses
+  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  FileUtil, TB2Item, IniFiles, Registry;
+
+type
+  TTBMRUListClickEvent = procedure(Sender: TObject; const Filename: String) of object;
+
+  TTBMRUList = class(TComponent)
+  private
+    FAddFullPath: Boolean;
+    FContainer: TTBCustomItem;
+    FHidePathExtension: Boolean;
+    FList: TStrings;
+    FMaxItems: Integer;
+    FOnChange: TNotifyEvent;
+    FOnClick: TTBMRUListClickEvent;
+    FPrefix: String;
+    procedure ClickHandler(Sender: TObject);
+    procedure SetHidePathExtension(Value: Boolean);
+    procedure SetList(Value: TStrings);
+    procedure SetMaxItems(Value: Integer);
+  protected
+    property Container: TTBCustomItem read FContainer;
+    function GetItemClass: TTBCustomItemClass; virtual;
+    procedure SetItemCaptions; virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Add(Filename: String);
+    procedure Remove(const Filename: String);
+    procedure LoadFromIni(Ini: TCustomIniFile; const Section: String);
+    procedure LoadFromRegIni(Ini: TRegIniFile; const Section: String);
+    procedure SaveToIni(Ini: TCustomIniFile; const Section: String);
+    procedure SaveToRegIni(Ini: TRegIniFile; const Section: String);
+  published
+    { MaxItems must be published before Items }
+    property AddFullPath: Boolean read FAddFullPath write FAddFullPath default True;
+    property HidePathExtension: Boolean read FHidePathExtension write SetHidePathExtension default True;
+    property MaxItems: Integer read FMaxItems write SetMaxItems default 4;
+    property Items: TStrings read FList write SetList;
+    property OnClick: TTBMRUListClickEvent read FOnClick write FOnClick;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property Prefix: String read FPrefix write FPrefix;
+  end;
+
+  TTBMRUListItem = class(TTBCustomItem)
+  private
+    FMRUList: TTBMRUList;
+    procedure SetMRUList(Value: TTBMRUList);
+  protected
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property MRUList: TTBMRUList read FMRUList write SetMRUList;
+    //property Caption;
+    //property LinkSubitems;
+  end;
+
+implementation
+
+uses
+  {$IFDEF CLR} System.Text, System.IO, {$ENDIF}
+  TB2Common, TB2Consts, CommDlg;
+
+procedure ChangeFileNameToTitle(var S: String);
+{$IFNDEF CLR}
+var
+  Buf: array[0..MAX_PATH-1] of Char;
+begin
+  if GetFileTitle(PChar(S), Buf, SizeOf(Buf) div SizeOf(Buf[0])) = 0 then
+    S := Buf;
+end;
+{$ELSE}
+var
+  Buf: StringBuilder;
+begin
+  Buf := StringBuilder.Create(MAX_PATH);
+  if GetFileTitle(S, Buf, Buf.Capacity) = 0 then
+    S := Buf.ToString;
+end;
+{$ENDIF}
+
+
+{ TTBMRUListStrings }
+
+type
+  TTBMRUListStrings = class(TStrings)
+  private
+    FInternalList: TStrings;
+    FMRUList: TTBMRUList;
+    procedure Changed;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear; override;
+    procedure Delete(Index: Integer); override;
+    function Get(Index: Integer): String; override;
+    function GetCount: Integer; override;
+    function IndexOf(const S: String): Integer; override; 
+    procedure Insert(Index: Integer; const S: String); override;
+    procedure Move(CurIndex, NewIndex: Integer); override;
+    procedure Put(Index: Integer; const S: String); override;
+  end;
+
+constructor TTBMRUListStrings.Create;
+begin
+  inherited;
+  FInternalList := TStringList.Create;
+end;
+
+destructor TTBMRUListStrings.Destroy;
+begin
+  inherited;
+  FInternalList.Free;
+end;
+
+procedure TTBMRUListStrings.Changed;
+begin
+  if Assigned(FMRUList.FOnChange) and
+     not(csLoading in FMRUList.ComponentState) then
+    FMRUList.FOnChange(FMRUList);
+end;
+
+procedure TTBMRUListStrings.Clear;
+var
+  I: Integer;
+begin
+  for I := FInternalList.Count-1 downto 0 do
+    Delete(I);
+end;
+
+procedure TTBMRUListStrings.Delete(Index: Integer);
+begin
+  FMRUList.FContainer[Index].Free;
+  FInternalList.Delete(Index);
+  FMRUList.SetItemCaptions;
+  Changed;
+end;
+
+function TTBMRUListStrings.Get(Index: Integer): String;
+begin
+  Result := FInternalList[Index];
+end;
+
+function TTBMRUListStrings.GetCount: Integer;
+begin
+  Result := FInternalList.Count;
+end;
+
+function TTBMRUListStrings.IndexOf(const S: String): Integer;
+begin
+  { This is identical to TStrings.IndexOf except we use SameFileName. }
+  for Result := 0 to GetCount - 1 do
+    {$IFDEF JR_D6}
+    if SameFileName(Get(Result), S) then Exit;
+    {$ELSE}
+    if AnsiCompareFileName(Get(Result), S) = 0 then Exit;
+    {$ENDIF}
+  Result := -1;
+end;
+
+procedure TTBMRUListStrings.Insert(Index: Integer; const S: String);
+var
+  Item: TTBCustomItem;
+begin
+  Item := FMRUList.GetItemClass.Create(FMRUList.FContainer);
+  Item.OnClick := FMRUList.ClickHandler;
+  FMRUList.FContainer.Insert(Index, Item);
+  FInternalList.Insert(Index, S);
+  FMRUList.SetItemCaptions;
+  Changed;
+end;
+
+procedure TTBMRUListStrings.Move(CurIndex, NewIndex: Integer);
+begin
+  FInternalList.Move(CurIndex, NewIndex);
+  FMRUList.FContainer.Move(CurIndex, NewIndex);
+  FMRUList.SetItemCaptions;
+  Changed;
+end;
+
+procedure TTBMRUListStrings.Put(Index: Integer; const S: String);
+begin
+  FInternalList[Index] := S;
+  FMRUList.SetItemCaptions;
+  Changed;
+end;
+
+
+{ TTBMRUList }
+
+constructor TTBMRUList.Create(AOwner: TComponent);
+begin
+  inherited;
+  FAddFullPath := True;
+  FHidePathExtension := True;
+  FMaxItems := 4;
+  FPrefix := 'MRU';
+  FList := TTBMRUListStrings.Create;
+  TTBMRUListStrings(FList).FMRUList := Self;
+  FContainer := TTBCustomItem.Create(nil);
+end;
+
+destructor TTBMRUList.Destroy;
+begin
+  FContainer.Free;
+  FList.Free;
+  inherited;
+end;
+
+procedure TTBMRUList.Add(Filename: String);
+var
+  I: Integer;
+begin
+  if AddFullPath then
+    Filename := ExpandFileNameUTF8(Filename); { *Преобразовано из ExpandFileName* }
+  { If Filename is already in the MRU list, move it to the top }
+  I := FList.IndexOf(Filename);
+  if I <> -1 then begin
+    if I > 0 then
+      FList.Move(I, 0);
+    FList[0] := Filename;  { ...in case the capitalization changed }
+  end
+  else
+    FList.Insert(0, Filename);
+end;
+
+procedure TTBMRUList.Remove(const Filename: String);
+var
+  I: Integer;
+begin
+  I := FList.IndexOf(Filename);
+  if I <> -1 then
+    FList.Delete(I);
+end;
+
+procedure TTBMRUList.LoadFromIni(Ini: TCustomIniFile; const Section: String);
+var
+  I: Integer;
+  S: String;
+begin
+  FList.Clear;
+  for I := 1 to FMaxItems do begin
+    S := Ini.ReadString(Section, FPrefix + IntToStr(I), '');
+    if S <> '' then
+      FList.Add(S);
+  end;
+end;
+
+procedure TTBMRUList.LoadFromRegIni(Ini: TRegIniFile; const Section: String);
+var
+  I: Integer;
+  S: String;
+begin
+  FList.Clear;
+  for I := 1 to FMaxItems do begin
+    S := Ini.ReadString(Section, FPrefix + IntToStr(I), '');
+    if S <> '' then
+      FList.Add(S);
+  end;
+end;
+
+procedure TTBMRUList.SaveToIni(Ini: TCustomIniFile; const Section: String);
+var
+  I: Integer;
+begin
+  for I := 1 to FMaxItems do begin
+    if I <= FList.Count then
+      Ini.WriteString(Section, FPrefix + IntToStr(I), FList[I-1])
+    else
+      Ini.DeleteKey(Section, FPrefix + IntToStr(I));
+  end;
+end;
+
+procedure TTBMRUList.SaveToRegIni(Ini: TRegIniFile; const Section: String);
+var
+  I: Integer;
+begin
+  for I := 1 to FMaxItems do begin
+    if I <= FList.Count then
+      Ini.WriteString(Section, FPrefix + IntToStr(I), FList[I-1])
+    else
+      Ini.DeleteKey(Section, FPrefix + IntToStr(I));
+  end;
+end;
+
+procedure TTBMRUList.SetItemCaptions;
+var
+  I, J: Integer;
+  Key: Char;
+  S: String;
+begin
+  while FList.Count > FMaxItems do
+    FList.Delete(FList.Count-1);
+  for I := 0 to FContainer.Count-1 do begin
+    Key := #0;
+    if I < 9 then
+      Key := Chr(Ord('1') + I)
+    else begin
+      { No more numbers; try letters }
+      J := I - 9;
+      if J < 26 then
+        Key := Chr(Ord('A') + J);
+    end;
+    S := FList[I];
+    if HidePathExtension then
+      ChangeFileNameToTitle(S);
+    S := EscapeAmpersands(S);
+    if Key <> #0 then
+      FContainer[I].Caption := Format('&%s %s', [Key, S])
+    else
+      FContainer[I].Caption := S;
+  end;
+end;
+
+procedure TTBMRUList.ClickHandler(Sender: TObject);
+var
+  I: Integer;
+begin
+  I := FContainer.IndexOf(TTBCustomItem(Sender));
+  if I <> -1 then begin
+    if I > 0 then
+      FList.Move(I, 0);
+    if Assigned(FOnClick) then
+      FOnClick(Self, FList[0]);
+  end;
+end;
+
+procedure TTBMRUList.SetHidePathExtension(Value: Boolean);
+begin
+  if FHidePathExtension <> Value then begin
+    FHidePathExtension := Value;
+    SetItemCaptions;
+  end;
+end;
+
+procedure TTBMRUList.SetList(Value: TStrings);
+begin
+  FList.Assign(Value);
+end;
+
+procedure TTBMRUList.SetMaxItems(Value: Integer);
+begin
+  FMaxItems := Value;
+  SetItemCaptions;
+end;
+
+function TTBMRUList.GetItemClass: TTBCustomItemClass;
+begin
+  Result := TTBCustomItem;
+end;
+
+
+{ TTBMRUListItem }
+
+constructor TTBMRUListItem.Create(AOwner: TComponent);
+begin
+  inherited;
+  ItemStyle := ItemStyle + [tbisEmbeddedGroup];
+  Caption := STBMRUListItemDefCaption;
+end;
+
+procedure TTBMRUListItem.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited;
+  if (AComponent = FMRUList) and (Operation = opRemove) then
+    SetMRUList(nil);
+end;
+
+procedure TTBMRUListItem.SetMRUList(Value: TTBMRUList);
+begin
+  if FMRUList <> Value then begin
+    FMRUList := Value;
+    if Assigned(FMRUList) then begin
+      Value.FreeNotification(Self);
+      LinkSubitems := FMRUList.FContainer;
+    end
+    else
+      LinkSubitems := nil;
+  end;
+end;
+
+end.

ToolBar 2000/Source/TB2OleMarshal.pas

@@ -0,0 +1,203 @@
+unit TB2OleMarshal;
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2008 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2OleMarshal.pas,v 1.4 2008/09/17 18:04:09 jr Exp $
+
+  This unit implements the TTBStandardOleMarshalObject class, an exact clone of
+  .NET Framework 2.0's StandardOleMarshalObject class, which isn't available
+  on the .NET Framework 1.1-based Delphi 2006.
+  On Delphi 2007, I had planned to switch to StandardOleMarshalObject, but it
+  turns out there's a bug that causes it raise AV's on x64 & IA-64 (seen as
+  E_POINTER on the client side). Coincidentally, TTBStandardOleMarshalObject
+  does not suffer from this bug (even though it was intended to be an exact
+  clone!).
+
+  The class "replaces the standard common language runtime (CLR) free-threaded
+  marshaler with the standard OLE STA marshaler." It "prevents calls made into
+  a hosting object by OLE from entering threads other than the UI thread."
+  For more information, see:
+  http://msdn2.microsoft.com/system.runtime.interopservices.standardolemarshalobject.aspx
+}
+
+interface
+
+{$I TB2Ver.inc}
+
+uses
+  System.Runtime.InteropServices, Windows;
+
+type
+  { Our declaration for IMarshal }
+  [ComImport,
+  GuidAttribute('00000003-0000-0000-C000-000000000046'),
+  InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
+  ITBMarshal = interface
+    [PreserveSig]
+    function GetUnmarshalClass([MarshalAs(UnmanagedType.LPStruct)] riid: Guid;
+      pv: IntPtr; dwDestContext: Longint; pvDestContext: IntPtr;
+      mshlflags: Longint; out pCid: Guid): HRESULT;
+    [PreserveSig]
+    function GetMarshalSizeMax([MarshalAs(UnmanagedType.LPStruct)] riid: Guid;
+      pv: IntPtr; dwDestContext: Longint; pvDestContext: IntPtr;
+      mshlflags: Longint; out pSize: Longint): HRESULT;
+    [PreserveSig]
+    function MarshalInterface([in, MarshalAs(UnmanagedType.Interface)] pStm: TObject;
+      [MarshalAs(UnmanagedType.LPStruct)] riid: Guid; pv: IntPtr;
+      dwDestContext: Longint; pvDestContext: IntPtr; mshlflags: Longint): HRESULT;
+    [PreserveSig]
+    function UnmarshalInterface([in, MarshalAs(UnmanagedType.Interface)] pStm: TObject;
+      [MarshalAs(UnmanagedType.LPStruct)] riid: Guid; out ppv: IntPtr): HRESULT;
+    [PreserveSig]
+    function ReleaseMarshalData([in, MarshalAs(UnmanagedType.Interface)] pStm: TObject): HRESULT;
+    [PreserveSig]
+    function DisconnectObject(dwReserved: Longint): HRESULT;
+  end;
+
+  TTBStandardOleMarshalObject = class(System.MarshalByRefObject, ITBMarshal)
+  private
+    function GetStdMarshaller(const riid: Guid; const dwDestContext: Longint;
+      const mshlflags: Longint): IntPtr;
+    { IMarshal }
+    function GetUnmarshalClass(riid: Guid; pv: IntPtr; dwDestContext: Longint;
+      pvDestContext: IntPtr; mshlflags: Longint; out pCid: Guid): HRESULT;
+    function GetMarshalSizeMax(riid: Guid; pv: IntPtr; dwDestContext: Longint;
+      pvDestContext: IntPtr; mshlflags: Longint; out pSize: Longint): HRESULT;
+    function MarshalInterface(pStm: TObject; riid: Guid; pv: IntPtr;
+      dwDestContext: Longint; pvDestContext: IntPtr; mshlflags: Longint): HRESULT;
+    function UnmarshalInterface(pStm: TObject; riid: Guid; out ppv: IntPtr): HRESULT;
+    function ReleaseMarshalData(pStm: TObject): HRESULT;
+    function DisconnectObject(dwReserved: Longint): HRESULT;
+  end;
+
+implementation
+
+{ Note: According to http://blogs.msdn.com/cbrumme/archive/2003/04/15/51335.aspx
+  the Marshal.ReleaseComObject(pStm) calls are needed to work around a "quirk
+  of OLE32 on some versions of the operating system". }
+
+uses
+  System.Security;
+
+const
+  ole32 = 'ole32.dll';
+
+[SuppressUnmanagedCodeSecurity, DllImport(ole32, CharSet = CharSet.Unicode, EntryPoint = 'CoGetMarshalSizeMax')]
+function _CoGetMarshalSizeMax(out pulSize: Longint;
+  [in, MarshalAs(UnmanagedType.LPStruct)] riid: Guid; pUnk: IntPtr;
+  dwDestContext: Longint; pvDestContext: IntPtr;
+  mshlflags: Longint): HRESULT; external;
+[SuppressUnmanagedCodeSecurity, DllImport(ole32, CharSet = CharSet.Unicode, EntryPoint = 'CoGetStandardMarshal')]
+function _CoGetStandardMarshal([in, MarshalAs(UnmanagedType.LPStruct)] iid: Guid;
+  pUnk: IntPtr; dwDestContext: Longint; pvDestContext: IntPtr;
+  mshlflags: Longint; out ppMarshal: IntPtr): HRESULT; external;
+[SuppressUnmanagedCodeSecurity, DllImport(ole32, CharSet = CharSet.Unicode, EntryPoint = 'CoMarshalInterface')]
+function _CoMarshalInterface([in, MarshalAs(UnmanagedType.Interface)] pStm: TObject;
+  [in, MarshalAs(UnmanagedType.LPStruct)] riid: Guid; pUnk: IntPtr;
+  dwDestContext: Longint; pvDestContext: IntPtr;
+  mshlflags: Longint): HRESULT; external;
+
+function TTBStandardOleMarshalObject.GetStdMarshaller(const riid: Guid;
+  const dwDestContext: Longint; const mshlflags: Longint): IntPtr;
+var
+  V_1: IntPtr;
+begin
+  Result := nil;
+  V_1 := Marshal.GetIUnknownForObject(Self);
+  if V_1 <> nil then begin
+    try
+      if _CoGetStandardMarshal(riid, V_1, dwDestContext, nil, mshlflags, Result) = S_OK then
+        Exit;
+    finally
+      Marshal.Release(V_1);
+    end;
+  end;
+  { Note: Localizing this message isn't necessary because a user will never
+    see it; the .NET runtime will catch it and translate it into a
+    COR_E_EXCEPTION HRESULT. }
+  raise InvalidOperationException.Create('TTBStandardOleMarshalObject.GetStdMarshaller failed');
+end;
+
+function TTBStandardOleMarshalObject.GetUnmarshalClass(riid: Guid; pv: IntPtr;
+  dwDestContext: Longint; pvDestContext: IntPtr; mshlflags: Longint;
+  out pCid: Guid): HRESULT;
+begin
+  { StandardOleMarshalObject does "pCid := TypeOf(IStdMarshal).GUID" here, but
+    we haven't declared IStdMarshal anywhere, so create a fresh Guid }
+  pCid := Guid.Create('00000017-0000-0000-C000-000000000046');  { CLSID_StdMarshal }
+  Result := S_OK;
+end;
+
+function TTBStandardOleMarshalObject.GetMarshalSizeMax(riid: Guid; pv: IntPtr;
+  dwDestContext: Longint; pvDestContext: IntPtr; mshlflags: Longint;
+  out pSize: Longint): HRESULT;
+var
+  V_0: IntPtr;
+begin
+  V_0 := GetStdMarshaller(riid, dwDestContext, mshlflags);
+  try
+    Result := _CoGetMarshalSizeMax(pSize, riid, V_0, dwDestContext, pvDestContext, mshlflags);
+  finally
+    Marshal.Release(V_0);
+  end;
+end;
+
+function TTBStandardOleMarshalObject.MarshalInterface(pStm: TObject; riid: Guid;
+  pv: IntPtr; dwDestContext: Longint; pvDestContext: IntPtr;
+  mshlflags: Longint): HRESULT;
+var
+  V_0: IntPtr;
+begin
+  V_0 := GetStdMarshaller(riid, dwDestContext, mshlflags);
+  try
+    Result := _CoMarshalInterface(pStm, riid, V_0, dwDestContext, pvDestContext, mshlflags);
+  finally
+    Marshal.Release(V_0);
+    if pStm <> nil then
+      Marshal.ReleaseComObject(pStm);
+  end;
+end;
+
+function TTBStandardOleMarshalObject.UnmarshalInterface(pStm: TObject;
+  riid: Guid; out ppv: IntPtr): HRESULT;
+begin
+  ppv := nil;
+  if pStm <> nil then
+    Marshal.ReleaseComObject(pStm);
+  Result := E_NOTIMPL;
+end;
+
+function TTBStandardOleMarshalObject.ReleaseMarshalData(pStm: TObject): HRESULT;
+begin
+  if pStm <> nil then
+    Marshal.ReleaseComObject(pStm);
+  Result := E_NOTIMPL;
+end;
+
+function TTBStandardOleMarshalObject.DisconnectObject(dwReserved: Longint): HRESULT;
+begin
+  Result := E_NOTIMPL;
+end;
+
+end.

ToolBar 2000/Source/TB2Reg.pas

@@ -0,0 +1,317 @@
+unit TB2Reg;
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2008 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2Reg.pas,v 1.32 2008/09/18 19:08:40 jr Exp $
+}
+
+interface
+
+{$I TB2Ver.inc}
+
+uses
+  Windows, SysUtils, Classes, Graphics, Controls, Dialogs, ActnList, ImgList,
+  {$IFDEF JR_D6} DesignIntf, DesignEditors, VCLEditors, {$ELSE} DsgnIntf, {$ENDIF}
+  TB2Toolbar, TB2ToolWindow, TB2Dock, TB2Item, TB2ExtItems, TB2MRU, TB2MDI,
+  TB2DsgnItemEditor;
+
+procedure Register;
+procedure TBRegisterClasses(const AClasses: array of TPersistentClass);
+
+implementation
+
+{$IFDEF CLR}
+{ Delphi.NET doesn't use DCR files for component icons }
+{$R 'Icons\TTBBackground.bmp'}
+{$R 'Icons\TTBBackground16.bmp'}
+{$R 'Icons\TTBDock.bmp'}
+{$R 'Icons\TTBDock16.bmp'}
+{$R 'Icons\TTBImageList.bmp'}
+{$R 'Icons\TTBImageList16.bmp'}
+{$R 'Icons\TTBItemContainer.bmp'}
+{$R 'Icons\TTBItemContainer16.bmp'}
+{$R 'Icons\TTBMDIHandler.bmp'}
+{$R 'Icons\TTBMDIHandler16.bmp'}
+{$R 'Icons\TTBMRUList.bmp'}
+{$R 'Icons\TTBMRUList16.bmp'}
+{$R 'Icons\TTBPopupMenu.bmp'}
+{$R 'Icons\TTBPopupMenu16.bmp'}
+{$R 'Icons\TTBToolbar.bmp'}
+{$R 'Icons\TTBToolbar16.bmp'}
+{$R 'Icons\TTBToolWindow.bmp'}
+{$R 'Icons\TTBToolWindow16.bmp'}
+{$ENDIF}
+
+uses
+  {$IFDEF CLR} WinUtils, {$ENDIF}
+  ImgEdit;
+
+{$IFDEF JR_D5}
+
+{ TTBImageIndexPropertyEditor }
+
+{ Unfortunately TComponentImageIndexPropertyEditor seems to be gone in
+  Delphi 6, so we have to use our own image index property editor class } 
+
+type
+  TTBImageIndexPropertyEditor = class(TIntegerProperty
+    {$IFDEF JR_D6} , ICustomPropertyListDrawing {$ENDIF})
+  public
+    function GetAttributes: TPropertyAttributes; override;
+    procedure GetValues(Proc: TGetStrProc); override;
+    function GetImageListAt(Index: Integer): TCustomImageList; virtual;
+
+    // ICustomPropertyListDrawing
+    procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;
+      var AHeight: Integer); {$IFNDEF JR_D6} override; {$ENDIF}
+    procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
+      var AWidth: Integer); {$IFNDEF JR_D6} override; {$ENDIF}
+    procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
+      const ARect: TRect; ASelected: Boolean); {$IFNDEF JR_D6} override; {$ENDIF}
+  end;
+
+function TTBImageIndexPropertyEditor.GetAttributes: TPropertyAttributes;
+begin
+  Result := [paMultiSelect, paValueList, paRevertable];
+end;
+
+function TTBImageIndexPropertyEditor.GetImageListAt(Index: Integer): TCustomImageList;
+begin
+  Result := nil;
+end;
+
+procedure TTBImageIndexPropertyEditor.GetValues(Proc: TGetStrProc);
+var
+  ImgList: TCustomImageList;
+  I: Integer;
+begin
+  ImgList := GetImageListAt(0);
+  if Assigned(ImgList) then
+    for I := 0 to ImgList.Count-1 do
+      Proc(IntToStr(I));
+end;
+
+procedure TTBImageIndexPropertyEditor.ListDrawValue(const Value: string;
+  ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
+var
+  ImgList: TCustomImageList;
+  X: Integer;
+begin
+  ImgList := GetImageListAt(0);
+  ACanvas.FillRect(ARect);
+  X := ARect.Left + 2;
+  if Assigned(ImgList) then begin
+    ImgList.Draw(ACanvas, X, ARect.Top + 2, StrToInt(Value));
+    Inc(X, ImgList.Width);
+  end;
+  ACanvas.TextOut(X + 3, ARect.Top + 1, Value);
+end;
+
+procedure TTBImageIndexPropertyEditor.ListMeasureHeight(const Value: string;
+  ACanvas: TCanvas; var AHeight: Integer);
+var
+  ImgList: TCustomImageList;
+begin
+  ImgList := GetImageListAt(0);
+  AHeight := ACanvas.TextHeight(Value) + 2;
+  if Assigned(ImgList) and (ImgList.Height + 4 > AHeight) then
+    AHeight := ImgList.Height + 4;
+end;
+
+procedure TTBImageIndexPropertyEditor.ListMeasureWidth(const Value: string;
+  ACanvas: TCanvas; var AWidth: Integer);
+var
+  ImgList: TCustomImageList;
+begin
+  ImgList := GetImageListAt(0);
+  AWidth := ACanvas.TextWidth(Value) + 4;
+  if Assigned(ImgList) then
+    Inc(AWidth, ImgList.Width);
+end;
+
+{ TTBItemImageIndexPropertyEditor }
+
+type
+  TTBItemImageIndexPropertyEditor = class(TTBImageIndexPropertyEditor)
+  public
+    function GetImageListAt(Index: Integer): TCustomImageList; override;
+  end;
+
+function TTBItemImageIndexPropertyEditor.GetImageListAt(Index: Integer): TCustomImageList;
+var
+  C: TPersistent;
+  Item: TTBCustomItem;
+begin
+  Result := nil;
+  { ? I'm guessing that the Index parameter is a component index (one that
+    would be passed to the GetComponent function). }
+  C := GetComponent(Index);
+  if C is TTBCustomItem then begin
+    Item := TTBCustomItem(C);
+    repeat
+      Result := Item.Images;
+      if Assigned(Result) then
+        Break;
+      Item := Item.Parent;
+      if Item = nil then
+        Break;
+      Result := Item.SubMenuImages;
+    until Assigned(Result);
+  end;
+end;
+
+{$ENDIF}
+
+{ TTBImageListEditor }
+
+type
+  TTBImageListEditor = class(TComponentEditor)
+  public
+    procedure Edit; override;
+    procedure ExecuteVerb(Index: Integer); override;
+    function GetVerb(Index: Integer): String; override;
+    function GetVerbCount: Integer; override;
+  end;
+
+procedure TTBImageListEditor.Edit;
+var
+  ImgList: TTBImageList;
+begin
+  ImgList := Component as TTBImageList;
+  if not ImgList.ImagesBitmap.Empty then begin
+    if MessageDlg('The image list''s ImagesBitmap property has ' +
+       'a bitmap assigned. Because of this, any changes you make in the ' +
+       'Image List Editor will not be preserved when the form is saved.'#13#10#13#10 +
+       'Do you want to open the editor anyway?', mtWarning,
+       [mbYes, mbNo], 0) <> mrYes then
+      Exit;
+  end;
+  EditImageList(ImgList);
+end;
+
+procedure TTBImageListEditor.ExecuteVerb(Index: Integer);
+begin
+  if Index = 0 then
+    Edit;
+end;
+
+function TTBImageListEditor.GetVerbCount: Integer;
+begin
+  Result := 1;
+end;
+
+function TTBImageListEditor.GetVerb(Index: Integer): String;
+begin
+  if Index = 0 then
+    Result := 'ImageList Editor...'
+  else
+    Result := '';
+end;
+
+
+procedure TBRegisterClasses(const AClasses: array of TPersistentClass);
+{$IFDEF CLR}
+var
+  I: Integer;
+  FoundClass: TPersistentClass;
+{$ENDIF}
+begin
+  {$IFDEF CLR}
+  { Hack for Delphi.NET (2006): If you recompile an already-installed package
+    the IDE doesn't unload the old package before installing the new one.
+    Therefore, we must search for and unregister any existing classes before
+    registering new ones, to avoid having two incompatible sets of classes
+    registered at the same time.
+    Without this, if we rebuild tb2kdsgn_dn10 (which implicitly reloads
+    tb2k_dn10) and then attempt to open the Demo project's main form in the
+    IDE, we get a "Toolbar item cannot be inserted into container of type
+    TTBToolbar" exception inside TTBCustomItem.SetParentComponent, because
+    apparently the TTBToolbar class it's trying to use is located in the new
+    assembly, while the item class is located in the old assembly.
+    Note: It appears that this issue only affects registered classes; there
+    is no need for an "UnRegisterComponents" call. }
+  for I := High(AClasses) downto Low(AClasses) do begin
+    { Unregister all classes with the same name }
+    while True do begin
+      FoundClass := GetClass(AClasses[I].ClassName);
+      if FoundClass = nil then
+        Break;
+      UnRegisterClass(FoundClass);
+    end;
+  end;
+  {$ENDIF}
+  RegisterClasses(AClasses);
+end;
+
+procedure Register;
+begin
+  { Note: On Delphi.NET 2006, it's possible for this procedure to be called
+    a second time on the same tb2kdsgn instance. See comments in
+    TBRegisterItemClass. }
+
+  RegisterComponents('Toolbar2000', [TTBDock, TTBToolbar, TTBToolWindow,
+    TTBPopupMenu, TTBImageList, TTBItemContainer, TTBBackground, TTBMRUList,
+    TTBMDIHandler]);
+  {$IFDEF JR_D4}
+  RegisterActions('', [TTBEditAction], nil);
+  {$ENDIF}
+  RegisterNoIcon([TTBCustomItem]);
+  TBRegisterClasses([TTBItem, TTBGroupItem, TTBSubmenuItem, TTBSeparatorItem,
+    TTBEditItem, TTBMRUListItem, TTBControlItem, TTBMDIWindowItem,
+    TTBVisibilityToggleItem]);
+
+  RegisterComponentEditor(TTBCustomToolbar, TTBItemsEditor);
+  RegisterComponentEditor(TTBItemContainer, TTBItemsEditor);
+  RegisterComponentEditor(TTBPopupMenu, TTBItemsEditor);
+  RegisterComponentEditor(TTBImageList, TTBImageListEditor);
+  RegisterPropertyEditor(TypeInfo(TTBRootItem), nil, '', TTBItemsPropertyEditor);
+  {$IFDEF JR_D5}
+  RegisterPropertyEditor(TypeInfo(TImageIndex), TTBCustomItem, 'ImageIndex',
+    TTBItemImageIndexPropertyEditor);
+  {$ENDIF}
+  {$IFDEF JR_D6}
+  { TShortCut properties show up like Integer properties in Delphi 6
+    without this... }
+  RegisterPropertyEditor(TypeInfo(TShortCut), TTBCustomItem, '',
+    TShortCutProperty);
+  {$ENDIF}
+
+  { Link in images for the toolbar buttons }
+  {$IFNDEF CLR}
+    {$R TB2DsgnItemEditor.res}
+  {$ELSE}
+    {$R 'Icons\TB2DsgnEditorImages.bmp'}
+    {$R 'Icons\TTBEditItem.bmp'}
+    {$R 'Icons\TTBGroupItem.bmp'}
+    {$R 'Icons\TTBMDIWindowItem.bmp'}
+    {$R 'Icons\TTBMRUListItem.bmp'}
+  {$ENDIF}
+  TBRegisterItemClass(TTBEditItem, 'New &Edit', HInstance);
+  TBRegisterItemClass(TTBGroupItem, 'New &Group Item', HInstance);
+  TBRegisterItemClass(TTBMRUListItem, 'New &MRU List Item', HInstance);
+  TBRegisterItemClass(TTBMDIWindowItem, 'New MDI &Windows List', HInstance);
+  TBRegisterItemClass(TTBVisibilityToggleItem, 'New &Visibility-Toggle Item', HInstance);
+end;
+
+end.

ToolBar 2000/Source/TB2ToolWindow.pas

@@ -0,0 +1,260 @@
+unit TB2ToolWindow;
+
+{$MODE Delphi}
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2005 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2ToolWindow.pas,v 1.18 2005/01/06 03:56:50 jr Exp $
+}
+
+interface
+
+{$I TB2Ver.inc}
+
+uses
+  LCLIntf, LCLType, LMessages, Classes, Graphics, Controls, TB2Dock;
+
+type
+  { TTBToolWindow }
+
+  TTBToolWindow = class(TTBCustomDockableWindow)
+  private
+    FMinClientWidth, FMinClientHeight, FMaxClientWidth, FMaxClientHeight: Integer;
+    FBarHeight, FBarWidth: Integer;
+    function CalcSize(ADock: TTBDock): TPoint;
+    function GetClientAreaWidth: Integer;
+    procedure SetClientAreaWidth(Value: Integer);
+    function GetClientAreaHeight: Integer;
+    procedure SetClientAreaHeight(Value: Integer);
+    procedure SetClientAreaSize(AWidth, AHeight: Integer);
+  protected
+    function DoArrange(CanMoveControls: Boolean; PreviousDockType: TTBDockType;
+      NewFloating: Boolean; NewDock: TTBDock): TPoint; override;
+    procedure GetBaseSize(var ASize: TPoint); override;
+    procedure GetMinMaxSize(var AMinClientWidth, AMinClientHeight,
+      AMaxClientWidth, AMaxClientHeight: Integer); override;
+    procedure Paint; override;
+    procedure SizeChanging(const AWidth, AHeight: Integer); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+
+    procedure ReadPositionData(const Data: TTBReadPositionData); override;
+    procedure WritePositionData(const Data: TTBWritePositionData); override;
+  published
+    property ActivateParent;
+    property Align;
+    property Anchors;
+    property BorderStyle;
+    property Caption;
+    property Color;
+    property CloseButton;
+    property CloseButtonWhenDocked;
+    property ClientAreaHeight: Integer read GetClientAreaHeight write SetClientAreaHeight;
+    property ClientAreaWidth: Integer read GetClientAreaWidth write SetClientAreaWidth;
+    property CurrentDock;
+    property DefaultDock;
+    property DockableTo;
+    property DockMode;
+    property DockPos;
+    property DockRow;
+    property DragHandleStyle;
+    property FloatingMode;
+    property Font;
+    property FullSize;
+    property HideWhenInactive;
+    property LastDock;
+    property MaxClientHeight: Integer read FMaxClientHeight write FMaxClientHeight default 0;
+    property MaxClientWidth: Integer read FMaxClientWidth write FMaxClientWidth default 0;
+    property MinClientHeight: Integer read FMinClientHeight write FMinClientHeight default 32;
+    property MinClientWidth: Integer read FMinClientWidth write FMinClientWidth default 32;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property Resizable;
+    property ShowCaption;
+    property ShowHint;
+    property Stretch;
+    property SmoothDrag;
+    property TabOrder;
+    property UseLastDock;
+    {}{property Version;}
+    property Visible;
+
+    property OnClose;
+    property OnCloseQuery;
+    {$IFDEF JR_D5}
+    property OnContextPopup;
+    {$ENDIF}
+    property OnDragDrop;
+    property OnDragOver;
+    property OnDockChanged;
+    property OnDockChanging;
+    property OnDockChangingHidden;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMove;
+    property OnRecreated;
+    property OnRecreating;
+    property OnResize;
+    property OnVisibleChanged;
+  end;
+
+implementation
+
+const
+  { Constants for TTBToolWindow-specific registry values. Do not localize! }
+  rvClientWidth = 'ClientWidth';
+  rvClientHeight = 'ClientHeight';
+
+
+{ TTBToolWindow }
+
+constructor TTBToolWindow.Create(AOwner: TComponent);
+begin
+  inherited;
+  FMinClientWidth := 32;
+  FMinClientHeight := 32;
+  { Initialize the client size to 32x32 }
+  SetBounds(Left, Top, 32, 32);
+end;
+
+procedure TTBToolWindow.Paint;
+var
+  R: TRect;
+begin
+  { Draw dotted border in design mode }
+  if csDesigning in ComponentState then
+    with Canvas do begin
+      R := ClientRect;
+      Pen.Style := psDot;
+      Pen.Color := clBtnShadow;
+      Brush.Style := bsClear;
+      Rectangle(R.Left, R.Top, R.Right, R.Bottom);
+      Pen.Style := psSolid;
+    end;
+end;
+
+procedure TTBToolWindow.ReadPositionData(const Data: TTBReadPositionData);
+begin
+  inherited;
+  { Restore ClientAreaWidth/ClientAreaHeight variables }
+  if Resizable then
+    with Data do
+      SetClientAreaSize(ReadIntProc(Name, rvClientWidth, FBarWidth, ExtraData),
+        ReadIntProc(Name, rvClientHeight, FBarHeight, ExtraData));
+end;
+
+procedure TTBToolWindow.WritePositionData(const Data: TTBWritePositionData);
+begin
+  inherited;
+  { Write values of FBarWidth/FBarHeight }
+  with Data do begin
+    WriteIntProc(Name, rvClientWidth, FBarWidth, ExtraData);
+    WriteIntProc(Name, rvClientHeight, FBarHeight, ExtraData);
+  end;
+end;
+
+procedure TTBToolWindow.GetMinMaxSize(var AMinClientWidth, AMinClientHeight,
+  AMaxClientWidth, AMaxClientHeight: Integer);
+begin
+  AMinClientWidth := FMinClientWidth;
+  AMinClientHeight := FMinClientHeight;
+  AMaxClientWidth := FMaxClientWidth;
+  AMaxClientHeight := FMaxClientHeight;
+end;
+
+procedure TTBToolWindow.SizeChanging(const AWidth, AHeight: Integer);
+begin
+  FBarWidth := AWidth;
+  if Parent <> nil then Dec(FBarWidth, Width - ClientWidth);
+  FBarHeight := AHeight;
+  if Parent <> nil then Dec(FBarHeight, Height - ClientHeight);
+end;
+
+function TTBToolWindow.CalcSize(ADock: TTBDock): TPoint;
+begin
+  Result.X := FBarWidth;
+  Result.Y := FBarHeight;
+  if Assigned(ADock) and (FullSize or Stretch) then begin
+    { If docked and stretching, return the minimum size so that the toolbar
+      can shrink below FBarWidth/FBarHeight }
+    if not(ADock.Position in [dpLeft, dpRight]) then
+      Result.X := FMinClientWidth
+    else
+      Result.Y := FMinClientHeight;
+  end;
+end;
+
+procedure TTBToolWindow.GetBaseSize(var ASize: TPoint);
+begin
+  ASize := CalcSize(CurrentDock);
+end;
+
+function TTBToolWindow.DoArrange(CanMoveControls: Boolean;
+  PreviousDockType: TTBDockType; NewFloating: Boolean; NewDock: TTBDock): TPoint;
+begin
+  Result := CalcSize(NewDock);
+end;
+
+function TTBToolWindow.GetClientAreaWidth: Integer;
+begin
+  if Parent = nil then
+    Result := Width
+  else
+    Result := ClientWidth;
+end;
+
+procedure TTBToolWindow.SetClientAreaWidth(Value: Integer);
+begin
+  SetClientAreaSize(Value, ClientAreaHeight);
+end;
+
+function TTBToolWindow.GetClientAreaHeight: Integer;
+begin
+  if Parent = nil then
+    Result := Height
+  else
+    Result := ClientHeight;
+end;
+
+procedure TTBToolWindow.SetClientAreaHeight(Value: Integer);
+begin
+  SetClientAreaSize(ClientAreaWidth, Value);
+end;
+
+procedure TTBToolWindow.SetClientAreaSize(AWidth, AHeight: Integer);
+var
+  Client: TRect;
+begin
+  if Parent = nil then
+    SetBounds(Left, Top, AWidth, AHeight)
+  else begin
+    Client := GetClientRect;
+    SetBounds(Left, Top, Width - Client.Right + AWidth,
+      Height - Client.Bottom + AHeight);
+  end;
+end;
+
+end.

ToolBar 2000/Source/TB2Ver.inc

@@ -0,0 +1,55 @@
+{ $jrsoftware: tb2k/Source/TB2Ver.inc,v 1.11 2008/09/13 21:06:45 jr Exp $ }
+
+{ Determine Delphi/C++Builder version }
+{$IFNDEF VER90}  { if it's not Delphi 2.0 }
+  {$IFNDEF VER93}  { and it's not C++Builder 1.0 }
+    {$DEFINE JR_D3}  { then it must be at least Delphi 3 or C++Builder 3 }
+    {$IFNDEF VER100}  { if it's not Delphi 3.0 }
+      {$IFNDEF VER120}  { Delphi 4/5's command line compiler doesn't like the ObjExportAll directive, so don't include it on Delphi 4/5 }
+        {$IFNDEF VER130}
+          {$ObjExportAll On}  { <- needed for compatibility with run-time packages in C++Builder 3+ }
+        {$ENDIF}
+      {$ENDIF}
+      {$IFNDEF VER110}  { and it's not C++Builder 3.0 }
+        {$DEFINE JR_D4}  { then it must be at least Delphi 4 or C++Builder 4 }
+        {$IFNDEF VER120} {$IFNDEF VER125}  { if it's not Delphi 4 or C++Builder 4 }
+          {$DEFINE JR_D5}  { then it must be at least Delphi 5 or C++Builder 5 }
+          {$IFNDEF VER130}  { if it's not Delphi 5 or C++Builder 5 }
+            {$DEFINE JR_D6}  { then it must be at least Delphi 6 or C++Builder 6 }
+            {$IFNDEF VER140}  { if it's not Delphi 6 or C++Builder 6 }
+              {$DEFINE JR_D7}  { then it must be at least Delphi 7 }
+              {$IFNDEF VER150}  { if it's not Delphi 7 }
+                {$DEFINE JR_D8}  { then it must be at least Delphi 8 }
+                {$IFNDEF VER160}  { if it's not Delphi 8 }
+                  {$DEFINE JR_D9}  { then it must be at least Delphi 9 (2005) }
+                  {$IFNDEF VER170}  { if it's not Delphi 9 (2005) }
+                    {$DEFINE JR_D10}  { then it must be at least Delphi 10 (2006) }
+                    { Delphi 11 (2007) is an odd case: it defines VER180 and VER185 on Win32, and VER190 on .NET }
+                    {$IFDEF VER185}  { if it's Win32 Delphi 11 (2007) exactly }
+                      {$DEFINE JR_D11}  { then it must be at least Delphi 11 (2007) }
+                    {$ENDIF}
+                    {$IFNDEF VER180}  { if it's neither Delphi 10 (2006) nor Win32 Delphi 11 (2007) }
+                      {$DEFINE JR_D11}  { then it must be at least Delphi 11 (2007) }
+                      {$IFNDEF VER190}  { if it's not .NET Delphi 11 (2007) }
+                        {$DEFINE JR_D12}  { then it must be at least Delphi 12 (2009) }
+                      {$ENDIF}
+                    {$ENDIF}
+                  {$ENDIF}
+                {$ENDIF}
+              {$ENDIF}
+            {$ENDIF}
+          {$ENDIF}
+        {$ENDIF} {$ENDIF}
+      {$ENDIF}
+    {$ENDIF}
+  {$ENDIF}
+{$ENDIF}
+
+{$ALIGN ON}
+{$BOOLEVAL OFF}
+{$LONGSTRINGS ON}
+{$TYPEDADDRESS OFF}
+{$WRITEABLECONST ON}
+{$IFDEF JR_D6}
+  {$WARN SYMBOL_PLATFORM OFF}
+{$ENDIF}

ToolBar 2000/Source/TB2Version.pas

@@ -0,0 +1,65 @@
+unit TB2Version;
+
+{$MODE Delphi}
+
+{
+  Toolbar2000
+  Copyright (C) 1998-2008 by Jordan Russell
+  All rights reserved.
+
+  The contents of this file are subject to the "Toolbar2000 License"; you may
+  not use or distribute this file except in compliance with the
+  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
+  TB2k-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
+
+  Alternatively, the contents of this file may be used under the terms of the
+  GNU General Public License (the "GPL"), in which case the provisions of the
+  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
+  the GPL may be found in GPL-LICENSE.txt or at:
+    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
+  If you wish to allow use of your version of this file only under the terms of
+  the GPL and not to allow others to use your version of this file under the
+  "Toolbar2000 License", indicate your decision by deleting the provisions
+  above and replace them with the notice and other provisions required by the
+  GPL. If you do not delete the provisions above, a recipient may use your
+  version of this file under either the "Toolbar2000 License" or the GPL.
+
+  $jrsoftware: tb2k/Source/TB2Version.pas,v 1.69 2008/09/13 21:39:24 jr Exp $
+}
+
+interface
+
+{$I TB2Ver.inc}
+
+const
+  Toolbar2000Version = '2.2.2';
+  Toolbar2000VersionPropText = 'Toolbar2000 version ' + Toolbar2000Version
+    {$IFDEF CLR} + ' (.NET)' {$ENDIF};
+
+type
+  TToolbar2000Version = type string;
+
+implementation
+
+const
+  Sig: {$IFNDEF CLR} PAnsiChar {$ELSE} AnsiString {$ENDIF} =
+    '- ' + Toolbar2000VersionPropText +
+    {$IFDEF VER90}  '/D2'+ {$ENDIF} {$IFDEF VER93}  '/CB1'+ {$ENDIF}
+    {$IFDEF VER100} '/D3'+ {$ENDIF} {$IFDEF VER110} '/CB3'+ {$ENDIF}
+    {$IFDEF VER120} '/D4'+ {$ENDIF} {$IFDEF VER125} '/CB4'+ {$ENDIF}
+    {$IFNDEF BCB} {$IFDEF VER130} '/D5'+ {$ENDIF} {$ELSE} {$IFDEF VER130} '/CB5'+ {$ENDIF} {$ENDIF}
+    {$IFNDEF BCB} {$IFDEF VER140} '/D6'+ {$ENDIF} {$ELSE} {$IFDEF VER140} '/CB6'+ {$ENDIF} {$ENDIF}
+    {$IFNDEF BCB} {$IFDEF VER150} '/D7'+ {$ENDIF} {$ELSE} {$IFDEF VER150} '/CB7'+ {$ENDIF} {$ENDIF}
+    {$IFNDEF BCB} {$IFDEF VER170} '/D9'+ {$ENDIF} {$ELSE} {$IFDEF VER170} '/CB9'+ {$ENDIF} {$ENDIF}
+    {$IFNDEF VER185} {$IFNDEF BCB} {$IFDEF VER180} '/D10'+ {$ENDIF} {$ELSE} {$IFDEF VER180} '/CB10'+ {$ENDIF} {$ENDIF} {$ENDIF}
+    {$IFNDEF BCB} {$IFDEF VER185} '/D11'+ {$ENDIF} {$ELSE} {$IFDEF VER185} '/CB11'+ {$ENDIF} {$ENDIF}
+    {$IFNDEF BCB} {$IFDEF VER190} '/D11'+ {$ENDIF} {$ELSE} {$IFDEF VER190} '/CB11'+ {$ENDIF} {$ENDIF}
+    {$IFNDEF BCB} {$IFDEF VER200} '/D12'+ {$ENDIF} {$ELSE} {$IFDEF VER200} '/CB12'+ {$ENDIF} {$ENDIF}
+    ', Copyright (C) 1998-2008 by Jordan Russell -';
+
+{$IFNDEF CLR}
+initialization
+  Sig := Sig;
+{$ENDIF}
+end.