Бегущая строка

← →
Dead.MorozZ (2006-01-21 22:03) [0]

У меня такая ситуация строка полностью не влазет в метку, поэтому решил сделать ее бегущей.
Как можно сделать бегущую строку по типу как в WinAmp"e. Чтоб после того, как последняя часть строки выползла процесс пошел в другую сторону(строка побежала обратно) а добежав до другого конца снова поворачивала и т.д. ...
Только, чтоб это обязательно происходило в Лейбле

← →
Кефир87 © (2006-01-21 23:02) [1]

В моем винампе 2,91 строка просто цикоическая. Там все просто:
Сохраняем первый знак в C
Удаляем первый знак
Ставим в конец строки C

если пораскинуть мозгой, то все получится 8)

← →
з. танька (2006-01-21 23:04) [2]

плюхаешь на форму таймер, в обработчике OnTimer пишеш:
label1.Caption := Copy(Label1.Caption, 2, MAXINT) + Copy(Label1.Caption, 1, 1);

← →
Dead.MorozZ (2006-01-21 23:07) [3]

Это я сам умею не могу придумать как сделать чтоб строка когда уже полностью вылезла ползла обратно, т.е. сначала как ты сказал, а когда вылезет послндний символ от первоначальной строки удалялся первый символ а вместо него вставлялся последний

← →
RunningString (2006-01-22 19:39) [4]

VAR I:WORD; procedure TForm1.Timer1Timer(Sender: TObject); begin IF I>2*Length(Label1.Caption) THEN I:=0; IF (I>Length(Label1.Caption)) {AND (I<Length(Label1.Caption))} THEN BEGIN label1.Caption := Copy(Label1.Caption, 2, Length(Label1.Caption)-1) + Copy(Label1.Caption, 1, 1); I:=I+1; END ELSE BEGIN label1.Caption := Copy(Label1.Caption, Length(Label1.Caption), 1)+Copy(Label1.Caption, 1, Length(Label1.Caption)-1); I:=I+1; END; end; procedure TForm1.FormCreate(Sender: TObject); begin I:=0; Label1.Caption:="12345 "; Timer1.Interval:=1000; end;

← →
RunningString (2006-01-22 19:56) [5]

Corrected:
VAR I:WORD; procedure TForm1.Timer1Timer(Sender: TObject); begin IF I>2*Length(Label1.Caption)-1 THEN I:=0; IF (I>=Length(Label1.Caption)) THEN label1.Caption := Copy(Label1.Caption, 2, Length(Label1.Caption)-1) + Copy(Label1.Caption, 1, 1) ELSE label1.Caption := Copy(Label1.Caption, Length(Label1.Caption), 1)+Copy(Label1.Caption, 1, Length(Label1.Caption)-1); I:=I+1; end; procedure TForm1.FormCreate(Sender: TObject); begin I:=0; Label1.Caption:="Test "; Timer1.Interval:=500; end;

← →
Dead.MorozZ (2006-01-22 20:39) [6]

Большой Сенкс!!!

← →
Dead.MorozZ (2006-01-22 21:18) [7]

А как сделать так что:
если в видимой части Метки еще есть место для символов забивать это место пробелами, а потом наоборот убирать пробелы так чтобы получился эффект перемещения строки от одного края Метки к другому??

← →
Dead.MorozZ (2006-01-22 21:40) [8]

ЗЫ: Первая прога работала лучше:)

← →
RunningString (2006-01-22 22:37) [9]

procedure TForm1.Timer1Timer(Sender: TObject); begin IF I>P*2-1 then i:=0; IF I<p THEN label1.Caption := Copy(Label1.Caption, Length(Label1.Caption), 1)+Copy(Label1.Caption, 1, Length(Label1.Caption)-1) ELSE label1.Caption := Copy(Label1.Caption, 2, Length(Label1.Caption)-1) + Copy(Label1.Caption, 1, 1); I:=I+1; end; procedure TForm1.FormCreate(Sender: TObject); begin I:=0; Label1.Caption:="Test "; IF pos(" ",Label1.Caption)=0 THEN Label1.Caption:=Label1.Caption+" "; P:=Length(Label1.Caption)+1-pos(" ",Label1.Caption); Timer1.Interval:=500; end;

← →
Dead.MorozZ (2006-01-22 23:14) [10]

Что здесь означает р и где указывается длина метки??
И еще как на Паскале написать
если длина строки (Label1.Caption) больше 10 символов то..... ?????

← →
RunningString (2006-01-23 00:09) [11]

p-это кол-во пробелов в конце строки.

Corrected:
VAR I,P:WORD; procedure TForm1.Timer1Timer(Sender: TObject); begin IF I>P*2-1 then i:=0; IF I<p THEN label1.Caption := Copy(Label1.Caption, Length(Label1.Caption), 1)+Copy(Label1.Caption, 1, Length(Label1.Caption)-1) ELSE label1.Caption := Copy(Label1.Caption, 2, Length(Label1.Caption)-1) + Copy(Label1.Caption, 1, 1); I:=I+1; end; procedure TForm1.FormCreate(Sender: TObject); begin Label1.Caption:="1 2 3 4 5 "; FOR i:=Length(Label1.Caption) DOWNTO 1 DO IF Label1.Caption[i]<>" " THEN BEGIN P:=Length(Label1.Caption)-i; BREAK; END; Timer1.Interval:=100; I:=0; end;

>И еще как на Паскале написать
>если длина строки (Label1.Caption) больше 10 символов то.

IF Length(Label1.Caption) > 10 THEN BEEP;

← →
Dead.MorozZ (2006-01-23 01:20) [12]

> procedure TForm1.Timer1Timer(Sender: TObject);
> begin
> IF I>2*Length(Label1.Caption)-1 THEN I:=0;
> IF (I>=Length(Label1.Caption)) THEN
> label1.Caption := Copy(Label1.Caption, 2, Length(Label1.
> Caption)-1) + Copy(Label1.Caption, 1, 1)
> ELSE
> label1.Caption := Copy(Label1.Caption, Length(Label1.
> Caption), 1)+Copy(Label1.Caption, 1, Length(Label1.Caption)-
> 1);
> I:=I+1;
> end;
>
> procedure TForm1.FormCreate(Sender: TObject);
> begin
> I:=0;
> Label1.Caption:="Test ";
> Timer1.Interval:=500;
> end;

тут еще один баг:
если кепшон присвоить 123 то результаты после каждого интервала Таймера:
123
312
231
123
312
123<<<<сдесь упускается 231

и лучше бы выглядело еслиб строка бежала вперед т.е:
123
231
312
123
312
231
помоги PlzZ

← →
RunningString (2006-01-23 02:11) [13]

Так ?

VAR I:WORD;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
IF I<Length(Label1.Caption) THEN
label1.Caption := Copy(Label1.Caption, 2, Length(Label1.Caption)-0) + Copy(Label1.Caption, 1, 1)
ELSE IF I>=Length(Label1.Caption) THEN
label1.Caption := Copy(Label1.Caption, Length(Label1.Caption), 1)+Copy(Label1.Caption, 1, Length(Label1.Caption)-1);
I:=I+1;
IF I>=2*Length(Label1.Caption) THEN I:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Caption:="123";
I:=0;
Timer1.Interval:=1000;
end;

← →
Dead.MorozZ (2006-01-23 11:52) [14]

А как удалить из строки последние 4 символа??
(навсегда удалить:)

← →
Dead.MorozZ (2006-01-23 13:07) [15]

Как написать на Паскале:
Если длина строки, присваиваемой Label1.Caption < 10,
то дополнять эту строку пробелами до тех пор пока ее длина строки не станет = 10 ???

На, не жалко. Как в пакет собрать, надеюсь, разберёшься.
unit ScrLabel; interface uses Windows, Classes, Controls, StdCtrls; {$R TSCROLLABLELABEL.DCR} type TCustomScrollableLabel=class(TLabel) private fCaptureX: Integer; fOffset: Integer; fScrolling: Boolean; protected procedure SetOffset(Value: Integer); virtual; procedure DoDrawText(var Rect: TRect; Flags: Longint); override; procedure DblClick; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public constructor Create(AOwner: TComponent); override; property Offset: Integer read fOffset write SetOffset; property Scrolling: Boolean read fScrolling; end; TScrollableLabel=class(TCustomScrollableLabel); procedure Register; implementation procedure Register; begin RegisterComponents("Additional", [TScrollableLabel]); end; { TCustomScrollableLabel } constructor TCustomScrollableLabel.Create(AOwner: TComponent); begin inherited; fOffset:=0; fScrolling:=False; end; procedure TCustomScrollableLabel.DblClick; begin inherited; Offset:=0; end; procedure TCustomScrollableLabel.DoDrawText(var Rect: TRect; Flags: Integer); begin Rect.Left:=Rect.Left+fOffset; inherited; end; procedure TCustomScrollableLabel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; fScrolling:=Button=mbLeft; fCaptureX:=X-Offset; end; procedure TCustomScrollableLabel.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; if not fScrolling then Exit; Offset:=X-fCaptureX; end; procedure TCustomScrollableLabel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin fScrolling:=False; inherited; end; procedure TCustomScrollableLabel.SetOffset(Value: Integer); var CanvasLeft, CanvasWidth, CaptionLeft, CaptionWidth: Integer; begin if Value=fOffset then Exit; with Canvas do begin CanvasLeft:=ClipRect.Left; CanvasWidth:=ClipRect.Right-CanvasLeft; CaptionWidth:=TextWidth(Caption); end; case Alignment of taRightJustify: CaptionLeft:=(CanvasWidth-CanvasLeft)-CaptionWidth; taCenter: CaptionLeft:=((CanvasWidth-CanvasLeft)-CaptionWidth) div 2; else CaptionLeft:=CanvasLeft; end; if Value<(CanvasLeft+CanvasWidth)-(CaptionLeft+CaptionWidth) then Value:=(CanvasLeft+CanvasWidth)-(CaptionLeft+CaptionWidth); if Value>CanvasLeft-CaptionLeft then Value:=CanvasLeft-CaptionLeft; fOffset:=Value; Repaint; end; end.

← →
Dead.MorozZ (2006-01-23 14:34) [17]

Зачем мне целый компонент???
Мне все казалось гораздо проще:)
В цикле прибавлять к строке (если она меньше 10) пробелы до тех пор пока она не станет равной 10:)

Я просто с Паскалем не очень, а нам надо проект скоро сдавать на Делфи.
Помогите PlzZ

← →
RunningString (2006-01-23 15:42) [18]

>А как удалить из строки последние 4 символа??
>(навсегда удалить:)

procedure TForm1.FormCreate(Sender: TObject); VAR s:string; begin s:="12345678901234"; DELETE(s,Length(s)-3,4); Caption:=s; end;

>Как написать на Паскале:
>Если длина строки, присваиваемой Label1.Caption < 10,
>то дополнять эту строку пробелами до тех пор пока ее длина строки не станет = 10 ???

procedure TForm1.FormCreate(Sender: TObject); VAR s:string; begin s:="1234"; WHILE Length(s)<10 DO s:=s+" "; Caption:=s+" "+inttostr(Length(s)); end;

А если размер фонта поменялся, тогда что?

← →
Dead.MorozZ (2006-01-24 14:12) [20]

> procedure TForm1.FormCreate(Sender: TObject);
> VAR s:string;
> begin
> s:="1234";
> WHILE Length(s)<10 DO s:=s+" ";
> Caption:=s+" "+inttostr(Length(s));
> end;

> VAR I:WORD;
>
> procedure TForm1.Timer1Timer(Sender: TObject);
> begin
> IF I<Length(Label1.Caption) THEN
> label1.Caption := Copy(Label1.Caption, 2, Length(Label1.
> Caption)-0) + Copy(Label1.Caption, 1, 1)
> ELSE IF I>=Length(Label1.Caption) THEN
> label1.Caption := Copy(Label1.Caption, Length(Label1.Caption),
> 1)+Copy(Label1.Caption, 1, Length(Label1.Caption)-1);
> I:=I+1;
> IF I>=2*Length(Label1.Caption) THEN I:=0;
> end;
>
> procedure TForm1.FormCreate(Sender: TObject);
> begin
> Label1.Caption:="123";
> I:=0;
> Timer1.Interval:=1000;
> end;

Как можно объеденить два куска программы в одно:
Сначала забить до конца строки пробелами а потом
Перемещать? А то когда я их объединял получилось совсем не то что я ожидал:) Помогите PlzZ

>Dead.MorozZ
>Мне все казалось гораздо проще:)
>В цикле прибавлять к строке (если она меньше 10) пробелы до тех пор >пока она не станет равной 10:)

uses StrUtils; procedure TForm1.FormCreate(Sender: TObject); var s:string; begin s:="1234"; Caption:=s+DupeString(" ",10-length(s)); end;

Бегущая строка Найти похожие ветки