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

← →
JetAPI © (2007-08-09 17:00) [0]

Хочу попробовать написать код для "бегущей строки".
Начал подыскивать компонент, с помощью которого это можно сделать, но подобрать нужный не могу.
Подскажите: какой стандартный компонент лучше всего подойдет для выполнения этой задачи?
Спасибо.

зы: В поиске ничего не нашёл; сейчас еще буду искать.

← →
Сергей М. © (2007-08-09 17:01) [1]

> Хочу попробовать написать код для "бегущей строки".

Хотеть не вредно)

> Начал подыскивать компонент, с помощью которого это можно
> сделать

Что-то как-то не стыкуется "хлочу написать .. код" и "ищу готовый код")

← →
vegarulez © (2007-08-09 17:24) [2]

Сергей М. © (09.08.07 17:01) [1] - )))

JetAPI © (09.08.07 17:00)

TLabel :)

← →
JetAPI © (2007-08-09 17:51) [3]

А StatusBar может для этого подойти?..
Сейчас читаю про него... Или что-то может быть лучше?
TLabel, хотел вначале попробывать, но в сторонних источниках пишут что он не очень подходит. А про то что подходит, не упоминается...
Буду, конечно искать...
Но если кто-сталкивался ранее, с созданием "бегущей сстроки", может на мысль навести.
Очень хотель бы самому сделать... Практика хорошая...

← →
{RASkov} © (2007-08-09 18:25) [4]

> [3] JetAPI © (09.08.07 17:51)

Оптимальный вариант - TPaintBox
TLabel и TPaintBox - они "похожи", у них общий предок....

← →
$00FF00 © (2007-08-09 18:27) [5]

Хм. А если по таймеру менять текст лабела, проставляя самые левые бкувы в конец? По-моему довольно просто. Пример надо?

← →
trubin © (2007-08-09 18:30) [6]

> Хм. А если по таймеру менять текст лабела, проставляя самые
> левые бкувы в конец? По-моему довольно просто. Пример надо?
>

плавного движения строки не получится

← →
$00FF00 © (2007-08-09 18:31) [7]

> плавного движения строки не получится

А оно надо?

← →
JetAPI © (2007-08-09 18:46) [8]

Вот что нашел... но мне кажется это не лучшее решение.
http://www.noil.pri.ee/?mod=art/art&id=135
Вернее не то чтобы не лучшее, а как то... Как-то не так все. Сложно что ли...

Прислушаюсь к авторитетному мнению и начну с: TPaintBox,
и потом, может, попробую ТStatusBar + TBitmap + Таймер.

← →
JetAPI © (2007-08-09 18:55) [9]

$00FF00 , Если честно, плавность хода пока не нужна.
Но сразу подумал: а если строка должна быть цветная (поля), то как в в TLabel это сделать? Нужен TCanvas...
Вот сейчас этим и занимаюсь, что думаю: что будет оптимальным.

Спасибо всем, что новечку не даете заблудиться!
Любую помощь и совет принимаю с благодарностью!

← →
FF00FF (2007-08-09 19:05) [10]

> А оно надо?

надо!!!

← →
trubin © (2007-08-09 19:14) [11]

> $00FF00 © (09.08.07 18:31) [7]
> > плавного движения строки не получится
>
> А оно надо?

Просто где-то уже давно (точно не помню где, вроде на каком-то сайте) я видел вариант с перемещением по буквам, по сравнению с плавным движением по пикселам смотриться отвратно.

Чем больше размер шрифта, тем хуже будет смотреться.

← →
JetAPI © (2007-08-09 19:25) [12]

Похоже что - да... TPaintBox оптимальное решение.
Сейчас читаю про него...
Главное, там TCanvas есть, - то что требуется.
Расков, спасибо большое. В который раз, без Вас, не обходится не одно решение!

← →
$00FF00 © (2007-08-09 20:50) [13]

Во. Зацените мой СУПЕР БЕГАЮЩИЙ ТЕКСТ!!! гЫЫ. Вроде тоже вариант...

program Test;

{$Warnings off}
{$Hints off}

uses
Windows, Messages;

const
WW = 300;
WH = 170;
CN = "TEST_WND";
WN = "Test";

var
M : MSG;
W : HWND;
F : HFONT;
WC : WNDCLASS;
WXPos, WYPos, TXPos, TYPos, invCount : SmallInt;

function SetNewFont(Width:Longint; i, u:boolean; FSize:word; FontName:PChar):HFONT;
var
lf:LOGFONT;
begin
FillChar(lf, SizeOf(lf), 0);
lf.lfHeight := -FSize;
lf.lfWeight := Width;
if i then
lf.lfItalic := 1;
if u then
lf.lfUnderline := 1;
lf.lfCharSet := DEFAULT_CHARSET;
lf.lfOutPrecision := OUT_DEFAULT_PRECIS;
lf.lfClipPrecision := CLIP_DEFAULT_PRECIS;
lf.lfQuality := DEFAULT_QUALITY;
lf.lfPitchAndFamily := FF_DONTCARE or DEFAULT_PITCH;
lstrcpy(lf.lfFaceName, FontName);

Result:=CreateFontIndirect(lf);
end;

procedure PaintText(DC, F:HGDIOBJ; Text:string; incX, incY:shortInt);
var
sz, inc : SIZE;
r : TRect;
DF, DB : HGDIOBJ;
i : Word;
tmp : string;
begin
inc.cx:=0;
inc.cy:=0;
DF:=SelectObject(DC, F);
GetTextExtentPoint32(DC, PChar(Text), Length(Text), sz);
TXPos:=TXPos+incX;
TYPos:=TYPos+incY;
if (TXPos>=WW)and(incX>0) then TXPos:=-sz.cx else
if (TXPos<=-sz.cx)and(incX<0) then TXPos:=WW;
if (TYPos>=WH)and(incY>0) then TYPos:=-sz.cy else
if (TYPos<=-sz.cy)and(incY<0) then TYPos:=WH;

for i:=1 to length(Text) do begin
tmp:=Text[i];
GetTextExtentPoint32(DC, PChar(tmp), 1, sz);
r.Left:=TXPos+inc.cx;
r.Top:=TYPos+inc.cy;
r.Right:=r.Left+sz.cx;
r.Bottom:=r.Top+sz.cy;
SetTextColor(DC, RGB(Random(256), Random(256), Random(256)));
DrawText(DC, PChar(tmp), 1, r, DT_NOCLIP);
inc.cx:=inc.cx+sz.cx;
inc.cy:=round(20*sin(i));
end;
SelectObject(DC, DF);
end;

function WindowProc(hWnd: HWND; Msg, WParam, LParam: LongInt): LongInt; stdcall;
var
S, i : integer;
P : PChar;
ps : PAINTSTRUCT;
DC : HDC;
begin
Result:=0;
case Msg of
WM_CREATE:
begin
Randomize;
invCount:=1;
TXPos:=WW;
TYPos:=10;
SetTimer(hWnd, 1, 100, nil);
F:=SetNewFont(FW_BOLD, false, false, 80, "Comic Sans MS");
end;

WM_TIMER:
begin
Inc(invCount);
InvalidateRect(hWnd, nil, false);
end;

WM_PAINT:
begin
DC:=BeginPaint(hWnd, ps);
i:=0;
if invCount>0 then begin
Dec(InvCount);
i:=-3;
end;
PaintText(DC, F, "Enter Text Here", i, 0);
EndPaint(hWnd, ps);
end;

WM_CLOSE:
begin
KillTimer(hWnd, 1);
DeleteObject(F);
DestroyWindow(hWnd);
end;

WM_DESTROY: PostQuitMessage(0);

else Result:=DefWindowProc(hWnd, Msg, WParam, LParam);
end;
end;

begin
WXPos:=round((GetSystemMetrics(SM_CXSCREEN)-WW)/2);
WYPos:=round((GetSystemMetrics(SM_CYSCREEN)-WH)/2);

With WC do begin
Style := CS_HREDRAW or CS_VREDRAW;
lpfnWndProc := @WindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := sysInit.HInstance;
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := GetSysColorBrush(COLOR_BTNFACE);
lpszClassName := CN;
end;
RegisterClass(WC);
W := CreateWindowEx(0, CN, WN, WS_VISIBLE or WS_SYSMENU,
WXPos, WYPos, WW, WH, 0, 0, HInstance, nil);
ShowWindow(W, SW_SHOWNORMAL);
UpdateWindow(W);

while GetMessage(M, 0, 0, 0) do begin
TranslateMessage(M);
DispatchMessage(M);
end;
Halt(M.wParam);
end.

← →
Германн © (2007-08-09 21:30) [14]

> Хочу попробовать написать код для "бегущей строки".
> Начал подыскивать компонент, с помощью которого это можно
> сделать, но подобрать нужный не могу.
>

TSecretPanel из RxLibrary

← →
JetAPI © (2007-08-09 23:44) [15]

$00FF00 , даа... Даже трудно что-либо сказать...
Я когда смотрел, единственное о чем подумал, что такой труд, ив консоле написан.
Но во всем этом, алгоритм важен! Когда определюсь: как и что, буду штудировать. Спасибо.

← →
JetAPI © (2007-08-09 23:58) [16]

Германн, скорее всего, мне это не подойдет...
Я пользую версию Turbo Delphi for Win32 (free), а она, как раз, имеет ограничение на подключение стороних компонентов.
Так что, TPaintBox ,буду осваивать и постигать.

← →
Германн © (2007-08-10 01:28) [17]

> JetAPI © (09.08.07 23:58) [16]
>
> Германн, скорее всего, мне это не подойдет...
> Я пользую версию Turbo Delphi for Win32 (free), а она, как
> раз, имеет ограничение на подключение стороних компонентов.
>
>

Уж сколько раз твердили миру, что RxLibrary дана нам всем её разработчиками в исходниках! Не хочешь использовать сторонние компоненты или не можешь их использовать, так хоть посмотри исходники сей библиотеки. Найдёшь много всего.
Повторю ещё раз. RxLibrary - один из золотых фондов программистов Дельфи.

← →
{RASkov} © (2007-08-10 01:44) [18]

> [17] Германн © (10.08.07 01:28)
> RxLibrary - один из золотых фондов программистов Дельфи.

+5
...Но не JEDI и иже сними :)

← →
Германн © (2007-08-10 02:02) [19]

> {RASkov} © (10.08.07 01:44) [18]

> ...Но не JEDI и иже сними :)
>

Не знаю, не пробовал, посему "молчу в тряпочку" :)
P.S. "иже с ними". Иначе не понятно что снимать! То ли одёжку, то ли фильму. :-)

← →
{RASkov} © (2007-08-10 02:24) [20]

> [19] Германн © (10.08.07 02:02)
> P.S. "иже с ними". Иначе не понятно что снимать! То ли одёжку, то ли фильму. :-)

Так и знал.... "влетит" :)

← →
JetAPI © (2007-08-10 10:52) [21]

Германн

> Уж сколько раз твердили миру, что RxLibrary дана нам всем
> её разработчиками в исходниках!

Я не знал этого... Я про эту библиотеку, вот, только узнал... здесь. На будущее выводы сделал.

← →
MsGuns © (2007-08-10 11:04) [22]

>Германн ©

Не надо давать вредных советов

← →
Alral © (2007-08-10 14:59) [23]

А TLabel нельзя сделать прозрачной и двигать по горизонтали (или как надо) изменяя Left(или Top)?

← →
MsGuns © (2007-08-10 15:19) [24]

Можно. Самый простой пример - по таймеру "отрезать" от строки сколько нужно (или в символах или в пикселях на канве) и перемещать лабел влево или вправо по контейнеру, явно его при этом перерисовывая

← →
novill © (2007-08-10 15:36) [25]

Я делал так:
1. удвоил выводимую строку
2. выводил ее Textout постепенно уменьшая координату Х, пока не доходил до момента когда копазывался только второй экземпляр.

← →
Sonic90 (2007-08-10 23:05) [26]

procedure TForm1.Timer1Timer(Sender: TObject);
var
s:String;
begin
s:=Label1.Caption;
s:=s+s[1];
delete(s,1,1);
Label1.Caption:=s;
end;

← →
MsGuns © (2007-08-10 23:35) [27]

>novill © (10.08.07 15:36) [25]
>Sonic90 (10.08.07 23:05) [26]

Метлы в руки !!!

← →
Двигатель внешнего сгорания (2007-08-11 14:53) [28]

> Метлы в руки !!!

Для тупых можно подробнее?

> Двигатель внешнего сгорания (11.08.2007 14:53:28) [28]

Смотри пластилиновая ворона.

← →
tmp (2007-08-12 02:24) [30]

> 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.

Неметчиной повеяло :)

Вот мой вариант:
Форма, на ней ПаинтБокс, Таймер и кнопка...

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)
> Неметчиной

Что это значит? :)

← →
tmp (2007-08-12 03:19) [33]

> Германн © (12.08.07 03:00) [31]
> Неметчиной повеяло :)

:-) А чего мудрить с придумыванием имён на англицком, если проще применять то, что думается автоматом.

> Button1.Tag:=ORD(not Boolean(Button1.Tag));
> Timer1.Enabled:=Boolean(Button1.Tag);

заменить на
Timer1.Enabled:=not Timer1.Enabled;
Сорри...

> {RASkov} © (12.08.07 03:09) [32]

> Вот мой вариант:

Я б предпочел не пользовать DoubleBuffered:=True,
если мы сами можем подготовить битмап с текстом и
выводить его одним махом.
Это весьма пригодится, если под текстом будет картинка.

См. также
http://groups.google.com/group/borland.public.delphi.winapi/browse_thread/thread/b42cc723c5923bff/9b24ed0c90f1816d#9b24ed0c90f1816d

--
Regards, LVT.

>tmp (12.08.07 02:24) [30]

Есть некоторые проблемы, если текст меньше ширины Label1.Width, немного изменил код tmp

procedure TForm33.Timer1Timer(Sender: TObject); var iLeft: Integer; begin if AusgabePosition < -BmpText.Width then AusgabePosition := 0; with Label1 do begin Canvas.Brush.Color := Color; Canvas.FillRect(ClientRect); iLeft := AusgabePosition; while iLeft < Label1.Width do begin Canvas.Draw(iLeft, 0, BmpText); iLeft := iLeft + BmpText.Width end end; AusgabePosition := AusgabePosition - 1 end;

> [35] Leonid Troyanovsky © (12.08.07 09:10)
> Это весьма пригодится, если под текстом будет картинка.

Можно и так поступить в этом сучае:
procedure TForm1.PaintBox1Paint(Sender: TObject); * var OldBStyle: TBrushStyle; begin * OldBStyle:=PaintBox1.Canvas.Brush.Style; PaintBox1.Canvas.Brush.Style:=bsClear; DrawText(PaintBox1.Canvas.Handle, STR, -1, R, 0); * PaintBox1.Canvas.Brush.Style:=OldBStyle; end;
* - в не обязательно...

> Я б предпочел не пользовать DoubleBuffered:=True,
> если мы сами можем подготовить битмап с текстом и
> выводить его одним махом.

Согласен.... можно и так.... имхо, я самый простой вариант привел в [32]....

ЗЫ по ссылке хороший первый пример....

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