Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 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
2-1186587997
Ага
2007-08-08 19:46
2007.09.02
Как удалить компонент?


10-1136451082
SupKlo
2006-01-05 11:51
2007.09.02
Как передать jpeg с клиента на сервер через dcom


2-1186488500
Roun
2007-08-07 16:08
2007.09.02
Как удалить пустые строки из Memo?


15-1186401509
de.
2007-08-06 15:58
2007.09.02
Acer 5100


2-1186638077
Darvin
2007-08-09 09:41
2007.09.02
выделение в TListView





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский