Canvas Text löschen

[steppo]

Hi Leute,

habe einen Text mit canvas.Textout auf dem Desktop ausgegeben.
Wie lösche ich diesen wieder?

[Luckie]

Übermalen oder Desktop mit InvalidateRect aktualisieren.

[steppo]

Hi Lucky,

Was meinst du mit übermalen?
InvalidateRect verusacht ein flackern!

[ATwardz]

Hi,

bei meinem Paintprogramm habe ich das so angestellt, das ich mir die vollgeschriebene Stelle(bemahlte gespeichert habe und diese nachher wieder hergestellt habe!
So wie Luckie das mit übermahlen meinte!
Meiner Meinung nach ist das die schnellste und effektivste Variante!
Ich habe die bei der zeichnung eines Kreises benutzt um einen Kreis zu zeichnen , der Vorher schon die Grösse angibt, wie es in MSPaint auch der Fall ist!

ATwardz

[steppo]

ich habe jetzt den gleichen Text in einer anderen schrift farbe überschrieben.
das problem ist nur,das der Hintergrund natürlich auch überschrieben wird, und so textteile fehlen!

[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)

[steppo]

Funktioniert nicht bei mir.
Woran liegt es?

Delphi-Quellcode:

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    //    procedure FormPaint(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  Nachricht: string;
  Canv: TCanvas;
implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin

  Timer1.Enabled := not Timer1.Enabled;

  case Timer1.Enabled of
    True:
      begin
        Canv.Font.Color := clBlack;

        //Position zur Ausgabe der Schrift
        Canv.textout(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2,
          Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht);

        Application.ProcessMessages;

        sleep(1000);
      end;
    False:
      begin
        Application.ProcessMessages;

        Canv.Font.Color := clWhite;

        //Position zur Ausgabe der Schrift
        Canv.textout(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2,
          Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht);

        Refresh;

        sleep(1000);
      end;
  end;
  Timer1Timer(Self);
end;

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;
    brush.style := bsclear;
    Pen.Mode := pmNot;
  end;
  Timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Canv.Free;
end;

end.

[himitsu]

Sehe ich das richtig:

die Schrift soll doch zentriert blinken?

[steppo]

ja das ist richtig!

[OLLI_T]

HY!

Hast Du Dir eigentlich irgendetwas bei Deiner ultrakrassen OnTimer Methode gedacht oder hast Du das Artefakt einfach nur vorbehaltlos irgendwo rausgeschnipselt???? TsTsTs

Gruss

OLLI

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

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.delphipraxis.net/images/common/divider.jpg
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

Delphi-Quellcode:

canv.handle := GetWindowDC(0);

benutzt habe.

Dabei wird der Hintergrund gelöscht.

Verwendet man aber

Delphi-Quellcode:

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.delphipraxis.net/images/common/divider.jpg
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.delphipraxis.net/images/common/divider.jpg
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

[fenni]

Soweit ich weiss, bewirkt der sleep-Befehl eine komplette Unterbrechung im Programmablauf, d.h. dem Prozess wird sämtliche zur Verfügung stehende Rechenleistung gestrichen. Diese Zeit bräuchte er aber, um z.B. den Text anzuzeigen. sleep sollte also nicht als Erstaz für delay (aus TurboPascal) verwendet werden, dafür gibt es ja eben die Timer.

Vielleicht versuchst du es einmal mit folgender Prozedur (bei mir hat sie geholfen :wink: ):

Delphi-Quellcode:

uses Forms;

procedure delay(ms: longint; var app: TApplication);
  var start,stop: TDateTime;
begin
  start := time;
  repeat
    stop := time;
    app.ProcessMessages;
  until millisecondsbetween(start,stop) >= ms;
end;

MfG
fenni

[steppo]

hi fenni,
danke für deine antwort. habe den code ausprobiert.
Wenn ich die delay procedure auf 1 ms setze sehe ich nichts. damit wäre die forderung erfüllt.
das problem ist, wenn ich den wert auf 1000 setze sehe ich auch keinen text!

Allerdings weis ich nicht, ob ich die procedur richtig angewandt habe.

Habe die Procedure jeweils unter on.Timer in die case anweisung geschrieben und zwar einmal unter false und einmal unter true. Sie soll ja in beiden fällen mit unterschiedlichen werten ausgeführt werden.

Was übergebe ich als app?

Delphi-Quellcode:

procedure TForm1.delay(ms: longint; var app: TApplication);

MfG steppo

[himitsu]

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

wenn der Text nur kurz angezeigt werden soll, kannst du es ja auch so machen:

Delphi-Quellcode:

  Procedure TForm1.Timer1Timer(Sender: TObject); 
    Begin
      (* Text zeichnen *) 
      Font.Color := clBlack; 
      Canv.TextOut(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2, 
        Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht); 
      Sleep(1);
      Application.ProcessMessage;
      (* 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;

Kannst ja mit verschieden Varianten spielen:

Code:

        [color=gray]Screen.Height [b]div[/b] 2 - Canv.TextHeight(Nachricht) [b]div[/b] 2, Nachricht);[/color] 
      Sleep(1);
      [color=gray](* Text löschen *)[/color]

Code:

        [color=gray]Screen.Height [b]div[/b] 2 - Canv.TextHeight(Nachricht) [b]div[/b] 2, Nachricht);[/color] 
      Application.ProcessMessage;
      [color=gray](* Text löschen *)[/color]

Code:

        [color=gray]Screen.Height [b]div[/b] 2 - Canv.TextHeight(Nachricht) [b]div[/b] 2, Nachricht);[/color] 
      Sleep(1);
      Application.ProcessMessage;
      [color=gray](* Text löschen *)[/color]

PS: Die Anzeigedauer (Sleep) mß kleiner als das Anzeigeintervall (Timer1.Interval) sein.

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
      Canv.Free;
    End;

  Procedure TForm1.Timer1Timer(Sender: TObject); 
    Begin
      (* Text zeichnen *) 
      Font.Color := clBlack; 
      Canv.TextOut(Screen.Width div 2 - Canv.TextWidth(Nachricht) div 2, 
        Screen.Height div 2 - Canv.TextHeight(Nachricht) div 2, Nachricht); 
      Sleep(1);
      (* 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;

End.

http://www.delphipraxis.net/images/common/divider.jpg
http://www.FrankNStein.de/Smiley-Kuss.gif * * http://www.FrankNStein.de/Smiley-Spinne.gif * * * http://www.FrankNStein.de/Smiley-Winken.gif

[steppo]

Zitat:

Zitat von himitsu

PS: Die Anzeigedauer (Sleep) mß kleiner als das Anzeigeintervall (Timer1.Interval) sein.

Was meinst du genau damit?
Wie ich schon geschrieben habe, ist mein Timerinterval auf 1 gesetzt, da dieser lediglich dem starten des timers dient.

steppo

[himitsu]

Gehn mer das mal anders an.

Sag erst mal die Zeitintervalle, die hier eingehalten werden sollen.
Und eventuell noch mal was genau passieren soll.

Zum Beispiel:

• Schrift sofort nach Programm start anzeigen (0 ms)
• Anzeigedauer der Schrift - 1 ms
• Pausen zwischen dem Anzeigen der Schrift - 1000 ms
  ...

http://www.delphipraxis.net/images/common/divider.jpg
http://www.FrankNStein.de/Smiley-Kuss.gif * * http://www.FrankNStein.de/Smiley-Spinne.gif * * * http://www.FrankNStein.de/Smiley-Winken.gif

[fenni]

Aufgerufen wird die Prozedur mit

Delphi-Quellcode:

delay(1000, Application);

Application wird benötigt, um ProcessMessages ausführen zu können (damit das Programm nicht ganz stehen bleibt, wie bei sleep). Das ganze ist sehr Prozessorintensiv, ich würde evtl. das Timer-Intervall etwas höher setzen (50 ms), damit sich der Prozess nicht nur mit Schleifen aufhält.

Falls du noch andere Befehle abarbeiten willst, könntest du Probleme bekommen - da die delay-Prozedur alles aufhält. Wenn der Sinn des Programms also nicht nur darin besteht, den Text blinken zu lassen, solltest du vielleicht doch jeweils das Timer-Intervall ändern und auf sleep o.ä. verzichten. :wink:

MfG
fenni

[steppo]

hallo himitsu,

Schriftanzeige sofort nach Programmstart anzeigen.
Anzeigedauer der Schrift 750 ms.
Pause nach dem ablauf der Schriftanzeige 1sekunde.

Also, der text soll jede sekunde für genau 750 millisekunden angezeigt werden.
(Text anzeigen für 750 millisekunden, ausblenden, 1 sekunde warten, text wieder für 750 millisekunden anzeigen).

Mein Problem liegt nicht im Ein und Ausblenden des Textes, sondern darin das die Zeitintervalle nicht eingehalten werden. In dem Programm, welches ich als Vorlage benutze, wird der Text blinkend dargestellt wenn beide Werte (Dauer der anzeige und wiederholen der Anzeige) auf 1 sekunde eingestellt werden. Der Text wird also eingeblendet, wird nach einer sekunde ausgeblendet und nach einer sekunde wieder eingeblendet.
o.k.

Das funktioniert bei mir auch!

Stelle ich aber,in dem Beispielprogramm, den Anzeigeinterval auf 750 millisekunden und die wiederholungsrate auf 1 sekunde so ist der darstellbare text nicht mehr sichtbar.

Bei meinem Programm blinkt der anzuzeigende Text sogar, wenn ich den Anzeigeinterval auf 1 millisekunde setze. Da stimmt doch etwas nicht!

[steppo]

hi fenni,
genau diese parameter habe ich auch übergeben.
Als Ergebnis wurde mir ein blinkender Text angezeigt, der sich nicht an die Intervalle gehalten hat, sondern ständig geblinkt hat.

[himitsu]

Und die Fortsetzung von http://www.FrankNStein.de/Smiley-Wolke.gif.

So, hab jetzt endlich mal das ganze umgestellt, den mit dem Canvas (Canv) geht es ja anscheinen nicht.

Außerdem hab ich mal das richtige Fensterhandle eingebaut.
Nicht:

Delphi-Quellcode:

HDC := GetWindowDC(WindowHandle);

Sondern:

Delphi-Quellcode:

HDC := CreateDC('DISPLAY', Nil, Nil, Nil);

Es sind aber noch nicht alle Befehle geändert.
Da ich mich nicht so gut mit der Windows-GDI auskenne blieben zwei Zeilen übrig, welche noch geändert werden müssen.
Ich hab erst mal die Canvas-Methoden hingeschrieben. Diese müssen nur noch durch entsprechende Funktionen aus der Windows-GDI ersetzt werden.

Delphi-Quellcode:

{DC: Canvas.Brush.Style := bsClear;}

siehe Windows GDI - Brush Functions

Delphi-Quellcode:

{DC: Canvas.Pen.Mode := pmNotXor;

siehe Windows GDI - Pen Functions

Im Prinzip muß jeweils für Brush (HBrush) und Pen (HPen) ein entsprechender Typ erstellt und dann DC zugewiesen werden. Genauso, wie ich es schon mit der Schriftart (HSchrift) gemacht hab.

Das Prinzip zum löschen der Schrift ist einfach, das ein zweimaliges Zeichnen mit XOR ja den Originalzustand wieder herstellt.
Entsprechend dem Beispiel am Ende der 1. Seite diese Beitrags (canvas.rahmen.aufziehen.laufzeit = wie.aufziehen.entwicklung / meine 2. Antwort in diesem Beitrag)

Der aktuelle Code:

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;
    DC: HDC;
    HSchrift, SchriftAlt: Integer;
    {HBrush, HPen: Integer;}

Implementation
  {$R *.dfm}

  Procedure TForm1.FormCreate(Sender: TObject);
    Begin
      {Timer1.Tag := 0;}
      {Timer1.Enabled := False;}
      DC := CreateDC('DISPLAY', Nil, Nil, Nil);
      SetTextAlign(DC, TA_CENTER or TA_BASELINE or TA_NOUPDATECP);
      HSchrift := CreateFont(24{Schriftgrösse}, 0, 0, 0, 
        300, 0, 0, 0, 1, 4, 16, 2, 4, @('Arial'#00)[1]);
      SchriftAlt := SelectObject(DC, HSchrift);
      SetTextColor(DC, clBlack);
      {DC: Canvas.Brush.Style := bsClear;}
      {DC: Canvas.Pen.Mode := pmNotXor;}
      OpenDialog1.Execute;
      Nachricht := ExtractFileName(OpenDialog1.FileName);
      Timer1Timer(Sender);
      Timer1.Enabled := True;
    End;

  Procedure TForm1.FormDestroy(Sender: TObject);
    Begin
      If Timer1.Tag <> 0 Then Begin
        (* Text löschen *)
        TextOut(DC, Screen.Width div 2, Screen.Height div 2,
          PChar(Nachricht), StrLen(PChar(Nachricht)));
      End;
      SelectObject(DC, SchriftAlt);
      DeleteObject(HSchrift);
      DeleteDC(DC);
    End;

  Procedure TForm1.Timer1Timer(Sender: TObject);
    Begin
      If Timer1.Tag = 0 Then Begin
        (* Text zeichnen *)
        Timer1.Tag := 1;
        Timer1.Interval := 750;
      End Else Begin
        (* Text löschen *)
        Timer1.Tag := 0;
        Timer1.Interval := 1000;
      End;
      TextOut(DC, Screen.Width div 2, Screen.Height div 2, 
        PChar(Nachricht), StrLen(PChar(Nachricht)));
    End;

End.

Hab dir extra mal 'ne Version zum testen der Blinkfrequenz erstellt, da man es ja in der richtigen Version noch nichts seh'n kann (dort bleibt ja die Schrift noch schwarz):

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;
    DC: HDC;
    HSchrift, SchriftAlt: Integer;

Implementation
  {$R *.dfm}

  Procedure TForm1.FormCreate(Sender: TObject);
    Begin
      {Timer1.Tag := 0;}
      {Timer1.Enabled := False;}
      DC := CreateDC('DISPLAY', Nil, Nil, Nil);
      SetTextAlign(DC, TA_CENTER or TA_BASELINE or TA_NOUPDATECP);
      HSchrift := CreateFont(24{Schriftgrösse}, 0, 0, 0, 
        300, 0, 0, 0, 1, 4, 16, 2, 4, @('Arial'#00)[1]);
      SchriftAlt := SelectObject(DC, HSchrift);
      Nachricht := 'Test - Test - Test';
      Timer1Timer(Sender);
      Timer1.Enabled := True;
    End;

  Procedure TForm1.FormDestroy(Sender: TObject);
    Begin
      If Timer1.Tag <> 0 Then Begin
        (* Text löschen *)
        SetTextColor(DC, clWhite);
        TextOut(DC, Screen.Width div 2, Screen.Height div 2,
          PChar(Nachricht), StrLen(PChar(Nachricht)));
      End;
      SelectObject(DC, SchriftAlt);
      DeleteObject(HSchrift);
      DeleteDC(DC);
    End;

  Procedure TForm1.Timer1Timer(Sender: TObject);
    Begin
      If Timer1.Tag = 0 Then Begin
        (* Text zeichnen *)
        SetTextColor(DC, clBlack);
        Timer1.Tag := 1;
        Timer1.Interval := 750;
      End Else Begin
        (* Text löschen *)
        SetTextColor(DC, clWhite);
        Timer1.Tag := 0;
        Timer1.Interval := 1000;
      End;
      TextOut(DC, Screen.Width div 2, Screen.Height div 2,
        PChar(Nachricht), StrLen(PChar(Nachricht)));
    End;

End.

http://www.delphipraxis.net/images/common/divider.jpg
http://www.FrankNStein.de/Smiley-Kuss.gif * * http://www.FrankNStein.de/Smiley-Spinne.gif * * * http://www.FrankNStein.de/Smiley-Winken.gif

[steppo]

danke für die Mühe die du dir gegeben hast.

Hätte einen solchen aufwand nicht erwartet. Erst recht nicht, dass sich jemand so damit auseinander setzt, um mir zu helfen.

Wie bist du den an die ganzen befehle gekommen?
Habe mich fast totgesucht!

Werde es ausprobieren und bericht erstatten.

Danke
steppo

[himitsu]

Immer schön gesammelt.

Und das aus verschiedenen Demo-Projekten zusammengebaut.

http://www.delphipraxis.net/images/common/divider.jpg
http://www.FrankNStein.de/Smiley-Kuss.gif * * http://www.FrankNStein.de/Smiley-Spinne.gif * * * http://www.FrankNStein.de/Smiley-Winken.gif

[steppo]

Hi himitsu,
habe beide Programme getestet. Leider nicht mit dem erwünschten Erfolg.

Ich kann mein Problem anscheinend nicht deutlich genug darlegen.

Das blinken ist nicht das Problem.

O.K.

Das was jetzt noch übrig bleibt ist, dass du dir das Originalprogramm ("Mega Motivator") von folgender Webseite herunterlädst und es dir ansiehst.

http://www.supreme-web-design.org/

Stelle die Werte wie folgt ein:
Anzeigedauer:750 ms
Wiederholungsrate: 1000 ms

zum Vergleich

Anzeigedauer:1000 ms
Wiederholungsrate: 1000 ms.

Großer Unterschied, oder?

Bei meinem Programm gibt es kaum einen Unterschied!

[himitsu]

Dieser Mega Motivator will bei mir nicht richtig laufen. (unter 2 Sekunden Anzeigedauer ist selten mal was zu seh'n)

Ich kann mich aber auch täuschen, aber mir kommt es so vor, als wenn dieser Mega Motivator garnicht direckt auf den Desktop schreibt.
Bin mir zu 99,9999% sicher, dass die den selben oder zumindestens einen ähnlichen Weg gehen, wie im angehängten Prog.

Add:
Brauchst aber ein 7er Delphi dafür, an sonsten mußß noch ein bissl geändert werden.

http://www.delphipraxis.net/images/common/divider.jpg
http://www.FrankNStein.de/Smiley-Kuss.gif * * http://www.FrankNStein.de/Smiley-Spinne.gif * * * http://www.FrankNStein.de/Smiley-Winken.gif

[steppo]

genau darum geht es.

Wenn ich die Einstellungen auf 1000ms anzeige und 1000ms wiederholung setze, habe ich ein einwandfreies auf und abblincken des Textes.

Original wie mein Programm O.K.

Setze ich die Anzeigedauer auf 750 ms und die wiederholung auf 1000 ms, so ist der Text im Original nicht mehr zu sehen.

Bei mir jedoch ist der text sogar bei 1 ms Anzeigedauer sichtbar.

Das war es, was mich verwundert hat.

Funktioniert das Programm nicht richtig, oder liegt der Fehler in meinem Program?
Das war die Frage, die ich mir gestellt habe.

Werde mir mal deinen Link anschauen.!
steppo

[steppo]

Hi himitsu,
habe mir dein Programm angesehen.
Hast das ganze mit einem Label versucht.
Habe ich auch schon hinter mir.
Bringt nicht den gewünschten erfolg.

Mir ist aufgefallen das die intervalle ungleichmäßig werden, wenn man sleep auf 1 ms setzt.
Das Problem habe ich bei meinem Programm auch.Müßte so jeder 8te durchlauf sein, wenn der text kurz sichtbar wird.
steppo