Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.165 Beiträge
 
Delphi 12 Athens
 
#25

AW: Komprimierung : Wie geht das?

  Alt 15. Jul 2010, 22:00
doch mal getestet:
die Längenberechnung war erstmal falsch, so daß da zuwenig gelöscht wurde und es bei mehrfachen #0 dann zur Endlosschleife kam, da die #0 immer wieder eingefügt wurde.

- AnsiString, wegen den Unicode-Delphis und da es hier für einen "Byte-Stream" verwendet wird
- Dec(a, i); , zur Längenberechnung war falsch ... mußte Dec(a, i - 1); sein
- und dann noch so einige andere Kleinigkeiten

Delphi-Quellcode:
function LauflängenKodierung(S: AnsiString): AnsiString;
var
  i, a: Integer;
  c: AnsiChar;
begin
  i := 1;
  while i <= Length(S) do
    if (i < Length(S)) and (S[i] = S[i + 1]) then begin
      c := S[i];
      a := i + 1;
      while (a < Length(S)) and (c = S[a + 1]) and (a - i < 65790) do Inc(a);
      Dec(a, i - 1);
      if (a < 4) and (c <> #0) then begin
        Inc(i, a);
        Continue;
      end;
      Delete(S, i, a);
      if a < 256 then begin
        Insert(#0 + AnsiChar(a - 1) + C, S, i);
        Inc(i, 3);
      end else begin
        Dec(a, 256);
        Insert(#0#255 + AnsiChar(a div 256) + AnsiChar(a mod 256) + C, S, i);
        Inc(i, 5);
      end;
    end else if S[i] = #0 then begin
      Insert(#0, S, i);
      Inc(i, 2);
    end else Inc(i);
  Result := S;
end;

function LauflängenDekodierung(S: AnsiString): AnsiString;
var
  i, a: Integer;
  c: AnsiChar;
begin
  i := 1;
  while i < Length(S) do
    if S[i] = #0 then begin
      a := Ord(S[i + 1]);
      if a = 0 then begin
        Delete(S, i, 1);
        Inc(i);
      end else if a < 255 then begin
        Inc(a);
        c := S[i + 2];
        Delete(S, i, 3);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end else begin
        a := Ord(S[i + 2]) * 256 + Ord(S[i + 3]) + 256;
        c := S[i + 4];
        Delete(S, i, 5);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end;
    end else Inc(i);
  Result := S;
end;

procedure TForm5.FormCreate(Sender: TObject);
var S: TStream;
  A, B, C: AnsiString;
begin
  S := TFileStream.Create('test.bmp', fmOpenRead or fmShareDenyNone);
  SetLength(A, S.Size);
  S.ReadBuffer(A[1], S.Size);
  S.Free;

  B := LauflängenKodierung(A);
  C := LauflängenDekodierung(B);

  ShowMessage(Format('%d=%d (%d) ... %d (%.1n%%)',
    [Length(A), Length(C), Ord(A = C), Length(B), Length(B) / Length(A) * 100]));
end;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu (15. Jul 2010 um 22:10 Uhr)
  Mit Zitat antworten Zitat