function CompressImageFile(FileName: string;  Width, Height: integer; PressQuality:Integer= 90): Boolean;

   function GetNewSize(OldWidth, OldHeight: integer; NewWidth, NewHeight: integer; var RetWidth, RetHeight: integer):Boolean;

   var

       H:Boolean;

   begin

       Result := False;

       if (NewHeight < OldHeight) or (NewWidth < OldWidth) then

       begin

          H := NewHeight < OldHeight;

 

          if H then

          begin //按比例缩小,按高度来算高度的

             RetHeight := NewHeight;

             RetWidth := Round(OldWidth *  (NewHeight/OldHeight));

          end

          else

          begin //按比例缩小,按宽度来算宽度的

             RetWidth := NewWidth;

             RetHeight := Round(OldHeight * (NewWidth/OldWidth));

          end;

          Result:=True;

       end;

   end;

var

   bmp: TBitmap;

   jpg: TJpegImage;

   png: TPNGGraphic;

   i: Integer;

   sTemp: string;

begin

 

   Result := False;

   try

      bmp := TBitmap.Create;

      jpg := TJPEGImage.Create;

      png := TPNGGraphic.Create;

      if pos(UpperCase('.bmp'), UpperCase(filename)) <> 0 then   //bmp格式

      begin

         bmp.LoadFromFile(filename);

         jpg.Assign(bmp);

         jpg.CompressionQuality := PressQuality;

         jpg.Compress;

         if GetNewSize(bmp.Width,bmp.height,Width,Height,Width,Height) then

         begin

            bmp.height := Height;

            bmp.Width := Width;

            bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);

            jpg.Assign(bmp);

            sTemp := filename + '.lq';

            jpg.SaveToFile(sTemp);

            DeleteFile(filename);

            CopyFile(PChar(sTemp), PChar(filename), True);

            DeleteFile(sTemp);

            Result := True;

         end;

      end

      else if pos(UpperCase('.png'), UpperCase(filename)) <> 0 then //jpg其它格式

      begin

         jpg.LoadFromFile(filename);

         if GetNewSize(jpg.Width,jpg.height,Width,Height,Width,Height) then

         begin

            bmp.height := Height;

            bmp.Width := Width;

            bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);

            jpg.Assign(bmp);

            jpg.CompressionQuality := PressQuality;

            jpg.Compress;

            sTemp := filename + '.lq';

            jpg.SaveToFile(sTemp);

            DeleteFile(filename);

            CopyFile(PChar(sTemp), PChar(filename), True);

            DeleteFile(sTemp);

            Result := True;

         end;

      end

      else if pos(UpperCase('.png'), UpperCase(filename)) <> 0 then   //png格式

      begin

         png.LoadFromFile(filename);

         if GetNewSize(png.Width,png.height,Width,Height,Width,Height) then

         begin

            bmp.height := Height;

            bmp.Width := Width;

            bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, png);

            jpg.Assign(bmp);

            jpg.CompressionQuality := PressQuality;

            jpg.Compress;

            sTemp := filename + '.lq';

            jpg.SaveToFile(sTemp);

            DeleteFile(filename);

            CopyFile(PChar(sTemp), PChar(filename), True);

            DeleteFile(sTemp);

            Result := True;

         end;

      end;

   finally

      FreeAndNil(bmp);

      FreeAndNil(jpg);

      FreeAndNil(png);

   end;

end;

 

procedure TForm1.btn1Click(Sender: TObject);

begin

   CompressImageFile('d:\png\222.png', 200, 200);

end;

————————————————

原文链接：https://blog.csdn.net/lqena/article/details/78732255