Search code examples
delphiindy10delphi-xe8idhttp

how to convert idhttp downloaded image from extention to another?


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 ?


Solution

  • 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.