Einzelnen Beitrag anzeigen

Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#7

AW: Lauftext von rechts nach links

  Alt 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)
  Mit Zitat antworten Zitat