我想在桌面上写一些文字(目前连接的DiskDrives)。因此,我将BorderStyle
设置为bsNone
,将TransparentColor
设置为true
,将TransparentColorValue
设置为clRed
,之后我得到了可怕的结果:
我该如何解决这个问题?我目前正在努力解决这个问题已经持续了6个小时:/ 也许还有另一种方法可以在桌面上编写文本(而不是在所有Windows上)?
答案 0 :(得分:7)
感谢大家的帮助。我只是使用WinApi重新编码。这是工作源代码:
program test;
uses
Winapi.Windows,
Winapi.Messages;
var
s_width: DWORD;
s_height: DWORD;
hWind: HWND;
g_bModalState: boolean = false;
hStatic: THandle;
bkGrnd: NativeUInt;
function Proced(hWin, iMsg, wP, lP: integer): integer; stdcall;
var
hdcStatic: hdc;
begin
case iMsg of
WM_WINDOWPOSCHANGING:
begin
with PWindowPos(lP)^ do
hwndInsertAfter := HWND_BOTTOM
end;
WM_DESTROY:
begin
PostQuitMessage(0);
Result := 0;
end;
WM_CTLCOLORSTATIC:
begin
hdcStatic := wP;
SetBkMode(hdcStatic, TRANSPARENT);
SetTextColor(hdcStatic, RGB(0, 0, 0));
Result := bkGrnd;
end;
else
Result := DefWindowProc(hWin, iMsg, wP, lP);
end;
end;
procedure WinMain();
var
WinClass: TWndClassEx;
rc: TRect;
uMsg: Tmsg;
hTarget: HWND;
ClassName: PWideChar;
textStr: string;
begin
hTarget := GetDesktopWindow;
if hTarget < 1 then
ExitProcess(0);
GetWindowRect(hTarget, rc);
s_width := rc.right - rc.left;
s_height := (rc.bottom - rc.top) div 2;
ClassName := '#32770';
bkGrnd := CreateSolidBrush(RGB(255,0,0));
ZeroMemory(@WinClass, sizeof(WinClass));
with WinClass do
begin
cbSize := SizeOf(WinClass);
lpszClassName := ClassName;
lpfnWndProc := @Proced;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := hInstance;
lpszMenuName := nil;
style := CS_HREDRAW or CS_VREDRAW;
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := bkGrnd;
end;
textStr := 'Testing desktop output';
RegisterClassEx(WinClass);
hWind := CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_LAYERED or WS_EX_TRANSPARENT, ClassName, 'testOverlayDELPHI', WS_POPUP or WS_VISIBLE, rc.Left, s_height, s_width, s_height, 0, 0, hInstance, nil);
SetLayeredWindowAttributes(hWind, RGB(255, 0, 0), 0, ULW_COLORKEY);
ShowWindow(hWind, SW_SHOW);
hStatic := CreateWindow('Static', PChar(textStr), WS_VISIBLE or WS_CHILD or SS_RIGHT, s_width - length(textStr) * 9 - 4, s_height - 60, length(textStr) * 9, 20, hWind, 0, hInstance, nil);
while GetMessage(uMsg, 0, 0, 0) do
begin
TranslateMessage(uMsg);
DispatchMessage(uMsg);
end;
end;
begin
WinMain;
end.