Новичок
Профиль
Группа: Участник
Сообщений: 17
Регистрация: 27.5.2009
Репутация: нет
Всего: нет
|
ето модуль | Код |
unit menu;
interface
uses crt;
type men=array[1..8] of string[20];
procedure ramka(x1,y1,m,n,ct,cf:byte);
procedure form_men(me:men;x1,y1,n,ct,cf:byte);
function mov_men(me:men;x1,y1,n,ct,cf:byte):byte;
procedure readfile(path:string);
procedure form_m_gor(m:men;x2,y2,n,k,ct,cf:byte);
function mov_m_gor(m:men;x2,y2,n,k,ct,cf:byte):byte;
implementation
procedure form_m_gor;
var i:byte; {n-kilkist punktiv menu}
begin
window(x2,y2,lo(windmax),k);
textbackground(cf);
textcolor(ct);
clrscr;
gotoxy(2,2);
highvideo;
write(m[1]);
lowvideo;
for i:=2 to n do begin
gotoxy(wherex+15,2);
write(m[i]);
end;
gotoxy(2,2);
end;
function mov_m_gor;
var i,j:byte; c1,c2:char;
begin
form_m_gor(m,x2,y2,n,k,ct,cf);
i:=2;
j:=1;
repeat
c1:=readkey; c2:=#0;
if c1=#0 then c2:=readkey;
case c2 of
#77:{right} begin
lowvideo;
write(m[j],#13);
if j=n then begin j:=1;
i:=2;
end
else begin i:=i+15+length(m[j]);
j:=j+1;
end;
highvideo;
gotoxy(i,2);
write(m[j]);
gotoxy(i,2);
end;
#75:begin
lowvideo;
write(m[j],#13);
if j=1 then
begin
i:=2;
for j:=1 to n-1 do begin
i:=i+wherex+14+length(m[j]);
end;
j:=n;
end
else begin
i:=i-15-length(m[j-1]);
j:=j-1;
end;
highvideo;
gotoxy(i,2);
write(m[j]);
gotoxy(i,2);
end;
end;
until (c1=#13)or(c1=#27);
if c1=#13 then mov_m_gor:=j else mov_m_Gor:=0;
end;
procedure readfile;
var f:text;
s:string;
begin
assign(f,path);
reset(f);
gotoxy(2,2);
while not eof(f) do begin
readln(f,s);
write(s);
gotoxy(2,wherey+1);
end;
close(f);
end;
procedure ramka;
var i:byte;
begin
window(x1,y1,x1+m-1,y1+n-1);
textcolor(ct); textbackground(cf);
clrscr;
gotoxy(1,n);
write(#200);
for i:=1 to m-2 do write(#205);
write(#188);
gotoxy(1,1);
insline; {vstavili pustii piadok}
write(#201);
for i:=1 to m-2 do write(#205);
write(#187);
for i:=2 to n-1 do begin
gotoxy(1,i);
write(#186);
gotoxy(m,i);
write(#186);
end;
gotoxy(2,2);
end;
procedure form_men;
var j,i:byte; {n-kilkist punktiv menu}
max:integer;
begin
max:=0;
for i:=1 to n do begin
if length(me[i])> max then begin
max:=length(me[i]);
j:=i;
end;
end;
ramka(x1,y1,sizeof(me[j])-6,n+2,ct,cf);
gotoxy(2,2);
highvideo;
write(me[1]);
lowvideo;
for i:=2 to n do begin
gotoxy(2,i+1);
write(me[i]);
end;
gotoxy(2,2);
end;
function mov_men;
var i:byte; c1,c2:char;
begin
form_men(me,x1,y1,n,ct,cf);
i:=1;
repeat
c1:=readkey; c2:=#0;
if c1=#0 then c2:=readkey;
case c2 of
#72: {up} begin
lowvideo;
write(me[i]);
if i=1 then i:=n else i:=i-1;
gotoxy(2,i+1);
highvideo;
write(me[i]);
gotoxy(2,i+1);
end;
#80: begin
lowvideo;
write(me[i]);
if i=n then i:=1 else i:=i+1;
gotoxy(2,i+1);
highvideo;
write(me[i]);
gotoxy(2,i+1);
end;
end;
until (c1=#13)or(c1=#27);
if c1=#13 then mov_men:=i else mov_men:=0;
end;
End.
|
ето сама прога, мб кому понадобится... да и вобще интересно позапускать=) | Код |
program renev;
uses crt,menu,graph;
const glav:men=(' Program',' About',' Exit','','','','','');
vekt:men=(' Start',' Help','','','','','',''); r=150;
e=30;
type
pointtype=record
x,y:word;
end;
pMyVector = ^myVector;
myVector = array[1..1] of shortInt;
myArrayPtr = ^myArray;
myArray = array[1..1] of pMyVector;
Var maxx,maxy,x1,y1,sizex,sizey:byte;
t:boolean;
c:char;
angle:real;
vertex: array[0 .. 10{pred(size)}] of pointType;
adj_mx: array[0 .. 10{pred(size)}, 0 ..10 {pred(size)}] of integer;
countTop : shortInt;
g_driver, g_mode, errcode: integer;
i, j, center_x, center_y,n: integer;
matrixArc : myArrayPtr;
color : pMyVector;
procedure getMemVector;
var
i : byte;
begin
getMem(color, countTop * sizeOf(pMyVector));
end;
{===============================================================}
procedure getMemory(var x : myArrayPtr);
var
i : byte;
begin
getMem(x, countTop * sizeOf(pMyVector));
for i := 1 to countTop do
begin
getMem(x^[i], countTop * sizeOf(shortInt));
end;
end;
{===============================================================}
procedure inputValueOfArc;
var
i, j : byte;
begin gotoxy(wherex+1,wherey);
writeln('Esli vershini ne soedeneni vvedite 0');
gotoxy(wherex+1,wherey);
writeln('esli soedeneni to vvedite 1');
gotoxy(wherex+1,wherey);
writeln('Drugie zna4eniya ne dopestimi');
gotoxy(wherex+1,wherey);
for i := 1 to countTop do
begin
for j := 1 to countTop do
begin
if(i <> j) then
begin
if(i <= j) then
begin
gotoxy(wherex+1,wherey);
write('Rassmatrivaem vershini s nomerom ', i, ' I vershinu ', j, ': ');
gotoxy(wherex,wherey);
{$I-}
readln(matrixArc^[i]^[j]);
matrixArc^[j]^[i] := matrixArc^[i]^[j];
{$I+}
if(IOResult <> 0) then
begin gotoxy(wherex+1,wherey);
writeln('Error. Znachenie prinyato kak 0');
gotoxy(wherex+1,wherey);
matrixArc^[i]^[j] := 0;
matrixArc^[j]^[i] := 0;
end;
if((matrixArc^[i]^[j] < 0) or (matrixArc^[i]^[j] > 1)) then
begin
writeln('Vvedeno chislo ne ravnoe 1 ili 0. Po ymolchaniyu 0');
gotoxy(wherex+1,wherey);
matrixArc^[i]^[j] := 0;
matrixArc^[j]^[i] := 0;
end;
end;
end
else
begin
matrixArc^[i]^[j] := 0;
end;
end;
end;
end;
function inttostr(X: integer): string;
var s: string;
begin
str(X, s); inttostr := s;
end;
{===============================================================}
procedure printWeightArc(x : myArrayPtr; comment : string);
var
i, j : byte;
begin
writeln;
writeln('Etot graf, sostoyachiy iz ', countTop, comment);
gotoxy(wherex+1,wherey);
for i := 1 to countTop do
begin
for j := 1 to countTop do
begin
write(x^[i]^[j]:3, ' ');
end;
writeln;
end;
end;
{===============================================================}
procedure paintGraf(m : integer);
var
i, j : byte;
cont : boolean;
begin
if(m > countTop) then
begin
writeln('РPolycheni resultati ');
gotoxy(wherex+1,wherey);
end
else
begin
for i := 1 to countTop do
begin
color^[m] := i;
cont := true;
for j := 1 to countTop do
begin
if((matrixArc^[j]^[m] = 1) and (color^[j] = i)) then
begin
cont := false;
end;
end;
if(cont) then
begin
paintGraf(m + 1);
exit;
end;
end;
end;
end;
{===============================================================}
Begin
maxx:=lo(windmax)+1;
maxy:=hi(windmax)+1;
repeat
textattr:=blue*8*white;
clrscr;
{meny}
n:=3;
x1:=(maxx-sizeof(glav[1]))div 2 -1;
y1:=(maxy-n)div 2-1;
i:=mov_men(glav,x1,y1,n,blue,cyan);
clrscr;
case i of
1: begin
n:=3;
x1:=(maxx-sizeof(vekt[3]))div 2 -1;
y1:=(maxy-n)div 2-1;
j:=mov_men(vekt,x1,y1,n,blue,cyan);
case j of
1: begin
window(1,1,maxx,maxy);
sizex:=50; sizey:=20;
x1:=(maxx-sizex)div 2;
y1:=(maxy-sizey)div 2;
ramka(x1,y1,maxx,maxy,blue,cyan);
textcolor(lightblue);
writeln('Number of vershin grafa');
gotoxy(wherex+1,wherey);
writeln('Bolshe 5 lychshe ne vvodit,');
gotoxy(wherex+1,wherey);
readln(countTop);
angle:=2*pi/counttop;
if(countTop <= 0) then
begin
writeln('otrizatelnoe kol-vo grafov. po ymolchaniy 4');
gotoxy(wherex+1,wherey);
countTop := 4;
end;
getMemory(matrixArc);
getMemVector;
inputValueOfArc;
printWeightArc(matrixArc, ' Vershina imeet cledyuchie haracteristiki');
paintGraf(1);
for i := 1 to countTop do
begin
writeln('Vershina s nomerom ', i, ' imeet cvet ', color^[i]);
gotoxy(wherex+1,wherey);
end;
for i:=1 to counttop do begin
for j:=1 to counttop do begin
adj_mx[i,j]:=matrixarc^[i]^[j];
end;end; normvideo;
g_driver:= detect;
initgraph(g_driver, g_mode, '');
errcode:= graphresult;
if errcode <> grok then begin
writeln('graphics error: ', grapherrormsg(errcode));
readln; halt(101);
end;
center_x := getmaxx div 2;
center_y := getmaxy div 2;
for i := 0 to counttop do begin
vertex[i].x :=center_x+trunc(R*cos(Pi/2+i*angle));
vertex[i].y :=center_y-trunc(R*sin(Pi/2+i*angle));
end;
for i := 0 to counttop do begin
for j := 0 to counttop do begin
if adj_mx[i, j] <> 0 then begin
moveto(vertex[i].x, vertex[i].y);
lineto(vertex[j].x, vertex[j].y);
end
end
end;
setfillstyle(solidfill, lightred);
settextjustify(centertext, centertext);
for i := 1 to counttop do begin
setfillstyle(solidfill,color^[i]);
fillellipse(vertex[i].x, vertex[i].y, E, E);
circle(vertex[i].x, vertex[i].y, E); outtextxy(vertex[i].x, vertex[i].y, inttostr(i));
end;
readln;
closegraph;
repeat until keypressed;
end;
2:begin
window(1,1,maxx,maxy);
sizex:=40;
sizey:=10;
x1:=(maxx-sizex)div 2;
y1:=(maxy-sizey)div 2;
ramka(x1,y1,sizex,sizey,Blue,cyan);
x1:=(sizex)div 2;
y1:=sizey div 2;
gotoxy(x1-15,y1-1);
writeln('The program has developed');
gotoxy(x1-15,y1);
writeln('For Zada4i - razukraski grafa');
gotoxy(x1-15,y1+1);
writeln('Ny i ona ego razukrashivaet');
gotoxy(x1-15,y1+2);
writeln('V obshem eta proga o4en gyd');
gotoxy(x1-5,y1+4);
writeln('Press Enter');
repeat until keypressed;
end;
end;
end;
2:begin
window(1,1,maxx,maxy);
sizex:=40;
sizey:=10;
x1:=(maxx-sizex)div 2;
y1:=(maxy-sizey)div 2;
ramka(x1,y1,sizex,sizey,blue,cyan);
x1:=(sizex)div 2;
y1:=sizey div 2;
gotoxy(x1-15,y1-1);
writeln('The program has developed');
gotoxy(x1-15,y1);
writeln('student of group KA-84');
gotoxy(x1-15,y1+1);
writeln('IASA');
gotoxy(x1-15,y1+2);
writeln('Renyov Olexey');
gotoxy(x1-5,y1+4);
writeln('Press Enter');
repeat until keypressed;
end;
3:halt;
end;
until keypressed;
if keypressed then c:=readkey;
window (1,1,maxx,maxy);
readln;
end.
|
|
Прошу помочь с кусочком программы! 
Загрузка ...
