Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Звук, графика и видео > Галерея картинок!

Автор: SultanOFF 22.11.2009, 11:59

Здравствуйте. Есть ли такой компонент с помощью которого можно было бы реализовать галерею картинок? Или кто посоветует как это можно сделать?  Допустим при запуске сканируется папка 'c:\xxx\' на файлы форматов *.png, *.bmp, *.jpg, *.gif. После получения списка картинок на форме создаются image`sы в количестве равном найденным картинкам и в них соответственно загружаются картинки. Но тогда встает вопрос, можно ли так во время открытия создавать Timage в нужном количестве и загружать в них картинки и как это сделать?

Автор: ~FoX~ 22.11.2009, 13:40

Цитата(SultanOFF @  22.11.2009,  12:59 ) Но тогда встает вопрос, можно ли так во время открытия создавать Timage в нужном количестве и загружать в них картинки и как это сделать?  Да сколько угодно... Тока вот если у тебя в галереи 10000 картинок, то это как то не очень хорошо скажется на производительности...  Лучше сделать фиксированное количество имеджей и при скроллинге подгружать в них картинки... Я реализовывал через ListView и прям на его канве при надобности отрисовывал то что надо при помощи GDI+... Получилось быстро, красиво и маштабируемо...

Автор: SultanOFF 22.11.2009, 13:48

Цитата Получилось быстро, красиво и маштабируемо... о вот Мне тоже нужно чтобы масштабировалось!   Цитата реализовывал через ListView и прям на его канве при надобности отрисовывал то что надо при помощи GDI+. это как? Можно подробней? или что было бы вовсе прекрасно примером?  Просто никогда не работал с компонентом ListView...

Автор: ~FoX~ 22.11.2009, 20:43

Ну идея такова... На форму бросаем ImageList и ListView...Связываем их Дальше ищем файлы и заполняем список путей... Код var   TumbPath: TStringList; //глобальный лист //-------------------------- procedure GetPathsToTumbs(Dir: string; ras: string);  //Dir - путь к папке, Ras - соответственно расширение формата ('*.jpg') var   f : TSearchRec;   i : integer;   s : string; begin   i := FindFirst(Dir+ras, faAnyFile, f);   while (i=0) do     begin      s := Dir+f.Name;      TumbPath.Add(s);      i := FindNext(f);      Application.ProcessMessages;     end;   FindClose(f); end; Дальше я создавал пустой список в ЛистеВьюве: Код var //глобальная    TerminateFlag: boolean; //Если флаг поднят, занчит тормазим все что тормазиться... //............................ procedure CreateEmptyItem(); //Создаем пустой список var   ListItem: TListItem;   i: integer; begin   with Form1 do begin     for i := 0 to TumbPath.Count -1 do begin       if TerminateFlag then exit; //Т.к. процесс может быть давольно длительный, при смени фокуса прерываем опирацию....       Application.ProcessMessages;       ListItem := ListView1.Items.Add;       ListItem.Caption := GetDirNameFromPath(TumbPath.Strings[i]); //Здесь просто заполняется капшен итемов именами файлов       ListItem.ImageIndex := -1; //говорим что картинки пока нету     end; //for   end;//with end; Дальше немного сложнее, т.к. я писал это все на GDI+ Код uses GDIPAPI, GDIPOBJ; //....................... procedure FillImg(); var   graphics : TGPGraphics; //основной санвас   Image, pThumbnail: TGPImage; //полная картинка, и тумблс (минисатюра/эскиз) к ней   b: TBitmap; //Это мы будем запихивать в имиджлист   path: string; //путь к файлу   R: TRect; //область   x, y, i: integer; //x,y - для размещения по центру begin   for i:= 0 to TumbPath.Count-1 do begin     if TerminateFlag = true then exit;     Application.ProcessMessages;     b := TBitmap.Create;      b.Width := 130;  //размеры эскизов     b.Height := 130;      graphics := TGPGraphics.Create(b.Canvas.Handle);     try       path := TumbPath[i]; //получаем путь из ранее заполненного списка       Image:= TGPImage.Create(path);       R := GetProportional(Image.GetWidth, Image.GetHeight, 128, 128); //рассчитываем пропорциональную область        pThumbnail := Image.GetThumbnailImage(R.Right, R.Bottom, nil, nil); //получаем миниатюрку       x := Trunc((130-R.Right)/2);   //определяем координаты левого верхнего угла картинки,        y := Trunc((130-R.Bottom)/2); //для размещения по центру       Graphics.SetSmoothingMode(SmoothingModeHighSpeed); //устанавливаем качество сжатия       //Graphics.SetCompositingQuality(CompositingQualityHighSpeed);       Graphics.DrawImage(pThumbnail, x, y, pThumbnail.GetWidth, pThumbnail.GetHeight); //непосредственно рисуем миниатюрку на битмапе      //это просто рисует прямоугольник во круг картинки       b.Canvas.LineTo(0,128);       b.Canvas.LineTo(128,128);       b.Canvas.LineTo(128,-128);       b.Canvas.MoveTo(0,0);       b.Canvas.LineTo(128,0);             Form1.TumbnailsList.Add(b, nil); //добавляем в наш имиджлист полученный маленький битмап       Form1.ListView1.Items[i].ImageIndex := i; //(*) пробегаем по нашему ListViev-у и устанавливаем картинки для нашего пустого списка       finally //не забываем почистица       Image.Free;       b.Free;       pThumbnail.Free;       graphics.Free;     end;   end; end; В общем то за счет использования GDI+ код довольно шустро работает даже на нескольких сотнях файлов, к тому же он адекватно переваривает *.bmp, *.dib, *.jpeg/*.jpg, *.emf, *.wmf, *.gif, *.tif/tiff, *.png, *.ico (*) Вот этот код надо вынести в OnAdvancedCustomDrawItem и подгружать только те картинки которые в данный момент на экране...Откровенно говоря я просто не нашел последний вариант... З.Ы.: Я не стал выносить код в отдельный поток, ради сохранения производительности. Хотя конечно в потоке это было бы правильней. З.З.Ы.: Если использовать код как есть, то есть минусы: - Во время формирования есть артифакты в виде подрагивания - Приходиться отслеживать смену дирректории в рантайме Но есть и плюсы: - После формирования, скроллинг проходит без артифактов - Есть возможность создавать картинки любого размера В аттаче скрин с проекта

Автор: SultanOFF 23.11.2009, 15:08

спасибо большое за столь обширный ответ  Но в пару местах возникли трудности: почему пишется что переменная GetDirNameFromPath не обьявленна? А также переменные GetProportional, TumbnailsList? GDI+ подключил... ПС: не могли бы Вы выложить исходник вашей программы?

Автор: ~FoX~ 23.11.2009, 15:39

SultanOFF, GetDirNameFromPath функция возвращает имя файла из пути, писал сам потому что нужно было по хитрому это делать, ты используй ExtractFileName... TumbnailsList - твой ImageList1 А про GetProportional я забыл... Код function GetProportional(OldW, OldH, cw, ch: integer): TRect; //получаем пропорцианальный рект var   xyaspect: Double; //отношение begin   if ((OldW > cw) or (OldH > ch)) then begin     if ((OldW > 0) and (OldH > 0)) then    begin       xyaspect := OldW / OldH;       if OldW > OldH then begin         OldW := cw;         OldH := Trunc(cw / xyaspect);         if OldH > ch then begin           OldH := ch;           OldW := Trunc(ch * xyaspect);         end;       end       else begin         OldH := ch;         OldW := Trunc(ch * xyaspect);         if OldW > cw then begin           OldW := cw;           OldH := Trunc(cw / xyaspect);         end;       end;     end     else begin       OldW := cw;       OldH := ch;     end;   end;   with Result do begin     Left := 0;     Top := 0;     Right := OldW;     Bottom := OldH;   end;   //OffsetRect(Result, (cw - OldW) div 2, (ch - OldH) div 2); end; Цитата   ПС: не могли бы Вы выложить исходник вашей программы? smile Боль-мение адекватные исходники давно потеряны, а в том что есть придется пол года разбираться )))) А, еще забыл..ViewStyle выстави в vsIcon и в ImageList Width и Height в 130 З.Ы.: Если ооочень надо - могу накатать рабочий пример на Д7 или 2k9, но т.к. сильно лениво для начала попробуй сам

Автор: SultanOFF 23.11.2009, 17:09

еще раз большая благодарность   Вставил все эти функции и процедуры, но теперь никак не пойму как применять данный код? Что получается нужно писать в OnAdvancedCustomDrawItem? И где указать папку с изображениями? Помогите пожалуйста

Автор: ~FoX~ 23.11.2009, 17:18

SultanOFF, Иееех....молодежжж        Код procedure TForm1.Button1Click(Sender: TObject); begin   GetPathsToTumbs('c:\папка с изображениями\', '*.png');   GetPathsToTumbs('c:\папка с изображениями\', '*.bmp');   GetPathsToTumbs('c:\папка с изображениями\', '*.jpg');   GetPathsToTumbs('c:\папка с изображениями\', '*.jpeg');   GetPathsToTumbs('c:\папка с изображениями\', '*.gif');   CreateEmptyItem;   FillImg; end;

Автор: SultanOFF 23.11.2009, 17:36

Цитата Иееех....молодежжж  smile  smile  smile   для вас Мои вопросы наверно кажутся такими глупыми    Кстати  почему то вылетает ошибка указывая на  => TumbPath.Add(s); :( на скрине сама ошибка

Автор: ~FoX~ 23.11.2009, 21:27

Иеееххх.... Ты лист то создай перед использованием....    Код procedure TForm1.FormCreate(Sender: TObject); begin   TumbPath := TStringList.Create; end; //............................................... procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin   TumbPath.Free; end;   Цитата  для вас Мои вопросы наверно кажутся такими глупыми smile  Фигня..."Мы все учились понемногу"

Автор: ~FoX~ 24.11.2009, 09:39

Кстати, не забывай очищать лист во время работы Код   TerminateFlag := true;   TumbPath.Clear;   ImageList1.Clear;   ListView1.Items.Clear;   GetPathsToTumbs('c:\папка с изображениями\', '*.png');   GetPathsToTumbs('c:\папка с изображениями\', '*.bmp');   GetPathsToTumbs('c:\папка с изображениями\', '*.jpg');   GetPathsToTumbs('c:\папка с изображениями\', '*.jpeg');   GetPathsToTumbs('c:\папка с изображениями\', '*.gif');   TerminateFlag := false;     CreateEmptyItem;   FillImg;

Автор: ~FoX~ 24.11.2009, 10:15

Собственно утро, на работе делать не чего.... Вот тебе рабочий пример в аттаче... Исходники + екзешник, писано на Д7...

Автор: SultanOFF 24.11.2009, 14:20

Громаднейшее спасибо уважаемый FOX!   Все работает просто превосходно, без вас Я бы никак не справился! Выражаю глубокую благодарность

Автор: ~FoX~ 24.11.2009, 14:45

SultanOFF, Ну если что обращайся, я много с графикой работал...

Автор: SultanOFF 24.11.2009, 15:32

а можешь сказать как сделать чтобы при нажатии на картинку открывался большой скриншот?

Автор: ~FoX~ 24.11.2009, 16:05

Создай вторую форму, положи на нее image, к сожалению он понимает только стандартные форматы bmp, ico, по этому я написал процедурку которая переваривет любой формат в битмап Код procedure GetBitmapFromGPImage(SeurceGPImage:TGPImage; var DestBMP: TBitmap); //получаем битма из всего var   GPGraphics : TGPGraphics; begin   DestBMP.Width := SeurceGPImage.GetWidth;   DestBMP.Height := SeurceGPImage.GetHeight;   GPGraphics := TGPGraphics.Create(DestBMP.Canvas.Handle);   GPGraphics.SetSmoothingMode(SmoothingModeHighSpeed);   GPGraphics.DrawImage(SeurceGPImage, 0, 0, DestBMP.Width, DestBMP.Height);   GPGraphics.Free; end; По onShow формы получай путь к картинке и работай с ней: Код var    WBitmap: TBitmap; //Глобальная //............... procedure TForm2.FormShow(Sender: TObject); var   s: string;   GPImage: TGPImage; begin   try     s:= Form1.DirectoryListBox1.Directory +'\'+ Form1.ListView1.ItemFocused.Caption;     GPImage := TGPImage.Create(s);     WBitmap := TBitmap.Create;     GetBitmapFromGPImage(GPImage, WBitmap);     Image1.Picture.Bitmap := WBitmap;   finally      GPImage.Free;   end; end; по onClose освобождай паямять Код procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); begin   WBitmap.Free; end; Примерно так

Автор: SultanOFF 27.11.2009, 17:12

блин при компиляции gdiplus.pas  Delphi 2009  выпадает :( Почему? Ведь версия именно под delphi 2009!

Автор: ~FoX~ 27.11.2009, 17:42

SultanOFF, http://decoding.narod.ru/download/units/main.html

Автор: SultanOFF 27.11.2009, 18:55

FOX спасибо! Вы просто золотой человек!

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)