IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

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





Группа: Пользователи
Сообщений: 3
Пол: Мужской

Репутация: -  0  +


прога наз-ся таблица металов
блок схему такую огромную сделать немогу,очень нужна ваша помощь
 
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.



хотябы посоветуйте что нибудь
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Цитата
хотябы посоветуйте что нибудь
Совет "переписать программу так, чтобы она была в 3 раза короче" - не принимается? И не только в 3, может и еще короче...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 3
Пол: Мужской

Репутация: -  0  +


как ты предложиш её укоротить без потери функциональности?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Убрать все копи/пасты, и заменить их на несколько строк. Основная часть становится вот такой:
Begin
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, как константу, что тоже облегчит работу с блок-схемой...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5





Группа: Пользователи
Сообщений: 3
Пол: Мужской

Репутация: -  0  +


спасибо!так попроще будет
если нетрудно помоги насчет массива Menu и константы

Сообщение отредактировано: Seven -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.10.2020 19:32
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name