{ Code-Copyright (c) 2001, Hagen Reddmann }
unit flatmenu;
interface
uses
Windows, SysUtils, Messages, Graphics;
//
// functions
//
function InitFlatMenuHook: boolean;
function FreeFlatMenuHook: boolean;
//
// variable to handle the menu from the app
//
var
mnuFrameColor : TColor = clGrayText;
mnuBgColor : TColor = clMenu;
mnuLeftbarColor : TColor = clMenu;
HookActive : integer = 0;
WinME, Win2k : boolean;
implementation
{ -- procs ------------------------------------------------------------------- }
var
FHook: hHook = 0;
FAtom: TAtom = 0;
//
// hook proc
//
function CallWndProcHook(Code: Integer; wParam: WParam; lParam: LParam):
LResult;
stdcall;
//
// Win2k, WinME
//
procedure MenuNCPaint(Wnd: hWnd;
DC: hDC; IsClient: Boolean);
var
D : hDC;
bg, frame : hBrush;
R : TRect;
P : TPoint;
begin
if(
DC = 0)
then D := GetWindowDC(Wnd)
else D :=
DC;
if(D <> 0)
then
try
bg := CreateSolidBrush(ColorToRGB(mnuBgColor));
frame := CreateSolidBrush(ColorToRGB(mnuFrameColor));
try
if(IsClient)
then SetWindowOrgEx(D, 0, 0, @P); SelectClipRgn(D, 0);
GetWindowRect(Wnd, R);
OffsetRect(R, -R.Left, -R.Top);
FrameRect(D, R, frame); InflateRect(R, -1, -1);
FrameRect(D, R, bg); InflateRect(R, -1, -1);
FrameRect(D, R, bg);
finally
if(IsClient)
then SetWindowOrgEx(D, P.X, P.Y, @P);
DeleteObject(frame);
DeleteObject(bg);
end;
finally
if(
DC = 0)
then ReleaseDC(Wnd, D);
end;
end;
function IsPopupMenu(Wnd: hWnd): Boolean;
var
N :
array[0..8]
of Char;
begin
Result := (HookActive > 0)
and IsWindow(Wnd)
and
((GetClassLong(Wnd, GCW_ATOM) = 32768)
or
(StrLIComp(@N, '
#32768', GetClassName(Wnd, @N, SizeOf(N))) = 0));
end;
//
// Win9x/NT
//
function DoNCPaint(Wnd: hWnd): Boolean;
var
DC: hDC;
bg, frame: hBrush;
R: TRect;
begin
Result := False;
DC := GetWindowDC(Wnd);
if(
DC <> 0)
then
try
GetWindowRect(Wnd, R);
OffsetRect(R, -R.Left, -R.Top);
bg := CreateSolidBrush(ColorToRGB(mnuBgColor));
frame := CreateSolidBrush(ColorToRGB(mnuFrameColor));
try
FrameRect(
DC, R, frame); InflateRect(R, -1, -1);
FrameRect(
DC, R, bg); InflateRect(R, -1, -1);
FrameRect(
DC, R, bg);
Result := True;
finally
DeleteObject(frame); DeleteObject(bg);
end;
finally
ReleaseDC(Wnd,
DC);
end;
end;
procedure MarkWindowAsPopup(Wnd: hWnd);
begin
if (HookActive > 0)
and (IsWindow(Wnd))
and (GetProp(Wnd,
MakeIntResource(FAtom)) <> MainThreadID)
then
SetProp(Wnd, MakeIntResource(FAtom), MainThreadID);
end;
begin
//
// hook functions for Win9x/NT
//
if(
not(WinME))
and (
not(Win2k))
then
begin
if lParam <> 0
then
with PCWPStruct(lParam)^
do
begin
case Message of
wm_NCPaint :
if(HookActive = 1)
then
begin
if(GetProp(hWnd, MakeIntResource(FAtom)) =
MainThreadID)
and DoNCPaint(hWnd)
then
begin
Message := wm_Null; Result := 0; exit;
end;
end;
wm_NCDestroy,
wm_Destroy :
if GetProp(hWnd, MakeIntResource(FAtom)) = MainThreadID
then
RemoveProp(hWnd, MakeIntResource(FAtom));
wm_InitMenuPopup:
MarkWindowAsPopup(FindWindow(MakeIntResource(32768),
nil));
wm_Create :
with PCreateStruct(lParam)^
do
// ist eine #POPUP# class
if(lpszClass = MakeIntResource(32768))
then
MarkWindowAsPopup(hWnd);
end;
end;
Result := CallNextHookEx(FHook, Code, wParam, lParam);
end
//
// hook functions for ME and 2000
//
else
begin
Result := CallNextHookEx(FHook, Code, wParam, lParam);
if(lParam <> 0)
then
with PCWPStruct(lParam)^
do
case Message of
wm_PrintClient:
if IsPopupMenu(hWnd)
then MenuNCPaint(hWnd, wParam, True);
wm_EraseBkGnd :
if IsPopupMenu(hWnd)
then MenuNCPaint(hWnd, 0, False);
end;
end;
end;
{ -- hook functions ---------------------------------------------------------- }
//
// init hook
//
function InitFlatMenuHook: boolean;
begin
//
// unregister first
//
if(FHook <> 0)
then FreeFlatMenuHook;
//
// now, play it again, Sam!
//
if(
not(WinME))
and (
not(Win2k))
then
FAtom := GlobalAddAtom(PChar(Format('
POPUPMENU_IDENTIFY_%0.8x',
[MainThreadID])));
FHook := SetWindowsHookEx(WH_CALLWNDPROC, CallWndProcHook, 0, MainThreadID);
//
// function´s result
//
Result := (FHook <> 0);
end;
//
// free hook
//
function FreeFlatMenuHook: boolean;
begin
if(FHook <> 0)
then
begin
Result := UnhookWindowsHookEx(FHook);
if(
not(WinME))
and (
not(Win2k))
then GlobalDeleteAtom(FAtom);
end
else
Result := false;
end;
initialization
WinME := ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS)
and
(Win32MajorVersion = 4)
and (Win32MinorVersion >= 90));
Win2k := ((Win32Platform = VER_PLATFORM_WIN32_NT)
and
(Win32MajorVersion = 5)
{and (Win32MinorVersion = 1)});
finalization
WinME := false; Win2k := false;
end.