|
p align="left">end; end; end; end. Процедура oprmarki; 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:=0; Перебираем все записи и сохраняем минимальный год выпуска в переменную min, а номер записи в переменную nmin. А после цикла их выводит на экран. 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 Вначале программы задаем пустое множество. И запускаем цикл. Если определенной марки нет в множестве, тогда добавляем ее. И запускаем второй цикл, только начиная не с еденицы, а с h-го элемента. Затем если h-ый и l-ый элементы совпадают, прибавляем к счетчику еденицу.И в конце вторго цикла выводим собранные данные на экран. 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; 6 Заключение.В ходе выполнения курсовой работы мною был изучен язык програмированния Pascal. Также получены практические навыки работы с текстовыми строками, двумерными массивами, файловыми структурами данных, элементами машинной графики и записями. 7 Приложения АКод программы 1 program slova1; uses crt; type Stroka250=string[250]; Slovo=string[20]; function Copy1(S: Stroka250; Start, Len: Integer):Stroka250; var Rez: Stroka250; L: Integer; I, J: Integer; begin L:=byte(S[0]); if (L<Start) then Rez[0]:=char(0) else begin if (Start+Len-1)>L then Len:=L-Start+1; J:=Start; for I:=1 to Len do begin Rez[I]:=S[J]; Inc(J); end; Rez[0]:=char(Len); end; Copy1:=Rez; end; function isletter(C: Char): Boolean; begin if ((C>='A') and (C<='Z')) or ((C>='a') and (C<='z')) then isletter:=True else isletter:=False; end; function alforder(Sl: Slovo; var Count: Byte): Boolean; var I, L: Byte; F: Boolean; Buf: Char; begin L:=Length(Sl); Count:=0; for I:=1 to L do begin if (isletter(Sl[I])) then Inc(Count); if (Sl[I]>='A') and (Sl[I]<='Z') then Sl[I]:=char(byte(Sl[I])+32); end; {esli v slove net bukv} if Count=0 then alforder:=False else if Count=1 then alforder:=True else begin F:=True; While F do begin F:=False; for I:=1 to L-1 do if (Not isletter(Sl[I])) And (isletter(Sl[I+1])) then begin F:=True; Buf:=Sl[I]; Sl[I]:=Sl[I+1]; Sl[I+1]:=Buf; end; end; F:=true; for I:=1 to Count-1 do if Sl[I]>Sl[I+1] then begin F:=False; break; end; alforder:=F; end; end; procedure alfslovo(S: Stroka250); var F: boolean; Len: Byte; I: Byte; Counter: Byte; FSlovo, Buf: Slovo; Index, L: Byte; MaxCol: Byte; begin Len:=Length(S); if S[Len]<>' ' then begin S:=S+' '; Inc(Len); end; F:=False; MaxCol:=0; for I:=1 to Len do if S[I]<>' ' then begin if F=False then begin F:=True; Index:=I; L:=1; end else Inc(L); end else if F=True then begin F:=False; Buf:=Copy1(S, Index, L); Buf[0]:=char(L); if alforder(Buf, Counter) then begin if Counter>MaxCol then begin FSlovo:=Copy1(S, Index, L); FSlovo[0]:=char(L); MaxCol:=Counter; end; end; end; if MaxCol=0 then writeln('Net podhodyaschi slov v texte') else writeln(FSlovo, ' kol-vo bukv: ', MaxCol); end; function simmetr(S: Slovo):boolean; var L, I, R: Byte; F: Boolean; begin L:=Length(S); R:=L div 2; F:=True; for I:=1 to R do if S[I]<>S[L-I+1] then begin F:=False; break; end; simmetr:=F; end; procedure colsimmslovo(S: Stroka250); var F: boolean; Len: Byte; I: Byte; Counter: Byte; Buf: Slovo; Index, L: Byte; MaxCol: Byte; begin Len:=Length(S); if S[Len]<>' ' then begin S:=S+' '; Inc(Len); end; F:=False; Counter:=0; writeln('Spisok simmetrichnyh slov iz bolshe chem 2 znaka:'); for I:=1 to Len do if S[I]<>' ' then begin if F=False then begin F:=True; Index:=I; L:=1; end else Inc(L); end else if F=True then begin F:=False; if L>2 then begin Buf:=Copy(S, Index, L); Buf[0]:=char(L); if simmetr(Buf) then begin Inc(Counter); writeln(Buf); end; end; end; writeln('Kol-vo naidennyh slov: ', Counter); end; procedure menu; begin writeln; writeln('++++++++++++++++++++++++++++++++++++++++++++++++'); writeln('+ Vvod texta --> 1 +'); writeln('+ Slovo s max. kol.bukv v alf. poryadke --> 2 +'); writeln('+ Simmetrichnye slova --> 3 +'); writeln('+ Vyvod texta --> 4 +'); writeln('+ +'); writeln('+ Konec --> 0 +'); writeln('++++++++++++++++++++++++++++++++++++++++++++++++'); writeln; end; var Txt: Stroka250; Vvod, Cont: Boolean; Rem: Char; begin Vvod:=False; Cont:=True; while Cont do begin clrscr; menu; write('Vvedite komandu: '); readln(Rem); case Rem of '0': Cont:=False; '1': begin writeln('Text:'); readln(Txt); Vvod:=True; end; '2': begin if Not Vvod then writeln('Ne vveden text') else alfslovo(Txt); end; '3': begin if Not Vvod then writeln('Ne vveden text') else colsimmslovo(Txt); end; '4': begin if Not Vvod then writeln('Ne vveden text') else writeln(Txt); end else writeln('Neizvestnaya komanda'); end; if Cont then begin write('Nagmite ENTER dlya vvoda sleduyuschei komandy... '); readln; end else clrscr; end; end. 8 Приложение БКод программы 2 program massiv1; uses crt; type Matrix=array[1..20,1..20] of Integer; type Vector=array[1..80] of Integer; procedure TurnArray(var V: Vector; NN: Integer; Rev: Integer); var Buf: Integer; I, J: Integer; begin for J:=1 to Rev do begin Buf:=V[NN]; for I:=NN downto 2 do V[I]:=V[I-1]; V[1]:=Buf; end; end; procedure TurnMatrix(var A: Matrix; N: Integer); var Arr: Vector; I, J, K, Ot, L: Integer; R: Integer; Revers: Integer; Buf1, Buf2: Integer; begin R:=N div 2; Ot:=0; for K:=1 to R do begin L:=0; for J:=1+Ot to N-Ot do begin Inc(L); Arr[L]:=A[1+Ot, J]; end; for I:=2+Ot to N-1-Ot do
Страницы: 1, 2, 3, 4, 5
| 
