Einzelnen Beitrag anzeigen

Benutzerbild von Desmulator
Desmulator

Registriert seit: 3. Mai 2007
Ort: Bonn
169 Beiträge
 
#1

Simples Textausgeben mit DrawText

  Alt 11. Jul 2009, 13:35
Guten Morgen,

ich habe aus Spaß an der Freude ein Programm versucht zu schreiben, das eigendlich so simpel ist, dass nicht schief gehen kann. Allerdings tut es das trotzdem.
Mein Ziel ist es in einem Thread einen String fest zu legen und schließlich an ein TOP_MOST-Window die WM_PAINT zusenden, was darin resultiert, dass der String auf dem Fenster gezeichnet werden soll. Klingt simpel, ist es auch eigendlich, allerdings hapert es bei der Umsetzung. Es wird einfach nichts gezeichnet!?

Delphi-Quellcode:
program ToniCounter;

uses
  SysUtils, DateUtils, Windows;

const
  { Fensterklassennamen und Fenstername. }
  WindowClassName = 'Toni Returns!';
  WindowName = 'Toni Returns!';

  { Fenstergröße, sollte eigendlich so ausreichen. }
  WindowWidth : LongWord = 400;
  WindowHeight : LongWord = 50;

  { Datum der Rückkehr oder what ever. }
  ReturnDate = 0; // Anpassen

var
  ScreenX, ScreenY, TaskbarHeight : LongWord;

  WindowClass : TWndClass;
  Window, TaskbarWnd : HWnd;
  Msg : TMsg;
  TaskbarRect, WindowRect : TRect;

  PaintThreadHandle : THandle; PaintThreadID : LongWord;
  TimeString : String;

function WindowProc(Window : HWnd; Msg : LongWord; Param1, Param2 : LongInt) : LongInt; stdcall;
var
  PaintInfo : TPaintStruct;
begin
  Result := 0;
  case Msg of
    WM_DESTROY : PostQuitMessage(0);
    WM_PAINT : begin
      WriteLn('Zeichne!');
      BeginPaint(Window, PaintInfo);
      SetTextColor(PaintInfo.hdc, $00000000);
      DrawText(PaintInfo.hdc, @TimeString[1], Length(TimeString), WindowRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
      EndPaint(Window, PaintInfo);
    end;
    else Result := DefWindowProc(Window, Msg, Param1, Param2);
  end;
end;

function PaintThread(Param : Pointer) : LongWord; stdcall;
begin
  repeat
    Sleep(1000);
    TimeString := 'Hallo Welt!';
    RedrawWindow(Window, nil, 0, RDW_INTERNALPAINT);
  until false;
end;

procedure Abort(Msg : PChar);
begin
  MessageBox(0, Msg, WindowName, MB_ICONERROR or MB_OK);
  ExitProcess(0);
end;

begin
  { Bildschirmgröße ermitteln, die brauchen wir um das Fenster zu positionieren. }
  ScreenX := GetSystemMetrics(SM_CXSCREEN);
  ScreenY := GetSystemMetrics(SM_CYSCREEN);

  { Hohe der Taskbar ermitteln. }
  TaskbarWnd := FindWindow('Shell_TrayWnd', nil);
  if TaskbarWnd <> 0 then begin
    GetWindowRect(TaskbarWnd, TaskbarRect);
    TaskbarHeight := TaskbarRect.Bottom - TaskbarRect.Top;
  end else Abort('Das TaskbarFenster konnte nicht ermittelt werden!');

  { Fensterklasse erstellen. }
  ZeroMemory(@WindowClass, SizeOf(WindowClass));
  WindowClass.hInstance := hInstance;
  WindowClass.lpfnWndProc := @WindowProc;
  WindowClass.lpszClassName := WindowClassName;
  WindowClass.hbrBackground := 1;
  if RegisterClass(WindowClass) = 0 then Abort('Fensterklasse konnte nicht erstellt werden!');

  { Fenster erstellen. }
  Window := CreateWindowEx(WS_EX_TOPMOST, WindowClassName, WindowName, WS_POPUP, ScreenX - WindowWidth, ScreenY - WindowHeight - TaskbarHeight, WindowWidth, WindowHeight, 0, 0, hInstance, nil);
  if Window = 0 then Abort('Das Fenster konnte nicht erstellt werden.');
  GetClientRect(Window, WindowRect);
  { Fenster anzeigen. }
  ShowWindow(Window, CmdShow);

  { Thread fürs Zeichnen starten. }
  PaintThreadHandle := CreateThread(nil, 0, @PaintThread, nil, 0, PaintThreadID);
  if PaintThreadHandle = 0 then Abort('Der ZeichnenThread konnte nicht erstellt werden.');

  { Messages abarbeiten. }
  while GetMessage(Msg, Window, 0, 0) do begin
    { Übersetzen ... }
    TranslateMessage(Msg);
    { und verteilen. }
    DispatchMessage(Msg);
  end;

  TerminateThread(PaintThreadHandle, 0);
  DestroyWindow(Window);
  UnregisterClass(WindowClassName, hInstance);
end.
Das ganze ist für FreePascal, wenn ihr es unter Delphi ausprobieren wollt, müsst ihr wahrscheinlich ein paar Units einfügen ( Messages(?) ).

Ich hoffe ihr könnnt mir verraten wo hier der Denkfehler ist bzw. vllt hab ich auch irgendwas übersehen.
Achja es wird auch kein Fehlercode zurückgegeben.

Mfg Desmu
Lars
There are 10 kinds of people in the world:
those who get binary, and those who don’t.
  Mit Zitat antworten Zitat