B4J Code Snippet [B4X] Reduce an image file to a specific size - for example, <500KB to upload to the Forum.

B4X:
Sub Class_Globals
    Private Root As B4XView
    Private xui As XUI

    Public original As B4XBitmap
    Public stage As B4XRect
    Public imageLayer As B4XView
    Public imageCV As B4XCanvas
    Private imageDir As String
    Private imageFile As String
    
    Private maxSize As Long = 200000
End Sub

Private Sub B4XPage_Created (Root1 As B4XView)
    Root = Root1
    imageCV.Initialize(Root)
    Public stage As B4XRect
    stage.Initialize(0, 0, Root.Width, Root.Height)
    
    'specify your imageFile
    imageDir = "C:\Users\willi\Desktop\Images"
    imageFile = "TrainMoment.png"   'as an example

    original = xui.LoadBitmap(imageDir, imageFile)
    imageCV.DrawBitmap(original, stage)


    Dim fn As String = imageFile.SubString2(0, imageFile.LastIndexOf(".")) & "_NEW.jpeg"
    Dim bmp As B4XBitmap = imageCV.CreateBitmap

    Dim sz As Long = 1 / 0
    Dim perc As Float = 100
    Do While sz > maxSize
        Dim out As OutputStream = File.OpenOutput(imageDir, fn, False)
        bmp.WriteToStream(out, perc, "JPEG")
        out.Close
        sz = File.Size(imageDir, fn)
        perc = perc - 1
        Log(perc & TAB & sz)
        If perc < 5 Then Exit
    Loop
    bmp = xui.LoadBitmap(imageDir, fn)
    imageCV.DrawBitmap(bmp, stage)
End Sub
 

kimstudio

Active Member
Licensed User
Longtime User
Dim sz As Long = 1 / 0

It is interesting to see using this to get LONG_MAX. I know there are some discussions on dividing zero in the forum.

It is also interesting to see following test results:

B4X:
    Dim sz As Long = 1/0
    Log(sz)
    sz = Power(2, 64)  'should be 18446744073709551616, but Long is signed so only half? internally how it converts from double to long?
    Log(sz)
    sz = Bit.ShiftLeftLong(1, 63) 'how to use bitshift to get LONG_MAX?
    Log(sz)
Log:
9223372036854775807
9223372036854775807
-9223372036854775808
 

William Lancee

Well-Known Member
Licensed User
Longtime User
You might be interested in
 

xulihang

Active Member
Licensed User
Longtime User
I have a similar solution which reduces the image quality. But it will take some time to process a very large image. Maybe we should take the resolution into consideration as well.
 

William Lancee

Well-Known Member
Licensed User
Longtime User
I wrote this code to convert a file just once. Either prior to using in an App or afterwards to upload it somewhere.
On my somewhat fast computer, it took just over 2 seconds to convert a 2166928 bytes file to 199211 bytes in 35 steps.

Obviously, it is a brute force technique, but it is simple and speedy enough for the purpose.
The method reduces the information and hence resolution of the image. That's why one should check if it is still OK.
 

stevel05

Expert
Licensed User
Longtime User
If you set a tolerance, you could use a binary chop to reduce the iterations. so > 180000 and < 200000
 

kimstudio

Active Member
Licensed User
Longtime User
If you set a tolerance, you could use a binary chop to reduce the iterations. so > 180000 and < 200000
Could u elaborate this steve? I see this can be optimized by prior knowledge of setting a jpeg quality parameter first based on orig size and target size, then +/- quality para in loop.

Also "resolution" in discussion here may mean the size of image? most of time we need to keep the image size.
 

stevel05

Expert
Licensed User
Longtime User
Something like this:

B4X:
Public Sub ResizeImage(BMP As B4XBitmap, ImageDir As String, fn As String, MinSize As Int, MaxSize As Int) As B4XBitmap
    Dim sz As Long = 1 / 0
    Dim IMax As Float = 100
    Dim IMin As Float = 0
    Dim IMid As Float = (IMax - IMin) / 2
 
    'Get the original size
    Dim out As OutputStream = File.OpenOutput(ImageDir, fn, False)
    BMP.WriteToStream(out, IMax, "JPEG")
    out.Close
    sz = File.Size(ImageDir, fn)
 
    If sz < MinSize Then
        Log("Resize not necessary")
        Return BMP
    End If
 
    Dim Count As Int = 0
    Do While sz > MaxSize Or sz < MinSize
        If sz < MinSize Then
            IMin = IMid
            IMid = IMid + (IMax - IMid) / 2
        Else If sz > MaxSize Then
            IMax = IMid
            IMid = IMid - (IMid - IMin) / 2
        End If
  
        Dim out As OutputStream = File.OpenOutput(ImageDir, fn, False)
        BMP.WriteToStream(out, IMid, "JPEG")
        out.Close
        sz = File.Size(ImageDir, fn)

        'May not be able to get it within the tolerance, this is a close as it will get
        If IMax = IMid Or IMid = IMin Then Exit

        Count = Count + 1
    Loop
 
    Log("Found or failed in " & Count & " iterations")
 
    Log(IMax & TAB & IMid & TAB & IMin & TAB & sz)
    Dim NewBMP As B4XBitmap =  xui.LoadBitmap(ImageDir,fn)
 
    Return NewBMP
End Sub


It gives an image within the tolerance from a 1.7 MB file in 6 iterations.

Usage
B4X:
    Dim Bmp As B4XBitmap = xui.LoadBitmap("D:\","ImgSizeTest.jpg")
    Log(File.Size("D:\","ImgSizeTest.jpg"))
 
    ResizeImage(Bmp,"D:\","test-resize.jpg",190000,200000)

The image Width and Height is not changed, just the quality of the image. As William suggests you will need to check that the resultant image is usable.

If the provided tolerance is too narrow, the routine will eventually give up if it can't make the image fit.
 
Last edited:

kimstudio

Active Member
Licensed User
Longtime User
Thanks steve, as the function of quality parameter and compressed size is monotonic, I got your point for this binary chop method.
 

emexes

Expert
Licensed User
B4X:
sz = Bit.ShiftLeftLong(1, 63) 'how to use bitshift to get LONG_MAX?

Yeah, the 32-bitness of Bit. operations often trips me up.

B4X:
'ideally you'd be able to do:

'Dim MaxLong As Long = 0x7FFFFFFFFFFFFFFF
   
'but the closest I've ever got to that is this:

Dim bc As ByteConverter
Dim MaxLong As Long = bc.LongsFromBytes(Array As Byte(127, 255, 255, 255, 255, 255, 255, 127))(0) + 128    '127 at both ends so doesn't matter if big- or little-endian

Log("MaxLong - 1 =" & TAB & (MaxLong - 1))
Log("MaxLong = "    & TAB & (MaxLong    ))
Log("MaxLong + 1 =" & TAB & (MaxLong + 1))
Log("MaxLong + 2 =" & TAB & (MaxLong + 2))

Log output:
Waiting for debugger to connect...
Program started.
MaxLong - 1 =    9223372036854775806
MaxLong =         9223372036854775807
MaxLong + 1 =    -9223372036854775808
MaxLong + 2 =    -9223372036854775807
 

emexes

Expert
Licensed User
B4X:
'ideally you'd be able to do:
'Dim MaxLong As Long = 0x7FFFFFFFFFFFFFFF

Far out, brussell sprout! Just had an epiphany, tried adding L to end of hex literal, and...
B4X:
Dim MaxLong As Long = 0x7FFFFFFFFFFFFFFFL

Log("MaxLong - 1 =" & TAB & (MaxLong - 1))
Log("MaxLong     =" & TAB & (MaxLong    ))
Log("MaxLong + 1 =" & TAB & (MaxLong + 1))
Log("MaxLong + 2 =" & TAB & (MaxLong + 2))

Log output:
Waiting for debugger to connect...
Program started.
MaxLong - 1 =    9223372036854775806
MaxLong     =    9223372036854775807
MaxLong + 1 =    -9223372036854775808
MaxLong + 2 =    -9223372036854775807

You've made my day, maybe even my year. Thanks for that. 🍻
 

kimstudio

Active Member
Licensed User
Longtime User
adding L to end of hex literal
Adding L with b4j 9.3 java 1.8.202 causes error, then it just works without adding L.

Dim MaxLong As Long = 0x7FFFFFFFFFFFFFFF works.
 

OliverA

Expert
Licensed User
Longtime User
I really don't know if it matters much, but here is a version that only writes to disk once and never reads from disk

B4X:
Public Sub ResizeImage(BMP As B4XBitmap, ImageDir As String, fn As String, MinSize As Int, MaxSize As Int) As B4XBitmap
	Dim sz As Long = 1 / 0
	Dim IMax As Float = 100
	Dim IMin As Float = 0
	Dim IMid As Float = (IMax - IMin) / 2
 
	'Get the original size
'	Dim out As OutputStream = File.OpenOutput(ImageDir, fn, False)
'	BMP.WriteToStream(out, IMax, "JPEG")
'	out.Close
'	sz = File.Size(ImageDir, fn)
	Dim imageBytes() As Byte = ImageToBytes2(BMP, IMax)
	sz = imageBytes.Length
	Log($"Size: ${sz}"$)
 
	If sz < MinSize Then
		Log("Resize not necessary")
		Return BMP
	End If
 
	Dim Count As Int = 0
	Do While sz > MaxSize Or sz < MinSize
		If sz < MinSize Then
			IMin = IMid
			IMid = IMid + (IMax - IMid) / 2
		Else If sz > MaxSize Then
			IMax = IMid
			IMid = IMid - (IMid - IMin) / 2
		End If
  
'		Dim out As OutputStream = File.OpenOutput(ImageDir, fn, False)
'		BMP.WriteToStream(out, IMid, "JPEG")
'		out.Close
'		sz = File.Size(ImageDir, fn)
		imageBytes = ImageToBytes2(BMP, IMid)
		sz = imageBytes.Length

		'May not be able to get it within the tolerance, this is a close as it will get
		If IMax = IMid Or IMid = IMin Then Exit

		Count = Count + 1
	Loop
 
 	File.WriteBytes(ImageDir, fn, imageBytes)

	Log("Found or failed in " & Count & " iterations")
 
	Log(IMax & TAB & IMid & TAB & IMin & TAB & sz)
	Dim NewBMP As B4XBitmap = BytesToImage(imageBytes)
	Return NewBMP
End Sub

'Adapted from
'https://www.b4x.com/android/forum/threads/b4x-bytes-to-file.70111/post-445167
Public Sub ImageToBytes2(Image As B4XBitmap, Quality As Int) As Byte()
	Dim out As OutputStream
	out.InitializeToBytesArray(0)
	Image.WriteToStream(out, Quality, "JPEG")
	out.Close
	Return out.ToBytesArray
End Sub

Public Sub BytesToImage(bytes() As Byte) As B4XBitmap
	Dim In As InputStream
	In.InitializeFromBytesArray(bytes, 0, bytes.Length)
#if B4A or B4i
   Dim bmp As Bitmap
   bmp.Initialize2(In)
#else
	Dim bmp As Image
	bmp.Initialize2(In)
#end if
	Return bmp
End Sub

Note:
B4X:
	'Get the original size
'	Dim out As OutputStream = File.OpenOutput(ImageDir, fn, False)
'	BMP.WriteToStream(out, IMax, "JPEG")
'	out.Close
'	sz = File.Size(ImageDir, fn)
	Dim imageBytes() As Byte = ImageToBytes2(BMP, IMax)
	sz = imageBytes.Length
	Log($"Size: ${sz}"$)
Neither the commented-out code nor the new code really returns the "original" size. It returns the size of the B4XBitmap at 100% Quality. In my case, a ~ 400K JPEG on disk produces a ~800K byte array via the above code. The end result is still pretty much the same.
 

OliverA

Expert
Licensed User
Longtime User
Far out, brussell sprout! Just had an epiphany, tried adding L to end of hex literal, and...
What version of B4J are you using? In older versions (pre 9.30), you could use the L at the end of a hex literal. The newer versions don't accept it anymore and plain
B4X:
Dim maxlong As Long = 0x7FFFFFFFFFFFFFFF
Works
See:
 

emexes

Expert
Licensed User
What version of B4J are you using? In older versions (pre 9.30),

I feel like you're trying to give me a hint, but precisely what, I can't quite put my finger on... 🤔

1665434882155.png
 

kimstudio

Active Member
Licensed User
Longtime User
I really don't know if it matters much
I think it matters a lot as disk IO is usually the bottleneck for speed. Glad to know it can work in memory in this way! 👍
 
Top