All pastes #394864 Raw Edit

Miscellany

public text v1 · immutable
·published 2007-03-14 16:58 UTC
rendered paste body
//Robertas Jurkaitis, 8 grupe, 1 uzduotis, 7 variantas
//Nuskaito intext.txt, surikiuoja abeceles tvarka tuos zodzius, kurie turi dvibalsius, isveda i outtext.txt
program uzd1;
type mas=array[1..1000] of string;

//PATIKRINAM AR SIMBOLIS RAIDE

function check(ch:char):boolean;

begin
    check:=FALSE;
    if (ord(ch) >= 65)and(ord(ch) <= 90) then check:=TRUE;
    if (ord(ch) >= 97)and(ord(ch) <= 122) then check:=TRUE;
end;

//NUSKAITOM

procedure readz(var arr:mas; var wordnr:integer);
var intext:text;
    ch:char;
    word:string;

begin
    assign(intext ,'intext.txt');
    reset(intext);
    wordnr:= 0;
    word:='';
    while not EOF(intext) do
    begin
        read(intext, ch);
        if check(ch) //ar raide
        then word:=concat(word, ch)
        else if word<>'' then
        begin
            wordnr:=wordnr+1;
            arr[wordnr]:=word;
            word:= '';
        end;
    end;
    close(intext);
end;

//SURIKIUOJAM

procedure sortz(var arr:mas; wordnr:integer);
var i, j:integer;
    s1, s2, temp:string;

begin
    for i:=1 to wordnr do
    begin
        for j:=i+1 to wordnr do
        begin
            s1:=lowercase(arr[i]);
            s2:=lowercase(arr[j]);
            if s1>s2 then
            begin
                temp:=arr[i];
                arr[i]:=arr[j];
                arr[j]:=temp;
            end;
        end;
    end;
end;

//AR BALSE?

function arbalse(balse:char):boolean;
var z:integer;
    balses:string;

begin
    arbalse:=FALSE;
    balses:='AEIOUaeiou';
    for z:=0 to 9 do
    begin
        if balses[z]=balse
        then arbalse:=TRUE;
    end;
end;
    
    
//PATIKRINAM IR SPAUSDINAM

procedure checkprint(var arr:mas; var wordnr:integer);
var outtext:text;
    n, m:integer;

begin
    assign(outtext, 'outtext.txt');
    rewrite(outtext);
    for n:=1 to wordnr do
    begin
        for m:=1 to length(arr[n])-1 do
        begin
            if arbalse(arr[n][m]) and arbalse(arr[n][m+1]) then
            begin
                writeln(outtext, arr[n]);
                break;
            end;
        end;
    end;
    close(outtext);
end;

//Programa

var wordnr:integer;
    arr:mas;

begin
    writeln('Programa nuskaitys tekstini faila intext.txt, surusiuos pagal abecele ir isves i outtext.txt tik zodzius su dvibalsiais');
    readz(arr, wordnr);
    writeln('Failas intext.txt nuskaitytas');
    sortz(arr, wordnr);
    writeln('Zodziai surikiuoti pagal abecele');
    checkprint(arr, wordnr);
    writeln('Zodziai su dvibalsiais isvesti faile outtext.txt abeceles tvarka');
    writeln('Paspauskite Enter');
    readln();
end.