Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Вывести в TListView изображения, зная путь до папки 
:(
    Опции темы
AdamAry
Дата 21.8.2018, 19:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 1
Регистрация: 21.8.2018

Репутация: нет
Всего: нет



Как зная путь до папки найти все файлы и вывести в TListView  изображения типа JPEG BMP PNG в виде миниатюр thumbnails?
PM MAIL   Вверх
Hiori
Дата 23.8.2018, 07:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 46
Регистрация: 29.3.2016

Репутация: нет
Всего: нет



я надеюсь писать как сделать дерево файлов и папок не нужно, правда же?
а вот миниатюрки...
цепляете к дереву ImageList, в процессе поиска файлов, если картинка - открываете и в Ваш лист добавляете миниатюрку:
Код

var
   ext: string;
   image: TCustomImage;
   ...
begin
   ...
   il.Clear();
   image := TCustomImage.Create();
   repeat // или как у вас реализован поиск
      ...
      ext := ExtractFileExt( FileName );
      if( ext = '.jpg' )or( ext = '.png' )or( ext = '.bmp' )then begin
         image.LoadFromFile( FileName );
         il.AddMasked( image.MiniatureAsJpeg( 32 ), clNone );
         item.ImageIndex := il.Count - 1;
      end;
   until ;
   FreeAndNil( image );
...
end;


Соответственно в MiniatureAsJpeg( 32 ) - 32 размер картинки в пикселах, можно сделать настраиваемым.
На код попрошу не ругаться, писался в стародавние времена, так что уж какой есть smile

Код

type
    TImageType = ( itJpeg, itGif, itPng, itNoImage );
    TCustomImage = class( TBitmap )
        protected
            fImageData: TMemoryStream;
            fBmp: TBitmap;
            fJpeg: TJPEGImage;
            fPng: TPNGObject;

            function KindOfImage(): TImageType;
        public
            property ImageType: TImageType read KindOfImage;

            constructor Create(); override;
            destructor Free(); virtual;
            procedure LoadFromFile( const Filename: string ); override;
            procedure SaveAsBitmap( const FileName: string );
            procedure SaveAsPng( const FileName: string );
            procedure SaveAsJpeg( const FileName: string; Quality: Integer = 100 );

            function MiniatureAsBitmap( ASize: Integer ): TBitmap;
            function MiniatureAsJpeg( ASize: Integer ): TJPEGImage;
            function MiniatureAsPng( ASize: Integer ): TPNGObject;

            procedure ResizeImage( iWidth: Integer; iHeight: Integer );
            procedure ResizeByX( ASize: Integer );
            procedure ResizeByY( ASize: Integer );
    end;

Implementation
    
constructor TCustomImage.Create();
begin
    inherited;
    fBmp := TBitmap.Create();
    fJpeg := TJPEGImage.Create();
    fPng := TPNGObject.Create();
end;

destructor TCustomImage.Free();
begin
    fPng.Free();
    fJpeg.Free();
    fBmp.Free();
end;

function TCustomImage.KindOfImage(): TImageType;
var
    Start: Pointer;
begin
    Start := fImageData.Memory;
    if( LongWord( Start^ ) = $38464947 )then Result := itGif
    else if( Word( Start^ ) = $4D42 )then Result := itBmp
    else if( LongWord( Start^ ) = $474E5089 )then Result := itPng
    else if( Word( Start^ ) = $D8FF )then Result := itJpeg
    else Result := itNoImage;
end;

procedure TCustomImage.LoadFromFile( const Filename: string );
begin
    fImageData := TMemoryStream.Create();
    fImageData.LoadFromFile( FileName );
    fImageData.Seek( 0, 0 );

    try
        case KindOfImage() of
            itBmp:        begin if( not Assigned( fBmp ) )then fBmp := TBitmap.Create(); fBmp.LoadFromFile( FileName ); end;
            itJpeg:        begin if( not Assigned( fJpeg ) )then fJpeg := TJPEGImage.Create(); fJpeg.LoadFromFile( FileName ); end;
            itPng:        begin if( not Assigned( fPng ) )then fPng := TPNGObject.Create(); fPng.LoadFromFile( FileName ); end;
            else            raise Exception.Create( 'Invalid format or no image!' );
        end;
    except on E:Exception do begin
        raise Exception.Create( 'Can''t open file: ' + E.Message );
    end; end;

    try
        case KindOfImage() of
            itBmp:    begin
                            Width  := fBmp.Width;
                            Height := fBmp.Height;
                            Self.Canvas.Draw( 0, 0, fBmp );
                        end;
            itJpeg:    begin
                            Width  := fJpeg.Width;
                            Height := fJpeg.Height;
                            Self.Canvas.Draw( 0, 0, fJpeg );
                        end;
            itPng:    begin
                            Width  := fPng.Width;
                            Height := fPng.Height;
                            Self.Canvas.Draw( 0, 0, fPng );
                        end;
        end;
    except on E:Exception do begin
        raise Exception.Create( 'Can''t link bitmap image: ' + E.Message );
    end; end;

    fImageData.Free();
end;

procedure TCustomImage.SaveAsBitmap( const FileName: string );
begin
    Self.SaveToFile( FileName );
end;

procedure TCustomImage.SaveAsPng( const FileName: string );
var
    png: TPNGObject;
begin
    png := TPNGObject.Create();
    png.Assign( Self );
    png.SaveToFile( FileName );
    png.Free();
end;

procedure TCustomImage.SaveAsJpeg( const FileName: string; Quality: Integer = 100 );
var
    jpeg: TJPEGImage;
begin
    jpeg := TJPEGImage.Create();
    jpeg.Assign( Self );
    jpeg.CompressionQuality := Quality;
    jpeg.SaveToFile( FileName );
    jpeg.Free();
end;

function TCustomImage.MiniatureAsBitmap( ASize: Integer ): TBitmap;
var
    tbmp: TBitmap;
    ratio: Single;
    X, Y, AWidth, AHeight: Integer;
begin
    Result := TBitmap.Create();

    if( Self.Width >= Self.Height )then begin
        ratio := Self.Width / Self.Height;
        AWidth := ASize;
        AHeight := Round( ASize / ratio );
        X := 0;
        Y := Round( ( ASize / 2 ) - ( AHeight / 2 ) );
    end else begin
        ratio := Self.Height / Self.Width;
        AWidth := Round( ASize / ratio );
        AHeight := ASize;
        X := Round( ( ASize / 2 ) - ( AWidth / 2 ) );
        Y := 0;
    end;

    tbmp := TBitmap.Create();
    tbmp.Width := Self.Width;
    tbmp.Height := Self.Height;
    BitBlt( tbmp.Canvas.Handle, 0, 0, tbmp.Width, tbmp.Height, Self.Canvas.Handle, 0, 0, SRCCOPY );

    Result.Width := ASize;
    Result.Height := ASize;
    SetStretchBltMode( Result.Canvas.Handle, HALFTONE );
    StretchBlt( Result.Canvas.Handle, X, Y, AWidth, AHeight,tbmp.Canvas.Handle, 0, 0, tbmp.Width, tbmp.Height, SRCCOPY );

    tbmp.Free();
end;

function TCustomImage.MiniatureAsJpeg( ASize: Integer ): TJPEGImage;
begin
    Result := TJPEGImage.Create();
    Result.Assign( MiniatureAsBitmap( ASize ) );
end;

function TCustomImage.MiniatureAsPng( ASize: Integer ): TPNGObject;
begin
    Result := TPNGObject.Create();
    Result.Assign( MiniatureAsBitmap( ASize ) );
end;

procedure TCustomImage.ResizeImage( iWidth: Integer; iHeight: Integer );
var
    tbmp: TBitmap;
begin
    tbmp := TBitmap.Create();
    tbmp.Width := Self.Width;
    tbmp.Height := Self.Height;
    BitBlt( tbmp.Canvas.Handle, 0, 0, tbmp.Width, tbmp.Height, Self.Canvas.Handle, 0, 0, SRCCOPY );

    Width := iWidth;
    Height := iHeight;
    SetStretchBltMode( Canvas.Handle, HALFTONE );
    StretchBlt( Canvas.Handle, 0, 0, iWidth, iHeight,tbmp.Canvas.Handle, 0, 0, tbmp.Width, tbmp.Height, SRCCOPY );

    tbmp.Free();
end;

procedure TCustomImage.ResizeByX( ASize: Integer );
var
    tbmp: TBitmap;
    ratio: Single;
    AWidth, AHeight: Integer;
begin
    ratio := Self.Width / Self.Height;
    AWidth := ASize;
    AHeight := Round( ASize / ratio );

    tbmp := TBitmap.Create();
    tbmp.Width := Self.Width;
    tbmp.Height := Self.Height;
    BitBlt( tbmp.Canvas.Handle, 0, 0, tbmp.Width, tbmp.Height, Self.Canvas.Handle, 0, 0, SRCCOPY );

    Width := AWidth;
    Height := AHeight;
    SetStretchBltMode( Canvas.Handle, HALFTONE );
    StretchBlt( Canvas.Handle, 0, 0, AWidth, AHeight,tbmp.Canvas.Handle, 0, 0, tbmp.Width, tbmp.Height, SRCCOPY );

    tbmp.Free();
end;

procedure TCustomImage.ResizeByY( ASize: Integer );
var
    tbmp: TBitmap;
    ratio: Single;
    AWidth, AHeight: Integer;
begin
    ratio := Self.Height / Self.Width;
    AWidth := Round( ASize / ratio );
    AHeight := ASize;

    tbmp := TBitmap.Create();
    tbmp.Width := Self.Width;
    tbmp.Height := Self.Height;
    BitBlt( tbmp.Canvas.Handle, 0, 0, tbmp.Width, tbmp.Height, Self.Canvas.Handle, 0, 0, SRCCOPY );

    Width := AWidth;
    Height := AHeight;
    SetStretchBltMode( Canvas.Handle, HALFTONE );
    StretchBlt( Canvas.Handle, 0, 0, AWidth, AHeight,tbmp.Canvas.Handle, 0, 0, tbmp.Width, tbmp.Height, SRCCOPY );

    tbmp.Free();
end;


Это сообщение отредактировал(а) Hiori - 23.8.2018, 07:23
PM MAIL   Вверх
Google
  Дата 15.11.2019, 18:19 (ссылка)  





  Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.0879 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.