close
دانلود فیلم
ایجاد منو با شفافیت کم در دلفی

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;

لینک کوتاه پست
مطالب مرتبط با پست جاری
  • نکات مهم
    1- لطفا نظر خود را با زبان فارسی بیان کنید
    2- رایتم نظرات اسپم و تبلیغی شما را تایید نمی کند
    3- لطفا نظرات شما بدون ابهام و واضح باشد
  • نام
    ایمیل (منتشر نمی‌شود) (لازم)
    وبسایت
    :):(;):D;)):X:?:P:*=((:O@};-:B/:):S
    نظر خصوصی
    مشخصات شما ذخیره شود ؟[حذف مشخصات] [شکلک ها]
    کد امنیتی
به کانال تلگرام سایت ما بپیوندید