program D1;
uses GraphABC;
const c: array[1..3] of integer = (15,20,65);
n: array[1..3] of string = (' Белки ',' Жиры ',' Углеводы ');
var nu,u, i: integer;
begin
SetWindowTitle ('Сбалансированное питание');
SetFontSize(15);
TextOut(185,30,'Сбалансированное питание');
SetFontSize(10);
nu:=0;
for i:=1 to 3 do
case i of
1: SetBrushColor(clred);
2: SetBrushColor(clgreen);
3: SetBrushColor(clblue)
end;
TextOut(285,385+(i*20),n[i]+IntToStr(c[i])+' % ');
u:=nu+trunc(c[i]*360/100);
Pie(320,230,150,nu,u);
nu:=u;
SaveWindow ('Диаграмма питания.bmp')
end.
Объяснение:
картинка
procedure TfrmMain.FindFilesOnDisk(Dir : string);
var SR : TSearchRec;
Err : integer;
i, j : integer;
st : string;
if (Dir[Length(Dir)] <> '\') then Dir := Dir + '\';
Err := FindFirst(Dir + '*.*', faAnyFile, SR);
while Err = 0 do
j := 0;
st := AnsiUpperCase(SR.Name);
if lbDirs.Items.Count > 0 then //Если в списке есть каталоги
//Проверить, нет ли среди них
for i := 0 to lbDirs.Items.Count - 1 do
if lbDirs.Items[i] = st then //найденного
j := 1;
break;
end; //if lbDirs.Items[i] = st then
if j = 0 then
if (SR.Name <> '.') and
(SR.Name <> '..') and
((SR.Attr and faDirectory) <> 0) then
inc(NumDir);
DirList.Add(Dir + st);
frmMain.sbMain.Panels[1].Text := IntToStr(NumDir);
pbFind.Position := NumDir;
Application.ProcessMessages;
FindFilesOnDisk(Dir + SR.Name);
end; //if (SR.Name <> '.') and
end; //if j = 0 then
Err := FindNext(SR);
program D1;
uses GraphABC;
const c: array[1..3] of integer = (15,20,65);
n: array[1..3] of string = (' Белки ',' Жиры ',' Углеводы ');
var nu,u, i: integer;
begin
SetWindowTitle ('Сбалансированное питание');
SetFontSize(15);
TextOut(185,30,'Сбалансированное питание');
SetFontSize(10);
nu:=0;
for i:=1 to 3 do
begin
case i of
1: SetBrushColor(clred);
2: SetBrushColor(clgreen);
3: SetBrushColor(clblue)
end;
TextOut(285,385+(i*20),n[i]+IntToStr(c[i])+' % ');
u:=nu+trunc(c[i]*360/100);
Pie(320,230,150,nu,u);
nu:=u;
end;
SaveWindow ('Диаграмма питания.bmp')
end.
Объяснение:
картинка
procedure TfrmMain.FindFilesOnDisk(Dir : string);
var SR : TSearchRec;
Err : integer;
i, j : integer;
st : string;
begin
if (Dir[Length(Dir)] <> '\') then Dir := Dir + '\';
Err := FindFirst(Dir + '*.*', faAnyFile, SR);
while Err = 0 do
begin
j := 0;
st := AnsiUpperCase(SR.Name);
if lbDirs.Items.Count > 0 then //Если в списке есть каталоги
//Проверить, нет ли среди них
for i := 0 to lbDirs.Items.Count - 1 do
if lbDirs.Items[i] = st then //найденного
begin
j := 1;
break;
end; //if lbDirs.Items[i] = st then
if j = 0 then
begin
if (SR.Name <> '.') and
(SR.Name <> '..') and
((SR.Attr and faDirectory) <> 0) then
begin
inc(NumDir);
DirList.Add(Dir + st);
frmMain.sbMain.Panels[1].Text := IntToStr(NumDir);
pbFind.Position := NumDir;
Application.ProcessMessages;
FindFilesOnDisk(Dir + SR.Name);
end; //if (SR.Name <> '.') and
end; //if j = 0 then
Err := FindNext(SR);
end;
end;
Объяснение: