Tipy a triky v Delphi, díl 98.

Téma je jasné, takže se hned bez dalších řečí pusťme do práce. Pro náš příklad si vytvoříme dvě funkce. První bude paměťový blok komprimovat, druhá naopak. Budou vlastně tvořit pouze jakési rozhraní a o samotnou kompresi se postará knihovna ZLib.

Těchto dvou funkcí pak využijeme k našemu příkladu. Na formulář přidáme dvě tlačítka (jedno na kompresi, druhé pro dekompresi) a komponentu RichEdit. Tu naplníme nějakým textem. Samozřejmě nestačí napsat dvě tři slova, protože abychom dobře viděli výsledný efekt, je potřeba použít delší text, kde bude komprese dobře patrná. Zkomprimovaný obsah RichEditu pak bude uložen do souboru na disk a vypočítáme si i výsledný kompresní poměr.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ZLib, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    RichEdit1: TRichEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure CompressStream(inpStream, outStream: TStream);
var
  InpBuf, OutBuf: Pointer;
  InpBytes, OutBytes: Integer;
begin
  InpBuf := nil;
  OutBuf := nil;
  try
    GetMem(InpBuf, inpStream.Size);
    inpStream.Position := 0;
    InpBytes := inpStream.Read(InpBuf^, inpStream.Size);
    CompressBuf(InpBuf, InpBytes, OutBuf, OutBytes);
    outStream.Write(OutBuf^, OutBytes);
  finally
    if InpBuf <> nil then FreeMem(InpBuf);
    if OutBuf <> nil then FreeMem(OutBuf);
  end;
end;

procedure DecompressStream(inpStream, outStream: TStream);
var
  InpBuf, OutBuf: Pointer;
  OutBytes, sz: Integer;
begin
  InpBuf := nil;
  OutBuf := nil;
  sz := inpStream.Size - inpStream.Position;
  if sz > 0 then
    try
      GetMem(InpBuf, sz);
      inpStream.Read(InpBuf^, sz);
      DecompressBuf(InpBuf, sz, 0, OutBuf, OutBytes);
      outStream.Write(OutBuf^, OutBytes);
    finally
      if InpBuf <> nil then FreeMem(InpBuf);
      if OutBuf <> nil then FreeMem(OutBuf);
    end;
  outStream.Position := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ms1, ms2: TMemoryStream;
begin
  ms1 := TMemoryStream.Create;
  try
    ms2 := TMemoryStream.Create;
    try
      RichEdit1.Lines.SaveToStream(ms1);
      CompressStream(ms1, ms2);
      ShowMessage(Format(`Kompresni pomer: %d %%`, [round(100 / ms1.Size * ms2.Size)]));
      ms2.SaveToFile(`C:\test.dat`);
    finally
      ms1.Free;
    end;
  finally
    ms2.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  ms1, ms2: TMemoryStream;
begin
  ms1 := TMemoryStream.Create;
  try
    ms2 := TMemoryStream.Create;
    try
      ms1.LoadFromFile(`C:\test.dat`);
      DecompressStream(ms1, ms2);
      RichEdit1.Lines.LoadFromStream(ms2);
    finally
      ms1.Free;
    end;
  finally
    ms2.Free;
  end;
end;

end.

Nezapomeňte si také upravit cestu k výstupnímu souboru. Jak vidíte, samotný postup je velmi jednoduchý a při ukládání rozličných dat je velmi dobře použitelný (příklad s RichEdit je jen na ukázku).