Canvas Text löschen

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

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?
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.FrankNStein.de/Smiley-Kuss.gif * * http://www.FrankNStein.de/Smiley-Spinne.gif * * * http://www.FrankNStein.de/Smiley-Winken.gif

[steppo]

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

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.

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:HDC := GetWindowDC(WindowHandle); Sondern: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.
{DC: Canvas.Brush.Style := bsClear;} siehe Windows GDI - Brush Functions
{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.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