在标题栏显示按钮的实例源程序,也就是像有些播放软件一样,最小化的时候它会在当前操作窗口的标题栏右上角显示它的常用播放按钮,以方便对它的控制,在Windows 7有点小BUG,xp正常,求大神帮忙?下载地址:
http://download.csdn.net/detail/znhyz1/9597998
http://download.csdn.net/detail/znhyz1/9597998
解决方案 »
- 请问Delphi编写下载文件的工具,如何实现"加载条"?
- sdiapp 无法找到路径。.
- Delphi如何写出拦截例外 并可显示错误讯息.
- 干掉小日本——ttzzj首次放分
- 大虾们,请教 出现 BOF或EOF中有一个是"真",或者当前的记录已被删除,所需的操作要求一个当前的记录
- 怪了,formactivate为什么运行不了啊?
- 求助
- 在FORM2和datamodule1中怎样才能方问FORM1中的自已写的函数呢?
- 如何在远程数据模块内设置断点?
- delphi win32/trojan.multi.daf delphi 生成的exe 文件 360 报木马杀掉怎么办? 在线
- 用SkinVirtualStringTree,如何遍历列数据?
- dll中 use dbgrideh 导致运行时错误216?
SysUtils,
Classes,
Windows,
uActiveHook in 'uActiveHook.pas';{$R *.res}exports
GetDLLData,
EnableHook,
RemoveHook;begin
DllProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.unit uActiveHook;interfaceuses
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;implementationvar
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.
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;interfaceuses
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;implementationuses 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);
beginend;procedure TFrmMain.Reposition(var Message: TMessage);
var
ReceiveStruct: PReceiveStruct;
beginend;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]
在windows 7上,新加的标题栏按钮不随着窗体移动