Размер = Высота*Ширина*КоличествоБайтНаКаждыйПиксель

Imports System.IO
Imports System.Drawing.Imaging

Module All

Public Function GetJpegContent(ByVal Pct As Image) As Byte()
  Dim File As New MemoryStream
  Pct.Save(File, ImageFormat.Jpeg)
  Return File.ToArray()
End Function

Public Function GetJpegContent(ByVal Pct As Image, ByVal Quality As Long) As Byte()
  Dim File As New MemoryStream
  Dim EncoderParams As New EncoderParameters(1)
  EncoderParams.Param(0) = New EncoderParameter(Encoder.Quality, Quality)
  Pct.Save(File, GetEncoderInfo("image/jpeg"), EncoderParams)
  Return File.ToArray()
End Function

Private Function GetEncoderInfo(ByVal MimeType As String) As ImageCodecInfo
  For Each Codec As ImageCodecInfo In ImageCodecInfo.GetImageEncoders()
    If Codec.MimeType = MimeType Then Return Codec
  Next Codec
  Return Nothing
End Function

Public Function ReduceByQuality(ByVal Pct As Image, ByVal Lim As Integer) As Byte()
  Dim LastOk() As Byte = Nothing, Res() As Byte
  Dim L As Integer = 0, R As Integer = 100, Cur As Integer

  Do While L < R
    Cur = (L + R + 1) >> 1
    Res = GetJpegContent(Pct, Cur)
    If Res.Length > Lim Then
      R = Cur - 1
    Else
      L = Cur
      LastOk = Res
    End If
  Loop

  Return LastOk
End Function

Public Function ReduceBySize(ByVal Pct As Image, ByVal Lim As Integer) As Byte()
  Dim LastOk() As Byte = Nothing, Res() As Byte
  Dim LHeight As Integer = 0, RHeight As Integer = Pct.Height, CurHeight As Integer
  Dim LWidth As Integer = 0, RWidth As Integer = Pct.Width, CurWidth As Integer

  Do While LHeight < RHeight
    CurHeight = (LHeight + RHeight + 1) >> 1
    CurWidth = (LWidth + RWidth + 1) >> 1
    Res = GetJpegContent(New System.Drawing.Bitmap(CType(Pct, Bitmap), CurWidth, CurHeight))
    If Res.Length > Lim Then
      RHeight = CurHeight - 1
      RWidth = CurWidth - 1
    Else
      LHeight = CurHeight
      LWidth = CurWidth
      LastOk = Res
    End If
  Loop

  Return LastOk
End Function

Public Sub Main()
  My.Computer.FileSystem.WriteAllBytes("ReduceByQuality.jpg", ReduceByQuality(Bitmap.FromFile("input.jpg"), 307200), False)
  My.Computer.FileSystem.WriteAllBytes("ReduceBySize.jpg", ReduceBySize(Bitmap.FromFile("input.jpg"), 307200), False)
  MsgBox("Ready")
End Sub

End Module