unit uTestDiminishPics;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, {GDIPOBJ}Math,
  System.IOUtils,System.Types, Vcl.ComCtrls,syncobjs,

  //MyUnits

//  uDiminishPicsThread   // Объявим ниже, под implementation, иначе зависание от цикл. ссылок
  PNGImage,Jpeg, Vcl.ExtCtrls, Vcl.AppEvnts
  ;

type


// TPics=(.jpg,.jpeg,.bmp);

  TfTestDiminshPics = class(TForm)
    bStretchDraw: TButton;
    OpenDialog1: TOpenDialog;
    bSomeFunc: TBitBtn;
    GDIPlus: TBitBtn;
    bMultiDiminishPics: TBitBtn;
    FileOpenDialog: TFileOpenDialog;
    Button1: TButton;
    ProgressBar: TProgressBar;
    bStretchDraw2: TBitBtn;
    ApplicationEvents: TApplicationEvents;
    procedure bStretchDrawClick(Sender: TObject);
    procedure bSomeFuncClick(Sender: TObject);
    procedure GDIPlusClick(Sender: TObject);
    procedure bMultiDiminishPicsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure bStretchDraw2Click(Sender: TObject);
    procedure ApplicationEventsException(Sender: TObject; E: Exception);
  private



    FPicsExtensionsList:TStringList;

    procedure ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer);
  //  procedure LoadAAImageFromFile(FileName: String; W, H: Integer;
  //    Pic: TBitmap);
//    procedure GDIPlusShrinkPicture(bmp: tbitmap);
    procedure Draw(ACanvas: TCanvas; const Rect: TRect);


    { Private declarations }
  public

//   procedure GDIplusDiminishPic(FilePath: string); { Public declarations }

   procedure DiminishPic(FilePath: string);

  end;

var
  fTestDiminshPics: TfTestDiminshPics;

implementation

uses uDiminishPicsThread;

{$R *.dfm}



procedure TfTestDiminshPics.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  p:TPoint;
  dc:HDC;
begin

  //not calling inherited; here!
  dc:=ACanvas.Handle;
  GetBrushOrgEx(dc,p);
  SetStretchBltMode(dc,HALFTONE);
  SetBrushOrgEx(dc,p.x,p.y,@p);
  StretchBlt(dc,
  Rect.Left,Rect.Top,
  Rect.Right-Rect.Left,Rect.Bottom-Rect.Top,
  Canvas.Handle,0,0,Width,Height,ACanvas.CopyMode);

end;



procedure TfTestDiminshPics.ApplicationEventsException(Sender: TObject;
  E: Exception);
begin

if (Sender is TDiminishPicsThread) then

begin

      ShowMessage(


      'Вызвана ошибка '+E.ClassName+'с сообщением : '+
                  E.Message

                  );

end;




end;

procedure TfTestDiminshPics.bMultiDiminishPicsClick(Sender: TObject);

var FilesInDir,FilesInDirFiltered:TStringDynArray;
  i: Integer;
  Ext: string;

  DiminishPicsThread:TDiminishPicsThread;

  AllowedExtensions:string;

begin

AllowedExtensions:='.bmp,.jpg,.jpeg,.png,.tiff';

    //Choosing only folders
    FileOpenDialog.Options := [fdoPickFolders];

    // Getting All files from dir
    if FileOpenDialog.Execute then
    FilesInDir:=
    TDirectory.GetFiles(FileOpenDialog.FileName);


           //Filtering only pics... in FilesInDirFiltered

   SetLength(FilesInDirFiltered,0); // nulling...

    for i := 0 to High(FilesInDir) do
    begin
            Ext:=AnsiLowerCase(ExtractFileExt(FilesInDir[i]));
            if Pos(Ext,AllowedExtensions)>0 then

            begin
              SetLength(FilesInDirFiltered,Length(FilesInDirFiltered)+1);
              FilesInDirFiltered[ High(FilesInDirFiltered) ]:=FilesInDir[i];
            end;


    end;



      //--------------Starting additional thread

    if Length(FilesInDir)>0 then
     begin

        ProgressBar.Position:=0;

         //Creating additional thread
        DiminishPicsThread:=TDiminishPicsThread.Create(true);
        DiminishPicsThread.FreeOnTerminate:=true;
        DiminishPicsThread.Priority:=tpHigher;



                  //Transferring params to additional thread

              DiminishPicsThread.ThreadStarter:=Self;
              DiminishPicsThread.PicsInDir:=FilesInDirFiltered;
              DiminishPicsThread.MaxWidth:=50;
              DiminishPicsThread.MaxHeight:=50;



              DiminishPicsThread.Start;



     end;


end;

procedure TfTestDiminshPics.bSomeFuncClick(Sender: TObject);
var
  bmp, bmp2: TBItmap; twic:TWICImage;
begin
  if opendialog1.execute then begin

    twic:=TWICImage.Create;


    bmp:= Tbitmap.Create;
    try

      twic.LoadFromFile(opendialog1.filename);
      bmp.Assign(twic);


      bmp2 := Tbitmap.Create;
      try


       ResizeBitmap(bmp,bmp2,640,480);
       bmp2.SaveToFile(ChangeFileext( opendialog1.filename, '_thumb.BMP' ));

      finally
        bmp2.free;
      end;
    finally
      bmp.free;
      FreeAndNil(twic);
    end;
  end;
end;





procedure TfTestDiminshPics.bStretchDraw2Click(Sender: TObject);
var
  bmp, bmpDiminished: TBItmap; twic:TWICImage;
  image:TImage;

  maxWidth:integer;
  maxHeight:integer;

  currentWidth:integer;
  currentHeight:integer;

  k:Extended;
  NewHeight: Int64;
  NewWidth: Int64;
  size:int64;

begin

  maxWidth:=100;
  maxHeight:=100;

  if opendialog1.execute then begin

    twic:=TWICImage.Create;

    bmp:= Tbitmap.Create;
    bmpDiminished:= Tbitmap.Create;


    try

        twic.LoadFromFile(opendialog1.filename);
        bmp.Assign(twic);

        size:=SizeOf(bmp);
        currentWidth:=bmp.Width; currentHeight:=bmp.Height;

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

        NewWidth:=Trunc(k*currentWidth); NewHeight:=Trunc(k*currentHeight);


         bmpDiminished.Width:=NewWidth; bmpDiminished.Height:=NewHeight;
         bmpDiminished.Canvas.StretchDraw(Rect(0, 0, NewWidth, NewHeight), bmp);


         bmpDiminished.SaveToFile(ChangeFileext( opendialog1.filename, '_thumb.BMP' ));


    finally

      FreeAndNil(bmp);
      FreeAndNil(bmpDiminished);
      FreeAndNil(twic);
      ShowMessage('success');
    end;
  end;
end;

procedure TfTestDiminshPics.bStretchDrawClick(Sender: TObject);


var
  bmp, bmp2: TBItmap; twic:TWICImage; image:timage;
begin
  if opendialog1.execute then begin

    twic:=TWICImage.Create;


    bmp:= Tbitmap.Create;
    try

      twic.LoadFromFile(opendialog1.filename);
      bmp.Assign(twic);


      bmp2 := Tbitmap.Create;
      try
        bmp2.Width := 640;
        bmp2.Height:= 480;


       // image.Picture.Bitmap.Canvas.StretchDraw();

        bmp2.Canvas.StretchDraw(Rect(0, 0, 640, 480), bmp);
      //  Self.Canvas.Draw(100, 10, bmp2);
        bmp2.SaveToFile(ChangeFileext( opendialog1.filename, '_thumb.BMP' ));
      finally
        bmp2.free;
      end;
    finally
      bmp.free;
      FreeAndNil(twic);
    end;
  end;
end;



procedure TfTestDiminshPics.Button1Click(Sender: TObject);

var
  bmp, bmpDiminished: TBItmap; twic:TWICImage;

  maxWidth:integer;
  maxHeight:integer;

  currentWidth:integer;
  currentHeight:integer;

  k:Extended;
  NewHeight: Int64;
  NewWidth: Int64;

begin

  maxWidth:=100;
  maxHeight:=100;

  if opendialog1.execute then begin

    twic:=TWICImage.Create;

    bmp:= Tbitmap.Create;
    bmpDiminished:= Tbitmap.Create;

    try

        twic.LoadFromFile(opendialog1.filename);
        bmp.Assign(twic);

        currentWidth:=bmp.Width; currentHeight:=bmp.Height;

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

        NewWidth:=Trunc(k*currentWidth); NewHeight:=Trunc(k*currentHeight);

        SetStretchBltMode(bmp.Canvas.Handle, HALFTONE);
        StretchBlt(bmpDiminished.Canvas.Handle, 0, 0, NewWidth, NewHeight,
        bmp.Handle, 0, 0, bmp.Width, bmp.Height, SrcCopy);


      //  ShowMessage('Width '+bmp.Width.ToString() +' Height'+bmp.Height.ToString());

    //    LoadAAImageFromFile(OpenDialog1.FileName,currentWidth,currentHeight,bmpDiminished);
        bmpDiminished.SaveToFile(ChangeFileext( opendialog1.filename, '_thumb.BMP' ));


    finally
      FreeAndNil(bmp);
      FreeAndNil(bmpDiminished);
      FreeAndNil(twic);
      ShowMessage('success');
    end;
  end;
end;


procedure TfTestDiminshPics.FormCreate(Sender: TObject);
begin

//FPicsExtensionsList:=TStringList.Create;
//FPicsExtensionsList.Text:='.bmp,.jpg,.jpeg,.png';

end;

procedure TfTestDiminshPics.FormDestroy(Sender: TObject);
begin
//FreeAndNil(FPicsExtensionsList);
end;


{
procedure TfTestDiminshPics.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 );
  graphicsGDIPlus.DrawImage(ImageTemp , 0,0,W,H);
  ImageTemp.Free;
  graphicsGDIPlus.Free;
  end;


end;

}

{
procedure TfTestDiminshPics.GDIPlusShrinkPicture(bmp:tbitmap);

var graphics :TGPGraphics;
    image:TGPImage;

begin



graphics := TGPGraphics.Create(bmp.Canvas.Handle);

//  image:= TGPImage.Create(FileName);
  width  := image.GetWidth;
  height := image.GetHeight;

  // Shrink the image using high-quality interpolation.
  graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);
  graphics.DrawImage(
    image,
    MakeRect(0, 0, 0.6*width, 0.6*height),  // destination rectangle
    0, 0,        // upper-left corner of source rectangle
    width,       // width of source rectangle
    height,      // height of source rectangle
    UnitPixel);
  image.Free;
  graphics.Free;



end;
}

procedure TfTestDiminshPics.GDIPlusClick(Sender: TObject);
var
  bmp, bmpDiminished: TBItmap; twic:TWICImage;

  maxWidth:integer;
  maxHeight:integer;

  currentWidth:integer;
  currentHeight:integer;

  k:Extended;

begin

  maxWidth:=100;
  maxHeight:=100;

  if opendialog1.execute then begin

    twic:=TWICImage.Create;

    bmp:= Tbitmap.Create;
    bmpDiminished:= Tbitmap.Create;

    try

        twic.LoadFromFile(opendialog1.filename);
        bmp.Assign(twic);

        currentWidth:=bmp.Width; currentHeight:=bmp.Height;

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

        currentWidth:=Trunc(k*currentWidth); currentHeight:=Trunc(k*currentHeight);

      //  ShowMessage('Width '+bmp.Width.ToString() +' Height'+bmp.Height.ToString());

      //  LoadAAImageFromFile(OpenDialog1.FileName,currentWidth,currentHeight,bmpDiminished);
        bmpDiminished.SaveToFile(ChangeFileext( opendialog1.filename, '_thumb.BMP' ));


    finally
      FreeAndNil(bmp);
      FreeAndNil(bmpDiminished);
      FreeAndNil(twic);
      ShowMessage('success');
    end;
  end;
end;


{

procedure TfTestDiminshPics.GDIplusDiminishPic(FilePath:string);
var
  thumbnailPicsDir: string;

  bmp, bmpDiminished: TBItmap; twic:TWICImage;

  maxWidth:integer;
  maxHeight:integer;

  currentWidth:integer;
  currentHeight:integer;

  koeff:Extended;
  NewWidth: integer;
  NewHeight: integer;
  CurrentFileName: string;
  FileExtension: string;
  NewFileName: string;

  Picture:TPicture;

begin

//Checks...
if not TFile.Exists(FilePath) then exit;


//Creating dir for Thumbs if not Existed
thumbnailPicsDir:=ExtractFileDir(Application.ExeName)+'\thumbnailPics';
if not TDirectory.Exists( thumbnailPicsDir) then
TDirectory.CreateDirectory(thumbnailPicsDir);
//----

//Getting FileExtension
FileExtension:=ExtractFileExt(FilePath);

//Setting MaxSize On the Exit...
      maxWidth:=50;
      maxHeight:=50;


        twic:=TWICImage.Create;

        bmp:= Tbitmap.Create;
        bmpDiminished:= Tbitmap.Create;

        Picture:=TPicture.Create;

        try

            //twic.LoadFromFile(FilePath);
            Picture.LoadFromFile(FilePath);
            bmp.Assign(Picture.Bitmap);



            currentWidth:=bmp.Width; currentHeight:=bmp.Height;

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

            // New width and height
            NewWidth:=Trunc(koeff*currentWidth);
            NewHeight:=Trunc(koeff*currentHeight);

            CurrentFileName:=ExtractFileName(FilePath);
            NewFileName:=ChangeFileext( CurrentFileName, '_thumb'+FileExtension ); // <<NewExtension

          //  LoadAAImageFromFile(FilePath,NewWidth,NewHeight,bmpDiminished);
            bmpDiminished.SaveToFile(thumbnailPicsDir+'\'+NewFileName);

        finally
          FreeAndNil(Picture);
          FreeAndNil(bmp);
          FreeAndNil(bmpDiminished);
         // FreeAndNil(twic);
        //  ShowMessage('success');
        end;


end;

}

procedure TfTestDiminshPics.DiminishPic(FilePath:string);
var
  thumbnailPicsDir: string;

  bmp, bmpDiminished: TBItmap; twic:TWICImage;

  maxWidth:integer;
  maxHeight:integer;

  currentWidth:integer;
  currentHeight:integer;

  koeff:Extended;
  NewWidth: integer;
  NewHeight: integer;
  CurrentFileName: string;
  FileExtension: string;
  NewFileName: string;

  Picture:TPicture;
  ms: TMemoryStream;
  size:int64;

  cs:TCriticalSection;

begin

//Checks...
if not TFile.Exists(FilePath) then exit;


//Creating dir for Thumbs if not Existed
thumbnailPicsDir:=ExtractFileDir(Application.ExeName)+'\thumbnailPics';
if not TDirectory.Exists( thumbnailPicsDir) then
TDirectory.CreateDirectory(thumbnailPicsDir);
//----

//Getting FileExtension
FileExtension:=ExtractFileExt(FilePath);

//Setting MaxSize On the Exit...
      maxWidth:=50;
      maxHeight:=50;


        twic:=TWICImage.Create;

        bmp:= Tbitmap.Create;
        bmpDiminished:= Tbitmap.Create;

        Picture:=TPicture.Create;

        ms:=TMemoryStream.Create;

        cs:=TCriticalSection.Create;

        cs.Enter;

        try

        //    twic.LoadFromFile(FilePath);
        //    twic.SaveToStream(ms);
            Picture.LoadFromFile(FilePath);

             bmp.Assign(Picture.Bitmap);
          //  bmp.LoadFromStream(ms);


            currentWidth:=bmp.Width; currentHeight:=bmp.Height;

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

            // New width and height
            NewWidth:=Trunc(koeff*currentWidth);
            NewHeight:=Trunc(koeff*currentHeight);

            CurrentFileName:=ExtractFileName(FilePath);
            NewFileName:=ChangeFileext( CurrentFileName, '_thumb'+FileExtension ); // <<NewExtension


           bmpDiminished.Width:=NewWidth; bmpDiminished.Height:=NewHeight;
           bmpDiminished.Canvas.StretchDraw(Rect(0, 0, NewWidth, NewHeight), bmp);

            bmpDiminished.SaveToFile(thumbnailPicsDir+'\'+NewFileName);

        finally



          FreeAndNil(ms);
          //FreeAndNil(Picture);
          FreeAndNil(bmp);
          FreeAndNil(bmpDiminished);

          cs.Leave;

         // FreeAndNil(twic);
        //  ShowMessage('success');
        end;


end;







procedure TfTestDiminshPics.ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer);
 var
   xini, xfi, yini, yfi, saltx, salty: single;
   x, y, px, py, tpix: integer;
   PixelColor: TColor;
   r, g, b: longint;

   function MyRound(const X: Double): Integer;
   begin
     Result := Trunc(x);
     if Frac(x) >= 0.5 then
       if x >= 0 then Result := Result + 1
       else
         Result := Result - 1;
     // Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5);
  end;

 begin
   // Set target size

  imgd.Width  := nw;
   imgd.Height := nh;

   // Calcs width & height of every area of pixels of the source bitmap

  saltx := imgo.Width / nw;
   salty := imgo.Height / nh;


   yfi := 0;
   for y := 0 to nh - 1 do
   begin
     // Set the initial and final Y coordinate of a pixel area

    yini := yfi;
     yfi  := yini + salty;
     if yfi >= imgo.Height then yfi := imgo.Height - 1;

     xfi := 0;
     for x := 0 to nw - 1 do
     begin
       // Set the inital and final X coordinate of a pixel area

      xini := xfi;
       xfi  := xini + saltx;
       if xfi >= imgo.Width then xfi := imgo.Width - 1;


       // This loop calcs del average result color of a pixel area
      // of the imaginary grid

      r := 0;
       g := 0;
       b := 0;
       tpix := 0;

       for py := MyRound(yini) to MyRound(yfi) do
       begin
         for px := MyRound(xini) to MyRound(xfi) do
         begin
           Inc(tpix);
           PixelColor := ColorToRGB(imgo.Canvas.Pixels[px, py]);
           r := r + GetRValue(PixelColor);
           g := g + GetGValue(PixelColor);
           b := b + GetBValue(PixelColor);
         end;
       end;

       // Draws the result pixel

      imgd.Canvas.Pixels[x, y] :=
         rgb(MyRound(r / tpix),
         MyRound(g / tpix),
         MyRound(b / tpix)
         );
     end;
   end;
 end;


end.
