Stian Søiland, IT 111, øvingsgruppe 15 (stud.ass. Kari Alvheim)
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) filinn: TEdit; filut: TEdit; Button1: TButton; Label1: TLabel; Label2: TLabel; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); // Prosedyre for å fjerne ekstra mellomrom procedure mellomrom(var tekst:string); var i: integer; temp1,temp2: string; begin temp1 := ''; temp2 := ''; // Gjennomløper hele filen for i:=1 to length(tekst) do begin // Leser inn et tegn og tegnet som følger etter temp2 := Copy(tekst,i,2); if (temp2 = ' ') then begin // Dette mellomrommet blir ikke innsatt i den nye strengen. // Det vil derimot det første mellomrommet som følges av noe // annet enn et mellomrom. Mellomrom helt sist i filen vil bli // inkludert fordi da vil temp2 være ' '. end else begin // Tegnet er 'godkjent' og settes inn i den nye strengen. temp1 := temp1 + tekst[i]; end; end; // Tegn ferdig behandlet tekst := temp1; end; // Prosedyre for å gjøre alle bokstaver om til små bokstaver // Er frekk og går ut over oppgaven til å ikke bare gjøre om // første bokstaven i et ord. // Egennavn ignoreres tvert. Forkortelser med bare store // bokstaver, eksempel 'CERN', ser bedre ut som 'cern' enn som 'cERN', // og denne løsningen vurderes derfor til å være ørlite bedre enn den // foreslått av oppgaveteksten. procedure lowcase(var tekst:string); var i: integer; temp,temp1: string; begin temp := tekst; i := Length(tekst); // gjennomløper hvert tegn i strengen for i:=1 to length(tekst) do begin // tegnet lagres i lower case // AnsiLowerCase gjør også om norske tegn såfremt // filen er i riktig tegnsett (ie. filer laget i DOS får ikke sine // norske tegn riktig konvertert) SetLength(temp1,1); temp1[1] := temp[i]; temp[i] := AnsiLowerCase(temp1)[1]; end; // den ferdige strengen utleveres tekst := temp; end; // Prosedyre for å sette inn doble mellomrom mellom setninger og // stor forbokstav. procedure setning(var tekst:string); var i: integer; temp : string; tegn : char; nysetning : boolean; begin // initierer temp := ''; nysetning := true; // gjennomløper hvert tegn i filen for i:=1 to length(tekst) do begin // Leser aktuelt tegn til char-variabel tegn := tekst[i]; // Ignorer mulige setninger i parantes og anførselstegn if (tegn = '.') or (tegn = '?') or (tegn = ':') or (tegn = '!') then begin // Det setningsavsluttende tegnet legges til den nye strengen temp := temp + tegn; // Påfølgende tegn skal behandles særskilt. nysetning := true; end else // tegnet er ikke setningsavsluttende begin // sjekker for særskilt behandling if nysetning then begin if tegn = ' ' then begin // Legger til dobbelt mellomrom istedet for enkelt temp := temp + ' '; end // if mellomrom slutt else begin // Tegnet blir lagt til i upper case hvis mulig temp := temp + AnsiUpperCase(tegn); // ingen mer særskilt behandling nysetning := false; end; end // særskilt tegnbehandling slutt else begin // Tegn som ikke er særskilt behandlet settes inn som de er nysetning := false; temp := temp + tegn; end; end; // ikke-setningsavsluttende ferdig end; // gjennomløping av fil ferdig // den ferdige strengen utleveres tekst := temp; end; // Hovedprogrammet var lesinn,skrivut: textfile; temp,temp1,temp2,filen: string; posisjon1 : integer; sjekkdelord,ferdig : boolean; const DelOrd='uformatert '; DelTil='uforma- tert '; begin // åpner fil for lesing AssignFile(lesinn,filinn.text); Reset(lesinn); // initierer, punktum før første setning for å fikse forbokstav filen := ''; temp := ''; // Leser inn filen til en eneste stor tekststreng. Oppgaveteksten // sier ingenting om hvordan linjeskift i tekststrengen er. // I eksempelteksten er hele teksten på én linje. // Siden Delphi er så dum må filen ha to avsluttende linjeskift. // En tekststreng kan være opptil 2 GB stor. Større filer enn det // anser jeg som usannsynlig. while not eof(lesinn) do begin // Leser linje, setter inn mellomrom mellom ord på hver linje filen := filen + ' ' + temp; readln(lesinn,temp); end; // lukker åpen fil CloseFile(lesinn); // Første mellomrom i filen fjernes filen := copy(filen,3,length(filen)-2); // Prosedyrekall for å formatere tekst mellomrom(filen); lowcase(filen); setning(filen); // Skriver til fil med linjer maksimalt 20 tegn. Dersom det ikke // er plass til et ord på en linje må det skrives på neste linje. // Dersom ordet er større enn 20 tegn får bare første delen av ordet være // med. Dette skyldes oppgaveformuleringen. // Åpner fil for skriving AssignFile(skrivut,filut.text); Rewrite(skrivut); // initierer sjekkdelord := true; temp := filen; ferdig := false; temp2 := ''; while not ferdig do begin // finner ut hvor første ord i reststreng slutter posisjon1 := pos(' ',temp); if (posisjon1 = length(temp)) or (posisjon1 = 0) then begin // Dette er det siste ordet i filen ferdig := true; // sluttposisjon settes til siste tegn i tilfelle siste tegn // ikke var et mellomrom posisjon1 := length(temp); end; // dette ordet, inklusivt mellomrom på slutten, lagres i temp1 temp1 := copy(temp,1,posisjon1); // sjekker om neste tegn også er et mellomrom, og inkluderer isåfall dette if (temp[posisjon1+1] = ' ') then temp1 := temp1 + ' '; // temp blir resten av strengen temp := copy(temp,posisjon1+1,length(temp)); // krymper temp1 hvis den er større enn 20 tegn if length(temp1) > 20 then temp1 := copy(temp1,1,20); if length(temp2 + temp1) > 20 then begin // sjekker om temp1 er ordet som skal deles if (temp1 = DelOrd) and sjekkdelord then begin posisjon1 := pos(' ',DelTil); temp1 := copy(DelTil,1,posisjon1); if length(temp2 + temp1) > 20 then // Linjen blir for lang selv med bare første del av // delte ord begin temp := DelOrd + temp; sjekkdelord := false; // reststreng er som før, sløyfen vil gjentas, men denne gangen vil // DelOrd-sjekken være negativ end else begin // Linjen skrives med første del av delte ord temp2 := temp2 + temp1; writeln(skrivut,temp2); // Temp2 nullstilles og er klar for neste linje temp2 := ''; // Resten av det delte ordet legges til reststreng temp := copy(DelTil,posisjon1+1,length(DelTil)) + temp; end; end else // temp1 er ikke ordet som skal deles begin // Nå kan vi sjekke for om ord skal deles igjen sjekkdelord := true; // temp2 er for lang dersom temp1 inkluderes // temp2 skrives derfor til fil, og temp1 inkluderes i // reststrengen igjen temp := temp1 + temp; writeln(skrivut,temp2); // Temp2 nullstilles og er klar for neste linje temp2 := ''; end; end // slutt temp2 for lang else begin // temp2 blir ikke for lang, ordet kan taes med temp2 := temp2 + temp1; end; end; // Alle fulle linjer er skrevet til fil // Skriver siste rest til fil hvis det er mer igjen... if temp2 <> '' then writeln(skrivut,temp2); // Filen lukkes, programmet er ferdig CloseFile(skrivut); end; end.