Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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


Страницы:   1 2

Dead.MorozZ ©   (2006-01-21 22:03:00) 

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

Shirson   (2006-01-24 14:52:00) [1]

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

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

Dead.MorozZ   (2006-01-24 14:12:00) [2]


> 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

Ega23   (2006-01-23 15:51:00) [3]

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

RunningString   (2006-01-23 15:42:00) [4]

>А как удалить из строки последние 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-23 14:34:00) [5]

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

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

Ega23   (2006-01-23 13:27:00) [6]

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

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 13:07:00) [7]

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

Dead.MorozZ   (2006-01-23 11:52:00) [8]

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

RunningString   (2006-01-23 02:11:00) [9]

Так ?

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 01:20:00) [10]


> 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 00:09:00) [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-22 23:14:00) [12]

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

RunningString   (2006-01-22 22:37:00) [13]


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 21:40:00) [14]

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

Dead.MorozZ   (2006-01-22 21:18:00) [15]

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

Dead.MorozZ   (2006-01-22 20:39:00) [16]

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

RunningString   (2006-01-22 19:56:00) [17]

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;

RunningString   (2006-01-22 19:39:00) [18]


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;

Dead.MorozZ   (2006-01-21 23:07:00) [19]

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

з. танька   (2006-01-21 23:04:00) [20]

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

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо