Курсовая работа: Работа с текстовыми строками, двумерными массивами, файловыми структурами данных
slova2[k2]
:= copy(s2, i + 1, j - i - 1);
break;
end;
end;
end;
end;
procedure
chmax;
begin
m1 := 0;
m2
:= 0;
while
not eof(first) do
begin
readln(first, S1);
m1
:= m1 + 1;
end;
while
not eof(second) do
begin
readln(second, S2);
m2
:= m2 + 1;
end;
if
m1 < m2 then m := m1 else m := m2;
close(first);
reset(first);
close(second);
reset(second);
end;
procedure
filepr;
begin
assign(first, p);
assign(second,
v);
assign(third,
t);
reset(first);
reset(second);
rewrite(third);
end;
function
check1(x: string): boolean;
begin
if
length(x) > 0 then begin
if
x[1] <> ' ' then
check1 := true;
end;
end;
procedure
menu;
begin
writeln;
writeln('++++++++++++++++++++++++++++++++++++++++++++++++');
writeln('+
Vvod imeni pervogo faila --> 1 +');
writeln('+
Vvod imeni vtorogo faila --> 2 +');
writeln('+
Vvod imeni tretiego faila --> 3 +');
writeln('+
Preobrazovat tretii fail --> 4 +');
writeln('+
+');
writeln('+
Konec --> 0 +');
writeln('++++++++++++++++++++++++++++++++++++++++++++++++');
writeln;
end;
begin
menu;
pf
:= false;
vf
:= false;
tf
:= false;
cont
:= true;
flag1
:= false;
flag2
:= false;
while
cont do
begin
writeln;
write('Vvedite
komandu: ');
readln(command);
case
command of
'0': cont := false;
'1':
begin
write('Vvedite imja pervogo faila: ');
readln(p);
if
check1(p) = true then
begin
pf
:= true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln('Error
input');
end;
end;
'2':
begin
write('Vvedite imja vtorogo faila: ');
readln(v);
if
check1(v) = true then
begin;
vf
:= true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln('Error
input');
end;
end;
'3':
begin
write('Vvedite imja tretego faila: ');
readln(t);
if
check1(t) = true then
begin
tf
:= true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln('Error
input');
end;
end;
'4':
begin
if
(pf = true) and (vf = true) and (tf = true) then
begin
filepr;
chmax;
if
check2 = false then
begin
for
l := 1 to m do
begin
slv;
obrslov(slova1,
slova2, k1, k2, slova, k);
for
g := 1 to k do
begin
write(third, slova[g]);
if
g < k then write(third, ' ');
end;
writeln(third,
'');
end;
if
m1 <> m2 then
begin
if
m1 > m2 then for L := m to m1 do
begin
readln(first,
S1);
writeln(third,
S1);
end
else
for
L := m to m2 do
begin
readln(second,
S2);
Writeln(third,
S2);
end;
end;
closing;
writeln('Operacia
zavershena');
end
else
begin
if
flag1 = true then writeln('Pervii fail pustoi');
if
flag2 = true then writeln('Vtoroi fail pustoi');
end;
end
else
begin
if
pf = false then writeln('Ne vvedeno imja pervogo
faila');
if
vf = false then writeln('Ne vvedeno imja vtorogo faila');
if
tf = false then writeln('Ne vvedeno imja tretego faila');
end;
end;
else
writeln( 'Neizvestnaya komanda');
end;
end;
end.
10
Приложение Г
Код программы 4
program
grafik;
uses
graphabc;
var
xx,
yy, a, d, maxy, maxx: integer;
t,
k: real;
fileg:
text;
cont,
namef: boolean;
command:
char;
name:
string;
function
Yfunc(i: real): real;
begin
result
:= A * sin(i) - D * sin(A * t);
end;
function
Xfunc(i: real): real;
begin
result
:= A * cos(i) + D * cos(A * i);
end;
procedure
mnoj;
begin
t
:= 0;
while
t <= 2 * pi do
begin
xx
:= trunc(Xfunc(t));
if
abs(xx) > maxx then maxx := abs(xx);
yy
:= trunc(Yfunc(t));
if
abs(yy) > maxy then maxy := abs(yy);
t
:= t + 0.001;
end;
if
WindowWidth < WindowHeight then
if
maxy > maxx then k := (WindowHeight / 2) / maxy else k := (windowWidth / 2)
/ maxx else
if
maxx > maxy then k := (windowheight / 2) / maxx else k := (windowWidth / 2)
/ maxy;
end;
procedure
graf;
begin
k
:= k - k * 0.1;
moveto(1,
windowHeight div 2);
lineto(WindowWidth,
WindowHeight div 2);
moveto(WindowWidth
div 2, 1);
lineto(WindowWidth
div 2, WindowHeight);
moveto(trunc((WindowWidth
div 2) * 0.98), trunc(0.04 * WindowHeight));
Lineto((Windowwidth
div 2), 1);
lineto(trunc((windowWidth
div 2) * 1.02), trunc(0.04 * windowHeight));
moveto(trunc(windowwidth
* 0.96), trunc(0.98 * (windowheight div 2)));
lineto(windowwidth,
windowheight div 2);
lineto(trunc(windowwidth
* 0.96), trunc(1.02 * (windowheight div 2)));
T
:= 0;
xx
:= (WindowWidth div 2) + trunc(k * Xfunc(t));
yy
:= (WindowHeight div 2) + trunc(k * Yfunc(t));
moveto(xx,
yy);
while
t <= 2 * pi do
begin
xx
:= (WindowWidth div 2) + trunc(k * Xfunc(t));
yy
:= (WindowHeight div 2) + trunc(k * Yfunc(t));
lineto(xx,
yy);
t
:= t + 0.0001;
end;
if
WindowWidth > 400 then
if
Windowheight > 200 then
begin
textout(trunc(1.05
* (windowWidth div 2)), trunc(0.01 * (WindowHeight )), 'Y');
Textout(trunc(0.95
* WindowWidth), trunc((WindowHeight div 2) * 1.05), 'X');
end;
end;
function
check1: boolean;
begin
if
length(name) > 0 then
begin
assign(fileg,
name);
reset(fileg);
if
eof(fileg) = false then check1 := true else check1 := false;
end;
end;
procedure
menu;
begin
writeln;
writeln('++++++++++++++++++++++++++++++++++++++++++++++++');
writeln('+
Vvod imeni faila s parametrami --> 1 +');
writeln('+
Porstroenie grafika --> 2 +');
writeln('+
Vihod --> 0 +');
writeln('++++++++++++++++++++++++++++++++++++++++++++++++');
writeln;
end;
procedure
resize;
begin
mnoj;
ClearWindow;
graf;
redraw;
lockdrawing;
end;
begin;
t
:= 0;
menu;
cont
:= true;
while
cont do
begin
Writeln('Vvedite
komady: ');
Readln(command);
case
command of
'0':
cont := false;
'1':
begin
writeln;
writeln('Vvedite
imja faila: ');
Readln(name);
if
check1 = true then begin
namef
:= true;
read(fileg,
a);
read(fileg,
d);
close(fileg);
end
else namef := false;
end;
'2':
begin
if
namef = false then
writeln('Ne
Vvedeno imja faila')
else
begin
clearwindow;
SetWindowSize(800,
600);
mnoj;
graf;
cont
:= false;
end;
end;
end;
end;
lockdrawing;
OnResize
:= resize;
end.
11
Приложение Д
Код программы 5
program
zapisi;
uses
crt;
type
vladelez
= record
Familia:
string;
Adress:
string;
Avto:
string;
Nomer:
string;
Vypusk:
integer;
end;
mas2
= array [1..200] of boolean;
mas
= array [1..200] of vladelez;
var
command:
char;
cont,
fzap, dzap: boolean;
avtovl:
mas;
n:
integer;
i:
integer;
ch:
mas2;
marki:
set of string;
procedure
oprmarki(x: mas);
var
h:
integer;
m:
string;
begin
Write('Vvedite
marku avto: ');
readln(m);
for
h := 1 to n do
if
x[h].Avto = m then
writeln(x[h].Familia,
' nomer-', x[h].Nomer);
end;
procedure
mostold(x: mas);
var
min,
nmin, h: integer;
begin
min
:= x[1].Vypusk;
nmin
:= 1;
for
h := 1 to n do
if
x[h].Vypusk < min then
begin
min
:= x[h].Vypusk;
nmin
:= h;
end;
Writeln(x[nmin].Familia,
' - ', min, ' god vypuska');
end;
procedure
mark(x: mas);
var
h,
l, k: integer;
begin
for
h := 1 to n do
begin
if
not (x[h].avto in marki) = true then
begin
k
:= 0;
include(marki,
x[h].avto);
for
l := h to n do
if
x[h] = x[l] then
if
x[l].avto in marki then
k
:= k + 1;
writeln(x[h].avto,
'-', k);
end;
end;
end;
procedure
change(x: integer; var z: mas; var v: mas2);
Страницы: 1, 2, 3, 4, 5, 6, 7 |
