Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Прозрачные меню для 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;

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.