在桌面上写文字

时间:2014-06-03 23:26:53

标签: delphi transparent-control

我想在桌面上写一些文字(目前连接的DiskDrives)。因此,我将BorderStyle设置为bsNone,将TransparentColor设置为true,将TransparentColorValue设置为clRed,之后我得到了可怕的结果:

enter image description here

我该如何解决这个问题?我目前正在努力解决这个问题已经持续了6个小时:/ 也许还有另一种方法可以在桌面上编写文本(而不是在所有Windows上)?

1 个答案:

答案 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.