Difference between revisions of "Base64"
From Lazarus wiki
Jump to navigationJump to searchLine 234: | Line 234: | ||
<syntaxhighlight lang="pascal"> | <syntaxhighlight lang="pascal"> | ||
unit ubase64image; | unit ubase64image; | ||
− | + | ||
+ | (* ************************* *) | ||
+ | (* * Base64 to Image * *) | ||
+ | (* ************************* *) | ||
+ | { Created: 2023 by KodeZwerg } | ||
+ | { Dialect: FreePascal } | ||
+ | { Type: Helper unit } | ||
+ | { License: Unlicensed } | ||
+ | |||
+ | { This unit can convert a Base64 encoded string into a TImage } | ||
+ | { Additional you can do the opposite, create from a file a Base64 } | ||
+ | |||
+ | { Thank you Remy for teaching me about TGraphicClass usage! } | ||
+ | { Thank you paweld for beta testing and fixing a transparency bug! } | ||
+ | { Thank you wp for teaching me more about TGraphicClass usage! } | ||
+ | { Thank you wp for complaining about my original names, critism help! } | ||
+ | |||
{$mode ObjFPC}{$H+} | {$mode ObjFPC}{$H+} | ||
− | + | ||
interface | interface | ||
− | + | ||
+ | // remove the dot to utilize BGRABitmap package | ||
+ | // put a dod infront of $ to deactivate BGRABitmap support | ||
+ | {$DEFINE UseBGRA} | ||
+ | |||
uses | uses | ||
− | Classes, SysUtils, Graphics, ExtCtrls, | + | Classes, SysUtils, Graphics, ExtCtrls, Dialogs, LCLType, Controls, |
− | Base64 | + | Base64 |
− | BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRASVG, BGRAOpenRaster, BGRAPhoxo, BGRAPaintNet; | + | {$If defined(UseBGRA)},BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRASVG, BGRAOpenRaster, BGRAPhoxo, BGRAPaintNet{$EndIf}; |
− | + | ||
− | function | + | // this method creates a stream from a file, additional it can throw a warning if a certain mb limit is exceeded |
− | function | + | function CreateStreamFromFile(const AFilename: string; var AStream: TStream; const AFileSizeWarningInMegabyte: Integer = 1): Boolean; |
− | function | + | // this method convert a stream into a base64 string |
+ | function CreateBase64FromStream(const AStream: TStream): string; | ||
+ | // this method convert a base 64 into a stream | ||
+ | function CreateStreamFromBase64(const ABase64String: AnsiString): TStream; | ||
+ | // depending what mode you selected you having either this or that method available to display out of a base64 a timage | ||
+ | {$If defined(UseBGRA)} | ||
+ | // this method convert base64 into a timage, additional you can choose between a faster bitmap conversation or a slower png compressed variant | ||
procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False); | procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False); | ||
− | + | {$Else} | |
+ | // this method convert a base64 into a timage | ||
+ | procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage); | ||
+ | {$EndIf} | ||
implementation | implementation | ||
− | + | ||
− | function | + | function CreateStreamFromFile(const AFilename: string; var AStream: TStream; const AFileSizeWarningInMegabyte: Integer = 1): Boolean; |
+ | function SizeToString(const ASize: UInt64; const oneKB: Integer = {$IFDEF MSWINDOWS}1024{$ELSE}1000{$ENDIF}): string; | ||
+ | var | ||
+ | Calc: Extended; | ||
+ | Sign: String; | ||
+ | SizeLength: Integer; | ||
+ | begin | ||
+ | SizeLength := 0; | ||
+ | Calc := ASize; | ||
+ | while (Calc > oneKB) do | ||
+ | begin | ||
+ | Calc := Calc / oneKB; | ||
+ | Inc(SizeLength); | ||
+ | end; | ||
+ | case SizeLength of | ||
+ | 0: Sign := ' byte'; | ||
+ | 1: Sign := ' kb'; // Kilo Byte | ||
+ | 2: Sign := ' mb'; // Mega Byte | ||
+ | 3: Sign := ' gb'; // Giga Byte | ||
+ | 4: Sign := ' tb'; // Tera Byte | ||
+ | 5: Sign := ' pb'; // Peta Byte | ||
+ | 6: Sign := ' eb'; // Exa Byte | ||
+ | 7: Sign := ' zb'; // Zetta Byte | ||
+ | 8: Sign := ' yb'; // Yotta Byte | ||
+ | 9: Sign := ' rb'; // Ronna Byte | ||
+ | 10:Sign := ' qb'; // Quetta Byte | ||
+ | else | ||
+ | Sign :=' (' + IntToStr(SizeLength) + ')'; | ||
+ | end; | ||
+ | Result := FormatFloat('#,##0.00', Calc) + Sign; | ||
+ | end; | ||
+ | const | ||
+ | oneKB = Integer({$IFDEF MSWINDOWS}1024{$ELSE}1000{$ENDIF}); | ||
+ | oneMB = Integer(oneKB * oneKB); | ||
var | var | ||
FileStream: TFileStream; | FileStream: TFileStream; | ||
Line 257: | Line 319: | ||
FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); | FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); | ||
try | try | ||
− | Result := TMemoryStream.Create; | + | Result := False; |
+ | if (FileStream.Size > (oneMB * AFileSizeWarningInMegabyte)) then | ||
+ | if QuestionDlg('Filesize Warning!', | ||
+ | Format('Filesize is bigger than %dmb (%s)!', [AFileSizeWarningInMegabyte, SizeToString(FileStream.Size)]) | ||
+ | + LineEnding + 'Continue loading?', | ||
+ | mtWarning, [mrYes, mrNo], 0) = mrNo then | ||
+ | Exit; | ||
+ | AStream := TMemoryStream.Create; | ||
try | try | ||
− | + | AStream.CopyFrom(FileStream, FileStream.Size); | |
finally | finally | ||
− | + | AStream.Position := 0; | |
+ | Result := True; | ||
end; | end; | ||
finally | finally | ||
Line 267: | Line 337: | ||
end; | end; | ||
end; | end; | ||
− | + | ||
− | function | + | function CreateBase64FromStream(const AStream: TStream): string; |
var | var | ||
EncodedStream: TStringStream; | EncodedStream: TStringStream; | ||
Encoder: TBase64EncodingStream; | Encoder: TBase64EncodingStream; | ||
begin | begin | ||
+ | Result := ''; | ||
EncodedStream := TStringStream.Create(''); | EncodedStream := TStringStream.Create(''); | ||
Encoder := TBase64EncodingStream.Create(EncodedStream); | Encoder := TBase64EncodingStream.Create(EncodedStream); | ||
Line 286: | Line 357: | ||
end; | end; | ||
end; | end; | ||
− | + | ||
− | function | + | function CreateStreamFromBase64(const ABase64String: AnsiString): TStream; |
var | var | ||
DecodedStream: TBase64DecodingStream; | DecodedStream: TBase64DecodingStream; | ||
Line 309: | Line 380: | ||
end; | end; | ||
end; | end; | ||
− | + | ||
+ | {$IfNDef UseBGRA} | ||
+ | function GetGraphicClassFromStream(const AStream: TStream): TGraphicClass; | ||
+ | function HasIconSignature(const AStream: TStream): Boolean; | ||
+ | const | ||
+ | IconSignature: array[0..3] of Byte = ($00, $00, $01, $00); | ||
+ | var | ||
+ | SignatureBytes: array[0..3] of Byte; | ||
+ | begin | ||
+ | AStream.Position := 0; | ||
+ | AStream.ReadBuffer(SignatureBytes, SizeOf(SignatureBytes)); | ||
+ | Result := CompareMem(@SignatureBytes, @IconSignature, SizeOf(SignatureBytes)); | ||
+ | AStream.Position := 0; | ||
+ | end; | ||
+ | const | ||
+ | REGISTERED: array[0..5] of TGraphicClass = (TBitmap, TJpegImage, | ||
+ | TPortableNetworkGraphic, TTiffImage, TGifImage, TPixMap); | ||
+ | var | ||
+ | i: Integer; | ||
+ | begin | ||
+ | Result := nil; | ||
+ | AStream.Position := 0; | ||
+ | for i := 0 to High(REGISTERED) do | ||
+ | if REGISTERED[i].IsStreamFormatSupported(AStream) then | ||
+ | begin | ||
+ | Result := REGISTERED[i]; | ||
+ | AStream.Position := 0; | ||
+ | Exit; | ||
+ | end; | ||
+ | if HasIconSignature(AStream) then | ||
+ | Result := TIcon; | ||
+ | AStream.Position := 0; | ||
+ | end; | ||
+ | |||
+ | procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage); | ||
+ | var | ||
+ | graphicClass: TGraphicClass; | ||
+ | graphic: TGraphic; | ||
+ | stream: TStream; | ||
+ | begin | ||
+ | AImage.Picture.Clear; | ||
+ | stream := CreateStreamFromBase64(ABase64String); | ||
+ | graphicClass := GetGraphicClassFromStream(stream); | ||
+ | if Assigned(graphicClass) then | ||
+ | begin | ||
+ | graphic := graphicClass.Create; | ||
+ | try | ||
+ | graphic.LoadFromStream(stream); | ||
+ | AImage.Picture.Assign(graphic); | ||
+ | finally | ||
+ | graphic.Free; | ||
+ | end; | ||
+ | end; | ||
+ | stream.Free; | ||
+ | end; | ||
+ | {$EndIf} | ||
+ | |||
+ | {$If defined(UseBGRA)} | ||
function BGRABitmapToPNGStream(const ABGRABitmap: TBGRABitmap): TStream; | function BGRABitmapToPNGStream(const ABGRABitmap: TBGRABitmap): TStream; | ||
begin | begin | ||
Line 319: | Line 447: | ||
end; | end; | ||
end; | end; | ||
− | + | ||
function BGRABitmapToBitmap(const ABGRABitmap: TBGRABitmap): TBitmap; | function BGRABitmapToBitmap(const ABGRABitmap: TBGRABitmap): TBitmap; | ||
begin | begin | ||
Line 336: | Line 464: | ||
end; | end; | ||
end; | end; | ||
− | + | ||
− | procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; | + | procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False); |
− | |||
var | var | ||
BGRABitmap: TBGRABitmap; | BGRABitmap: TBGRABitmap; | ||
Line 345: | Line 472: | ||
begin | begin | ||
AImage.Picture.Clear; | AImage.Picture.Clear; | ||
− | Stream := | + | Stream := CreateStreamFromBase64(ABase64String); |
if (DetectFileFormat(Stream) <> ifUnknown) then | if (DetectFileFormat(Stream) <> ifUnknown) then | ||
begin | begin | ||
Line 382: | Line 509: | ||
Stream.Free; | Stream.Free; | ||
end; | end; | ||
− | + | {$EndIf} | |
+ | |||
initialization | initialization | ||
+ | {$If defined(UseBGRA)} | ||
BGRASVG.RegisterSvgFormat; | BGRASVG.RegisterSvgFormat; | ||
BGRAOpenRaster.RegisterOpenRasterFormat; | BGRAOpenRaster.RegisterOpenRasterFormat; | ||
BGRAPhoxo.RegisterPhoxoFormat; | BGRAPhoxo.RegisterPhoxoFormat; | ||
BGRAPaintNet.RegisterPaintNetFormat; | BGRAPaintNet.RegisterPaintNetFormat; | ||
+ | {$EndIf} | ||
end. | end. | ||
</syntaxhighlight> | </syntaxhighlight> |
Revision as of 23:13, 14 August 2023
Various code examples to handle Base64 encoded strings.
Convert Base64 string to picture, 1
Example from forum member wp.
uses
Classes, Base64;
procedure DecodeBase64ToStream(AStream: TStream; const s: string; strict: boolean=false);
var
SD: String;
InStream: TStringStream;
Decoder: TBase64DecodingStream;
begin
if Length(s)=0 then
Exit;
SD := S;
while Length(Sd) mod 4 > 0 do
SD := SD + '=';
InStream:= TStringStream.Create(SD);
try
if strict then
Decoder:=TBase64DecodingStream.Create(InStream, bdmStrict)
else
Decoder:=TBase64DecodingStream.Create(InStream, bdmMIME);
try
AStream.CopyFrom(Decoder, Decoder.Size);
AStream.Position := 0;
finally
Decoder.Free;
end;
finally
InStream.Free;
end;
end;
var
base64String: String =
'iVBORw0KGgoAAAANSUhEUgAAARIAAAAdCAYAAABmFuNCAAAFPElEQVR4Xu2cy5oiIQyFdaPP'+
'PCt1Nc9sbxyRTlcqJuFAYdvf9HGjllSAQ/grXGR/vV5vO76oABWgAhsU2BMkG9TjrVSACjwU'+
'IEjoCFSACmxWwAXJ4XDY7fe73fX6scpg1nVtNLLZWzPEzqzyM6/3+sasdkT8kHlVlVo+/wSS'+
'4/Hv7nY71XBlf7nD5M/j86zruvEimzW/Q8oSDbnMjhiZVX7m9V7fmNWOiB8yr7zvaw3diKQI'+
'WF4CEd0ZZ1y3jahtaoDcgmngEi3JS4ASlTnL6zvrxbyqU7Z0QNLM8k/mtb2Pi4bT50hKCHSP'+
'ZR72Pz6uaVRhfxSIWIDs7+Q4n8+706k+Db8K/wkUOwTrypSJqQAV2KzAVJBoiPSCpEAkikCK'+
'rQKTm5NAohPCZLMv0AAVGFZgGkgsROpkLRaRaIhE0Yet4eVyeUQpAhdvcnhYFd5IBahAlwJT'+
'QLIFIqW0Nhqx0YdEHTog8dIwKulqeyamAtMU2AySGRAptfGGNRUgF1PZU5L2eVlymlI0RAWo'+
'QKgADJIKjDKBWveWWICUaz3DGSmRXmLTpfQhIikimCzL1bbGx+Px65I35Cq/y3WdVm4qv9nr'+
'0dAty0vnU6OxJV/9vVVer0Uz217Zo3oi/SXSArmODnmjOuo2yTRE6qHTSNk9P4h8I0ub5Y+2'+
'ldaq1ye89JGNKK3NP2q7Jkg8YHgCjUCkOsGyb2UNkhqJlD0tZT+LvEsa2eti77FL1guw1qDw'+
'GsiK1Or0kaNYKLXykvTRfbYcWb7lN+3c3mcPsr2d2wOvwHaWjq1yat2ieqMw8bRvXfN8ywNb'+
'D/SzBwvaqTOfR+qEpLF1SkHyaohokJTJU728q+HhwWTZNFfXgMukq95Alzkh2mG9RtV2s4gk'+
'6sxyf+tJY5+OSIewQPI6u+5wUUfoycvaQJ5siH0UlrrjekBG8/L0jjqUbUMU9LosSETSCw7E'+
'5xFIjDxAGyBZhgNRgyzLr9gKzXNla0RSJk8FCOW9QKF+X0ck+rvYEgiNgiSCw4ig2rHRzzad'+
'dTiv83vtEUUJmf3Wb60OjXSqrFxoR880yQDaa18DBYXibJBIm2htRzSMyt9qsxG/D0HyHdFI'+
'FSwe2kQQEcBYJxkFSRT+jwjagscItFBHbT3lkAgK7XhoCO6BCq2PLQuS50gkF7WZV07kGlI/'+
'pC66XCO+2CprFMEhUctT34uOEUBBUgz27mBdP10ikJRUdRPaeo7kfL9+C1Zu+iZbrdN536Mh'+
'SBYlZE8COzmXQcw+OVqdvAUSFGKtfDI46LprjaLrSF5eNGJtbx0G6Cggm1dC6ofON3l+osth'+
'fSxKH2mIgiTKswdeUEQiE6mHw/NQZ3SSVSov/5vwJ08rTAo46qt+9peK61AommztdVimpwJU'+
'AFegCyTFrAeTLRFJpeE6KtGbzerUifxLb4GI3QGbDWtwOZiSClCBEQWgyVYddWzdgOYVUkcl'+
'6Bb5B17U/28IkpHm5z1UYI4CwD4SGc7o4cXnQKPj/zSt4mZDHAsNbUtWdzikaSnM36nA6xRo'+
'gkSGM/oMkDJHsXVuxI9MKrT8f/k+HyUgS8bo5NbrZKRlKvC7FYBA8kqJ7BFuembaA4qUxUKk'+
'dRRcBeL7j5CcVQbdJrNsUkMeIdnrS1/90Vv+7TXWm14yz49azDfDrZf7/OMhdWebdWwej1rk'+
'UYu9vvQb/PCtZ7YWgZEjEpGICLEz64g+5rX9iD5q+H9p+PYzWxFIMA0VoAI/W4G3z5H8bHlY'+
'OipABRAFCBJEJaahAlQgVYAgoYNQASqwWYF/o2XhCcA1FYIAAAAASUVORK5CYII=';
procedure TForm1.Button1Click(Sender: TObject);
var
stream: TMemoryStream;
begin
stream := TMemoryStream.Create;
try
DecodeBase64ToStream(stream, base64String);
Image1.Picture.LoadFromStream(stream);
finally
stream.Free;
end;
end;
Convert Base64 string to picture, 2
This procedure is from forum member KodeZwerg. He created a pretty easy to handle method that supports now all (?) formats that Lazarus Graphics offers. To name them: JPEG, PNG, GIF, BMP, ICO and TIFF. Full unit:
unit uBase64Image;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Graphics, ExtCtrls, Base64;
function FileToBytes(const AFilename: string): TBytes;
function BytesToBase64(const AData: TBytes): AnsiString;
function Base64ToBytes(const ABase64String: AnsiString): TBytes;
function GetGraphicClassFromBytes(const AData: TBytes): TGraphicClass;
procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
implementation
{ convert any file into bytes }
function FileToBytes(const AFilename: string): TBytes;
var
FileStream: TFileStream;
begin
FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
try
SetLength(Result, FileStream.Size);
FileStream.ReadBuffer(Result[0], FileStream.Size);
finally
FileStream.Free;
end;
end;
{ convert bytes to base64 }
function BytesToBase64(const AData: TBytes): AnsiString;
var
encodedStream: TStringStream;
encodingStream: TBase64EncodingStream;
begin
encodedStream := TStringStream.Create('');
try
encodingStream := TBase64EncodingStream.Create(encodedStream);
try
encodingStream.WriteBuffer(AData[0], Length(AData));
finally
encodingStream.Free;
end;
Result := encodedStream.DataString;
finally
encodedStream.Free;
end;
end;
{ convert base64 to bytes }
function Base64ToBytes(const ABase64String: AnsiString): TBytes;
var
decodedStream: TBase64DecodingStream;
base64stream: TStringStream;
begin
base64stream := TStringStream.Create(ABase64String);
try
decodedStream := TBase64DecodingStream.Create(base64stream);
try
SetLength(Result, decodedStream.Size);
decodedStream.ReadBuffer(Result[0], decodedStream.Size);
finally
decodedStream.Free;
end;
finally
base64stream.Free;
end;
end;
{ determine the image format }
function GetGraphicClassFromBytes(const AData: TBytes): TGraphicClass;
begin
Result := nil;
// JPEG
if (((Length(AData) >= 8) and (CompareMem(@AData[0], @[$FF, $D8, $FF, $DB], 4)
or CompareMem(@AData[0], @[$FF, $D8, $FF, $E0, $00, $10, $4A, $46], 8)
or CompareMem(@AData[0], @[$49, $46, $00, $01], 4)
or CompareMem(@AData[0], @[$FF, $D8, $FF, $EE], 4)
or (CompareMem(@AData[0], @[$FF, $D8, $FF, $E1], 4) and CompareMem(@AData[6], @[$45, $78], 2))
or CompareMem(@AData[0], @[$69, $66, $00, $00], 4)
or CompareMem(@AData[0], @[$FF, $D8, $FF, $E0], 4)))) then
Result := TJPEGImage
else
// PNG
if ((Length(AData) >= 8) and CompareMem(@AData[0], @[$89, $50, $4E, $47, $0D, $0A, $1A, $0A], 8)) then
Result := TPortableNetworkGraphic
else
// GIF
if ((Length(AData) >= 6) and (CompareMem(@AData[0], @[$47, $49, $46, $38, $37, $61], 6)
or CompareMem(@AData[0], @[$47, $49, $46, $38, $39, $61], 6))) then
Result := TGIFImage
else
// BMP
if ((Length(AData) >= 2) and CompareMem(@AData[0], @[$42, $4D], 2)) then
Result := TBitmap
else
// ICON
if ((Length(AData) >= 4) and CompareMem(@AData[0], @[$00, $00, $01, $00], 4)) then
Result := TIcon
else
// TIFF
if ((Length(AData) >= 4) and (CompareMem(@AData[0], @[$49, $49, $2A, $00], 4)
or CompareMem(@AData[0], @[$4D, $4D, $00, $2A], 6))) then
Result := TTiffImage
else
raise Exception.Create('Unknown Graphic Type!');
end;
{ analyze and display a found image format into a TImage }
procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
var
bytes: TBytes;
graphic: TGraphic;
stream: TStream;
begin
AImage.Picture.Clear;
bytes := Base64ToBytes(ABase64String);
graphic := GetGraphicClassFromBytes(bytes).Create;
try
stream := TBytesStream.Create(bytes);
try
graphic.LoadFromStream(stream);
finally
stream.Free;
end;
AImage.Picture.Assign(graphic);
finally
graphic.Free;
end;
end;
end.
Convert Base64 string to picture, using BGRABitmap
This unit is from forum member KodeZwerg. You must install the BGRABitmap component.
unit ubase64image;
(* ************************* *)
(* * Base64 to Image * *)
(* ************************* *)
{ Created: 2023 by KodeZwerg }
{ Dialect: FreePascal }
{ Type: Helper unit }
{ License: Unlicensed }
{ This unit can convert a Base64 encoded string into a TImage }
{ Additional you can do the opposite, create from a file a Base64 }
{ Thank you Remy for teaching me about TGraphicClass usage! }
{ Thank you paweld for beta testing and fixing a transparency bug! }
{ Thank you wp for teaching me more about TGraphicClass usage! }
{ Thank you wp for complaining about my original names, critism help! }
{$mode ObjFPC}{$H+}
interface
// remove the dot to utilize BGRABitmap package
// put a dod infront of $ to deactivate BGRABitmap support
{$DEFINE UseBGRA}
uses
Classes, SysUtils, Graphics, ExtCtrls, Dialogs, LCLType, Controls,
Base64
{$If defined(UseBGRA)},BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRASVG, BGRAOpenRaster, BGRAPhoxo, BGRAPaintNet{$EndIf};
// this method creates a stream from a file, additional it can throw a warning if a certain mb limit is exceeded
function CreateStreamFromFile(const AFilename: string; var AStream: TStream; const AFileSizeWarningInMegabyte: Integer = 1): Boolean;
// this method convert a stream into a base64 string
function CreateBase64FromStream(const AStream: TStream): string;
// this method convert a base 64 into a stream
function CreateStreamFromBase64(const ABase64String: AnsiString): TStream;
// depending what mode you selected you having either this or that method available to display out of a base64 a timage
{$If defined(UseBGRA)}
// this method convert base64 into a timage, additional you can choose between a faster bitmap conversation or a slower png compressed variant
procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False);
{$Else}
// this method convert a base64 into a timage
procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
{$EndIf}
implementation
function CreateStreamFromFile(const AFilename: string; var AStream: TStream; const AFileSizeWarningInMegabyte: Integer = 1): Boolean;
function SizeToString(const ASize: UInt64; const oneKB: Integer = {$IFDEF MSWINDOWS}1024{$ELSE}1000{$ENDIF}): string;
var
Calc: Extended;
Sign: String;
SizeLength: Integer;
begin
SizeLength := 0;
Calc := ASize;
while (Calc > oneKB) do
begin
Calc := Calc / oneKB;
Inc(SizeLength);
end;
case SizeLength of
0: Sign := ' byte';
1: Sign := ' kb'; // Kilo Byte
2: Sign := ' mb'; // Mega Byte
3: Sign := ' gb'; // Giga Byte
4: Sign := ' tb'; // Tera Byte
5: Sign := ' pb'; // Peta Byte
6: Sign := ' eb'; // Exa Byte
7: Sign := ' zb'; // Zetta Byte
8: Sign := ' yb'; // Yotta Byte
9: Sign := ' rb'; // Ronna Byte
10:Sign := ' qb'; // Quetta Byte
else
Sign :=' (' + IntToStr(SizeLength) + ')';
end;
Result := FormatFloat('#,##0.00', Calc) + Sign;
end;
const
oneKB = Integer({$IFDEF MSWINDOWS}1024{$ELSE}1000{$ENDIF});
oneMB = Integer(oneKB * oneKB);
var
FileStream: TFileStream;
begin
FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
try
Result := False;
if (FileStream.Size > (oneMB * AFileSizeWarningInMegabyte)) then
if QuestionDlg('Filesize Warning!',
Format('Filesize is bigger than %dmb (%s)!', [AFileSizeWarningInMegabyte, SizeToString(FileStream.Size)])
+ LineEnding + 'Continue loading?',
mtWarning, [mrYes, mrNo], 0) = mrNo then
Exit;
AStream := TMemoryStream.Create;
try
AStream.CopyFrom(FileStream, FileStream.Size);
finally
AStream.Position := 0;
Result := True;
end;
finally
FileStream.Free;
end;
end;
function CreateBase64FromStream(const AStream: TStream): string;
var
EncodedStream: TStringStream;
Encoder: TBase64EncodingStream;
begin
Result := '';
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 CreateStreamFromBase64(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;
{$IfNDef UseBGRA}
function GetGraphicClassFromStream(const AStream: TStream): TGraphicClass;
function HasIconSignature(const AStream: TStream): Boolean;
const
IconSignature: array[0..3] of Byte = ($00, $00, $01, $00);
var
SignatureBytes: array[0..3] of Byte;
begin
AStream.Position := 0;
AStream.ReadBuffer(SignatureBytes, SizeOf(SignatureBytes));
Result := CompareMem(@SignatureBytes, @IconSignature, SizeOf(SignatureBytes));
AStream.Position := 0;
end;
const
REGISTERED: array[0..5] of TGraphicClass = (TBitmap, TJpegImage,
TPortableNetworkGraphic, TTiffImage, TGifImage, TPixMap);
var
i: Integer;
begin
Result := nil;
AStream.Position := 0;
for i := 0 to High(REGISTERED) do
if REGISTERED[i].IsStreamFormatSupported(AStream) then
begin
Result := REGISTERED[i];
AStream.Position := 0;
Exit;
end;
if HasIconSignature(AStream) then
Result := TIcon;
AStream.Position := 0;
end;
procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
var
graphicClass: TGraphicClass;
graphic: TGraphic;
stream: TStream;
begin
AImage.Picture.Clear;
stream := CreateStreamFromBase64(ABase64String);
graphicClass := GetGraphicClassFromStream(stream);
if Assigned(graphicClass) then
begin
graphic := graphicClass.Create;
try
graphic.LoadFromStream(stream);
AImage.Picture.Assign(graphic);
finally
graphic.Free;
end;
end;
stream.Free;
end;
{$EndIf}
{$If defined(UseBGRA)}
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 := CreateStreamFromBase64(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;
{$EndIf}
initialization
{$If defined(UseBGRA)}
BGRASVG.RegisterSvgFormat;
BGRAOpenRaster.RegisterOpenRasterFormat;
BGRAPhoxo.RegisterPhoxoFormat;
BGRAPaintNet.RegisterPaintNetFormat;
{$EndIf}
end.