Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС
выпущен 4 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Прозрачные меню для XP, Win2000

Невиданную рекламную акцию устроила Microsoft в России по продвижению своего продукта Windows XP. 5 мая логотип XP был везде! Даже на празничных яйцах и куличах. По неофицальным данным несмотря на то, что юзеры просто молились на XP, продажа так и не возросла.


 var
   hHookID: HHOOK;
 
 // function to make the menu transparent 
 function MakeWndTrans(Wnd: HWND; nAlpha: Integer = 10): Boolean;
 type
   TSetLayeredWindowAttributes = function(hwnd: HWND; crKey: COLORREF; bAlpha: Byte;
     dwFlags: Longint): Longint; stdcall;
 const
   // Use crKey as the transparency color. 
   LWA_COLORKEY = 1;
   // Use bAlpha to determine the opacity of the layered window.. 
   LWA_ALPHA = 2;
   WS_EX_LAYERED = $80000;
 var
   hUser32: HMODULE;
   SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
   i : Integer;
 begin
   Result := False;
   // Here we import the function from USER32.DLL 
   hUser32 := GetModuleHandle('USER32.DLL');
   if hUser32 <> 0 then
   begin
     @SetLayeredWindowAttributes := GetProcAddress(hUser32,'SetLayeredWindowAttributes');
     // If the import did not succeed, make sure your app can handle it! 
     if @SetLayeredWindowAttributes <> nil then
     begin
       // Check the current state of the dialog, and then add the WS_EX_LAYERED attribute 
       SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE) or WS_EX_LAYERED);
       // The SetLayeredWindowAttributes function sets the opacity and 
       // transparency color key of a layered window 
       SetLayeredWindowAttributes(Wnd, 0, Trunc((255 / 100) * (100 - nAlpha)), LWA_ALPHA);
       Result := True;
     end;
   end;
 end;
 
 // hook procedure 
 function HookCallWndProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
 const
  MENU_CLASS = '#32768';
  N_ALPHA = 60;
 var
   cwps: TCWPStruct;
   lRet: THandle;
   szClass: array[0..8] of char;
 begin
   if (nCode = HC_ACTION) then
   begin
     CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT));
     case cwps.message of
       WM_CREATE:
         begin
           GetClassName(cwps.hwnd, szClass, Length(szClass)-1);
           // Window name for menu is #32768 
           if (lstrcmpi(szClass, MENU_CLASS) = 0) then
           begin
             MakeWndTrans(cwps.hwnd, N_ALPHA {Alphablending});
           end;
         end;
     end;
   end;
   // Call the next hook in the chain 
   Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, lParam);
 end;
 
 // Install the hook in the OnCreate Handler 
 procedure TForm1.FormCreate(Sender: TObject);
 var
   tpid: DWORD;
 begin
   // Retrieve the identifier of the thread that created the specified window 
   tpid := GetWindowThreadProcessId(Handle, nil);
   // The SetWindowsHookEx function installs an application-defined 
   // hook procedure into a hook chain 
   hHookID := SetWindowsHookEx(WH_CALLWNDPROC, HookCallWndProc, 0, tpid);
 end;
 
 // Stop the hook in the OnDestroy Handler 
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   if (hHookID <> 0) then
     // Removes the hook procedure 
     UnhookWindowsHookEx(hHookID);
 end;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS