Base64

Various code example to handle Base64 encoded strings.

Convert Base64 string to picture

This unit is from forum member KodeZwerg. You must use BGRABitmap component.

unit ubase64image;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Graphics, ExtCtrls,
  Base64,
  BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRASVG, BGRAOpenRaster, BGRAPhoxo, BGRAPaintNet;

function FileToStream(const AFilename: string): TStream;
function StreamToBase64(const AStream: TStream): AnsiString;
function Base64ToStream(const ABase64String: AnsiString): TStream;
procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False);

implementation

function FileToStream(const AFilename: string): TStream;
var
  FileStream: TFileStream;
begin
  FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    Result := TMemoryStream.Create;
    try
      Result.CopyFrom(FileStream, FileStream.Size);
    finally
      Result.Position := 0;
    end;
  finally
    FileStream.Free;
  end;
end;

function StreamToBase64(const AStream: TStream): string;
var
  EncodedStream: TStringStream;
  Encoder: TBase64EncodingStream;
begin
  EncodedStream := TStringStream.Create('');
  Encoder := TBase64EncodingStream.Create(EncodedStream);
  try
    AStream.Position := 0;
    Encoder.CopyFrom(AStream, AStream.Size);
    Encoder.Flush;
    Result := EncodedStream.DataString;
    AStream.Position := 0;
  finally
    Encoder.Free;
    EncodedStream.Free;
  end;
end;

function Base64ToStream(const ABase64String: AnsiString): TStream;
var
  DecodedStream: TBase64DecodingStream;
  Base64Stream: TStringStream;
begin
  Base64Stream := TStringStream.Create(ABase64String);
  try
    DecodedStream := TBase64DecodingStream.Create(base64stream);
    try
      Result := TMemoryStream.Create;
      try
        Result.CopyFrom(DecodedStream, DecodedStream.Size);
      finally
        Result.Position := 0;
      end;
    finally
      DecodedStream.Free;
    end;
  finally
    Base64Stream.Free;
  end;
end;

function BGRABitmapToPNGStream(const ABGRABitmap: TBGRABitmap): TStream;
begin
  Result := TMemoryStream.Create;
  try
    ABGRABitmap.SaveToStreamAsPng(Result);
  finally
    Result.Position := 0;
  end;
end;

function BGRABitmapToBitmap(const ABGRABitmap: TBGRABitmap): TBitmap;
begin
  Result := TBitmap.Create;
  try
    Result.PixelFormat := ABGRABitmap.Bitmap.PixelFormat;
    Result.Transparent := ABGRABitmap.HasTransparentPixels or ABGRABitmap.HasSemiTransparentPixels;
    Result.SetSize(ABGRABitmap.Width, ABGRABitmap.Height);
    Result.Canvas.Lock;
    try
      Result.Canvas.Draw(0, 0, ABGRABitmap.Bitmap);
    finally
      Result.Canvas.Unlock;
    end;
  finally
  end;
end;

procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage;
  const AFastMode: Boolean = False);
var
  BGRABitmap: TBGRABitmap;
  Stream: TStream;
  bmp: TBitmap;
begin
  AImage.Picture.Clear;
  Stream := Base64ToStream(ABase64String);
  if (DetectFileFormat(Stream) <> ifUnknown) then
    begin
      BGRABitmap := TBGRABitmap.Create;
      try
        try
          BGRABitmap.LoadFromStream(Stream);
        finally
          Stream.Free;
        end;
        if AFastMode then
          begin
            bmp := BGRABitmapToBitmap(BGRABitmap);
            try
              AImage.Transparent := bmp.Transparent;
              AImage.Picture.Assign(bmp);
            finally
              bmp.Free;
            end;
          end
        else
          begin
            Stream := BGRABitmapToPNGStream(BGRABitmap);
            try
              AImage.Transparent := BGRABitmap.HasTransparentPixels or BGRABitmap.HasSemiTransparentPixels;
              AImage.Picture.PNG.LoadFromStream(Stream);
            finally
              Stream.Free;
            end;
          end;
      finally
        BGRABitmap.Free;
      end;
    end
    else
      Stream.Free;
end;

initialization
  BGRASVG.RegisterSvgFormat;
  BGRAOpenRaster.RegisterOpenRasterFormat;
  BGRAPhoxo.RegisterPhoxoFormat;
  BGRAPaintNet.RegisterPaintNetFormat;
end.