Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Simples Textausgeben mit DrawText (https://www.delphipraxis.net/136968-simples-textausgeben-mit-drawtext.html)

Desmulator 11. Jul 2009 12:35


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:
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

turboPASCAL 11. Jul 2009 14:07

Re: Simples Textausgeben mit DrawText
 
Mach du mal so:

Delphi-Quellcode:
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;
und schon (sollte) funktioniert es. ;)

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.

Desmulator 11. Jul 2009 14:15

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?

turboPASCAL 11. Jul 2009 14:40

Re: Simples Textausgeben mit DrawText
 
Zitat:

Zitat von Desmulator
ja es geht -.- natoll, hätte ich mir zwei stunden fluchen sparen können xD

Aus solchen Fehlern lernt man. Da bin ich auch (stundenlang) durch.

Zitat:

Okay gut dann muss ich mir irgendwie etwas anderes überlegen :-P
Warum ? Den String in einen PChar wandeln und als Pointer dem Thread übergeben.

Oder einen Timer verwenden.


Zitat:

aber mal noch ne kleine andere Frage: Wieso wird immer über dem Fenster die Sanduhr angezeigt
Ist klar warum, du "Nullst" die Fensterklasse weist dem Cursor aber nicht zu.
Will heissen:
Delphi-Quellcode:
WindowClassEx.hCursor = 0
also kann Windows bzw. Linux keinen Cursor laden.
So solle es sein:
Delphi-Quellcode:
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);

Zitat:

ein TaskbarEintrag vorhanden, schon tausend mal gefragt, aber helfen tuts mir nicht, wie verhindere ich den Eintrag?
Warum hilfts nix ?


// Edit:
auserdem hast du eine normale WindowClass und erzeugst das Fenster mit CreateWindowEx... ?
Das passt nicht, da musst du schon die TWndClassEx verwenden.

Desmulator 11. Jul 2009 14:53

Re: Simples Textausgeben mit DrawText
 
Zitat:

Zitat von turboPASCAL
Zitat:

Okay gut dann muss ich mir irgendwie etwas anderes überlegen :-P
Warum ? Den String in einen PChar wandeln und als Pointer dem Thread übergeben.

Oder einen Timer verwenden.

Habe ich probiert, allerdings bleibt der String leer. Lösung habe ich gefunden, ich rufe einfach während des Zeichnens die Methode zur Stringerstellung auf, der Thread sagt jetzt praktisch nurnoch neuzeichnen. ( Er ermittelt auch die Daten für den String )

Zitat:

Zitat von turboPASCAL
Zitat:

aber mal noch ne kleine andere Frage: Wieso wird immer über dem Fenster die Sanduhr angezeigt
Ist klar warum, du "Nullst" die Fensterklasse weist dem Cursor aber nicht zu.
Will heissen:
Delphi-Quellcode:
WindowClassEx.hCursor = 0
also kann Windows bzw. Linux keinen Cursor laden.
So solle es sein:
Delphi-Quellcode:
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);

Geht -.- hätte ich auch selbst drauf kommen können, heute ist echt mal nicht mein Tag :pale:


Zitat:

Zitat von turboPASCAL
Zitat:

ein TaskbarEintrag vorhanden, schon tausend mal gefragt, aber helfen tuts mir nicht, wie verhindere ich den Eintrag?
Warum hilfts nix ?

Alles baut auf die VCL auf. Da ich ja non-VCL arbeite kanni ch die Ansätze alle nicht gebrauchen.

turboPASCAL 11. Jul 2009 15:48

Re: Simples Textausgeben mit DrawText
 
Zitat:

Zitat von turboPASCAL
Weil 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.

Ne, also das war es nicht.
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:
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.
Nun sollte es so sein wie du es ger hättest.

Desmulator 11. Jul 2009 16:24

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 12:33 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz