Lauftext von rechts nach links

[Natcree]

Danke

Habe mal versucht ein Procedure draus zu basteln

Funktioniert nur nicht hmmmm Wo ist der fehler???

Delphi-Quellcode:

procedure Laufschrift(Text:string;timer:ttimer;Ausgabe:string);
begin
  a:=Text;
  inc(i);
  if i > length(a)then
  begin
  timer.Enabled:=false;
  exit;
  end;
  Ausgabe:= Ausgabe + a[i];
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
i:=-1;
Timer2.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
Laufschrift('Hallo',timer2,label2.caption);
end;

[baumina]

Die Variable "Ausgabe" kennt die procedure Laufschrift nur lokal, alle Änderungen an der Variable werden nicht zurückgegeben. Zurückgegeben würde sie nur wenn du sie als var definierst (procedure TForm63.Laufschrift(Text:string;timer:ttimer;var Ausgabe:string); ) Allerdings kann man Label.Caption nicht als var-Parameter mitgeben.

Diese ganze Konstruktion ist etwas seltsam.

[DeddyH]

Ungetestet:

Delphi-Quellcode:

procedure Laufschrift(Text:string;timer:ttimer;var Ausgabe:string);
begin
  a:=Text;
  inc(i);
  if i > length(a)then
  begin
    timer.Enabled:=false;
    exit;
  end;
  Ausgabe:= Ausgabe + a[i];
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  i:=-1;
  Timer2.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
  s: string;
begin
  s := label2.caption;
  Laufschrift('Hallo',timer2,s);
  label2.caption := s;
end;

[Natcree]

Danke habe es jetzt so gemacht

Delphi-Quellcode:

procedure TForm1.Laufschrift(Text:string;timer:ttimer;la:Tlabel);
begin
  a:=Text;
  inc(i);
  if i > length(a)then
  begin
  timer.Enabled:=false;
  exit;
  end;
  la.caption:= la.caption + a[i];
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
i:=-1;
Label2.Caption:='';
Timer2.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
Laufschrift('Hallo',timer2,label2);
end;

[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