Lauftext von rechts nach links

[baumina]

Die Variable a kannst du in der Zwischenzeit weglassen und direkt durch die Variable Text (wobei ich die nicht so nennen würde, nenn sie lieber aText, dann kann es zu keinen Namenskonflikten kommen) ersetzen.

[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.

[Natcree]

gibt leider nur ne leere form

[DeddyH]

Hast Du das FormCreate auch dem OnCreate zugewiesen (Objektinspektor)?

[Natcree]

Nee hast recht läuft. Herje worauf mann auch alles achten darf XDD. Danke