Label

← →
GeLLeR © (2006-08-11 14:09) [0]

Подскажите пожалуйста как сделать прокрутку Лабеля как в Винампе, или может компонент есть какой...

← →
GeLLeR © (2006-08-11 14:18) [1]

????????

← →
Джо © (2006-08-11 14:21) [2]

Что такое "прокрутка Лабеля как в Винампе"?

← →
GeLLeR © (2006-08-11 14:23) [3]

Ну если название не помещается в лабеле то он прокручивается. Видели как
в программе "Новости" внизу бегущая строка...

← →
PZ (2006-08-11 14:24) [4]

Label - это (стандартно) однострочный компонент. Какая может быть прокрутка ?
Может быть Memo использовать, если уж так нужна прокрутка?

← →
Джо © (2006-08-11 14:26) [5]

> GeLLeR ©

Если не ошибаюсь, такой компонент есть в Jedi VCL. Если нет, поищи на torry.net, там такого добра навалом.

← →
GeLLeR © (2006-08-11 14:26) [6]

НЕПОДОЙДЕТ. видел в какой-то демке каго-то компонента такой лабель
Кстати я не думаю, что в винампе используется MEMO

← →
GeLLeR © (2006-08-11 14:28) [7]

> Джо © (11.08.06 14:26) [5]

Jedi давно пытался скачать... не работал. Попробую ещё раз.

> GeLLeR © (11.08.06 14:26) [6]

было написано пункту 4

← →
novill © (2006-08-11 14:32) [8]

хе, развиваем телепатию, господа )))

вот делать мне было нечего

текст всего модуля, чтобы не было вопросов.

отпимизацией не занимался

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, strutils; type TForm1 = class(TForm) Timer1: TTimer; Label1: TLabel; procedure Timer1Timer(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Timer1Timer(Sender: TObject); begin Label1.Caption:=RightStr(Label1.Hint+Label1.Hint,length(Label1.Hint)*2-Timer1.Tag); Timer1.Tag:= (Timer1.Tag+1) mod length(Label1.Hint); end; procedure TForm1.FormCreate(Sender: TObject); begin Timer1.Interval:=300; Label1.Hint:="Подскажите пожалуйста как сделать прокрутку Лабеля как в Винампе, или может компонент есть какой..."; Label1.AutoSize:=False; end; end.

← →
novill © (2006-08-11 14:41) [9]

можно еще так

procedure TForm1.Timer1Timer(Sender: TObject); begin Label1.Caption:=Rightstr(Label1.Caption,length(Label1.Caption)-1)+Label1.Caption[1]; Timer1.Tag:= (Timer1.Tag+1) mod length(Label1.Caption); end; procedure TForm1.FormCreate(Sender: TObject); begin Timer1.Interval:=300; Label1.Caption:="Подскажите пожалуйста "; Label1.AutoSize:=False; end;

← →
SerJaNT © (2006-08-11 14:53) [10]

на torry.net бегом!

← →
novil (2006-08-11 14:57) [11]

Да, ладно ,дайте фигней пострадать! :)

← →
Джо © (2006-08-11 15:22) [12]

Пострадать, так пострадать :D

TTextScrollPanel = class (TGraphicControl) private FScrolling: Boolean; FCaption: TCaption; FTimer: TTimer; FColor: TColor; FTextPosition: TPoint; procedure SetScrolling(const Value: Boolean); procedure SetFont(const Value: TFont); procedure OnTimer (Sender: TObject); function GetFont: TFont; protected procedure Paint; override; public constructor Create(AOwner: TComponent); override; published property Scrolling: Boolean read FScrolling write SetScrolling; property Caption: TCaption read FCaption write FCaption; property Font: TFont read GetFont write SetFont; property Color: TColor read FColor write FColor default clBtnFace; end; implementation constructor TTextScrollPanel.Create(AOwner: TComponent); begin inherited; Width := 150; Height := 30; FTimer := TTimer.Create(Self); FTimer.Interval := 50; FTimer.OnTimer := OnTimer; FTextPosition.X := 0; FColor := clBtnFace; end; function TTextScrollPanel.GetFont: TFont; begin Result := Canvas.Font; end; procedure TTextScrollPanel.OnTimer(Sender: TObject); begin FTextPosition.X := FTextPosition.X - 3; if Canvas.TextWidth(FCaption) + FTextPosition.X <= 0 then FTextPosition.X := ClientWidth; Repaint; end; procedure TTextScrollPanel.Paint; begin with Canvas do begin Brush.Style := bsSolid; Brush.Color := FColor; FillRect (ClientRect); Brush.Style := bsClear; FTextPosition.Y := (Height div 2) - (Canvas.TextHeight("Wq") div 2); TextOut(FTextPosition.X,FTextPosition.Y,FCaption); end; end; procedure TTextScrollPanel.SetFont(const Value: TFont); begin Canvas.Font.Assign(Value); end; procedure TTextScrollPanel.SetScrolling(const Value: Boolean); begin FScrolling := Value; FTimer.Enabled := Value; end;

Используем:

procedure TForm1.Button1Click(Sender: TObject); var ScrollPanel: TTextScrollPanel; begin ScrollPanel := TTextScrollPanel.Create(Self); ScrollPanel.Parent := Self; ScrollPanel.Font.Name := "Arial"; ScrollPanel.Font.Size := 12; ScrollPanel.Font.Color := clGreen; ScrollPanel.Color := clBlack; ScrollPanel.Caption := "Это такая очень длинная строка"; ScrollPanel.Scrolling := True; end;

:)

← →
novill © (2006-08-11 15:33) [13]

> [12] Джо

Снимаю шляпу :)))

← →
GeLLeR © (2006-08-11 19:44) [14]

> Джо © (11.08.06 15:22) [12]

Надоже ьыло так извратиться!!!! но всёравно пасибо.
> novill © (11.08.06 14:32) [8]

Тебе тоже АГРОМНОЕ ПАСИБО

← →
Джо © (2006-08-11 19:45) [15]

> [14] GeLLeR © (11.08.06 19:44)
>
> > Джо © (11.08.06 15:22) [12]
>
> Надоже ьыло так извратиться!!!! но всёравно пасибо.

А что тут "извращенного"?

← →
GeLLeR © (2006-08-11 19:47) [16]

Как-то длинновато.

← →
Джо © (2006-08-11 19:48) [17]

> [16] GeLLeR © (11.08.06 19:47)
> Как-то длинновато.

Ты просил "компонент". Я тебе написал компонент.

← →
GeLLeR © (2006-08-11 19:49) [18]

> Пострадать, так пострадать :D

Сами подтвердили кстати :)))

← →
GeLLeR © (2006-08-11 19:49) [19]

Всё. Ладно. Принято.

← →
Джо © (2006-08-11 19:50) [20]

> [16] GeLLeR © (11.08.06 19:47)
> Как-то длинновато.

"Длинновато" — это от 1000 строк на простую задачу. Я бы не стал тратить свое время на халявное написание 1000 ненужных мне строк кода.

Проехали...

FTimer: TTimer;

У меня почемуто в этой строку ошибка: Undeclared indefeniter.

Прописал в uses дофига всего но не помогло...

> У меня почемуто в этой строку ошибка: Undeclared indefeniter.
>
> Прописал в uses дофига всего но не помогло...

Ставим курсор на слове TTimer и жмем F1. Там написано юнита.

> Там написано юнита.

Там написано имя юнита.

Спасибычки

Дико извиняюсь за наглость но иногда мерцает. Это из-за таймера? может оптимизировать как...

← →
Мефисто (2006-08-11 20:51) [28]

DoubleBufered := true на ком лежит компонент.

пасибо
(в какй раз уже говорю )))

Label Найти похожие ветки