Laufschrift an Panelgröße anpassen

[newuser01]

Hallo

Ich erzeuge in einem Timer diese Laufschrift

Delphi-Quellcode:

sLaufText := lSong.Caption;        //caption übergeben
sTmp := sLaufText[1];             //1.zeichen wird sich gemerkt
delete(sLaufText, 1, 1);         //1.zeichen wird anschließend gelöscht
sLaufText := sLaufText + sTmp;  //caption + gemerktes zeichen wird sLaufText übergeben
labelID3.Caption := sLaufText; //sLaufText wieder an caption übergeben

Nun ist aber das label auf einem Panel mit der größe Height := 97 und Width := 416 bei dem label selber ist AutoSize auf false und die größe des labels entspricht der große des Panels. Wenn jetzt aber das Label (lSong.Caption) zb: nur wenige Zeichen enthält und diese geringer in der gesamtlänge als das Panel insgesamt lang ist, dann fängt die Laufschrift ja nicht genau rechts am ende vom Panel an, sondern schon weiter links je nachdem wieviel Zeichen das Label übergeben wurden. Ich möchte aber erreichen das die Laufschrift immer rechts am ende vom Panel beginnt egal ob das label ein Wort enthält was vielleicht nur zwei Buchstaben (zeichen) besitzt. Wie könnte ich das realisieren ?

[mkinzler]

Den String anfänglich links mit entsprechender Anzahl von Leerzeichen auffüllen

[Neutral General]

machs mit Canvas.Textout damit sollte es noch genauer gehn

[newuser01]

vielleicht so

Delphi-Quellcode:

while Length(sLauftext) < Panel.Width do
begin
sLauftext := ' ' + sLauftext;
end;

Problem wäre nur das die Schleife ja im Timer ständig wiederholt wird geht also auch nicht :gruebel:

[Sunlight7]

Das ginge schon, wenn Du Dir die Leerzeichen und die Breite des Panels änderst, dann muß die Schleife nur noch ausgeführt werden, wenn sich die Breite ändert.

Ich hab mir mal eine Komponente geschrieben, die sowas kann, hab da auf das Canvas gezeichnet und x immer um 1 reduziert.

[newuser01]

Sunlight hättest du vielleicht ein kleines Beispiel ich weiß diesbezüglich echt nich weiter :( mein Kopf Qualmt :mrgreen:

[Sunlight7]

Nicht zu kompliziert denken, das geht ganz einfach:

Delphi-Quellcode:

const MyText='Ich wandere von rechts nach links ;-)';
      StepWidth=1;
var x:Integer;
    TextWidth:Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
   x:=ClientWidth;
   TextWidth:=Canvas.TextWidth(MyText)
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Dec(x, StepWidth);
   Refresh;
   Canvas.TextOut(x, 0, MyText);
   If x<-TextWidth then x:=ClientWidth;
end;

Natürlich empfielt es sich, das Zeichnen zu optimieren, zB. zuerst auf ein Bitmap, damit es nicht flimmert. :???:

[newuser01]

Hallo Sunlight dein Beispiel funktioniert sehr gut und ich dacke dir dafür. Die Laufschrift fängt jetzt rechts an der PaintBox an und sobald diese links durchgelaufen ist beginnt sie wieder genau rechts am Anfang der Paintbox. Soweit so gut jetzt möchte ich aber wie schon oben im Code beschrieben das die Laufschrift sobald sie zum Teil links verschwindet das rechts Nachschub kommt so wie es oben in dem Code geschieht. Kannst du mir dabei noch weiterhelfen ?

[Namenloser]

Delphi-Quellcode:

const MyText='Ich wandere von rechts nach links ;-)';
      StepWidth=1;
var x:Integer;
    TextWidth:Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
   x:=ClientWidth;
   TextWidth:=Canvas.TextWidth(MyText)
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Dec(x, StepWidth);
   Refresh;
   Canvas.TextOut(x, 0, MyText);
   Canvas.TextOut(clientwidth+x, 0, MyText);
   If x<-clientwidth-textwidth-textwidth then x:=ClientWidth;
end;

Müsste gehen...
edit: doch nicht :/

[newuser01]

Geht fast der erste Durchlauf funktioniert aber ab dem zweiten Durchlauf bleibt der kommende text von rechts in der Mitte stehn und es kommt wieder neuer Text von rechts und der zuvor stehengebliebene verschwindet wieder u.s.w auch kein schlechter efekt :-D wir kommen der Sache langsam auf der Spur :mrgreen:

[Namenloser]

Delphi-Quellcode:

const MyText='Ich wandere von rechts nach links ;-)  ';
      StepWidth=2;
var x,x2:Integer;
    TextWidth:Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
   x:=ClientWidth;
   x2:=clientwidth+clientwidth;  //Edit: sieht besser aus, weil der text dann von rechts startet
   TextWidth:=Canvas.TextWidth(MyText)
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Dec(x, StepWidth);
   Dec(x2, StepWidth);
   Refresh;
   Canvas.TextOut(x, 0, MyText);
   Canvas.TextOut(x2, 0, MyText);
   If x<0 then x2:=ClientWidth+x;
   If x2<0 then x:=ClientWidth+x2;
end;

funzt :-D
(eleganter gings nicht...)

[newuser01]

Ja funzt :-D aber sind die Bindestriche zwischen den kommenden Text beabsichtigt oder ein Efekt ? :-D

[Namenloser]

Welche Bindestriche? o.O
bei mir sind da keine...

[newuser01]

Hat sich erledigt wenn man Step auf 1 setzt ist der Bindestrichefekt weg :-D hatte vorher Step auf 2 und Timer-interval auf 50 da kam dieser Efekt

[newuser01]

und noch vielen DANK an allen beteiligten für die wieder mal schnelle Hilfe !!! TOP

[Namenloser]

Kanns sein, dass du das Refresh rausgenommen hast?

[newuser01]

Ich hab es jetzt so im OnCreate und im Timer

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
 x1 := PaintBox.Width;
 x2 := PaintBox.Width + PaintBox.Width;
 TextWidth:= PaintBox.Canvas.TextWidth(sLaufSchrift);
end;

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
var
begin
Dec(x1, StepWidth);
Dec(x2, StepWidth);
Refresh;
PaintBox.Canvas.TextOut(x1, 0, sLaufSchrift);
PaintBox.Canvas.TextOut(x2, 0, sLaufSchrift);
if x1 < 0 then x2 := PaintBox.Width + x1;
if x2 < 0 then x1 := PaintBox.Width + x2;
end;

Ich hab allerdings festgestellt der sogenannte Bindestrichefekt :-D ist kein Bindestrich sondern immer das letzte Zeichen von sLaufSchrift was warum auch immer weiter gezeichnet wird egal ob Step 1 oder 2 u.s.w ist bekomm ich auch nicht weg :mrgreen: außer ich ersetze "Refresh" durch "PaintBox.Refresh" dann geht es, flackert aber dann nur unschön rum :-D

[newuser01]

Ich habe das Problem erstmal gelöst in dem ich dem Text der in "sLaufSchrift" steht ein Leerzeichen angehangen habe. Zumindest wird jetzt nicht immer der letzte Buchstabe weiter gezeichnet :mrgreen:

Delphi-Quellcode:

var
sLaufSchrift:String;

sLaufSchrift := sArtist + '-' + sTitle + ' ';

Ich sollte vielleicht noch erwähnen das "sLaufSchrift" nicht als const-variable Deklariert ist sondern normal als globale Stringvariable

[Namenloser]

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
var buffer: TBitmap;
begin
  buffer := TBitmap.Create;
  buffer.width := paintbox.width;
  buffer.height := paintbox.height;
  Dec(x1, StepWidth);
  Dec(x2, StepWidth);
  buffer.Canvas.TextOut(x1, 0, sLaufSchrift);
  buffer.Canvas.TextOut(x2, 0, sLaufSchrift);
  if x1 < 0 then x2 := PaintBox.Width + x1;
  if x2 < 0 then x1 := PaintBox.Width + x2;
  bitblt(paintbox.canvas.handle,0,0,paintbox.width,paintbox.height,buffer.canvas.handle,0,0,srccopy);
  buffer.free;
end;

die hintergrundfarbe lässt sich ja mit FillRect und brush.color einstellen.

Wäre etwas besser als die Methode mit dem Leerzeichen am Ende. Außerdem würd ich mir überlegen, eine Klasse oder einen record für dier Laufschrift anzulegen.

So in der Art:

Delphi-Quellcode:

TLaufschrift = record
  x1,x2: integer;
  stepwidth: integer;
  sLaufschrift: string:
end;

[...]

var
Laufschrift: Tlaufschrift;

etc...

[newuser01]

DANKE ! funktioniert

[Sunlight7]

Zitat:

Zitat von Sunlight7

Natürlich empfielt es sich, das Zeichnen zu optimieren, zB. zuerst auf ein Bitmap, damit es nicht flimmert. :???:

Dann bist Du sicher, das nix flimmert und keine Streifen überbleiben, falls zB. der Nutzer eine andere Standardschrift(art/größe) hat.

[Sunlight7]

Zitat:

Zitat von NamenLozer

(eleganter gings nicht...)

Es geht schon :zwinker:

Damit kann der Text mehrfach nebeneinander angezeigt werden:

Delphi-Quellcode:

const MyText='Ich wandere von rechts nach links ;-)  ';
      StepWidth=2;
      Space=10;
var x:Integer;
    TextWidth:Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
   x:=ClientWidth;
   TextWidth:=Canvas.TextWidth(MyText);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
   var temp:Integer;
begin
   Dec(x, StepWidth);
   Refresh;
   temp:=x;
   While temp<ClientWidth do begin
      Canvas.TextOut(temp, 0, MyText);
      Inc(temp, TextWidth+Space);
   end;
   If x<-TextWidth+Space then Inc(x, TextWidth+Space);
end;

:???:

[newuser01]

Delphi-Quellcode:

//funktioniert sehr gut nur nicht mit Buffer.Canvas.TextOut(temp, 0, sLaufSchrift);
while temp < PaintBox.Width do
begin
PaintBox.Canvas.TextOut(temp, 0, sLaufSchrift);
Inc(temp, TextWidth + Space);
end;

if x1 <- TextWidth + Space then Inc(x1, TextWidth + Space);

[newuser01]

Delphi-Quellcode:

//jetzt funktioniert es  :-D 
while temp < PaintBox.Width do
begin
PaintBox.Canvas.TextOut(temp, 0, sLaufSchrift);
Inc(temp, TextWidth + Space);
end;

bitblt(PaintBox.Canvas.Handle,1,1,PaintBox.Width,PaintBox.Height,Buffer.Canvas.Handle,0,0,Srccopy);

if x1 <- TextWidth + Space then Inc(x1, TextWidth + Space);

[Namenloser]

Hmm, aber bei einem größeren zwischenraum (Space = 100) funktioniert das nicht mehr ganz richtig. Der linke text verschwindet schon, bevor er ganz durchgelaufen ist.

[Sunlight7]

Zitat:

Zitat von NamenLozer

Hmm, aber bei einem größeren zwischenraum (Space = 100) funktioniert das nicht mehr ganz richtig. Der linke text verschwindet schon, bevor er ganz durchgelaufen ist.

Das kommt davon, wenn man Code voher net ausprobiert, bzw. sieht man dann die "Macht" von () :mrgreen:

Lösung:

Delphi-Quellcode:

If x<-(TextWidth+Space) then Inc(x, TextWidth+Space);

Habs probiert, es läuft durch!