Delphi

Stian Søiland, IT 111, øvingsgruppe 15 (stud.ass. Kari Alvheim)

Delphi - Øving 5- Oppgave 1

Oppgave 1
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.

 


© Stian Søiland 1998

Valid HTML 4.0!