Lazarus TImage to Base64

Question

I'm trying to encode a TImage picture to base64 for rest transmission, I've tried a couple ways and I can't seem to get it to encode as string. This is what I have now:

      imgstream := TStringStream.Create('');
      OutputStream := TStringStream.Create('');
      Encoder := TBase64EncodingStream.Create(OutputStream);
      try
        image1.Picture.SaveToStream(imgstream);
        Encoder.CopyFrom(imgstream, imgstream.Size);

        showmessage(OutputStream.DataString);
      finally
        imgstream.Free;
        Encoder.Free;
        OutputStream.Free;
      end;

Right now it's giving me an exception. When I showmessage(imgstream.DataString) I get a weird BM6~ string back.

After adding imgstream.Position := 0; before the CopyFrom now I get data back blank, no exception:

it's giving me an exception is only meaningful if you include information about the specific exception you're seeing. We can't see your screen from here. As the first step, my psychic debugging skills tell me that you should have a imgstream.Position := 0; before the CopyFrom. — Ken White
Thank you for your insight! Adding that now it no longer has an exception, but now it comes back blank. Please check above for screenshot. — jfreak53
I can't see the screenshot (corporate proxy doesn't allow image sharing sites, which is one of the reasons to avoid using images). Again though, I'm guessing you need to rewind the OutputStream by setting it's position before you access it. — Ken White
Exception is EReadError, Stream Read Error, I've reset position before showmessage but still empty. OutputStream.Position := 0; — jfreak53
showmessage comes up blank, trying to add the output to a TMemo component freezes the program with no errors: memo1.Lines.LoadFromStream(OutputStream); — jfreak53

vhanla vhanla · Accepted Answer · 2019-08-15T05:40:26

TBase64EncodingStream is not suitable for big binary conversion, I mean, it will be very slow, also Image1.Picture.SaveToStream, by default, will save the picture as Bitmap format, so it will be very big. Try using JPG format.

procedure TForm1.Button1Click(Sender: TObject);
var
  imgstream, Outputstream: TStream;
  Encoder: TBase64EncodingStream;
  jpg: TJPEGImage;
  I: Int64;
begin
  I := GetTickCount64;
  imgstream := TMemoryStream.Create();
  Outputstream := TStringStream.Create('');
  jpg := TJPEGImage.Create;
  Encoder := TBase64EncodingStream.Create(Outputstream);
  try
    jpg.Assign(Image1.Picture.Bitmap);
    jpg.CompressionQuality:=75;
    jpg.SaveToStream(imgstream);
    imgstream.Position:= 0;
    Encoder.CopyFrom(TStringStream(imgstream), imgstream.Size);
    Encoder.Flush;
    Memo1.Text:='data:image/jpg;base64,'+ TStringStream(Outputstream).DataString;
    ShowMessage('Created in '+IntToStr(GetTickCount64-I)+'ms');
  finally
    imgstream.Free;
    Encoder.Free;
    Outputstream.Free;
    jpg.Free;
  end;
end;

To improve encoding it, maybe you could try using threads separating the binary in chunks multiple of 3 to process each one and join the processed encoded chunks at the end.

e.g. Using 4 threads, hard encoded.

{ TEncodeThread }

  TEncodeThread = class (TThread)
  private
    fForm: TForm1;
    fStream: TStream;
    fStatusText: String;
    procedure ShowStatus;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended:Boolean; const AForm: TForm1);
    procedure SetStream(const AStream: TStream);
  end;   

...
procedure TForm1.Button3Click(Sender: TObject);
var
  jpg: TJPEGImage;
  mul3: Int64;
  mod3: Int64;
  dif3: Int64;
  imgstream: TStringStream;
begin
  Steps:=0;
  Start:=GetTickCount64;
  imgstream := TStringStream.Create('');
  jpg := TJPEGImage.Create;
  try
    jpg.Assign(Image1.Picture.Bitmap);
    jpg.CompressionQuality:=75;
    jpg.SaveToStream(imgstream);

    mul3 := imgstream.Size div 4;
    mod3 := mul3 mod 3;
    if mod3 <> 0 then
       mul3 := mul3 + 3 - mod3;
    dif3 := imgstream.Size - mul3*4;
    memo1.text := 'Total Size: '+ IntToStr(imgstream.size)
    + #13'Part1: '+IntToStr(mul3)
    + #13'Part2: '+IntToStr(mul3)
    + #13'Part3: '+IntToStr(mul3)
    + #13'Part4: '+IntToStr(mul3+dif3)
    + #13'Rest: '+IntToStr(dif3);

    Part1.Position:=0;
    Part2.Position:=0;
    Part3.Position:=0;
    Part4.Position:=0;
    imgstream.Position:=0;
    Part1.CopyFrom(imgstream,mul3);
    Part2.CopyFrom(imgstream,mul3);
    Part3.CopyFrom(imgstream,mul3);
    Part4.CopyFrom(imgstream,mul3+dif3);

    Thr1 := TEncodeThread.Create(True, Self);
    Thr2 := TEncodeThread.Create(True, Self);
    Thr3 := TEncodeThread.Create(True, Self);
    Thr4 := TEncodeThread.Create(True, Self);

    Thr1.SetStream(Part1);
    Thr1.Start;
    Thr2.SetStream(Part2);
    Thr2.Start;
    Thr3.SetStream(Part3);
    Thr3.Start;
    Thr4.SetStream(Part4);
    Thr4.Start;

  finally
    imgstream.Free;
    jpg.Free;
  end;
end;

procedure TEncodeThread.Execute;
var
  Encoder: TBase64EncodingStream;
  buf: TStream;
begin

    buf := TStringStream.Create('');
    Encoder := TBase64EncodingStream.Create(buf);
    try
      fStream.Position:= 0;
      Encoder.CopyFrom(TStringStream(fStream), fStream.Size);
      Encoder.Flush;
      buf.Position:= 0;
      fForm.Out1.CopyFrom(TStringStream(buf), buf.Size);
      Inc(fForm.Steps);
      if fForm.Steps = 3 then
      begin
        fForm.Out1.Position:=0;
        fForm.Out2.Position:=0;
        fForm.Out3.Position:=0;
        fForm.Out4.Position:=0;
        fForm.Memo1.Text:='data:image/jpg;base64,'
        + TStringStream(fForm.Out1).DataString
        + TStringStream(fForm.Out2).DataString
        + TStringStream(fForm.Out3).DataString
        + TStringStream(fForm.Out4).DataString;
      end;


    finally
      Encoder.Free;
      buf.Free;
    end;


end;

This demo, is not really optimized, neither correctly synchronized (output maybe wrongly formed), though, as a starting point it could be of help. zipped project

Lazarus TImage to Base64

1 Answers