Пример окна программы во время ее работы приведен на рис. 1.26.

Рис. 1.26. Окно программы Гистограмма

implementation •{$R *.dfm}const
NR = 4; // кол-во строк в таблице
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; // сумма категорий
га: integer; // номер категории, имеющей максимальное значение
i: integer;
begin
obr := FALSE; // пусть исх. данные не введены
// скопируем содержимое второго столбца
// в массив исходных данных
for i:=l to NR do
// здесь возможно исключение (ошибка) преобразования,
// если пользователь не ввел данные
begin
try
n[i] := StrToFloat(Forml.StringGridl.Cells[1,i]);
except
on EConvertError do
begin
ShowMessage('Надо ввести данные во все' + #13 +
'ячейки второй колонки.');
exit;
end;
end;
end;
// вычислим сумму категорий (эл-тов второго столбца)
sum := 0;
for i:=l to NR do
sum := sum + n [ i ]; // вычислим процент каждой категории
for i:=l 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((Forml.Imagel.Height - 20) *
n[i] /n[m]) ; // все готово
// можно строить диаграмму
obr := TRUE;
end;
// диаграмма
procedure diagr;
const
WR = 25; // ширина столбика
DP. = 10; // расстояние между столбиками
var
х,у. integer; .// левый нижний угол столбика i: integer;
begin
with Forml. Imagel do
begin
x:=10;
y.=Height;
Canvas.Brush.Color := clWindow;
Canvas.Rectangle(0,0,Width,Height);
// *** рисуем столбики ***
for i:=l to 4 do
begin
Canvas.Brush.Color := BarColor[i]; // цвет столбика
«
Canvas.Rectangle(x,у,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 + DR;
end; // *** легенда ***
// здесь х — координата левой границы
// последнего столбика
х := х + 20;
у:=20; // 20 пикселов от верхнего края Imagel
for i:=l to 4 do
begin
Canvas.Brush.Color := BarColor[i]; // цвет прямоугольника
11 легенды
Canvas.Rectangle(x,у,x+25,y+14); // прямоугольник легенды
Canvas.Brush.Color := clWindow;
Canvas.TextOut(x+WR+10,у,
Forml.StringGridl.Cells[0,i]);
у := у + 20;
end;
end; // with Forml.Imagel
end;procedure TForml.FormCreate(Sender: TObject);
begin
// определим заголовки колонок
StringGridl.Cells[0,0] := 'Категория';
StringGridl.Cells[1,0] := 'Кол-во1;
StringGridl.Width :=
StringGridl.ColWidths[01 + StringGridl.ColWidths[l]+5;end;// нажатие клавиши в ячейке таблицы (компонента StringGrid)
// в результате нажатия клавиши курсор переходит
// в следующую ячейку
procedure TForml.StringGridlKeyPress(Sender: TObject;
var Key: Char);
begin
// Col, Row — номер колонки и строки,
// в которой находится курсор (нумерация с нуля).
// ColCount и RowCount — кол-во колонок и строк if Key = #13 then
begin
// нажата клавиша
if StringGridl.Col < StringGridl.ColCount - 1
then
// ячейка не в последнем столбце
StringGridl.Col := StringGridl.Col + 1 // к след. столбцу
else
// ячейка в последнем столбце
if ( StringGridl.Row < StringGridl.RowCount — 1) then
begin
// в первый столбец следующей строки
StringGridl.Col :=0;
StringGridl.Row := StringGridl.Row +1;
end
else Buttonl.SetFocus;
exit;
// во вторую колонку разрешается вводить
// только числа
if StringGridl.Col = 1 then
// клавиша нажата в ячейке
'// второй колонки
case Key of
1 0' . . ' 9', # 8 :;
iii i .
begin
Key := DecimalSeparator;
if Pos(DecimalSeparator,
StringGridl.Cells[StringGridl.Row,
StringGridl.Col]) о О
then Key := Char(O);
end;
else Key := Char(O);
end;
end;// щелчок на кнопке Построить
procedure TForml.ButtonlClick(Sender: TObject);
begin
if Obr // исходные данные введены
then diagr; // строим диаграмму
end;end.