Невиданную рекламную акцию устроила 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 thenbegin
@SetLayeredWindowAttributes := GetProcAddress(hUser32,'SetLayeredWindowAttributes');
// If the import did not succeed, make sure your app can handle it! if @SetLayeredWindowAttributes <> nilthenbegin// 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;
beginif (nCode = HC_ACTION) thenbegin
CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT));
case cwps.messageof
WM_CREATE:
begin
GetClassName(cwps.hwnd, szClass, Length(szClass)-1);
// Window name for menu is #32768 if (lstrcmpi(szClass, MENU_CLASS) = 0) thenbegin
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);
beginif (hHookID <> 0) then// Removes the hook procedure
UnhookWindowsHookEx(hHookID);
end;
Привет! Я переведу текст на русский язык:
Это фрагмент кода на Delphi, который предназначен для создания прозрачных меню для Windows XP и Windows 2000. Код использует процедуру hook для перехвата событий создания окон, в частности, когда создается окно меню, и применяет прозрачность к нему.
Вот разбивка кода:
Функция MakeWndTrans принимает handle окна (Wnd) и необязательное значение альфа-канала (nAlpha) в качестве входных параметров. Она импортирует функцию SetLayeredWindowAttributes из библиотеки USER32.DLL, которая используется для установки прозрачности и цвета ключа прозрачности окна с уровнем.
Процедура hook HookCallWndProc вызывается при каждом событии создания окна. Она проверяет, является ли это событие связанным с созданием окна меню (проверяя имя класса) и применяет прозрачность с помощью функции MakeWndTrans.
В обработчике события FormCreate код получает ID потока создателя формы и устанавливает процедуру hook с помощью SetWindowsHookEx.
В обработчике события FormDestroy код отменяет установку процедуры hook с помощью UnhookWindowsHookEx.
Код хорошо структурирован и легко понятен. Однако, есть несколько областей для улучшения:
Обработка ошибок: Код предполагает, что вызов GetProcAddress всегда будет успешным, но на самом деле он может неудачно выполниться, если библиотека или функция не найдены. Лучше было бы проверять возвращаемое значение GetProcAddress и обрабатывать любые ошибки соответствующим образом.
Название переменных: Некоторые имена переменных несколько криптические (например, hHookID, tpid). Рекомендуется использовать более описательные имена для улучшения читаемости кода.
Организация кода: Процедура hook определена внутри секции реализации формы, что может сделать ее труднее для повторного использования или понимания другими разработчиками. Рекомендуется переместить процедуру hook в свой собственный модуль или файл.
В целом, этот код предоставляет хороший старт для создания прозрачных меню на Delphi. С некоторыми минимальными улучшениями он может стать еще более robust и поддерживаемым.
Прозрачные меню для XP и Win2K можно создать с помощью использования функции SetLayeredWindowAttributes из библиотеки USER32.DLL.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.