找到一个文章，晚上回家看，别打不开呀。

问题：分享:全屏DirectX程序下弹出摸态窗口代码 ( 积分：0, 回复：10, 阅读：1082 ) 分类：系统相关 ( 版主：luyear, zyy04 )
来自：tt.t, 时间：2003-8-26 21:05:00, ID：2135796	[显示：小字体 | 大字体]
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2135796   一直有人问如何在DirectX全屏游戏中弹出窗口就象金山游侠一样.我答应过要给出原码,只是一直没有时间整理,不过现在总算是弄玩了.代码不长,大致作了些注释,但愿你能看懂:) 按照我的说明一步步作应该就能成功,但有时可能不行,为什么?我也不知道,或许是你哪一步做错了,或者是Delphi的问题?天知道,但大多数时候按照我给出的步骤,这些代码应该能实现我们的目标. 下面的代码经过了一定的测试,但并没有刻意设计保证程序兼容性和稳定性的代码,所以不能保证在所有的机器上正常运行.如果死机或者花屏了,那么很不幸它不适合你,在找些别人写的类似的代码吧(不过以前有人公开过类似的代码吗?如果有请mail给我:) 试一试吧,希望我们能把它完善起来. {***************HOOK.DLL************ FileName:Hook.dpr(The KEY unit to pop up a window in DX apps) Author: tTui or tt.t (As u like ;) Feature:This unit contain the Demo codes for pop up an MODAL window in Apps which use exclusive directX fullscreen mode. Description: 1.Uses KeyBoard hook to hook the hotkey.              2.Uses s0me tricks to get the *real* IDirectDraw pointer.              3.Call the *IDirectDraw.FilptoGDISurface* to make sure the poped up window could be seen.(See MSDN for the reason)              4.Uses GetMessage hook to hook the WM_TIMER,WM_SETFOCUS... messages.(Why?I don't want to tell u :) Find the reason by urself)              5.The HotKey is Left WIN + NumPad *              6.Mute codes needed, but havn't wrote yet.              7.Complied with Delphi 6. Tested under Win98&SE, Win ME, Win 2K,Win XP and Win 2003.NET with DirectX 8&9. Known Bugs:  1.Cannot repaint the background when the poped up window moved.              2.May crash when try to pop up from some games and apps.              3.Cannot show the cursor in some games.              4.May minimize the main App, when try to pop up the window.              5.Many more...but unknown yet... MY MAIL: ttui@163.com BTW, if u want to pop up an MODALLESS window, u should write the codes all by urself. *DO NOT* ask me for that. ***********************************} library Hook; uses   SysUtils,   Classes,   Windows,   Messages,   Dialogs,   DirectDraw,  //*Modified* Jedi's DirectX header file for Delphi.   FormUnit in 'FormUnit.pas' {Form1};  //The unit contains the popup window. {$R *.res} type   PHookRec = ^THookRec;   THookRec = record     ParentWnd:HWND;  //The main app's handle     FormWnd:HWND;    //Handle of the popup window     Poped:Boolean;   //A flag. eq True if the window poped     HH1:HHOOK;       //Hook handle of the keyboard hook     HH2:HHOOK;       //Hook handle of the GetMessage hook   end; var   rHookRec: PHookRec = nil;   hMapObject: THandle = 0; var   pDirectDrawCreate:function (lpGUID: PGUID;out lplpDD: IDirectDraw;pUnkOuter: IUnknown) : HResult; stdcall; function WHGETMESSAGE(iCode:Integer;wParam: WPARAM;lParam: LPARAM):LRESULT; stdcall; begin   result:=0;   if iCode<0 then   begin     CallNextHookEx(rHookRec^.HH2,iCode,wParam,lParam);     result:=0;     Exit;   end;   case PMSG(lParam)^.message of     WM_TIMER,       //$113     WM_WINDOWPOSCHANGING,  //$47     WM_SETCURSOR,     //$20     WM_ACTIVATEAPP,    //$1c     WM_SETFOCUS:      //$7       begin           //Some other messages should be processed here.         PMSG(lParam)^.message:=0;       end;   end; end; function HookProc(iCode:Integer;wParam: WPARAM;lParam: LPARAM):LRESULT; stdcall; var   dh:dword;   FD:IDirectDraw;   pp:pointer;   a:dword;   sc:integer; begin   result:=0;   if iCode<0 then   begin     CallNextHookEx(rHookRec^.HH1,iCode,wParam,lParam);     result:=0;     Exit;   end;   if ((lParam and $80000000)=0) and      (GetKeyState(VK_LWIN)<0) and (wParam=$6a) then  //The HotKey is Left WIN + NumPad *   begin     rHookRec^.ParentWnd:=getforegroundwindow;     if not isWindow(rHookRec^.ParentWnd) then exit;     try       if not rHookRec^.Poped then       begin         dh:=GetModuleHandle('ddraw.dll');  //is a dx app??         if dh<>0 then         begin           dh:=dword(GetProcAddress(dh,'DirectDrawCreate'));           if dh<>0 then           begin             pDirectDrawCreate:=Pointer(dh);             if pDirectDrawCreate(nil,FD,nil)=0 then             begin               pp:=@fd;               a:=dword(pointer(dword(pp^)+8)^);  //Now a is the pointer to the *REAL* IDirectDraw               asm     //Call FliptoGDISurface                 mov eax,a                 push eax                 mov eax,[eax]                 call [eax+$28]               end;               FD:=nil;             end;           end;         end;         rHookRec^.HH2:=setwindowshookex(WH_GETMESSAGE,@WHGETMESSAGE,0,GetCurrentThreadID);         sc:=ShowCursor(true);  //Show cursor         form1:=tform1.CreateParented(rHookRec^.ParentWnd); //Create the window that'll pop up         rHookRec^.Poped:=true;  //set flag         rHookRec^.FormWnd:=form1.Handle;         form1.ShowModal;  //Bingo!! The window pops up!!         form1.Free;         rHookRec^.Poped:=false;  //set flag         UnhookWindowshookEx(rHookRec^.HH2);         if sc>=0 then           ShowCursor(true)         else           ShowCursor(false);       end;     finally     end;     result:=1;   end; end; function sethook:bool;export;  //Call the func to set the keyboard hook begin   result:=false;   if rHookRec^.HH1<>0 then exit;                   rHookRec^.Poped:=False;   rHookRec^.HH1 := SetWindowsHookEx(WH_KEYBOARD,hookproc,HInstance,0);   Result := rHookRec^.HH1 <> 0; end; function endhook:bool;export;  //Call the func to unhook the keyboard hook begin   if rHookRec^.HH1 <> 0 then   begin     UnhookWindowshookEx(rHookRec^.HH1);     rHookRec^.HH1 := 0;   end;   Result := rHookRec^.HH1 = 0; end; procedure EntryPointProc(Reason: Integer);  //Create and Close the file mapping to share data in different processes. begin   case reason of     DLL_PROCESS_ATTACH:     begin       hMapObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(THookRec), '_Popup_A_Wnd_DEMO_');       rHookRec := MapViewOfFile(hMapObject, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookRec));     end;     DLL_PROCESS_DETACH:     begin       try         UnMapViewOfFile(rHookRec);         CloseHandle(hMapObject);       except       end;     end;   end; end; Exports   SetHook,   EndHook; begin   DllProc := @EntryPointProc;   EntryPointProc(DLL_PROCESS_ATTACH); end. //================================================== {*************FormUnit.pas********** FileName:FormUnit.pas Author: tTui or tt.t (As u like ;) Description: This unit contains the codes of the popup window. MY MAIL: ttui@163.com TIPS:The form's BoaderStyle property must be "bsDialog" or the popup window may not be seen. ***********************************} unit FormUnit; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs; type   TForm1 = class(TForm)     procedure FormCreate(Sender: TObject);     procedure FormDestroy(Sender: TObject); //u can add other VCL components.   private     { Private declarations }     procedure WndProc(var Message: TMessage); override;   public     { Public declarations }   end; type   PHookRec = ^THookRec;   THookRec = record     ParentWnd:HWND;     FormWnd:HWND;     Poped:Boolean;     HH1:HHOOK;     HH2:HHOOK;   end; var   Form1: TForm1;   TILC_Message:Cardinal;  //Exit message   rHookRec: PHookRec = nil;   hMapObject: THandle = 0; implementation {$R *.dfm} procedure TForm1.WndProc(var Message: TMessage); begin   inherited WndProc(Message);   if Message.Msg=TILC_Message then       Close; end; procedure TForm1.FormCreate(Sender: TObject); begin   TILC_Message:=RegisterWindowMessage(pchar('Poooop!!'));   hMapObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(THookRec), '_Popup_A_Wnd_DEMO_');   rHookRec := MapViewOfFile(hMapObject, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookRec)); // the popup window cann't access its handle via its property "form.handle" or an exception'll rise. end; procedure TForm1.FormDestroy(Sender: TObject); begin   try     UnMapViewOfFile(rHookRec);     CloseHandle(hMapObject);   except   end; end; end. //======================================== {***************Test.pas************ FileName:Test.pas Author: tTui or tt.t (As u like ;) Description: This unit demostrates how to use HOOK.DLL.                    File->New->Application MY MAIL: ttui@163.com ***********************************} unit Test; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls; type   TForm1 = class(TForm)     Button1: TButton;     procedure Button1Click(Sender: TObject);     procedure FormDestroy(Sender: TObject);     procedure FormCreate(Sender: TObject);     procedure FormClose(Sender: TObject; var Action: TCloseAction);   private     { Private declarations }   public     { Public declarations }   end;   function sethook:Bool;External 'Hook.DLL';   function endhook:Bool;External 'Hook.DLL'; var   Form1: TForm1;   TILC_Message:Cardinal; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin   if Button1.Caption='SetHook' then   begin     SetHook;     Button1.Caption:='EndHook';   end   else   begin     Button1.Caption:='SetHook';     EndHook;   end; end; procedure TForm1.FormDestroy(Sender: TObject); begin   EndHook; end; procedure TForm1.FormCreate(Sender: TObject); begin   TILC_Message:=RegisterWindowMessage(pchar('Poooop!!')); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var   r:DWORD; begin   r:=BSM_APPLICATIONS;   BroadcastSystemMessage(BSF_QUERY,@r,TILC_Message,0,0);  //Broadcast the exit message when quit. end; end. //=============================== Finally, we must modify the DirectDraw.pas to prevent to load the ddraw.dll when the application runs. Find the initialization part at the end of DirectDraw.pas and add "if false then" before "if not IsNTandDelphiRunning then". Ok, everythig is ready.It's time to complie and launch it!