Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.04.2012, 18:06   #1
afirat
Пользователь
 
Регистрация: 19.04.2012
Сообщений: 32
По умолчанию Нужно создать элементарное меню в паскале

Сам код программы есть, но надо чтоб при запуске выбивались такие пункты меню: "Запуск программы", "О программе", "Выход".
Казалось бы это просто, но я ноль в этом, так что нужна ваша помощь.
Ниже сама программа, нужно чтоб она включалась при выбора пункта "Запуск программы". Буду рад если напишите красивое меню, но и простое тоже подойдет. Заранее спасибо.
Код:
Program kursovaya;
Const
 Nmax=20;
type
 VectorType = ARRAY[1..Nmax] OF Real;
 MatrixType = ARRAY[1..Nmax] OF VectorType;
function Gauss(n:Byte;A:MatrixType;B:VectorType;var x:VectorType):boolean;
var
 i,j,k,iMax:Byte;
 tmp,Max,d:Real;
 v:VectorType;
begin
 for k:=1 to n-1 do
 begin
  Max:=Abs(A[k,k]);
  iMax:=k;
  for i:=k+1 to n do
   if Abs(A[i,k])>Max then
   begin
    Max:=Abs(A[i,k]);
    iMax:=i;
   end;
  IF Max=0 THEN
  begin
   Gauss:=false;
   Exit
  end;
 IF iMax<>k then
 begin
  Tmp:=B[k];
  B[k]:=B[iMax];
  B[iMax]:=Tmp;
  v:=A[k];
  A[k]:=A[iMax];
  A[iMax]:=v
 end;
 for i:=k+1 to n do
  begin
   d:=A[i,k]/A[k,k];
   for j:=k to n do
    A[i,j]:=A[i,j]-d*A[k,j];
    B[i]:=B[i]-d*B[k];
  end;
 end;
 if A[n,n]=0 then
 begin
  Gauss:=false;
  Exit
 end;
 { ObPATHblu XoD }
 X[n]:=B[n]/A[n,n];
 for i:=n-1 downto 1 do
 begin
  tmp:=B[i];
  for j:=i+1 to n do
   tmp:=tmp-A[i,j]*X[j];
  X[i]:=tmp/A[i,i]
 end;
 Gauss:=true
end;
var
 n,i,j:Byte;
 a:MatrixType;
 b,x:VectorType;
begin
 Write('Vvedite razmery matricy');
 READ(n);
 Writeln('Rasshirennaya matrica');
 for i:=1 to n do
 begin
  for j:=1 to n do
  begin
   write('A[' ,i, ',' ,j, ']=');
   readln(a[i,j]);
  end;
  Write('b[' ,i, ']=');
  readln(b[i]);
 end;
 if not Gauss(n,a,b,x) then
 begin
  Writeln('Matrica vyrozhdena');
  Halt;
 end;
 Writeln('Reshenie sistemy');
 for i:=1 to n do
 begin
  for j:=1 to n do
   b[i]:=b[i]-a[i,j]*x[j];
 Writeln(x[i]:12,' ',b[i]:12)
 end;
 readln
end.
afirat вне форума Ответить с цитированием
Старый 19.04.2012, 20:47   #2
afirat
Пользователь
 
Регистрация: 19.04.2012
Сообщений: 32
По умолчанию

что, никто не поможет?
afirat вне форума Ответить с цитированием
Старый 19.04.2012, 20:48   #3
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,291
По умолчанию

Заготовка для красивого меню:
Код:
{@author voltage}
uses graph,crt; 
 
const def_bk_color=7;             {default background color}
      def_font=7;                 {default font}
      def_color=8;                {color of element}
      choice_color=1;             {color of chosen element}
      drv_path='c:\pascal\bgi';   {driver path}
 
var d,m,e:integer; 
    a:array[1..10] of string; 
    i,n:byte; 
    break_flag:boolean; 
 
procedure redraw(z:shortint); 
begin
setbkcolor(def_bk_color); 
settextstyle(def_font,0,5); 
for i:=1 to n do begin
 
if(i=z) then setcolor(choice_color); 
 
outtextxy( 
    round(getmaxx/2)-round(textwidth(a[i])/2), 
    round(getmaxy/2)+textheight(a[i])*(i-(round(n/2)+1)), 
    a[i] 
); 
 
if(i=z) then setcolor(def_color); 
end; 
end; 
 
function call_menu:shortint; 
var z:shortint; 
    c:char; 
begin
z:=1; 
repeat
redraw(z); 
c:=readkey; 
 
case c of
  #72:dec(z); 
  #80:inc(z); 
  #27:break_flag:=true; 
end; 
 
if(z<1) then z:=n; 
if(z>n) then z:=1; 
 
until c=#13; 
call_menu:=z; 
end; 
 
procedure exec_handler(z:shortint); 
var s:string; 
begin
cleardevice; 
str(z,s); 
s:='selected #'+s; 
outtextxy( 
    round(getmaxx/2)-round(textwidth(s)/2), 
    round(getmaxy/2)-round(textheight(s)/2), 
    s 
); 
readln; 
cleardevice; 
end; 
 
begin
{clrscr;}
 
d:=detect; 
m:=2; 
 
{readln(n); 
for i:=1 to n do readln(a[i]);}
 
n:=5; 
a[1]:='option 1'; 
a[2]:='option 2'; 
a[3]:='option 3'; 
a[4]:='option 4'; 
a[5]:='option 5'; 
 
initgraph(d,m,drv_path); 
break_flag:=false; 
 
e:=graphresult; 
 
if e<>grok then begin
    writeln(grapherrormsg(e)); 
    readln; 
    halt(1); 
end; 
 
repeat
exec_handler(call_menu); 
until break_flag; 
 
end.
Дерзайте.
Вам осталось изменить содержимое массива a и в процедуре exec_handler обрабатывать индекс выбранной строчки (вызывать свой код).
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA вне форума Ответить с цитированием
Старый 19.04.2012, 20:53   #4
afirat
Пользователь
 
Регистрация: 19.04.2012
Сообщений: 32
По умолчанию

спасибо, но я не разбираюсь в паскале, поэтому я не понимаю ничего. Мне б такое меню, куда просто в тупую в одно место вставить код программы и все, чтоб работало.
afirat вне форума Ответить с цитированием
Старый 19.04.2012, 22:48   #5
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,291
По умолчанию

Что-то такое
Код:
{@author voltage}
uses graph,crt; 
 
const def_bk_color=0;             {default background color}
      def_font=7;                 {default font}
      def_color=7;                {color of element}
      choice_color=4;             {color of chosen element}
      drv_path='c:\pascal\bgi';   {driver path}
 
var d,m,e:integer; 
    ac:array[1..10] of string; 
    nc:byte;
    break_flag:boolean; 


Const
 Nmax=20;
type
 VectorType = ARRAY[1..Nmax] OF Real;
 MatrixType = ARRAY[1..Nmax] OF VectorType;

var
 n,i,j:Byte;
 a:MatrixType;
 b,x:VectorType;

function Gauss(n:Byte;A:MatrixType;B:VectorType;var x:VectorType):boolean;
var
 i,j,k,iMax:Byte;
 tmp,Max,d:Real;
 v:VectorType;
begin
 for k:=1 to n-1 do
 begin
  Max:=Abs(A[k,k]);
  iMax:=k;
  for i:=k+1 to n do
   if Abs(A[i,k])>Max then
   begin
    Max:=Abs(A[i,k]);
    iMax:=i;
   end;
  IF Max=0 THEN
  begin
   Gauss:=false;
   Exit
  end;
 IF iMax<>k then
 begin
  Tmp:=B[k];
  B[k]:=B[iMax];
  B[iMax]:=Tmp;
  v:=A[k];
  A[k]:=A[iMax];
  A[iMax]:=v
 end;
 for i:=k+1 to n do
  begin
   d:=A[i,k]/A[k,k];
   for j:=k to n do
    A[i,j]:=A[i,j]-d*A[k,j];
    B[i]:=B[i]-d*B[k];
  end;
 end;
 if A[n,n]=0 then
 begin
  Gauss:=false;
  Exit
 end;
 { ObPATHblu XoD }
 X[n]:=B[n]/A[n,n];
 for i:=n-1 downto 1 do
 begin
  tmp:=B[i];
  for j:=i+1 to n do
   tmp:=tmp-A[i,j]*X[j];
  X[i]:=tmp/A[i,i]
 end;
 Gauss:=true
end;

procedure exec;
begin
 Write('Vvedite razmery matricy');
 READ(n);
 Writeln('Rasshirennaya matrica');
 for i:=1 to n do
 begin
  for j:=1 to n do
  begin
   write('A[' ,i, ',' ,j, ']=');
   readln(a[i,j]);
  end;
  Write('b[' ,i, ']=');
  readln(b[i]);
 end;
 if not Gauss(n,a,b,x) then
 begin
  Writeln('Matrica vyrozhdena');
  Halt;
 end;
 Writeln('Reshenie sistemy');
 for i:=1 to n do
 begin
  for j:=1 to n do
   b[i]:=b[i]-a[i,j]*x[j];
 Writeln(x[i]:12,' ',b[i]:12)
 end;
 readln
end;
 
procedure redraw(z:shortint); 
begin
setbkcolor(def_bk_color); 
settextstyle(def_font,0,5); 
for i:=1 to nc do begin
 
if(i=z) then setcolor(choice_color); 
 
outtextxy( 
    round(getmaxx/2)-round(textwidth(ac[i])/2),
    round(getmaxy/2)+textheight(ac[i])*(i-(round(nc/2)+1)),
    ac[i]
); 
 
if(i=z) then setcolor(def_color); 
end; 
end; 
 
function call_menu:shortint; 
var z:shortint; 
    c:char; 
begin
z:=1; 
repeat
redraw(z); 
c:=readkey; 
 
case c of
  #72:dec(z); 
  #80:inc(z); 
  #27:break_flag:=true; 
end; 
 
if(z<1) then z:=nc;
if(z>nc) then z:=1;
 
until c=#13; 
call_menu:=z; 
end; 
 
procedure exec_handler(z:shortint); 
var s:string; 
begin
cleardevice;
s:='ABOUT';
case z of
1:begin
closegraph;
exec;
initgraph(d,m,drv_path);
end;
2:begin
outtextxy(
    round(getmaxx/2)-round(textwidth(s)/2),
    round(getmaxy/2)-round(textheight(s)/2),
    s
);
readln;
end;
3:break_flag:=true;
end;
cleardevice;
end; 
 
begin
 
d:=detect; 
m:=2; 
 
nc:=3;
ac[1]:='Start program';
ac[2]:='About';
ac[3]:='Exit';
 
initgraph(d,m,drv_path);
break_flag:=false; 
 
e:=graphresult; 
 
if e<>grok then begin
    writeln(grapherrormsg(e)); 
    readln; 
    halt(1); 
end; 
 
repeat
exec_handler(call_menu); 
until break_flag; 
 
end.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA вне форума Ответить с цитированием
Старый 20.04.2012, 00:03   #6
afirat
Пользователь
 
Регистрация: 19.04.2012
Сообщений: 32
По умолчанию

о, это то что нужно. мне нравиться, спасибо Вам!
afirat вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Табулирование функции и массивы..Нужно создать программу в Паскале Кристина) Помощь студентам 1 19.05.2011 18:05
Задача по массивам...Нужно создать программу в Паскале Кристина) Помощь студентам 7 18.05.2011 22:39
Нужно создать программу в Паскале по этому условию Кристина) Паскаль, Turbo Pascal, PascalABC.NET 0 17.05.2011 16:17
как создать меню в паскале? Kati Помощь студентам 1 20.06.2009 11:35