Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
Delphi XE3 Enterprise
|
AW: Lauftext von rechts nach links
18. Nov 2013, 15:30
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.
Thomas Wassermann H₂♂ Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂♂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
|
|
Zitat
|