Delphi控件源码

开发平台：
C++ Builder

am2000utils.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       Additional utilities                            }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000utils;
{$I am2000.inc}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, ExtCtrls,
  Forms, Dialogs, Menus, Buttons, CommCtrl, ComCtrls;
const
  wm_ShowAnimated     = wm_User + $102;
  wm_ShowSilent       = wm_User + $103;
  wm_HideAnimated     = wm_User + $104;
  wm_HideSilent       = wm_User + $105;
  // messages for popup menu form
  wm_KillAnimation    = wm_User + $101;
  wm_KillTimer        = wm_User + $106;
  wm_SetKeepSelected  = wm_User + $112; // wParam -> enable/disable keepselected
  wm_UpdateMenuBar    = wm_User + $107; // wParam <> 0 -> rebound menu bar
  wm_ActivateMenuBar  = wm_User + $108; // wParam <> 0 -> window is active
  wm_InitState        = wm_User + $113; // clears all menu states
  // messages for menu designer
  wm_SelectComponent  = wm_User + $120; // select component in Object Inspector
  wm_UpdateCaption    = wm_User + $121;
  wm_UpdateBitmap     = wm_User + $122;
  // GetItemAt(X,Y)
  itNothing           = -1;
  itDragPane          = -2;
  itHiddenArrow       = -3;
  upNothing           = 0;
  upRepaint           = 0;
  upForceRebound      = 1;
  upChildChanged      = 2;
  upForceRebuild      = 3;
  // vk_Menu key
  AltMask = $20000000;
  FormFlags = swp_NoMove or swp_NoSize or swp_NoActivate;
  dt_DrawTextFlags = dt_NoClip + dt_SingleLine + dt_VCenter;
  nSteps = 10;  // number of steps in menu animation
  nTimeout = 5; // cannot be more than 100
  nFirstStage = 6; // size of first step
const
  Pattern : TBitmap  = nil;
  // Custom Sounds - set your favorite
  MenuPopupSound    : String = 'MenuPopup';      // or = 'c:laser.wav';
  MenuCloseSound    : String = '';
  MenuCommandSound  : String = 'MenuCommand';
  ActivePopupMenu   : TPopupMenu     = nil;
const
  FloatingMenusList       : TList            = nil;
  IgnoreNextMenuUp        : Boolean          = False; // ignore alt key up after alt key down
  IgnoreRepaintFloating   : Boolean          = False;
  bmpCheckMark            : HBitmap          = 0;
  bmpRadioItem            : HBitmap          = 0;
var
  Z: array [0..256] of Char;
  mii: TMenuItemInfo;
  NonClientMetrics: TNonClientMetrics;
{ other routines }
procedure HideWindowMenu(Owner: TComponent);
function AssignedActivePopupMenu2000Form: Boolean;
procedure KillActivePopupMenu2000(KillMenuBar, B: Boolean);
procedure SetStatusBarText(HintText: String);
function GetMessageHook(Code, wParam, lParam: Integer): Integer; stdcall;
function GetCBTHook(Code: Integer; wParam: HWND; lParam: LPARAM): LRESULT; stdcall;
function GetCallWndProcHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
procedure CheckShowHint(MenuItem: Menus.TMenuItem; ShowFloatingHint: Boolean; Form: TForm);
procedure ProcessPaintMessages;
procedure ProcessMouseMoveMessages;
procedure NewDisabledBlt(Canvas: TCanvas; X, Y: Integer; clHigh, clShadow: TColor;
  hBmp: HBitmap);
procedure ImgDisabledBlt(Canvas: TCanvas; X, Y: Integer; Images: TImageList; Index: Integer;
  clShadow, clHigh: TColor);
procedure TransBlt(Canvas: TCanvas; X, Y, Glyph, NumGlyphs: Integer; hBmp: HBitmap);
procedure PaintMenuIcon(Owner, AMC: Forms.TForm; DC: HDC; X, Y, W: Integer);
procedure FullHideCaret;
procedure FullShowCaret;
function GetMenuFontHandle: HFont;
function GetValidName(Caption: String): String;
procedure RepaintFloatingMenus;
procedure OffsetBitmap(Bitmap: TBitmap; Left, Top, Width, Height: Integer);
function StripAmpersands(S: String): String;
procedure ShowDoesntSupport(Feature: String);
procedure InstallGMHooks;
procedure RemoveGMHooks;
procedure InstallCWHooks;
procedure RemoveCWHooks;
function IsAccelEx(VK: Word; const Str: String; UseFirstLetter: Boolean): Boolean;
function HasSubmenu(Item: TMenuItem): Boolean;
function AmpTextWidth(Canvas: TCanvas; S: String): Integer;
function GetMnuDsgnHandle: HWND;
procedure CopyToClipboard(S: String);
function PasteFromClipboard: String;
function IsShortCutEx(var Msg: TWMKey; Items: TMenuItem; DoAction: Boolean): Boolean;
function GetNumLines(S: String): Integer;
implementation
uses
  am2000menubar, am2000popupmenu, am2000mainmenu, am2000hintwindow,
  am2000menuitem, am2000const;
const
  // directions for GetNextToolbarButton2000
  drLeft  = -1;
  drRight = 1;
  vk_0 = Byte('0');
  vk_Z = Byte('Z');
const
  CurCaretIndex : Integer = 0;
  HGetMessageHook         : HHook            = 0;
  HGetCBTHook             : HHook            = 0;
  HGetCallWndProcHook     : HHook            = 0;
  GMHooksCount            : Integer          = 0;
  CWHooksCount            : Integer          = 0;
{ Routines }
function AssignedActivePopupMenu2000Form: Boolean;
begin
  Result:= (ActivePopupMenu <> nil)
    and TCustomPopupMenu2000(ActivePopupMenu).FormOnScreen;
end;
procedure HideWindowMenu(Owner: TComponent);
begin
  // hides only MDIForm's menu
  if (Owner is Forms.TForm)
  and (not (Owner.Owner is Forms.TForm))
  and (Forms.TForm(Owner).Menu <> nil)
  then begin
    Forms.TForm(Owner).Menu:= nil;
  end;
end;
procedure SetStatusBarText(HintText: String);
var
  I: Integer;
  S: String;
begin
  S:= Trim(GetLongHint(HintText));
  // remove '&#13;' symbols from status bar text
  repeat
    I:= Pos('&#', S);
    if I = 0 then System.Break;
    System.Delete(S, I, 5);
    System.Insert(' ', S, I);
  until False;
  if Assigned(ActivePopupMenu)
  and Assigned(TCustomPopupMenu2000(ActivePopupMenu).StatusBar)
  then
    with TCustomPopupMenu2000(ActivePopupMenu), StatusBar do begin
      if SimplePanel
      then SimpleText:= S
      else
        if StatusBarIndex < Panels.Count
        then Panels[StatusBarIndex].Text:= S;
      Exit;
    end;
{  if AssignedActiveMenuBar
  and Assigned(ActiveMenuBar.StatusBar)
  then
    with ActiveMenu2000, StatusBar do
      if SimplePanel
      then SimpleText:= S
      else
        if StatusBarIndex < Panels.Count
        then Panels[StatusBarIndex].Text:= S;
}
end;
// processing mousemove and paint messages --
// a bit faster than Application.ProcessMessages
// thanks to Jordan Russell
procedure ProcessPaintMessages;
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, 0, wm_Paint, wm_Paint, pm_NoRemove) do begin
    case Integer(GetMessage(Msg, 0, wm_Paint, wm_Paint)) of
      -1: Exit;
      0: begin PostQuitMessage(Msg.WParam); Exit; end;
    end;
    DispatchMessage(Msg);
  end;
end;
procedure ProcessMouseMoveMessages;
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, 0, wm_MouseMove, wm_MouseMove, pm_NoRemove) do begin
    case Integer(GetMessage(Msg, 0, wm_MouseMove, wm_MouseMove)) of
      -1: Exit;
      0: begin PostQuitMessage(Msg.WParam); Exit; end;
    end;
    DispatchMessage(Msg);
  end;
end;
procedure KillActivePopupMenu2000;
begin
  try
    if AssignedActivePopupMenu2000Form then
      with ActivePopupMenu, TCustomPopupMenu2000(ActivePopupMenu).Form do begin
        SetStatusBarText('');
        Perform(wm_KillTimer, 0, 0);
        Perform(wm_KillAnimation, 0, 0);
        Perform(wm_HideSilent, 0, LongInt(B));
      end;
    if KillMenuBar
    and (ActiveMenuBar <> nil)
    then ActiveMenuBar.HideActiveItem;
  except
  end;
  ActivePopupMenu:= nil;
end;
{ Hooks }
function GetMessageHook(Code, wParam, lParam: Integer): Integer; stdcall;
const
  LastForm: TCustomPopupMenu2000Form = nil;
var
  M: TMsg;
  Msg: Integer;
  C: TControl;
  P: TPoint;
  procedure ClearMessage;
  begin
    FillChar(PMsg(lParam)^, SizeOf(TMsg), 0);
  end;
  function IsOkControl(C: TControl): Boolean;
  begin
    Result:=
      ((C is TCustomPopupMenu2000Form) and (TForm(C).BorderStyle = bsNone))
      or (C is TCustomMenuBar2000)
      or (Assigned(C) and IsOkControl(C.Parent));
  end;
  function IsFloating: Boolean;
  var
    I: Integer;
  begin
    Result:= False;
    for I:= 0 to FloatingMenusList.Count -1 do
      if SendMessage(TForm(FloatingMenusList[I]).Handle, wm_NCHitTest, 0,
        MakeLong(P.X, P.Y)) <> htError
      then begin
        Result:= True;
        Exit;
      end;
  end;
  function GetActiveMenuBar: Boolean;
  var
    F: TForm;
    function SearchForActiveMenuBar(C: TComponent): Boolean;
    var
      I: Integer;
    begin
      Result:= False;
      I:= 0;
      while (I < C.ComponentCount) and (not Result) do begin
        if C.Components[I] is TCustomMenuBar2000 then begin
          ActiveMenuBar:= TCustomMenuBar2000(C.Components[I]);
          Result:= True;
          Exit;
        end;
        if C.Components[I].ComponentCount > 0 then
          Result:= Result or SearchForActiveMenuBar(C.Components[I]);
        Inc(I);
      end;
    end;
  begin
    F:= Screen.ActiveForm;
    Result:= (F.Menu = nil)
      and SearchForActiveMenuBar(F)
      and (ActiveMenuBar <> nil);
  end;
begin
  Result:= 0;
  if (Code >= 0)
  and Assigned(Application)
  and Application.Active
  and (not IsIconic(GetActiveWindow))
  then begin
    M:= PMsg(lParam)^;
    Msg:= PMsg(lParam)^.Message;
    // check for mouse messages
    if ((Msg >= wm_LButtonDblClk) and (Msg <= wm_MButtonDblClk))
    or ((Msg >= wm_NCRButtonDblClk) and (Msg <= wm_NCMButtonDblClk))
    or (Msg = wm_LButtonDown)
    or (Msg = wm_NCLButtonDown)
    or (Msg = wm_NCRButtonDown)
    then begin
      // is it a mouse click on form's client area?
      if (Msg > wm_MouseFirst) then begin
        GetCursorPos(P);
        C:= FindDragTarget(P, True);
        if Assigned(C) and IsOkControl(C) then Exit;
      end
      else
        if IsFloating then Exit;
      // if not -- kil active menu
      if AssignedActivePopupMenu2000Form then begin
        if TCustomPopupMenu2000(ActivePopupMenu).Form.BorderStyle <> bsNone
        then Exit;
        KillActivePopupMenu2000(True, False);
        IgnoreNextMenuUp:= False;
      end;
      if Assigned(ActiveMenuBar)
      then ActiveMenuBar.KillActiveItem;
      FullShowCaret;
    end;
    // another key?
    if ((Msg = wm_KeyDown) or (Msg = wm_KeyUp) or (Msg = wm_SysKeyDown) or (Msg = wm_SysKeyUp))
    then 
      // trying to search receiver of the message in active popup menu
      if ((ActivePopupMenu <> nil)
        and (TCustomPopupMenu2000(ActivePopupMenu).GetTopMostForm.Perform(Msg, M.wParam, M.lParam) <> 0))
      or
      // .. or in active menu bar...
        (GetActiveMenuBar
        and (not (csDesigning in ActiveMenuBar.ComponentState))
        and IsWindowEnabled(TForm(ActiveMenuBar.Owner).Handle)
        and (ActiveMenuBar.Perform(Msg, M.wParam, M.lParam) <> 0))
    then begin
      ClearMessage;
      Exit;
    end { keyboard message } ;
  end { main form is active } ;
  Result:= CallNextHookEx(HGetMessageHook, Code, wParam, lParam);
end;
function GetCBTHook(Code: Integer; wParam: HWND; lParam: LPARAM): LRESULT; stdcall;
  // updates menu bar on new mdi form
begin
  if ((Code = HCBT_MINMAX)
  or (Code = HCBT_SETFOCUS))
  and (Assigned(ActiveMenuBar)
  and ActiveMenuBar.HandleAllocated)
  then PostMessage(ActiveMenuBar.Handle, wm_UpdateMenuBar, upChildChanged, 0);
  Result := CallNextHookEx(HGetCBTHook, Code, wParam, lParam);
end;
function GetCallWndProcHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  // activate and deactivate application and main form
var
  IsActive: Boolean;
begin
  if (Code = HC_ACTION) then
    with PCWPStruct(lParam)^ do
      if ((Message = WM_ACTIVATE)
      or (Message = WM_ACTIVATEAPP))
      and (Assigned(ActiveMenuBar)
      and ActiveMenuBar.HandleAllocated)
      and ((hwnd = ActiveMenuBar.Handle) or (hwnd = TForm(ActiveMenuBar.Owner).Handle))
      then begin
        if (Message = WM_ACTIVATE)
        then IsActive:= IsWindowEnabled(TForm(ActiveMenuBar.Owner).Handle)
        else IsActive:= Boolean(WParam);
        PostMessage(ActiveMenuBar.Handle, wm_ActivateMenuBar, DWord(IsActive), 0);
      end;
  Result:= CallNextHookEx(HGetCallWndProcHook, Code, wParam, lParam);
end;
{ Other Routines }
procedure CheckShowHint(MenuItem: TMenuItem; ShowFloatingHint: Boolean; Form: TForm);
var
  S: String;
begin
  if not Assigned(MenuItem) then Exit;
  S:= '';
  if (MenuItem is TMenuItem2000)
  then
    if (TMenuItem2000(MenuItem).Control = ctlButtonArray)
    then
      with TMenuItem2000(MenuItem), AsButtonArray do begin
        if (LastItemIndex >= 0)
        and (LastItemIndex < Hints.Count)
        then S:= Hints[LastItemIndex]
      end
    else
      S:= TMenuItem2000(MenuItem).Hint
  else
    S:= MenuItem.Hint;
  // fire Application.OnHint
  Application.Hint:= S;
  Form.Hint:= S;
  if (ActivePopupMenu <> nil)
  and (TCustomPopupMenu2000(ActivePopupMenu).StatusBar <> nil)
  then SetStatusBarText(S);
end;
// thanks to Brad Stowers for this routine
procedure PaintMenuIcon(Owner, AMC: Forms.TForm; DC: HDC; X, Y, W: Integer);
var
  IconHandle, NewIcon: HIcon;
begin
  if Assigned(AMC) and (AMC.Icon.Handle <> 0)
  then IconHandle := AMC.Icon.Handle
  else
  if Assigned(AMC) and (Owner.Icon.Handle <> 0)
  then IconHandle:= Owner.Icon.Handle
  else
  if Application.Icon.Handle <> 0
  then IconHandle:= Application.Icon.Handle
  else IconHandle:= LoadIcon(0, IDI_APPLICATION);
  NewIcon:= CopyImage(IconHandle, IMAGE_ICON, W, W, $4000);
  DrawIconEx(DC, X, Y, NewIcon, 0, 0, 0, 0, DI_NORMAL);
  DeleteObject(NewIcon);
end;
procedure TransBlt(Canvas: TCanvas; X, Y, Glyph, NumGlyphs: Integer; hBmp: HBitmap);
var
  BitmapDC: HDC;
  X1, Y1, DX, XE, Cur, Trans: Integer;
  BmpInfo: Windows.TBitmap;
  oldh: HBitmap;
begin
  BmpInfo.bmHeight:= 16;
  BmpInfo.bmWidth:= 16;
  GetObject(hBmp, SizeOf(BmpInfo), @BmpInfo);
  BitmapDC:= CreateCompatibleDC(Canvas.Handle);
  oldh:= SelectObject(BitmapDC, hBmp);
  if oldh <> 0 then begin
    Trans:= GetPixel(BitmapDC, 0, BmpInfo.bmHeight -1);
    if NumGlyphs > 1 then begin
      XE:= BmpInfo.bmWidth div NumGlyphs;
      DX:= Glyph * XE;
    end
    else begin
      DX:= 0;
      XE:= BmpInfo.bmWidth;
    end;
    for X1:= 0 to XE -1 do
      for Y1:= 0 to BmpInfo.bmHeight -1 do begin
        Cur:= GetPixel(BitmapDC, X1 + DX, Y1);
        if (Cur <> Trans) then
          SetPixel(Canvas.Handle, X + X1, Y + Y1, Cur);
      end;
    SelectObject(BitmapDC, oldh);
  end;
  DeleteDC(BitmapDC);
end;
procedure NewDisabledBlt(Canvas: TCanvas; X, Y: Integer; clHigh, clShadow: TColor;
  hBmp: HBitmap);
var
  XOffset: Integer;
  BitmapDC: HDC;
  Trans: TColor;
  BmpInfo: Windows.TBitmap;
  oldh: HBitmap;
  procedure PaintColor(Color: TColor; Offset: Integer);
  var
    X1, Y1, Cur: Integer;
  begin
    for X1:= XOffset to XOffset + BmpInfo.bmWidth -1 do
      for Y1:= 0 to BmpInfo.bmHeight -1 do begin
        Cur:= GetPixel(BitmapDC, X1, Y1);
        if (Cur <> Trans)
        and (Cur and $000000FF <= 132)
        and (Cur and $0000FF00 shr 08 <= 128)
        and (Cur and $00FF0000 shr 16 <= 132)
        then
          SetPixel(Canvas.Handle, X + X1 + Offset, Y + Y1 + Offset, Color);
      end;
  end;
begin
  if hBmp = 0 then Exit;
  XOffset:= 0;
  BmpInfo.bmHeight:= 16;
  BmpInfo.bmWidth:= 16;
  GetObject(hBmp, SizeOf(BmpInfo), @BmpInfo);
  BitmapDC:= CreateCompatibleDC(Canvas.Handle);
  oldh:= SelectObject(BitmapDC, hBmp);
  if oldh <> 0 then begin
    Trans:= GetPixel(BitmapDC, 0, BmpInfo.bmHeight -1);
    PaintColor(ColorToRgb(clShadow), 1);
    PaintColor(ColorToRgb(clHigh), 0);
    SelectObject(BitmapDC, oldh);
  end;
  DeleteDC(BitmapDC);
end;
procedure ImgDisabledBlt(Canvas: TCanvas; X, Y: Integer; Images: TImageList; Index: Integer;
  clShadow, clHigh: TColor);
const
  ROP_DSPDxax = $00E20746;
var
  R: TRect;
  DestDC, SrcDC: HDC;
  MonoBitmap: TBitmap;
begin
  MonoBitmap:= TBitmap.Create;
  with MonoBitmap do begin
    Monochrome:= True;
    Width:= Images.Width;
    Height:= Images.Height;
  end;
  // Store masked version of image temporarily in FBitmap
  MonoBitmap.Canvas.Brush.Color:= clWhite;
  MonoBitmap.Canvas.FillRect(Rect(0, 0, Images.Width, Images.Height));
  ImageList_DrawEx(Images.Handle, Index, MonoBitmap.Canvas.Handle, 0, 0, 0, 0,
    CLR_DEFAULT, 0, ILD_NORMAL);
  R:= Rect(X, Y, X + Images.Width, Y + Images.Height);
  SrcDC:= MonoBitmap.Canvas.Handle;
  // Convert Black to clHigh
  Canvas.Brush.Color:= clHigh;
  DestDC := Canvas.Handle;
  Windows.SetTextColor(DestDC, clWhite);
  Windows.SetBkColor(DestDC, clBlack);
  BitBlt(DestDC, X+1, Y+1, Images.Width, Images.Height, SrcDC, 0, 0, ROP_DSPDxax);
  // Convert Black to clShadow
  Canvas.Brush.Color:= clShadow;
  DestDC:= Canvas.Handle;
  SetTextColor(DestDC, clWhite);
  SetBkColor(DestDC, clBlack);
  BitBlt(DestDC, X, Y, Images.Width, Images.Height, SrcDC, 0, 0, ROP_DSPDxax);
end;
procedure FullHideCaret;
  // hides the caret
begin
  HideCaret(0);
  Inc(CurCaretIndex);
end;
procedure FullShowCaret;
  // shows the caret
var
  I: Integer;
begin
  for I:= CurCaretIndex downto 1 do
    ShowCaret(0);
  CurCaretIndex:= 0;
end;
function GetMenuFontHandle: HFont;
  // retrives default menu font
begin
  if SystemParametersInfo(spi_GetNonClientMetrics, 0, @NonClientMetrics, 0)
  then Result:= CreateFontIndirect(NonClientMetrics.lfMenuFont)
  else Result:= GetStockObject(SYSTEM_FONT);
end;
function GetValidName(Caption: String): String;
  // creates valid menu item name from the given caption
var
  I: Integer;
begin
  Result:= '';
  for I:= 1 to Length(Caption) do
    if Caption[I] in ['0'..'9', 'A'..'Z', '_', 'a'..'z']
    then AppendStr(Result, Caption[I]);
  if Result = '' then Result:= 'N';
  if Result[1] in ['0'..'9'] then Result:= 'N' + Result;
end;
procedure RepaintFloatingMenus;
var
  I: Integer;
begin
  if IgnoreRepaintFloating then Exit;
  for I:= 0 to FloatingMenusList.Count -1 do
    TForm(FloatingMenusList[I]).Repaint;
end;
procedure OffsetBitmap(Bitmap: TBitmap; Left, Top, Width, Height: Integer);
var
  TempBitmap: TBitmap;
begin
  TempBitmap:= TBitmap.Create;
  TempBitmap.Width:= Width;
  TempBitmap.Height:= Height;
  BitBlt(TempBitmap.Canvas.Handle, 0, 0, Width, Height,
    Bitmap.Canvas.Handle, Left, Top, Bitmap.Canvas.CopyMode);
  BitBlt(Bitmap.Canvas.Handle, 0, 0, Width, Height,
    TempBitmap.Canvas.Handle, 0, 0, Bitmap.Canvas.CopyMode);
  TempBitmap.Free;
end;
procedure InstallGMHooks;
begin
  Inc(GMHooksCount);
  if GMHooksCount <> 1 then Exit;
  // setting the hook - many thanks to Victor Santos
  // for help in solving the problems with hook
  if HGetMessageHook = 0
  then HGetMessageHook:= SetWindowsHookEx(wh_GetMessage, @GetMessageHook, 0, GetCurrentThreadID);
end;
procedure RemoveGMHooks;
begin
  Dec(GMHooksCount);
  if GMHooksCount <> 0 then Exit;
  // remove the 'get message' hook
  if HGetMessageHook <> 0
  then UnhookWindowsHookEx(HGetMessageHook);
  HGetMessageHook:= 0;
end;
procedure InstallCWHooks;
begin
  Inc(CWHooksCount);
  if CWHooksCount <> 1 then Exit;
  // install the computer-based training hook for mdi child form
  if (HGetCBTHook = 0)
  then HGetCBTHook:= SetWindowsHookEx(WH_CBT, @GetCBTHook, 0, GetCurrentThreadID);
  // install the call window procedure hook - for gray activated
  if (HGetCallWndProcHook = 0)
  then HGetCallWndProcHook:= SetWindowsHookEx(WH_CallWndProc, @GetCallWndProcHook, 0, GetCurrentThreadID);
end;
procedure RemoveCWHooks;
begin
  Dec(CWHooksCount);
  if CWHooksCount <> 0 then Exit;
  // remove the 'computer-based training' hook
  if HGetCBTHook <> 0
  then UnhookWindowsHookEx(HGetCBTHook);
  // remove the 'call window procedure' hook
  if HGetCallWndProcHook <> 0
  then UnhookWindowsHookEx(HGetCallWndProcHook);
  HGetCBTHook:= 0;
  HGetCallWndProcHook:= 0;
end;
procedure ShowDoesntSupport(Feature: String);
begin
  KillActivePopupMenu2000(True, True);
  Application.MessageBox(PChar(SDoesntSupportText1 + Feature + SDoesntSupportText2), SDoesntSupportTitle, mb_IconInformation);
end;
function StripAmpersands(S: String): String;
var
  P: Integer;
begin
  Result:= ' ';
  P:= Pos('&', S);
  while P > 0 do begin
    if P > 1
    then AppendStr(Result, Copy(S, 1, P -1));
    Delete(S, 1, P);
    if (S <> '') and (S[1] = '&')
    then begin
      AppendStr(Result, '&');
      Delete(S, 1, 1);
    end;
    P:= Pos('&', S);
  end;
  AppendStr(Result, S);
end;
function IsAccelEx(VK: Word; const Str: String; UseFirstLetter: Boolean): Boolean;
var
  S: String;
begin
  Result:= (VK in [$30..$39,$41..$5a])
    and Forms.IsAccel(VK, Str);
  if (not Result)
  and UseFirstLetter
  and (Str <> '')
  then begin
    S:= StripAmpersands(Str);
    Result:= (S <> '') and (VK = Byte(UpCase(S[1])));
  end;
end;
function HasSubmenu(Item: TMenuItem): Boolean;
begin
  Result:= (Item <> nil)
    and ((Item.Count > 0)
    or ((Item is TMenuItem2000)
    and (TMenuItem2000(Item).AttachMenu <> nil)));
end;
function AmpTextWidth(Canvas: TCanvas; S: String): Integer;
  // returns text width without ampersands
begin
  Result:= Canvas.TextWidth(StripAmpersands(S));
end;
function GetMnuDsgnHandle: HWND;
begin
  Result:= FindWindow(nil, 'AM/2000 Menu Designer');
end;
procedure CopyToClipboard(S: String);
var
  L: Integer;
  hglbCopy: HGLOBAL;
  lptstrCopy: PChar;
begin
  L:= (Length(S) +1) * SizeOf(Char);
  OpenClipboard(0);
  EmptyClipboard;
  hglbCopy:= GlobalAlloc(GMEM_DDESHARE, L);
  lptstrCopy:= GlobalLock(hglbCopy);
  Move(PChar(S)^, lptstrCopy^, L);
//    lptstrCopy[cch] = (TCHAR) 0;    // null character
  GlobalUnlock(hglbCopy);
  // Place the handle on the clipboard.
  SetClipboardData(cf_Text, hglbCopy);
  CloseClipboard;
end;
function PasteFromClipboard: String;
var
  hglb: HGLOBAL;
  lptstr: PChar;
begin
  Result:= '';
  OpenClipboard(0);
  hglb:= GetClipboardData(cf_Text);
  lptstr:= GlobalLock(hglb);
  if lptstr <> nil then Result:= StrPas(lptstr);
  GlobalUnlock(hglb);
  CloseClipboard;
end;
function IsShortCutEx(var Msg: TWMKey; Items: TMenuItem; DoAction: Boolean): Boolean;
type
  TClickResult = (crDisabled, crClicked, crShortCutMoved);
var
  ShortCut: TShortCut;
  ShortCutStr: String;
  ShortCutItem: TMenuItem;
  function DoClick(Item: TMenuItem): TClickResult;
    // thanks to Borland (Inprise) for this code
  begin
    Result:= crClicked;
    if Item.Parent <> nil then Result:= DoClick(Item.Parent);
    if Result = crClicked then
      if Item.Enabled 
      then begin
{$IFDEF Delphi4OrHigher}
        if DoAction then Item.InitiateAction;
{$ENDIF}
        Item.Click;
      end
      else Result:= crDisabled;
  end;
  function PosShortCut(const SC, SCList: String): Boolean;
    // is shortcut delimited with semi-colons or string limits?
  var
    P, E: Integer;
  begin
    P:= Pos(SC, SCList);
    E:= P + Length(SC);
    Result:= (P <> 0)
      and ((P = 1) or (SCList[P -1] = ';'))
      and ((E > Length(SCList)) or (SCList[E] = ';'));
  end;
  function FindItemByShortCut(Items: TMenuItem): TMenuItem;
  var
    I: Integer;
  begin
    I:= 0;
    Result:= nil;
    while (I < Items.Count) and (Result = nil) do begin
      if (Items[I].ShortCut = ShortCut)
      or ((Items[I] is TMenuItem2000)
      and (PosShortCut(ShortCutStr, TMenuItem2000(Items[I]).ShortCut)))
      then begin
        Result:= Items[I];
        Exit;
      end;
      if Items[I].Count > 0 then
        Result:= FindItemByShortCut(Items[I]);
      Inc(I);
    end;
  end;
  procedure SearchForItems(Items: TMenuItem);
  var
    ClickResult: TClickResult;
  begin
    if Items = nil then Exit;
    repeat
      ClickResult:= crDisabled;
      ShortCutItem:= FindItemByShortCut(Items);
      if ShortCutItem <> nil then begin
        KillActivePopupMenu2000(True, False);
        ClickResult:= DoClick(ShortCutItem);
      end;
    until ClickResult <> crShortCutMoved;
    if ShortCutItem <> nil
    then begin
      Msg.Result:= 1;
      Result:= True;
    end;
  end;
begin
  Result:= False;
  // get short cut
  ShortCut:= Msg.CharCode;
  if GetKeyState(vk_Shift) < 0 then Inc(ShortCut, scShift);
  if GetKeyState(vk_Control) < 0 then Inc(ShortCut, scCtrl);
  if Msg.KeyData and AltMask <> 0 then Inc(ShortCut, scAlt);
  // get text short cut
  ShortCutStr:= ShortCutToText(ShortCut);
  // search
  if ShortCutStr <> ''
  then SearchForItems(Items);
end;
function GetNumLines(S: String): Integer;
var
  P, PS: PChar;
begin
  Result:= 1;
  PS:= PChar(S);
  repeat
    P:= StrPos(PS, 'n');
    if P = nil then P:= StrPos(PS, #13);
    if P = nil then Break;
    Inc(Result);
    PS:= @P[1];
  until PS[0] = #0;
end;
initialization
  // active menu2000 list for multiforms
  FloatingMenusList:= TList.Create;
  // structure for quering menus
  mii.cbSize:= 44;
  NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  // get system parameters info
  SystemParametersInfo(spi_GetNonClientMetrics, 0, @NonClientMetrics, 0);
  // load bitmaps
  bmpCheckMark:=      LoadBitmap(HInstance, 'AM2000_SYSTEMCHECKMARK');
  bmpRadioItem:=      LoadBitmap(HInstance, 'AM2000_SYSTEMRADIOITEM');
finalization
  FloatingMenusList.Free;
  // delete bitmaps
  DeleteObject(bmpCheckMark);
  DeleteObject(bmpRadioItem);
end.

						