Canvas Text löschen

[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