AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Canvas Text löschen
Thema durchsuchen
Ansicht
Themen-Optionen

Canvas Text löschen

Ein Thema von steppo · begonnen am 19. Nov 2003 · letzter Beitrag vom 25. Nov 2003
 
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.340 Beiträge
 
Delphi 12 Athens
 
#29

Re: Canvas Text löschen

  Alt 24. Nov 2003, 23:25
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
Ein Therapeut entspricht 1024 Gigapeut.
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:23 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz