Создание круговой диаграммы

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
  ExtCtrls, StdCtrls,shellapi,LCLType;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    //procedure Label1Click(Sender: TObject);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    //PROCEDURE FormMouseMove(Sender: TObject; Shift: TShiftState; X,
    //    Y: Integer);
    //procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
    //    Y: Integer);
    procedure Label1MouseEnter(Sender: TObject);
    procedure Label1MouseLeave(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
const
NR = 4; // кол-во строк в таблице
implementation
 
{$R *.lfm}
var
n: array[1..NR] of real; // значения категорий
p: array[1..NR] of real; // процент категории в общей сумме
h: array[1..NR] of integer; // высота столбиков диаграммы // цвет столбиков диаграммы
BarColor: array[1..4] of TColor = (clRed,clGreen,clBlue,clYellow);// ввод и обработка
// если исходные данные введены, то Obr = TRUE
function Obr : boolean;
var
sum: real; // сумма категорий
ra: integer; // номер категории, имеющей максимальное значение
i,m: integer;
begin
obr := FALSE; // пусть исх. данные не введены
// скопируем содержимое второго столбца
// в массив исходных данных
for i:=1 to NR do
// здесь возможно исключение (ошибка) преобразования,
// если пользователь не ввел данные
begin
try
n[i] := StrToFloat(Form1.StringGrid1.Cells[1,i]);
except
on EConvertError do
begin
ShowMessage('Надо ввести данные во все ячейки второй колонки.'); //#13
exit;
end;
end;
end;
// вычислим сумму категорий (эл-тов второго столбца)
sum:= 0;
for i:= 1 to NR do
sum:= sum + n [ i ]; // вычислим процент каждой категории
for i:= 1 to NR do
p[i]:= n[i] / sum; // определим категорию с максимальным значением
m:= 1;
for i := 2 to NR do
if n[i] > n[m] then m:= i; // пусть максимальному значению соответствует
// столбик высотой в Imagel.Height-20 пикселов
// вычислим высоту остальных столбиков
for i :=1 to NR do
h[i] := Round((Form1.Image1.Height - 20) *
n[i] /n[m]) ; // все готово
// можно строить диаграмму
obr := TRUE;
end;
// диаграмма
procedure diagr;
const
WR = 25; // ширина столбика
DP = 10; // расстояние между столбиками
var
i,x,y: integer;// левый нижний угол столбика i: integer;
begin
with Form1.Image1 do
begin
x:= 10;
y:= Height;
Canvas.Brush.Color := clWindow;
Canvas.Rectangle(0,0,Width,Height);
// *** рисуем столбики ***
for i:= 1 to 4 do
begin
Canvas.Brush.Color := BarColor[i]; // цвет столбика
Canvas.Rectangle(x,y,x+WR,y-h[i]); // столбик
Canvas.Brush.Color := clWindow; // чтобы область за текстом не была окрашена подпись данных (над столбиком)
Canvas.TextOut(x,y-h[i]-15,
FloatToStrF(p[i]*100,ffGeneral,3,2)+'%');
x := x + WR + DP;
end; //
// здесь х — координата левой границы
// последнего столбика
x:= x + 20;
y:= 20; // 20 пикселов от верхнего края Imagel
for i:=1 to 4 do
begin
Canvas.Brush.Color := BarColor[i]; // цвет прямоугольника
Canvas.Rectangle(x,y,x+25,y+14); // прямоугольник легенды
Canvas.Brush.Color:= clWindow;
Canvas.TextOut(x+WR+10,y,
Form1.StringGrid1.Cells[0,i]);
y:= y + 20;
end;
end; // with Form1.Image1
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//заголовки колонок
StringGrid1.Cells[0,0] := 'Категория';
StringGrid1.Cells[1,0] := 'Кол-во';
StringGrid1.Width :=
StringGrid1.ColWidths[01 + StringGrid1.ColWidths[1]+5];end;// нажатие клавиши в ячейке таблицы (компонента StringGrid)
 
 
 
// в результате нажатия клавиши <Enter> курсор переходит
// в следующую ячейку
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
VAR
O: Char;
begin
if Key = #13 then
begin
// нажата клавиша <Enter>
if StringGrid1.Col < StringGrid1.ColCount - 1
then
// ячейка не в последнем столбце
StringGrid1.Col := StringGrid1.Col + 1 // к след. столбцу
else
 
// ячейка в последнем столбце
 
if ( StringGrid1.Row < StringGrid1.RowCount - 1) then
begin
 
// в первый столбец следующей строки
 
StringGrid1.Col :=0;
StringGrid1.Row := StringGrid1.Row +1;
end
else Button1.SetFocus;
exit;
 
// во вторую колонку разрешается вводить только числа
 
if StringGrid1.Col = 1 then
 
// клавиша нажата в ячейке второй колонки
case key of
 '0'..'9':;
 #8:;
 else key:=#0;
begin
if (key=DecimalSeparator) and
   (Pos(DecimalSeparator,StringGrid1.Cells[StringGrid1.Row,StringGrid1.Col]) > 0)
then Key := Char(O);
end;
end;
end;
 
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Obr // исходные данные введены
then diagr; // строим диаграмму
end;
 
procedure TForm1.Label1Click(Sender: TObject);
begin
end;
 
procedure TForm1.Label1MouseEnter(Sender: TObject);
begin
  Label1.Font.Color := clYellow;
end;
 
procedure TForm1.Label1MouseLeave(Sender: TObject);
begin
  Label1.Font.Color := clRed;
end;
end.