Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.09.02;
Скачать: CL | DM;

Вниз

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

 
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;
Скачать: CL | DM;

Наверх




Память: 0.59 MB
Время: 0.023 c
6-1168779369
@gent
2007-01-14 15:56
2007.09.02
Как скрытно зайти на страницу ?


15-1186120138
Slider007
2007-08-03 09:48
2007.09.02
С днем рождения ! 3 августа 2007 пятница


2-1186457366
sts
2007-08-07 07:29
2007.09.02
Почему в Hint ах вылазит абракадабра


2-1186575343
wazaaaa
2007-08-08 16:15
2007.09.02
Wait until program starts


8-1164713466
Tar I
2006-11-28 14:31
2007.09.02
Вывод графики поверх видео