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

[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 von Der schöne Günther:

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

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