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:

enter image description here

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)?

Do you want this to appear only on the desktop its self or layered over windows too? Also try playing with the fonts and colors. — Jerry Dodge, Jun 03 '14 at 23:28
Perhaps this might help: http://stackoverflow.com/questions/8349814/dynamic-text-printed-on-the-desktop-using-delphi — Jerry Dodge, Jun 03 '14 at 23:30
Then will you want to be able to change that information on-the-fly or would it be always the same text? — Jerry Dodge, Jun 03 '14 at 23:32
As well as http://stackoverflow.com/questions/8212796/how-to-draw-text-on-desktop - both of those links were the first 2 results searching for `delphi text on desktop` — Jerry Dodge, Jun 03 '14 at 23:35
@JerryDodge I did this:`WM_WINDOWPOSCHANGING: with PWindowPos(msg.LParam)^ do hwndInsertAfter := HWND_BOTTOM` and my window is always on the desktop. But It doesn't solve problem with red pixels (form's background color). — Alex Hide, Jun 03 '14 at 23:37
@JerryDodge I've already seen these links earlier and it didn't help at all :( I want to edit text but not too often. Just when disk connected or disconnected. — Alex Hide, Jun 03 '14 at 23:40
Is the problem there's no anti aliasing? The solution is to use UpdateLayeredWindow with a bitmap having proper alpha transparency. — Sertac Akyuz, Jun 03 '14 at 23:55
If might help to see what the original Form looks like without transparency applied to it. What does it look like when `TransparentColor` is set to false? — Remy Lebeau, Jun 03 '14 at 23:55
@RemyLebeau That: [link](http://puu.sh/9e0QP/eebb81f99b.png) — Alex Hide, Jun 04 '14 at 00:30
As suspected, you have an issue with anti-aliasing. The remnant coloring you are seeing are sections where the original black text was blended with the original red background to produce shades of greyish-red that are not pure red, that is why those areas are not being drawn transparently by the OS. You will have to turn off anti-aliasing on your UI controls, or use a `Font` that does not support anti-aliasing. Or use a different background `Color` that is closer to your wallpaper color so you don't notice the anti-aliasing as much. — Remy Lebeau, Jun 04 '14 at 00:40
Or, switch to `UpdateLayeredWindow()` (`TransparentColor` and `AlphaBlend` use `SetLayeredWindowAttributes()` instead) and do your own manual alpha blending, like Sertac suggested. — Remy Lebeau, Jun 04 '14 at 00:42
@RemyLebeau Thank you very much. Forgot about anti-aliasing. Sets quality to nonAntialised also solve my problem. — Alex Hide, Jun 04 '14 at 01:44

score 7 · Accepted Answer · answered Jun 04 '14 at 00:22

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.

+1 for a good effort to resolve this yourself. Although I haven't checked your code, I can assume it does exactly what you intended. — Jerry Dodge, Jun 04 '14 at 01:42

Writing text on desktop

1 Answers1