You've already forked lazarus-ccr
fpbrowser: Adds GIF support for the ipro viewer
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2107 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -7,6 +7,8 @@ interface
|
|||||||
uses
|
uses
|
||||||
Classes, SysUtils, Graphics, Forms, Controls,
|
Classes, SysUtils, Graphics, Forms, Controls,
|
||||||
//
|
//
|
||||||
|
fpreadgif, fpimage, fpwritebmp,
|
||||||
|
//
|
||||||
browserviewer,
|
browserviewer,
|
||||||
//
|
//
|
||||||
IPHtml, Ipfilebroker, IpMsg;
|
IPHtml, Ipfilebroker, IpMsg;
|
||||||
@ -100,20 +102,56 @@ procedure TiProViewer.DataProvider1GetImage(Sender: TIpHtmlNode; const URL: stri
|
|||||||
var Picture: TPicture);
|
var Picture: TPicture);
|
||||||
var
|
var
|
||||||
lStream: TMemoryStream = nil;
|
lStream: TMemoryStream = nil;
|
||||||
|
lConvertedStream: TMemoryStream = nil;
|
||||||
lStr: String;
|
lStr: String;
|
||||||
|
//
|
||||||
|
image: TFPCustomImage;
|
||||||
|
reader: TFPCustomImageReader;
|
||||||
|
writer: TFPCustomImageWriter;
|
||||||
|
lAbsURL: String;
|
||||||
begin
|
begin
|
||||||
WriteLn('TformBrowser.DataProvider1GetImage ',URL);
|
WriteLn('TformBrowser.DataProvider1GetImage URL=', URL);
|
||||||
lStr := ExtractFileExt(URL);
|
|
||||||
|
// Corrections of the URL
|
||||||
|
if (URL[1] = '/') and (URL[2] = '/') then lAbsURL := 'http:' + URL;
|
||||||
|
|
||||||
|
WriteLn('TformBrowser.DataProvider1GetImage Corrected URL=', lAbsURL);
|
||||||
|
|
||||||
|
lStr := ExtractFileExt(lAbsURL);
|
||||||
if (lStr = '.jpeg') or (lStr = '.jpg') then
|
if (lStr = '.jpeg') or (lStr = '.jpg') then
|
||||||
begin
|
begin
|
||||||
try
|
try
|
||||||
MyPageLoader.LoadBinaryResource(URL, lStream);
|
MyPageLoader.LoadBinaryResource(lAbsURL, lStream);
|
||||||
|
lStream.Position := 0;
|
||||||
Picture := TPicture.Create;
|
Picture := TPicture.Create;
|
||||||
Picture.Jpeg.LoadFromStream(lStream);
|
Picture.Jpeg.LoadFromStream(lStream);
|
||||||
finally
|
finally
|
||||||
lStream.Free
|
lStream.Free
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
|
else if (lStr = '.gif') then
|
||||||
|
begin
|
||||||
|
WriteLn('TformBrowser.DataProvider1GetImage Processing GIF');
|
||||||
|
try
|
||||||
|
MyPageLoader.LoadBinaryResource(lAbsURL, lStream);
|
||||||
|
lStream.Position := 0;
|
||||||
|
Picture := TPicture.Create;
|
||||||
|
Image := TFPMemoryImage.Create(10, 10);
|
||||||
|
Reader := TFPReaderGIF.Create;
|
||||||
|
Image.LoadFromStream(lStream, Reader);
|
||||||
|
Writer := TFPWriterBMP.Create;
|
||||||
|
lConvertedStream := TMemoryStream.Create;
|
||||||
|
Image.SaveToStream(lConvertedStream, Writer);
|
||||||
|
lConvertedStream.Position:=0;
|
||||||
|
Picture.Bitmap.LoadFromStream(lConvertedStream);
|
||||||
|
finally
|
||||||
|
lStream.Free;
|
||||||
|
image.Free;
|
||||||
|
reader.Free;
|
||||||
|
writer.Free;
|
||||||
|
lConvertedStream.Free;
|
||||||
|
end;
|
||||||
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
WriteLn('TformBrowser.DataProvider1GetImage Unsupported format: ', lStr);
|
WriteLn('TformBrowser.DataProvider1GetImage Unsupported format: ', lStr);
|
||||||
|
Reference in New Issue
Block a user