PROGRAMOWANIE TP łancuchy

Program szukanie;

USES crt;

VAR s,s1,s2:STRING;

k,n1,n2:byte;

PROCEDURE podkresl;

VAR k:byte;

BEGIN

FOR k:=1 TO 79 DO write('-');

writeln

END;{Procedury}

BEGIN

clrscr;

writeln('Wpisz napis s1 i jeden znak s2, a dowiesz sie,na którym miejscu ');

writeln('w s1 występuje s2, czyli poznasz działanie funkcji POS');

podkresl;

write('Napisz łańcuch znaków s1:'); readln(s1);

write('Znak (litera, spacja)'); readln(s2);

podkresl;

writeln('Znak s2 występuje na ',POS(s2,s1),' pozycji łańcucha s1');

podkresl;

writeln('A teraz jak działa instrukcja DELETE(s,n1,n2)');

write('Napisz łańcuch znaków s: '); readln(s);

write('Od którego znaku zacząć wycinać łańcuch s ? n1= '); readln(n1);

write('Ile znaków wyciąć? n2= '); readln(n2);

podkresl;

DELETE(s,n1,n2);

{Instrukcja DELETE wycina z łańcucha s n2 znaków, poczynając od pozycji n1}

IF length(s)<=0 THEN writeln('Wyciałem cały łancuch') ELSE

{Jeżeli n1=1, a n2>dlugosci łańcucha, to po wycięciu nie pozostaje łańcuch}

writeln('Nowy łańcuch, po wycięciu n2 znaków z łańcucha s: ',s);

readln

END.

PROGRAM na_odwrot; { Uzyskać rekurencyjnie zadane słowo wspak }

var txt : String;

procedure wspak(i:Integer; txt:String); { 'i' - numer znaku w tekście 'txt', który ma być pokazany }

begin

if i=length(txt) then write(txt[i]) { jeśli jest to ostatnia litera - drukujemy je }

else begin { w przeciwnym przypadku }

wspak(i+1,txt); { wywołujemy funkcję rekurencyjnie }

write(txt[i]) { a potem drukujemy t‘ liter‘ }

end { taka! kolejność ostatnich dwu procedur zapewnia wyświetlanie wpierw liter dalszych ze zmiennej 'txt' }

end; { procedury wspak }

begin

writeln('Podaj tekst');

readln(txt);

writeln('wspak: ');

wspak(1,txt);

readln

end.

PROGRAM SUMA_LANC;

USES crt;

VAR s1,s2:STRING;

k,i:byte;

PROCEDURE podkresl;

VAR k:byte;

BEGIN

FOR k:=1 TO 79 DO write('=');

writeln

END;{Procedury}

BEGIN

clrscr;

writeln('Wpisz dwa napisy, a otrzymasz trzeci napis składający się z tych ');

writeln('znaków napisu pierwszego, które nie występują w drugim.');

podkresl;

write('Napis pierwszy '); readln(s1);

write('Napis drugi '); readln(s2);

podkresl;

FOR i:=1 TO length(s2) DO

WHILE POS(s2[i],s1)<>0 DO DELETE(s1,POS(s2[i],s1),1);

writeln('Napis trzeci ',s1);

podkresl;

readln

END.

PROGRAM ANAGRAM; { Anagramy }

uses Crt;

const maxdl=5; { maksymalna długość słowa }

var txt, anagram : String[maxdl];

i, j, dltxt : Integer;

{ procedura rekurencyjna wybierająca kolejne litery ze zmiennej 'txt'

i wstawiająca je do zmiennej 'anagram';

kolejne wywołania procedury następują z coraz krótszym tekstem (pozostałymi literami);

procedura zaś na danym poziomie wywołania dołącza na k-tym miejscu w wyrazie

(gdzie k-liczba kolejnych wywołań procedury) kolejno wszystkie pozostałe litery }

procedure litera(txt:string);

var i,n : Integer;

lt : String[1]; { litera jako zmienna typu STRING a nie CHAR aby

ułatwić operacje na tekście }

begin

n:=length(txt);

if n=0 then

writeln(anagram){ jeśli już nie ma liter do dołączenia drukuj anagram}

else

for i:=1 to n do { dla wszystkich pozostałych liter }

begin

anagram[dltxt-n+1]:=txt[i]; { dołącz kolejne liter‘ }

lt:=copy(txt,i,1); { zapamiętaj je na tym poziomie wywołania procedury }

delete(txt,i,1); { usuń liter‘ z tekstu }

litera(txt); { wywołaj procedur‘ litera' z krótszym tekstem }

insert(lt,txt,i); { dołącz poprzednio usunięte litery }

end;

end;

(*********** program główny ***********)

begin

ClrScr;

writeln('Napisz jakieś słowo (do 5 znaków) i naciśnij ENTER');

readln(txt);

dltxt:=length(txt);

anagram[0]:=Chr(dltxt); { ustalamy długość anagramu }

litera(txt); { wywołanie procedury rekurencyjnej }

readln;

end.

program kalkulator_duzy;

uses crt;

type liczby=string[255];

VAR

X,Y,O:LICZBY;

PROCEDURE INICJUJ;

VAR I:BYTE;

A:LICZBY;

BEGIN

A:='0';

FOR I:=1 TO 254 DO A:=A+'0';

O:=A;

END;

PROCEDURE CZYTAJ (VAR X:LICZBY);

VAR I,N:BYTE;

POM: LICZBY;

BEGIN

READLN (X);

POM:=O;

N:=LENGTH(X);

FOR I:=1 TO LENGTH (X) DO

POM[I]:=X[(N+1)-I];

X:=POM;

END;

FUNCTION DODAJ (X,Y:LICZBY): LICZBY;

VAR I,TEMP,X1,Y1:BYTE;

KOD: INTEGER;

C:STRING[2];

BEGIN

DODAJ:=O;

TEMP:=0;

FOR I:=1 TO 255 DO

BEGIN

VAL(X[I],X1,KOD);

VAL(Y[I],Y1,KOD);

STR(X1+Y1+TEMP,C);

CASE LENGTH(C) OF

1:BEGIN

TEMP:=0;

DODAJ[I]:=C[1]

END;

2:BEGIN

TEMP:=1;

DODAJ[I]:=C[2];

END;

END;

END;

END;

PROCEDURE NAPISZ(X:LICZBY);

VAR I,J:BYTE;

BEGIN

REPEAT I:=I-1

UNTIL X[I]<>'0';

FOR J:=I DOWNTO 1 DO

WRITE (X[J]);

WRITELN;

END;

BEGIN

CLRSCR;

INICJUJ;

CZYTAJ (X);

CZYTAJ (Y);

NAPISZ( DODAJ(X,Y));

READLN;

END.