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

[-Андрей-]

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

 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

[Гость]

Вот полный код.
Ввод - удачный, график 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