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

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

Мерцание прорисовки Canvas-a [D7, WinXP]

Лопух ©   (2006-04-14 16:13:00) 

Подскажите как получить не мерцающую прорисовку линий в полноэкранной Direct3D(?) игрушке?

имею

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
repeat
 DC := GetDC (0);
 Scr := TCanvas.Create;
 Scr.Handle := DC;
 Scr.Pen.Color := clRed;
 Scr.Pen.Style := psSolid;
 for i:=0 to 50 do begin
   Scr.MoveTo(400, 290);Scr.LineTo(400, 295);
   Scr.MoveTo(400, 305);Scr.LineTo(400, 310);
   Scr.MoveTo(390, 300);Scr.LineTo(395, 300);
   Scr.MoveTo(405, 300);Scr.LineTo(410, 300);
   sleep(1);
 end;
 ReleaseDC(0,Scr.Handle);
until (false);
end;

Приоритет Normal

---

Лопух   (2006-04-20 16:20:00) [1]

UP4хи! Извини, модер.

---

Лопух   (2006-04-14 16:34:00) [2]

Поправил слегка.

procedure TForm1.FormCreate(Sender: TObject);
begin
 Scr := TCanvas.Create;
 Scr.Handle := GetDC (0);
 Scr.Pen.Color := clRed;
 Scr.Pen.Style := psSolid;
end;
procedure TForm1.Button1Click(Sender: TObject);
 var i:integer;
begin
repeat
 Scr.Handle := GetDC (0);
 for i:=0 to 2000 do begin
   Scr.MoveTo(400, 290);Scr.LineTo(400, 295);
   Scr.MoveTo(400, 305);Scr.LineTo(400, 310);
   Scr.MoveTo(390, 300);Scr.LineTo(395, 300);
   Scr.MoveTo(405, 300);Scr.LineTo(410, 300);
   sleep(1);
 end;
 ReleaseDC(0,Scr.Handle);
until (false);
end;

Разницы не заметил.

Простите за очепятки.

---

antonn   (2006-04-14 16:18:00) [3]

для начала создавай конвас только один раз и пользуйся им.

---

Лопух   (2006-04-14 16:15:00) [4]

Такую программу сам видел в работе. Но сейчас ни сорцов, ни её самой откопать невозможно.

---

Наверх