| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Бегущая строка.
JetAPI © (2007-08-09 17:00:00)Хочу попробовать написать код для "бегущей строки".
Начал подыскивать компонент, с помощью которого это можно сделать, но подобрать нужный не могу.
Подскажите: какой стандартный компонент лучше всего подойдет для выполнения этой задачи?
Спасибо.
зы: В поиске ничего не нашёл; сейчас еще буду искать.
tmp (2007-08-12 03:19:00) [21]
> Германн © (12.08.07 03:00) [31]
> Неметчиной повеяло :)
:-) А чего мудрить с придумыванием имён на англицком, если проще применять то, что думается автоматом.
{RASkov} (2007-08-12 03:09:00) [22]Вот мой вариант:
Форма, на ней ПаинтБокс, Таймер и кнопка...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Button1: TButton;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
R: TRect;
Wdt: Integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
//Скролируемый текст
const STR = 'Tag:=(Tag mod (PaintBox1.Width+Wdt))+1; R.Left:=PaintBox1.Width-Tag; R.Right:=R.Left+Wdt; PaintBox1.Invalidate;';
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
* BorderStyle:=bsDialog;
* SetBounds((Screen.Width div 2) - 100, (Screen.Height div 2) - 75, 200, 100);
* PaintBox1.SetBounds(8, 8, ClientWidth-16, 22);
* Button1.SetBounds(64, 36, 65, 25);
* Button1.Caption:='Start';
* Timer1.Interval:=15;
DoubleBuffered:=True;
R:=PaintBox1.ClientRect;
Wdt:=PaintBox1.Canvas.TextWidth(STR);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Tag:=ORD(not Boolean(Button1.Tag));
Timer1.Enabled:=Boolean(Button1.Tag);
if Timer1.Enabled then Button1.Caption:='Stop' else Button1.Caption:='Start';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Tag:=(Tag mod (PaintBox1.Width+Wdt)) +1; //Так же скорость можно менять и здесь
R.Left:=PaintBox1.Width-Tag; R.Right:=R.Left+Wdt;
PaintBox1.Invalidate;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
DrawText(PaintBox1.Canvas.Handle, STR, -1, R, 0);
end;
end.
* - можно в ИО выставить
> [31] Германн © (12.08.07 03:00)
> Неметчиной
Что это значит? :)
Германн (2007-08-12 03:00:00) [23]Неметчиной повеяло :)
tmp (2007-08-12 02:24:00) [24]
> JetAPI © (09.08.07 17:51) [3]
> А StatusBar может для этого подойти?..
> Сейчас читаю про него... Или что-то может быть лучше?
> TLabel, хотел вначале попробывать, но в сторонних источниках
> пишут что он не очень подходит. А про то что подходит, не
> упоминается...
> Буду, конечно искать...
> Но если кто-сталкивался ранее, с созданием "бегущей сстроки",
> может на мысль навести.
> Очень хотель бы самому сделать... Практика хорошая...
Лишь бы Canvas был и можно сделать всё, что приснится.
На форму, разумеется, поместить TLabel и TTimer.
Label1.Width должен быть меньше или равен ширине текста, а Label1.AutoSize должен быть = False. Timer1.Interval - по вкусу.
Удачи.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
AusgabeText: String;
AusgabePosition: Integer;
BmpText: TBitmap;
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
with Label1 do
begin
AusgabeText := Caption;
AusgabePosition := Width;
Caption := '';
end;
BmpText := TBitmap.Create;
with BmpText do
begin
Height := Label1.Height;
Canvas.Font.Assign(Label1.Font);
Canvas.Brush.Color := Label1.Color;
Width := Canvas.TextWidth(AusgabeText) + 20;
Canvas.TextOut(0,0,AusgabeText);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
const
AusgabePosition2: Integer = 0;
begin
if AusgabePosition2 + BmpText.Width < Label1.Width then
AusgabePosition := AusgabePosition2;
AusgabePosition2 := AusgabePosition + BmpText.Width;
with Label1 do
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ClientRect);
Canvas.Draw(AusgabePosition,0,BmpText);
Canvas.Draw(AusgabePosition2,0,BmpText);
end;
AusgabePosition := AusgabePosition - 1;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
BmpText.Free;
end;
end.
Anatoly Podgoretsky (2007-08-11 15:42:00) [25]> Двигатель внешнего сгорания (11.08.2007 14:53:28) [28]
Смотри пластилиновая ворона.
Двигатель внешнего сгорания (2007-08-11 14:53:00) [26]
> Метлы в руки !!!
Для тупых можно подробнее?
MsGuns (2007-08-10 23:35:00) [27]>novill © (10.08.07 15:36) [25]
>Sonic90 (10.08.07 23:05) [26]
Метлы в руки !!!
Sonic90 (2007-08-10 23:05:00) [28]procedure TForm1.Timer1Timer(Sender: TObject);
var
s:String;
begin
s:=Label1.Caption;
s:=s+s[1];
delete(s,1,1);
Label1.Caption:=s;
end;
novill (2007-08-10 15:36:00) [29]Я делал так:
1. удвоил выводимую строку
2. выводил ее Textout постепенно уменьшая координату Х, пока не доходил до момента когда копазывался только второй экземпляр.
MsGuns (2007-08-10 15:19:00) [30]Можно. Самый простой пример - по таймеру "отрезать" от строки сколько нужно (или в символах или в пикселях на канве) и перемещать лабел влево или вправо по контейнеру, явно его при этом перерисовывая
Alral (2007-08-10 14:59:00) [31]А TLabel нельзя сделать прозрачной и двигать по горизонтали (или как надо) изменяя Left(или Top)?
MsGuns (2007-08-10 11:04:00) [32]>Германн ©
Не надо давать вредных советов
JetAPI (2007-08-10 10:52:00) [33]Германн
> Уж сколько раз твердили миру, что RxLibrary дана нам всем
> её разработчиками в исходниках!
Я не знал этого... Я про эту библиотеку, вот, только узнал... здесь. На будущее выводы сделал.
{RASkov} (2007-08-10 02:24:00) [34]> [19] Германн © (10.08.07 02:02)
> P.S. "иже с ними". Иначе не понятно что снимать! То ли одёжку, то ли фильму. :-)
Так и знал.... "влетит" :)
Германн (2007-08-10 02:02:00) [35]
> {RASkov} © (10.08.07 01:44) [18]
> ...Но не JEDI и иже сними :)
>
Не знаю, не пробовал, посему "молчу в тряпочку" :)
P.S. " иже с ними". Иначе не понятно что снимать! То ли одёжку, то ли фильму. :-)
{RASkov} (2007-08-10 01:44:00) [36]> [17] Германн © (10.08.07 01:28)
> RxLibrary - один из золотых фондов программистов Дельфи.
+5
...Но не JEDI и иже сними :)
Германн (2007-08-10 01:28:00) [37]
> JetAPI © (09.08.07 23:58) [16]
>
> Германн, скорее всего, мне это не подойдет...
> Я пользую версию Turbo Delphi for Win32 (free), а она, как
> раз, имеет ограничение на подключение стороних компонентов.
>
>
Уж сколько раз твердили миру, что RxLibrary дана нам всем её разработчиками в исходниках! Не хочешь использовать сторонние компоненты или не можешь их использовать, так хоть посмотри исходники сей библиотеки. Найдёшь много всего.
Повторю ещё раз. RxLibrary - один из золотых фондов программистов Дельфи.
JetAPI (2007-08-09 23:58:00) [38]Германн, скорее всего, мне это не подойдет...
Я пользую версию Turbo Delphi for Win32 (free), а она, как раз, имеет ограничение на подключение стороних компонентов.
Так что, TPaintBox ,буду осваивать и постигать.
JetAPI (2007-08-09 23:44:00) [39]$00FF00, даа... Даже трудно что-либо сказать...
Я когда смотрел, единственное о чем подумал, что такой труд, ив консоле написан.
Но во всем этом, алгоритм важен! Когда определюсь: как и что, буду штудировать. Спасибо.
Германн (2007-08-09 21:30:00) [40]
> Хочу попробовать написать код для "бегущей строки".
> Начал подыскивать компонент, с помощью которого это можно
> сделать, но подобрать нужный не могу.
>
TSecretPanel из RxLibrary
| |
Страницы: 