Текущий архив: 2006.02.12;
Скачать: CL | DM;

Вниз

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

← →
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 ???

---

← →
Ega23 ©   (2006-01-23 13:27) [16]

На, не жалко. Как в пакет собрать, надеюсь, разберёшься.

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;


---

← →
Ega23 ©   (2006-01-23 15:51) [19]

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

---

← →
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

---

← →
Shirson ©   (2006-01-24 14:52) [21]

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

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

---

Страницы: 1 вся ветка

Текущий архив: 2006.02.12;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.039 c