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.

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

SR: System.SysUtils.TSearchRec