// Kompression
procedure CompressBitmap_Slow(bmp: TBitmap;
var Data:
string);
var
ms: TMemoryStream;
buf: pointer;
size: integer;
begin
ms := TMemoryStream.Create;
bmp.SaveToStream(ms);
ZCompress(ms.Memory, ms.size, buf, size);
SetLength(Data, size);
Move(buf^, Data[1], size);
FreeMem(buf);
ms.Free;
end;
procedure CompressBitmap(bmp: TBitmap;
var Data:
string);
var
cs: TZCompressionStream;
ms: TMemoryStream;
begin
ms := TMemoryStream.Create;
cs := TZCompressionStream.Create(ms, zcDefault);
bmp.SaveToStream(cs);
cs.Free;
SetLength(Data, ms.size);
Move(ms.Memory^, Data[1], ms.size);
ms.Free;
end;
procedure UnCompressBitmap(
const Data:
string; bmp: TBitmap);
var
ms: TMemoryStream;
buf: pointer;
size: integer;
outsize: integer;
begin
try
size := 0;
outsize := Length(Data) * 3;
ZDecompress(@Data[1], Length(Data), buf, outsize, size);
except
on E:
Exception do
begin
E.
Message := Format('
Error Decompressing Buffer (Len = %d):'#13#10'
%s',
[Length(Data), E.
Message]);
raise;
end;
end;
ms := TMemoryStream.Create;
ms.
Write(buf^, outsize);
FreeMem(buf);
ms.Position := 0;
Assert(bmp <>
nil);
bmp.LoadFromStream(ms);
ms.Free;
end;
{------ MAIN ------}
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
Data:
string;
FStream: TMemoryStream;
bmp: TBitmap;
begin
FStream := TMemoryStream.Create;
try
AContext.Connection.Socket.ReadStream(FStream);
FStream.Position := 0;
finally
try
FStream.
Read(Data, 1000000);
finally
bmp.LoadFromStream(FStream);
FStream.Free;
end;
end;
UnCompressBitmap(Data, bmp);
PaintBox1.Canvas.Create(bmp);
//Bin mir da nicht sicher, was ist mit data?
end;