Writing text on desktop

Question

I want to write some text on Desktop (Currently connected DiskDrives). So I set BorderStyle to bsNone, TransparentColor to true and TransparentColorValue to clRed after that I got terrible result:

How can I fix this? I'm currently trying to fix that for 6 hours already :/ Maybe there is another way to write text on Desktop (not over all Windows)?

Answer 1

Thanks all for helping. I've just recode all with WinApi. Here is working source code:

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.