How to convert an NSImage to Delphis FireMonkey TBitmap? The NSImage is being passed to me from an Objective C API. I am using Delphi XE8.
Try using NSImage.TIFFRepresentation data. Save it to memory stream and then load TBitmap from the stream. Another way is using NSImage.CGImageForProposedRect, you may find a sample here: https://delphi-foundations.googlecode.com/svn/trunk/FMX%20Utilities/CCR.FMXClipboard.Mac.pas
https://delphi-foundations.googlecode.com/svn/trunk/XE2%20book/13.%20Native%20APIs/Taking%20a%20screenshot/ScreenshotForm.pas
Update: OK, here comes my solution:
function PutBytesCallback(info: Pointer; buffer: Pointer; count: Longword): Longword; cdecl;
begin
Result := TStream(info).Write(buffer^, count)
end;
procedure ReleaseConsumerCallback(info: Pointer); cdecl;
begin
end;
function NSImageToBitmap(Image: NSImage; Bitmap: TBitmap): Boolean;
var
LStream: TMemoryStream;
LCGImageRef: CGImageRef;
LCallbacks: CGDataConsumerCallbacks;
LConsumer: CGDataConsumerRef;
LImageDest: CGImageDestinationRef;
begin
Result := False;
LStream := TMemoryStream.Create;
LImageDest := nil;
LConsumer := nil;
try
LCallbacks.putBytes := PutBytesCallback;
LCallbacks.releaseConsumer := ReleaseConsumerCallback;
LCGImageRef := Image.CGImageForProposedRect(nil, nil, nil);
LConsumer := CGDataConsumerCreate(LStream, #LCallbacks);
if LConsumer <> nil then
LImageDest := CGImageDestinationCreateWithDataConsumer(LConsumer, CFSTR('public.png'), 1, nil);
if LImageDest <> nil then
begin
CGImageDestinationAddImage(LImageDest, LCGImageRef, nil);
CGImageDestinationFinalize(LImageDest);
LStream.Position := 0;
Bitmap.LoadFromStream(LStream);
Result := True
end
finally
if LImageDest <> nil then CFRelease(LImageDest);
if LConsumer <> nil then CGDataConsumerRelease(LConsumer);
LStream.Free
end;
end;
Related
Hi I have the following code:
procedure TformInvoiceDetails.ReadWebImage(imgAddress: string);
var
memStream: TMemoryStream;
begin
memStream := TMemoryStream.Create;
try
IdHTTP1.Get (imgAddress,memStream);
//sleep(5000);
except
imageContProduct.Visible := false;
ShowMessage('Image not found at:'+imgAddress);
memStream.Free;
exit;
end;
try
memStream.Position := 0;
imageContProduct.Visible := true;
imageContProduct.Bitmap.LoadFromStream(memStream);
finally
memStream.Free;
end;
end;
Most of the time it works okay but I keep getting an exeption error and sometimes a 'Image not found at' ( although the image does exist).
If I put the sleep(5000) everything works okay.
So I am presuming the image has not been recived before I try and add to the TImage.
Is there a better method to use ?
You can use another components to load pictures:
uses WinInet, JPEG;
...
function DownloadToStream(Url: string; Stream: TStream): Boolean;
var
hNet: HINTERNET;
hUrl: HINTERNET;
Buffer: array[0..10240] of Char;
BytesRead: DWORD;
begin
Result := FALSE;
hNet := InternetOpen('agent', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if (hNet <> nil) then
begin
hUrl := InternetOpenUrl(hNet, PChar(Url), nil, 0,
INTERNET_FLAG_RELOAD, 0);
if (hUrl <> nil) then
begin
while (InternetReadFile(hUrl, #Buffer, sizeof(Buffer), BytesRead)) do
begin
if (BytesRead = 0) then
begin
Result := TRUE;
break;
end;
Stream.WriteBuffer(Buffer,BytesRead);
end;
InternetCloseHandle(hUrl);
end;
InternetCloseHandle(hNet);
end;
end;
procedure TformInvoiceDetails.ReadWebImage(imgAddress: string);
var
memStream: TMemoryStream;
Jpg:= TJPEGImage;
begin
memStream:= TMemoryStream.Create;
try
if DownloadToStream(imgAddress, memStream) then
begin
memStream.Seek(0, soFromBeginning);
if (LowerCase(RightStr(imgAddress, 4))='.jpg') or (LowerCase(RightStr(imgAddress, 5))='.jpeg')
try //do the same operation for *.png
Jpg:= TJPEGImage.Create;
Jpg.LoadFromStream(memStream);
imageContProduct.Picture.Bitmap.Assign(Jpg);
imageContProduct.Visible := true;
finally
Jpg.Free;
end
else
try
imageContProduct.Picture.Bitmap.LoadFromStream(memStream);
imageContProduct.Visible := true;
finally
end;
end;
finally
memStream.Free;
end;
end;
I've got a minor issue with decompressing using the ZLib unit in Delphi
unit uZCompression;
interface
uses
uCompression;
type
TZZipCompression = class(TInterfacedObject, ICompression)
public
function DoCompression(aContent: TArray<Byte>): TArray<Byte>;
function DoDecompression(aContent: TArray<Byte>): TArray<Byte>;
function GetWindowsBits: Integer; virtual;
end;
TZGZipCompression = class(TZZipCompression)
function GetWindowsBits: Integer; override;
end;
implementation
uses
System.ZLib, System.Classes, uMxKxUtils;
{ TZCompression }
function TZZipCompression.DoCompression(aContent: TArray<Byte>): TArray<Byte>;
var
LContentStream, LOutputStream: TMemoryStream;
LCompressedStream: TZCompressionStream;
begin
LContentStream := ByteArrayToStream(aContent);
LOutputStream := TMemoryStream.Create;
LCompressedStream := TZCompressionStream.Create(LOutputStream, zcDefault, GetWindowsBits);
LCompressedStream.CopyFrom(LContentStream, LContentStream.Size);
LCompressedStream.Free;
Result := StreamToByteArray(LOutputStream);
LOutputStream.Free;
LContentStream.Free;
end;
function TZZipCompression.DoDecompression(aContent: TArray<Byte>): TArray<Byte>;
var
LContentStream, LOutputStream: TMemoryStream;
LDecompressedStream: TZDecompressionStream;
begin
LContentStream := ByteArrayToStream(aContent);
LOutputStream := TMemoryStream.Create;
LDecompressedStream := TZDecompressionStream.Create(LContentStream);
LOutputStream.CopyFrom(LDecompressedStream, LDecompressedStream.Size);
LDecompressedStream.Free;
Result := StreamToByteArray(LOutputStream);
LOutputStream.Free;
LContentStream.Free;
end;
function TZZipCompression.GetWindowsBits: Integer;
begin
Result := 15;
end;
{ TZGZipCompression }
function TZGZipCompression.GetWindowsBits: Integer;
begin
Result := inherited;
Result := Result + 16;
end;
end.
This is my unit which is driven by an interface (which you don't need to know about), and data is passed in and out through a TArray variables.
I've coded it to be able to do 2 types of compression, standard zip and gzip which is determined by the windowsbits passed in to the functions.
Here are a couple of other functions being used to convert the TArray to TMemoryStream
function ByteArrayToStream(aContent: TArray<Byte>): TMemoryStream;
begin
Result := TMemoryStream.Create;
Result.Write(aContent, length(aContent)*SizeOf(aContent[0]));
Result.Position := 0;
end;
function StreamToByteArray(aStream: TMemoryStream): TArray<Byte>;
var
LStreamPos: Int64;
begin
if Assigned(aStream) then
begin
LStreamPos := aStream.Position;
aStream.Position := 0;
SetLength(Result, aStream.Size);
aStream.Read(Result, aStream.Size);
aStream.Position := LStreamPos;
end
else
SetLength(Result, 0);
end;
Now I can compress and decompress to .zip using the TZZipCompression class perfectly fine (it doesn't open up as a zip file, but it does decompress back to the original file which I can open and edit).
I can also compress to .gz using the TZGZipCompression class fine as well (interestingly I can open this gzip file perfectly well).
My issue however is that it won't decompress back from the .gz file and throws and error as soon as it hits
LOutputStream.CopyFrom(LDecompressedStream, LDecompressedStream.Size)
Funnily enough the Help file example has it as below
LOutputStream.CopyFrom(LDecompressedStream, 0)
But this doesn't work either.
Can anyone spot the issue?
Your conversion functions between TArray<Byte> and TMemoryStream are wrong, as you are not accessing the array content correctly. TArray is a dynamic array. When calling TMemoryStream.Write() and TMemoryStream.Read(), you are passing the memory address of the TArray itself, not the memory address of the data that the TArray points at. You need to reference the TArray to get the correct memory address, eg:
function ByteArrayToStream(const aContent: TArray<Byte>): TMemoryStream;
begin
Result := TMemoryStream.Create;
try
if Length(aContent) > 0 then
Result.WriteBuffer(aContent[0], Length(aContent));
Result.Position := 0;
except
Result.Free;
raise;
end;
end;
function StreamToByteArray(aStream: TMemoryStream): TArray<Byte>;
begin
if Assigned(aStream) then
begin
SetLength(Result, aStream.Size);
if Length(Result) > 0 then
Move(aStream.Memory^, Result[0], aStream.Size);
end
else
SetLength(Result, 0);
end;
Alternatively:
function ByteArrayToStream(const aContent: TArray<Byte>): TMemoryStream;
begin
Result := TMemoryStream.Create;
try
Result.WriteBuffer(PByte(aContent)^, Length(aContent));
Result.Position := 0;
except
Result.Free;
raise;
end;
end;
function StreamToByteArray(aStream: TMemoryStream): TArray<Byte>;
begin
if Assigned(aStream) then
begin
SetLength(Result, aStream.Size);
Move(aStream.Memory^, PByte(Result)^, aStream.Size);
end
else
SetLength(Result, 0);
end;
That being said, you don't need to waste memory making copies of the array data using TMemoryStream. You can use TBytesStream instead (since dynamic arrays are reference counted), eg:
function TZZipCompression.DoCompression(aContent: TArray<Byte>): TArray<Byte>;
var
LContentStream, LOutputStream: TBytesStream;
LCompressedStream: TZCompressionStream;
begin
LContentStream := TBytesStream.Create(aContent);
try
LOutputStream := TBytesStream.Create(nil);
try
LCompressedStream := TZCompressionStream.Create(LOutputStream, zcDefault, GetWindowsBits);
try
LCompressedStream.CopyFrom(LContentStream, 0);
finally
LCompressedStream.Free;
end;
Result := Copy(LOutputStream.Bytes, 0, LOutputStream.Size);
finally
LOutputStream.Free;
end;
finally
LContentStream.Free;
end;
end;
function TZZipCompression.DoDecompression(aContent: TArray<Byte>): TArray<Byte>;
var
LContentStream, LOutputStream: TBytesStream;
LDecompressedStream: TZDecompressionStream;
begin
LContentStream := TBytesStream.Create(aContent);
try
LOutputStream := TBytesStream.Create(nil);
try
LDecompressedStream := TZDecompressionStream.Create(LContentStream, GetWindowsBits);
try
LOutputStream.CopyFrom(LDecompressedStream, 0);
finally
LDecompressedStream.Free;
end;
Result := Copy(LOutputStream.Bytes, 0, LOutputStream.Size);
finally
LOutputStream.Free;
end;
finally
LContentStream.Free;
end;
end;
i have this Thread that get image url from the web then save it to memory stream then save from memory stream To file
i needed to convert any image that downloaded to a gif image so i do something like this
unit downloadimgThread;
interface
uses Windows, SysUtils, Classes, dialogs, IdSSLOpenSSL, IdHttp, IdUri, System.AnsiStrings, Graphics, Jpeg, Vcl.Imaging.GIFImg, PNGImage;
type
TDownloadUpdateVisualEvent = procedure(Sender: TObject; Anameofimg: String;
var Aimagelocate: String) of object;
type
TURLDownload = class(TThread)
private
FOnUpdateVisual: TDownloadUpdateVisualEvent;
FURL: String;
Fnameofimg: string;
FPathImage: string;
FFileNameImage: string;
ImageName: string;
PathURL: string;
procedure DoUpdateVisual;
protected
procedure Execute; override;
public
constructor Create(Thrdid: Pointer; const AUrl: String;
Const AOutPathImages: string; AOnUpdateVisual: TDownloadUpdateVisualEvent;
Anameofimg: String); reintroduce;
property URL: string read FURL write FURL;
property PathImage: string read FPathImage;
property FileNameImage: string read FFileNameImage;
end;
var
URLDOWNLOAD: TURLDownload;
implementation
{ TURLDownload }
function JpgToGif(ms: TMemoryStream): Boolean;
var
gif: TGIFImage;
jpg: TJPEGImage;
begin
Result := False;
gif := TGIFImage.Create;
try
jpg := TJPEGImage.Create;
try
//jpg
ms.Position := 0;
jpg.LoadFromStream(ms);
jpg.DIBNeeded;
gif.Assign(jpg);
//save...
ms.Clear;
gif.SaveToStream(ms);
Result := True;
finally
jpg.Free;
jpg := nil;
end;
finally
gif.Free;
gif := nil;
end;
end;
constructor TURLDownload.Create(Thrdid: Pointer; const AUrl, AOutPathImages: string; AOnUpdateVisual: TDownloadUpdateVisualEvent; Anameofimg: String);
var
URI: TIdURI;
begin
inherited Create(false);
FreeOnTerminate := True;
FURL := AUrl;
FOnUpdateVisual := AOnUpdateVisual;
Fnameofimg := Anameofimg;
FPathImage := AOutPathImages;
URI := TIdURI.Create(AUrl);
try
ImageName := URI.Document;
PathURL := URI.path;
finally
URI.Free;
end;
end;
procedure TURLDownload.DoUpdateVisual;
begin
if Assigned(FOnUpdateVisual) then
FOnUpdateVisual(self, Fnameofimg, FFileNameImage);
end;
procedure TURLDownload.Execute;
var
aMs: TMemoryStream;
aIdHttp: TIdHttp;
IdSSL: TIdSSLIOHandlerSocketOpenSSL;
path: string;
dir: string;
SPEXT : String;
itsimage: string;
responsechk: Integer;
begin
dir := AnsiReplaceText(PathURL, '/', '');
if (ImageName = '') then
begin
exit;
end;
SPEXT := ExtractFileExt(ImageName);
ImageName := Copy(ImageName, 1, Length(ImageName) - Length(SPEXT));
path := PathImage + '\' + ImageName + '.gif';
if fileexists(path) then
begin
FFileNameImage := path;
if Assigned(FOnUpdateVisual) then
begin
Synchronize(DoUpdateVisual);
end;
exit;
end
else
if not fileexists(path) then
begin
aMs := TMemoryStream.Create;
aIdHttp := TIdHttp.Create(nil);
IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
try
IdSSL.SSLOptions.Method := sslvTLSv1;
IdSSL.SSLOptions.Mode := sslmUnassigned;
aIdHttp.HTTPOptions := [hoForceEncodeParams] + [hoNoProtocolErrorException];
aIdHttp.IOHandler := IdSSL;
aIdHttp.AllowCookies := True;
aIdHttp.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
aIdHttp.HandleRedirects := True;
aIdHttp.RedirectMaximum := 3;
try
aIdHttp.Head(trim(FURL));
except
end;
itsimage := aIdHttp.Response.ContentType;
responsechk := aIdHttp.ResponseCode;
if responsechk <> 200 then
begin
FFileNameImage := 'error';
if Assigned(FOnUpdateVisual) then
begin
Synchronize(DoUpdateVisual);
end;
exit;
end;
if (itsimage = 'image/gif') then
begin
try
aIdHttp.Get(trim(FURL), aMs);
except
end;
aMs.SaveToFile(path);
end else if (itsimage = 'image/jpeg') then
begin
try
aIdHttp.Get(trim(FURL), aMs);
except
end;
if JpgToGif(aMs) then
begin
aMs.SaveToFile(path);
end;
end;
try
if aIdHttp.Connected then
aIdHttp.Disconnect;
except
end;
finally
aMs.Free;
IdSSL.Free;
aIdHttp.Free;
end;
end;
FFileNameImage := path;
if Assigned(FOnUpdateVisual) then
begin
Synchronize(DoUpdateVisual);
end;
end;
end.
in this unit i try to check if image type is jpg then convert it to gif and save it specifically at this line of code
if (itsimage = 'image/jpeg') then
begin
try
aIdHttp.Get(trim(FURL), aMs);
except
end;
if JpgToGif(aMs) then
begin
aMs.SaveToFile(path);
end;
// function to convert
function JpgToGif(ms: TMemoryStream): Boolean;
var
gif: TGIFImage;
jpg: TJPEGImage;
begin
Result := False;
gif := TGIFImage.Create;
try
jpg := TJPEGImage.Create;
try
//jpg
ms.Position := 0;
jpg.LoadFromStream(ms);
jpg.DIBNeeded;
gif.Assign(jpg);
//save...
ms.Clear;
gif.SaveToStream(ms);
Result := True;
finally
jpg.Free;
jpg := nil;
end;
finally
gif.Free;
gif := nil;
end;
end;
when i try to convert the image and save it the image saved is corrupted what could be the issue ?
There is a very simple solution for this. And that is to use FMX Bitmap instead of default VCL Bitmap as it allows automatic format recognition on load and automatic format choosing on save based on file extension of the file name you provide to SaveToFile method.
Here is a simple code that loads selected image chosen in OpenDialog into Memory stream first and then into Bitmap and then it saves the image into GIF format.
procedure TForm1.Button1Click(Sender: TObject);
var Bitmap: FMX.Graphics.TBitmap;
MS: TMemoryStream;
begin
if OpenDialog1.Execute then
begin
MS := TMemoryStream.Create;
MS.LoadFromFile(OpenDialog1.FileName);
Bitmap := FMX.Graphics.TBitmap.Create;
Bitmap.LoadFromStream(MS);
Bitmap.SaveToFile('D:\Proba.gif');
end;
end;
As you can see you only need just a few lines and you get ability to convert images between all supported formats.
You can see which ones are supported here:
http://docwiki.embarcadero.com/Libraries/XE8/en/FMX.Graphics.TBitmapCodecManager#Supported_Image_Formats
Just make sure you are indeed using FMX.Graphics.TBitmap by specifying the full namespace for the file in which it resided.
NOTE: Working on VCL application does not mean you can't use some of the functionality that is present in Fire Monkey.
How can I get all the exported functions from a DLL, programmatically? I am trying to compare two DLL's for exported functions.
This is the code that I use:
uses
System.Classes, Winapi.Windows;
type
PIMAGE_NT_HEADERS = ^IMAGE_NT_HEADERS;
PIMAGE_EXPORT_DIRECTORY = ^IMAGE_EXPORT_DIRECTORY;
function ImageNtHeader(Base: Pointer): PIMAGE_NT_HEADERS; stdcall; external 'dbghelp.dll';
function ImageRvaToVa(NtHeaders: Pointer; Base: Pointer; Rva: ULONG; LastRvaSection: Pointer): Pointer; stdcall; external 'dbghelp.dll';
procedure EnumerateImageExportedFunctionNames(const ImageName: string; NamesList: TStrings);
var
i: Integer;
FileHandle: THandle;
ImageHandle: THandle;
ImagePointer: Pointer;
Header: PIMAGE_NT_HEADERS;
ExportTable: PIMAGE_EXPORT_DIRECTORY;
NamesPointer: Pointer;
NamesPtr: PCardinal;
NamePtr: PAnsiChar;
begin
//NOTE: our policy in this procedure is to exit upon any failure and return and empty list
NamesList.Clear;
FileHandle := CreateFile(
PChar(ImageName),
GENERIC_READ,
FILE_SHARE_READ,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0
);
if FileHandle=INVALID_HANDLE_VALUE then begin
exit;
end;
Try
ImageHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
if ImageHandle=0 then begin
exit;
end;
Try
ImagePointer := MapViewOfFile(ImageHandle, FILE_MAP_READ, 0, 0, 0);
if not Assigned(ImagePointer) then begin
exit;
end;
Try
Header := ImageNtHeader(ImagePointer);
if not Assigned(Header) then begin
exit;
end;
if Header.Signature<>$00004550 then begin // "PE\0\0" as a DWORD.
exit;
end;
ExportTable := ImageRvaToVa(Header, ImagePointer, Header.OptionalHeader.DataDirectory[0].VirtualAddress, nil);
if not Assigned(ExportTable) then begin
exit;
end;
NamesPtr := ImageRvaToVa(Header, ImagePointer, Cardinal(ExportTable.AddressOfNames), nil);
if not Assigned(NamesPtr) then begin
exit;
end;
for i := 0 to ExportTable.NumberOfNames-1 do begin
NamePtr := ImageRvaToVa(Header, ImagePointer, NamesPtr^, nil);
if not Assigned(NamePtr) then begin
exit;
end;
NamesList.Add(NamePtr);
inc(NamesPtr);
end;
Finally
UnmapViewOfFile(ImagePointer); // Ignore error as there is not much we could do.
End;
Finally
CloseHandle(ImageHandle);
End;
Finally
CloseHandle(FileHandle);
End;
end;
I came here to find a way to list all functions contained within an ocx (which is basically a dll). All infos here didn't give me what I was looking for. But then I found the free dllexp.exe from nirsoft (https://www.nirsoft.net/utils/dll_export_viewer.html).
Direct download link: https://www.nirsoft.net/packages/progtools.zip which perfectly shows all exported functions of a dll/ocx and is very user-friendly.
I need to access binary image data using XMLHttpRequest in Delphi. I am using the following code but its not working, could someone please tell me what's wrong with this code, thanks in advance.
//I am using this function to get Image Binary data into Memory Stream.
procedure SendGETRequest(p_Url: string; p_resStream: TMemoryStream);
begin
FXmlHttpReq.open(METHOD_GET, p_Url, false, FUsername, FPassword);
FXmlHttpReq.setRequestHeader(HTTP_AUTHENTICATION, HTTP_BASIC + EncodeBase64(
FUsername + ':'+FPassword));
FXmlHttpReq.setRequestHeader(HTTP_CACHE_CONTROL, HTTP_NO_CACHE);
//FXmlHttpReq.setRequestHeader('Content-type','application/octet-stream');
FXmlHttpReq.send('');
if not VarIsEmpty(FXmlHttpReq.responseBody) then
begin
p_resStream:= OleVariantToMemoryStream(FXmlHttpReq.responseStream);
end;//if...
end;
function OleVariantToMemoryStream(OV: OleVariant): TMemoryStream;
var
Data: PByteArray;
Size: integer;
begin
Result := TMemoryStream.Create;
try
Size := VarArrayHighBound (OV, 1) - VarArrayLowBound(OV, 1) + 1;
Data := VarArrayLock(OV);
try
Result.Position := 0;
Result.WriteBuffer(Data^, Size);
finally
VarArrayUnlock(OV);
end;
except
Result.Free;
Result := nil;
end;
end;
responseStream is IStream. You need to convert it using TOleStream (AxCtrls):
uses AxCtrls, ComObj, ActiveX;
procedure TForm1.Button1Click(Sender: TObject);
var
oXMLHTTP: OleVariant;
MemoryStream: TMemoryStream;
Stream: IStream;
OleStream: TOleStream;
begin
oXMLHTTP := CreateOleObject('MSXML2.XMLHTTP.3.0');
oXMLHTTP.open('GET', 'https://www.google.com/images/srpr/logo11w.png', False);
oXMLHTTP.send(EmptyParam);
Stream := IUnknown(oXMLHTTP.ResponseStream) as IStream;
OleStream := TOleStream.Create(Stream);
try
OleStream.Position := 0;
MemoryStream := TMemoryStream.Create;
try
MemoryStream.CopyFrom(OleStream, OleStream.Size);
MemoryStream.SaveToFile('logo11w.png');
finally
MemoryStream.Free;
end;
finally
OleStream.Free;
end;
end;