Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

Как из файла JPEG закинуть в TListBox изображение


Adam ©   (22.08.18 11:24

Как из файла JPEG закинуть в TListBox уменьшенное по масштабу изображение?


macrodens ©   (22.08.18 11:34[1]

Ответить нет(No) в диалоге разбивки изображения на N -частей


Поиск   (22.08.18 11:36[2]

https://stackoverflow.com/questions/10988310/loading-images-to-timagelist-and-reading-them


Игорь Шевченко ©   (22.08.18 13:08[3]

unit main;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.ImgList,
 Vcl.StdCtrls;

type
 TfMain = class(TForm)
   Grid: TListView;
   Image: TImage;
   Button1: TButton;
   ImageList: TImageList;
   ListBox: TListBox;
   procedure Button1Click(Sender: TObject);
   procedure ListBoxClick(Sender: TObject);
 private
   FThumbnails: array of TBitmap;
   procedure Scan;
   procedure AddThumbnail (const AFileName: string);
 end;

var
 fMain: TfMain;

const
 Path = 'D:\Images';

implementation
uses
 Jpeg, Math;

{$R *.dfm}

procedure TfMain.AddThumbnail (const AFileName: string);
var
 bmWidth, bmHeight: Integer;
 Thumbnail, Worker: TBitmap;
 ImageIndex: Integer;
 Item: TListItem;
 R: TRect;
begin
 with Image.Picture.Graphic do
 begin
   if Width > Height then
   begin
     bmWidth := ImageList.Width;
     bmHeight := Round(ImageList.Height * Height / Width);
   end
   else
   begin
     bmHeight := ImageList.Height;
     bmWidth := Round(ImageList.Width * Width / Height);
   end;
 end;
 Thumbnail := TBitmap.Create;
 with Thumbnail do
 begin
   PixelFormat := pf24bit;
   Width := bmWidth;
   Height := bmHeight;
   Canvas.StretchDraw(Rect(0,0,Width, Height), Image.Picture.Graphic);
 end;
 Worker := TBitmap.Create;
 with Worker do
 begin
   PixelFormat := pf24bit;
   Width := ImageList.Width;
   Height := ImageList.Height;
 end;
 R.Left := (ImageList.Width - Thumbnail.Width) div 2;
 R.Top := (ImageList.Height - Thumbnail.Height) div 2;
 Worker.Canvas.Draw(R.Left, R.Top, Thumbnail);
 ImageIndex := Imagelist.AddMasked(Worker, clWhite);
 SetLength(FThumbnails, Length(FThumbnails)+1);
 FThumbnails[Length(FThumbnails)-1] := Thumbnail;
 Item := Grid.Items.Add;
 Item.Caption := ExtractFilename(AFileName);
 Item.ImageIndex := ImageIndex;
end;

procedure TfMain.Button1Click(Sender: TObject);
begin
 Scan;
end;

procedure TfMain.ListBoxClick(Sender: TObject);
var
 FileName: string;
begin
 FileName := IncludeTrailingPathDelimiter(Path)+ListBox.Items[ListBox.ItemIndex];
 Image.Picture.LoadFromFile(FileName);
 if Assigned(Image.Picture.Graphic) then
   AddThumbnail(FileName);
end;

procedure TfMain.Scan;
var
 SR: System.SysUtils.TSearchRec;
 Mask: string;
 Error: Integer;
begin
 Mask := IncludeTrailingPathDelimiter(Path)+'*.*';
 Error := System.SysUtils.FindFirst(Mask, 0, SR);
 while Error = 0 do
 begin
   ListBox.AddItem(SR.Name, nil);
   Error := System.SysUtils.FindNext(SR);
 end;
end;

end.


Медленно.


Adam ©   (22.08.18 18:25[4]

Благодарю Игорь.

Как сделать так в вышенаписанной программе, чтобы в Grid: TListView отображались не первые три буквы имени файлов, а уменьшенные изображения файлов, т.е. их миникартинки?
https://unsee.cc/eb28aa79/
т.е. вместо 021... 041... должны быть сами микроизображения.


Игорь Шевченко ©   (22.08.18 18:46[5]

Возможно, поможет dfm

object fMain: TfMain
 Left = 0
 Top = 0
 Caption = 'fMain'
 ClientHeight = 671
 ClientWidth = 746
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'Tahoma'
 Font.Style = []
 OldCreateOrder = False
 DesignSize = (
   746
   671)
 PixelsPerInch = 96
 TextHeight = 13
 object Image: TImage
   Left = 8
   Top = 28
   Width = 65
   Height = 73
   Visible = False
 end
 object Grid: TListView
   Left = 192
   Top = 28
   Width = 546
   Height = 413
   Anchors = [akLeft, akTop, akRight, akBottom]
   Color = clBlack
   Columns = <>
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWhite
   Font.Height = -11
   Font.Name = 'Tahoma'
   Font.Style = []
   IconOptions.AutoArrange = True
   LargeImages = ImageList
   ParentFont = False
   TabOrder = 0
 end
 object Button1: TButton
   Left = 20
   Top = 608
   Width = 75
   Height = 25
   Caption = 'Button1'
   TabOrder = 1
   OnClick = Button1Click
 end
 object ListBox: TListBox
   Left = 192
   Top = 456
   Width = 546
   Height = 177
   Anchors = [akLeft, akRight, akBottom]
   ItemHeight = 13
   TabOrder = 2
   OnClick = ListBoxClick
 end
 object ImageList: TImageList
   Height = 160
   Width = 160
   Left = 20
   Top = 128
 end
end


Adam ©   (22.08.18 20:30[6]

Да, помогло, спасибо.
Не было привязки TImageList к TListView.
Привязал програмно:
Grid.LargeImages := ImageList;


Adam ©   (23.08.18 20:17[7]

Игорь, хотел бы спросить, как можно в процедуре scan пройти часть файлов пусть будет это 10 картинок и остановить скан, а потом возобновить скан по нажатию баттона с оставшихся картинок (каждый раз по 10 картинок), как это можно программно реализовать?

procedure TfMain.Scan;
var
SR: System.SysUtils.TSearchRec;
Mask: string;
Error: Integer;
begin
Mask := IncludeTrailingPathDelimiter(Path)+'*.*';
Error := System.SysUtils.FindFirst(Mask, 0, SR);
while Error = 0 do
begin
  ListBox.AddItem(SR.Name, nil);
  Error := System.SysUtils.FindNext(SR);
end;
end;


Adam ©   (23.08.18 20:18[8]

Имелось в виду возобновить скан в той же папке.


Игорь Шевченко ©   (23.08.18 21:17[9]

Adam ©   (23.08.18 20:17) [7]

Запоминать состояние SR: System.SysUtils.TSearchRec;


Adam ©   (23.08.18 21:24[10]

Как это сделать программно Игорь:
как запомнить и как возобновить с запомненного состояния SR: System.SysUtils.TSearchRec;?


ухты ©   (23.08.18 21:55[11]

запомнить это - скинуть в переменную/поле класса(формы)/.. с более глобальной видимостью, у вас сейчас данные живут только в пределах метода, а надо подольше.
потом начать поиск передав то что запомнили


Игорь Шевченко ©   (23.08.18 22:26[12]

Adam ©   (23.08.18 21:24) [10]

Например, скопировать куда-нибудь


Игорь Шевченко ©   (23.08.18 22:29[13]

Желательно задачу озвучить целиком и полностью, а не обрывками - возможно, сразу найдется правильное решение.


Adam ©   (23.08.18 22:42[14]

В папке находится очень большое количество файлов. Чтобы не тормозило (чтобы пользователь вообще не чувствовал что у него зависло что) есть вариант с помощью
SR: System.SysUtils.TSearchRec брать названия не всех файлов, а по 20 штук за раз, и при нажатии пользователем лифта скролбара TListView (Grid) вниз мы будем брать другую партию следующих 20 файлов и записывать их в ListBox (добавляя, а не стирая прежние названия), а уже изображения выводить будем в TListView уже  по 6 шт.


Игорь Шевченко ©   (23.08.18 23:08[15]

http://www.sql.ru/forum/actualutils.aspx?action=gotomsg&tid=932563&msg=20491672
?


Adam ©   (23.08.18 23:29[16]

Прочитал.


Pavia ©   (25.08.18 19:33[17]

есть вариант с помощью
> SR: System.SysUtils.TSearchRec брать названия не всех файлов,
>  а по 20 штук за раз, и при нажатии пользователем лифта
> скролбара TListView (Grid) вниз мы будем брать другую партию
> следующих 20 файлов и записывать их в ListBox (добавляя,
>  а не стирая прежние названия), а уже изображения выводить
> будем в TListView уже  по 6 шт.

Это не правильное решение. Время открытие 1 файла соизмерима с реакцией человека. Он будет видеть что тормозит. Решение выработано и известно как thumbs.


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо