Форум: "Начинающим";
Текущий архив: 2007.09.02;
Скачать: [xml.tar.bz2];
ВнизБегущая строка. Найти похожие ветки
← →
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]
> Метлы в руки !!!
Для тупых можно подробнее?
← →
Anatoly Podgoretsky © (2007-08-11 15:42) [29]> Двигатель внешнего сгорания (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.
← →
Германн © (2007-08-12 03:00) [31]Неметчиной повеяло :)
← →
{RASkov} © (2007-08-12 03:09) [32]Вот мой вариант:
Форма, на ней ПаинтБокс, Таймер и кнопка...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]
> Неметчиной повеяло :)
:-) А чего мудрить с придумыванием имён на англицком, если проще применять то, что думается автоматом.
← →
{RASkov} © (2007-08-12 04:02) [34]> Button1.Tag:=ORD(not Boolean(Button1.Tag));
> Timer1.Enabled:=Boolean(Button1.Tag);
заменить наTimer1.Enabled:=not Timer1.Enabled;
Сорри...
← →
Leonid Troyanovsky © (2007-08-12 09:10) [35]
> {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.
← →
Lacmus © (2007-08-12 09:22) [36]>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;
← →
Leonid Troyanovsky © (2007-08-12 10:00) [37]
> Lacmus © (12.08.07 09:22) [36]
> while iLeft < Label1.Width do begin
Что это?
--
Regards, LVT.
← →
{RASkov} © (2007-08-12 14:30) [38]> [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]....
ЗЫ по ссылке хороший первый пример....
← →
Lacmus © (2007-08-12 15:22) [39]>Leonid Troyanovsky © (12.08.07 10:00) [37]
Какие есть варианты ?
← →
Leonid Troyanovsky © (2007-08-12 19:05) [40]
> {RASkov} © (12.08.07 14:30) [38]
> ЗЫ по ссылке хороший первый пример....
А чем второй плох?
--
Regards, LVT.
Страницы: 1 2 вся ветка
Форум: "Начинающим";
Текущий архив: 2007.09.02;
Скачать: [xml.tar.bz2];
Память: 0.57 MB
Время: 0.036 c