CHART.PAS 3.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  1. Uses Graph,Crt;
  2. Const
  3. Path = '';
  4. Xpol = 25;
  5. YPol = 25;
  6. PieX = 200;
  7. PieY = 200;
  8. Radius = 100;
  9. Type TypeVal = record
  10. num : Integer;
  11. per : Real;
  12. end;
  13. Var
  14. num_of_elem,type_of_diag : byte;
  15. values : array [1..15] of TypeVal;
  16. Summa : Integer;
  17. {---------=====================================---------------}
  18. Procedure GetValues;
  19. var
  20. i:Byte;
  21. begin
  22. ClrScr;
  23. Summa := 0;
  24. Num_of_elem := 0;
  25. for i := 1 to 15 do values[i].num := 0;
  26. WriteLn('Вводите элементы (не более 15), конец ввода - 0');
  27. i := 0;
  28. repeat
  29. inc(i);
  30. ReadLn(values[i].num);
  31. until (i > 14) or (values[i].num = 0);
  32. WriteLn('Введите тип диаграмы(1-один график, 0-много графиков)');
  33. ReadLn(type_of_diag);
  34. for i := 1 to 15 do if values[i].num <> 0 then inc(num_of_elem);
  35. if type_of_diag = 1 then
  36. For i := 1 to num_of_elem do Summa := Summa + values[i].num
  37. else
  38. for i := 1 to num_of_elem do
  39. if values[i].num > summa then summa := values[i].num;
  40. For i := 1 to num_of_elem do values[i].per := values[i].num / Summa;
  41. end;{GetValues}
  42. {-----------------------------------------}
  43. Procedure InitT;
  44. var
  45. Gd, Gm: Integer;
  46. i : byte;
  47. begin
  48. Gd := Detect;
  49. InitGraph(Gd, Gm,Path);
  50. if GraphResult <> grOk then
  51. WriteLn(GraphErrorMsg(GraphResult))
  52. else
  53. begin
  54. Rectangle(GetMaxX div 10,GetMaxY div 10,9*(GetMaxX div 10),9*(GetMaxY div 10));
  55. SetViewPort(GetMaxX div 10+1,GetMaxY div 10+1,9*(GetMaxX div 10)-1,9*(GetMaxY div 10)-1,ClipOn);
  56. SetWriteMode(XorPut);
  57. end;
  58. end;{InitT}
  59. {---------------------------------------}
  60. Procedure Chart2;
  61. var
  62. num : string;
  63. i : byte;
  64. begin
  65. for i := 1 to num_of_elem do
  66. begin
  67. SetFillStyle(solidfill,i);
  68. Bar3D(i*30,350,i*30+20,350 - round(330*values[i].per),5,true);
  69. Str(values[i].num,num);
  70. SetTextJustify(CenterText,TopText);
  71. OutTextXY(i*30+10,360,num)
  72. end;
  73. SetTextJustify(LeftText,TopText);
  74. end{chart2};
  75. {---------------------------------------}
  76. Procedure Chart;
  77. var
  78. String1,s2 : string;
  79. i : byte;
  80. LastVal,LastArc : Integer;
  81. begin
  82. for i := 1 to num_of_elem do
  83. begin
  84. Str(values[i].num,string1);
  85. str(round(values[i].per*100),s2);
  86. string1 := concat('Число ',string1,'(',s2,'%)');
  87. SetFillStyle(SolidFill,i);
  88. Bar(330,((387 div 2) - (Num_of_elem * 10)-20)+i*20,380,((387 div 2) - (Num_of_elem * 10)-20)+i*20+15);
  89. OutTextXY(390,((380 div 2) - (Num_of_elem * 10)-15)+i*20,string1);
  90. end;
  91. LastVal := Ypol;
  92. LastArc := 0;
  93. for i := 1 to num_of_elem do
  94. begin
  95. SetFillStyle(SolidFill,i);
  96. if i = 1 then
  97. begin
  98. Bar3d(Xpol,LastVal,Xpol+40,round(LastVal+Values[i].per*330),10,true);
  99. PieSlice(PieX,PieY,LastArc,round(Lastarc+Values[i].per*360),Radius);
  100. end
  101. else if i = num_of_elem then
  102. begin
  103. Bar3d(Xpol,LastVal,Xpol+40,round(LastVal+Values[i].per*330),10,false);
  104. PieSlice(PieX,PieY,LastArc,360,Radius);
  105. end
  106. else
  107. begin
  108. Bar3d(Xpol,LastVal,Xpol+40,round(LastVal+Values[i].per*330),10,false);
  109. PieSlice(PieX,PieY,Lastarc,round(Lastarc+Values[i].per*360),Radius);
  110. end;
  111. LastVal := round(LastVal+Values[i].per*330);
  112. LastArc := round(LastArc+Values[i].per*360);
  113. end;
  114. Circle(PieX,PieY,Radius);
  115. end; {Chart}
  116. {-=====================================-}
  117. Begin
  118. GetValues;
  119. InitT;
  120. if type_of_diag = 1 then Chart else chart2;
  121. Readln;
  122. CloseGraph;
  123. End.