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

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

Label [D7, XP]

Страницы:   < 1 2 >

GeLLeR ©   (2006-08-11 14:09:00) 

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

---

GeLLeR   (2006-08-11 20:53:00) [1]

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

---

Мефисто   (2006-08-11 20:51:00) [2]

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

---

GeLLeR   (2006-08-11 20:48:00) [3]

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

---

GeLLeR   (2006-08-11 20:08:00) [4]

Спасибычки

---

Джо   (2006-08-11 20:05:00) [5]

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

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

---

Джо   (2006-08-11 20:04:00) [6]

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

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

---

GeLLeR   (2006-08-11 20:01:00) [7]

FTimer: TTimer;

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

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

---

Джо   (2006-08-11 19:53:00) [8]

> [21] GeLLeR ©   (11.08.06 19:50)
> Проехали...

Вы чрезвычайно добры, спасибо.

---

GeLLeR   (2006-08-11 19:50:00) [9]

Проехали...

---

Джо   (2006-08-11 19:50:00) [10]

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

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

---

GeLLeR   (2006-08-11 19:49:00) [11]

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

---

GeLLeR   (2006-08-11 19:49:00) [12]

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

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

---

Джо   (2006-08-11 19:48:00) [13]

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

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

---

GeLLeR   (2006-08-11 19:47:00) [14]

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

---

Джо   (2006-08-11 19:45:00) [15]

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

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

---

GeLLeR   (2006-08-11 19:44:00) [16]

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

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

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

---

novill   (2006-08-11 15:33:00) [17]

> [12] Джо


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

---

Джо   (2006-08-11 15:22:00) [18]

Пострадать, так пострадать :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;


:)

---

novil   (2006-08-11 14:57:00) [19]

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

---

SerJaNT   (2006-08-11 14:53:00) [20]

на torry.net бегом!

---

Страницы:   < 1 2 >

Наверх