Форум: "Media";
Текущий архив: 2006.12.03;
Скачать: [xml.tar.bz2];

Вниз

Мерцание прорисовки Canvas-a   Найти похожие ветки 

← →
Лопух   (2006-04-14 16:13) [0]

Подскажите как получить не мерцающую прорисовку линий в полноэкранной 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-14 16:15) [1]

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

---

← →
antonn ©   (2006-04-14 16:18) [2]

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

---

← →
Лопух   (2006-04-14 16:34) [3]

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

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;

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

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

---

← →
Лопух   (2006-04-20 16:20) [4]

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

---

Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2006.12.03;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.046 c