мерцает PaintBox

← →
iSODEv (2008-07-07 10:11) [0]

здравствуйте, появилась проблема: мерцает PaintBox, пробовал создать временный питмап и отрисовать его Draw"ом:
procedure TForm1.PaintBox1Paint(Sender: TObject); begin bmpTemp := TBitmap.Create; { работаю с bmptemp } PaintBox1.Canvas.Draw(0,0,bmpTemp); bmpTemp.Free; end;
Но все равно мерцает. помогите! как быть?

← →
Ega23 © (2008-07-07 10:13) [1]

DoubleBuffered := True; - пробовал?

← →
iSODEv (2008-07-07 10:14) [2]

Я пока новичок, а что это?

← →
Рамиль © (2008-07-07 10:18) [3]

Да не должен он мерцать и без DoubleBuffered со вторым битмапом.

Боюсь у автора PaintBox на скроле размером этак 5000*5000 пикселов. Тут никакие DoubleBuffered не помогут.

← →
iSODEv (2008-07-07 10:50) [4]

нет, размер 500x300 пикселей где-то, я в обработчике OnPaint рисую.
А что это за doublebuffer?

← →
Amoeba © (2008-07-07 11:40) [5]

> iSODEv (07.07.08 10:14) [2]
>
> Я пока новичок, а что это?
>

TWinControl.DoubleBuffered

Неужели клавиша F1 на клавиатуре отсутствует или сломана?

← →
iSODEv (2008-07-07 11:54) [6]

Form1.DoubleBuffered := True;
не помагает

← →
Рамиль © (2008-07-07 11:56) [7]

> { работаю с bmptemp }

долго работаешь?

← →
iSODEv (2008-07-07 12:01) [8]

рисую там сетку 10x20, каждая клетка - это битмап (20x20 пикселей).
for i := 1 to 10 do for j := 1 to 20 do begin with bmpTemp.Canvas do begin StretchDraw(drect,bmpBlue); Pen.Color := $00FFAE5E; MoveTo(drect.Left,drect.Top); LineTo(drect.Right,drect.Top); LineTo(drect.Right,drect.Bottom); LineTo(drect.Left,drect.Bottom); LineTo(drect.Left,drect.Top); end; end; end;

← →
Anatoly Podgoretsky © (2008-07-07 12:04) [9]

> iSODEv (07.07.2008 12:01:08) [8]

Зачем ты 200 раз рисуешь одно и тоже?

← →
iSODEv (2008-07-07 12:08) [10]

а как сделать?
мне же надо еще просчитывать размеры PaintBoxa, он у меня размер может менять (сплиттером).

← →
Renegat (2008-07-07 12:38) [11]

А не проще ли нарисовать ети линии сопстно линиями а не квадратиками? получится гораздо меньше итераций - раз, уйдёт мигание - два. ++а с фига ли при отрисовке в промежуточный битмап тоже мигает? чтобы этого не происходило, не Refresh (или как там этот метод называется), а вызывать InvalidateRect(PaintBox.handle, 0, false);

← →
Тын-Дын © (2008-07-07 13:06) [12]

> iSODEv (07.07.08 12:01) [8]

См. также Canvas.FillRect вместо зарисовки в цикле прямоугольника.

← →
iSODEv (2008-07-07 13:11) [13]

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

← →
iSODEv (2008-07-07 13:12) [14]

текст рисуется всегда, пока одна булевапеременная стоит как false. и когда он true, уже рисуются клетки. моргает в обеих случаях

> [6] iSODEv (07.07.08 11:54)

if PaintBox.Parent<>nil then PaintBox.Parent.DoubleBuffered:=True;

> [13, 14] iSODEv (07.07.08 13:11)

"Кидай" свой ПаинтОнПаинт(процедуру) весь сюда...

← →
iSODEv (2008-07-07 13:29) [16]

procedure TForm1.PaintBox1Paint(Sender: TObject); var OldBkMode,x,y,i,j,pW,pH,cW,cH,offset: Integer; drect,truerect: TRect; const Pretext1: String = "Welcome"; begin if not bInGame then begin bmpTemp.Height := paintBox1.ClientHeight; bmpTemp.Width := paintBox1.ClientWidth; with bmpTemp.Canvas do begin Font.Color := $00FFAE5E; Font.Name := "Arial"; Font.Size := 16; OldBkMode := SetBkMode(Handle,Transparent); TextOut((PaintBox1.ClientWidth - TextWidth(Pretext1)) div 2,(PaintBox1.ClientHeight - TextHeight(Pretext1)) div 2,Pretext1); SetBkMode(Handle,OldBkMode); end; end else begin pW := PaintBox1.Width; pH := paintBox1.Height; cW := pW div 10; cH := pH div 20; bmpTemp.Height := cH * 20; bmpTemp.Width := cW * 10; for j := 1 to 20 do begin drect.Left := 0; drect.Right := cW * 10; drect.Top := (j * cH) - cH; drect.Bottom := drect.Top + cH; bmpTemp.Canvas.StretchDraw(drect,bmpBlue); for i := 1 to 10 do begin drect.Left := (i * cW) - cW; drect.Right := drect.Left + cW; drect.Top := (j * cH) - cH; drect.Bottom := drect.Top + cH; with bmpTemp.Canvas do begin Pen.Color := $00FFAE5E; MoveTo(drect.Left,drect.Top); LineTo(drect.Right,drect.Top); LineTo(drect.Right,drect.Bottom); LineTo(drect.Left,drect.Bottom); LineTo(drect.Left,drect.Top); if binfield[i,j] = true then begin // недоделал end; end; end; end; end; PaintBox1.Canvas.Draw(0,0,bmpTemp); end;
код незавершен, не ругайтесь :)

← →
IsodeV (2008-07-07 16:11) [17]

Удалено модератором

Может стоит посмотреть в сторону DrawGrid? И сетку рисовать не придется. А в ячейках соответственно отрисовывать Bitmap"ы и все, что душе угодно.

> [16] iSODEv (07.07.08 13:29)

Ясно.... про неоптимальность кода уже говорили...
Теперь расскажи что же нужно и когда моргает.
Попробуй такой вариант:

var bmpTemp: TBimap;
................
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
TPaintBox(Sender).Canvas.Draw(0, 0, bmpTemp);
end;

procedure PaintBMP;
begin
рисуем на bmpTemp
PaintBox1.invalidate;
end;

PaintBMP - вызывай только когда картинка реально сменилась...

> LineTo(drect.Right,drect.Top);
> LineTo(drect.Right,drect.Bottom);
> LineTo(drect.Left,drect.Bottom);
> LineTo(drect.Left,drect.Top);

В двух линиях смысла нет, ну только если в крайних нижне-правых(левых) или верхне-левых(правых) ячейках...

мерцает PaintBox Найти похожие ветки