unit uDiminishPicSize;

interface

uses
  System.SysUtils, System.Classes,GDIPOBJ,Math,Vcl.Graphics,
  Vcl.ExtCtrls;

type
  TDiminishPicSize = class(TDataModule)
  private


    procedure LoadAAImageFromFile(FileName: String; W, H: Integer; Pic: TBitmap);

    { Private declarations }
  public
    { Public declarations }

    procedure
    ProportionalDiminishPicSize
    (FilePath: string; maxWidth, maxHeight: Integer; var bmpDest: TBitmap); overload;

  procedure ProportionalDiminishPicSize2(

  SourceBitMap:TBitmap;
  maxWidth:Integer;
  maxHeight:Integer;
  var ImageDest:TImage

);


  end;

//var
//  DiminishPicSize: TDiminishPicSize;

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}


procedure TDiminishPicSize.ProportionalDiminishPicSize
(FilePath:string; maxWidth,maxHeight:Integer; var bmpDest:TBitmap);

var
  currentWidth: Integer;
  currentHeight: Integer;
  koeff: Extended;
  NewWidth: Integer;
  NewHeight: Integer;
  image:TImage;

begin
//


image:=TImage.Create(Self);
image.Picture.LoadFromFile(FilePath);

            currentWidth:=image.Picture.Width;
            currentHeight:=image.Picture.Height;

            //Calculating koeff
            if (currentWidth>maxWidth) or (currentHeight>maxHeight) then
            koeff:=Min(maxWidth/currentWidth,maxHeight/currentHeight) else
            koeff:=1;



if koeff<>1 then

 begin

  NewWidth:=trunc(currentWidth*koeff);
  NewHeight:=Trunc(currentHeight*koeff);


  LoadAAImageFromFile(FilePath,NewWidth,NewHeight,bmpDest);



 end else

  LoadAAImageFromFile(FilePath,currentWidth,currentHeight,bmpDest);

 end;








procedure TDiminishPicSize.
LoadAAImageFromFile(FileName: String; W,H: Integer; Pic: TBitmap);

var ImageTemp: TGPImage;
graphicsGDIPlus: TGPGraphics;
begin

if FileExists(FileName) then
  begin
  Pic.Width:=W;
  Pic.Height:=H;
  graphicsGDIPlus:=TGPGraphics.Create (Pic.Canvas.Handle);

  ImageTemp:=TGPImage.Create(FileName ); // Trouble here

  graphicsGDIPlus.DrawImage(ImageTemp , 0,0,W,H);
  ImageTemp.Free;
  graphicsGDIPlus.Free;
  end;
end;



procedure TDiminishPicSize.ProportionalDiminishPicSize2(

SourceBitMap:TBitmap;
maxWidth:Integer;
maxHeight:Integer;
var ImageDest:TImage
);

var

  imageSource:TImage;
  currentWidth: integer;
  currentHeight: integer;
  koeff: Extended;



begin

// Checks...


//if not ( Assigned(imageSource) ) or not ( Assigned(imageDest) ) then exit;

imageSource:=TImage.Create(Self);


//Proportional diminishing
imageSource.Picture.Bitmap.Assign(SourceBitMap);


currentWidth:=imageSource.Picture.Width;
currentHeight:=imageSource.Picture.Height;

if (currentWidth>maxWidth) or (currentHeight>maxHeight) then
koeff:=Min(maxWidth/currentWidth,maxHeight/currentHeight) else
koeff:=1;

if koeff<>1 then

 begin


  imageDest.Width:=Trunc(currentWidth*koeff);//MaxWidth;
  imageDest.Height:=Trunc(currentHeight*koeff);// MaxHeight;


  imageDest.Proportional:=true;
  imageDest.Stretch:=true;

  imageDest.Assign(imageSource);


 end else

 begin


  imageDest.Width:=imageSource.Width;
  imageDest.Height:=imageSource.Height;

  imageDest.Assign(imageSource);

 end;


FreeAndNil(imageSource);

end;
















end.
