mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
930 lines
31 KiB
ObjectPascal
930 lines
31 KiB
ObjectPascal
// ***************************************************************************************************
|
||
//
|
||
// Unit Vcl.Styles.Utils.SysControls
|
||
// unit for the VCL Styles Utils
|
||
// https://github.com/RRUZ/vcl-styles-utils/
|
||
//
|
||
// The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License")
|
||
// you may not use this file except in compliance with the License. You may obtain a copy of the
|
||
// License at http://www.mozilla.org/MPL/
|
||
//
|
||
// Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF
|
||
// ANY KIND, either express or implied. See the License for the specific language governing rights
|
||
// and limitations under the License.
|
||
//
|
||
//
|
||
// Portions created by Mahdi Safsafi [SMP3] e-mail SMP@LIVE.FR
|
||
// Portions created by Rodrigo Ruz V. are Copyright (C) 2013-2015 Rodrigo Ruz V.
|
||
// All Rights Reserved.
|
||
//
|
||
// **************************************************************************************************
|
||
unit Vcl.Styles.Utils.SysControls;
|
||
{.$DEFINE EventLog}
|
||
|
||
interface
|
||
|
||
uses
|
||
System.Classes,
|
||
System.Types,
|
||
System.SysUtils,
|
||
System.Generics.Collections,
|
||
Winapi.Windows,
|
||
Winapi.Messages,
|
||
Vcl.Controls,
|
||
Vcl.Graphics,
|
||
Vcl.Themes,
|
||
Vcl.Styles.Utils.SysStyleHook;
|
||
|
||
type
|
||
PChildControlInfo = ^TChildControlInfo;
|
||
|
||
TChildControlInfo = record
|
||
Parent: HWND;
|
||
ParentStyle: NativeInt;
|
||
StyleHookClass: TSysStyleHookClass;
|
||
end;
|
||
|
||
PControlInfo = ^TControlInfo;
|
||
|
||
TControlInfo = record
|
||
Handle: HWND;
|
||
Parent: HWND;
|
||
Style: NativeInt;
|
||
ParentStyle: NativeInt;
|
||
ExStyle: NativeInt;
|
||
ParentExStyle: NativeInt;
|
||
ClassName: PChar;
|
||
ParentClassName: PChar;
|
||
end;
|
||
|
||
type
|
||
TSysHookAction = (cAdded, cRemoved);
|
||
TBeforeHookingControl = function(Info: PControlInfo): Boolean;
|
||
TSysHookNotification = procedure(Action: TSysHookAction; Info: PControlInfo);
|
||
|
||
TSysStyleManager = class(TComponent)
|
||
private
|
||
class var
|
||
FEnabled: Boolean;
|
||
FHook_WH_CBT: HHook;
|
||
FBeforeHookingControlProc: TBeforeHookingControl;
|
||
FSysHookNotificationProc: TSysHookNotification;
|
||
FRegSysStylesList: TObjectDictionary<String, TSysStyleHookClass>;
|
||
FSysStyleHookList: TObjectDictionary<HWND, TSysStyleHook>;
|
||
FChildRegSysStylesList: TObjectDictionary<HWND, TChildControlInfo>;
|
||
FHookVclControls: Boolean;
|
||
FUseStyleColorsChildControls: Boolean;
|
||
class var FHookDialogIcons: Boolean;
|
||
protected
|
||
/// <summary>
|
||
/// Install the Hook
|
||
/// </summary>
|
||
class procedure InstallHook_WH_CBT;
|
||
/// <summary>
|
||
/// Remove the Hook
|
||
/// </summary>
|
||
class procedure RemoveHook_WH_CBT;
|
||
/// <summary>
|
||
/// Hook Callback
|
||
/// </summary>
|
||
class function HookActionCallBackCBT(nCode: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall; static;
|
||
public
|
||
/// <summary>
|
||
/// Register a Sys Style Hook for an specified class.
|
||
/// </summary>
|
||
class procedure RegisterSysStyleHook(const SysControlClass: String; SysStyleHookClass: TSysStyleHookClass);
|
||
/// <summary>
|
||
/// UnRegister a Sys Style Hook for an specified class.
|
||
/// </summary>
|
||
class procedure UnRegisterSysStyleHook(const SysControlClass: String; SysStyleHookClass: TSysStyleHookClass);
|
||
class constructor Create;
|
||
class destructor Destroy;
|
||
constructor Create(AOwner: TComponent); override;
|
||
destructor Destroy; override;
|
||
/// <summary>
|
||
/// Event to preventvor allow<6F>hook a control.
|
||
/// </summary>
|
||
class Property OnBeforeHookingControl: TBeforeHookingControl read FBeforeHookingControlProc write FBeforeHookingControlProc;
|
||
/// <summary>
|
||
/// Notify when a hook foir<69>control is added or removed
|
||
/// </summary>
|
||
class Property OnHookNotification: TSysHookNotification read FSysHookNotificationProc write FSysHookNotificationProc;
|
||
/// <summary>
|
||
/// Enable or disable the style of the controls
|
||
/// </summary>
|
||
class property Enabled: Boolean read FEnabled write FEnabled;
|
||
/// <summary>
|
||
/// Allow<6F>set the<68>current VCL Style<6C>font and background color in<69> child
|
||
/// controls.
|
||
/// </summary>
|
||
class property UseStyleColorsChildControls: Boolean read FUseStyleColorsChildControls write FUseStyleColorsChildControls;
|
||
/// <summary>
|
||
/// Allow disable or enable the hook of VCL Controls
|
||
/// </summary>
|
||
class property HookVclControls: Boolean read FHookVclControls write FHookVclControls;
|
||
/// <summary>
|
||
/// Allow disable or enable the hook of the icons dialogs
|
||
/// </summary>
|
||
class property HookDialogIcons: Boolean read FHookDialogIcons write FHookDialogIcons;
|
||
/// <summary>
|
||
/// Collection of Styled (Hooked) Controls
|
||
/// </summary>
|
||
class property SysStyleHookList: TObjectDictionary<HWND, TSysStyleHook> read FSysStyleHookList;
|
||
/// <summary>
|
||
/// Collection of Styled Child<6C>Controls
|
||
/// </summary>
|
||
class property ChildRegSysStylesList: TObjectDictionary<HWND, TChildControlInfo> read FChildRegSysStylesList;
|
||
class procedure AddControlDirectly(Handle: HWND; const sClassName : string; IncludeChildControls : Boolean = False);
|
||
end;
|
||
|
||
function GetWindowClassName(Window: HWND): String;
|
||
function RectVCenter(var R: TRect; const Bounds: TRect): TRect;
|
||
procedure MoveWindowOrg(DC: HDC; const DX, DY: Integer);
|
||
{$IFDEF EventLog}
|
||
procedure AddToLog(const Msg: TMessage); overload;
|
||
procedure AddToLog(const S: string; const Value: Integer); overload;
|
||
procedure AddToLog(const Msg: string); overload;
|
||
function WM_To_String(const WM_Message: Integer): string;
|
||
{$ENDIF}
|
||
|
||
implementation
|
||
|
||
uses
|
||
WinApi.CommCtrl;
|
||
|
||
{$IFDEF EventLog}
|
||
|
||
{ Useful functions when debugging }
|
||
procedure AddToLog(const Msg: TMessage);
|
||
begin
|
||
with Msg do
|
||
OutputDebugString(PChar(FormatDateTime('hh:nn:ss.zzz', Now)+' Msg = ' + WM_To_String(Msg) + ' wParam = ' + IntToStr(wParam) + ' LParam = ' + IntToStr(lParam)));
|
||
end;
|
||
|
||
procedure AddToLog(const S: string; const Value: Integer);
|
||
begin
|
||
OutputDebugString(PChar((S) + ' = ' + IntToStr(Value)));
|
||
end;
|
||
|
||
procedure AddToLog(const Msg: string);
|
||
begin
|
||
OutputDebugString(PChar(Msg));
|
||
end;
|
||
|
||
function WM_To_String(const WM_Message: Integer): string;
|
||
begin
|
||
case WM_Message of
|
||
$0000: Result := 'WM_NULL';
|
||
$0001: Result := 'WM_CREATE';
|
||
$0002: Result := 'WM_DESTROY';
|
||
$0003: Result := 'WM_MOVE';
|
||
$0005: Result := 'WM_SIZE';
|
||
$0006: Result := 'WM_ACTIVATE';
|
||
$0007: Result := 'WM_SETFOCUS';
|
||
$0008: Result := 'WM_KILLFOCUS';
|
||
$000A: Result := 'WM_ENABLE';
|
||
$000B: Result := 'WM_SETREDRAW';
|
||
$000C: Result := 'WM_SETTEXT';
|
||
$000D: Result := 'WM_GETTEXT';
|
||
$000E: Result := 'WM_GETTEXTLENGTH';
|
||
$000F: Result := 'WM_PAINT';
|
||
$0010: Result := 'WM_CLOSE';
|
||
$0011: Result := 'WM_QUERYENDSESSION';
|
||
$0012: Result := 'WM_QUIT';
|
||
$0013: Result := 'WM_QUERYOPEN';
|
||
$0014: Result := 'WM_ERASEBKGND';
|
||
$0015: Result := 'WM_SYSCOLORCHANGE';
|
||
$0016: Result := 'WM_EndSESSION';
|
||
$0017: Result := 'WM_SYSTEMERROR';
|
||
$0018: Result := 'WM_SHOWWINDOW';
|
||
$0019: Result := 'WM_CTLCOLOR';
|
||
$001A: Result := 'WM_WININICHANGE or WM_SETTINGCHANGE';
|
||
$001B: Result := 'WM_DEVMODECHANGE';
|
||
$001C: Result := 'WM_ACTIVATEAPP';
|
||
$001D: Result := 'WM_FONTCHANGE';
|
||
$001E: Result := 'WM_TIMECHANGE';
|
||
$001F: Result := 'WM_CANCELMODE';
|
||
$0020: Result := 'WM_SETCURSOR';
|
||
$0021: Result := 'WM_MOUSEACTIVATE';
|
||
$0022: Result := 'WM_CHILDACTIVATE';
|
||
$0023: Result := 'WM_QUEUESYNC';
|
||
$0024: Result := 'WM_GETMINMAXINFO';
|
||
$0026: Result := 'WM_PAINTICON';
|
||
$0027: Result := 'WM_ICONERASEBKGND';
|
||
$0028: Result := 'WM_NEXTDLGCTL';
|
||
$002A: Result := 'WM_SPOOLERSTATUS';
|
||
$002B: Result := 'WM_DRAWITEM';
|
||
$002C: Result := 'WM_MEASUREITEM';
|
||
$002D: Result := 'WM_DELETEITEM';
|
||
$002E: Result := 'WM_VKEYTOITEM';
|
||
$002F: Result := 'WM_CHARTOITEM';
|
||
$0030: Result := 'WM_SETFONT';
|
||
$0031: Result := 'WM_GETFONT';
|
||
$0032: Result := 'WM_SETHOTKEY';
|
||
$0033: Result := 'WM_GETHOTKEY';
|
||
$0037: Result := 'WM_QUERYDRAGICON';
|
||
$0039: Result := 'WM_COMPAREITEM';
|
||
$003D: Result := 'WM_GETOBJECT';
|
||
$0041: Result := 'WM_COMPACTING';
|
||
$0044: Result := 'WM_COMMNOTIFY { obsolete in Win32}';
|
||
$0046: Result := 'WM_WINDOWPOSCHANGING';
|
||
$0047: Result := 'WM_WINDOWPOSCHANGED';
|
||
$0048: Result := 'WM_POWER';
|
||
$004A: Result := 'WM_COPYDATA';
|
||
$004B: Result := 'WM_CANCELJOURNAL';
|
||
$004E: Result := 'WM_NOTIFY';
|
||
$0050: Result := 'WM_INPUTLANGCHANGEREQUEST';
|
||
$0051: Result := 'WM_INPUTLANGCHANGE';
|
||
$0052: Result := 'WM_TCARD';
|
||
$0053: Result := 'WM_HELP';
|
||
$0054: Result := 'WM_USERCHANGED';
|
||
$0055: Result := 'WM_NOTIFYFORMAT';
|
||
$007B: Result := 'WM_CONTEXTMENU';
|
||
$007C: Result := 'WM_STYLECHANGING';
|
||
$007D: Result := 'WM_STYLECHANGED';
|
||
$007E: Result := 'WM_DISPLAYCHANGE';
|
||
$007F: Result := 'WM_GETICON';
|
||
$0080: Result := 'WM_SETICON';
|
||
$0081: Result := 'WM_NCCREATE';
|
||
$0082: Result := 'WM_NCDESTROY';
|
||
$0083: Result := 'WM_NCCALCSIZE';
|
||
$0084: Result := 'WM_NCHITTEST';
|
||
$0085: Result := 'WM_NCPAINT';
|
||
$0086: Result := 'WM_NCACTIVATE';
|
||
$0087: Result := 'WM_GETDLGCODE';
|
||
$0088: Result := 'WM_SYNCPAINT';
|
||
$00A0: Result := 'WM_NCMOUSEMOVE';
|
||
$00A1: Result := 'WM_NCLBUTTONDOWN';
|
||
$00A2: Result := 'WM_NCLBUTTONUP';
|
||
$00A3: Result := 'WM_NCLBUTTONDBLCLK';
|
||
$00A4: Result := 'WM_NCRBUTTONDOWN';
|
||
$00A5: Result := 'WM_NCRBUTTONUP';
|
||
$00A6: Result := 'WM_NCRBUTTONDBLCLK';
|
||
$00A7: Result := 'WM_NCMBUTTONDOWN';
|
||
$00A8: Result := 'WM_NCMBUTTONUP';
|
||
$00A9: Result := 'WM_NCMBUTTONDBLCLK';
|
||
// edit control messages start (todo: add more if needed)
|
||
$00B0: Result := 'EM_GETSEL';
|
||
$00B1: Result := 'EM_SETSEL';
|
||
$00B2: Result := 'EM_GETRECT';
|
||
$00B3: Result := 'EM_SETRECT';
|
||
$00B4: Result := 'EM_SETRECTNP';
|
||
$00B5: Result := 'EM_SCROLL';
|
||
$00B6: Result := 'EM_LINESCROLL';
|
||
$00B7: Result := 'EM_SCROLLCARET';
|
||
$00B8: Result := 'EM_GETMODIFY';
|
||
$00B9: Result := 'EM_SETMODIFY';
|
||
$00BA: Result := 'EM_GETLINECOUNT';
|
||
$00BB: Result := 'EM_LINEINDEX';
|
||
$00BC: Result := 'EM_SETHANDLE';
|
||
$00BD: Result := 'EM_GETHANDLE';
|
||
$00BE: Result := 'EM_GETTHUMB';
|
||
$00C1: Result := 'EM_LINELENGTH';
|
||
$00C2: Result := 'EM_REPLACESEL';
|
||
$00C4: Result := 'EM_GETLINE';
|
||
$00C5: Result := 'EM_LIMITTEXT';
|
||
$00C6: Result := 'EM_CANUNDO';
|
||
$00C7: Result := 'EM_UNDO';
|
||
$00C8: Result := 'EM_FMTLINES';
|
||
$00C9: Result := 'EM_LINEFROMCHAR';
|
||
$00CB: Result := 'EM_SETTABSTOPS';
|
||
$00CC: Result := 'EM_SETPASSWORDCHAR';
|
||
$00CD: Result := 'EM_EMPTYUNDOBUFFER';
|
||
$00CE: Result := 'EM_GETFIRSTVISIBLELINE';
|
||
$00CF: Result := 'EM_SETREADONLY';
|
||
$00D0: Result := 'EM_SETWORDBREAKPROC';
|
||
$00D1: Result := 'EM_GETWORDBREAKPROC';
|
||
$00D2: Result := 'EM_GETPASSWORDCHAR';
|
||
$00D3: Result := 'EM_SETMARGINS';
|
||
$00D4: Result := 'EM_GETMARGINS';
|
||
$00D5: Result := 'EM_GETLIMITTEXT';
|
||
$00D6: Result := 'EM_POSFROMCHAR';
|
||
$00D7: Result := 'EM_CHARFROMPOS';
|
||
// edit control messages end
|
||
// scrollbar control messages start
|
||
$00E0: Result := 'SBM_SETPOS';
|
||
$00E1: Result := 'SBM_GETPOS';
|
||
$00E2: Result := 'SBM_SETRANGE';
|
||
$00E3: Result := 'SBM_GETRANGE';
|
||
$00E4: Result := 'SBM_ENABLE_ARROWS';
|
||
$00E6: Result := 'SBM_SETRANGEREDRAW';
|
||
$00E9: Result := 'SBM_SETSCROLLINFO';
|
||
$00EA: Result := 'SBM_GETSCROLLINFO';
|
||
$00EB: Result := 'SBM_GETSCROLLBARINFO';
|
||
// scrollbar control messages end
|
||
// button control messages start
|
||
$00F0: Result := 'BM_GETCHECK';
|
||
$00F1: Result := 'BM_SETCHECK';
|
||
$00F2: Result := 'BM_GETSTATE';
|
||
$00F3: Result := 'BM_SETSTATE';
|
||
$00F4: Result := 'BM_SETSTYLE';
|
||
$00F5: Result := 'BM_CLICK';
|
||
$00F6: Result := 'BM_GETIMAGE';
|
||
$00F7: Result := 'BM_SETIMAGE';
|
||
$00F8: Result := 'BM_SETDONTCLICK';
|
||
|
||
$0090: result := 'WM_UAHDESTROYWINDOW';
|
||
$0091: result := 'WM_UAHDRAWMENU';
|
||
$0092: result := 'WM_UAHDRAWMENUITEM';
|
||
$0093: result := 'WM_UAHINITMENU';
|
||
$0094: result := 'WM_UAHMEASUREMENUITEM';
|
||
$0095: result := 'WM_UAHNCPAINTMENUPOPUP';
|
||
|
||
$01E0: Result := 'MN_SETHMENU';
|
||
$01E1: Result := 'MN_GETHMENU';
|
||
$01E2: Result := 'MN_SIZEWINDOW';
|
||
$01E3: Result := 'MN_OPENHIERARCHY';
|
||
$01E4: Result := 'MN_CLOSEHIERARCHY';
|
||
$01E5: Result := 'MN_SELECTITEM';
|
||
$01E6: Result := 'MN_CANCELMENUS';
|
||
$01E7: Result := 'MN_SELECTFIRSTVALIDITEM';
|
||
|
||
$01EA: Result := 'MN_GETPPOPUPMENU';
|
||
$01EB: Result := 'MN_FINDMENUWINDOWFROMPOINT';
|
||
$01EC: Result := 'MN_SHOWPOPUPWINDOW';
|
||
$01ED: Result := 'MN_BUTTONDOWN';
|
||
$01F0: Result := 'MN_SETTIMERTOOPENHIERARCHY';
|
||
$01F1: Result := 'MN_DBLCLK';
|
||
$01F2: Result := 'MN_ENDMENU';
|
||
$01F3: Result := 'MN_DODRAGDROP';
|
||
|
||
|
||
// button control messages end
|
||
$0100: Result := 'WM_KEYFIRST or WM_KEYDOWN';
|
||
$0101: Result := 'WM_KEYUP';
|
||
$0102: Result := 'WM_CHAR';
|
||
$0103: Result := 'WM_DEADCHAR';
|
||
$0104: Result := 'WM_SYSKEYDOWN';
|
||
$0105: Result := 'WM_SYSKEYUP';
|
||
$0106: Result := 'WM_SYSCHAR';
|
||
$0107: Result := 'WM_SYSDEADCHAR';
|
||
$0108: Result := 'WM_KEYLAST';
|
||
$010D: Result := 'WM_IME_STARTCOMPOSITION';
|
||
$010E: Result := 'WM_IME_ENDCOMPOSITION';
|
||
$010F: Result := 'WM_IME_COMPOSITION or WM_IME_KEYLAST';
|
||
$0110: Result := 'WM_INITDIALOG';
|
||
$0111: Result := 'WM_COMMAND';
|
||
$0112: Result := 'WM_SYSCOMMAND';
|
||
$0113: Result := 'WM_TIMER';
|
||
$0114: Result := 'WM_HSCROLL';
|
||
$0115: Result := 'WM_VSCROLL';
|
||
$0116: Result := 'WM_INITMENU';
|
||
$0117: Result := 'WM_INITMENUPOPUP';
|
||
$011F: Result := 'WM_MENUSELECT';
|
||
$0120: Result := 'WM_MENUCHAR';
|
||
$0121: Result := 'WM_ENTERIDLE';
|
||
$0122: Result := 'WM_MENURBUTTONUP';
|
||
$0123: Result := 'WM_MENUDRAG';
|
||
$0124: Result := 'WM_MENUGETOBJECT';
|
||
$0125: Result := 'WM_UNINITMENUPOPUP';
|
||
$0126: Result := 'WM_MENUCOMMAND';
|
||
$0127: Result := 'WM_CHANGEUISTATE';
|
||
$0128: Result := 'WM_UPDATEUISTATE';
|
||
$0129: Result := 'WM_QUERYUISTATE';
|
||
$0132: Result := 'WM_CTLCOLORMSGBOX';
|
||
$0133: Result := 'WM_CTLCOLOREDIT';
|
||
$0134: Result := 'WM_CTLCOLORLISTBOX';
|
||
$0135: Result := 'WM_CTLCOLORBTN';
|
||
$0136: Result := 'WM_CTLCOLORDLG';
|
||
$0137: Result := 'WM_CTLCOLORSCROLLBAR';
|
||
$0138: Result := 'WM_CTLCOLORSTATIC';
|
||
$0140: Result := 'CB_GETEDITSEL';
|
||
$0141: Result := 'CB_LIMITTEXT';
|
||
$0142: Result := 'CB_SETEDITSEL';
|
||
$0143: Result := 'CB_ADDSTRING';
|
||
$0144: Result := 'CB_DELETESTRING';
|
||
$0145: Result := 'CB_DIR';
|
||
$0146: Result := 'CB_GETCOUNT';
|
||
$0147: Result := 'CB_GETCURSEL';
|
||
$0148: Result := 'CB_GETLBTEXT';
|
||
$0149: Result := 'CB_GETLBTEXTLEN';
|
||
$014A: Result := 'CB_INSERTSTRING';
|
||
$014B: Result := 'CB_RESETCONTENT';
|
||
$014C: Result := 'CB_FINDSTRING';
|
||
$014D: Result := 'CB_SELECTSTRING';
|
||
$014E: Result := 'CB_SETCURSEL';
|
||
$014F: Result := 'CB_SHOWDROPDOWN';
|
||
$0150: Result := 'CB_GETITEMDATA';
|
||
$0151: Result := 'CB_SETITEMDATA';
|
||
$0152: Result := 'CB_GETDROPPEDCONTROLRECT';
|
||
$0153: Result := 'CB_SETITEMHEIGHT';
|
||
$0154: Result := 'CB_GETITEMHEIGHT';
|
||
$0155: Result := 'CB_SETEXTENDEDUI';
|
||
$0156: Result := 'CB_GETEXTENDEDUI';
|
||
$0157: Result := 'CB_GETDROPPEDSTATE';
|
||
$0158: Result := 'CB_FINDSTRINGEXACT';
|
||
$0159: Result := 'CB_SETLOCALE';
|
||
$015A: Result := 'CB_GETLOCALE';
|
||
$015B: Result := 'CB_GETTOPINDEX';
|
||
$015C: Result := 'CB_SETTOPINDEX';
|
||
$015D: Result := 'CB_GETHORIZONTALEXTENT';
|
||
$015E: Result := 'CB_SETHORIZONTALEXTENT';
|
||
$015F: Result := 'CB_GETDROPPEDWIDTH';
|
||
$0160: Result := 'CB_SETDROPPEDWIDTH';
|
||
$0161: Result := 'CB_INITSTORAGE';
|
||
$0163: Result := 'CB_MULTIPLEADDSTRING';
|
||
$0164: Result := 'CB_GETCOMBOBOXINFO';
|
||
$0200: Result := 'WM_MOUSEFIRST or WM_MOUSEMOVE';
|
||
$0201: Result := 'WM_LBUTTONDOWN';
|
||
$0202: Result := 'WM_LBUTTONUP';
|
||
$0203: Result := 'WM_LBUTTONDBLCLK';
|
||
$0204: Result := 'WM_RBUTTONDOWN';
|
||
$0205: Result := 'WM_RBUTTONUP';
|
||
$0206: Result := 'WM_RBUTTONDBLCLK';
|
||
$0207: Result := 'WM_MBUTTONDOWN';
|
||
$0208: Result := 'WM_MBUTTONUP';
|
||
$0209: Result := 'WM_MBUTTONDBLCLK';
|
||
$020A: Result := 'WM_MOUSEWHEEL or WM_MOUSELAST';
|
||
$0210: Result := 'WM_PARENTNOTIFY';
|
||
$0211: Result := 'WM_ENTERMENULOOP';
|
||
$0212: Result := 'WM_EXITMENULOOP';
|
||
$0213: Result := 'WM_NEXTMENU';
|
||
$0214: Result := 'WM_SIZING';
|
||
$0215: Result := 'WM_CAPTURECHANGED';
|
||
$0216: Result := 'WM_MOVING';
|
||
$0218: Result := 'WM_POWERBROADCAST';
|
||
$0219: Result := 'WM_DEVICECHANGE';
|
||
$0220: Result := 'WM_MDICREATE';
|
||
$0221: Result := 'WM_MDIDESTROY';
|
||
$0222: Result := 'WM_MDIACTIVATE';
|
||
$0223: Result := 'WM_MDIRESTORE';
|
||
$0224: Result := 'WM_MDINEXT';
|
||
$0225: Result := 'WM_MDIMAXIMIZE';
|
||
$0226: Result := 'WM_MDITILE';
|
||
$0227: Result := 'WM_MDICASCADE';
|
||
$0228: Result := 'WM_MDIICONARRANGE';
|
||
$0229: Result := 'WM_MDIGETACTIVE';
|
||
$0230: Result := 'WM_MDISETMENU';
|
||
$0231: Result := 'WM_ENTERSIZEMOVE';
|
||
$0232: Result := 'WM_EXITSIZEMOVE';
|
||
$0233: Result := 'WM_DROPFILES';
|
||
$0234: Result := 'WM_MDIREFRESHMENU';
|
||
$0281: Result := 'WM_IME_SETCONTEXT';
|
||
$0282: Result := 'WM_IME_NOTIFY';
|
||
$0283: Result := 'WM_IME_CONTROL';
|
||
$0284: Result := 'WM_IME_COMPOSITIONFULL';
|
||
$0285: Result := 'WM_IME_SELECT';
|
||
$0286: Result := 'WM_IME_CHAR';
|
||
$0288: Result := 'WM_IME_REQUEST';
|
||
$0290: Result := 'WM_IME_KEYDOWN';
|
||
$0291: Result := 'WM_IME_KEYUP';
|
||
$02A1: Result := 'WM_MOUSEHOVER';
|
||
$02A2: Result := 'WM_NCMOUSELEAVE';
|
||
$02A3: Result := 'WM_MOUSELEAVE';
|
||
$0300: Result := 'WM_CUT';
|
||
$0301: Result := 'WM_COPY';
|
||
$0302: Result := 'WM_PASTE';
|
||
$0303: Result := 'WM_CLEAR';
|
||
$0304: Result := 'WM_UNDO';
|
||
$0305: Result := 'WM_RENDERFORMAT';
|
||
$0306: Result := 'WM_RENDERALLFORMATS';
|
||
$0307: Result := 'WM_DESTROYCLIPBOARD';
|
||
$0308: Result := 'WM_DRAWCLIPBOARD';
|
||
$0309: Result := 'WM_PAINTCLIPBOARD';
|
||
$030A: Result := 'WM_VSCROLLCLIPBOARD';
|
||
$030B: Result := 'WM_SIZECLIPBOARD';
|
||
$030C: Result := 'WM_ASKCBFORMATNAME';
|
||
$030D: Result := 'WM_CHANGECBCHAIN';
|
||
$030E: Result := 'WM_HSCROLLCLIPBOARD';
|
||
$030F: Result := 'WM_QUERYNEWPALETTE';
|
||
$0310: Result := 'WM_PALETTEISCHANGING';
|
||
$0311: Result := 'WM_PALETTECHANGED';
|
||
$0312: Result := 'WM_HOTKEY';
|
||
$0317: Result := 'WM_PRINT';
|
||
$0318: Result := 'WM_PRINTCLIENT';
|
||
$031F: Result := 'WM_DWMNCRENDERINGCHANGED';
|
||
$0358: Result := 'WM_HANDHELDFIRST';
|
||
$035F: Result := 'WM_HANDHELDLAST';
|
||
$0380: Result := 'WM_PENWINFIRST';
|
||
$038F: Result := 'WM_PENWINLAST';
|
||
$0390: Result := 'WM_COALESCE_FIRST';
|
||
$039F: Result := 'WM_COALESCE_LAST';
|
||
$03E0: Result := 'WM_DDE_FIRST or WM_DDE_INITIATE';
|
||
$03E1: Result := 'WM_DDE_TERMINATE';
|
||
$03E2: Result := 'WM_DDE_ADVISE';
|
||
$03E3: Result := 'WM_DDE_UNADVISE';
|
||
$03E4: Result := 'WM_DDE_ACK';
|
||
$03E5: Result := 'WM_DDE_DATA';
|
||
$03E6: Result := 'WM_DDE_REQUEST';
|
||
$03E7: Result := 'WM_DDE_POKE';
|
||
$03E8: Result := 'WM_DDE_EXECUTE or WM_DDE_LAST';
|
||
$0400: Result := 'WM_USER';
|
||
// progress bar
|
||
$0401: Result := 'PBM_SETRANGE';
|
||
$0402: Result := 'PBM_SETPOS';
|
||
$0403: Result := 'PBM_DELTAPOS';
|
||
$0404: Result := 'PBM_SETSTEP';
|
||
$0405: Result := 'PBM_STEPIT';
|
||
$0406: Result := 'PBM_SETRANGE32';
|
||
$0407: Result := 'PBM_GETRANGE';
|
||
$0408: Result := 'PBM_GETPOS';
|
||
$0409: Result := 'PBM_SETBARCOLOR';
|
||
$040A: Result := 'PBM_SETMARQUEE';
|
||
$040D: Result := 'PBM_GETSTEP';
|
||
$040E: Result := 'PBM_GETBKCOLOR';
|
||
$040F: Result := 'PBM_GETBARCOLOR';
|
||
$0410: Result := 'PBM_SETSTATE';
|
||
$0411: Result := 'PBM_GETSTATE';
|
||
// misc
|
||
$0469: Result := 'UDM_SETBUDDY';
|
||
$046A: Result := 'UDM_GETBUDDY';
|
||
$102C: Result := 'LVM_GETITEMSTATE';
|
||
$8000: Result := 'WM_APP';
|
||
|
||
LM_HITTEST : Result:= 'LM_HITTEST';
|
||
LM_GETIDEALHEIGHT : Result:= 'LM_GETIDEALHEIGHT';
|
||
LM_SETITEM : Result:= 'LM_SETITEM';
|
||
LM_GETITEM : Result:= 'LM_GETITEM';
|
||
//LM_GETIDEALSIZE : Result:= 'LM_GETIDEALSIZE';
|
||
|
||
else
|
||
begin
|
||
if WM_Message>WM_USER then
|
||
Result := 'WM_USER + (' + IntToHex(WM_Message-WM_USER, 4) + ')'
|
||
|
||
else
|
||
Result := 'Unknown(' + IntToHex(WM_Message, 4) + ')';
|
||
end;
|
||
end; { Case }
|
||
end;
|
||
|
||
{$ENDIF}
|
||
|
||
function GetWindowClassName(Window: HWND): String;
|
||
var
|
||
lpClassName : array [0..255] of Char;
|
||
begin
|
||
Result:='';
|
||
if GetClassName(Window, @lpClassName, Length(lpClassName))>0 then
|
||
Result := lpClassName;
|
||
end;
|
||
|
||
function RectVCenter(var R: TRect; const Bounds: TRect): TRect;
|
||
begin
|
||
OffsetRect(R, -R.Left, -R.Top);
|
||
OffsetRect(R, 0, (Bounds.Height - R.Height) div 2);
|
||
OffsetRect(R, Bounds.Left, Bounds.Top);
|
||
Result := R;
|
||
end;
|
||
|
||
procedure MoveWindowOrg(DC: HDC; const DX, DY: Integer);
|
||
var
|
||
P: TPoint;
|
||
begin
|
||
GetWindowOrgEx(DC, P);
|
||
SetWindowOrgEx(DC, P.X - DX, P.Y - DY, nil);
|
||
end;
|
||
|
||
function FindWinFromRoot(Root: HWND; ClassName: PChar): HWND;
|
||
var
|
||
Next, Child: HWND;
|
||
S: String;
|
||
begin
|
||
Result := 0;
|
||
Next := GetWindow(Root, GW_CHILD or GW_HWNDFIRST);
|
||
while (Next > 0) do
|
||
begin
|
||
S := GetWindowClassName(Next);
|
||
if S = String(ClassName) then
|
||
Exit(Next);
|
||
Next := GetWindow(Next, GW_HWNDNEXT);
|
||
Child := GetWindow(Next, GW_CHILD or GW_HWNDFIRST);
|
||
if Child > 0 then
|
||
Result := FindWinFromRoot(Next, ClassName);
|
||
if Result > 0 then
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
{ -------------------------------------------------------------------------------------- }
|
||
{ TSysStyleManager }
|
||
function BeforeHookingControl(Info: PControlInfo): Boolean;
|
||
var
|
||
LInfo: TControlInfo;
|
||
Root, C: HWND;
|
||
begin
|
||
{
|
||
Return true to allow control hooking !
|
||
Return false to prevent control hooking !
|
||
}
|
||
{ NB: The ClassName is always in lowercase . }
|
||
LInfo := Info^;
|
||
Result := True;
|
||
Root := GetAncestor(LInfo.Parent, GA_ROOT);
|
||
if FindWinFromRoot(Root, 'DirectUIHWND') > 0 then
|
||
begin
|
||
Result := False;
|
||
Exit;
|
||
end;
|
||
|
||
if SameText(LInfo.ClassName, WC_LISTVIEW) then
|
||
begin
|
||
if SameText(LInfo.ParentClassName, 'listviewpopup') then
|
||
Result:=False;
|
||
end
|
||
else
|
||
if SameText(LInfo.ClassName, TRACKBAR_CLASS) then
|
||
begin
|
||
if SameText(LInfo.ParentClassName, 'ViewControlClass') then
|
||
Result:=False;
|
||
end
|
||
else
|
||
//Prevent hook Toolbars on DirectUIHWND
|
||
if SameText(LInfo.ClassName, TOOLBARCLASSNAME) then
|
||
begin
|
||
if SameText(LInfo.ParentClassName, 'ViewControlClass') then
|
||
Result:=False
|
||
else
|
||
if Root > 0 then
|
||
begin
|
||
C := FindWinFromRoot(Root, REBARCLASSNAME);
|
||
Result := not(C > 0);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure HookNotification(Action: TSysHookAction; Info: PControlInfo);
|
||
begin
|
||
|
||
end;
|
||
|
||
class constructor TSysStyleManager.Create;
|
||
begin
|
||
FHook_WH_CBT:=0;
|
||
FBeforeHookingControlProc := @BeforeHookingControl;
|
||
FSysHookNotificationProc := @HookNotification;
|
||
FUseStyleColorsChildControls := True;
|
||
FEnabled := True;
|
||
FHookDialogIcons := False;
|
||
FHookVclControls := False;
|
||
FSysStyleHookList := TObjectDictionary<HWND, TSysStyleHook>.Create([doOwnsValues]);
|
||
FRegSysStylesList := TObjectDictionary<String, TSysStyleHookClass>.Create;
|
||
FChildRegSysStylesList := TObjectDictionary<HWND, TChildControlInfo>.Create;
|
||
//FSysStyleHookList := TObjectDictionary<HWND, TSysStyleHook>.Create([]);
|
||
InstallHook_WH_CBT;
|
||
end;
|
||
|
||
class destructor TSysStyleManager.Destroy;
|
||
begin
|
||
RemoveHook_WH_CBT;
|
||
FRegSysStylesList.Free;
|
||
FSysStyleHookList.Free; // remove the childs too because doOwnsValues
|
||
FChildRegSysStylesList.Free;
|
||
inherited;
|
||
end;
|
||
|
||
class procedure TSysStyleManager.AddControlDirectly(Handle: HWND; const sClassName : string; IncludeChildControls : Boolean = False);
|
||
var
|
||
LStyleHook : TSysStyleHook;
|
||
ParentStyle : DWORD;
|
||
|
||
procedure AddChildControl(ChildHandle: HWND);
|
||
var
|
||
Info: TChildControlInfo;
|
||
sChildClassName : string;
|
||
LStyleHook : TSysStyleHook;
|
||
begin
|
||
{ Hook the control directly ! }
|
||
ZeroMemory(@Info, sizeof(TChildControlInfo));
|
||
Info.Parent := Handle;
|
||
Info.ParentStyle := ParentStyle;
|
||
sChildClassName := LowerCase(GetWindowClassName(ChildHandle));
|
||
if FRegSysStylesList.ContainsKey(sChildClassName) then
|
||
begin
|
||
LStyleHook:=FRegSysStylesList[LowerCase(sChildClassName)].Create(ChildHandle);
|
||
FSysStyleHookList.Add(ChildHandle, LStyleHook);
|
||
SendMessage(ChildHandle, CM_CONTROLHOOKEDDIRECTLY, 0, 0);
|
||
InvalidateRect(ChildHandle, nil, False);
|
||
// if Assigned(FSysHookNotificationProc) then
|
||
// FSysHookNotificationProc(cAdded, @Info);
|
||
end;
|
||
end;
|
||
|
||
function EnumChildProc(const hWindow: hWnd; const LParam : LParam): boolean; stdcall;
|
||
begin
|
||
AddChildControl(hWindow);
|
||
Result:= True;
|
||
end;
|
||
|
||
begin
|
||
if not FRegSysStylesList.ContainsKey(LowerCase(sClassName)) then
|
||
Exit;
|
||
{ Hook the control directly ! }
|
||
if FSysStyleHookList.ContainsKey(Handle) then
|
||
FSysStyleHookList.Remove(Handle);
|
||
LStyleHook:=FRegSysStylesList[LowerCase(sClassName)].Create(Handle);
|
||
FSysStyleHookList.Add(Handle, LStyleHook);
|
||
SendMessage(Handle, CM_CONTROLHOOKEDDIRECTLY, 0, 0);
|
||
// if Assigned(FSysHookNotificationProc) then
|
||
// FSysHookNotificationProc(cAdded, @Info);
|
||
|
||
if IncludeChildControls then
|
||
begin
|
||
ParentStyle:=GetWindowLongPtr(Handle, GWL_STYLE);
|
||
EnumChildWindows(Handle, @EnumChildProc, 0);
|
||
end;
|
||
end;
|
||
|
||
|
||
constructor TSysStyleManager.Create(AOwner: TComponent);
|
||
begin
|
||
inherited;
|
||
end;
|
||
|
||
destructor TSysStyleManager.Destroy;
|
||
begin
|
||
inherited;
|
||
end;
|
||
|
||
type
|
||
TSysStyleClass = class(TSysStyleHook);
|
||
|
||
class function TSysStyleManager.HookActionCallBackCBT(nCode: Integer; wParam: wParam; lParam: lParam): LRESULT;
|
||
var
|
||
CBTSturct: TCBTCreateWnd;
|
||
sClassName, Tmp: string;
|
||
{LHWND,} Parent: HWND;
|
||
Style, ParentStyle, ExStyle, ParentExStyle: NativeInt;
|
||
Info: TControlInfo;
|
||
|
||
procedure RemoveUnusedHooks;
|
||
var
|
||
LHandle : THandle;
|
||
begin
|
||
for LHandle in TSysStyleManager.SysStyleHookList.Keys do
|
||
if TSysStyleClass(TSysStyleManager.SysStyleHookList.Items[LHandle]).MustRemove then
|
||
TSysStyleManager.SysStyleHookList.Remove(LHandle);
|
||
end;
|
||
|
||
procedure AddChildControl(Handle: HWND);
|
||
var
|
||
Info: TChildControlInfo;
|
||
begin
|
||
{ The child control will be hooked inside it's parent control. }
|
||
ZeroMemory(@Info, sizeof(TChildControlInfo));
|
||
Info.Parent := Parent;
|
||
Info.ParentStyle := ParentStyle;
|
||
Info.StyleHookClass := FRegSysStylesList[sClassName];
|
||
if FChildRegSysStylesList.ContainsKey(Handle) then
|
||
FChildRegSysStylesList.Remove(Handle);
|
||
FChildRegSysStylesList.Add(Handle, Info);
|
||
if Assigned(FSysHookNotificationProc) then
|
||
FSysHookNotificationProc(cAdded, @Info);
|
||
end;
|
||
|
||
procedure AddControl(Handle: HWND);
|
||
var
|
||
LStyleHook : TSysStyleHook;
|
||
begin
|
||
{ Hook the control directly ! }
|
||
RemoveUnusedHooks;
|
||
if FSysStyleHookList.ContainsKey(Handle) then
|
||
FSysStyleHookList.Remove(Handle);
|
||
LStyleHook:=FRegSysStylesList[sClassName].Create(Handle);
|
||
FSysStyleHookList.Add(Handle, LStyleHook);
|
||
SendMessage(Handle, CM_CONTROLHOOKEDDIRECTLY, 0, 0);
|
||
if Assigned(FSysHookNotificationProc) then
|
||
FSysHookNotificationProc(cAdded, @Info);
|
||
end;
|
||
|
||
begin
|
||
Result := CallNextHookEx(FHook_WH_CBT, nCode, wParam, lParam);
|
||
if not FEnabled then
|
||
Exit;
|
||
|
||
// if (nCode = HCBT_ACTIVATE) and not(StyleServices.IsSystemStyle) then
|
||
// begin
|
||
// LHWND := HWND(wParam);
|
||
// if(LHWND>0) then
|
||
// begin
|
||
// sClassName:= GetWindowClassName(LHWND);
|
||
// if (sClassName<>'') and (not TSysStyleManager.SysStyleHookList.ContainsKey(LHWND)) and (SameText(sClassName,'#32770')) then
|
||
// begin
|
||
// TSysStyleManager.AddControlDirectly(LHWND, sClassName);
|
||
// InvalidateRect(LHWND, nil, False);
|
||
// end;
|
||
// end;
|
||
// end;
|
||
|
||
|
||
if (nCode = HCBT_CREATEWND) and not(StyleServices.IsSystemStyle) then
|
||
begin
|
||
|
||
CBTSturct := PCBTCreateWnd(lParam)^;
|
||
sClassName := GetWindowClassName(wParam);
|
||
sClassName := LowerCase(sClassName);
|
||
|
||
// if SameText(sClassName, '#32770') then
|
||
// OutputDebugString(PChar('Class '+sclassName+' '+IntToHex(wParam, 8)));
|
||
|
||
Parent := CBTSturct.lpcs.hwndParent;
|
||
Style := CBTSturct.lpcs.Style;
|
||
ExStyle := CBTSturct.lpcs.dwExStyle;
|
||
ParentExStyle := 0;
|
||
ParentStyle := 0;
|
||
|
||
if Parent > 0 then
|
||
begin
|
||
ParentStyle := GetWindowLongPtr(Parent, GWL_STYLE);
|
||
ParentExStyle := GetWindowLongPtr(Parent, GWL_EXSTYLE);
|
||
end;
|
||
|
||
if FRegSysStylesList.ContainsKey(sClassName) then
|
||
begin
|
||
Info.Handle := wParam;
|
||
Info.Parent := Parent;
|
||
Info.Style := Style;
|
||
Info.ParentStyle := ParentStyle;
|
||
Info.ExStyle := ExStyle;
|
||
Info.ParentExStyle := ParentExStyle;
|
||
Tmp := sClassName;
|
||
Info.ClassName := PChar(Tmp);
|
||
Tmp := LowerCase(GetWindowClassName(Parent));
|
||
Info.ParentClassName := PChar(Tmp);
|
||
|
||
if not HookVclControls then
|
||
if IsVCLControl(wParam) then
|
||
Exit;
|
||
|
||
if Assigned(FBeforeHookingControlProc) then
|
||
if not FBeforeHookingControlProc(@Info) then
|
||
Exit;
|
||
|
||
if (Style and DS_CONTROL = DS_CONTROL) then
|
||
begin
|
||
{ TabSheet ! }
|
||
AddControl(wParam);
|
||
PostMessage(wParam, CM_INITCHILDS, 0, 0);
|
||
end
|
||
else if (Style and WS_POPUP = WS_POPUP) then
|
||
begin
|
||
{ Parent Control ! }
|
||
AddControl(wParam);
|
||
end
|
||
else if (Style and WS_CHILD = WS_CHILD) then
|
||
begin
|
||
{ Child Control ! }
|
||
if FSysStyleHookList.ContainsKey(Parent) then
|
||
begin
|
||
{ Parent is already hooked . }
|
||
if IsVCLControl(Parent) then
|
||
{ Parent is a VCL control . }
|
||
AddControl(wParam)
|
||
else
|
||
AddChildControl(wParam)
|
||
end
|
||
else
|
||
{ Parent not registered (not hooked). }
|
||
AddControl(wParam);
|
||
end
|
||
else
|
||
{ Not (WS_CHILD or WS_POPUP) !! }
|
||
AddControl(wParam);
|
||
end;
|
||
|
||
// if FSysStyleHookList.ContainsKey(wParam) or FChildRegSysStylesList.ContainsKey(wParam) then
|
||
// OutputDebugString(PChar('Hooked '+IntToHex(wParam, 8)));
|
||
|
||
end;
|
||
|
||
|
||
if nCode = HCBT_DESTROYWND then
|
||
begin
|
||
//OutputDebugString(PChar('HCBT_DESTROYWND Handle '+IntToHex(wParam, 8)));
|
||
if FSysStyleHookList.ContainsKey(wParam) then
|
||
begin
|
||
ZeroMemory(@Info, sizeof(TControlInfo));
|
||
Info.Handle := wParam;
|
||
if Assigned(FSysHookNotificationProc) then
|
||
OnHookNotification(cRemoved, @Info);
|
||
// FSysStyleHookList.Remove(wParam); -> removed in WM_NCDESTROY
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
class procedure TSysStyleManager.InstallHook_WH_CBT;
|
||
begin
|
||
FHook_WH_CBT := SetWindowsHookEx(WH_CBT, @HookActionCallBackCBT, 0, GetCurrentThreadId);
|
||
end;
|
||
|
||
class procedure TSysStyleManager.RegisterSysStyleHook(const SysControlClass: String; SysStyleHookClass: TSysStyleHookClass);
|
||
begin
|
||
if FRegSysStylesList.ContainsKey(LowerCase(SysControlClass)) then
|
||
FRegSysStylesList.Remove(LowerCase(SysControlClass));
|
||
FRegSysStylesList.Add(LowerCase(SysControlClass), SysStyleHookClass);
|
||
end;
|
||
|
||
class procedure TSysStyleManager.RemoveHook_WH_CBT;
|
||
begin
|
||
if FHook_WH_CBT <> 0 then
|
||
UnhookWindowsHookEx(FHook_WH_CBT);
|
||
end;
|
||
|
||
class procedure TSysStyleManager.UnRegisterSysStyleHook(const SysControlClass: String; SysStyleHookClass: TSysStyleHookClass);
|
||
begin
|
||
if FRegSysStylesList.ContainsKey(LowerCase(SysControlClass)) then
|
||
FRegSysStylesList.Remove(LowerCase(SysControlClass));
|
||
end;
|
||
|
||
end.
|