Canvas Text löschen

[steppo]

Hi Olli,

ich weis nicht was du gegen meine onTimer methode hast, aber die ist selber erstellt.
o.k, aber das ist nebensache.

Kann mir nun jemand bei meinem Problem helfen oder nicht?

P.s. Falls es eurer Meinung nach zu Problemen mit diesem "Artefakt" kommt, so bitte ich um Verbesserungsvorschläge.

MFG
steppo

[himitsu]

Hab es so versucht, aber aus irrgend einem Grund hat "Pen.Mode" auf TextOut keine Auswirkung.
In dem weiter oben von mir verlinkten Beispiel ist ja zu erkennen, das sich zweimal pmNotXor gegenseitig aufhebt.

Delphi-Quellcode:

Unit Unit1;

Interface
  Uses Windows, Messages, SysUtils, Variants, Classes,
    Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;

  Type TForm1 = Class(TForm)
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    Procedure FormCreate(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure Timer1Timer(Sender: TObject);
  End;

  Var Form1: TForm1;
    Nachricht: String;
    Canv: TCanvas;

Implementation
  {$R *.dfm}

  Procedure TForm1.FormCreate(Sender: TObject);
    Begin
      Canv := TCanvas.Create;
      Canv.Handle := GetWindowDC(0);
      OpenDialog1.Execute;
      Nachricht := ExtractFileName(OpenDialog1.FileName);
      With Canv do Begin
        Font.Name := 'Arial';
        Font.Size := 24;
        Font.Color := clRed;
        Brush.Style := bsClear;
        Pen.Mode := pmNotXor;
      End;
      Timer1.Enabled := True;
    End;

  Procedure TForm1.FormDestroy(Sender: TObject);
    Begin
      Timer1.Enabled := False;
      If Timer1.Tag <> 0 Then Begin
        (* Text löschen *)
        Canv.TextOut(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2,
          Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht);
        Timer1.Tag := 0;
      End;
      Canv.Free;
    End;

  Procedure TForm1.Timer1Timer(Sender: TObject);
    Begin
      (* Text zeichnen und/oder löschen *)
      Canv.TextOut(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2,
        Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht);
      If Timer1.Tag = 0 Then Timer1.Tag := 1 Else Timer1.Tag = 0;
    End;

End.

Das Timer-Ereignis könnte aber auch so aussehn:

Delphi-Quellcode:

  Procedure TForm1.Timer1Timer(Sender: TObject);
    Begin
      If Timer1.Tag = 0 Then Begin
        (* Text zeichnen *)
        Canv.TextOut(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2,
          Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht);
        Timer1.Tag := 1;
      End Else Begin
        (* Text löschen *)
        Canv.TextOut(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2,
          Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht);
        Timer1.Tag := 0;
      End;
    End;

[steppo]

das beispiel ist sehr gut gelungen, löst aber mein Problem nicht.

Problem 1:
Im Moment wird der dargestellte Text durch den gleichen Text (schwarz und weiß) ersetzt. Dadurch wird das löschen des Textes simuliert. Der text wird also nicht wirklich gelöscht sondern nur überschrieben.
Was ist aber wenn der Hintergrund nicht weiß ist?

Problem 2:
Wird der schwarze Text durch weißen Text ersetzt, so werden auch die Elemente auf dem Bildschirm übermalt.

Also kommt diese Art der Änderung nicht in Frage!

Was Tun?

[steppo]

Hallo gibt es jemanden der mir hier helfen kann?
Ist es vielleicht besser mit einer Transparenten Form und einem Label zu arbeiten?

Und Lucky, ich habe es auch mit InvalidRect versucht.
Das Problem dabei ist aber, das beim ausführen des Befehls der Bildschirm flimmert!
Vielleicht kann mir ja jemand bei diesem Problem helfen.
Wie schalte ich das Flimmern ab?

[himitsu]

Ein Hallöle von http://www.FrankNStein.de/Smiley-Wolke.gif,

Zitat von himitsu:

Wenn du etwas schreiben und dann wieder löschen willst, ohne den Hintergrund zu zerstören, musst du anders zeichnen/schreiben.

Delphi-Quellcode:

Canvas.Brush.Style := bsClear;  {kein Hintergrund beim schreiben}
Canvas.Pen.Mode := pmNotXor;

Canvas.TextOut(X, Y, 'Text');   {Text schreiben}


Canvas.TextOut(X, Y, 'Text');   {Text wieder löschen}

Beispiele für PenMode (müsste der letzte Post auf der 1. Seite sein - von mir)

Idealer Weise, währe es besser nicht mit Schwarz und Weiß zu schreiben, sondern immer mit der selben Farbe und PenMode=pmNotXor.
Da verschwindet bei jedem 2. schreiben der Text wieder, so das der Hintergrund wieder hergestellt wird.

Denn
(X xor Y) xor Y = X
not ((not (X xor Y)) xor Y) = X

Konnte PenMode aber noch nicht für API finden/aktivieren.
Ich weiß aber, das ich noch irgendwo 'ne Funktion für TextOut (API-Version) haben, die hält sich aber seit meiner letzten Aufräumaktion sehr gut versteckt. (suche ab und zu mal danach - wenn sie auftaucht, sag' ich Bescheid)


http://www.FrankNStein.de/Smiley-Kuss.gif * * http://www.FrankNStein.de/Smiley-Spinne.gif * * * http://www.FrankNStein.de/Smiley-Winken.gif

[steppo]

Vielen Dank für deine Mühe himitsu.

Das Problem hat sich aber schon erledigt.
Der Fehler bestand darin, dass ich

canv.handle := GetWindowDC(0); benutzt habe.

Dabei wird der Hintergrund gelöscht.

Verwendet man aber
canv.handle := GetWindowDC(WindowHandle); So funktioniert das ganze einwandfrei.

Dennoch bestehen noch andere Probleme.

Wie du gesehen hast, benutze ich einen Timer um das ganze ein bzw auszublenden.
Das Problem ist aber, das die eingestellten Zeitintervalle nicht den Tatsächlichen Zeitintervallen entsprechen. Aufgefallen ist mir das ganze als ich den Timer auf 1 millissekunde eingestellt habe.
Bei diesem Zeitintervall dürfte man gar keinen Text sehen!
Wie ist das möglich und wie behebe ich das Problem?

[himitsu]

Ein Hallöle von http://www.FrankNStein.de/Smiley-Wolke.gif,

Delphi-Quellcode:

Unit Unit1; 

Interface 
  Uses Windows, Messages, SysUtils, Variants, Classes, 
    Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; 

  Type TForm1 = Class(TForm) 
    Timer1: TTimer; 
    OpenDialog1: TOpenDialog; 
    Procedure FormCreate(Sender: TObject); 
    Procedure FormDestroy(Sender: TObject); 
    Procedure Timer1Timer(Sender: TObject); 
  End; 

  Var Form1: TForm1; 
    Nachricht: String; 
    Canv: TCanvas; 

Implementation 
  {$R *.dfm} 

  Procedure TForm1.FormCreate(Sender: TObject); 
    Begin 
      Canv := TCanvas.Create; 
      Canv.Handle := GetWindowDC(WindowHandle); 
      OpenDialog1.Execute; 
      Nachricht := ExtractFileName(OpenDialog1.FileName); 
      With Canv do Begin 
        Font.Name := 'Arial'; 
        Font.Size := 24; 
        Brush.Style := bsClear; 
      End; 
      {Timer1.Interval := Anzeigeintervall;}
      {Timer1.Tag := 0;}
      {Timer1.Enabled := True;}
    End; 

  Procedure TForm1.FormDestroy(Sender: TObject); 
    Begin 
      If Timer1.Tag <> 0 Then Begin 
        (* Text löschen *) 
        Font.Color := clWhite; 
        Canv.TextOut(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2, 
          Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht); 
      End; 
      Canv.Free; 
    End; 

  Procedure TForm1.Timer1Timer(Sender: TObject); 
    Begin 
      If Timer1.Tag = 0 Then Begin 
        (* Text zeichnen *) 
        Font.Color := clBlack; 
        Timer1.Tag := 1; 
      End Else Begin 
        (* Text löschen *) 
        Font.Color := clWhite; 
        Timer1.Tag := 0; 
      End; 
      Canv.TextOut(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2, 
        Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht); 
    End;

End.

(nicht getestet)


http://www.FrankNStein.de/Smiley-Kuss.gif * * http://www.FrankNStein.de/Smiley-Spinne.gif * * * http://www.FrankNStein.de/Smiley-Winken.gif

[steppo]

Hallo himitsu,
vielen Dank für deine schnelle Antwort.
Ich finde es toll, dass du dir soviel Mühe machst und dazu meinen Quellcode im großen und ganzen mit einbindest.
Das ist sehr selten.

Danke auch für den vorbereiteten Quellcode.
Allerdings ist mein Problem dadurch nicht behoben!

Wie du in meinem Quelltext sehen kannst benutze ich sleep.

Warum?

Ganz einfach.

Ich möchte die Anzeigezeit des Textes sowie die Wiederholungszeit selber definieren können.
Im Klartext, es muß wählbar sein, wie oft, also in welchen Zeitabständen der Text angezeigt wird, und für wie lange der Text angezeigt wird.

Den Timerintervall selber habe ich auf 1 millisekunde gesetzt und dieser dient nur dem starten des Timers bei Beginn des Programmes. Danach wird alles weitere über sleep geregelt.

MfG
steppo

[himitsu]

Und weiter geht's auf http://www.FrankNStein.de/Smiley-Wolke.gif,

Das Intervall könnte man ja so ändern:

Delphi-Quellcode:

  Procedure TForm1.Timer1Timer(Sender: TObject); 
    Begin 
      If Timer1.Tag = 0 Then Begin 
        (* Text zeichnen *) 
        Font.Color := clBlack; 
        Timer1.Tag := 1; 
{}      Timer1.Interval := 1000;
      End Else Begin 
        (* Text löschen *) 
        Font.Color := clWhite; 
        Timer1.Tag := 0; 
{}      Timer1.Interval := 5000;
      End; 
      Canv.TextOut(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2, 
        Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht); 
    End;

http://www.FrankNStein.de/Smiley-Kuss.gif * * http://www.FrankNStein.de/Smiley-Spinne.gif * * * http://www.FrankNStein.de/Smiley-Winken.gif

[steppo]

Danke himitsu,
habe es ausprobiert, bringt aber nicht den gewünschten erfolg. Ist ja im enteffekt auch nichts anders als mein procedure nur halt mit einer if-anweisung.

Das problem besteht weiterhin.

Selbst wenn ich ich sleep auf 1 setze, wird ungefähr nach dem 8ten aufruf der text kurz sichtbsr.
danke dennoch

MfG
steppo