Lauftext von rechts nach links

[Natcree]

Hallo ich möchte einen Lauftext erstellen. Dieser soll von rechts nach links laufen und ein wort Zeichen weise zusammensetzen

Edit.text := Hallo

das erste Zeichen also "H" soll einrücken wenn es steht dann soll das "a" kommen

H <--- a
Ha <--- l
Hal <--- l
Hall <--- o
Hallo

Wie bekomme ich das realisiert?

[baumina]

Nimm einen Timer. Und baue dort Buchstaben für Buchstaben des Wortes auf und brings auf den Bildschirm (z.B. Label rechtsbündig formatiert).

[Der schöne Günther]

Falls das keinen funktionalen Zweck erfüllt sondern einfach nur eine Animation zum gut aussehen sein soll würde ich das von Anfang an mit irgendeiner professionellen Animationssoftware machen und als Videoclip oder Flash einbauen.

Ansonsten würde ich bei dem Label noch aufpassen, dass es eine Schriftart ist, in welcher die Zeichen alle gleich breit sind. Der Fachbegriff dafür fehlt mir grade :oops:

[Natcree]

Delphi-Quellcode:

var
s:string;
i:integer;
begin
  edit1.text:='Hallo';
  s:=edit1.text;
  for i:=1 to length(s) do
  canvas.textout(50+i*10,50,s[i]);
end;

Wo kann ich hier in der schleife den timer einbauen ? er soll nach jedem Buchstaben eine sekunde warten....

[Perlsau]

Zitat:

Zitat von Der schöne Günther (Beitrag 1236394)

... Zeichen alle gleich breit sind. Der Fachbegriff dafür fehlt mir grade :oops:

monospaced ...

[baumina]

Hier ein kleines Beispiel:

Delphi-Quellcode:

type
  TForm62 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form62: TForm62;
  i : Integer;

const
  aText = 'Dies ist ein Text';

implementation

{$R *.dfm}

procedure TForm62.Timer1Timer(Sender: TObject);
begin
  inc(i);
  if i > length(aText) then
  begin
    Timer1.Enabled := False;
    Exit;
  end;
  canvas.textout(50+i*10,50,aText[i]);
end;

Delphi-Quellcode:

object Form62: TForm62
  Left = 0
  Top = 0
  Caption = 'Form62'
  ClientHeight = 337
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Timer1: TTimer
    Interval = 1000
    OnTimer = Timer1Timer
    Left = 518
    Top = 180
  end
end

[Bummi]

So was?
Leeres Form, Code ersetzen, Komponenten werden zur Laufzeit erzeugt

Delphi-Quellcode:

type
  TForm1 = class(TForm)
  private
    FS: String;
    Timer1: TTimer;
    PaintBox1: TPaintBox;
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    { Private-Deklarationen }
  public
    Constructor Create(AOwner: TComponent); override;
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
implementation

uses Math;
{$R *.dfm}

Const
  InPoint = 200;
  C_Stepping = 10;

constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
  DoubleBuffered := true;
  Timer1 := TTimer.Create(self);
  Timer1.Interval := 20;
  Timer1.Enabled := false;
  Timer1.OnTimer := Timer1Timer;
  Timer1.Tag := InPoint;
  PaintBox1 := TPaintBox.Create(self);
  PaintBox1.Parent := self;
  PaintBox1.Align := alTop;
  PaintBox1.OnPaint := PaintBox1Paint;
  PaintBox1.Font.Size := 12;
  PaintBox1.Font.Style := [fsBold];
  Edit1 := TEdit.Create(self);
  Edit1.Parent := self;
  Edit1.Text := 'Hallo';
  Edit1.Top := 100;
  Button1 := TButton.Create(self);
  Button1.Parent := self;
  Button1.Top := 130;
  Button1.Caption := 'Run';
  Button1.OnClick := Button1Click;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FS := '';
  Timer1.Enabled := true;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.TextOut(0, 0, FS);
  if Timer1.Enabled then
    PaintBox1.Canvas.TextOut(Timer1.Tag, 0, Copy(Edit1.Text, Length(FS) + 1, 1));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Length(FS) = Length(Edit1.Text) then
  begin
    Timer1.Enabled := false;
    Exit;
  end;
  if Timer1.Tag <= PaintBox1.Canvas.TextWidth(FS) then
  begin
    FS := FS + Copy(Edit1.Text, Length(FS) + 1, 1);
    Timer1.Tag := InPoint;
    PaintBox1.Invalidate;
  end
  else
  begin
    Timer1.Tag := Timer1.Tag - MIN(C_Stepping, InPoint - Canvas.TextWidth(FS));
    Caption := IntToStr(Timer1.Tag);
    PaintBox1.Invalidate;
  end;
end;

end.

[Natcree]

Danke erstmal

Nun soll auch sound abgespielt werden jedoch bremst dieser die geschwindigkeit aus kann ich da was gegen machen

Delphi-Quellcode:

var
s:String;
begin
  s:='Hallo';
  inc(i);
  if i > length(s) then
  begin
    Timer1.Enabled := False;
    Exit;
  end;
  canvas.textout(50+i*10,50,s[i]);
  sndPlaySound(Pchar('c:\delphi progs\fenster\windows navigation start.wav'),SND_SYNC);
end;

[DeddyH]

Du weißt, was SND_SYNC macht?

[Natcree]

Ja weiss ich habe es auch mit async versucht

SND_ASYNC Der Ton ist asynchron und spielte PlaySound kehrt sofort nach Beginn der Sound. Um eine asynchron gespielt Wellenform Ton beenden, rufen PlaySound mit pszSound auf NULL gesetzt.

Wie kann ich pszsound auf null setzen??

[DeddyH]

Delphi-Quellcode:

sndPlaySound(nil, 0);

[Natcree]

Ja aber selbst wenn ich diesen einsetze spielt er bei 200 milsek. im timer den Sound nur einmal ab

Delphi-Quellcode:

  canvas.textout(50+i*10,50,s[i]);
  sndPlaySound(nil, 0);
  sndPlaySound('c:\delphi progs\fenster\windows navigation start.wav',SND_async);

[DeddyH]

Dann läuft vermutlich Dein Timer zu schnell, so dass das Sound abspielen nicht mehr hinterher kommt.

[Natcree]

kann mann da was machen????

[DeddyH]

Keine Ahnung. Wie ist es so?

Delphi-Quellcode:

Timer.Enabled := false;
sndPlaySound(nil, 0);
canvas.textout(50+i*10,50,s[i]);
sndPlaySound('c:\delphi progs\fenster\windows navigation start.wav',SND_async or SND_FILENAME); 
Timer.Enabled := true;

[Natcree]

keine änderung hmmmm????

[Natcree]

komisch bei menushowdelay in der registry kann man auf null setzen und er spielt es auch gut ab. wieso geht es hier nicht.

[Natcree]

Was muss ich machen wenn Der Textout in einem Label erscheinen soll ??

Habe mal das ausprobiert passiert aber nichts

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
var
a:String;
i:integer;
begin
  a:='Anrede';
  inc(i);
  if i > length(a)then
  begin
  timer1.Enabled:=false;
  exit;
  end;
  Label1.canvas.textout(296+i*16,50,a[i]);
end;

[DeddyH]

Schau Dir mal den Wert von i im Debugger an, dann wirst Du merken, dass das so nicht funktionieren kann.

[Natcree]

Var i might not have been initialized. Welchen wert muss ich denn i geben ( inc(i); ) scheint ja denn nicht zu funtionieren

[baumina]

Die Variable i hast du lokal definiert, so dass der Initialwert immer irgendwas sein wird. Durch inc(i) isser dann halt jedesmal irgendwas+1.

[DeddyH]

Wofür ist das i denn da? Ist eine lokale Variable dafür sinnvoll? Wenn Du eine solche nicht selbst initialisierst, dann steht da irgend etwas drin.

[Natcree]

Hmmmmmm ???

Selbst wenn ich i:= 1; zu weise ändert sich nichts
er intitialisiert i aber bei label1 ändert sich nichts er schreibt den Text out nicht

[DeddyH]

An Position (312, 50) bzw. (328, 50) müsste aber das 'A' bzw. 'n' ausgegeben werden ('A' bei i = 0 und nach dem inc(i), 'n' bei i = 1 und auch nach dem inc(i))..

[Natcree]

Hier mal der code Es ändert sich nichts

Delphi-Quellcode:

var
a:String;
i:integer;
begin
  a:='Anrede';
  i:=1;
  if i > length(a)then
  begin
  timer1.Enabled:=false;
  exit;
  end;
  Label1.canvas.textout(121+i*16,30,a[i]);
end;

[baumina]

Die Zählervariable um den richtigen Buchstaben im Timer anzuzeigen darf definitiv nicht lokal sein.

[Natcree]

Das heisst ich muss i hier hinsetzen richtig

Delphi-Quellcode:

var
  Form1: TForm1;
  i:integer;
implementation

{$R *.dfm}

[DeddyH]

Das wäre eine Möglichkeit. Du kannst sie auch als globale Variable unter implementation schreiben, oder Du machst ein privates Feld Deines Formulars daraus, oder Du erstellst Dir eine eigene Klasse für den Lauftext und deklarierst sie dann dort als privates Feld.

[Natcree]

den Text gibt er trotzdem nicht aus ????

Kann mann nicht statt canvas.textout label1.caption ändern???

[baumina]

Wozu ein Label, wenn du eh auf den Canvas schreibst. Also entweder auf Canvas schreiben oder die Caption vom Label ändern :

Delphi-Quellcode:

   label1.caption := label1.Caption + a[i];

[Natcree]

Danke Baumina jetzt klappt es

Delphi-Quellcode:

begin
  a:='Anrede';
  inc(i);
  if i > length(a)then
  begin
  timer1.Enabled:=false;
  exit;
  end;
  Label1.caption:= label1.Caption+ a[i];

Ist bloss die frage warum hat es nicht mit textout geklappt?????

[Natcree]

Warum startet er den Timer nicht mehr wenn ich ihn erneut aktiviere

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.caption:='';
timer1.Enabled:=true;
end;

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  a:='Anrede';
  inc(i);
  if i > length(a)then
  begin
  timer1.Enabled:=false;
  exit;
  end;
  Label1.caption:= label1.Caption+ a[i];
end;

[baumina]

Der Timer staret bestimmt, nur hast du vergessen i zurückzusetzen.

[Natcree]

Oh Ja alles klar Danke

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
i:=-1;// Variable i zurücksetzten
label1.Caption:='';
timer1.Enabled:=true;
end;

Kann ich auch was anderes für i:=-1; schreiben sowas wie reset(i) oder so???

[baumina]

Zitat:

Zitat von Natcree (Beitrag 1237322)

Kann ich auch was anderes für i:=-1; schreiben sowas wie reset(i) oder so???

Da fällt mir spontan nix dazu ein.

[DeddyH]

Wem es Spaß macht:

Delphi-Quellcode:

procedure Reset(out Zahl: integer);
begin
  Zahl := -1;
end;

[Natcree]

Danke :)

Habe mal versucht ein Procedure draus zu basteln

Funktioniert nur nicht hmmmm Wo ist der fehler???

Delphi-Quellcode:

procedure Laufschrift(Text:string;timer:ttimer;Ausgabe:string);
begin
  a:=Text;
  inc(i);
  if i > length(a)then
  begin
  timer.Enabled:=false;
  exit;
  end;
  Ausgabe:= Ausgabe + a[i];
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
i:=-1;
Timer2.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
Laufschrift('Hallo',timer2,label2.caption);
end;

[baumina]

Die Variable "Ausgabe" kennt die procedure Laufschrift nur lokal, alle Änderungen an der Variable werden nicht zurückgegeben. Zurückgegeben würde sie nur wenn du sie als var definierst (

Delphi-Quellcode:

procedure TForm63.Laufschrift(Text:string;timer:ttimer;var Ausgabe:string);

) Allerdings kann man Label.Caption nicht als var-Parameter mitgeben.

Diese ganze Konstruktion ist etwas seltsam.

[DeddyH]

Ungetestet:

Delphi-Quellcode:

procedure Laufschrift(Text:string;timer:ttimer;var Ausgabe:string);
begin
  a:=Text;
  inc(i);
  if i > length(a)then
  begin
    timer.Enabled:=false;
    exit;
  end;
  Ausgabe:= Ausgabe + a[i];
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  i:=-1;
  Timer2.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
  s: string;
begin
  s := label2.caption;
  Laufschrift('Hallo',timer2,s);
  label2.caption := s;
end;

[Natcree]

Danke habe es jetzt so gemacht

Delphi-Quellcode:

procedure TForm1.Laufschrift(Text:string;timer:ttimer;la:Tlabel);
begin
  a:=Text;
  inc(i);
  if i > length(a)then
  begin
  timer.Enabled:=false;
  exit;
  end;
  la.caption:= la.caption + a[i];
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
i:=-1;
Label2.Caption:='';
Timer2.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
Laufschrift('Hallo',timer2,label2);
end;