(Да это довольно старая версия лазаруса но в принципе вполне рабочая )


Зы
Пересобрал 64-х разрядную версию там такого дампа нет .
(правда там https не читает через fphttpclient )
Модератор: Модераторы
Const
CacheMode:boolean=True;
function LoadAndScaleImage(const URLOrFilePath: string; const TargetWidth, TargetHeight: Integer): TBitmap;
var
Bitmap,B: TBitmap;
JPEGImage: TFPCustomImage;
HTTPClient: TFPHttpClient;
CachePath: string;
CacheFilename: string;
MST, MemoryStream: TMemoryStream;
FCanvas : TFPcustomCAnvas ;
writer : TFPCustomImageWriter;
begin
Result := nil;
Bitmap := TBitmap.Create;
try
// Кэширование: проверяем, есть ли файл в кэше
CachePath := ExtractFilePath( ExpandFileName(ParamStr(0)));
CacheFilename := CachePath + ExtractFileName(URLOrFilePath);
JPEGImage := TFPMemoryImage.create(0,0);
//if ExtractFileExt( URLOrFilePath )<>'jpg' then exit;
// Загрузка из интернета или файла
if CacheMode and FileExists(CacheFilename) then
begin
JPEGImage.LoadFromFile(CacheFilename);
end
else
begin
if Pos('http', LowerCase(URLOrFilePath)) = 1 then
begin
HTTPClient := TFPHttpClient.Create(nil);
try
MemoryStream := TMemoryStream.Create;
try
HTTPClient.Get(URLOrFilePath, MemoryStream);
MemoryStream.Position := 0;
JPEGImage. LoadFromStream(MemoryStream);
finally
MemoryStream.Free;
end
except
FreeAndNil(Bitmap);
HTTPClient.Free;
exit;
end;
HTTPClient.Free;
end
else
begin
// Bitmap
JPEGImage.LoadFromFile(URLOrFilePath);
end;
// Сохраняем в кэш
if Pos('http', LowerCase(URLOrFilePath)) = 1 then
JPEGImage.SaveToFile(CacheFilename);
end;
Bitmap.SetSize(TargetWidth, TargetHeight);
B := Bitmap;
//Конверсия в Bitmap
FCanvas := TFPImageCanvas.Create (JPEGImage);
Writer := TFPWriterBMP.Create;
MST:=TMemoryStream.Create;
Writer.ImageWrite(Mst,JPEGImage);
Writer.Free;
MST.Seek(0,soBeginning);
b.LoadFromStream(MST);
Mst.Free;
Bitmap:=ScaleNN(B,TargetWidth, TargetHeight);b.Free;
//Bitmap.Canvas.StretchDraw( Rect(0,0,TargetWidth-1, TargetHeight-1),B);
FCanvas .Free;
except
FreeAndNil(Bitmap);
end;
JPEGImage.Free;
Result := Bitmap;
end;
Const
L:Tlist=nil;
...
Begin
...
if L=Nil then L:=Tlist.Create
else
For I:=0 to L.Count-1 do
TBitmap(L[I]).Free;
Тест загрузки списка
Однопоточный
Время 15,60 c
Тест загрузки списка
Многопоточный
Время 4,84 c
Тест загрузки списка
Однопоточный
Время 27,69 c
Тест загрузки списка
Многопоточный
Время 4,40 c
Alex2013 писал(а):(правда там https не читает через fphttpclient
Ichthyander писал(а):Прокомментирую только это: очень похоже на то, что не установлены (или не добавлены в соответствующую папку) 64 битные библиотеки OpenSSL. То есть установлены 32-битные. Нужно именно 64 битные установить
Тест загрузки списка 1
Однопоточный
Время 18,13 c
Тест загрузки списка 1
Многопоточный
Время 6,00 c
Тест загрузки списка 2
Однопоточный
Время 12,56 с
Тест загрузки списка 2
Многопоточный
Время 4,34 c
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 8