2

Поставлена задача:нарисовать окружность методом Брезенхема.

Саму окружность нарисовать удалось,но не получается в этот метод как-то добавить утолщение.

Как это можно сделать? Вот что должно получиться(делал другим методом)

Радиус 55,максимальная толщина 20.

Окружность

UPD:изменил код,было пару ошибок.

вот что пока есть:

{$G+}
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   {64y}
        mov di,ax
        shl ax,2  {256}
        add di,ax  {320y}
        add di,x
        mov al,12
        stosb      {mov es:[di],a}
     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); {построить 4 симметричные точки}
  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<r)) do {обход идет по верхней правой четверти}
    begin
     sim(x,y);
     dv:=abs(r*r - x*x - (y-1)*(y-1));{сдвиг на 1 вниз}
     dh:=abs(r*r - (x+1)*(x+1) - y*y); {сдвиг на 1 вправо}
     dd:=abs(r*r - (x+1)*(x+1) - (y-1)*(y-1)); {сдвиг на 1 по диагонали вправо и вниз}
     if(dv<dh) then {если сдвиг вниз ближе к радиусу круга}
      begin
        dec(y);
       {Вставил сюда кусок,который по идее должен добавлять толщину,но на деле просто сам круг еще дольше выводится}
       { for i:=x-k to (x+k) do
        begin
             sim(i,y);
             inc(k);
        end;}
        if(dd<dv) then inc(x); {если сдвиг по диагонали ближе к радиусу круга}
      end
     else {если сдвиг вправо ближе к радиусу круга}
      begin
        inc(x);
        if(dd<dh) then dec(y); {если сдвиг по диагонали ближе к радиусу круга}
      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.
2
  • А почему не получается? Вместо рисования одного пиксела рисуется горизонтальный отрезок, так что for i:=x-k to (x+k) - верный подход, если рисование окружности вообще работает.
    – MBo
    23 окт 2018 в 2:59
  • Рисование окружности работает,но не получается реализовать рисование отрезков,не понимаю где организовать этот цикл. В моем случае ,если добавить тот цикл закрашивает вообще весь экран
    – AndrrK
    24 окт 2018 в 10:47

1 ответ 1

1

Примерно так:

 procedure sim(x, y: integer); {построить 4 симметричные точки}
 var
   sh: integer;
  begin
    for sh := -10 to 10 do begin
      PP(x0+x + sh, y0+y); {верхняя правая четверть}
      PP(x0+x + sh, y0-y); {нижняя правая четверть}
      PP(x0-x + sh, y0+y); {верхняя левая четверть}
      PP(x0-x + sh, y0-y); {нижняя левая четверть}
    end;
  end;

Для регулировки ширины:

sy := 2 + 5 * (rad - y) div rad;
for sh := -sy to sy do begin ...

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge you have read our privacy policy.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.