График, дырки в круговой диаграмме Опции

[-Андрей-]

вот процедура.
Но тут одна проблема, что при удеалении элемента отображения диаграммы, получается "дырка", подскажите решение!!!

 procedure ShowTable(tabl : table);
  var i : Integer;
  begin {вывод таблицы}
    writeln('Данные');
    for i :=1 to MAX do
     if tabl[i].busy then
      writeln('ФИО = ',tabl[i].fio,' Соток = ',tabl[i].sot,' Годовой взнос = ',tabl[i].year,
       ' Итого = ',tabl[i].sot*tabl[i].year);
  end; {вывод таблицы}

  procedure CreateDia(tabl : table);
  var i,dr,md : Integer;
      x,y     : Integer;
      angle   : Integer;
      sum     : Integer;
      proc    : array[1..MAX] of LongInt; {для расчета углов диаграммы}
      last    : Integer;
      have    : Integer;
      A   : real;
      xn,yn : Integer;
      prs : string;
  begin {вывод диаграммы}
    dr := DETECT; {инициализация графики}
    md := 0;
    InitGraph(dr,md,'');
    if GraphResult <> grOk then
    begin
      writeln('Не найден файл EGAVGA.BGI');
    end else
    begin {рисовать график}
      SetColor(GREEN);
      Rectangle(0,0,GetMaxX,GetMaxY);
      SetFillSTyle(SOLIDFILL,LIGHTGRAY);
      FloodFill(1,1,GREEN);

      SetColor(BLUE);
      OutTextXY(10,10,'Диаграмма');

      sum := 0;
      last := 1;
      for i:=1 to MAX do
        if tabl[i].busy then
         sum := sum + tabl[i].sot;
      have := 0;
      for i:=1 to MAX do
       if tabl[i].busy then
        begin
          proc[last] := tabl[i].sot;
          proc[last] := proc[i]*360;
          proc[last] := proc[i] div sum;
          have := have + proc[last];
          last := last + 1;
        end;

      have := 360-have;

      proc[last-1] := proc[last-1]+have;
      x := GetMaxX div 2;
      y := GetMaxY div 2;
      Angle := 0;

      for i:=1 to MAX do
      begin
        if tabl[i].busy then
        begin
          if(i<>LIGHTGRAY)then
          SetFillStyle(SOLIDFILL,i)
          else SetFillStyle(SOLIDFILL,BLACK);
          PieSlice(x,y,angle,angle+proc[i],100);

          A:=(angle+angle+proc[i])/2;
          XN:=x+Round(110*Cos(A*Pi/180));
          YN:=y-Round(110*Sin(A*Pi/180));
          if (A>90) and (A<270) then
            Settextjustify(Righttext,0)
          else
            Settextjustify(lefttext,0);
          SetColor(WHITE);
          str(tabl[i].sot,prs);
          Outtextxy(XN,YN,prs);
          angle := angle + proc[i];
        end;
      end;
      ReadKey;
    end; {рисовать график}
    CloseGraph;
  end; {вывод диаграммы}

Сообщение отредактировано: volvo - 6.11.2006 21:18

[volvo]

-Андрей-, можешь привести программу, показывающую возникновение "дырки"? Потому, что не вполне понятно, при каких именно условиях она возникает, какие именно действия ты ДО этого производил?

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

[Гость]

Вот полный код.
Ввод - удачный, график 0- все ОК!!
Удаление - в графике получается ДЫРКА!!!
Сроки поджимают!!!

Код

program Kursovik;
uses Graph,Crt;
const
  MAX = 10; {максимальное количество мест}
type
    item = record
    fio : string[100];
    sot : integer;
    year : byte;
    busy : boolean;
  end;
  table = array[1..MAX] of item; {массив из MAX записей}
    
function FindFree(tabl : table) : Integer;
   var i : Integer;
   begin {ищет первую свободную ячейку}
    FindFree := -1; {нет свободных}
    for i := 1 to MAX do
     if (tabl[i].busy=FALSE) then
     begin {нашли свободную ячейку}
       FindFree := i;
       break; {конец цикла}
     end; {нашли свободную ячейку}
  end; {ищет первую свободную ячейку}



  procedure AddSad(var tabl : table);
  var pos : integer;
  begin {процедура добавления}
    pos := FindFree(tabl);
    tabl[pos].busy := True; {ячейка теперь занята}
    writeln('Vvedite F.I.O.: ');
    readln(tabl[pos].fio);
    writeln('Vvedite colichestvo sotok: ');
    readln(tabl[pos].sot);
    writeln('Vvedite godovoy vznos: ');
    readln(tabl[pos].year);
    writeln('OK!.');
  end; {процедура добавления}

  procedure DelSad(var tabl : table);
  var
    no,i : Integer;
    found : boolean;
    mar : string;
  begin
    writeln('Vvedite F.I.O. dlya udaleniya: ');
    readln(mar);
    found :=False; {не найден}
    for i := 1 to MAX do
     if(tabl[i].busy=TRUE)and(tabl[i].fio = mar)then
     begin
       tabl[i].busy:=FALSE;
       found:=TRUE; {нашли}
       break;
     end;
    if(found)then writeln('Yacheika teper svobodna')
    else writeln('Ukazanniy F.I,O. ne neyden!.');
  end;

  procedure SaveFile(tabl : table);
  var f : file of table;
      name : string;
  begin
    write('Vvedite imya faila (naprimer, my.txt): ');
    readln(name);
    assign(f,name);
    {$i-}
    rewrite(f);
    {$i+}
    if IOResult=0 then
    begin {если нет ошибки}
      write(f,tabl);
      close(f);
      writeln('Dannie zapisani.');

    end {если нет ошибки}
      else writeln('OSHIBKA vvoda\vivoda!');
  end;

  procedure LoadFile(var tabl : table);
  var
    f : file of table;
    name : string;
  begin
    write('Vvedite imya faila (naprimer, my.txt): ');
    readln(name);
    assign(f,name);
    {$i-}
    reset(f);
    {$i+}
    if IOResult=0 then
    begin {если файл найден}
      read(f,tabl);
      close(f);
      writeln('Vse v poryadke. Dannie uspeshno prochitani.');
    end {если файл найден}
    else writeln('Fail ne nayden.');
  end;

  procedure Help;
  begin
    textcolor(LIGHTRED);
    writeln('Help dlya programmy');
    textcolor(LIGHTGRAY);
    writeln('Programma pozvolyaet vesti bazu sadovodov,');
    writeln('sortirovat ih,sohranyat v fail, a tak zhe');
    writeln('vivodit grafik');
  end;

procedure Sort(var tabl : table);
  var
    i,j   : Integer;
    temp  : item;
    tabl2 : table;
    mx    : Integer;
  begin
    mx:=FindFree(tabl)-1;
    for i:= 1 to mx do
    begin
      temp := tabl[i];
      j:=i-1;
      while((j >= 1)and(tabl[j].sot> temp.sot))do
      begin
        tabl[j+1] := tabl[j];
        j:=j-1;
      end;
      tabl[j+1]:= temp;
    end;
    writeln('Sortirovka zavershena.');
  end;


  procedure Tablica(tabl : table);
  var i : Integer;
  begin {вывод таблицы}
    writeln('Dannie');
    for i :=1 to MAX do
     if tabl[i].busy then
      writeln('F.I.O. = ',tabl[i].fio,' Sotka =  ',tabl[i].sot,' Godovoy vznos = ',tabl[i].year,
       ' Itogo = ',(tabl[i].sot)*(tabl[i].year));
  end; {вывод таблицы}

  procedure Diagramma(tabl : table);
  var i,dr,md : Integer;
      x,y     : Integer;
      angle   : Integer;
      sum     : Integer;
   proc    : array[1..MAX] of LongInt; {для расчета углов диаграммы}
      last    : Integer;
      have    : Integer;
      A   : real;
      xn,yn : Integer;
      prs : string;
  begin {вывод диаграммы}
    dr := DETECT; {инициализация графики}
    md := 0;
    InitGraph(dr,md,'');
    if GraphResult <> grOk then
    begin
      writeln('Ne naiden fail EGAVGA.BGI');
    end else
    begin {рисовать график}
      SetColor(GREEN);
      Rectangle(0,0,GetMaxX,GetMaxY);
      SetFillSTyle(SOLIDFILL,LIGHTGRAY);
      FloodFill(1,1,GREEN);

      SetColor(BLUE);
      OutTextXY(10,10,'Diagramma');

      sum := 0;
      last := 1;
      for i:=1 to MAX do
        if tabl[i].busy then
         sum := sum + tabl[i].sot;
      have := 0;
      for i:=1 to MAX do
       if tabl[i].busy then
        begin
          proc[last] := tabl[i].sot;
          proc[last] := proc[i]*360;
          proc[last] := proc[i] div sum;
          have := have + proc[last];
          last := last + 1;
        end;

      have := 360-have;

      proc[last-1] := proc[last-1]+have;
      x := GetMaxX div 2;
      y := GetMaxY div 2;
      Angle := 0;

      for i:=1 to MAX do
      begin
        if tabl[i].busy then
        begin
          if(i<>LIGHTGRAY)then
          SetFillStyle(SOLIDFILL,i)
          else SetFillStyle(SOLIDFILL,BLACK);
          PieSlice(x,y,angle,angle+proc[i],100);

          A:=(angle+angle+proc[i])/2;
          XN:=x+Round(110*Cos(A*Pi/180));
          YN:=y-Round(110*Sin(A*Pi/180));
          if (A>90) and (A<270) then
            Settextjustify(Righttext,0)
          else
            Settextjustify(lefttext,0);
          SetColor(WHITE);
          str(tabl[i].sot,prs);
          Outtextxy(XN,YN,prs);
          angle := angle + proc[i];
        end;
      end;
      ReadKey;
    end; {рисовать график}
    CloseGraph;
  end; {вывод диаграммы}


  procedure Find(tabl : table);
  var i : Integer;
      s : String;
  begin {поиск}
    write('Vvedit F.I.O. dlya poiska: ');
    readln(s);
    writeln('Rezultat');
    for i :=1 to MAX do
     if(tabl[i].busy)and(tabl[i].fio=s)then
      writeln('F.I.O. = ',tabl[i].fio,' Sotka = ',tabl[i].sot,
       ' Godovoy vznos = ',tabl[i].year,
       ' Itogo = ',tabl[i].sot*tabl[i].year);
  end; {поиск}

  var
    ch      : byte;
    tabl    : table;
    s : integer;
  begin
    s:=1;
    repeat
      ClrScr;
      textcolor(LIGHTGRAY);
      writeln('Nazhmite:');
      writeln('');
      if(s=1)then textcolor(yellow)
      else textcolor(white);
      writeln(' 1 - Dobavlenie ');
      if(s=2)then textcolor(yellow)
      else textcolor(white);
      writeln(' 2 - Udalenie ');
      if(s=3)then textcolor(yellow)
      else textcolor(white);
      writeln(' 3 - Sortirovka ');
      if(s=4)then textcolor(yellow)
      else textcolor(white);
      writeln(' 4 - Diagramma ');
      if(s=5)then textcolor(yellow)
      else textcolor(white);
      writeln(' 5 - Zapisat ');
      if(s=6)then textcolor(yellow)
      else textcolor(white);
      writeln(' 6 - Prochitat ');
      if(s=7)then textcolor(yellow)
      else textcolor(white);
      writeln(' 7 - Vivod dannih ');
      if(s=8)then textcolor(yellow)
      else textcolor(white);
      writeln(' 8 - Poisk ');
      if(s=9)then textcolor(yellow)
      else textcolor(white);
      writeln(' 9 - Pomosch ');
      if(s=10)then textcolor(lightRED)
      else textcolor(white);
      writeln(' 10 - Vihod ');
      ch:=ord(readkey);
      if(ch=0)then ch:=ord(readkey);
      case ch of
         72 : if(s-1>=1)then begin ch:=0; s:=s-1; end else  ch:=0;
         80 : if(s+1<=10)then begin ch:=0;  s:=s+1; end else  ch:=0;
         13 : ch:=s;
      end; {case}
      if(ch<>0)then
      begin
        writeln;
        case ch of {обработка кнопок}
          1 : AddSad(tabl);
          2 : DelSad(tabl);
          3 : Sort(tabl);
          4 : Diagramma(tabl);
          5 : SaveFile(tabl);
          6 : LoadFile(tabl);
          7 : Tablica(tabl);
          8 : Find(tabl);
          9 : Help;
          10 : break
          else writeln('Nevernaya komanda.');
        end; {обработка кнопок}
        writeln('Nazhmite <ENTER> dlya prodolzheniya.');
        readln;
      end;
    until (ch=10);
  end.

Пользуемся тэгами!

Сообщение отредактировано: GoodWind - 25.12.2005 14:07