прога наз-ся таблица металов
блок схему такую огромную сделать немогу,очень нужна ваша помощь
Uses CRT;
Const MaxMenuItem = 17;
Var Ret : Byte;
f: text;
s: string;
Function MainMenu(R_Select:Byte):Byte;
Type TMenu = record
X,Y : Byte;
S : String[20];
End;
Var
Menu : Array [0..MaxMenuItem] Of TMenu;
Run : Boolean;
Sel : Byte;
TC,TB : Byte;
Procedure DrawMenu;
Var I : Byte;
Begin
For I := 0 To MaxMenuItem Do
Begin
GotoXY(Menu[I].X, Menu[I].Y);
Write(Menu[I].S);
End;
End;
Procedure Select (I:Byte);
Begin
TextBackground(TC); TexTColor(TB);
GotoXY(Menu[I].X, Menu[I].Y);
Write(Menu[I].S);
TextBackground(TB); TexTColor(TC);
End;
Procedure DeSelect (I:Byte);
Begin
GotoXY(Menu[I].X, Menu[I].Y);
Write(Menu[I].S);
End;
Begin
Menu[0].S := 'Li'; Menu[0].X := 5; Menu[0].Y :=4;
Menu[1].S := 'Na'; Menu[1].X := 5; Menu[1].Y :=5;
Menu[2].S := 'Mg'; Menu[2].X := 5; Menu[2].Y :=6;
Menu[3].S := 'Al'; Menu[3].X := 5; Menu[3].Y :=7;
Menu[4].S := 'K'; Menu[4].X := 5; Menu[4].Y :=8;
Menu[5].S := 'Ca'; Menu[5].X := 5; Menu[5].Y :=9;
Menu[6].S := 'Ti'; Menu[6].X := 5; Menu[6].Y :=10;
Menu[7].S := 'Cr'; Menu[7].X := 5; Menu[7].Y :=11;
Menu[8].S := 'Fe'; Menu[8].X := 5; Menu[8].Y :=12;
Menu[9].S := 'Ni'; Menu[9].X := 5; Menu[9].Y :=13;
Menu[10].S := 'Cu'; Menu[10].X := 5; Menu[10].Y :=14;
Menu[11].S := 'Zn'; Menu[11].X := 5; Menu[11].Y :=15;
Menu[12].S := 'Ag'; Menu[12].X := 5; Menu[12].Y :=16;
Menu[13].S := 'Ba'; Menu[13].X := 5; Menu[13].Y :=17;
Menu[14].S := 'Au'; Menu[14].X := 5; Menu[14].Y :=18;
Menu[15].S := 'Hg'; Menu[15].X := 5; Menu[15].Y :=19;
Menu[16].S := 'Pb'; Menu[16].X := 5; Menu[16].Y :=20;
Menu[17].S := 'exit';Menu[17].X :=5; Menu[17].Y :=21;
ClrScr;
TC := TextAttr mod 16;
TB := TextAttr div 16;
DrawMenu;
Sel := R_Select;
Select(Sel);
Run := False;
While Not Run Do Begin
Case ReadKey Of
#13 : Run := True;
#27 : Begin
Run := True;
Sel := MaxMenuItem;
End;
#0 : Case ReadKey Of
#72 : Begin
DeSelect(Sel);
If Sel = 0
Then Sel := MaxMenuItem
Else Sel := Sel - 1;
Select(Sel);
End;
#80 : Begin
DeSelect(Sel);
If Sel = MaxMenuItem
Then Sel := 0
Else Sel := Sel + 1;
Select(Sel);
End;
End;
End;
End;
MainMenu := Sel;
ClrScr;
End;
Begin
ClrScr;
Ret := 0;
Repeat
Ret := MainMenu(Ret);
Case Ret Of
0: Begin
WriteLn('Vibrano Li ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
1: Begin
WriteLn('Vibrano Na ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
2: Begin
WriteLn('Vibrano Mg ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
3: Begin
WriteLn('Vibrano Al ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
4: Begin
WriteLn('Vibrano K ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
5: Begin
WriteLn('Vibrano Ca ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
6: Begin
WriteLn('Vibrano Ti ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
7: Begin
WriteLn('Vibrano Cr ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
8: Begin
WriteLn('Vibrano Fe ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
9: Begin
WriteLn('Vibrano Ni ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
10: Begin
WriteLn('Vibrano Cu ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
11: Begin
WriteLn('Vibrano Zn ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
12: Begin
WriteLn('Vibrano Ag ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
13: Begin
WriteLn('Vibrano Ba ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
14: Begin
WriteLn('Vibrano Au ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
15: Begin
WriteLn('Vibrano Hg ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
16: Begin
WriteLn('Vibrano Pb ', Ret);
assign(f,'c:\A.txt');
reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
End;
Else Begin
WriteLn('‚л室 Ё§ Їа®Ја ¬¬л');
ReadLn;
End;
End; {case Ret}
Until Ret = MaxMenuItem;
End.
как ты предложиш её укоротить без потери функциональности?
Убрать все копи/пасты, и заменить их на несколько строк. Основная часть становится вот такой:
BeginЯ уж не говорю о том, что можно задать весь массив Menu, как константу, что тоже облегчит работу с блок-схемой...
ClrScr;
Ret := 0;
Repeat
Ret := MainMenu(Ret);
if Ret < 17 then begin
WriteLn('Vibrano ', Menu[Ret], ' ', Ret);
assign(f,'c:\A.txt'); reset(f);
readln(f,s);
writeln(s);
close(f);
ReadLn;
end
else begin
WriteLn('‚л室 Ё§ Їа®Ја ¬¬л');
ReadLn;
End;
Until Ret = MaxMenuItem;
End.
спасибо!так попроще будет
если нетрудно помоги насчет массива Menu и константы