Ticker-Text

[Christian Seehase]

Moin Zusammen,

nur mal so ein Schnellschuss auf Basis von TStaticText, damit das DoubleBuffered schon in der Kompo enthalten ist.

Ruckelt aber noch ganz schön. Wer's optimieren will: Nur zu

Delphi-Quellcode:

unit csTickerStatic;

interface
uses stdctrls,extctrls,classes;

type
  TcsTickerStatic = class(TStaticText)
  private
    FsTickerText : string;
    FcInterval   : cardinal;
    FTimer       : TTimer;
    FfRunning    : Boolean;
    procedure OnTimer(Sender : TObject);
    function GetRunning: Boolean;
  public
    constructor Create(AOwner : TComponent); override;
    procedure Start;
    procedure Stop;
    property TickerText : string   read FsTickerText write FsTickerText;
    property Interval   : cardinal read FcInterval   write FcInterval;
    property Running    : Boolean  read GetRunning;
  end;

  procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('csKompos',[TcsTickerStatic]);
end;

{ TcsTickerStatic }

constructor TcsTickerStatic.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  self.DoubleBuffered := true;
  self.Autosize       := false;
  FsTickerText        := 'Tickertext ';
  self.Caption        := FsTickerText;
  self.Width          := 100;
  self.Height         := 16;
  FcInterval          := 100;
  FTimer              := TTimer.Create(self);
  FTimer.Interval     := FcInterval;
  FTimer.Enabled      := false;
  FTimer.OnTimer      := OnTimer;
  FfRunning           := false;
end;

function TcsTickerStatic.GetRunning: Boolean;
begin
  Result := FTimer.Enabled;
end;

procedure TcsTickerStatic.OnTimer(Sender: TObject);
begin
  if Length(FsTickerText) = 0 then
  begin
    exit;
  end;
  FTimer.Enabled := false;
  self.Caption := FsTickerText;
  FsTickerText := copy(FsTickerText,2,Length(FsTickerText))+FsTickerText[1];
  FTimer.Enabled := true;
end;

procedure TcsTickerStatic.Start;
begin
  FTimer.Enabled := true;
end;

procedure TcsTickerStatic.Stop;
begin
  FTimer.Enabled := false;
end;

end.