JPEG Image in Stream schreiben

[Zodi]

Hi Delphianer.

Ich versuche mich gerade an einem TEAMVIEWER.

Dazu erzeuge ich einen Screenshot und wandle das BITMAP in ein JPEG um.
Nun will ich die JPEG in ein MemoryStream schreiben und mit SetString in einen String umwandeln damit ich ihn später über die Sockets versenden kann.
Für die Streams verwende ich die CompressionsStreamUnit.

Leider meldet mir der Compiler immer Inkompatible Typen TStream und TMemoryTream wenn ich das JPEG ind den Stream speichern will.

Delphi-Quellcode:

unit UnitScreenCapture;

interface

uses
  windows, vcl.Graphics, Vcl.Forms,  Vcl.Imaging.jpeg, Vcl.ExtCtrls, CompressionStreamUnit;
var
   jpgImg: TJPEGImage;
   myimg: Timage;

function GetScreenShot: TBitmap;
Function SaveShotToStream(PIC: TBitmap): String;

implementation

uses unit1;


function GetScreenShot: TBitmap;
var
  Desktop: HDC;
begin
  Result  := TBitmap.Create;
  Desktop := GetDC(0);
  try
    try
      Result.PixelFormat := pf32bit;
      Result.Width := Screen.Width;
      Result.Height := Screen.Height;
      BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
      Result.Modified := True;
    finally
      ReleaseDC(0, Desktop);
    end;
  except
    Result.Free;
    Result := nil;
  end;
end;


Function SaveShotToStream(PIC: TBitmap): String;

var
   St: TMemoryStream;

begin


   ST := TMemoryStream.Create;

   Myimg.Picture.Bitmap := GetScreenShot;

   jpgImg := TJPEGImage.Create;

   jpgImg.CompressionQuality := 80;
   jpgimg.Compress;

   jpgImg.Assign(Myimg.Picture.Bitmap);

   jpgImg.SaveToFile('TestBild.jpg')

   jpgimg.SaveToStream(ST);

end;

Hier die CompressionSTreamUnit

Delphi-Quellcode:

unit CompressionStreamUnit;

interface

{$WARNINGS OFF}

uses
  Windows;

const
  ZLIB_VERSION = '1.1.4';
  WM_USER = $0400;
  MaxListSize = Maxint div 16;
  soFromBeginning = 0;
  soFromCurrent = 1;
  soFromEnd = 2;

type
  TNotifyEvent = procedure(Sender: TObject) of object;

  TSeekOrigin = (soBeginning, soCurrent, soEnd);

  TStream = class(TObject)
  private
    function GetPosition: Int64;
    procedure SetPosition(const Pos: Int64);
    function GetSize: Int64;
    procedure SetSize64(const NewSize: Int64);
  protected
    procedure SetSize(NewSize: Longint); overload; virtual;
    procedure SetSize(const NewSize: Int64); overload; virtual;
  public
    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
    function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
    function Seek(Offset: Longint; Origin: Word): Longint; overload; virtual;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; virtual;
    procedure ReadBuffer(var Buffer; Count: Longint);
    procedure WriteBuffer(const Buffer; Count: Longint);
    function CopyFrom(Source: TStream; Count: Int64): Int64;
    property Position: Int64 read GetPosition write SetPosition;
    property Size: Int64 read GetSize write SetSize64;
  end;

  TCustomMemoryStream = class(TStream)
  private
    FMemory: Pointer;
    FData: Pointer;
    FSize, FPosition: Longint;
  protected
    procedure SetPointer(Ptr: Pointer; Size: Longint);
  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    property Memory: Pointer read FMemory;
    property Data: Pointer read FData write FData;
  end;

  TMemoryStream = class(TCustomMemoryStream)
  private
    FCapacity: Longint;
    procedure SetCapacity(NewCapacity: Longint);
  protected
    function Realloc(var NewCapacity: Longint): Pointer; virtual;
    property Capacity: Longint read FCapacity write SetCapacity;
  public
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SetSize(NewSize: Longint); override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

  THandleStream = class(TStream)
  protected
    FHandle: Integer;
    procedure SetSize(NewSize: Longint); override;
    procedure SetSize(const NewSize: Int64); override;
  public
    constructor Create(AHandle: Integer);
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    property Handle: Integer read FHandle;
  end;

  TFileStream = class(THandleStream)
  public
    constructor Create(const FileName: string; Mode: Word); overload;
    constructor Create(const FileName: string; Mode: Word; Rights: Cardinal); overload;
    destructor Destroy; override;
  end;
  TAlloc = function(Opaque: Pointer; Items, Size: Integer): Pointer;
  TFree = procedure(Opaque, Block: Pointer);

  TCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);

  TCompressionStreamRecord = packed record
    NextIn: PChar;
    AvailableIn: dword;
    TotalIn: dword;
    NextOut: PChar;
    AvailableOut: dword;
    TotalOut: dword;
    Msg: PChar;
    State: Pointer;
    AllocProc: TAlloc;
    FreeProc: TFree;
    Opaque: Pointer;
    DataType: dword;
    Adler: dword;
    Reserved: dword;
  end;

  TCustomCompressionStream = class(TStream)
  private
    FStream: TStream;
    FStreamPos: Integer;
    FOnProgress: TNotifyEvent;
    FStreamRecord: TCompressionStreamRecord;
    FBuffer: array [Word] of Char;
  protected
    constructor Create(stream: TStream);
    procedure DoProgress; dynamic;
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
  end;

  TCompressionStream = class(TCustomCompressionStream)
  private
    function GetCompressionRate: Single;
  public
    constructor Create(dest: TStream; CompressionLevel: TCompressionLevel = zcDefault);
    destructor Destroy; override;
    function Read(var Buffer; Count: longint): longint; override;
    function Write(const Buffer; Count: longint): longint; override;
    function Seek(Offset: longint; Origin: Word): longint; override;
    property CompressionRate: Single read GetCompressionRate;
    property OnProgress;
  end;

  TDecompressionStream = class(TCustomCompressionStream)
  public
    constructor Create(source: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: longint): longint; override;
    function Write(const Buffer; Count: longint): longint; override;
    function Seek(Offset: longint; Origin: Word): longint; override;
    property OnProgress;
  end;

function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt;
function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt;
function compressBound(sourceLen: LongInt): LongInt;

implementation

{$L objects\adler32.obj}
{$L objects\compress.obj}
{$L objects\crc32.obj}
{$L objects\deflate.obj}
{$L objects\infback.obj}
{$L objects\inffast.obj}
{$L objects\inflate.obj}
{$L objects\inftrees.obj}
{$L objects\trees.obj}
{$L objects\uncompr.obj}

const
  Levels: array[TCompressionLevel] of Shortint = (0, 1, (-1), 9);
  _z_errmsg: array[0..9] of PChar = ('', '', '', '', '', '', '', '', '', '');
  fmCreate = $FFFF;
  fmOpenRead = $0000;
  fmOpenWrite = $0001;
  fmOpenReadWrite = $0002;
  fmShareCompat = $0000;
  fmShareExclusive = $0010;
  fmShareDenyWrite = $0020;
  fmShareDenyRead = $0030;
  fmShareDenyNone = $0040;


function deflateInit_(var strm: TCompressionStreamRecord; level: Integer; version: PChar; recsize: Integer): Integer; external;
function DeflateInit2_(var strm: TCompressionStreamRecord; level: integer; method: integer; windowBits: integer; memLevel: integer; strategy: integer; version: PChar; recsize: integer): integer; external;
function deflate(var strm: TCompressionStreamRecord; flush: Integer): Integer; external;
function deflateEnd(var strm: TCompressionStreamRecord): Integer; external;
function inflateInit_(var strm: TCompressionStreamRecord; version: PChar; recsize: Integer): Integer; external;
function inflateInit2_(var strm: TCompressionStreamRecord; windowBits: integer; version: PChar; recsize: integer): integer; external;
function inflate(var strm: TCompressionStreamRecord; flush: Integer): Integer; external;
function inflateEnd(var strm: TCompressionStreamRecord): Integer; external;
function inflateReset(var strm: TCompressionStreamRecord): Integer; external;
function adler32; external;
function crc32; external;
function compressBound; external;

function FileOpen(const FileName: string; Mode: LongWord): Integer;
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := -1;
  if ((Mode and 3) <= $0002) and
    (((Mode and $F0) shr 4) <= $0040) then
    Result := Integer(CreateFile(PChar(FileName), AccessMode[Mode and 3],
      ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL, 0));
end;

procedure FileClose(Handle: Integer);
begin
  CloseHandle(THandle(Handle));
end;

function FileCreate(const FileName: string): Integer;
begin
  Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
end;

function FileRead(Handle: Integer; var Buffer; Count: LongWord): Integer;
begin
  if not ReadFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
    Result := -1;
end;

function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
begin
  if not WriteFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
    Result := -1;
end;

function FileSeek(Handle, Offset, Origin: Integer): Integer;
begin
  Result := SetFilePointer(THandle(Handle), Offset, nil, Origin);
end;

function zcalloc(opaque: Pointer; items, size: Integer): Pointer;
begin
  GetMem(Result, items * size);
end;

procedure zcfree(opaque, block: Pointer);
begin
  FreeMem(block);
end;

procedure _memset(p: Pointer; b: Byte; Count: Integer); cdecl;
begin
  FillChar(p^, Count, b);
end;

procedure _memcpy(dest, source: Pointer; Count: Integer); cdecl;
begin
  move(source^, dest^, Count);
end;

function DeflateInit(var stream: TCompressionStreamRecord; level: Integer): Integer;
begin
  Result := DeflateInit_(stream, level, ZLIB_VERSION, SizeOf(TCompressionStreamRecord));
end;

function DeflateInit2(var stream: TCompressionStreamRecord; level, method, windowBits,
  memLevel, strategy: Integer): Integer;
begin
  Result := DeflateInit2_(stream, level, method, windowBits, memLevel, strategy, ZLIB_VERSION, SizeOf(TCompressionStreamRecord));
end;

function InflateInit(var stream: TCompressionStreamRecord): Integer;
begin
  Result := InflateInit_(stream, ZLIB_VERSION, SizeOf(TCompressionStreamRecord));
end;

function InflateInit2(var stream: TCompressionStreamRecord; windowBits: Integer): Integer;
begin
  Result := InflateInit2_(stream, windowBits, ZLIB_VERSION, SizeOf(TCompressionStreamRecord));
end;

function TStream.GetPosition: Int64;
begin
  Result := Seek(0, soCurrent);
end;

procedure TStream.SetPosition(const Pos: Int64);
begin
  Seek(Pos, soBeginning);
end;

function TStream.GetSize: Int64;
var
  Pos: Int64;
begin
  Pos := Seek(0, soCurrent);
  Result := Seek(0, soEnd);
  Seek(Pos, soBeginning);
end;

procedure TStream.SetSize(NewSize: Longint);
begin
  SetSize(NewSize);
end;

procedure TStream.SetSize64(const NewSize: Int64);
begin
  SetSize(NewSize);
end;

procedure TStream.SetSize(const NewSize: Int64);
begin
  if (NewSize < Low(Longint)) or (NewSize > High(Longint)) then
    Exit;
  SetSize(Longint(NewSize));
end;

function TStream.Seek(Offset: Longint; Origin: Word): Longint;
type
  TSeek64 = function (const Offset: Int64; Origin: TSeekOrigin): Int64 of object;
var
  Impl: TSeek64;
  Base: TSeek64;
  ClassTStream: TClass;
begin
  Impl := Seek;
  ClassTStream := Self.ClassType;
  while (ClassTStream <> nil) and (ClassTStream <> TStream) do
    ClassTStream := ClassTStream.ClassParent;
  Base := TStream(@ClassTStream).Seek;
  Result := Seek(Int64(Offset), TSeekOrigin(Origin));
end;

function TStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  Result := 0;
  if (Offset < Low(Longint)) or (Offset > High(Longint)) then
    Exit;
  Result := Seek(Longint(Offset), Ord(Origin));
end;

procedure TStream.ReadBuffer(var Buffer; Count: Longint);
begin
  if (Count <> 0) and (Read(Buffer, Count) <> Count) then
    Exit;
end;

procedure TStream.WriteBuffer(const Buffer; Count: Longint);
begin
  if (Count <> 0) and (Write(Buffer, Count) <> Count) then
    Exit;
end;

function TStream.CopyFrom(Source: TStream; Count: Int64): Int64;
const
  MaxBufSize = $F000;
var
  BufSize, N: Integer;
  Buffer: PChar;
begin
  if Count = 0 then
  begin
    Source.Position := 0;
    Count := Source.Size;
  end;
  Result := Count;
  if Count > MaxBufSize then BufSize := MaxBufSize else BufSize := Count;
  GetMem(Buffer, BufSize);
  try
    while Count <> 0 do
    begin
      if Count > BufSize then N := BufSize else N := Count;
      Source.ReadBuffer(Buffer^, N);
      WriteBuffer(Buffer^, N);
      Dec(Count, N);
    end;
  finally
    FreeMem(Buffer, BufSize);
  end;
end;

constructor THandleStream.Create(AHandle: Integer);
begin
  inherited Create;
  FHandle := AHandle;
end;

function THandleStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result := FileRead(FHandle, Buffer, Count);
  if Result = -1 then Result := 0;
end;

function THandleStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := FileWrite(FHandle, Buffer, Count);
  if Result = -1 then Result := 0;
end;

function THandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  Result := FileSeek(FHandle, Offset, Ord(Origin));
end;

procedure THandleStream.SetSize(NewSize: Longint);
begin
  SetSize(Int64(NewSize));
end;

procedure THandleStream.SetSize(const NewSize: Int64);
begin
  Seek(NewSize, soBeginning);
end;

constructor TFileStream.Create(const FileName: string; Mode: Word);
begin
  Create(Filename, Mode, 0);
end;

constructor TFileStream.Create(const FileName: string; Mode: Word; Rights: Cardinal);
begin
  if Mode = $FFFF then
  begin
    inherited Create(FileCreate(FileName));
  end
  else
  begin
    inherited Create(FileOpen(FileName, Mode));
  end;
end;

destructor TFileStream.Destroy;
begin
  if FHandle >= 0 then FileClose(FHandle);
  inherited Destroy;
end;

constructor TCustomCompressionStream.Create(Stream: TStream);
begin
  inherited Create;
  FStream := Stream;
  FStreamPos := Stream.Position;
end;

procedure TCustomCompressionStream.DoProgress;
begin
  if Assigned(FOnProgress) then FOnProgress(Self);
end;

constructor TCompressionStream.Create(Dest: TStream; CompressionLevel: TCompressionLevel);
begin
  inherited Create(dest);
  FStreamRecord.NextOut := FBuffer;
  FStreamRecord.AvailableOut := SizeOf(FBuffer);
  DeflateInit(FStreamRecord, Levels[CompressionLevel]);
end;

destructor TCompressionStream.Destroy;
begin
  FStreamRecord.NextIn := nil;
  FStreamRecord.AvailableIn := 0;
  try
    if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
    while deflate(FStreamRecord, 4) <> 1 do
    begin
      FStream.WriteBuffer(FBuffer, SizeOf(FBuffer) - FStreamRecord.AvailableOut);
      FStreamRecord.NextOut := FBuffer;
      FStreamRecord.AvailableOut := SizeOf(FBuffer);
    end;
    if FStreamRecord.AvailableOut < SizeOf(FBuffer) then
    begin
      FStream.WriteBuffer(FBuffer, SizeOf(FBuffer) - FStreamRecord.AvailableOut);
    end;
  finally
    deflateEnd(FStreamRecord);
  end;
  inherited Destroy;
end;

function TCompressionStream.Read(var Buffer; Count: longint): longint;
begin
end;

function TCompressionStream.Write(const Buffer; Count: longint): longint;
begin
  FStreamRecord.NextIn := @Buffer;
  FStreamRecord.AvailableIn := Count;
  if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
  while FStreamRecord.AvailableIn > 0 do
  begin
    deflate(FStreamRecord, 0);
    if FStreamRecord.AvailableOut = 0 then
    begin
      FStream.WriteBuffer(FBuffer, SizeOf(FBuffer));
      FStreamRecord.NextOut := FBuffer;
      FStreamRecord.AvailableOut := SizeOf(FBuffer);
      FStreamPos := FStream.Position;
      DoProgress;
    end;
  end;
  Result := Count;
end;

function TCompressionStream.Seek(offset: Longint; origin: Word): Longint;
begin
  if (offset = 0) and (origin = soFromCurrent) then
  begin
    Result := FStreamRecord.TotalIn;
  end;
end;

function TCompressionStream.GetCompressionRate: Single;
begin
  if FStreamRecord.TotalIn = 0 then Result := 0
  else Result := (1.0 - (FStreamRecord.TotalOut / FStreamRecord.TotalIn)) * 100.0;
end;

constructor TDecompressionStream.Create(source: TStream);
begin
  inherited Create(source);
  FStreamRecord.NextIn := FBuffer;
  FStreamRecord.AvailableIn := 0;
  InflateInit(FStreamRecord);
end;

destructor TDecompressionStream.Destroy;
begin
  inflateEnd(FStreamRecord);
  inherited Destroy;
end;

function TDecompressionStream.Read(var Buffer; Count: longint): longint;
var
  ReturnValue: longint;
begin
  FStreamRecord.NextOut := @Buffer;
  FStreamRecord.AvailableOut := Count;
  if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
  ReturnValue := 0;
  while ((FStreamRecord.AvailableOut > 0) and (ReturnValue <> 1)) do
  begin
    if FStreamRecord.AvailableIn = 0 then
    begin
      FStreamRecord.AvailableIn := FStream.Read(FBuffer, SizeOf(FBuffer));
      if FStreamRecord.AvailableIn = 0 then
      begin
        Result := Count - FStreamRecord.AvailableOut;
        Exit;
      end;
      FStreamRecord.NextIn := FBuffer;
      FStreamPos := FStream.Position;
      DoProgress;
    end;
    ReturnValue := inflate(FStreamRecord, 0);
  end;
  if ((ReturnValue = 1) and (FStreamRecord.AvailableIn > 0)) then
  begin
    FStream.Position := FStream.Position - FStreamRecord.AvailableIn;
    FStreamPos := FStream.Position;
    FStreamRecord.AvailableIn := 0;
  end;
  Result := Count - FStreamRecord.AvailableOut;
end;

function TDecompressionStream.Write(const Buffer; Count: longint): longint;
begin
end;

function TDecompressionStream.Seek(Offset: longint; Origin: Word): longint;
var
  Buffer: array [0..8191] of Char;
  Count: Integer;
begin
  if ((Offset = 0) and (Origin = soFromBeginning)) then
  begin
    inflateReset(FStreamRecord);
    FStreamRecord.NextIn := FBuffer;
    FStreamRecord.AvailableIn := 0;
    FStream.Position := 0;
    FStreamPos := 0;
  end
  else if ((Offset >= 0) and (Origin = soFromCurrent)) or (((Offset - FStreamRecord.TotalOut) > 0) and (Origin = soFromBeginning)) then
  begin
    if Origin = soFromBeginning then Dec(Offset, FStreamRecord.TotalOut);
    if Offset > 0 then
    begin
      for Count := 1 to Offset div SizeOf(Buffer) do ReadBuffer(Buffer, SizeOf(Buffer));
      ReadBuffer(Buffer, Offset mod SizeOf(Buffer));
    end;
  end
  else if (Offset = 0) and (Origin = soFromEnd) then
  begin
    while Read(Buffer, SizeOf(Buffer)) > 0 do;
  end;
  Result := FStreamRecord.TotalOut;
end;

procedure TCustomMemoryStream.SetPointer(Ptr: Pointer; Size: Longint);
begin
  FMemory := Ptr;
  FSize := Size;
end;

function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
begin
  if (FPosition >= 0) and (Count >= 0) then
  begin
    Result := FSize - FPosition;
    if Result > 0 then
    begin
      if Result > Count then Result := Count;
      Move(Pointer(Longint(FMemory) + FPosition)^, Buffer, Result);
      Inc(FPosition, Result);
      Exit;
    end;
  end;
  Result := 0;
end;

function TCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: FPosition := Offset;
    soFromCurrent: Inc(FPosition, Offset);
    soFromEnd: FPosition := FSize + Offset;
  end;
  Result := FPosition;
end;

procedure TCustomMemoryStream.SaveToStream(Stream: TStream);
begin
  if FSize <> 0 then Stream.WriteBuffer(FMemory^, FSize);
end;

procedure TCustomMemoryStream.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

const
  MemoryDelta = $2000;

destructor TMemoryStream.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TMemoryStream.Clear;
begin
  SetCapacity(0);
  FSize := 0;
  FPosition := 0;
end;

procedure TMemoryStream.LoadFromStream(Stream: TStream);
var
  Count: Longint;
begin
  Stream.Position := 0;
  Count := Stream.Size;
  SetSize(Count);
  if Count <> 0 then Stream.ReadBuffer(FMemory^, Count);
end;

procedure TMemoryStream.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TMemoryStream.SetCapacity(NewCapacity: Longint);
begin
  SetPointer(Realloc(NewCapacity), FSize);
  FCapacity := NewCapacity;
end;

procedure TMemoryStream.SetSize(NewSize: Longint);
var
  OldPosition: Longint;
begin
  OldPosition := FPosition;
  SetCapacity(NewSize);
  FSize := NewSize;
  if OldPosition > NewSize then Seek(0, soFromEnd);
end;

function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
begin
  if (NewCapacity > 0) and (NewCapacity <> FSize) then
    NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);
  Result := Memory;
  if NewCapacity <> FCapacity then
  begin
    if NewCapacity = 0 then
    begin
      GlobalFreePtr(Memory);
      Result := nil;
    end else
    begin
      if Capacity = 0 then
        Result := GlobalAllocPtr(HeapAllocFlags, NewCapacity)
      else
        Result := GlobalReallocPtr(Memory, NewCapacity, HeapAllocFlags);
    end;
  end;
end;

function TMemoryStream.Write(const Buffer; Count: Longint): Longint;
var
  Pos: Longint;
begin
  if (FPosition >= 0) and (Count >= 0) then
  begin
    Pos := FPosition + Count;
    if Pos > 0 then
    begin
      if Pos > FSize then
      begin
        if Pos > FCapacity then
          SetCapacity(Pos);
        FSize := Pos;
      end;
      System.Move(Buffer, Pointer(Longint(FMemory) + FPosition)^, Count);
      FPosition := Pos;
      Result := Count;
      Exit;
    end;
  end;
  Result := 0;
end;

end.

[Bernhard Geyer]

Zitat von Zodi:

Dazu erzeuge ich einen Screenshot und wandle das BITMAP in ein JPEG um.
Nun will ich die JPEG in ein MemoryStream schreiben und mit SetString in einen String umwandeln damit ich ihn später über die Sockets versenden kann.

Auf Deutsch: Du willst dir von hinten durch die Brust ins Knie schießen.

Folgendes solltest du anders machen:
- Für Screenshots ist PNG das bessere Format
- das Weiterumwandeln in einen String ist unnötig und verursacht eher Probleme als es löst. Den Memory-Stream kannst du direkt verschicken

[KodeZwerg]

Zu dem gesagten würde ich gerne noch hinzufügen, den Bild-Stream kann man ruhig als Bitmap versenden, da Du eh mit Streams arbeitest würde ich allerdings den Bild-Stream vorher komprimieren und bei Gegenstelle dann wieder entfalten.
So hast Du ein Verlustfreies Bild mit schneller Übertragung, was ja bei etwas wie RemoteControl wichtig sein könnte.
Empfehlen würde ich mich vorher auf ein kleineres Ausgabe Format als das Original mich festzulegen und zu Stretchen, das spart sehr viel ein/beschleunigt alles immens. Man kann ja mehrere Stufen Anbieten, bis rauf auf 1:1 Direkt-Kopie was dann am meisten Energie/Zeit kostet.
LZMA ist OpenSource und kann beim Stream komprimieren Wunder wirken!

Ps: Deine Unit kann man nicht testen da *.obj Dateien fehlen.

[Zodi]

Also wenn ich es Peer PGN stat JPG versuche habe ich das selbe Problem.

Wenn ich die Routine allerdings so schreibe dann Funktionierts und ich kann die BMP in einen Stream schreiben und dann verschicken allerdings ist die BMP dann 14MB gross und nicht 179KB wie ein PNG.

Delphi-Quellcode:

function SaveBitmapToFile(HBM: HBitmap;BitCount: word): string;
const
  BMType = $4D42;
type
  TBitmap = record
    bmType: Integer;
    bmWidth: Integer;
    bmHeight: Integer;
    bmWidthBytes: Integer;
    bmPlanes: Byte;
    bmBitsPixel: Byte;
    bmBits: Pointer;
  end;
var
  BM: TBitmap;
  BFH: TBitmapFileHeader;
  BIP: PBitmapInfo;
  DC: HDC;
  HMem: THandle;
  Buf: Pointer;
  ColorSize, DataSize: Longint;
  stream: tmemorystream;

  function AlignDouble(Size: Longint): Longint;
  begin
    Result := (Size + 31) div 32 * 4;
  end;

begin
  if GetObject(HBM, SizeOf(TBitmap), @BM) = 0 then Exit;



  //BitCount := 4;
  if (BitCount <> 24) then ColorSize := SizeOf(TRGBQuad) * (1 shl BitCount) else ColorSize := 0;

  DataSize := AlignDouble(bm.bmWidth * BitCount) * bm.bmHeight;
  GetMem(BIP, SizeOf(TBitmapInfoHeader) + ColorSize);

  if BIP <> nil then begin
    with BIP^.bmiHeader do begin
      biSize := SizeOf(TBitmapInfoHeader);
      biWidth := bm.bmWidth;
      biHeight := bm.bmHeight;
      biPlanes := 1;
      biBitCount := BitCount;
      biCompression := 0;
      biSizeImage := DataSize;
      biXPelsPerMeter := 0;
      biYPelsPerMeter := 0;
      biClrUsed := 0;
      biClrImportant := 0;
    end;

    with BFH do begin
      bfOffBits := SizeOf(BFH) + SizeOf(TBitmapInfo) + ColorSize;
      bfReserved1 := 0;
      bfReserved2 := 0;
      bfSize := longint(bfOffBits) + DataSize;
      bfType := BMType;
    end;

    HMem := GlobalAlloc(gmem_Fixed, DataSize);
    if HMem <> 0 then begin
      Buf := GlobalLock(HMem);
      DC := GetDC(0);
      if GetDIBits(DC, hbm, 0, bm.bmHeight,Buf, BIP^, dib_RGB_Colors) <> 0 then begin

        Stream := TMemoryStream.Create;
        Stream.WriteBuffer(BFH, SizeOf(BFH));
        Stream.WriteBuffer(PChar(BIP)^, SizeOf(TBitmapInfo) + ColorSize);
        Stream.WriteBuffer(Buf^, DataSize);
        //Stream.SaveToFile('TestBild.bmp');;
        SetString(Result, PChar(Stream.Memory), Stream.Size);
        stream.Free;

      end;
      ReleaseDC(0, DC);
      GlobalUnlock(HMem);
      GlobalFree(HMem);
    end;

  end;
  FreeMem(BIP, SizeOf(TBitmapInfoHeader) + ColorSize);
  DeleteObject(HBM);
end;

Ich habe mein Delphi Code hier mal gepackt wenn es jemand testen möchte.

Screenshoot.rar

[KodeZwerg]

Ps: Ich weiß nicht ob man es noch findet, es gab mal eine OpenSource Rar-Bibliothek, die Delta-Komprimierung von Rar ist für Bilder eine sehr gute Wahl. Es gab da mal so eine non-Visual komponente die einem intern das ganze als Stream verpackte, kann ich falls LZMA Dir zu langsam/nicht perfekt für Bilder sein sollte auch sehr Empfehlen. Schau mal bei Tory.net, von da hatte ich es mal her.

[EWeiss]

Deine Vorgehensweise ist total daneben..
Ausgangspunkt
TFileStream
CreateCompatibleDC
CreateDIBSection

erstelle ein Graphics Objekt
Stream auf 0 setzen Speicher allokieren "GlobalAlloc"

CreateStreamOnHGlobal
CreateBitmapFromStream (ISTREAM)

jetzt hast du ein GDI+ Image Format das du in allen erdenklichen Formaten abspeichern kannst.

Schaue dir mein AnimatePng an das macht genau das.

gruss

[Redeemer]

Kinners, ihr labert um den heißen Brei herum und niemand beantwortet seine Frage.

TJPEGImage.SaveToStream nimmt als Parameter einen System.Classes.TStream.
Du versuchst einen CompressionStreamUnit.TMemoryStream da reinzupacken, der von CompressionStreamUnit.TStream erbt. Das klappt natürlich nicht, da diese Klassen nichts, aber auch absolut gar nichts miteinander zu tun haben, außer dass es irgendwer lustig fand, denselben Namen für völlig verschiedene Klassen zu nehmen.

Wer auch immer diese Unit geschrieben hat, hat 1. nicht verstanden, was Unterstützende Klassen sind und 2. wie man Klassen vernünftig benennt. Kleiner Tipp: Klassen mit den Namen zu versehen, mit denen völlig andere Klassen schon existieren, ist nicht klug. Eventuell kann man CompressionStreamUnit.TStream von System.Classes.TStream erben, aber das fliegt einem wahrscheinlich um die Ohren. Noch ein Tipp: Es gibt nur einen einzigen Algorithmus, der JPEG überhaupt komprimieren kann, und der heißt Lepton.

[EWeiss]

Zitat:

Kinners, ihr labert um den heißen Brei herum und niemand beantwortet seine Frage.

Ja?
Ok der Meister hat gesprochen.
Was will er mit einer 14Mb großen BMP Datei darauf habe ich geantwortet auf nichts anderes.
Das einzige verlustfreie und für diesen zweck benötigte Image Format ist nun mal PNG! Aber das scheint in deinen Schädel nicht reinzugehen.

Da muss ich @Bernhard Geyer recht geben.

Wie man ein Image in einen stream schreibt dafür gibt es fertige GDI+ API's da benötigt man keinen TStream
Und dein angepriesener Algo um Jpeg zu komprimieren fällt in dem Fall ebenfalls weg.
Aber macht wie ihr wollt.

gruss

[Redeemer]

Zitat von EWeiss:

Zitat:

Kinners, ihr labert um den heißen Brei herum und niemand beantwortet seine Frage.

Ja?
Ok der Meister hat gesprochen.
Was will er mit einer 14Mb großen BMP Datei darauf habe ich geantwortet auf nichts anderes.
Das einzige verlustfreie und für diesen zweck benötigte Image Format ist nun mal PNG! Aber das scheint in deinen Schädel nicht reinzugehen.

Hab ich irgendwas Wertendes über das Dateiformat geschrieben? Nein. Der größte Teil meiner Antwort bezog sich allein auf das Problem, dass es überhaupt nicht geht. Ich weiß ja nicht, was so schlimm sein soll, ein Problem zu lösen, aber gut.

Sollte ich was über das Dateiformat schreiben? Vielleicht.
Dann schauen wir doch mal, was für wichtige Funktionen man für eine Bildschirmübertragung zwangsläufig braucht (Verlustfreiheit braucht man hingegen nicht zwangsläufig):
- Die Möglichkeit, die Bildqualität anzupassen
- Einen schnellen Algorithmus
Können PNG, Rar und LZMA irgendwas davon? Nein, können sie alle drei nicht.

[EWeiss]

Zitat:

Können PNG, Rar und LZMA irgendwas davon? Nein, können sie alle drei nicht.

Laber, laber (deine Worte).
Sollte dir klar sein das die GDIplus Bibliothek das übernimmt bei der Übergabe der jeweiligen Parameter die dafür nötig sind.
Aber sehe schon du bist der Grafik Profi.

Zitat:

Ich weiß ja nicht, was so schlimm sein soll, ein Problem zu lösen, aber gut.

Das selbe frage ich mich auch denn du hast uns als "Kinners" (Ich behaupte ein gestandener Mann zu sein, Kind bin ich schon lang nicht mehr) betitelt. Bleibt doch einfach mal sachlich und beleidigt nicht erst irgendwelche Leute vorher.
Dann lassen sich auch bestimmt optimale Lösungen finden.
Ich habe versucht ihm die Herangehensweise zu erläutern was dir wohl nicht genehm war.
Bin raus macht keinen sinn sich hier weiter auszulassen.

*.blup...

gruss