•  全屏DirectX程序下弹出摸态窗口代码【转载】

    分类：网络文章      迅驰小区物业管理系统V2008.05.2+注册机    DLPHI热键激活 代码简抄 

    将本文章摘录到：

    版权声明：转载时请以超链接形式标明文章原始出处和作者信息
    http://blog.bloodbird.com/tianwufengBlogs/Netarticle/200904/20090417222133.Html

    本文作者：tt.t,

    本文转载自：http://www.delphibbs.com/delphibbs/dispq.asp?lid=2135796

    一直有人问如何在DirectX全屏游戏中弹出窗口就象金山游侠一样.我答应过要给出原码,只是一直没有时间整理,不过现在总算是弄玩了.代码不长,大致作了些注释,但愿你能看懂:)
    按照我的说明一步步作应该就能成功,但有时可能不行,为什么?我也不知道,或许是你哪一步做错了,或者是Delphi的问题?天知道,但大多数时候按照我给出的步骤,这些代码应该能实现我们的目标.
    下面的代码经过了一定的测试,但并没有刻意设计保证程序兼容性和稳定性的代码,所以不能保证在所有的机器上正常运行.如果死机或者花屏了,那么很不幸它不适合你,在找些别人写的类似的代码吧(不过以前有人公开过类似的代码吗?如果有请mail给我:)
    试一试吧,希望我们能把它完善起来.

    delphi 代码
     
    1. {***************HOOK.DLL************ 
    2.  
    3. FileName:Hook.dpr(The KEY unit to pop up a window in DX apps) 
    4.  
    5. Author: tTui or tt.t (As u like ;) 
    6.  
    7. Feature:This unit contain the Demo codes for pop up an MODAL window in Apps which use exclusive directX fullscreen mode. 
    8.  
    9. Description: 1.Uses KeyBoard hook to hook the hotkey. 
    10.              2.Uses s0me tricks to get the *real* IDirectDraw pointer. 
    11.              3.Call the *IDirectDraw.FilptoGDISurface* to make sure the poped up window could be seen.(See MSDN for the reason) 
    12.              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) 
    13.              5.The HotKey is Left WIN + NumPad * 
    14.              6.Mute codes needed, but havn't wrote yet. 
    15.              7.Complied with Delphi 6. Tested under Win98&SE, Win ME, Win 2K,Win XP and Win 2003.NET with DirectX 8&9. 
    16.  
    17. Known Bugs:  1.Cannot repaint the background when the poped up window moved. 
    18.              2.May crash when try to pop up from some games and apps. 
    19.              3.Cannot show the cursor in some games. 
    20.              4.May minimize the main App, when try to pop up the window. 
    21.              5.Many more...but unknown yet... 
    22.  
    23. MY MAIL: ttui@163.com 
    24.  
    25. BTW, if u want to pop up an MODALLESS window, u should write the codes all by urself. 
    26. *DO NOT* ask me for that. 
    27. ***********************************} 
    28. library Hook; 
    29.  
    30. uses 
    31.   SysUtils, 
    32.   Classes, 
    33.   Windows, 
    34.   Messages, 
    35.   Dialogs, 
    36.   DirectDraw,  //*Modified* Jedi's DirectX header file for Delphi. 
    37.   FormUnit in 'FormUnit.pas' {Form1};  //The unit contains the popup window. 
    38.  
    39. {$R *.res} 
    40.  
    41. type 
    42.   PHookRec = ^THookRec; 
    43.   THookRec = record 
    44.     ParentWnd:HWND;  //The main app's handle 
    45.     FormWnd:HWND;    //Handle of the popup window 
    46.     Poped:Boolean;   //A flag. eq True if the window poped 
    47.     HH1:HHOOK;       //Hook handle of the keyboard hook  
    48.     HH2:HHOOK;       //Hook handle of the GetMessage hook 
    49.   end; 
    50.  
    51. var 
    52.   rHookRec: PHookRec = nil; 
    53.   hMapObject: THandle = 0; 
    54.  
    55. var 
    56.   pDirectDrawCreate:function (lpGUID: PGUID;out lplpDD: IDirectDraw;pUnkOuter: IUnknown) : HResult; stdcall; 
    57.  
    58. function WHGETMESSAGE(iCode:Integer;wParam: WPARAM;lParam: LPARAM):LRESULT; stdcall; 
    59. begin 
    60.   result:=0; 
    61.   if iCode<0 then 
    62.   begin 
    63.     CallNextHookEx(rHookRec^.HH2,iCode,wParam,lParam); 
    64.     result:=0; 
    65.     Exit; 
    66.   end; 
    67.   case PMSG(lParam)^.message of 
    68.     WM_TIMER,       //$113 
    69.     WM_WINDOWPOSCHANGING,  //$47 
    70.     WM_SETCURSOR,     //$20 
    71.     WM_ACTIVATEAPP,    //$1c 
    72.     WM_SETFOCUS:      //$7 
    73.       begin           //Some other messages should be processed here. 
    74.         PMSG(lParam)^.message:=0; 
    75.       end; 
    76.   end; 
    77. end; 
    78.  
    79. function HookProc(iCode:Integer;wParam: WPARAM;lParam: LPARAM):LRESULT; stdcall; 
    80. var 
    81.   dh:dword; 
    82.   FD:IDirectDraw; 
    83.   pp:pointer; 
    84.   a:dword; 
    85.   sc:integer; 
    86. begin 
    87.   result:=0; 
    88.   if iCode<0 then 
    89.   begin 
    90.     CallNextHookEx(rHookRec^.HH1,iCode,wParam,lParam); 
    91.     result:=0; 
    92.     Exit; 
    93.   end; 
    94.   if ((lParam and $80000000)=0) and 
    95.      (GetKeyState(VK_LWIN)<0) and (wParam=$6a) then  //The HotKey is Left WIN + NumPad * 
    96.   begin 
    97.     rHookRec^.ParentWnd:=getforegroundwindow; 
    98.     if not isWindow(rHookRec^.ParentWnd) then exit; 
    99.     try 
    100.       if not rHookRec^.Poped then 
    101.       begin 
    102.         dh:=GetModuleHandle('ddraw.dll');  //is a dx app?? 
    103.         if dh<>0 then 
    104.         begin 
    105.           dh:=dword(GetProcAddress(dh,'DirectDrawCreate')); 
    106.           if dh<>0 then 
    107.           begin 
    108.             pDirectDrawCreate:=Pointer(dh); 
    109.             if pDirectDrawCreate(nil,FD,nil)=0 then 
    110.             begin 
    111.               pp:=@fd; 
    112.               a:=dword(pointer(dword(pp^)+8)^);  //Now a is the pointer to the *REAL* IDirectDraw 
    113.               asm     //Call FliptoGDISurface 
    114.                 mov eax,a 
    115.                 push eax 
    116.                 mov eax,[eax] 
    117.                 call [eax+$28] 
    118.               end; 
    119.               FD:=nil; 
    120.             end; 
    121.           end; 
    122.         end; 
    123.         rHookRec^.HH2:=setwindowshookex(WH_GETMESSAGE,@WHGETMESSAGE,0,GetCurrentThreadID); 
    124.         sc:=ShowCursor(true);  //Show cursor 
    125.         form1:=tform1.CreateParented(rHookRec^.ParentWnd); //Create the window that'll pop up 
    126.         rHookRec^.Poped:=true;  //set flag 
    127.         rHookRec^.FormWnd:=form1.Handle; 
    128.         form1.ShowModal;  //Bingo!! The window pops up!! 
    129.         form1.Free; 
    130.         rHookRec^.Poped:=false;  //set flag 
    131.         UnhookWindowshookEx(rHookRec^.HH2); 
    132.         if sc>=0 then 
    133.           ShowCursor(true) 
    134.         else 
    135.           ShowCursor(false); 
    136.       end; 
    137.     finally 
    138.  
    139.     end; 
    140.     result:=1; 
    141.   end; 
    142. end; 
    143.  
    144. function sethook:bool;export;  //Call the func to set the keyboard hook 
    145. begin 
    146.   result:=false; 
    147.   if rHookRec^.HH1<>0 then exit;                 
    148.   rHookRec^.Poped:=False; 
    149.   rHookRec^.HH1 := SetWindowsHookEx(WH_KEYBOARD,hookproc,HInstance,0); 
    150.   Result := rHookRec^.HH1 <> 0; 
    151. end; 
    152.  
    153. function endhook:bool;export;  //Call the func to unhook the keyboard hook 
    154. begin 
    155.   if rHookRec^.HH1 <> 0 then 
    156.   begin 
    157.     UnhookWindowshookEx(rHookRec^.HH1); 
    158.     rHookRec^.HH1 := 0; 
    159.   end; 
    160.   Result := rHookRec^.HH1 = 0; 
    161. end; 
    162.  
    163. procedure EntryPointProc(Reason: Integer);  //Create and Close the file mapping to share data in different processes. 
    164. begin 
    165.   case reason of 
    166.     DLL_PROCESS_ATTACH: 
    167.     begin 
    168.       hMapObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(THookRec), '_Popup_A_Wnd_DEMO_'); 
    169.       rHookRec := MapViewOfFile(hMapObject, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookRec)); 
    170.     end; 
    171.     DLL_PROCESS_DETACH: 
    172.     begin 
    173.       try 
    174.         UnMapViewOfFile(rHookRec); 
    175.         CloseHandle(hMapObject); 
    176.       except 
    177.       end; 
    178.     end; 
    179.   end; 
    180. end; 
    181.  
    182. Exports 
    183.   SetHook, 
    184.   EndHook; 
    185.  
    186. begin 
    187.   DllProc := @EntryPointProc; 
    188.   EntryPointProc(DLL_PROCESS_ATTACH); 
    189. end. 
    190. //================================================== 
    191. {*************FormUnit.pas********** 
    192.  
    193. FileName:FormUnit.pas 
    194.  
    195. Author: tTui or tt.t (As u like ;) 
    196.  
    197. Description: This unit contains the codes of the popup window. 
    198.  
    199. MY MAIL: ttui@163.com 
    200.  
    201. TIPS:The form's BoaderStyle property must be "bsDialog" or the popup window may not be seen. 
    202.  
    203. ***********************************} 
    204. unit FormUnit; 
    205.  
    206. interface 
    207.  
    208. uses 
    209.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    210.   Dialogs; 
    211.  
    212. type 
    213.   TForm1 = class(TForm) 
    214.     procedure FormCreate(Sender: TObject); 
    215.     procedure FormDestroy(Sender: TObject); //u can add other VCL components. 
    216.   private 
    217.     { Private declarations } 
    218.     procedure WndProc(var Message: TMessage); override; 
    219.   public 
    220.     { Public declarations } 
    221.   end; 
    222.  
    223. type 
    224.   PHookRec = ^THookRec; 
    225.   THookRec = record 
    226.     ParentWnd:HWND; 
    227.     FormWnd:HWND; 
    228.     Poped:Boolean; 
    229.     HH1:HHOOK; 
    230.     HH2:HHOOK; 
    231.   end; 
    232.  
    233. var 
    234.   Form1: TForm1; 
    235.   TILC_Message:Cardinal;  //Exit message 
    236.   rHookRec: PHookRec = nil; 
    237.   hMapObject: THandle = 0; 
    238.  
    239. implementation 
    240.  
    241. {$R *.dfm} 
    242.  
    243. procedure TForm1.WndProc(var Message: TMessage); 
    244. begin 
    245.   inherited WndProc(Message); 
    246.   if Message.Msg=TILC_Message then   
    247.     Close; 
    248. end; 
    249.  
    250. procedure TForm1.FormCreate(Sender: TObject); 
    251. begin 
    252.   TILC_Message:=RegisterWindowMessage(pchar('Poooop!!')); 
    253.   hMapObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(THookRec), '_Popup_A_Wnd_DEMO_'); 
    254.   rHookRec := MapViewOfFile(hMapObject, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookRec)); 
    255. // the popup window cann't access its handle via its property "form.handle" or an exception'll rise. 
    256. end; 
    257.  
    258. procedure TForm1.FormDestroy(Sender: TObject); 
    259. begin 
    260.   try 
    261.     UnMapViewOfFile(rHookRec); 
    262.     CloseHandle(hMapObject); 
    263.   except 
    264.   end; 
    265. end; 
    266.  
    267. end. 
    268. //======================================== 
    269. {***************Test.pas************ 
    270.  
    271. FileName:Test.pas 
    272.  
    273. Author: tTui or tt.t (As u like ;) 
    274.  
    275. Description: This unit demostrates how to use HOOK.DLL. 
    276.                    File->New->Application 
    277.  
    278. MY MAIL: ttui@163.com 
    279.  
    280. ***********************************} 
    281. unit Test; 
    282.  
    283. interface 
    284.  
    285. uses 
    286.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    287.   Dialogs, StdCtrls; 
    288.  
    289. type 
    290.   TForm1 = class(TForm) 
    291.     Button1: TButton; 
    292.     procedure Button1Click(Sender: TObject); 
    293.     procedure FormDestroy(Sender: TObject); 
    294.     procedure FormCreate(Sender: TObject); 
    295.     procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    296.   private 
    297.     { Private declarations } 
    298.   public 
    299.     { Public declarations } 
    300.   end; 
    301.  
    302.   function sethook:Bool;External 'Hook.DLL'; 
    303.   function endhook:Bool;External 'Hook.DLL'; 
    304.  
    305. var 
    306.   Form1: TForm1; 
    307.   TILC_Message:Cardinal; 
    308.  
    309. implementation 
    310.  
    311. {$R *.dfm} 
    312.  
    313. procedure TForm1.Button1Click(Sender: TObject); 
    314. begin 
    315.   if Button1.Caption='SetHook' then 
    316.   begin 
    317.     SetHook; 
    318.     Button1.Caption:='EndHook'; 
    319.   end 
    320.   else 
    321.   begin 
    322.     Button1.Caption:='SetHook'; 
    323.     EndHook; 
    324.   end; 
    325. end; 
    326.  
    327. procedure TForm1.FormDestroy(Sender: TObject); 
    328. begin 
    329.   EndHook; 
    330. end; 
    331.  
    332. procedure TForm1.FormCreate(Sender: TObject); 
    333. begin 
    334.   TILC_Message:=RegisterWindowMessage(pchar('Poooop!!')); 
    335. end; 
    336.  
    337. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
    338. var 
    339.   r:DWORD; 
    340. begin 
    341.   r:=BSM_APPLICATIONS; 
    342.   BroadcastSystemMessage(BSF_QUERY,@r,TILC_Message,0,0);  //Broadcast the exit message when quit. 
    343. end; 
    344.  
    345. end. 
    346. //=============================== 
    347. Finally, we must modify the DirectDraw.pas to prevent to load the ddraw.dll when the application runs. 
    348. Find the initialization part at the end of DirectDraw.pas and add  
    349. "if false then" before "if not IsNTandDelphiRunning then". 
    350.  
    351. Ok, everythig is ready.It's time to complie and launch it! 

    本文所需要的DirectX控件代码 点此下载  找到所需的头文件

    包含附件:

     

    点击下载文件

     

    Tag：DirectX
    引用地址：
    天舞枫 发表于2009-04-17 22:21:33 | 分类:网络文章 | 浏览( ) | 评论( ) | 收藏这篇日志

    评论

    正在读取日志的评论数据,请稍后……
    正在加载日志评论签写框，请稍后……