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

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

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


Страницы:   1 2 3

JetAPI ©   (2007-08-09 17:00:00) 

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

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

$00FF00   (2007-08-09 20:50:00) [41]

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

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.

JetAPI   (2007-08-09 19:25:00) [42]

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

trubin   (2007-08-09 19:14:00) [43]


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


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

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

FF00FF   (2007-08-09 19:05:00) [44]


> А оно надо?

надо!!!

JetAPI   (2007-08-09 18:55:00) [45]

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

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

JetAPI   (2007-08-09 18:46:00) [46]

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

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

$00FF00   (2007-08-09 18:31:00) [47]

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

А оно надо?

trubin   (2007-08-09 18:30:00) [48]


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


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

$00FF00   (2007-08-09 18:27:00) [49]

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

{RASkov}   (2007-08-09 18:25:00) [50]

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

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

JetAPI   (2007-08-09 17:51:00) [51]

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

vegarulez   (2007-08-09 17:24:00) [52]

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

JetAPI ©   (09.08.07 17:00)

TLabel  :)

Сергей М.   (2007-08-09 17:01:00) [53]


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


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


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


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

Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо