在標題欄顯示按鈕的實體源程式，也就是像有些播放軟體一樣，最小化的時候它會在當前操作視窗的標題欄右上角顯示它的常用播放按鈕，以方便對它的控制，在Windows 7有點小BUG，xp正常，求大神幫忙？
下載地址：
http://download.csdn.net/detail/znhyz1/9597998
uj5u.com熱心網友回復：
鉤子ActiveHook.dll
library ActiveHook;
uses
SysUtils,
Classes,
Windows,
uActiveHook in 'uActiveHook.pas';
{$R *.res}
exports
GetDLLData,
EnableHook,
RemoveHook;
begin
DllProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
unit uActiveHook;
interface
uses
Windows, Messages, SysUtils;
const
MSG_FINDWIN = WM_USER + 2416;
MSG_REPOSITION = WM_USER + 2335;
MSG_CLOSE = WM_USER + 2248;
MAPFILE_GNAME: PChar = 'WIN_ACTIVE_INFO';
type
PReceiveStruct = ^TReceiveStruct;
TReceiveStruct = record
RecHandle: THandle;
CurHandle: THandle;
end;
procedure DLLEntryPoint(dwReason: DWord);
procedure GetDLLData(var aReceiveStruct: PReceiveStruct); stdcall; export;
function EnableHook(aRecHandle: THandle): Boolean; export;
function RemoveHook: Boolean; export;
function Hook(iCode: Integer; wParam: WPARAM; CWPRet: PCWPRetStruct): LRESULT; stdcall; export;
implementation
var
CurHookProc: HHOOK;
MapFileHandle: THandle;
ReceiveStruct: PReceiveStruct;
procedure GetDLLData(var aReceiveStruct: PReceiveStruct); stdcall;
begin
aReceiveStruct := ReceiveStruct;
end;
function EnableHook(aRecHandle: THandle): Boolean; export;
begin
ReceiveStruct.RecHandle := aRecHandle;
if CurHookProc = 0 then
begin
CurHookProc := SetWindowsHookEx(WH_CALLWNDPROCRET, @Hook, HInstance, 0);
end;
Result := (CurHookProc <> 0);
end;
function Hook(iCode: Integer; wParam: WPARAM; CWPRet: PCWPRetStruct): LRESULT; stdcall; export;
begin
//在外面需要判斷發生變化的視窗是否和自己有關系CWPRet.hwnd = MostRecentWindow
if iCode = HC_ACTION then
begin
ReceiveStruct.CurHandle := CWPRet.hwnd;
case CWPRet.message of
WM_ACTIVATE: //send msg to notify window change pos. change pos only cur window=active window
begin
if CWPRet.lResult = WA_INACTIVE then//
begin
SendMessage(ReceiveStruct.RecHandle, MSG_FINDWIN, 0, 0);
//Abandon();//??不懂
//Reposition();
end;
end;
WM_WINDOWPOSCHANGED, WM_SETTEXT:
begin
SendMessage(ReceiveStruct.RecHandle, MSG_FINDWIN, 0, 0); //MSG_REPOSITION
//Reposition();
end;
WM_CLOSE:
begin
SendMessage(ReceiveStruct.RecHandle, MSG_CLOSE, 0, 0);
//Reposition();
end;
end;
end;
Result := CallNextHookEx(CurHookProc, iCode, wParam, Integer(CWPRet));
end;
function RemoveHook: Boolean; export;
begin
if CurHookProc <> 0 then
begin
UnhookWindowshookEx(CurHookProc);
CurHookProc := 0;
end;
Result := (CurHookProc = 0);
end;
procedure OpenSharedData;
var
Size: Integer;
begin
Size := SizeOf(TReceiveStruct);
MapFileHandle := CreateFileMapping(DWord(-1), nil, PAGE_READWRITE, 0, Size, MAPFILE_GNAME);
if MapFileHandle = 0 then
RaiseLastWin32Error;
ReceiveStruct := MapViewOfFile(MapFileHandle, FILE_MAP_ALL_ACCESS, 0, 0, Size);
if ReceiveStruct = nil then
begin
CloseHandle(MapFileHandle);
RaiseLastWin32Error;
end;
end;
procedure CloseSharedData;
begin
UnmapViewOfFile(ReceiveStruct);
CloseHandle(MapFileHandle);
end;
procedure DLLEntryPoint(dwReason: DWord);
begin
case dwReason of
DLL_PROCESS_ATTACH:
OpenSharedData;
DLL_PROCESS_DETACH:
CloseSharedData;
end;
end;
end.
uj5u.com熱心網友回復：
Demo程式:
program DemoHookActive;
uses
Forms,
uDemoMain in 'uDemoMain.pas' {FrmMain},
uDemoBar in 'uDemoBar.pas' {frmBar},
uDemoUtils in 'uDemoUtils.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TFrmMain, FrmMain);
frmBar := TfrmBar.Create(nil);
Application.Run;
end.
unit uDemoMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, uDemoUtils,
Dialogs, ExtCtrls, StdCtrls, ActnList, JvComponentBase, JvTrayIcon,
JvExControls, JvStaticText;
type
TFrmMain = class(TForm)
p1: TPanel;
btnEnable: TButton;
btnDisable: TButton;
Act: TActionList;
actEnable: TAction;
actDisable: TAction;
actHook: TAction;
JvTrayIcon1: TJvTrayIcon;
JvStaticText1: TJvStaticText;
ActionList1: TActionList;
actEnableKeyHook: TAction;
actDisableKeyHook: TAction;
procedure actEnableExecute(Sender: TObject);
procedure actDisableExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure actEnableKeyHookExecute(Sender: TObject);
procedure actDisableKeyHookExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
F11TOM: ATOM; // 全域快捷鍵F11唯一標識
F12TOM: ATOM; // 全域快捷鍵F12唯一標識
FCaptionFont: THandle;
FCurHookForm: THandle;
procedure Reposition(var Message: TMessage); message MSG_REPOSITION;
procedure FindWin(var Message: TMessage); message MSG_FINDWIN;
procedure HasFormClosed(var Message: TMessage); message MSG_CLOSE;
procedure Attach(hwnd: THandle; style: DWORD);
//procedure WMNMiniHook(var Msg: TMessage); message MSG_MINI_CLICK;
procedure hotykey(var msg: TMessage); message WM_HOTKEY; // 定義全域熱鍵訊息事件
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
uses uDemoBar;
{$R *.dfm}
{ TFrmMain }
procedure TFrmMain.Attach(hwnd: THandle; style: DWORD);
var
HookedFormRect: TRect;
top, left, height: Integer;
TmpSytle: integer;
YOffset, AddOn: Integer;// offset
chars, FormBaseWidth: Integer;
Title: string;
begin
CalcButtonOffsets(Handle, YOffset, AddOn);
SetLength (Title, 255);
chars := GetWindowText(hwnd, PChar(Title), Length(Title));
Title := Trim(Title);
FormBaseWidth := StringWidth(FCaptionFont, title, chars);
if (style and WS_SYSMENU) = WS_SYSMENU then
FormBaseWidth := FormBaseWidth + 30;
frmBar.HookedFormBaseWidth := FormBaseWidth + AddOn;
GetWindowRect(hwnd, HookedFormRect);
height := GetSystemMetrics(SM_CYSIZE) - EDGE*2;
frmBar.Height := height;
if (style and WS_THICKFRAME) <> 0 then
begin
TmpSytle := SM_CYSIZEFRAME;
end
else begin
TmpSytle := SM_CYFIXEDFRAME;
end;
top := HookedFormRect.Top + YOffset + EDGE;
left := HookedFormRect.Right - AddOn - frmBar.Width;
SetWindowPos(frmBar.Handle,
HWND_TOPMOST,
left, top, frmBar.Width, height,
SWP_NOACTIVATE or SWP_NOCOPYBITS or SWP_NOSENDCHANGING or
SWP_NOZORDER or SWP_NOOWNERZORDER);
ShowWindow(frmBar.Handle, SW_SHOWNA);//to make it stay on top.
frmBar.HookedHandle := hwnd;// --
end;
procedure TFrmMain.FindWin(var Message: TMessage);
var
ReceiveStruct: PReceiveStruct;
hwnd: THandle;
style: DWORD;
i: Integer;
begin
GetDLLData(ReceiveStruct);
if ReceiveStruct.CurHandle = frmBar.Handle then Exit;
i := NUM_GET_WINDOW_ATTEMPTS;
hwnd := GetWindow(GetDesktopWindow, GW_CHILD);
while hwnd <> 0 do
begin
hwnd := GetWindow(hwnd, GW_HWNDNEXT);
if IsWindowSuitable(hwnd, frmBar.Handle, style) then
begin
FCurHookForm := hwnd;
Attach(hwnd, style);
Exit;
end;
i := i - 1;
if i = 0 then
begin
hwnd := 0;
end;
end;
end;
procedure TFrmMain.HasFormClosed(var Message: TMessage);
begin
end;
procedure TFrmMain.Reposition(var Message: TMessage);
var
ReceiveStruct: PReceiveStruct;
begin
end;
procedure TFrmMain.actEnableExecute(Sender: TObject);
begin
EnableHook(Handle);
SendMessage(Self.Handle, MSG_FINDWIN, 0, 0);
ShowWindow(frmBar.Handle, SW_SHOWNA);
frmBar.Visible := True;
actEnable.Enabled := False;
actDisable.Enabled := not actEnable.Enabled;
actHook.Enabled := not actEnable.Enabled;
end;
procedure TFrmMain.actDisableExecute(Sender: TObject);
begin
ShowWindow(frmBar.Handle, SW_HIDE);
frmBar.Visible := False;
RemoveHook;
DeleteObject(FCaptionFont);
actEnable.Enabled := True;
actDisable.Enabled := not actEnable.Enabled;
actHook.Enabled := not actEnable.Enabled;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
var
metrics:PNONCLIENTMETRICS;
begin
if FindAtom('F11TOM') = 0 then F11TOM := GlobalAddAtom('F11TOM');
if FindAtom('F12TOM') = 0 then F12TOM := GlobalAddAtom('F12TOM');
if RegisterHotKey(Handle, F11TOM, MOD_CONTROL, VK_F11) then
begin
//MessageBox(Handle, '按F11', '提示', MB_OK);
end;
if RegisterHotKey(Handle, F12TOM, MOD_CONTROL, VK_F12) then
begin
//MessageBox(Handle, '按F12', '提示', MB_OK);
end;
metrics.cbSize := sizeof(NONCLIENTMETRICS);
if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @metrics, 0) then
FCaptionFont := CreateFontIndirect(metrics.lfCaptionFont);
end;
procedure TFrmMain.FormShow(Sender: TObject);
begin
actEnable.Enabled := True;
actDisable.Enabled := not actEnable.Enabled;
actHook.Enabled := not actEnable.Enabled;
actEnableKeyHook.Enabled := True;
actDisableKeyHook.Enabled := not actEnableKeyHook.Enabled;
end;
procedure TFrmMain.actEnableKeyHookExecute(Sender: TObject);
begin
// EnableKeyHook(Self.Handle);
// actEnableKeyHook.Enabled := False;
// actDisableKeyHook.Enabled := not actEnableKeyHook.Enabled;
end;
procedure TFrmMain.actDisableKeyHookExecute(Sender: TObject);
begin
// DisableKeyHook;
// actEnableKeyHook.Enabled := True;
// actDisableKeyHook.Enabled := not actEnableKeyHook.Enabled;
end;
//procedure TFrmMain.WMNMiniHook(var Msg: TMessage);
//var
// mm: string;
//begin
// mm := SubString(string(Msg.WParam),'|',1);
// if mm = '1' then
// begin
// SendMessage(frmBar.Handle, MSG_MINI_CLICK, wParam(mm), 0);//給界面發訊息
// end else
// begin
// SendMessage(frmBar.Handle, MSG_MINI_CLICK, wParam(mm), 0);//給界面發訊息
// end;
// inherited; // 加上這句就會繼續傳遞，否則就到此為止了
//end;
procedure TFrmMain.hotykey(var msg: TMessage);
var
h: THandle;
mm: string;
begin
if TWMHotKey(msg).HotKey = F11TOM then
begin
end; //ShowMessage('Hot');
if (msg.LParamHi = VK_F11) and (msg.LParamLo = MOD_CONTROL) then
begin
mm := '1|張三'; //ShowMessage('VK_F11');
frmBar.DoWMNMiniClick(mm);
//SendMessage(frmBar.Handle, MSG_MINI_CLICK, wParam(mm), 0);//給界面發訊息
end else
if (msg.LParamHi = VK_F12) and (msg.LParamLo = MOD_CONTROL) then
begin
mm := '2|李四'; //ShowMessage('VK_F12');
frmBar.DoWMNMiniClick(mm);
//SendMessage(frmBar.Handle, MSG_MINI_CLICK, wParam(mm), 0);//給界面發訊息
end;
end;
procedure TFrmMain.FormDestroy(Sender: TObject);
begin
UnregisterHotKey(Handle, F11TOM);
UnregisterHotKey(Handle, F12TOM);
GlobalDeleteAtom(F11TOM);
GlobalDeleteAtom(F12TOM);
end;
end.
[code=delphi]
uj5u.com熱心網友回復：
你說的是哪里的bug？圖示按鈕外觀？uj5u.com熱心網友回復：
在windows 7上，新加的標題欄按鈕不隨著表單移動
uj5u.com熱心網友回復：
360會放過你嗎，一用這功能就被360當病毒干掉了轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/64678.html