Проблема с TLabel

← →
hypnotize (2007-01-18 17:02) [0]

Всем здраствуйте, проблема такая, сделал я ефект появления текста, аля матрица, то биш текст будто печатается, нарастает по одной букве, для сего эфекта использовал я TLabel и TTimer с интервалом 10, вроде как все работает, но сам лейбл во время появления текста моргает, как избавится от этого?

← →
hypnotize (2007-01-18 19:31) [1]

up>
Ниужели никто не знает? Может есть другой вариант реализации? Другие компоненты тоже моргают :(

← →
Johnmen © (2007-01-18 19:35) [2]

У тебя монитор какой?

← →
Комбинатор (2007-01-18 19:36) [3]

Ага...нужна двойная буферизация, блиттинг)))

← →
hypnotize (2007-01-18 19:48) [4]

Монитор сони 19 дюймов жк, двойная буферизация только для картинок помогает, а лейбл дергается все равно

← →
hypnotize (2007-01-18 20:42) [5]

2Комбинатор
Раскажи про
> блиттинг

Как эту ересь включить? :)

← →
default © (2007-01-18 20:59) [6]

особые махосты могу выводить на каждую букву один лейбел:)

← →
default © (2007-01-18 21:07) [7]

у меня вот ничего не моргает

← →
hypnotize (2007-01-18 21:23) [8]

var i: integer; procedure TForm1.TimerTimer(Sender: TObject); begin i := i + 1; if copy(memo1.Lines.Text,i-1,1) = " " then begin Form1.TimerTimer(sender); exit; end; // Это чтобы пропускать пробелы label.caption := copy(memo1.Lines.Text,0,i); if i > 100 then Timer.Enabled:=false; end;

Вот такой собсно код, лейбл как надо рисует многострочный текст(с морганием), када доходит до 100-ого символа, перестаёт.

2default
Раскажи как ты делал чтобы не моргало.

← →
Vovan #2 (2007-01-18 21:28) [9]

Transparent := False ?

← →
default © (2007-01-18 21:29) [10]

hypnotize (18.01.07 21:23) [8]
обычный код
Label1.Caption = Label1.Caption + "L" в таймере

← →
Kolan © (2007-01-18 21:31) [11]

«интервалом 10»

Поставь побольше.

«двойная буферизация только для картинок »

У формы, может?

Урок нормального кода:
var I: Integer; procedure TForm1.TimerTimer(Sender: TObject); begin I := I + 1; if Copy(Memo1.Lines.Text,I-1,1) = " " then begin Form1.TimerTimer(sender); Exit; end; // Это чтобы пропускать пробелы Label.Caption := Copy(Memo1.Lines.Text,0,I); if I > 100 then Timer.Enabled := False; end;

теперь можно постараться понять :)

← →
Kolan © (2007-01-18 21:33) [12]

«Label.Caption := Copy(Memo1.Lines.Text,0,I);»

А нельзя так(нафик Copy:
Label.Caption := Label.Caption + Memo1.Lines.Text[I];

И тут:
if Copy(Memo1.Lines.Text,I-1,1) = " " then
if Memo1.Lines.Text[I] = " " then

Ессно не проверял. Просто на мысл навожу.

← →
hypnotize (2007-01-18 21:34) [13]

2Vovan #2
Transparent := False ?
Что тру, что фалс, адинаково моргает :)

2default
Хм, странно, у меня с твоим кодом все равно глючит, может потому что текст много строчный...

← →
default © (2007-01-18 21:36) [14]

hypnotize (18.01.07 21:34) [13]
я в Visual Studio 2005 пробовал, .net контролом Label
видимо всё дело в том, что в .net GDI+ и она буферизует

← →
hypnotize (2007-01-18 21:38) [15]

2Kolan
Проверил, действительно все работает, только к моему вопросу это не относится =(

← →
hypnotize (2007-01-18 21:39) [16]

Может стоить попробывать на канве этот текст рисовать? Раз компоненты моргают все

← →
default © (2007-01-18 21:41) [17]

если тебя итересует просто вывести текст можешь его в ручную отрисовывать по букве в таймере
а в OnPaint поставишь всю строку выводить(на случай затирания)

← →
hypnotize (2007-01-18 21:42) [18]

Текста много и рисовать нужно будет часто, так что это не катит.

← →
default © (2007-01-18 21:45) [19]

hypnotize (18.01.07 21:34) [13]
попробуй сначала двойную буферизацию для формы установить

← →
hypnotize (2007-01-18 21:48) [20]

да я с этого и начал) не помогает

← →
default © (2007-01-18 21:55) [21]

hypnotize (18.01.07 21:34) [13]

> Текста много и рисовать нужно будет часто, так что это не
> катит.

чё это за фикня?
рисуй по букве, в чём трабл? ширину буквы можно получить, нарисовать буквы знаем как
единственное, в OnPaint(когда твоя строка чем-то по какой-то причине инвалидируется) попробуй всё перерисовывать всё сначала
если будет хреново будешь и в OnPaint перерисовывать только то что надо
вообще странно всё это....не должно ничего моргать на самом-то деле
спроси у кого дельфи стоит у них у всех моргает?

← →
default © (2007-01-18 22:06) [22]

слушай, попробуй сначала с однострочным лейблом
если не моргает, вместо многострочного лейбла можешь использовать несколько однострочных

← →
hypnotize (2007-01-18 22:10) [23]

нет, моргают даже длинные однострочными((((

← →
default © (2007-01-18 22:12) [24]

hypnotize (18.01.07 22:10) [23]
попробуй в чистом проекте
фигня какая-то
что-то никто не может сказать моргает-ли у него
у меня просто дельфи нету...
пиши пока код отрисовки по букве, это недолго на самом деле
если уж двойная буферизация не помогает...

← →
hypnotize (2007-01-18 22:20) [25]

Пустой проект тоже моргает, но внем слабо заметно, наверно потому что в моём зеленый шрифт по черному сильнее видно, ладно пытаюсь рисовать...

← →
hypnotize (2007-01-18 22:20) [26]

← →
Kolan © (2007-01-18 22:57) [27]

procedure TForm3.Timer1Timer(Sender: TObject); begin I := I + 1; if Memo1.Lines.Text[I] = " " then begin Form3.Timer1Timer(sender); Exit; end; // Это чтобы пропускать пробелы Label1.Caption := Label1.Caption + Memo1.Lines.Text[I]; if I > Length(Memo1.Lines.Text) then Timer1.Enabled := False; end;

Проверил. Ниче не моргает при интервале 10. А при 100 супер вообще :).

← →
Комбинатор (2007-01-19 11:44) [28]

Наверное:

1) надо создать два канваса.
2) рисовать на обоих (по очереди)
* рисовать - в смысле печатать текст (см. DoDrawText у TCustomLabel)
3) затем менять поверхности местами - типа получиться эмуляция буферизации.

Вот пример простой двойной буфферизации:

MyLabel: TPaintBox; BackBuf: TBitmap; procedure FormCreate(Sender: TObject); begin //............. BackBuf := TBitmap.Create; BackBuf.Width := MyLabel.Width; BackBuf.Height := MyLabel.Height; BackBuf.PixelFormat := pf24bit; //............. end; procedure FormDestroy(Sender: TObject); begin //............. BackBuf.Free; //............. end; procedure SetLabelText(S: string); begin BackBuf.Canvas.TextOut(0,0,S); MyLabel.Repaint; end; procedure MyLabelPaint(Sender: TObject); // MyLabel.OnPaint begin BitBlt(MyLabel.Canvas.Handle,0,0,MyLabel.Width,MyLabel.Height, BackBuf.Canvas.Handle,0,0,SRCCOPY); end;

← →
hypnotize (2007-01-19 13:44) [30]

2Kolan
То что ты написал все равно моргает!

2Комбинатор
неосилил :( я же все таки еще новичок...

2TRUNK
Во, твой вариант хорош, токо рисует все в одну строчку :) Пытаюсь исправить.

← →
hypnotize (2007-01-19 13:59) [31]

Вопрос: какими символами выделяется начало новой строчки? На картинке рисует как , но pos два квадратика не воспринимает :)

> какими символами выделяется начало новой строчки

Вообщето этими символами строка заканчивается, ну да ладно...
Последовательность #13#10 (#13 - "возврат каретки", #10 - "перевод строки")

> токо рисует все в одну строчку

Замени

BackBuf.Canvas.TextOut(0,0,S);

на

DrawText(BackBuf.Canvas.Handle,PChar(S),Length(S),Rect(0,0,MyLabel.Width,MyLabel .Height),DT_CENTER or DT_VCENTER or DT_WORDBREAK or DT_NOPREFIX);

← →
hypnotize (2007-01-19 14:32) [33]

Дельфя жалуется на код: [Error] Unit1.pas(104): Constant object cannot be passed as var parameter

← →
hypnotize (2007-01-19 14:33) [34]

это в точке DT_CENTER

← →
Комбинатор (2007-01-19 14:58) [35]

передавай TRect через ссылку:
Rect1 = Rect(0,0,MyLabel.Width,MyLabel .Height)
а уж потом
DrawText(BackBuf.Canvas.Handle,PChar(S),Length(S),Rect1,DT_CENTER or DT_VCENTER or DT_WORDBREAK or DT_NOPREFIX);

← →
hypnotize (2007-01-19 15:00) [36]

2Комбинатор
[Error] Unit1.pas(105): Missing operator or semicolon

← →
Комбинатор (2007-01-19 15:03) [37]

риведи код, который получился

Где-то пропустил ";" :(

← →
Комбинатор (2007-01-19 15:09) [39]

> Где-то пропустил ";" :(

не обязательно

← →
hypnotize (2007-01-19 15:12) [40]

Такс все ок, токо текст выравнивается по центру, можно сие убрать?

Проблема с TLabel Найти похожие ветки