Шустрый
Профиль
Группа: Участник
Сообщений: 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;
|
Это сообщение отредактировал(а) Hiori - 23.8.2018, 07:23
|