Issue with Lockbits in DrawImage - vb.net

Looking for some much appreciated help. I'm trying to draw a smaller bitmap into a larger bitmap. I'm trying to use Lockbits to make the process go faster. But my .DrawImage function will not execute. The error is a general GDI+ error (Unhandled Exception). This is my code snippet. What am i doing wrong? The Misc.Lockbitmap is verified to work so i don't think the error is there, but I can put that code up here as well if that helps.
I should add that this is part of a much bigger code. To clarify: I am able to use execute the line with .DrawImage if i disable the lockbits.
Dim largerFile As New Bitmap(BitMapSizeX, BitMapSizeY)
Call MiscClass.LockBitmap(largerFile, PixBytes, RowSizeBytes)
Dim GraphicsModifier As Graphics = Graphics.FromImage(largerFile)
Dim currentPic As New Bitmap(smallerFilePath.Tostring) ' & ".jpg")
GraphicsModifier.DrawImage(currentPic, picAndLoc.XLoc, picAndLoc.YLoc, ComponentSize, ComponentSize)
Public Shared m_BitmapData As BitmapData
' Lock the bitmap's data.
Public Shared Sub LockBitmap(ByRef bm As Bitmap, ByRef PixBytes() As Byte, ByRef RowSizeBytes As Integer)
Dim bounds As Rectangle = New Rectangle(0, 0, bm.Width, bm.Height)
m_BitmapData = bm.LockBits(bounds, Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format24bppRgb)
RowSizeBytes = m_BitmapData.Stride
' Allocate room for the data.
Dim total_size As Integer = m_BitmapData.Stride * m_BitmapData.Height
ReDim PixBytes(total_size)
Marshal.Copy(m_BitmapData.Scan0, PixBytes, 0, total_size)
End Sub

Related

Hbitmap Out of memory exception

So I'm trying to make a small program that takes a load of images and makes them into a .gif file.
At the moment it works only if there are a small number of images but after a while memory usage will go above 4gb and I'll get an out of memory exception.
Here is what I have so far. I can't seem to find a way to get rid of the Hbitmap
Public Sub SaveGif()
TimerGif.Stop()
Dim stats As FileInfo
Dim genc As New System.Windows.Media.Imaging.GifBitmapEncoder
For Each img In Directory.GetFiles(txtSaveLocation.Text & "\TMP")
stats = My.Computer.FileSystem.GetFileInfo(img)
If stats.Extension = ".bmp" Then
Dim bitmapImage As System.Drawing.Bitmap = New System.Drawing.Bitmap(img)
Dim bmp = bitmapImage.GetHbitmap()
Dim src = System.Windows.Interop.Imaging.CreateBitmapSourceFromHBitmap(bmp, IntPtr.Zero, Int32Rect.Empty, System.Windows.Media.Imaging.BitmapSizeOptions.FromEmptyOptions())
genc.Frames.Add(BitmapFrame.Create(src))
bitmapImage.Dispose()
End If
Next
Using fs As New FileStream(Path.Combine(txtSaveLocation.Text, "Test.gif"), FileMode.Create)
genc.Save(fs)
End Using
End Sub

VB.NET Modify a Bitmap in a function Call

I'm trying to modify a bitmap in a function call.
Without the function call I can do
'MyBitMap - an existing bitmap of what I want to modify
Using NewBitMap as BitMap = MyBitMap.Clone 'make copy
Dim G as Graphics = Graphics.FromImage(MyBitMap) 'Draw graphics to MyBitMap
G.Clear(color.white) 'Clear image
G.DrawImage(NewBitMap, -10, 0) 'Shift Image to left 10
PictureBox1.Image = MyBitMap
End Using
works fine no memmory overflow or anything
In a sub it works fine
Sub BMScroll_S(BM as BitMap, dx as integer, dy as integer)
using BMtemp as BitMap = BM.Clone
Dim G as Graphics = Graphics.FromImage(BM)
G.Clear(color.white)
G.DrawImage(BMTemp, dx, dy)
End Using
End Sub
Call BMScroll_S(MyBitMap, -10, 0)
PictureBox1.Image = MyBitMap
works fine, but if I try to create a Function to return a Bitmap
Function BMScroll_F(BM as BitMap, dx as integer, dy as integer) as Bitmap
BMScroll_F = New Bitmap(BM)
Using BMtemp As Bitmap = BM.Clone
Dim G As Graphics = Graphics.FromImage(BMScroll_F)
G.Clear(Color.White)
G.DrawImage(BMtemp, dx, dy)
BM.Dispose()
End Using
End Function
MyBitMap=BMScroll_F(MyBitMap, -10, 0)
PictureBox1.Image = MyBitMap
here I have a Memory Leak and after more and more iterations, it will crash.
I suppose in the function call you are returning a bitmap as well as the fact that BitMaps are passed ByRef so they will continue to exist. I thought BM.Dispose might get rid of it - but it doesn't. I not quite sure how to solve my memory leak (if it is in fact due to my supposition). Granted, I could continue on with the Subroutine but I'd like to know how to solve this problem any way. Any help would be appreciated.

VB.NET Display progress of file decryption?

I'm using this code to encrypt/decrypt files:
Public Shared Sub encryptordecryptfile(ByVal strinputfile As String, _
ByVal stroutputfile As String, _
ByVal bytkey() As Byte, _
ByVal bytiv() As Byte, _
ByVal direction As CryptoAction)
Try
fsInput = New System.IO.FileStream(strinputfile, FileMode.Open, FileAccess.Read)
fsOutput = New System.IO.FileStream(stroutputfile, FileMode.OpenOrCreate, FileAccess.Write)
fsOutput.SetLength(0)
Dim bytbuffer(4096) As Byte
Dim lngbytesprocessed As Long = 0
Dim lngfilelength As Long = fsInput.Length
Dim intbytesincurrentblock As Integer
Dim cscryptostream As CryptoStream
Dim csprijndael As New System.Security.Cryptography.RijndaelManaged
Select Case direction
Case CryptoAction.ActionEncrypt
cscryptostream = New CryptoStream(fsOutput, _
csprijndael.CreateEncryptor(bytkey, bytiv), _
CryptoStreamMode.Write)
Case CryptoAction.ActionDecrypt
cscryptostream = New CryptoStream(fsOutput, _
csprijndael.CreateDecryptor(bytkey, bytiv), _
CryptoStreamMode.Write)
End Select
While lngbytesprocessed < lngfilelength
intbytesincurrentblock = fsInput.Read(bytbuffer, 0, 4096)
cscryptostream.Write(bytbuffer, 0, intbytesincurrentblock)
lngbytesprocessed = lngbytesprocessed + CLng(intbytesincurrentblock)
End While
cscryptostream.Close()
fsInput.Close()
fsOutput.Close()
Catch ex As Exception
End Try
End Sub
Is I need to get the percentage of this process being done as an integer. I am going to use a background worker, so I need to call for this sub from the background worker and be able to keep refreshing a progress bar that the background worker reports to. Is this possible?
Thanks in advance.
There are a couple of things you can do to make your cryptor more efficient and other issues:
A method like encryptordecryptfile which then requires a "mode" argument to know which action to take means it really might be better off as 2 methods
The way you are going, you will be raising a blizzard of ProgressChanged events which the ProgressBar wont be able to keep up with given the animation. A 700K file will result in 170 or so progress reports of tiny amounts
Some of the crypto steps can be incorporated
You have a lot of things not being disposed of; you could run out of resources if you run a number of files thru it in a loop.
It might be worth noting that you can replace the entire While block with fsInput.CopyTo(cscryptostream) to process the file all at once. This doesnt allow progress reporting though. Its also not any faster.
Rather than a BackgroundWorker (which will work fine), you might want to implement it as a Task. The reason for this is that all those variables need to make their way from something like a button click to the DoWork event where your method is actually called. Rather than using global variables or a class to hold them, a Task works a bit more directly (but does involve one extra step when reporting progress). First, a revised EncryptFile method:
Private Sub EncryptFile(inFile As String,
outFile As String,
pass As String,
Optional reporter As ProgressReportDelegate = Nothing)
Const BLOCKSIZE = 4096
Dim percentDone As Integer = 0
Dim totalBytes As Int64 = 0
Dim buffSize As Int32
' Note A
Dim key = GetHashedBytes(pass)
Dim iv = GetRandomBytes(16)
Dim cryptor As ICryptoTransform
' Note B
Using fsIn As New FileStream(inFile, FileMode.Open, FileAccess.Read),
fsOut As New FileStream(outFile, FileMode.OpenOrCreate, FileAccess.Write)
fsOut.SetLength(0)
' Note C
'ToDo: work out optimal block size for Lg vs Sm files
If fsIn.Length > (2 * BLOCKSIZE) Then
' use buffer size to limit to 20 progress reports
buffSize = CInt(fsIn.Length \ 20)
' to multiple of 4096
buffSize = CInt(((buffSize + BLOCKSIZE - 1) / BLOCKSIZE) * BLOCKSIZE)
' optional, limit to some max size like 256k?
'buffSize = Math.Min(buffSize, BLOCK256K)
Else
buffSize = BLOCKSIZE
End If
Dim buffer(buffSize-1) As Byte
' Note D
' write the IV to "naked" fs
fsOut.Write(iv, 0, iv.Length)
Using rij = Rijndael.Create()
rij.Padding = PaddingMode.ISO10126
Try
cryptor = rij.CreateEncryptor(key, iv)
Using cs As New CryptoStream(fsOut, cryptor, CryptoStreamMode.Write)
Dim bytesRead As Int32
Do Until fsIn.Position = fsIn.Length
bytesRead = fsIn.Read(buffer, 0, buffSize)
cs.Write(buffer, 0, bytesRead)
If reporter IsNot Nothing Then
totalBytes += bytesRead
percentDone = CInt(Math.Floor((totalBytes / fsIn.Length) * 100))
reporter(percentDone)
End If
Loop
End Using
Catch crEx As CryptographicException
' ToDo: Set breakpoint and inspect message
Catch ex As Exception
' ToDo: Set breakpoint and inspect message
End Try
End Using
End Using
End Sub
Note A
One of the standard crypto tasks it could handle is creating the Key and IV arrays for you. These are pretty simple and could be shared/static members.
Public Shared Function GetHashedBytes(data As String) As Byte()
Dim hBytes As Byte()
' or SHA512Managed
Using hash As HashAlgorithm = New SHA256Managed()
' convert data to bytes:
Dim dBytes = Encoding.UTF8.GetBytes(data)
' hash the result:
hBytes = hash.ComputeHash(dBytes)
End Using
Return hBytes
End Function
Public Shared Function GetRandomBytes(size As Integer) As Byte()
Dim data(size - 1) As Byte
Using rng As New RNGCryptoServiceProvider
' fill the array
rng.GetBytes(data)
End Using
Return data
End Function
As will be seen later, you can store the IV in the encrypted file rather than saving and managing it in code.
Note B
Using blocks close and dispose of resources for you. Basically, if something has a Dispose method, then you should wrap it in a Using block.
Note C
You dont want to report progress for every block read, that will just overwhelm the ProgressBar. Rather than another variable to keep track of when the progress has changed by some amount, this code starts by creating a buffer size which is 5% of the input file size so there will be about 20 reports (every 5%).
As the comments indicate, you may want to add some code to set minimum/maximum buffer size. Doing so would change the progress report frequency.
Note D
You can write the IV() to the filestream before you wrap it in the CryptoStream (and of course read it back first when Decrypting). This prevents you from having to store the IV.
The last part is kicking this off as a Task:
Dim t As Task
t = Task.Run(Sub() EncryptFile(inFile, oFile, "MyWeakPassword",
AddressOf ReportProgress))
...
What a BGW does is execute the work on one thread, but progress is reported on the UI thread. As a Task, all we need to do is use Invoke:
Delegate Sub ProgressReportDelegate(value As Int32)
Private Sub ReportProgress(v As Int32)
If progBar.InvokeRequired Then
progBar.Invoke(Sub() progBar.Value = v)
Else
progBar.Value = v
progBar.Invalidate()
End If
End Sub
The Encryptor will work either directly or as a Task. For small files, you can omit the progress report entirely:
' small file, no progress report:
EncryptFile(ifile, oFile, "MyWeakPassword")
' report progress, but run on UI thread
EncryptFile(ifile, oFile, "MyWeakPassword",
AddressOf ReportProgress)
' run as task
Dim t As Task
t = Task.Run(Sub() EncryptFile(ifile, oFile, "MyWeakPassword",
AddressOf ReportProgress))
...and if you had a list of files to do, you could run them all at once and perhaps report total progress.

Dropping shadow on WinForm distorts interface

I'm using the following code to create a Windows7 style drop shadow effect on my WinForms:
<DllImport("dwmapi.dll", PreserveSig:=True)> _
Private Shared Function DwmSetWindowAttribute(hwnd As IntPtr, attr As Integer, ByRef attrValue As Integer, attrSize As Integer) As Integer
End Function
<DllImport("dwmapi.dll")> _
Private Shared Function DwmExtendFrameIntoClientArea(hWnd As IntPtr, ByRef pMarInset As Margins) As Integer
End Function
Private Function CreateDropShadow() As Boolean
Try
Dim val As Integer = 2
Dim ret1 As Integer = DwmSetWindowAttribute(Me.Handle, 2, val, 4)
If ret1 = 0 Then
Dim m As New Margins(0, 0, 0, 0)
Dim ret2 As Integer = DwmExtendFrameIntoClientArea(Me.Handle, m)
Return ret2 = 0
Else
Return False
End If
Catch ex As Exception
' Probably dwmapi.dll not found (incompatible OS)
Return False
End Try
End Function
Protected Overrides Sub OnHandleCreated(e As EventArgs)
CreateDropShadow()
MyBase.OnHandleCreated(e)
End Sub
The result of above code creates a nice drop shadow effect on my borderless winform, but it causes the UI to distort. All the controls and labels on my form aren't appearing properly, with text not readable.
Am I missing something here? I don't want to use the traditional drop shadow effect using CreateParams, its too 'boxy' look and doesn't give a nice shadow effect.
Here are screenshots of without shadow and with shadow:
Thanks.
Dim m As New Margins(0, 0, 0, 0)
There's a subtle mistake visible here, looks a lot like you are using System.Drawing.Printing.Margins. But that's not a type that's compatible with the Windows' MARGINS type. Which is a structure, not a class.
So this just goes complete wrong, Windows reads nonsense instead of (0, 0, 0, 0). And extends the frame into the entire client area. Which then plays havoc on any control that draws with GDI, it is a 24bpp drawing api that leaves the alpha at 0 so anything that should be black becomes transparent instead.
Fix this by declaring a proper MARGINS structure:
Structure MARGINS
Public Left, Right, Top, Bottom As Integer
End Structure

Invert or Flip Text in RDLC report

Okay, I've learned a bit more and have rephrased my question. I've got a need to flip or invert text 180 degrees (so it appears upside-down) on a RDLC report. I have some custom VB code that takes the text, converts it to a bitmap, then flips the rotates the canvas 180 degrees. The effect of this makes the text look a bit.. dithered... or fuzzy. It's not a sharp font anymore. The problem I'm experiencing is I'm using a special TTF Barcode font that creates something a scanner can read. When I flip the barcode font, the fuzziness isn't good since the barcode lines are so close together and the scanner cannot read it. Here's the code:
Function LoadImage(ByVal sImageText as String, iRotationAngle as Integer, ByVal sFontName as String, iFontSize as Integer)
Dim bmpImage As New Drawing.Bitmap(1, 1)
Dim iWidth As Integer = 0
Dim iHeight As Integer = 0
'// Create the Font object for the image text drawing.
Dim MyFont As New Drawing.Font(sFontName, iFontSize) ', System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point)
'// Create a graphics object to measure the text's width and height.
Dim MyGraphics As Drawing.Graphics = Drawing.Graphics.FromImage(bmpImage)
'// This is where the bitmap size is determined.
iWidth = MyGraphics.MeasureString(sImageText, MyFont).Width
iHeight = MyGraphics.MeasureString(sImageText, MyFont).Height
'// Create the bmpImage again with the correct size for the text and font.
bmpImage = New Drawing.Bitmap(bmpImage, New Drawing.Size(iWidth, iHeight))
'// Add the colors to the new bitmap.
MyGraphics = Drawing.Graphics.FromImage(bmpImage)
MyGraphics.Clear(Drawing.Color.White)
MyGraphics.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
MyGraphics.TranslateTransform(iWidth,iHeight)
MyGraphics.RotateTransform(iRotationAngle)
MyGraphics.DrawString(sImageText, MyFont, New Drawing.SolidBrush(Drawing.Color.Black), 0, 0)
MyGraphics.Flush()
Dim stream As IO.MemoryStream = New IO.MemoryStream
Dim bitmapBytes As Byte()
'Create bitmap
bmpImage.Save(stream, System.Drawing.Imaging.ImageFormat.Bmp)
bitmapBytes = stream.ToArray
stream.Close()
bmpImage.Dispose()
Return bitmapBytes
End Function
I really don't know why there's not a built-in way to just flip text. It'll let me reverse it left-to-right. Ridiculous.
Thanks