Шустрый
Профиль
Группа: Участник
Сообщений: 51
Регистрация: 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 размер картинки в пикселах, можно сделать настраиваемым. На код попрошу не ругаться, писался в стародавние времена, так что уж какой есть  | Код |
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;
|
|
Вывести в TListView изображения, зная путь до папки 
Загрузка ...
