Lauftext von rechts nach links

[DeddyH]

Ich würde das ja ungefähr so angehen (schnell heruntergeschludert, daher ohne Gewähr):

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TScrollingText = class(TGraphicControl)
  private
    FActive: Boolean;
    FDisplayText: string;
    FFont: TFont;
    FTimer: TTimer;
    FMinLeft: integer;
    FCurrentLeft: integer;
    FLeftStr: string;
    FCurrentIndex: integer;
    FAutoSize: Boolean;
    procedure SetActive(const Value: Boolean);
    procedure SetDisplayText(const Value: string);
    procedure SetFont(const Value: TFont);
    procedure DoTimer(Sender: TObject);
    procedure Reset;
    procedure SetFontAutoSize(const Value: Boolean);
    procedure DoResize;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean read FActive write SetActive;
    property AutoSize: Boolean read FAutoSize write SetFontAutoSize;
    property DisplayText: string read FDisplayText write SetDisplayText;
    property Font: TFont read FFont write SetFont;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    FScrollingText: TScrollingText;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const STEP = 2;

{ TScrollingText }

constructor TScrollingText.Create(AOwner: TComponent);
begin
  inherited;
  FTimer := TTimer.Create(self);
  FTimer.Interval := 10;
  Active := false;
  FTimer.OnTimer := DoTimer;
  FFont := TFont.Create;
  FAutoSize := true;
end;

destructor TScrollingText.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure TScrollingText.DoResize;
begin
  Canvas.Font.Assign(FFont);
  SetBounds(Left, Top, Canvas.TextWidth(FDisplayText), Canvas.TextHeight(FDisplayText));
end;

procedure TScrollingText.DoTimer(Sender: TObject);
var
  CurrentChar: char;
begin
  dec(FCurrentLeft, STEP);
  if FCurrentLeft <= FMinLeft then
    begin
      FCurrentLeft := FMinLeft;
      if FCurrentIndex < Length(FDisplayText) then
        begin
          CurrentChar := FDisplayText[FCurrentIndex];
          inc(FMinLeft, Canvas.TextWidth(CurrentChar));
          FCurrentLeft := Width;
          FLeftStr := FLeftStr + CurrentChar;
          inc(FCurrentIndex);
        end
      else
        Active := false;
    end;
  invalidate;
end;

procedure TScrollingText.Paint;
begin
  inherited;
  Canvas.Font.Assign(FFont);
  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(0, 0, FLeftStr);
  if FDisplayText <> '' then
    begin
      if FDisplayText[FCurrentIndex] = ' ' then
        FCurrentLeft := FMinLeft;
      Canvas.TextOut(FCurrentLeft, 0, FDisplayText[FCurrentIndex]);
    end;
end;

procedure TScrollingText.Reset;
begin
  FMinLeft := 0;
  FLeftStr := '';
  FCurrentIndex := 1;
  FCurrentLeft := Width;
  invalidate;
end;

procedure TScrollingText.SetActive(const Value: Boolean);
begin
  FActive := Value;
  FTimer.Enabled := FActive;
end;

procedure TScrollingText.SetFontAutoSize(const Value: Boolean);
begin
  FAutoSize := Value;
  if FAutoSize then
    DoResize;
end;

procedure TScrollingText.SetDisplayText(const Value: string);
begin
  if FDisplayText <> Value then
    begin
      FDisplayText := Value;
      if FAutoSize then
        DoResize;
      Reset;
    end;
end;

procedure TScrollingText.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := true;
  FScrollingText := TScrollingText.Create(self);
  FScrollingText.Parent := self;
  FScrollingText.Font.Name := 'Arial';
  FScrollingText.Font.Size := 24;
  FScrollingText.DisplayText := 'Hallo Welt, da bin ich wieder :)';
  FScrollingText.Active := true;
end;

end.