Спасибо создателям за такой супер сайт!!!!! И соответсвенно людям которые тратят свое драгоценное время на помощь более неопытным прогамистов!!!!
Не один раз вы меня выручали. :))
Даже и не думал что когда нибудь я тоже буду задавать здесь вопрос, но появилась проблема которую не могу решить. Искал и на королевстве и в гугле - не нашел решения.
Поблема вот в чем:
Мне нужно отобразить несколько десятков .jpg фалов на форме в уменьшенном варианте. Чтото наподобие Thumbnails в Explorere. Все нормально при маленких jpg'шках. Но.... у клиента есть файлы более 4мб и их несколько десятков. При загрузки ОДНОГО 4мб jpg в память программа раздувается до 60мб!!!!!!!!! Что непримленно много. И рисуется такой файл на форме где-то 4 секунды!!!! А в Windows Explorer все 30 файлов рисуются за секунды. Как мне быть???
Я использую стандартные средства (TJPEGImage, TImage.StretchDraw). Пробовал FastFiles, FastDIB но там нужна какая-то библиотека "ijl15.dll". Подумал использовать DirectX но не знаю если поможет.
Может кто нибудь сталкивался с такой проблемой если нет хотябы подскажите в каком направлении искать. Буду очень благодарен!!!!
Уважаемые авторы вопросов! Большая просьба сообщить о результатах решения проблемы на этой странице. Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.
11-05-2007 00:23 | Комментарий к предыдущим ответам
DIBNeeded действительно всё ускоряет, но сам по себе медленный, как бы его ускорить вот его код
procedure TJPEGImage.DIBNeeded;
begin
GetBitmap;
end;
function TJPEGImage.GetBitmap: TBitmap;
var
LinesPerCall, LinesRead: Integer;
{$IFDEF JPEGSO}
DestScanLine, CurPixel: PChar;
Swap: Char;
AWidth: Integer;
{$ELSE}
DestScanLine: PChar;
{$ENDIF}
PtrInc: Integer;
jc: TJPEGContext;
GeneratePalette: Boolean;
begin
Result := FBitmap;
if Result <> nil then Exit;
if (FBitmap = nil) then FBitmap := TBitmap.Create;
Result := FBitmap;
GeneratePalette := True;
InitDecompressor(Self, jc);
try
try
// Set the bitmap pixel format
FBitmap.Handle := 0;
if (PixelFormat = jf8Bit) or (jc.d.out_color_space = JCS_GRAYSCALE) then
FBitmap.PixelFormat := pf8bit
else
FBitmap.PixelFormat := pf24bit;
Progress(Self, psStarting, 0, False, Rect(0,0,0,0), '');
try
if (FTempPal <> 0) then
begin
if (FPixelFormat = jf8Bit) then
begin // Generate DIB using assigned palette
BuildColorMap(jc.d, FTempPal);
FBitmap.Palette := CopyPalette(FTempPal); // Keep FTempPal around
GeneratePalette := False;
end
else
begin
DeleteObject(FTempPal);
FTempPal := 0;
end;
end;
jpeg_start_decompress(jc.d);
// Set bitmap width and height
with FBitmap do
begin
Handle := 0;
Width := jc.d.output_width;
Height := jc.d.output_height;
DestScanline := ScanLine[0];
PtrInc := Integer(ScanLine[1]) - Integer(DestScanline);
if (PtrInc > 0) and ((PtrInc and 3) = 0) then
// if no dword padding is required and output bitmap is top-down
LinesPerCall := jc.d.rec_outbuf_height // read multiple rows per call
else
LinesPerCall := 1; // otherwise read one row at a time
end;
if jc.d.buffered_image then
begin // decode progressive scans at low quality, high speed
while jpeg_consume_input(jc.d) <> JPEG_REACHED_EOI do
begin
jpeg_start_output(jc.d, jc.d.input_scan_number);
// extract color palette
if (jc.common.progress^.completed_passes = 0) and (jc.d.colormap <> nil)
and (FBitmap.PixelFormat = pf8bit) and GeneratePalette then
begin
FBitmap.Palette := BuildPalette(jc.d);
PaletteModified := True;
end;
DestScanLine := FBitmap.ScanLine[0];
while (jc.d.output_scanline < jc.d.output_height) do
begin
LinesRead := jpeg_read_scanlines(jc.d, @DestScanline, LinesPerCall);
{$IFDEF JPEGSO}
if PixelFormat = jf24bit then
begin
CurPixel := DestScanLine;
AWidth := FBitmap.Width;
while (CurPixel - DestScanLine) < (AWidth * 3) do
begin
Swap := CurPixel[0];
CurPixel[0] := CurPixel[2];
CurPixel[2] := Swap;
Inc(CurPixel, 3);
end;
end;
{$ENDIF}
Inc(Integer(DestScanline), PtrInc * LinesRead);
end;
jpeg_finish_output(jc.d);
end;
// reset options for final pass at requested quality
jc.d.dct_method := jc.FinalDCT;
jc.d.dither_mode := jc.FinalDitherMode;
if jc.FinalTwoPassQuant then
begin
jc.d.two_pass_quantize := True;
jc.d.colormap := nil;
end;
jpeg_start_output(jc.d, jc.d.input_scan_number);
DestScanLine := FBitmap.ScanLine[0];
end;
// build final color palette
if (not jc.d.buffered_image or jc.FinalTwoPassQuant) and
(jc.d.colormap <> nil) and GeneratePalette then
begin
FBitmap.Palette := BuildPalette(jc.d);
PaletteModified := True;
DestScanLine := FBitmap.ScanLine[0];
end;
// final image pass for progressive, first and only pass for baseline
while (jc.d.output_scanline < jc.d.output_height) do
begin
LinesRead := jpeg_read_scanlines(jc.d, @DestScanline, LinesPerCall);
{$IFDEF JPEGSO}
if PixelFormat = jf24bit then
begin
CurPixel := DestScanLine;
AWidth := FBitmap.Width;
while (CurPixel - DestScanLine) < (AWidth * 3) do
begin
Swap := CurPixel[0];
CurPixel[0] := CurPixel[2];
CurPixel[2] := Swap;
Inc(CurPixel, 3);
end;
end;
{$ENDIF}
Inc(Integer(DestScanline), PtrInc * LinesRead);
end;
if jc.d.buffered_image then jpeg_finish_output(jc.d);
jpeg_finish_decompress(jc.d);
finally
if ExceptObject = nil then
PtrInc := 100
else
PtrInc := 0;
Progress(Self, psEnding, PtrInc, PaletteModified, Rect(0,0,0,0), '');
// Make sure new palette gets realized, in case OnProgress event didn't.
if PaletteModified then
Changed(Self);
end;
except
on EAbort do ; // OnProgress can raise EAbort to cancel image load
end;
finally
ReleaseContext(jc);
end;
end;
29-08-2006 05:31 | Комментарий к предыдущим ответам
Здравствуйте,
Очень интересно было найти именно то, над чем в данный момент работаю: делаю компонент для thumbnail.
Хотел поделится кодом, может у кого будут замечания или критика :-)
Загружал Thumbnail разными путями:
- с exif (dExif)
- с помощью Gr32 (Graphicd32 lib)
- нашёл в этом форуме ответ Python'а - намного быстрее.
- с потоком также пробовал - добавил в компонент, но столкнулся с такой проблемой: когда на форме 50 компонентов для изображения thumbnails, тогда используется много памяти (600 Мб). Решил убрать поток с компонента и добавит в компонент parent - контейнер, содержащий все preview.
Буду благодарен за Ваши замечания.
С уважением,
Олег
код:
{
Source Name: PreviewItem
Description: component to display preview of an image
Copyright (C) Oleh Lozynskyy <oleh.lozynskyy...at... ask me>
SetBkMode(MemoryBitmap.Canvas.Handle, windows.TRANSPARENT);
if FMouseOver then
if FActive then
memoryBitmap.Canvas.Brush.Color := Darker(FActiveColor, 10)
else memoryBitmap.Canvas.Brush.Color := Lighter(FInActiveColor, 10)
else if FActive then memoryBitmap.Canvas.Brush.Color := FActiveColor
else memoryBitmap.Canvas.Brush.Color := FInActiveColor;
memoryBitmap.PixelFormat := pf32bit;
memoryBitmap.Canvas.FillRect(ClientRect);
except
ShowMessage('in the begining');
end;
try
if FSelected then begin
memoryBitmap.Canvas.Pen.Width := FBorderWidth;
if FMouseOver then
if FActive then
memoryBitmap.Canvas.pen.Color := Lighter(FSelectedColor, 40)
else memoryBitmap.Canvas.pen.Color := Darker(FInActiveColor, 10)
else if FActive then
memoryBitmap.Canvas.pen.Color := FSelectedColor
else memoryBitmap.Canvas.pen.Color := FInActiveColor;
// Draw Border
{if not( FBorderStyle = tbsNone ) then begin
if not(FSelected) then begin
memoryBitmap.Canvas.pen.Color := FBorderColor;
memoryBitmap.Canvas.Brush.Color := FColor;
end
else begin
memoryBitmap.Canvas.pen.Color := FSelectedBorderColor;
memoryBitmap.Canvas.Brush.Color := FSelectedColor;
end;
if FBorderStyle = tbsRoundedRect then begin
memoryBitmap.Canvas.RoundRect(ClientRect.Left, ClientRect.Top,
ClientRect.Right, ClientRect.Bottom, 14, 14);
end
else begin
memoryBitmap.Canvas.Rectangle(ClientRect.Left, ClientRect.Top,
ClientRect.Right, ClientRect.Bottom);
end;
end; }
except
ShowMessage('error drawing border');
end;
try
// thumbnail
if Assigned(FOriBmpImage) then begin
if not(FActive) then begin
BlendBmp(FOriBmpImage, FBmpImage, lighter(FInActiveBlendColor,50));
//FBmpImage.Assign(FOriBmpImage); // but grey or inactive
end
else FBmpImage.Assign(FOriBmpImage);
// Copy memoryBitmap to screen
try
canvas.CopyRect(ClientRect, memoryBitmap.canvas, ClientRect);
except
ShowMessage('bitmap is not copied to canvas');
end;
finally
if assigned(memorybitmap) then
memoryBitmap.Free;
end;
except
ShowMessage('generic error');
end;
end;
procedure TPreviewItem.ReadPreview;
var
iRez: Integer;
aFile: PChar;
h,w: Integer;
begin
// if filename doesn't exists - leave
if not FileExists(FFilename) then exit;
// implement DLL to get thumbnails - done
if not Assigned(FOriBmpImage) then
FOriBmpImage := TBitmap.Create;
if not Assigned(FBmpImage) then
FBmpImage := TBitmap.Create;
// load DLL
FDllHandle := LoadLibrary('ppPreview.dll');
if FDllHandle <> 0 then
begin
try
@Ffx_GetBmpPreview := GetProcAddress(FDllHandle, 'GetBmpPreviewFromFile');
// Call function
GetMem(aFile,Length(FFilename) + 1);
StrCopy(aFile, PChar(FFilename));
// get Thumbnail from Dll
iRez := Ffx_GetBmpPreview(aFile, FOriBmpImage);
// free mem
FreeMem(aFile);
except
// if some problems with dll occured
GeneratePreview(FFilename, 120, FOriBmpImage);
end;
try
FreeLibrary(FDllHandle);
finally
FDllHandle := 0;
end;
end
else begin
// create preview in default way
// GeneratePreview(FFilename, 120, FOriBmpImage);
procedure TPreviewItem.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
FMouseOver := True;
Invalidate;
end;
procedure TPreviewItem.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
FMouseOver := False;
Invalidate;
end;
function TPreviewItem.Lighter(AValue: TColor; APercent: Byte): TColor;
var
rgbColor: TColor;
r, g, b: Byte;
r2, g2, b2: Byte;
begin
rgbColor := ColorToRGB(AValue);
r := GetRValue(rgbColor);
g := GetGValue(rgbColor);
b := GetBValue(rgbColor);
r2 := r + muldiv(255 - r, APercent, 100);
if r2 < r then
r2 := 255;
g2 := g + muldiv(255 - g, APercent, 100);
if g2 < g then
g2 := 255;
b2 := b + muldiv(255 - b, APercent, 100);
if b2 < b then
b2 := 255;
result := RGB(r2, g2, b2);
end;
function TPreviewItem.Darker(AValue: TColor; APercent: Byte): TColor;
var
rgbColor: TColor;
r, g, b: Byte;
r2, g2, b2: Byte;
begin
rgbColor := ColorToRGB(AValue);
r := GetRValue(rgbColor);
g := GetGValue(rgbColor);
b := GetBValue(rgbColor);
r2 := r - muldiv(r, APercent, 128);
if r2 > r then
r2 := 0;
g2 := g - muldiv(g, APercent, 128);
if g2 > g then
g2 := 0;
b2 := b - muldiv(b, APercent, 128);
if b2 > b then
b2 := 0;
result := RGB(r2, g2, b2);
end;
procedure TPreviewItem.DbLCLick;
begin
inherited;
// todo for DoubleClick
end;
procedure TPreviewItem.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Button = mbLeft then begin
// If Left btn pressed
if assigned(FOnItemSelect) then
FOnItemSelect(Self);
end
else if Button = mbRight then begin
if assigned(FOnItemSelect) then
FOnItemSelect(Self);
//BuildMenu(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
end;
procedure TPreviewItem.SetActive(AValue: Boolean);
begin
if (FActive <> AValue) then begin
FActive := AValue;
Invalidate;
end;
end;
procedure TPreviewItem.SetActiveColor(AValue: TColor);
begin
if (FActiveColor <> AValue) then
begin
FActiveColor := AValue;
Invalidate;
end;
end;
procedure TPreviewItem.SetFilename(AValue: String);
begin
if (FFilename <> AValue) then
begin
FFilename := AValue;
ReadPreview;
Invalidate;
end;
end;
procedure TPreviewItem.SetInActiveColor(AValue: TColor);
begin
if (FInActiveColor <> AValue) then
begin
FInActiveColor := AValue;
Invalidate;
end;
end;
procedure TPreviewItem.SetInActiveBlendColor(AValue: TColor);
begin
if (FInActiveBlendColor <> AValue) then
begin
FInActiveBlendColor := AValue;
Invalidate;
end;
end;
procedure TPreviewItem.SetSize(AValue: Integer);
begin
if (FSize <> AValue) then begin
FSize := AValue;
Invalidate;
end;
end;
procedure TPreviewItem.SetSelected(AValue: Boolean);
begin
if (FSelected <> AValue) then begin
FSelected := AValue;
Invalidate;
end;
end;
procedure TPreviewItem.SetSelectedColor(AValue: TColor);
begin
if (FSelectedColor <> AValue) then
begin
FSelectedColor := AValue;
Invalidate;
end;
end;
procedure TPreviewItem.BlendBmp(source, Dest: TBitmap; color: TColor);
var
P: PColor32;
X, Y, res: integer;
red, alpha: byte;
c: TColor;
dst32, src32: TBitmap32;
begin
dst32 := TBitmap32.Create;
src32 := TBitmap32.Create;
src32.Assign(source);
//Dest.assign(source);
dst32.SetSize(src32.Width, src32.Height);
src32.DrawTo(dst32);
dst32.Font.Name := src32.Font.Name;
dst32.Font.Size := src32.Font.Size;
dst32.Font.Style := src32.Font.Style;
dst32.Font.Color := src32.Font.Color;
dst32.DrawMode := src32.DrawMode;
dst32.CombineMode := src32.CombineMode;
with dst32 do
begin
P := PixelPtr[0, 0];
for Y := 0 to Height - 1 do
begin
for X := 0 to Width - 1 do
begin
alpha := (P^ shr 24);
red := (P^ and $00FF0000) shr 16;
res := red - 178;// 128;
if (res < 0) then
c := Darker(color, -res)
else
if (res > 0) then
c := Lighter(color, res)
else
c := color;
P^ := color32(GetRValue(c), GetGValue(c), GetBValue(c), alpha);
inc(P); // proceed to the next pixel
end;
end;
end;
Dest.Assign(dst32);
dst32.Free;
src32.Free;
end;
// helper function to get thumbnails using Graphics32 lib
function TPreviewItem.GeneratePreview(AFilename: String;
AThumbWidth: Integer; var aBmp: TBitmap): Integer;
var
bmpSrc, bmpDst: TBitmap32;
AT: TAffineTransformation;
sScale: Single;
begin
//ShowMessage('Loading preview with Gr32.');
try
bmpSrc := TBitmap32.Create();
bmpDst := TBitmap32.Create();
AT := TAffineTransformation.Create;
procedure TPreviewItem.CountOnMaxXSize(h1, w1, side: integer; var h2,
w2: integer);
begin
if (h1 > w1) then begin
h2 := side;
w2 := ceil( min (h1,w1) * side / max (h1,w1) );
end
else begin
h2 := ceil (min (h1,w1) * side / max (h1,w1) );
w2 := side;
end;
end;
procedure TPreviewItem.CleanPreview;
begin
with Self do
begin
Clear;
Height := FSize;
Width := FSize;
FSelected := False;
end;
end;
function TPreviewItem.GetPreviewFromJpeg(AFilename: String;
AThumbWidth: Integer; var aBmp: TBitmap): Integer;
var
jpg: TJpegImage;
Rect: TRect;
begin
// code by Python
// from: http://www.delphikingdom.com/asp/answer.asp?IDAnswer=39689
jpg := TJpegImage.Create;
try
jpg.Smoothing := False;
jpg.Performance := jpBestSpeed;
jpg.LoadFromFile(AFilename);
if (jpg.Width > jpg.Height) then
if (jpg.Width >= AThumbWidth div 4) then jpg.Scale := jsHalf
else if (jpg.Width >= AThumbWidth div 2) then jpg.Scale := jsQuarter
else if (jpg.Width >= AThumbWidth) then jpg.Scale := jsEighth
else jpg.Scale := jsFullSize
else if jpg.Height>=AThumbWidth div 4 then jpg.Scale := jsHalf
else if jpg.Height>=AThumbWidth div 2 then jpg.Scale := jsQuarter
else if jpg.Height >= AThumbWidth then jpg.Scale := jsEighth
else jpg.Scale := jsFullSize;
if (jpg.Width/AThumbWidth > jpg.Height / AThumbWidth)then begin
aBmp.Width := AThumbWidth;
aBmp.Height := round(jpg.Height/jpg.Width*AThumbWidth);
end
else begin
aBmp.Height := AThumbWidth;
aBmp.Width := round(jpg.Width/jpg.Height*AThumbWidth);
end;
Rect.Left := 0;
Rect.Top := 0;
Rect.Right := aBmp.Width;
Rect.Bottom := aBmp.Height;
aBmp.Canvas.StretchDraw(Rect,jpg);
finally
jpg.Free;
end;
end;
{
using dEXIF - Copyright 2001-2004, Gerry McGuire
function TPreviewItem.GetPreviewFromExif(AFilename: String;
AThumbWidth: Integer; var aBmp: TBitmap): Integer;
var
jpegThumb: TJpegImage;
noThumbnailInline: Boolean;
ImgData: TimgData;
begin
// using dEXIF - Copyright 2001-2004, Gerry McGuire
try
// try to get preview from Exif inline
noThumbnailInline := True;
ImgData := TimgData.Create;
try
ImgData.BuildList := GenAll; // on by default anyway
ImgData.ProcessFile(AFilename);
if ImgData.HasThumbnail then
begin
ImgData.ExifObj.ProcessThumbnail;
try
// save it
jpegThumb := imgData.ExtractThumbnailJpeg();
Спасибо за код но я уже разобрался с потоками.
Я создал отдельный поток который для начала рисует стандартную иконку для каждого файла потом по мере загрузки заменяет иконку на thumbnail. Это очень удобно.
У меня он кеширует thumbnail'ы, релизован останов потока когда пользователь закрывает форму или нажимает на reload итд.
То что мне удалось разузнать:
- можно вытаскивать встроенные thumbnail'ы которые цифровые фотокамеры записывают в EXIF заголовке JPEG файла. http://mcguirez.homestead.com/downloads.html
- можно загрузить JPEG с ProgressiveDisplay := True. Так можно прочитать только часть файла и нарисовать его. Получится та же изображение только с низким разрешением. Проблема в том что ProgressiveEncode уже мало где используется.
- испробовал даже Pegasus Imaging библиотеку для работы с JPEG, её ACDSee использует, и заметил лишь очень малый прирост в производительности :(
Спасибо всем кто помог мне.
К слову, подумываю чтобы написать статью об использовании потоков для начинающих.
>>> после загрузки 30 jpeg'ов программа раздувается до 500мб
Не знаю, вот реализовал что-то похожее. Работает, конечно, не быстро, но приемлимо. На 2000 (чуть поменьше) файлов суммарным размером 90 Мб тратит 8-10 секунд (в зависимости видимо от нагрузки процессора, действий пользователя и фазы луны). Но во время загрузки пользователь уже может выполнять просмотр уже загруженных картинок. Конечно, алгоритм сырой (если пользователь переключился на какую-то картинку, то надо раздобыть сначала ее, Thumbnail не кешируются ну и прочие недоработки). Но за базу для тебя (да и других посетитителей этого вопроса) вполне сойдет.
DFM:
object Loader: TLoader
Left = 192
Top = 116
BorderStyle = bsDialog
Caption = 'Картиночник'
ClientHeight = 203
ClientWidth = 308
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 8
Width = 89
Height = 13
Caption = 'Откуда картинки:'
end
object Prev: TImage
Left = 96
Top = 36
Width = 105
Height = 105
end
object Path: TEdit
Left = 104
Top = 4
Width = 169
Height = 21
ReadOnly = True
TabOrder = 0
end
object Br: TButton
Left = 280
Top = 4
Width = 21
Height = 21
Caption = '...'
TabOrder = 1
OnClick = BrClick
end
object Pred: TButton
Left = 64
Top = 152
Width = 75
Height = 25
Caption = '< Назад'
Enabled = False
TabOrder = 2
OnClick = PredClick
end
object Next: TButton
Left = 160
Top = 152
Width = 75
Height = 25
Caption = 'Вперед >'
Enabled = False
TabOrder = 3
OnClick = PredClick
end
object Prog: TProgressBar
Left = 0
Top = 186
Width = 308
Height = 17
Align = alBottom
Min = 0
Max = 100
Smooth = True
TabOrder = 4
end
end
procedure TLoader.FormCreate(Sender: TObject);
begin
SetLength(Preview,0);Cur:=0;LoadThread:=nil;
Pred.Enabled:=false;Next.Enabled:=false;
end;
procedure TLoader.FormDestroy(Sender: TObject);
var I:integer;
begin
For I:=0 to High(Preview) do Preview[I].Free;
SetLength(Preview,0);
Pred.Enabled:=false;Next.Enabled:=false;
FreeAndNil(LoadThread);
end;
procedure TLoader.BrClick(Sender: TObject);
var S:string;
begin
Br.Enabled:=false;
S:=Path.Text;
if SelectDirectory('Выберите каталог:','',S) then begin
FreeAndNil(LoadThread);
Path.Text:=S;FormDestroy(Sender);CurMax:=0;Cur:=0;
Prog.Position:=0;
Caption:='Загрузка...';
Time:=GetTickCount;
LoadThread:=TLoadThread.Create(Handle,S,@Preview,Prev.Width,Prev.Height);
end;
Br.Enabled:=true;
end;
procedure TLoader.GetStatus(var M: TMessage);
begin
if M.WParam=0 then Prog.Max:=M.LParam;
Prog.Position:=M.WParam;
CurMax:=M.WParam;
if M.WParam=1 then PredClick(nil);
if M.WParam=M.LParam then begin
Caption:=Format('На загрузку ушло %4.2f секунды',[(GetTickCount-Time)/1000]);
PredClick(nil);
LoadThread:=nil;
end;
end;
procedure TLoadThread.Execute;
var Ji:TJpegImage;
Rct:TRect;
Sr:TSearchRec;
Cnt,Max:cardinal;
begin
Max:=0;
if FindFirst(Path,faAnyFile,Sr)=0 then repeat
Inc(Max);
until FindNext(Sr)<>0;
FindClose(Sr);
SetLength(Preview^,Max);Dec(Max);
For Cnt:=0 to Max do Preview^[Cnt]:=nil;
Ji:=TJpegImage.Create;
Ji.Smoothing:=false;
Ji.Performance:=jpBestSpeed;
Rct.Left:=0;Rct.Top:=0;Cnt:=0;
if FindFirst(Path,faAnyFile,Sr)=0 then try
repeat
Ji.LoadFromFile(Sr.Name);
if Ji.Width>Ji.Height then
if Ji.Width>=pWidth then Ji.Scale:=jsEighth
else if Ji.Width>=pWidth div 2 then Ji.Scale:=jsQuarter
else if Ji.Width>=pWidth div 4 then Ji.Scale:=jsHalf
else Ji.Scale:=jsFullSize
else
if Ji.Height>=pHeight then Ji.Scale:=jsEighth
else if Ji.Height>=pHeight div 2 then Ji.Scale:=jsQuarter
else if Ji.Height>=pHeight div 4 then Ji.Scale:=jsHalf
else Ji.Scale:=jsFullSize;
Preview^[Cnt]:=TBitmap.Create;
if(Ji.Width/pWidth>Ji.Height/pHeight)then begin
Preview^[Cnt].Width:=pWidth;
Preview^[Cnt].Height:=round(Ji.Height/Ji.Width*pHeight);
end else begin
Preview^[Cnt].Height:=pHeight;
Preview^[Cnt].Width:=round(Ji.Width/Ji.Height*pWidth);
end;
Rct.Right:=Preview^[Cnt].Width;
Rct.Bottom:=Preview^[Cnt].Height;
Preview^[Cnt].Canvas.StretchDraw(Rct,Ji);
PostMessage(ParentHandle,WM_STATUS,Cnt,Max);
Inc(Cnt);
until FindNext(Sr)<>0;
finally
FindClose(Sr);
Ji.Free;
end;
end;
После загрузки JPEGа я ставлял Performance=jpBestSpeed, Smoothing=False и Scale=jsEighth. Потом рисовал на форме обычным StretchDraw. Просто я тестировал с большими JPEGами (8Mb) и даже с Scale=jsEighth они занимали очень много памяти.
Сейчас же перед рисованием использую DIBNeeded (скорость рисования повысилась на 20%) рисую с помощью StretchDraw на Bitmap в памяти (уменьшаю изображение)а потом обычным Draw рисую этот Bitmap на форме. Тем самым я сохраняю не оригинальный JPEG а только уменьшенный вариант в Bitmap формате.
Это я сделал после того как отправил последнее сообщение.
Если я делаю чтото не так подскажи. В общем я доволен как работает алгоритм только по сравнению с Windows он работает в 30 раз медленней. :((
- как сделать чтобы картинки занимали меньше места в памяти (сейчс после загрузки 30 jpeg'ов программа раздувается до 500мб :)))
Так вы что картинки не уменьшаете что ли? Прямо через CopyRect на форме рисуете (ну или Stretch у Image стоит)? Если так, то неудивительно, что у вас низкая скорость и даже IJL не помогает. Надо уменьшить картинки до нужного размера сразу после декодирования JPEG-а, тогда объём памяти не должен зависеть от первоначального размера картинки и для Thumb-ов размером 128*80 будет где-то 30Кб на картинку, то есть <1М в вашем случае.
- как определить размер картинки (если картинка маленькая то при Scale=jsEighth она еле различимая)
У IJL есть соответствующий режим, а стандартный TJPEGImage и так декодирует размер картинки, то есть после TJPEGImage.LoadFromFile размер (Width и Height) будет иметь правильное значение, но сама картинка декодирована не будет, а собственно распаковка картинки происходит в момент обращения к DIBNeeded.
Вам надо вызвать LoadFromFile, в зависимости от размеров выставить Scale, вызвать DIBNeeded, перенести картинку на Image c помощью StretchDraw.
to DRON:
Спасибо за помощь!!! Пробовал "ijl15.dll" но скорость как у стандартных средств (TJPEGImage).
Сейчас у меня другие задачи:
- как сделать чтобы картинки занимали меньше места в памяти (сейчс после загрузки 30 jpeg'ов программа раздувается до 500мб :)))
- как определить размер картинки (если картинка маленькая то при Scale=jsEighth она еле различимая)
нельзя ли загружать картинку уменьшенной в 16, 32 раз?
Надо документацию по jpeglib найти и посмотреть какие значения могут принимать scale_num и scale_denom, но думаю, что больше чем 8 не получится.
Посмотрите всё таки "ijl15.dll" (Intel JPEG Library) думаю это наиболее быстрая библиотека (её ACDSee использует).
to DRON:
Спасибо, заработало! Намного быстрей, только есть одно но... Если размер jpg оооооооочень большой (7-10 Mb) все равно медленно, нельзя ли загружать картинку уменьшенной в 16, 32 раз?
to karai2:
Если по другому не получится буду юзать Thread'ы. Хотя ни разу не пробовал :)))
Никто не знает какую-то ссылку по потокам для начинающих??
Поиграйтесь с TJPEGScale, у TJPEGImage есть возможность загружать картинку сразу уменьшенной в 2,4 или 8 раз. Ещё можно Performance=jpBestSpeed и Smoothing=False.
дык винда же подгружает жипеги в фоновом потоке, пока пользователь тупо думает что ж ему дальше делать папкой, куда он зашел. Ну а после подгрузки создает иконочную копию изображения, которую сливает в Thumbs.db, соответственно последующие загрузки происходят ойкак быстро.
Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter. Функция может не работать в некоторых версиях броузеров.
