Private Sub Button1_Click
CC.Show("image/*", "Choose image")
'CC.Show("audio/*", "Choose audio file")
End Sub
Sub CC_Result (Success As Boolean, Dir As String, FileName As String)
If Success = True Then
Dim TargetSize As Int =600 * 1024
Dim FileSize As Long = File.Size(Dir, FileName)
If FileSize > TargetSize Then
ResizeImageBasedOnMaxFileSize(xui.LoadBitmap(Dir, FileName), TargetSize, xui.DefaultFolder, FileName)
ImageView1.Bitmap = LoadBitmap(xui.DefaultFolder,FileName)
Else
ImageView1.Bitmap = LoadBitmap(Dir, FileName)
End If
Else
ToastMessageShow("No Success :(",True)
End If
End Sub
Private Sub ResizeImageBasedOnMaxFileSize (Img As B4XBitmap, MaxSize As Long, OutputFolder As String, OutputFile As String)'图片压缩算法
Dim Quality As Int = 100
Dim Size As Long = MaxSize + 1
Do While Size > MaxSize And Quality >= 10
Dim out As OutputStream = File.OpenOutput(OutputFolder, OutputFile, False)
Img.WriteToStream(out, Quality, "JPEG")
out.Close
Size = File.Size(OutputFolder, OutputFile)
Log($"Quality: ${Quality}%, Size: $1.0{Size / 1024}kb"$)
Quality = Quality - 5
Loop
End Sub
Private Sub btnViewImage_Click
Dim FileName As String = "b4a.png"
File.Copy(File.DirAssets, FileName, Provider.SharedFolder, FileName)
Dim filesize As Long = File.Size(Provider.SharedFolder, FileName)
Log((filesize/1024) & "KB")
Dim in As Intent
in.Initialize(in.ACTION_VIEW, "")
Provider.SetFileUriAsIntentData(in, FileName)
'Type must be set after calling SetFileUriAsIntentData
in.SetType("image/*")
StartActivity(in)
End Sub
Which problem are you trying to solve? There is (almost) no relation between the file size and the memory required to load it.
If you are loading external images then you shouldn't use LoadBitmap. Use XUI.LoadBitmapResize instead. This will solve memory issues.
Sub CC_Result (Success As Boolean, Dir As String, FileName As String)
If Success = True Then
Dim TargetSize As Int =600 * 1024
File.Copy(File.DirAssets, FileName, Provider.SharedFolder, FileName)
Dim filesize As Long = File.Size(Provider.SharedFolder, FileName)/1024'得出KB
If filesize > TargetSize Then
ResizeImageBasedOnMaxFileSize(xui.LoadBitmap(Dir, FileName), TargetSize, xui.DefaultFolder, FileName)
ImageView1.Bitmap = LoadBitmap(xui.DefaultFolder,FileName)
Else
ImageView1.Bitmap = LoadBitmap(Dir, FileName)
End If
Else
ToastMessageShow("No Success :(",True)
End If
End Sub
Private Sub Button1_Click
Dim cc As ContentChooser
cc.Initialize("cc")
cc.Show("image/*", "Choose image")
Wait For cc_Result (Success As Boolean, Dir As String, FileName As String)
If Success Then
Dim bmp As B4XBitmap = LoadBitmap(Dir, FileName)
ImageView1.Bitmap = ResizeBitmapMaxByte(bmp, 600000)
End If
End Sub
'https://www.b4x.com/android/forum/threads/resize-bitmap-with-a-maximum-byte-limit.86793/
Sub ResizeBitmapMaxByte(Original As B4XBitmap, MaxByte As Long) As B4XBitmap
Dim ByteSize As Long
Dim ObjectBitmap As JavaObject = Original
Dim Api_Lelvel As JavaObject
Api_Lelvel.InitializeStatic("android.os.Build.VERSION")
If Api_Lelvel.GetField("SDK_INT") >= 19 Then 'kitkat
ByteSize = ObjectBitmap.RunMethod("getAllocationByteCount", Null)
else if Api_Lelvel.GetField("SDK_INT") >= 12 Then 'Android 3.1 Honeycomb
ByteSize = ObjectBitmap.RunMethod("getByteCount", Null)
Else 'earlier Android versions
ByteSize = ObjectBitmap.RunMethod("getRowBytes", Null) * Original.Height
End If
Dim Ratio As Float = Sqrt(MaxByte/ByteSize)
If Ratio<1 Then
Dim Width As Int = (Original.Width * Ratio)
Dim Height As Int = (Original.Height * Ratio)
LogColor($"resized: ${Width}x${Height}"$,xui.Color_Cyan)
Return Original.Resize(Width, Height, True)
Else
LogColor("original",xui.Color_Cyan)
Return Original
End If
End Sub
You still know me, thank you very muchuse
B4X:Private Sub Button1_Click Dim cc As ContentChooser cc.Initialize("cc") cc.Show("image/*", "Choose image") Wait For cc_Result (Success As Boolean, Dir As String, FileName As String) If Success Then Dim bmp As B4XBitmap = LoadBitmap(Dir, FileName) ImageView1.Bitmap = ResizeBitmapMaxByte(bmp, 600000) End If End Sub 'https://www.b4x.com/android/forum/threads/resize-bitmap-with-a-maximum-byte-limit.86793/ Sub ResizeBitmapMaxByte(Original As B4XBitmap, MaxByte As Long) As B4XBitmap Dim ByteSize As Long Dim ObjectBitmap As JavaObject = Original Dim Api_Lelvel As JavaObject Api_Lelvel.InitializeStatic("android.os.Build.VERSION") If Api_Lelvel.GetField("SDK_INT") >= 19 Then 'kitkat ByteSize = ObjectBitmap.RunMethod("getAllocationByteCount", Null) else if Api_Lelvel.GetField("SDK_INT") >= 12 Then 'Android 3.1 Honeycomb ByteSize = ObjectBitmap.RunMethod("getByteCount", Null) Else 'earlier Android versions ByteSize = ObjectBitmap.RunMethod("getRowBytes", Null) * Original.Height End If Dim Ratio As Float = Sqrt(MaxByte/ByteSize) If Ratio<1 Then Dim Width As Int = (Original.Width * Ratio) Dim Height As Int = (Original.Height * Ratio) LogColor($"resized: ${Width}x${Height}"$,xui.Color_Cyan) Return Original.Resize(Width, Height, True) Else LogColor("original",xui.Color_Cyan) Return Original End If End Sub
This code will cause color loss in the image, resulting in the image being cut and reassembleduse
B4X:Private Sub Button1_Click Dim cc As ContentChooser cc.Initialize("cc") cc.Show("image/*", "Choose image") Wait For cc_Result (Success As Boolean, Dir As String, FileName As String) If Success Then Dim bmp As B4XBitmap = LoadBitmap(Dir, FileName) ImageView1.Bitmap = ResizeBitmapMaxByte(bmp, 600000) End If End Sub 'https://www.b4x.com/android/forum/threads/resize-bitmap-with-a-maximum-byte-limit.86793/ Sub ResizeBitmapMaxByte(Original As B4XBitmap, MaxByte As Long) As B4XBitmap Dim ByteSize As Long Dim ObjectBitmap As JavaObject = Original Dim Api_Lelvel As JavaObject Api_Lelvel.InitializeStatic("android.os.Build.VERSION") If Api_Lelvel.GetField("SDK_INT") >= 19 Then 'kitkat ByteSize = ObjectBitmap.RunMethod("getAllocationByteCount", Null) else if Api_Lelvel.GetField("SDK_INT") >= 12 Then 'Android 3.1 Honeycomb ByteSize = ObjectBitmap.RunMethod("getByteCount", Null) Else 'earlier Android versions ByteSize = ObjectBitmap.RunMethod("getRowBytes", Null) * Original.Height End If Dim Ratio As Float = Sqrt(MaxByte/ByteSize) If Ratio<1 Then Dim Width As Int = (Original.Width * Ratio) Dim Height As Int = (Original.Height * Ratio) LogColor($"resized: ${Width}x${Height}"$,xui.Color_Cyan) Return Original.Resize(Width, Height, True) Else LogColor("original",xui.Color_Cyan) Return Original End If End Sub
Please send me the image so I can test it here on my deviceThis code will cause color loss in the image, resulting in the image being cut and reassembled
use
B4X:Private Sub Button1_Click Dim cc As ContentChooser cc.Initialize("cc") cc.Show("image/*", "Choose image") Wait For cc_Result (Success As Boolean, Dir As String, FileName As String) If Success Then Dim bmp As B4XBitmap = LoadBitmap(Dir, FileName) ImageView1.Bitmap = ResizeBitmapMaxByte(bmp, 600000) End If End Sub 'https://www.b4x.com/android/forum/threads/resize-bitmap-with-a-maximum-byte-limit.86793/ Sub ResizeBitmapMaxByte(Original As B4XBitmap, MaxByte As Long) As B4XBitmap Dim ByteSize As Long Dim ObjectBitmap As JavaObject = Original Dim Api_Lelvel As JavaObject Api_Lelvel.InitializeStatic("android.os.Build.VERSION") If Api_Lelvel.GetField("SDK_INT") >= 19 Then 'kitkat ByteSize = ObjectBitmap.RunMethod("getAllocationByteCount", Null) else if Api_Lelvel.GetField("SDK_INT") >= 12 Then 'Android 3.1 Honeycomb ByteSize = ObjectBitmap.RunMethod("getByteCount", Null) Else 'earlier Android versions ByteSize = ObjectBitmap.RunMethod("getRowBytes", Null) * Original.Height End If Dim Ratio As Float = Sqrt(MaxByte/ByteSize) If Ratio<1 Then Dim Width As Int = (Original.Width * Ratio) Dim Height As Int = (Original.Height * Ratio) LogColor($"resized: ${Width}x${Height}"$,xui.Color_Cyan) Return Original.Resize(Width, Height, True) Else LogColor("original",xui.Color_Cyan) Return Original End If End Sub
My APP principle: Select an image and check if it is larger than 600KB. If it is smaller than 600KB, upload it directly to the database. If it is larger than 600KB, compress and upload it. Then click the button to query the records according to the device ID and date. Select one of the records and the image will be automatically displayed in the ImageView control. During this process, some images will be displayed completely, while others will be distorted. I have verified that it is not related to the size or format of the image. Currently, I have found a phenomenon that if the APP is running for the first time and the uploaded image is queried and viewed normally, the images after the first one are distorted. I suspect that it is caused by the release of a variable value when it is turned off?View attachment 161244
I carried out the tests here, and it worked normally without loss of quality or color distortions.
Private Sub CustomListView1_ItemClick (Index As Int, Value As Object)'短按查看图片
Dim cx1 As Int =CustomListView1.GetValue(Index)'获取当前点击的CustomListView1_Item的序号
Dim Cursor As JdbcResultSet= Starter.Mysql_Jdbc.ExecQuery2("SELECT * FROM 记录表 WHERE `序号`= ? ", Array As String(cx1)) '防止SQL注入
Do While Cursor.NextRow
Dim nc As String=Cursor.GetString("账单图片")'查找结果赋值nc
Loop
ImageView1.Bitmap = Base64EncodeDecodeImage.Base64StringToImage(nc)'加载图片
End Sub
Please send me the image so I can test it here on my device
Private Sub Button1_Click
Dim CC As ContentChooser
CC.Initialize("cc")
CC.Show("image/*", "Choose image")
Wait For CC_Result (Success As Boolean, Dir As String, FileName As String)
If Success Then
Dim bmp As B4XBitmap = LoadBitmap(Dir, FileName)
ImageView1.Bitmap = ResizeBitmapMaxByte(bmp, 600000)
' ImageView1.Bitmap = LoadBitmap(Dir, FileName)
End If
End Sub
My APP principle: Select an image and check if it is larger than 600KB. If it is smaller than 600KB, upload it directly to the database. If it is larger than 600KB, compress and upload it. Then click the button to query the records according to the device ID and date. Select one of the records and the image will be automatically displayed in the ImageView control. During this process, some images will be displayed completely, while others will be distorted. I have verified that it is not related to the size or format of the image. Currently, I have found a phenomenon that if the APP is running for the first time and the uploaded image is queried and viewed normally, the images after the first one are distorted. I suspect that it is caused by the release of a variable value when it is turned off?
b4a:Private Sub CustomListView1_ItemClick (Index As Int, Value As Object)'短按查看图片 Dim cx1 As Int =CustomListView1.GetValue(Index)'获取当前点击的CustomListView1_Item的序号 Dim Cursor As JdbcResultSet= Starter.Mysql_Jdbc.ExecQuery2("SELECT * FROM 记录表 WHERE `序号`= ? ", Array As String(cx1)) '防止SQL注入 Do While Cursor.NextRow Dim nc As String=Cursor.GetString("账单图片")'查找结果赋值nc Loop ImageView1.Bitmap = Base64EncodeDecodeImage.Base64StringToImage(nc)'加载图片 End Sub
Public Sub BitmapToString(bmp As B4XBitmap) As String
Dim out As OutputStream
out.InitializeToBytesArray(1000)
bmp.WriteToStream(out, 100, "PNG")
out.Close
Dim su As StringUtils
Return su.EncodeBase64(out.ToBytesArray)
End Sub
Public Sub StringToBitmap(s As String) As B4XBitmap
Dim in As InputStream
Dim su As StringUtils
Dim b() As Byte = su.DecodeBase64(s)
in.InitializeFromBytesArray(b, 0, b.Length)
#if B4J
Dim img As Image
#else
Dim img As Bitmap
#end if
img.Initialize2(in)
Return img
End Sub
My current approach is to transcode images using base64 and store them in a database, but the database size may become very large in the later stage. This approach may not be very good, and I need to change my thinking: can the images be stored in a disk on the cloud server? I have checked and it seems that FTP technology is available, but I am not sure if B4A supports itI had a distortion problem using the Base64EncodeDecodeImage library in a project of mine and that's why I stopped using it, it's probably something I may have done wrong, since then I've been using the following functions to convert base64 string to b4xbitmap and also b4xbitmap to base64 string
B4X:Public Sub BitmapToString(bmp As B4XBitmap) As String Dim out As OutputStream out.InitializeToBytesArray(1000) bmp.WriteToStream(out, 100, "PNG") out.Close Dim su As StringUtils Return su.EncodeBase64(out.ToBytesArray) End Sub Public Sub StringToBitmap(s As String) As B4XBitmap Dim in As InputStream Dim su As StringUtils Dim b() As Byte = su.DecodeBase64(s) in.InitializeFromBytesArray(b, 0, b.Length) #if B4J Dim img As Image #else Dim img As Bitmap #end if img.Initialize2(in) Return img End Sub
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?