在标题栏显示按钮，最小化的时候它会在当前操作窗口的标题栏右上角显示

znhyz1 2016-08-08 02:07:09

在标题栏显示按钮的实例源程序，也就是像有些播放软件一样，最小化的时候它会在当前操作窗口的标题栏右上角显示它的常用播放按钮，以方便对它的控制，在Windows 7有点小BUG，xp正常，求大神帮忙？

下载地址：
http://download.csdn.net/detail/znhyz1/9597998

...全文

1498 5 打赏收藏转发到动态举报

写回复

用AI写文章

5 条回复

切换为时间正序

请发表友善的回复…

发表回复

mychj 2016-09-02

打赏
举报

360会放过你吗，一用这功能就被360当病毒干掉了

znhyz1 2016-08-22

打赏
举报

引用 3 楼 gyk120 的回复:

你说的是哪里的bug？图标按钮外观？

在windows 7上，新加的标题栏按钮不随着窗体移动

gyk120 2016-08-15

打赏
举报

你说的是哪里的bug？图标按钮外观？

znhyz1 2016-08-08

打赏
举报

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]

znhyz1 2016-08-08

打赏
举报

钩子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.