program menu; uses crt; Const abc = ['a'..'z','A'..'Z','1'..'9']; Maxsize=100;{Maximalnoe 4islo} var nom1:integer; {nomer vybrannoj zada4i} nom2:integer; {nomer metoda vvoda} nom4: integer;{nomer zadaniya v 3 zada4e} i:integer; {s4et4ik} j:integer; {s4et4ik} fl:text; name:string; vyxod:string[3]; {pervaya zada4a} n1: integer;{Koli4estvo el-tov v massive} K1: integer;{s4et4ik} a1: array [1..maxsize] of real;{isxodniy massiv} P1: real;{rabo4aya peremennaya} kol1: integer;{koli4estvo perestanovok} {vtoraya zada4a} n2: integer;{4islo strok} m2: integer;{4islo stolbcov} a2: array[1..maxsize,1..maxsize] of real;{isxodniy massiv} s2_: real;{summa} {tret'ya zada4a} a3: array[1..10] of string [8]; a3_1: array[1..10] of integer; a3_2: array[1..10] of string [8]; k3:integer; p3: longint; s:string; s1,s2:string; n3,x3:longint; res3: string; res3_6: longint; res3_7: boolean; res3_9: integer; {4etvertaya zada4a} s_res, prev, word: string;{rabo4ie stroki} count, n4: integer; p4: integer;{rabo4aya peremennaya} s4: string;{isxodnaya stroka} stnew: string;{stroka rezultata} Function StrUpper(s: String): String; {funkciya perevoda} Var {stroki v verhniy} i: Byte; {registr} Begin For i := 1 To Ord(s[0]) Do Case s[i] Of 'a' .. 'z': s[i] := Chr(Ord(s[i])-$20); {Chr-vozvrawaet kod} #160 .. #175: s[i] := Chr(Ord(s[i])-$20);{po simvolu,Ord-simvol po kodu} #224 .. #239: s[i] := Chr(Ord(s[i])-$50);{cifri-raznost kodov v verhnem i nijn.registre} End; StrUpper := s End; Function StrOneSpace(s: String): String;{funkciya udaleniya} Var {liwnix probelov} p: Byte; Begin Repeat p := Pos(' ', s); If p > 0 Then Delete(s, p, 1) Until p = 0; StrOneSpace := s; End; var a4: array[1..10] of string [8]; function from_(s:string;ss:byte):longint;{funkciya perexoda iz stroki v 4islo} var q:longint; begin q:=0; for i:=1 to length(s) do begin s[i]:=char(ord(s[i]) or 32); case s[i] of '0'..'9': q:=q*ss+byte(s[i])-ord('0'); 'a'..'z': q:=q*ss+byte(s[i])-ord('a')+10; end; end; from_:=q; end; function to_(q:longint;ss:byte):string;{funkciya perexoda iz 4isla v stroku} var s:string; i:longint; begin s:=''; repeat i:=q-trunc(q/ss)*ss; if i>9 then i:=i+ord('A')-ord('9')-1; s:=chr(i+ord('0'))+s; q:=trunc(q/ss); until q=0; to_:=s; end; function MulHexToHex(s1,s2:string):string;{umnojenie v 16} begin MulHexToHex:=to_(from_(s1,16)*from_(s2,16),16); end; function DivHexToHex(s1,s2:string):string; {delenie v 16} begin DivHexToHex:=to_(from_(s1,16) div from_(s2,16),16); end; function AddHexToHex(s1,s2:string):string; {slojenie} begin addHexToHex:=to_(from_(s1,16) +from_(s2,16),16); end; function vich(s1,s2:string):string;{vi4itanie} begin vich:=to_(from_(s1,16)- from_(s2,16),16); end; function BinToHex(s:string):string;{iz 2 v 16} begin BinToHex:=to_(from_(s,2),16); end; function check_hex(s: string): boolean;{funkciya pravilnosti zapisi} var i: byte; flag: boolean; begin i := 1; flag := true; while (i <= length(s)) and flag do begin flag := (upcase(s[i]) in ['0' .. '9', 'A' .. 'F']); inc(i) end; check_hex := flag end; function proverka(s: string): boolean;{yavlyaetsya li 2-im} var i: byte; flag: boolean; begin i := 1; flag := true; while (i <= length(s)) and flag do begin flag :=s[i] in ['0' .. '1']; inc(i) end; proverka := flag end; Function Hex2Dec (s:string): longint;{iz 16 v 10} var res,k: longint; r,i: integer; c: char; begin res := 0; k := 1; for i := length (s) downto 1 do begin c := UpCase (s[i]); case c of 'A'..'F': r := ord(c) - (ord('A') - 10); { ord (c) - 55 } '0'..'9': r := ord(c) - ord('0'); { ord (c) - 48 } else break end; res := res + r * k; k := k * 16; end; Hex2Dec := res; end; function Dec2Hex(n: integer): string; {Perevod iz 10-oy v 16-uu} var r: integer; {ostatok ot deleniya 4isla na osnovanie} buf: string[1]; begin s:=''; repeat r:=n mod 16; {o4erednaya cifra} n:=n div 16; {celaya 4ast deleniya} if r< 10 then buf:=chr(r+48) {chr(48) = '0', chr(49)='1' i t.d} else buf:=chr(r+55);{chr(65)= 'A', chr(66)='b' i t.d} s:=buf+s; until (n<16); if n<>0 then begin if n<10 then buf:=chr(n+48) else buf:=chr(n+55); s:=buf+s; end; Dec2Hex:=s; end; function stepen(x,n:longint):integer; {vozvedenie v stepen} begin stepen:=Trunc(exp(n*ln(x))); end; function Ravno(s1,s2:string):boolean; begin Ravno:=from_(s1,16)=from_(s2,16); end; function Neravno(s1,s2:string):boolean; begin Neravno:=not(from_(s1,16)=from_(s2,16)); end; function Bolwe(s1,s2:string):boolean; begin Bolwe:=from_(s1,16)>from_(s2,16); end; function Menwe(s1,s2:string):boolean; begin Menwe:=from_(s1,16)=from_(s2,16); end; label perexod00,perexod01,perexod02,perexod03,perexod04,perexod05,perexod06, perexod07,perexod08,perexod10,perexod09,perexod11,metka_vyxod, vyx; {vozvrat k vyboru punkta menu v slu4ae owibo4nogo vvoda} BEGIN textbackground(black); clrscr; perexod00:BEGIN textcolor(lightgreen); writeln('MENU:'); writeln; writeln('1.Odnomernye massivy.'); {vyvod} writeln('2.Dvumernyj massivy.'); {isxodnogo} writeln('3.Podprogrammy.'); {menu na} writeln('4.Stroki.'); {ekran} writeln('5.Vyxod.'); {monitora} writeln; writeln('vyberite nuzhnyj punkt MENU i nazhmite enter'); writeln; read(nom1); textbackground(black); clrscr; perexod01:BEGIN textcolor(lightcyan); CASE (nom1) of 1: BEGIN {pervaya zada4a} writeln; writeln ('zada4a 1:'); writeln; highvideo; writeln('Dana posledovatelnost 4isel a1,a2,...,an.Trebuetsya'); writeln('perestavit 4isla v poryadke vozrastaniya.Dlya etogo'); writeln('sravnivautsya dva sosednix 4isla ai i ai+1.Esli ai>ai+1,'); writeln('to delaetsya perestanovka.Tak prodoljaetsya do tex'); writeln('por,poka vse elementi ne stanut raspolojeni v poryadke'); writeln('vozrastaniya.Sostavit algoritm sortirovki,pods4itivaya'); writeln('pri etom koli4estvo perestanovok.'); normvideo; writeln; writeln('1. S klaviatury'); writeln('2. Iz fajla'); writeln('3. S4et4ik slu4ajnyx 4isel'); writeln('4. Vyxod'); writeln; highvideo; writeln('vyberite metod vvoda i nazhmite enter'); normvideo; writeln; readln(nom2); textcolor(green); textbackground(black); CASE (nom2) of {vybor vvoda v pervoj zada4e} 1: BEGIN clrscr; repeat Write('Vvedite 4islo el-tov massiva: '); Readln(n1); if (n1<=0) or (n1>maxsize) then begin writeln; textcolor(lightred); writeln('OWIBKA!Povtorite'); textcolor(green); writeln; END; {if} until (n1<=maxsize) and (n1>=1); for i:=1 to n1 do begin Write(i,'-y element: '); readln(a1[i]); end; END; {vvod s klaviatury} 2: BEGIN clrscr; write('vvedite imya fajla: '); readln(name); assign(fl,name); {$I-} reset(fl); {$I+} if ioresult=0 then BEGIN repeat read(fl,n1); writeln('4islo elementov massiva: ',n1:3); if (n1>maxsize) or (n1<1) then begin writeln; textcolor(lightred); writeln('OWIBKA!Povtorite'); textcolor(green); writeln; END; {if} until (n1<=maxsize) and (n1>=1); for i:=1 to n1 do begin read(fl,a1[i]); Write(i,'-y element: '); writeln(a1[i]:4:1); end; close(fl); END else BEGIN writeln ('fajl ',name,' ne najden'); goto vyx; END; END; {vvod iz fajla} 3: BEGIN clrscr; randomize; repeat write('4islo elementov massiva: '); n1:=random(100)-50; writeln(n1); if (n1>maxsize) or (n1<1) then begin writeln; textcolor(lightred); writeln('OWIBKA!Povtorite'); textcolor(green); writeln; END; {if} until (n1<=maxsize) and (n1>=1); for i:=1 to n1 do begin a1[i]:=random(100); Write(a1[i]:6:1); end; END; {s4et4ik slu4ajnyx 4isel} 4: goto vyx; else BEGIN clrscr; textcolor(lightred); writeln('OWIBKA! Vyberite odin iz predlozhennyx punktov'); textcolor(cyan); goto perexod01; END;{else} END; {metody vvoda v pervoj zada4e} {rewenie pervoj zada4i} kol1:=0; repeat K1:=0; for i:=1 to n1-1 do begin if a1[i]> a1[i+1] then begin P1:=a1[i]; a1[i]:=a1[i+1]; a1[i+1]:=p1; k1:=k1+1; kol1:=kol1+1; end; end; until k1=0; Writeln; Writeln('Polu4enniy'); for i:=1 to n1 do Write(a1[i]:6:1); writeln; Writeln('4islo povtoreniy ravno: ',kol1); writeln; writeln; end; 2: BEGIN {vtoraya zada4a} writeln; writeln ('zada4a 2:'); writeln; highvideo; writeln('Matrica A[N,M] (M kratno 4) razdelena po vertikali'); writeln('na 2 polovini.Opredelit summu elementov kajdogo'); writeln('stolbca levoy polovini i summu elementov kajdogo'); writeln('4etnogo stolbca pravoy polovini matrici A.'); normvideo; writeln; writeln('1. S klaviatury'); writeln('2. Iz fajla'); writeln('3. S4et4ik slu4ajnyx 4isel'); writeln('4. Vyxod.'); writeln; highvideo; writeln('vyberite metod vvoda i nazhmite enter'); normvideo; writeln; readln(nom2); textcolor(lightmagenta); textbackground(black); CASE (nom2) of {vybor vvoda vo vtoroj zada4e} 1:BEGIN clrscr; repeat Write('Zadayte 4islo strok v matrice: '); Readln(n2); if (n2>maxsize) or (n2<1) then begin writeln; textcolor(lightred); writeln('OWIBKA!Povtorite'); textcolor(lightmagenta); writeln; END; {if} until (n2>0) and (n2<=maxsize); repeat Write('Zadayte 4islo stolbcov v matrice: '); Readln(m2); if ((m2 mod 4)<> 0) then begin writeln; textcolor(lightred); writeln('OWIBKA!Ne kratno 4'); textcolor(lightmagenta); writeln; END; {if} if (m2>maxsize) or (m2<1) then begin writeln; textcolor(lightred); writeln('OWIBKA!Povtorite'); textcolor(lightmagenta); writeln; END; {if} until (m2>0) and (m2<=maxsize) and ((m2 mod 4) = 0); Write('Zadayte el-ti matrici po'); Writeln(' strokam 4erez probel '); for i:=1 to n2 do begin Write('Stroka ',I,': '); for j:=1 to m2 do read(a2[i,j]); readln; END; end; 2: BEGIN clrscr; write('vvedite imya fajla: '); readln(name); assign(fl,name); {$I-} reset(fl); {$I+} if ioresult=0 then BEGIN repeat read(fl,n2); writeln('koli4estvo strok v matrice: ',n2); if (n2>maxsize) or (n2<1) then begin writeln; textcolor(lightred); writeln('OWIBKA!Povtorite'); textcolor(lightmagenta); writeln; END; {if} until (n2>0) and (n2<=maxsize); repeat read(fl,m2); writeln('koli4estvo stolbcov v matrice: ',m2); if ((m2 mod 4)<> 0) then begin writeln; textcolor(lightred); writeln('OWIBKA!Ne kratno 4'); textcolor(lightmagenta); writeln; END; {if} if (m2>maxsize) or (m2<1) then begin writeln; textcolor(lightred); writeln('OWIBKA!Povtorite'); textcolor(lightmagenta); writeln; END; {if} until (m2>0) and (m2<=maxsize) and ((m2 mod 4) = 0); {vvod matricy po strokam} for i:=1 to n2 do BEGIN Write('Stroka ',I,': '); for j:=1 to m2 do BEGIN read(fl,a2[i,j]); write(a2[i,j]:4:0); END; {for} writeln; END; {for} close(fl); END else BEGIN writeln ('fajl ',name,' ne najden'); goto vyx; END; END; 3:BEGIN clrscr; randomize; repeat n2:=random(25)-5; writeln('4islo strok v matrice: ',n2:2); if (n2>maxsize) or (n2<1) then begin writeln; textcolor(lightred); writeln('OWIBKA!Povtorite'); textcolor(lightmagenta); writeln; END; {if} until (n2>0) and (n2<=maxsize); repeat m2:=random(25)-5; writeln('4islo stolbcov v matrice: ',m2:2); if ((m2 mod 4)<> 0) then begin writeln; textcolor(lightred); writeln('OWIBKA!Ne kratno 4'); textcolor(lightmagenta); writeln; END; {if} if (m2>maxsize) or (m2<1) then begin writeln; textcolor(lightred); writeln('OWIBKA!Povtorite'); textcolor(lightmagenta); writeln; END; {if} until (m2>0) and (m2<=maxsize) and ((m2 mod 4) = 0); Write('Zadayte el-ti matrici po'); Writeln(' strokam 4erez probel '); for i:=1 to n2 do begin Write('Stroka ',I,': '); for j:=1 to m2 do begin a2[i,j]:=random(25); write(a2[i,j]:2:1,' '); END; {for} writeln; END; {for} END; {s4et4ik slu4ajnyx 4isel} 4:goto vyx; else BEGIN clrscr; textcolor(lightred); writeln('OWIBKA! Vyberite odin iz predlozhennyx punktov'); textcolor(cyan); goto perexod01; END;{else} END; {metod vvoda vo vtoroj zada4e} {rewenie vtoroj zada4i} Writeln('Summa el-tov v levoy polovine'); j:=1; While j<=(m2 div 2) do begin S2_:=0; I:=1; While i<=n2 do begin S2_:=S2_+a2[i,j]; I:=i+1; end; Writeln('Summa ',j,'-go stolbca ravna: ', S2_:4:1); J:=J+1; end; Writeln('Summa el-tov v pravoy polovine'); j:=((m2 div 2)+1); While j<=m2 do begin if (j mod 2)=0 then begin S2_:=0; I:=1; While i<=n2 do begin S2_:=S2_+a2[i,j]; I:=i+1; end; Writeln('Summa ',j,'-go stolbca ravna: ', S2_:4:1); end; J:=J+1; end; writeln; writeln; END; {vtoraya zada4a} 3: BEGIN {tret'ya zada4a} writeln; writeln ('zada4a 3:'); writeln; highvideo; writeln('Realizovat nabor podprogramm dlya vipolneniya sleduuwix'); writeln('operaciy nad 4islami v westnadcatiri4noy sisteme s4isleniya:'); writeln('a) slojenie,b)vi4itanie,c)umnojenie,d)delenie,e) perevod iz'); writeln('dvoi4noy sistemi s4isleniya(s/s) v westnadcatiri4nuu,f)perevod'); writeln('iz westnadcatiri4noy s/s v desyati4nuu,g)funkciya proverki'); writeln('pravilnosti zapisi 4isla v westnadcatiri4noy s/s,h)funkcii,'); writeln('realizuuwie operacii otnoweniya(ravno,ne ravno,bolwe ili ravno'); writeln('menwe ili ravno,bolwe,menwe).'); writeln('1)Vozvesti 4islo v stepen(osnovanie i pokazatel stepeni zapisani'); writeln('v westnadcatiri4noy s/s).Otvet vidat v westnadcatiri4noy i'); writeln('desyati4noy s/s'); writeln('2)Dan massiv A-massiv 4isel,zapisannix v westnadcatiri4noy s/s'); writeln('Otsortirovat ego v poryadke ubivaniya.Otvet vidat v westnadcatiri4noy'); writeln('i desyati4noy s/s'); normvideo; writeln; writeln('1. Slojenie'); writeln('2. Vichitanie'); writeln('3. Umnojenie'); writeln('4. Delenie'); writeln('5. Perevod iz 2 s/s v 16 s/s'); writeln('6. Perevod iz 16 s/s v 10 s/s'); writeln('7. Proverka pravilnosti zapisi 4isla v 16 s/s'); writeln('8. Operacii otnoweniya'); writeln('9. Vozvedenie 4isla v stepen'); writeln('10. Sortirovka massiva'); writeln('11. Vixod'); writeln; highvideo; writeln('vyberite nomer i nazhmite enter'); normvideo; writeln; readln(nom4); textcolor(lightblue); textbackground(black); CASE (nom4) of {vybor zadaniya v tret'ey zada4e} 1: begin clrscr; perexod02: begin Writeln('Slojenie'); Writeln; writeln('1. S klaviatury'); writeln('2. Iz fajla'); writeln('3. S4et4ik slu4ajnyx 4isel'); writeln('4. Vyxod.'); writeln; highvideo; writeln('vyberite nomer i nazhmite enter'); normvideo; writeln; readln(nom2); textcolor(lightblue); textbackground(black); clrscr; CASE (nom2) of {vybor metoda v tret'ey zada4e} 1: begin clrscr; repeat Write('Vvedite pervoe 16-ri4noe 4islo: '); Readln(s1); res3_7:=check_hex(s1); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7; repeat Write('Vvedite vtoroe 16-ri4noe 4islo: '); Readln(s2); res3_7:=check_hex(s2); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7; end; 2: begin clrscr; write('vvedite imya fajla: '); readln(name); assign(fl,name); {$I-} reset(fl); {$I+} if ioresult=0 then BEGIN repeat readln(fl,s1); writeln('Pervoe 16-ri4noe 4islo: ',s1); res3_7:=check_hex(s1); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7=true; repeat readln(fl,s2); writeln('Vtoroe 16-ri4noe 4islo: ',s2); res3_7:=check_hex(s2); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7=true; close(fl); end{if} else BEGIN writeln ('fajl ',name,' ne najden'); goto vyx; end;{iz fayla} end; 4:goto vyx; else BEGIN clrscr; textcolor(lightred); writeln('OWIBKA! Vyberite odin iz predlozhennyx punktov'); textcolor(cyan); goto perexod02; END;{else} end; {rewenie 3_1} res3:=addHexToHex(s1,s2); Writeln('Rezultat raven: ',res3); writeln; writeln; end; end;{perexod02} 2: begin clrscr; perexod03: begin Writeln('Vi4itanie'); Writeln; writeln('1. S klaviatury'); writeln('2. Iz fajla'); writeln('3. S4et4ik slu4ajnyx 4isel'); writeln('4. Vyxod.'); writeln; highvideo; writeln('vyberite nomer i nazhmite enter'); normvideo; writeln; readln(nom2); textcolor(lightblue); textbackground(black); CASE (nom2) of {vybor metoda v tret'ey zada4e} 1: begin clrscr; repeat Write('Vvedite pervoe 16-ri4noe 4islo: '); Readln(s1); res3_7:=check_hex(s1); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7; repeat Write('Vvedite vtoroe 16-ri4noe 4islo: '); Readln(s2); res3_7:=check_hex(s2); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7; end; 2: begin clrscr; write('vvedite imya fajla: '); readln(name); assign(fl,name); {$I-} reset(fl); {$I+} if ioresult=0 then BEGIN repeat readln(fl,s1); writeln('Pervoe 16-ri4noe 4islo: ',s1); res3_7:=check_hex(s1); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7=true; repeat readln(fl,s2); writeln('Vtoroe 16-ri4noe 4islo: ',s2); res3_7:=check_hex(s2); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7=true; close(fl); end{if} else BEGIN writeln ('fajl ',name,' ne najden'); goto vyx; end;{iz fayla} end; 4:goto vyx; else BEGIN clrscr; textcolor(lightred); writeln('OWIBKA! Vyberite odin iz predlozhennyx punktov'); textcolor(cyan); goto perexod03; END;{else} end; {rewenie 3_2} res3:= vich(s1,s2); Writeln('Rezultat raven: ',res3); writeln; writeln; end;{perexod03} end; 3: begin clrscr; perexod04: begin Writeln('Umnojenie'); Writeln; writeln('1. S klaviatury'); writeln('2. Iz fajla'); writeln('3. S4et4ik slu4ajnyx 4isel'); writeln('4. Vyxod.'); writeln; highvideo; writeln('vyberite nomer i nazhmite enter'); normvideo; writeln; readln(nom2); textcolor(lightblue); textbackground(black); CASE (nom2) of {vybor metoda v tret'ey zada4e} 1: begin clrscr; repeat Write('Vvedite pervoe 16-ri4noe 4islo: '); Readln(s1); res3_7:=check_hex(s1); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7; repeat Write('Vvedite vtoroe 16-ri4noe 4islo: '); Readln(s2); res3_7:=check_hex(s2); if res3_7=false then begin textcolor(lightred); Writeln('Owibka!Povtorite vvod 4isla'); textcolor(lightblue); writeln; end; until res3_7; end; 2: begin clrscr; write('vvedite imya fajla: '); readln(name); assign(fl,name); {$I-} reset(fl); {$I+} if ioresult=0 then BEGIN repeat readln(fl,s1); writeln('Pervoe 16-ri4noe 4islo: ',s1); res3_7:=check_hex(s1); if res3_7=false then begin