Registriert seit: 3. Mai 2007
Ort: Bonn
169 Beiträge
|
Simples Textausgeben mit DrawText
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.
|