Рисование движущегося прямоугольника

← →
Юра (2007-07-30 14:13) [0]

Задача: Создать движение прямоугольника.
Что сделал: Реализовал движение очень просто: стирание и рисование в новых координатах, однако при таком способе рисования происходит моргание изображения.
Вопрос: Как от него избавиться?

← →
Инс © (2007-07-30 14:18) [1]

Вместо стирания всего, делай только стирание прямоугольника. См. режим рисования XOR или в крайнем случае можно ClipRegion-ом поиграться

← →
Юра (2007-07-30 14:24) [2]

Я и стираю только прямоугольник, когда вызываю Rectangle с теми же координатами, только цветом фона?

← →
Инс © (2007-07-30 14:32) [3]

Тогда код приведите

← →
Юра (2007-07-30 14:37) [4]

...
//Стирание
Canvas.Pen.Color := clBtnColor;
Canvas.Rectangle(endLeft,50,endRight,300);
dec(endLeft);
//Рисование
Canvas.Pen.Color := clBlack;
Canvas.Rectangle(endLeft,50,endRight,300);
...

← →
oxffff © (2007-07-30 14:39) [5]

> Вопрос: Как от него избавиться?

Использовать двойную буферизацию.

DoubleBuffered:=TRUE;

← →
Юра (2007-07-30 14:40) [6]

Пробовал

← →
Инс © (2007-07-30 14:43) [7]

И с какой частотой такое рисование/стирание происходит?

← →
Юра (2007-07-30 14:45) [8]

в цикле while true do begin
рисование/стирание
sleep(50);
end;
Судите о частоте.

← →
oxffff © (2007-07-30 14:55) [9]

> Судите о частоте.

А как?

← →
Юра (2007-07-30 14:58) [10]

а вот так: смотришь на код и понимаешь какая частота.

← →
Darvin © (2007-07-30 15:01) [11]

Рисуешь сначала на невидимой канве, а потом ВСЕ ИЗОБРАЖЕНИЕ копируешь на видимую. Плюс DoubleBuffered.

← →
oxffff © (2007-07-30 15:04) [12]

> Юра (30.07.07 14:58) [10]
> а вот так: смотришь на код и понимаешь какая частота.

Может вставить GetTickCount?
Вдруг получиться?

← →
Юра (2007-07-30 15:07) [13]

Darvin, пожалуйста покажи код...

← →
Инс © (2007-07-30 15:18) [14]

> Рисуешь сначала на невидимой канве, а потом ВСЕ ИЗОБРАЖЕНИЕ
> копируешь на видимую. Плюс DoubleBuffered.

DoubleBuffered именно так и делает: рисует сначала во временный битмап, потом целиком его копирует. Плюс подавляет обработку WM_ERASEBKGND по умолчанию. Так что - масло масляное, к тому же не даст никакого эффекта. DoubleBuffered включается в работу только когда приходят сообщения WM_PAINT и WM_ERASEBKGND, а тут мы просто рисуем на контроле.

Я бы делал так:
1. Поставил бы DoubleBuffered форме
2. Рисовал бы в OnPaint
3. По таймеру, увеличивал бы циферку, означающую смещение прямоугольника, и вызывал Invalidate

← →
Darvin © (2007-07-30 15:19) [15]

>Darvin, пожалуйста покажи код...
А сам, слабо?

var Bitmap : TBitmap; R : TRect; begin Bitmap := TBitmap.Create; Bitmap.Height := Height; Bitmap.Width := Width; with Bitmap.Canvas do begin ... end; R.Left := 0; R.Top := 0; R.Right := Width; R.Bottom := Height; Canvas.CopyRect ( R, BitMap.Canvas, R ); end;

Разжевал, в рот положил, тебе осталось проглотить ;-)

← →
Darvin © (2007-07-30 15:23) [16]

>Инс © (30.07.07 15:18) [14]
>DoubleBuffered именно так и делает: рисует сначала во временный битмап, >потом целиком его копирует
Он это делает только при сбытиях WM_PAINT (при перекрытии окна и т.д.), а когда он САМ ручками двигает прямоугольник, двойная буферизация не работает

← →
Инс © (2007-07-30 15:25) [17]

> Он это делает только при сбытиях WM_PAINT (при перекрытии
> окна и т.д.), а когда он САМ ручками двигает прямоугольник,
> двойная буферизация не работает

Ты мой пост до конца дочитал? Я об этом говорю. А при перекрытии окна прямоугольник вообще сотрется, так как рисуется вне обработки WM_PAINT

← →
DVM © (2007-07-30 15:51) [18]

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm1 = class(TForm) Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormPaint(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private declarations } Bmp: TBitmap; x: integer; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin Bmp := TBitmap.Create; Bmp.Width := Width; Bmp.Height := Height; Bmp.PixelFormat := pf24bit; x := 0; Bmp.Canvas.Brush.Style := bsSolid; Bmp.Canvas.Brush.Color := clWhite; Bmp.Canvas.Pen.Color := clBlack; DoubleBuffered := true; end; procedure TForm1.FormDestroy(Sender: TObject); begin Bmp.Free; end; procedure TForm1.FormPaint(Sender: TObject); begin Bmp.Canvas.FillRect(rect(0, 0, bmp.Width, bmp.Height)); Bmp.Canvas.Rectangle(x, 0, x + 50, 50); inc(x, 5); if x > bmp.Width - 50 then x := 0; Canvas.Draw(0, 0, Bmp); end; procedure TForm1.Timer1Timer(Sender: TObject); begin Form1.Invalidate; end; end.

← →
Инс © (2007-07-30 15:54) [19]

> DVM © (30.07.07 15:51) [18]

Не, x не в FormPaint лучше инкрементировать, а в Timer1Timer. Мало ли из-за чего будет вызвана перерисовка.

← →
DVM © (2007-07-30 15:55) [20]

> Инс © (30.07.07 15:54) [19]

точно!

← →
Инс © (2007-07-30 16:00) [21]

В общем, все куда проще:

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm1 = class(TForm) Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure FormPaint(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} var x: Integer; procedure TForm1.FormCreate(Sender: TObject); begin DoubleBuffered:=true; end; procedure TForm1.Timer1Timer(Sender: TObject); begin Inc(x); if x > Width then x:=0; Invalidate; end; procedure TForm1.FormPaint(Sender: TObject); begin Canvas.Rectangle(x,10,x + 100,80); end; end.

← →
Инс © (2007-07-30 16:27) [22]

Вот еще механизм хороший для рисования движущегося изображения. Модифицируем не изображение, а систему координат. Правда для борьбы с мерцанием ничего не предусматривается, но если кому надо - подумает над этим.

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm1 = class(TForm) Timer1: TTimer; procedure Timer1Timer(Sender: TObject); procedure FormPaint(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} var Angle: Single; procedure TForm1.Timer1Timer(Sender: TObject); begin Angle:=Angle + 2; Invalidate; end; procedure TForm1.FormPaint(Sender: TObject); var p: XFORM; begin SetGraphicsMode(Canvas.Handle, GM_ADVANCED); p.eM11 := 1; p.eM12 := 0; p.eM21 := 0; p.eM22 := 1; p.eDx := -160; p.eDy := -160; SetWorldTransform(Canvas.Handle, p); p.eM11 := sin(Angle*pi/180); p.eM12 := cos(Angle*pi/180); p.eM21 := -cos(Angle*pi/180); p.eM22 := sin(Angle*pi/180); p.eDx := 0; p.eDy := 0; ModifyWorldTransform(Canvas.Handle,p,MWT_RIGHTMULTIPLY); p.eM11 := 1; p.eM12 := 0; p.eM21 := 0; p.eM22 := 1; p.eDx := 160; p.eDy := 160; ModifyWorldTransform(Canvas.Handle,p,MWT_RIGHTMULTIPLY); Canvas.Rectangle(110,110,210,210); end; end.

← →
Юра (2007-07-30 17:23) [23]

Спасибо всем. :)

← →
Юра (2007-07-30 22:36) [24]

Инс, попробовал предпоследний вариант, результат тот же...

← →
Юра (2007-07-30 22:41) [25]

Работает вариант Дарвина ;)

← →
Юра (2007-07-30 23:03) [26]

А как задать фон в Bitmap? (FloodFill не работает)

> Инс, попробовал предпоследний вариант, результат тот же...

Позволь тебе не поверить ;)

← →
Юра (2007-07-31 12:25) [28]

Позволяю ;)

> [26] Юра (30.07.07 23:03)
> А как задать фон в Bitmap? (FloodFill не работает)

Меняй цвет кисти перед рисованием прямоугольника на нужный......

← →
Юра (2007-07-31 12:57) [30]

А почему все-таки при движении есть какие-то глюки уже не мерцание, а что-то не понятное, какое-то искажение изображения. Как это исправить?

> [30] Юра (31.07.07 12:57)

Что за искажения? Покажи текущий твой код...

> Юра (31.07.07 12:57) [30]

А ты в курсе, что на экране ты видишь оцифрованное изображение ?

← →
Юра (2007-07-31 13:56) [33]

Jeer я в курсе и что?

> Юра (31.07.07 13:56) [33]

То, что прямая - на самом деле не прямая, а ломанная и в процессе смещения/вращения меняется ее вид, что вполне может тобой (и не только) восприниматься как артефакт.

Рисование движущегося прямоугольника Найти похожие ветки