помогите написать очень сложную блок схему, прога с вертикальным меню Опции

[Seven]

прога наз-ся таблица металов
блок схему такую огромную сделать немогу,очень нужна ваша помощь

 
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.

хотябы посоветуйте что нибудь

[volvo]

хотябы посоветуйте что нибудь

Совет "переписать программу так, чтобы она была в 3 раза короче" - не принимается? И не только в 3, может и еще короче...