При рисовании окружности FPC сильно тормозит. Используется процедура circle(x,y,r); Процессор AMD athlon 2000+, видео Geforce 7300 Gt;
В TP 7 производительность в сотни раз быстрее.
Инцилизация графики идет так:
driver:=detect;
mode:=0;
initgraph(driver,mode,’Путь к модулю graph или просто »).
Кто знает в чем проблема или аналог процедуры circle в FPC.
- Профиль
- ICQ
Re: Рисование окружности в free pascal
Гм. не используйте Graph, лучше GDI. Или сразу OpenGL или DirectX, но аналогами это трудно назвать.
Re: Рисование окружности в free pascal
Кирилл
Ваша проблема здесь:
driver:=detect;
Detect выдаёт максимально возможный режим работы дравера, а следовательно и максимально ресурсоёмкий. Лучше поставьте какой-нибудь более-менее разумный режим, например:
Код: Выделить всё gd:=D8bit; //Это цветность
gm:=m1024x768; //Это разрешение экрана
InitGraph(gd, gm, »); //Не знаю как Вам, а меня вполне удовлетворяет шрифт по умолчанию, поэтому третий параметр пустой
Движение круга в PascalABC
.
Скорость хорошая.
Re: Рисование окружности в free pascal
Дож,Vadim,спасибо за советы. попробую.
Vadim т.е можно поставить например Driver:=D2,4,8,16bit ?
и например mode:=m640x480; ?
Кстати почему на вы? Мне 16 лет. так, что можно и проще =)
Дож а как собственно использовать эти самые Gui,OpenGl,directX?
- Профиль
- ICQ
Re: Рисование окружности в free pascal
На счет GDI ничего посоветовать не могу, так как сам не использовал.
Re: Рисование окружности в free pascal
Создал програмку для рисования только окружностей. Получается примерно по 2 тыщи окружностей в секунду.
GD:=D4bit;
gm:=m640x480;
И еще хотел спросить про такую функция как random, как она в FPC?
Добавлено спустя 14 минут 26 секунд:
Вот собственно и сама програмулина
Код: Выделить всё Program s1;// под TP 7
uses Crt,graph;
type t=array [1..30] of integer;
var Driver,Mode,c,i,d,col,rad:integer; x1,y1,x,y:t;
procedure pix(Var x1,y1:t);
Var i,n:integer;
begin
For i:=1 to 30 do begin //здесь 30 кол-во шариков;
x1[i]:=random(640);
y1[i]:=random(450);// задаем начальные координаты шаров.
putpixel(x1[i],y1[i],15);
end;end;
procedure Xog(x1,y1:t); // изменяем положение каждого шара.
Var x2,y2,x,y:t;
begin
while not keypressed do begin
For i:=1 to 30 do begin
col:=i mod 14;
rad:=(i mod 3)+2;
setcolor(black);// этим цветом рисуем окружность чтоб убрать предыдущую
setfillstyle(1,black);// устанавливаем режим закраски
circle(x1[i],y1[i],rad);// рисуем саму окружность
floodfill(x1[i],y1[i],black);// закрашиваем ее в черный цвет
x2[i]:=random(13)-6;// задается изменение по оси x
y2[i]:=random(13)-6;//задается изменение по оси у
x[i]:=x1[i]+x2[i];//меням координаты каждого шарика
Рисование в Pascal ABC (размеры окна, основные фигуры, заливка, текст, толщина и цвет линий)
y[i]:=y1[i]+y2[i];//
setcolor(col);//выбираем его цвет
setfillstyle(1,col);//выбираем стиль закрашивания
circle(x[i],y[i],rad);//рисуем окружность
floodfill(x[i],y[i],col);//закрашиваем ее нужным цветом
x1[i]:=x[i]; y1[i]:=y[i];//сохраняем кординаты точек
end;
delay(100); задержка//
end; end;
begin
ReadKey;
closegraph;
end.
как не пыхтел в FPC, добиться производительности не получилось =(
- Профиль
- ICQ
Re: Рисование окружности в free pascal
Модуль graph судя по всему и использует GDI для отрисовки под Windows. Но видимо как-то кривовато там это реализовано, даже если пользоваться в Лазарусе методами типо Canvas.Arc,Canvas.FillRect и т.д. должно намного быстрее получиться
Дож а как собственно использовать эти самые Gui,OpenGl,directX?
И еще хотел спросить про такую функция как random, как она в FPC?
Вот нашол старую программку-тест на моей старой OpenGL-библиотечке (в аттаче). Там есть функция RenderCircle которая выводит круг средствами OpenGL (строит круг из треугольников- иначе в OpenGL никак) и random там везде используеться. (Сама инициализация OpenGL спрятана внутри длл-ки, но этой инициализации и так в интернете полно..) Зато при разрешении 800*600 и глубине цвета 32 бита в этой демке отрисовываються 25000 полупрозрачных окружностей в секунду (на видеокарте GeForce 5500FX)
Вложения Circles.zip (142.45 КБ) Скачиваний: 559
- Профиль
- ICQ
Re: Рисование окружности в free pascal
Затык тут не с circle(), а с floodfill(), которая в Windows не использует одноименный вызов GDI, а считывает содержимое видеопамяти попиксельно с помощью GetPixel.
Как я понимаю, модуль Graph не позволяет рисовать закрашенные окружности одной процедурой. В качестве выхода (если уж оставаться в рамках graph) видится написание собственной процедуры рисования окружностей путем рисования набора горизонтальных линий нужного цвета.
Ф-ция random в FPC — очень хороша
- Профиль
- ICQ
Источник: www.freepascal.ru
Нарисовать окружность с изменяющейся толщиной (Borland pascal)
Поставлена задача:нарисовать окружность методом Брезенхема. Саму окружность нарисовать удалось,но не получается в этот метод как-то добавить утолщение. Как это можно сделать? Вот что должно получиться(делал другим методом) Радиус 55,максимальная толщина 20. UPD:изменил код,было пару ошибок. вот что пока есть:
uses DOS; var r:registers; k,x0,y0,i,j,rad,x,y,x1,x2,h,f:integer; a,rate:real; c:byte; startTime,endTime:longint; Procedure SetVM; begin r.ah:=0; r.al:=$13; intr($10,r); end; Procedure PP(x,y:integer);assembler; asm mov ax,0a000h mov es,ax mov ax,y shl ax,6 mov di,ax shl ax,2 add di,ax add di,x mov al,12 stosb end; Function GetTime:longint;assembler; asm xor ah,ah int 1ah mov ax,dx mov dx,cx end; procedure BrezenCircle(x0, y0, r: integer); var x, y: integer; dv, dd, dh: integer; procedure sim(x, y: integer); begin PP(x0+x, y0+y); PP(x0+x, y0-y); PP(x0-x, y0+y); PP(x0-x, y0-y); end; begin k:=0; x:=0; y:=r; while((y>=0)or(x begin sim(x,y); dv:=abs(r*r — x*x — (y-1)*(y-1)); dh:=abs(r*r — (x+1)*(x+1) — y*y); dd:=abs(r*r — (x+1)*(x+1) — (y-1)*(y-1)); if(dv begin dec(y); < for i:=x-k to (x+k) do begin sim(i,y); inc(k); end;>if(dd end else begin inc(x); if(dd end; end; end; begin x0:=160; y0:=100; a:=0; rad:=55; h:=20; c:=4; SetVM; startTime:=GetTime; BrezenCircle(x0,y0,rad); endTime:=GetTime; rate:=(endTime/startTime)/65536; Writeln(rate:2:10); readln; end.
Отслеживать
задан 22 окт 2018 в 17:08
63 8 8 бронзовых знаков
А почему не получается? Вместо рисования одного пиксела рисуется горизонтальный отрезок, так что for i:=x-k to (x+k) — верный подход, если рисование окружности вообще работает.
23 окт 2018 в 2:59
Рисование окружности работает,но не получается реализовать рисование отрезков,не понимаю где организовать этот цикл. В моем случае ,если добавить тот цикл закрашивает вообще весь экран
Источник: ru.stackoverflow.com
circle pascal
Ответ от Георгий Зотиков[гуру]
uses graphabc;
var a,b,c,i,count:integer;
begin
floodfill(1, 1, clblue);
setbrushstyle(bsClear);
a:=100;
b:=100;
c:=50;
count:=1;
for i:=1 to 15 do <>
begin
if(count <= 4) then
begin
circle(a,b,c);
floodfill(a, b, clwhite);
a:=a+90;
end;
if(count = 5) then
begin
circle(a,b,c);
floodfill(a, b, clwhite);
a:=100;
b:=b+90;
count:=0;
end;
count:=count+1;
end;
end.
вот еще одна прога
program grnebo;
uses graphABC,crt;
var
x,y:integer;
n,i,r,k:integer;
m:array [1..6] of integer;
begin
randomize;
m[1]:=clred;
m[2]:=clyellow;
m[3]:=clgreen;
m[4]:=clblue;
m[5]:=clolive;
m[6]:=clsilver;
for i:=1 to 50 do begin
x:=300 + random(510)-200;
y:=250 + random(400)-200;
r:=10;
delay(100);
k:= random(6)+1;
SetBrushColor(m[k]);
circle(x,y,r);
end;
end.
Ответ от Ёаня Олейник[активный]
uses GraphAbc;
begin
SetWindowSize (200,200);
SetPenColor (clRed);
SetBrushColor (clRed);
Circle (50,50,20); // (50)-центр по оси x, (50)-центр по оси y, (20)-радиус
end.
Ответ от 22 ответа[гуру]
Привет! Вот подборка тем с похожими вопросами и ответами на Ваш вопрос: как в паскале ABC нарисовать круг?
Источник: 22oa.ru