Nadesłany przez Tomasz Lubiński, 16 czerwca 2007 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
RLE - Delphi/RLE.dpr:
// Kompresja RLE (Run Length Encoding) // www.algorytm.org // (c) 2007 by Tomasz Lubinski program RLE; {$APPTYPE CONSOLE} uses SysUtils; // kompresja RLE procedure compress(inFile: Integer; outFile: Integer); var cur, prev, tmp: Byte ; cnt: Byte; cont: Integer; begin cnt := 0; cont := FileRead(inFile, cur, 1); prev := not(cur); while cont = 1 do begin if (prev <> cur) then if (cnt = 0) then // znaki obok siebie rozne wrzuc do pliku wyjsciowego FileWrite(outFile, cur, 1) else begin // skonczyla sie sekwencja powtarzajcych sie znakow cnt := cnt-1; FileWrite(outFile, prev, 1); FileWrite(outFile, cnt, 1); FileWrite(outFile, cur, 1); cnt := 0; end else // liczbe powtarzajacych sie znakow zapisujemy na jednym bajcie // wypisz sekwencje jezeli ma ona maksymalna dlugosc if (cnt = 255) then begin FileWrite(outFile, prev, 1); FileWrite(outFile, cnt, 1); cnt := 0; cont := FileRead(inFile, cur, 1); prev := not(cur); continue; end else // licz powtarzajace sie znaki cnt := cnt+1; // odczytaj kolejny znak z pliku wejsciowego cont := FileRead(inFile, tmp, 1); if (cont = 1) then begin prev := cur; cur := tmp; end; end; // jezeli plik konczy sie sekwencja wypisz ja if (prev = cur) then begin cnt := cnt-1; FileWrite(outFile, prev, 1); FileWrite(outFile, cnt, 1); end; end; // dekompresja RLE procedure decompress(inFile: Integer; outFile: Integer); var cur, prev, cnt: Byte; cont, i: Integer; begin cont := FileRead(inFile, cur, 1); prev := not(cur); while (cont = 1) do if (prev <> cur) then begin // znaki obok siebie rozne wrzuc do pliku wyjsciowego FileWrite(outFile, cur, 1); prev := cur; // odczytaj kolejny znak cont := FileRead(inFile, cur, 1); end else begin // znaki obok siebie sa rowne - mamy sekwencje // odczytaj dlugosc sekwencji i wrzuc ja do pliku wyjsciowego FileRead(inFile, cnt, 1); for i:=0 to cnt do FileWrite(outFile, cur, 1); // odczytaj kolejny znak cont := FileRead(inFile, cur, 1); prev := Not(cur); end; end; var x: Integer; inPath, outPath: String; inFile, outFile: Integer; begin Writeln('1 - kompresja'); Writeln('2 - dekompresja'); Readln(x); Writeln('Plik wejsciowy'); Readln(inPath); Writeln('Plik wyjsciowy:'); Readln(outPath); inFile := FileOpen(inPath, fmOpenRead); outFile := FileCreate(outPath); if inFile <= 0 then begin Writeln('Nie moge otworzyc pliku wejsciowego'); exit; end; if outFile <= 0 then begin Writeln('Nie moge utworzyc pliku wyjsciowego'); exit; end; if x = 1 then compress(inFile, outFile) else decompress(inFile, outFile); FileClose(inFile); FileClose(outFile); end.