
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.