![]() |
Simples Textausgeben mit DrawText
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:
Das ganze ist für FreePascal, wenn ihr es unter Delphi ausprobieren wollt, müsst ihr wahrscheinlich ein paar Units einfügen ( Messages(?) ).
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. 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 |
Re: Simples Textausgeben mit DrawText
Mach du mal so:
Delphi-Quellcode:
und schon (sollte) funktioniert es. ;)
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); TimeString := 'Hallo Welt!'; // <--<< DrawText(PaintInfo.hdc, PCHAR(TimeString), Length(TimeString), WindowRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER); EndPaint(Window, PaintInfo); end; else Result := DefWindowProc(Window, Msg, Param1, Param2); end; end; Warum ? Wei irgend etwas mit dem String schief läuft wenn er im Thread geändert wird. Der Thread müsste ggf. noch Syncronisiert werden und die Variable TimeString als Parameter übergeben werden. Das ist jetzt eine Vermutung, habe es noch nicht ausprobiert. Das wirst ja du machen. ;) Achso, diese Schreibweise:[i]@TimeString[1][i] sollte man vermeiden. Es kann bei manchen Compei. zu Fehlern bei der Bereichsüberprüfung führen zB. wenn der String leer ist. |
Re: Simples Textausgeben mit DrawText
ja es geht -.- natoll, hätte ich mir zwei stunden fluchen sparen können xD
Okay gut dann muss ich mir irgendwie etwas anderes überlegen :-P aber mal noch ne kleine andere Frage: Wieso wird immer über dem Fenster die Sanduhr angezeigt und nicht der normale Arrow? Das verwirrt mich auch zumal ja die Messages alle behandelt werden? Edit: @TimeString[1] benutz ich auch nur, weil PChar in FreePascal nich geht... leider.. Edit2: Soll ich nen neuen Thread aufmachen? xD ein TaskbarEintrag vorhanden, schon tausend mal gefragt, aber helfen tuts mir nicht, wie verhindere ich den Eintrag? |
Re: Simples Textausgeben mit DrawText
Zitat:
Zitat:
Oder einen Timer verwenden. Zitat:
Will heissen:
Delphi-Quellcode:
also kann Windows bzw. Linux keinen Cursor laden.
WindowClassEx.hCursor = 0
So solle es sein:
Delphi-Quellcode:
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
Zitat:
// Edit: auserdem hast du eine normale WindowClass und erzeugst das Fenster mit CreateWindowEx... ? Das passt nicht, da musst du schon die TWndClassEx verwenden. |
Re: Simples Textausgeben mit DrawText
Zitat:
Zitat:
Zitat:
|
Re: Simples Textausgeben mit DrawText
Zitat:
Es lag an dem
Delphi-Quellcode:
RedrawWindow(Window, nil, 0..
Ich habe es jetzt doch mal in Delphi ausprobiert und ein wenig verschlimmbessert ;)
Delphi-Quellcode:
Nun sollte es so sein wie du es ger hättest.
program ToniCounter;
uses SysUtils, DateUtils, Windows, Messages; 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; WindowClassEx : TWndClassEx; Window, TaskbarWnd : HWnd; Msg : TMsg; TaskbarRect, WindowRect : TRect; PaintThreadHandle : THandle; PaintThreadID : LongWord; szTime : PChar; function PaintThread(Param : Pointer) : LongWord; stdcall; begin while true do begin StrPCopy(szTime, 'Hallo Welt! ' + TimeToStr(now)); //RedrawWindow(Window, nil, 0, RDW_INVALIDATE or RDW_ERASE); // so klappts nun auch InvalidateRect(Window, nil, True); Sleep(1000); end; ExitThread(0); end; procedure Abort(Msg : PChar); begin MessageBox(0, Msg, WindowName, MB_ICONERROR or MB_OK); ExitProcess(0); end; function WindowProc(Window : HWnd; Msg: LongWord; wParam, lParam: LongInt) : LongInt; stdcall; var PaintInfo : TPaintStruct; begin Result := 0; case Msg of WM_CREATE: begin GetMem(szTime, 1024); { Thread fürs Zeichnen starten. } PaintThreadHandle := CreateThread(nil, 0, @PaintThread, nil, 0, PaintThreadID); //<--<< if PaintThreadHandle = 0 then Abort('Der ZeichnenThread konnte nicht erstellt werden.'); end; WM_DESTROY: begin if PaintThreadHandle <> 0 then TerminateThread(PaintThreadHandle, 0); FreeMem(szTime); PostQuitMessage(0); end; WM_CLOSE: begin DestroyWindow(Window); end; WM_PAINT: begin BeginPaint(Window, PaintInfo); SetTextColor(PaintInfo.hdc, $00000000); SetBKMode(PaintInfo.hdc, TRANSPARENT); SetTextColor(PaintInfo.hdc, RGB(255, 255, 255)); //DrawText(PaintInfo.hdc, @TimeString[1], Length(TimeString), WindowRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER); DrawText(PaintInfo.hdc, szTime, Length(szTime), WindowRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER); EndPaint(Window, PaintInfo); end; else Result := DefWindowProc(Window, Msg, wParam, lParam); end; 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); TaskbarHeight := 0; 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(@WindowClassEx, SizeOf(TWndClassEx)); With WindowClassEx do begin cbSize := SizeOf(TWndClassEx); Style := CS_HREDRAW or CS_VREDRAW; lpfnWndProc := @WindowProc; cbClsExtra := 0; cbWndExtra := 0; lpszMenuName := nil; lpszClassName := WindowClassName; hIconSm := 0; hInstance := hInstance; hIcon := LoadIcon(0, IDI_APPLICATION); hCursor := LoadCursor(0, IDC_ARROW); hbrBackground := GetStockObject(GRAY_BRUSH); end; if RegisterClassEx(WindowClassEx) = 0 then Abort('Fensterklasse konnte nicht erstellt werden!'); { Fenster erstellen. } Window := CreateWindowEx( WS_EX_TOPMOST or WS_EX_TOOLWINDOW, // <--<< WindowClassName, WindowName, WS_POPUP or WS_SYSMENU, 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); UpdateWindow(Window); { Messages abarbeiten. } while GetMessage(Msg, 0, 0, 0) do begin { Übersetzen ... } TranslateMessage(Msg); { und verteilen. } DispatchMessage(Msg); end; UnregisterClass(WindowClassName, hInstance); end. |
Re: Simples Textausgeben mit DrawText
Cool, danke man.
Ohne dich säß ich wohl immernoch wie dein Depp vor den paar Zeilen Code xD |
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:50 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz