在标题栏显示按钮的实例源程序,也就是像有些播放软件一样,最小化的时候它会在当前操作窗口的标题栏右上角显示它的常用播放按钮,以方便对它的控制,在Windows 7有点小BUG,xp正常,求大神帮忙?下载地址:
http://download.csdn.net/detail/znhyz1/9597998

解决方案 »

  1.   

    钩子ActiveHook.dlllibrary 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;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.
      

  2.   

    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;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]
      

  3.   

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

  4.   


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