p align="left"> begin Inc(L); Arr[L]:=A[I, N-Ot]; end; for J:=N-Ot downto 1+Ot do begin Inc(L); Arr[L]:=A[N-Ot, J]; end; for I:=N-1-Ot downto 2+Ot do begin Inc(L); Arr[L]:=A[I, 1+Ot]; end; Revers:=N-2*Ot-1; TurnArray(Arr, L, Revers); L:=0; for J:=1+Ot to N-Ot do begin Inc(L); A[1+Ot, J]:=Arr[L]; end; for I:=2+Ot to N-1-Ot do begin Inc(L); A[I, N-Ot]:=Arr[L]; end; for J:=N-Ot downto 1+Ot do begin Inc(L); A[N-Ot, J]:=Arr[L]; end; for I:=N-1-Ot downto 2+Ot do begin Inc(L); A[I, 1+Ot]:=Arr[L]; end; Inc(Ot); end; end; procedure FormMatrix(var A: Matrix; N, M: Integer); var I, J: Integer; D: Integer; R: Integer; begin randomize; for I:=1 to N do for J:=1 to M do begin A[I,J]:=random(100); if (random(1000) mod 2)=0 then A[I,J]:=0-A[I,J]; end; end; procedure PrintMatrix(var A: Matrix; N, M: Integer); var I, J: Integer; begin for I:=1 to N do begin for J:=1 to M do write(A[I,J]:4); writeln; end; end; var Matr: Matrix; N: Integer; begin clrscr; repeat write('Razmer matricy (12..20): '); readln(N); until (N>=12) and (N<=20); FormMatrix(Matr, N, N); writeln('Sformirovana matrica:'); PrintMatrix(Matr, N, N); TurnMatrix(Matr, N); writeln('Matrica posle povorota'); PrintMatrix(Matr, N, N); readln; end. 9 Приложение ВКод программы 3 program textfile; uses crt; type arr = array [1..83] of string; var slova1, slova2, slova: arr; m, m1, m2, k1, k2, k, l, g: integer; first, second, third: text; command: char; p, v, t, S1, S2: string; pf, vf, tf, cont, flag1, flag2: boolean; function check2: boolean; begin if eof(first) = true then flag1 := true else flag1 := false; if eof(second) = true then flag2 := true else flag2 := false; if (flag1 = false) and (flag2 = false) then check2 := false else check2 := true; end; procedure closing; begin close(first); close(second); close(third); end; procedure obrslov(a, b: arr; na, nb: integer; var c: arr; var nc: integer); var i, j, k: integer; begin nc := 0; for i := 1 to na do begin k := 0; for j := 1 to nb do if a[i] = b[j] then k := 1; if k = 0 then begin nc := nc + 1; c[nc] := a[i]; end; end; for i := 1 to nb do begin k := 0; for j := 1 to na do if b[i] = a[j] then k := 1; if k = 0 then begin nc := nc + 1; c[nc] := b[i]; end; end; end; procedure slv; var i, j: integer; begin Readln(first, S1); readln(second, S2); S1 := ' ' + S1 + ' '; S2 := ' ' + S2 + ' '; k1 := 0; k2 := 0; for i := 1 to length(S1) do begin if s1[i] = ' ' then begin for j := i + 1 to length(s1) do if s1[i + 1] <> ' ' then if s1[j] = ' ' then begin k1 := k1 + 1; slova1[k1] := copy(s1, i + 1, j - i - 1); break; end; end; end; for i := 1 to length(S2) do begin if s2[i] = ' ' then begin for j := i + 1 to length(s2) do if s2[i + 1] <> ' ' then if s2[j] = ' ' then begin k2 := k2 + 1; 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); begin clrscr; v[x] := true; write('Vvedite familiu: '); readln(z[x].familia); write('Vvedite adress: '); readln(z[x].adress); write('Vvedite marku avto: '); readln(z[x].avto); write('Vvedite nomer avto: '); readln(z[x].nomer); z[x].Vypusk := 0; while (z[x].Vypusk < 1900) or (z[x].Vypusk > 2000) do begin write('Vvedite god vipuska(1900..2000): '); readln(z[x].vypusk); end; end; procedure menu; begin writeln; Writeln('+++++++++++++++++++++++++++++++++++++++++++++++++++++'); writeln('+ Ykazat kolichestvo zapisei ->1 +'); writeln('+ Izmenit vse zapisi ->2 +'); writeln('+ Izmenit odny zapis ->3 +'); writeln('+ Kolichestvo avtomobilei kazdoi marki ->4 +'); writeln('+ Vladelec samogo starogo avtomobila ->5 +'); writeln('+ Familii vladelcev i nomera avto dannoi marki ->6 +'); Writeln('+ +'); writeln('+ Konec ->0 +'); Writeln('+++++++++++++++++++++++++++++++++++++++++++++++++++++'); writeln; end; begin for i := 1 to 200 do ch[i] := false; clrscr; menu; cont := true; fzap := false; while cont do begin write('Vvedite komandu: '); readln(command); case command of '0': cont := false; '1': begin Write('Vvedite kol-vo zapisei(1..200): '); readln(n); if (n > 0) and (n <= 200) then fzap := true else fzap := false; end; '2': begin if fzap = true then begin for i := 1 to n do change(i, avtovl, ch); clrscr; menu; end else writeln('Ne vvedeno kol-vo zapisei'); end; '3': begin if fzap = true then begin write('Vvedite nomer redaktiryemoi zapisi: '); readln(i); if i > n then writeln('Wrong input') else begin change(i, avtovl, ch); clrscr; menu; end; end else Writeln('Ne vvedeno obshee chislo zapisei'); end; '4': begin if fzap = true then begin for i := 1 to n do if ch[i] = false then begin dzap := false; writeln('Vvedeni ne vse zapisi'); end else dzap := true; if dzap = true then mark(avtovl); end else Writeln('Ne vvedeno obshee chislo zapisei'); end; '5': begin if fzap = true then begin for i := 1 to n do if ch[i] = false then begin dzap := false; writeln('Vvedeni ne vse zapisi'); end else dzap := true; if dzap = true then mostold(avtovl); end else Writeln('Ne vvedeno obshee chislo zapisei'); end; '6': begin if fzap = true then begin for i := 1 to n do if ch[i] = false then begin dzap := false; writeln('Vvedeni ne vse zapisi'); end else dzap := true; if dzap = true then oprmarki(avtovl); end else Writeln('Ne vvedeno obshee chislo zapisei'); end; end; end; end.
Страницы: 1, 2, 3, 4, 5
|