I Tried to convert this code into vb.net and add a little code to make a file... but the file's resolution became crap and i cant seem to insert it into the Crystal report, Did i do something wrong while converting it into vb.net? thanks in advance :)
Here is the original link Convert an image into WMF with .NET?
<Flags>
Private Enum EmfToWmfBitsFlags
EmfToWmfBitsFlagsDefault = &H0
EmfToWmfBitsFlagsEmbedEmf = &H1
EmfToWmfBitsFlagsIncludePlaceable = &H2
EmfToWmfBitsFlagsNoXORClip = &H4
End Enum
Private Shared MM_ISOTROPIC As Integer = 7
Private Shared MM_ANISOTROPIC As Integer = 8
<DllImport("gdiplus.dll")>
Private Shared Function GdipEmfToWmfBits(_hEmf As IntPtr, _bufferSize As UInteger, _buffer As Byte(), _mappingMode As Integer, _flags As EmfToWmfBitsFlags) As UInteger
End Function
<DllImport("gdi32.dll")>
Private Shared Function SetMetaFileBitsEx(_bufferSize As UInteger, _buffer As Byte()) As IntPtr
End Function
<DllImport("gdi32.dll")>
Private Shared Function CopyMetaFile(hWmf As IntPtr, filename As String) As IntPtr
End Function
<DllImport("gdi32.dll")>
Private Shared Function DeleteMetaFile(hWmf As IntPtr) As Boolean
End Function
<DllImport("gdi32.dll")>
Private Shared Function DeleteEnhMetaFile(hEmf As IntPtr) As Boolean
End Function
Private Function MakeMetafileStream(image As Bitmap) As Byte()
Dim metafile As Metafile = Nothing
Using g As Graphics = Graphics.FromImage(image)
Dim hDC As IntPtr = g.GetHdc()
metafile = New Metafile(hDC, EmfType.EmfOnly)
g.ReleaseHdc(hDC)
End Using
Using g As Graphics = Graphics.FromImage(metafile)
g.DrawImage(image, 0, 0)
End Using
Dim _hEmf As IntPtr = metafile.GetHenhmetafile()
Dim _bufferSize As UInteger = GdipEmfToWmfBits(_hEmf, 0, Nothing, MM_ANISOTROPIC, EmfToWmfBitsFlags.EmfToWmfBitsFlagsDefault)
Dim _buffer As Byte() = New Byte(_bufferSize - 1) {}
GdipEmfToWmfBits(_hEmf, _bufferSize, _buffer, MM_ANISOTROPIC, EmfToWmfBitsFlags.EmfToWmfBitsFlagsDefault)
Dim hmf As IntPtr = SetMetaFileBitsEx(_bufferSize, _buffer)
Dim tempfile As String = Path.GetTempFileName()
CopyMetaFile(hmf, tempfile)
DeleteMetaFile(hmf)
DeleteEnhMetaFile(_hEmf)
Dim stream = New MemoryStream()
Dim data As Byte() = File.ReadAllBytes(tempfile)
Return data
End Function
Private Sub Convert()
Dim src As New Bitmap("C:\Users\Sample\Desktop\Logos\LogoTransparent\Transparentlogo.png")
Dim Msteam As Byte() = MakeMetafileStream(src)
Dim newF As String = "C:\Users\Alvin Rodriguez\Desktop\Logos\new logo transparent\Transparentlogo.wmf"
System.IO.File.WriteAllBytes(newF, Msteam)
Msteam = Nothing
End Sub
Some interface are to be modifed:
Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As IntPtr, ByVal lpszFile As String) As IntPtr
Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hemf As IntPtr) As Integer
Private Declare Function GdipEmfToWmfBits Lib "gdiplus.dll" (ByVal hEmf As IntPtr, ByVal bufferSize As UInteger, ByVal buffer() As Byte, ByVal mappingMode As Integer, ByVal flags As EmfToWmfBitsFlags) As UInteger
Related
I am new to VB.Net. I came from vb6 and VBA so I'm still learning. I am trying to clear the memory space for when I retrieve text using my GetWinTxt() function. I am not sure if I am properly releasing the memory space or not. I have researched MSDN and a multitude of other sites including this one trying to learn about this and I find it somewhat confusing. This function will be used a lot and i don't want a memory leak. It seems to be working fine as there isn't any error codes but can someone with more knowledge please tell me if I'm doing this right? Also should I be using Marshal.DestroyStructure() before I use Marshal.FreeHGlobal()? And if so how would I use that in my code below?
Option Explicit On
Imports System.Runtime.InteropServices
Declare Auto Function SendMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Shared Function FindWindowEx(ByVal parentHandle As IntPtr, ByVal childAfter As IntPtr, ByVal lclassName As String, ByVal windowTitle As String) As IntPtr
End Function
Friend Const WM_GETTEXT = &HD
Friend Const WM_GETTEXTLENGTH = &HE
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
Dim Hwnd As IntPtr = FindWindow(Nothing, "Untitled - Notepad") 'notepad parent win
Dim Handle As IntPtr = FindWindowEx(Hwnd, IntPtr.Zero, "Edit", Nothing) 'notepad edit area
MsgBox(Lf.GetWinTxt(Handle))'Lf is my class name
End Sub
Friend Function GetWinTxt(hwnd As IntPtr) As String
Dim TextLen As Integer = SendMessage(hwnd, WM_GETTEXTLENGTH, 0, 0) + 1
Dim WinHandle As IntPtr = Marshal.AllocHGlobal(TextLen)
Call SendMessage(hwnd, WM_GETTEXT, TextLen, WinHandle)
Dim txt As String = Marshal.PtrToStringUni(WinHandle)
GetWinTxt = txt
Dim ByteString(TextLen) As Byte ' the next 3 lines are what i'm not sure if i'm doing it right or not
Marshal.Copy(WinHandle, ByteString, 0, TextLen)
Marshal.FreeHGlobal(txt)
End Function
EDITED FINAL CODE:
Public Function GetWinTxt(hwnd As IntPtr) As String
Dim TextLen As IntPtr = SendMessage(hwnd, WM_GETTEXTLENGTH, 0, 0) + 1
Dim f As Integer = TextLen
Winhandle = Marshal.AllocHGlobal(f)
Call SendMessage(hwnd, WM_GETTEXT, f, Winhandle)
Dim txt As String = Marshal.PtrToStringUni(Winhandle)
Return txt
Try
Dim ByteString(f) As Byte
Marshal.Copy(Winhandle, ByteString, 0, f)
Marshal.FreeHGlobal(Winhandle)
Catch ex As Exception
Return ""
Debug.Print(ex.Message)
End Try
End Function
The answer is no, unless you call method like Marshal. StructureToPtr().
You should use the counterpart of whatever method you used to allocate it.
Marshal. Destroy Structure will free all substructures that specify unmanaged memory block points to. But you don't have any structure in it.
In addition, you call Dim WinHandle As IntPtr = Marshal.AllocHGlobal(TextLen) Allocates memory from the unmanaged memory of the process to WinHandle, then free anther one, Marshal.FreeHGlobal(txt). This will cause memory leaks.
try to change it to Marshal.FreeHGlobal(WinHandle).
I'm working on programm on VB.net to retrieve data from Firefox browser. I have an error while trying to use "PK11SDR_Decrypt" method from nss3.lib. "PK11SDR_Decrypt" returns -1. I don't have master password. I think that the problem in Ctypes/marshalling/base64 decoding. This is the code of function.
Public Function DecryptFF(ByVal str As String)
On Error Resume Next
Dim tSecDec As New TSECItem
Dim e As Integer
Dim sb As New System.Text.StringBuilder(str)
Dim hi2 As Integer = NSSBase64_DecodeBuffer(IntPtr.Zero, IntPtr.Zero, sb, sb.Length)
Dim item As TSECItem = DirectCast(Marshal.PtrToStructure(New IntPtr(hi2), GetType(TSECItem)), TSECItem)
e = PK11SDR_Decrypt(item, tSecDec, 0)
If e = 0 Then
If tSecDec.SECItemLen <> 0 Then
Dim mozDecryptedData = New Byte(tSecDec.SECItemLen - 1) {}
Marshal.Copy(New IntPtr(tSecDec.SECItemData), mozDecryptedData, 0, tSecDec.SECItemLen)
Return Encoding.UTF8.GetString(mozDecryptedData)
End If
End If
Return String.Empty
End Function
And other code part.
Public NSS3 As IntPtr
Public hModuleList As New List(Of IntPtr)
<StructLayout(LayoutKind.Sequential)>
Public Structure TSECItem
Public SECItemType As Integer
Public SECItemData As Integer
Public SECItemLen As Integer
End Structure
Public Function NSS_Init(ByVal configdir As String) As Long
Dim PathM = FindFirefoxInstallationPath()
hModuleList.Add(LoadLibrary(PathM & "\msvcp140.dll"))
hModuleList.Add(LoadLibrary(PathM & "\mozglue.dll"))
hModuleList.Add(LoadLibrary(PathM & "\mozavutils.dll"))
NSS3 = LoadLibrary(PathM & "\nss3.dll")
hModuleList.Add(NSS3)
Return CreateAPI(Of DLLFunctionDelegate)(NSS3, "NSS_Init")(configdir)
End Function
Public Function CreateAPI(Of T)(ByVal hModule As IntPtr, ByVal method As String) As T 'Simple overload to avoid loading the same library every time
Return DirectCast(DirectCast(Marshal.GetDelegateForFunctionPointer(GetProcAddress(hModule, method), GetType(T)), Object), T)
End Function
Public Function NSSBase64_DecodeBuffer(ByVal arenaOpt As IntPtr, ByVal outItemOpt As IntPtr, ByVal inStr As System.Text.StringBuilder, ByVal inLen As Integer) As Integer
Dim pProc As IntPtr = GetProcAddress(NSS3, "NSSBase64_DecodeBuffer")
Dim dll As DLLFunctionDelegate4 = DirectCast(Runtime.InteropServices.Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate4)), DLLFunctionDelegate4)
Return dll(arenaOpt, outItemOpt, inStr, inLen)
End Function
Public Function PK11SDR_Decrypt(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
Dim pProc As IntPtr = GetProcAddress(NSS3, "PK11SDR_Decrypt")
Dim dll As DLLFunctionDelegate5 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate5)), DLLFunctionDelegate5)
Return dll(data, result, cx)
End Function
<UnmanagedFunctionPointer(CallingConvention.Cdecl)>
Public Delegate Function DLLFunctionDelegate5(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
<UnmanagedFunctionPointer(CallingConvention.Cdecl)>
Public Delegate Function DLLFunctionDelegate6() As Long
Public Function NSS_Shutdown() As Long
Return CreateAPI(Of DLLFunctionDelegate6)(NSS3, "NSS_Shutdown")()
End Function
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Public Shared Function LoadLibrary(ByVal dllFilePath As String) As IntPtr
End Function
<DllImport("kernel32.dll", SetLastError:=True, EntryPoint:="FreeLibrary")>
Public Shared Function FreeLibrary(ByVal hModule As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Ansi, ExactSpelling:=True)>
Public Shared Function GetProcAddress(ByVal hModule As IntPtr, ByVal procName As String) As IntPtr
End Function
DecryptFF get as argument the encrypted login fron logins.json file. Here is the part of code
Dim JSONRegex As New Regex("\""(hostname|encryptedPassword|encryptedUsername)"":""(.*?)""")
Dim mozMC = JSONRegex.Matches(Logins)
For I = 0 To mozMC.Count - 1 Step 3
Dim host = mozMC(I).Groups(2).Value
Dim usr = mozMC(I + 1).Groups(2).Value
Dim pas = mozMC(I + 2).Groups(2).Value
Account = (DecryptFF(usr))
Thank you for your help!
Hi currently I'm having this code below.
It retrieves the filename of open excel document from process and displays it.
For now it can retrieve it from my own pc, but when I wanted to remotely retrieves it from other pc, it doesn't work.
I have authorized access and I could actually get the process id and name of remote pcs only.
Dim w As Object
Dim processQ As String
Dim processes As Object
Dim processA As Object
Dim pname As String
w = GetObject("winmgmts:{impersonationLevel=impersonate}\\" & pc & "\root\cimv2")
processQ = "SELECT * FROM win32_process WHERE name = 'EXCEL.EXE'"
processes = w.execquery(processQ)
For Each processA In processes
activeprocess = Process.GetProcessById(processA.processid)
MsgBox(processA.processid & processA.name)
Dim windows As IDictionary(Of IntPtr, String) = GetOpenWindowsFromPID(processA.processid)
MsgBox(windows.Count())
For Each kvp As KeyValuePair(Of IntPtr, String) In windows
Dim value As String = kvp.Value.ToString
If InStr(value, "Excel") = False Then
MsgBox(value)
End If
Next
Next
Can anyone tell me what should I do and what's wrong with this?
<DllImport("USER32.DLL")>
Private Shared Function GetShellWindow() As IntPtr
End Function
<DllImport("USER32.DLL")>
Private Shared Function GetWindowText(ByVal hwnd As IntPtr, ByVal lpString As StringBuilder, ByVal nMaxCount As Integer) As Integer
End Function
<DllImport("USER32.DLL")>
Private Shared Function GetWindowTextLength(ByVal hwnd As IntPtr) As Integer
End Function
<DllImport("USER32.DLL", SetLastError:=True)>
Private Shared Function GetWindowThreadProcessId(ByVal hwnd As IntPtr, <Out()> ByRef lpdwProcessId As UInt32) As UInt32
End Function
<DllImport("USER32.DLL")>
Private Shared Function IsWindowVisible(ByVal hwnd As IntPtr) As Boolean
End Function
Private Delegate Function EnumWindowsProc(ByVal hwnd As IntPtr, ByVal lParam As Integer) As Boolean
<DllImport("USER32.DLL")>
Private Shared Function EnumWindows(ByVal enumFunc As EnumWindowsProc, ByVal lParam As Integer) As Boolean
End Function
Private hShellWindow As IntPtr = GetShellWindow()
Private dictWindows As New Dictionary(Of IntPtr, String)
Private currentProcessID As Integer
Public Function GetOpenWindowsFromPID(ByVal processID As Integer) As IDictionary(Of IntPtr, String)
dictWindows.Clear()
currentProcessID = processID
EnumWindows(AddressOf enumWindowsInternal, 0)
Return dictWindows
End Function
Public Function enumWindowsInternal(ByVal hwnd As IntPtr, ByVal lParam As Integer) As Boolean
If (hwnd <> hShellWindow) Then
Dim windowPid As UInt32
If Not IsWindowVisible(hwnd) Then
Return True
End If
Dim length As Integer = GetWindowTextLength(hwnd)
If (length = 0) Then
Return True
End If
GetWindowThreadProcessId(hwnd, windowPid)
If (windowPid <> currentProcessID) Then
Return True
End If
Dim stringBuilder As New StringBuilder(length)
GetWindowText(hwnd, stringBuilder, (length + 1))
dictWindows.Add(hwnd, stringBuilder.ToString)
End If
Return True
End Function
Sorry I'm quite new to vb.net.. but I'm learning thanks!
OK, this problem has been bugging me for a long time.
I have the code for the service which communicates a string to the client via PostMessage:
Public Sub SendToClient(msgs As String, types As Integer, hwnd As Long)
postMessage(hwnd, 0, Nothing, msgs)
End Sub
Then I have the client that receives the string:
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If (m.Msg = 0) Then
Dim a as string
a = Marshal.PtrToStringAuto(m.LParam)
end if
MyBase.WndProc(m)
End Sub
However, the client sends an error, or some jumble of binary data or even just a blank string sometimes. By the way, the m.LParam is a number.
Can someone tell me what is the right way to send/receive strings via postmessage.
I do it like this:
Public Sub SendMessageToApp(ByVal NombreVentana As String, ByVal Mensaje As String, ByVal sender As Form)
Dim hWnd As IntPtr
Dim mCopyData As COPYDATASTRUCT
hWnd = CType(FindWindow(Nothing, NombreVentana), IntPtr)
Dim message As New System.Text.StringBuilder
If (CInt(hWnd) <> 0) Then
message.Append(Mensaje)
Dim pCopyData As IntPtr = Marshal.AllocHGlobal(message.Length() + 40)
mCopyData.lpData = Marshal.StringToHGlobalAnsi(message.ToString)
mCopyData.cbData = message.Length
mCopyData.dwData = CType(_messageID, IntPtr)
Marshal.StructureToPtr(mCopyData, pCopyData, False)
SendMessage(hWnd, WM_COPYDATA, CInt(sender.Handle), pCopyData)
Marshal.FreeHGlobal(mCopyData.lpData)
Marshal.FreeHGlobal(pCopyData)
End If
End Sub
Receiver window:
Declarations and definitions:
Const WM_COPYDATA As Integer = 74
Const SIG_LENGTH As Integer = 36
Const MAX_COPY_LENGTH As Integer = 128
Const SigConnect As String = "F7B82657-BD18-4ee6-B182-78721293821C"
Dim CDCount As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, _
ByVal lParam As IntPtr) As Integer
Dim hWndSender As Integer
Private Const _messageID As Integer = 10
'Estructura obligatoria para poder utilizar el API CopyData
<StructLayout(LayoutKind.Sequential)> _
Private Structure COPYDATASTRUCT
Public dwData As IntPtr
Public cbData As Integer
Public lpData As IntPtr
End Structure
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = WM_COPYDATA Then
Dim Estructura As COPYDATASTRUCT
Dim tipo As Type = Estructura.GetType
Dim message As String
Estructura = CType(m.GetLParam(GetType(COPYDATASTRUCT)), COPYDATASTRUCT)
'Here you get the message
message = Marshal.PtrToStringAnsi(Estructura.lpData, Estructura.cbData)
End If
I have a country map in a picture box with provincial divisions. I can fill each province on mouse over by calling following floodfill function on my pictureBox MouseMove event:
Private Structure BITMAPINFOHEADER
Dim biSize As Integer
Dim biWidth As Integer
Dim biHeight As Integer
Dim biPlanes As Short
Dim biBitCount As Short
Dim biCompression As Integer
Dim biSizeImage As Integer
Dim biXPelsPerMeter As Integer
Dim biYPelsPerMeter As Integer
Dim biClrUsed As Integer
Dim biClrImportant As Integer
End Structure
''' <summary>
''' API declarations
''' </summary>
''' <param name="hdc"></param>
''' <returns></returns>
''' <remarks></remarks>
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As IntPtr) As IntPtr
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As IntPtr, ByRef pBitmapInfo As BITMAPINFOHEADER, ByVal un As Integer, ByRef lplpVoid As IntPtr, ByVal handle As Integer, ByVal dw As Integer) As IntPtr
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As IntPtr, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal dwRop As Integer) As Integer
Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As IntPtr, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Integer, ByVal wFillType As Integer) As Integer
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Integer) As IntPtr
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As IntPtr, ByVal X As Integer, ByVal Y As Integer) As Integer
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As IntPtr, ByVal hObject As IntPtr) As IntPtr
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As IntPtr) As Integer
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As IntPtr) As Integer
Private Declare Function GdiFlush Lib "gdi32" Alias "GdiFlush" () As Integer
Private Const SRCCOPY = &HCC0020
Public Sub FloodFill(ByRef mbmp As Bitmap, ByVal col As Color, ByVal Pt As Point)
If mbmp Is Nothing Then Exit Sub
Dim srcDC As IntPtr = CreateCompatibleDC(IntPtr.Zero)
Dim dstDC As IntPtr = CreateCompatibleDC(IntPtr.Zero)
Dim dstBMI As BITMAPINFOHEADER
With dstBMI
.biBitCount = 24
.biHeight = mbmp.Height
.biSize = System.Runtime.InteropServices.Marshal.SizeOf(dstBMI)
.biWidth = mbmp.Width
.biPlanes = 1
End With
Dim dstBits As IntPtr
Dim mbmpGetHbitmap As IntPtr = mbmp.GetHbitmap
'Select the bitmap into an HDC
Dim Obmp As IntPtr = SelectObject(srcDC, mbmpGetHbitmap)
'Create a DIB
Dim dstBMP As IntPtr = CreateDIBSection(dstDC, dstBMI, 0, dstBits, 0, 0)
Dim Obmp2 As IntPtr = SelectObject(dstDC, dstBMP)
'Place our bitmap in the DIB
BitBlt(dstDC, 0, 0, mbmp.Width, mbmp.Height, srcDC, 0, 0, SRCCOPY)
GdiFlush()
'Create a brush to use to FloodFill
Dim mBrush As IntPtr = CreateSolidBrush(System.Drawing.ColorTranslator.ToOle(col))
Dim hmm As IntPtr = SelectObject(dstDC, mBrush)
'Label5.Text = mBrush
'Fill with color
ExtFloodFill(dstDC, Pt.X, Pt.Y, GetPixel(dstDC, Pt.X, Pt.Y), 1)
'Get the bitmap back with the Filled Color
mbmp = Bitmap.FromHbitmap(dstBMP)
'Go berserk clearing memory
'ExtFloodFill has a bad reputation for gobbling up memory
'if you dont clean up properly
DeleteObject(mBrush)
DeleteObject(SelectObject(dstDC, mBrush))
DeleteObject(SelectObject(dstDC, dstBMP))
DeleteObject(SelectObject(srcDC, mbmpGetHbitmap))
DeleteObject(hmm)
DeleteObject(dstBits)
DeleteObject(Obmp2)
DeleteObject(Obmp)
DeleteObject(dstBMP)
DeleteDC(dstDC)
DeleteDC(srcDC)
mbmpGetHbitmap = Nothing
hmm = Nothing
dstBits = Nothing
Obmp2 = Nothing
Obmp = Nothing
dstBMP = Nothing
dstDC = Nothing
srcDC = Nothing
dstBMI = Nothing
End Sub
the only thing I need is to recognize floodfilled province on mouse over. any suggestion?
If you know the map coordinates you could do bounds checking on a defined list of rectangles.
i.e. a class which has a name as string and a rectangle
so washington might be (0,0,100,100)
and new york might be (100,40,100,100)
then just look through your list of objects and bounds check them
return the "name" of the area to the user
if that is what you were trying to achieve.
p.s. i'm not sure why you're using alot of "classic" blitting / GDI code where the .NET framework system.drawing namespace could be much nicer for you....
dim b as New Bitmap(Width, Height, Imaging.PixelFormat.Format32bppPArgb)
dim g as graphics = graphics.fromimage(b)
g.Clear(Color.White)
g.DrawImage(Bitmap.FromFile("test.jpg"), New Rectangle(0, 0, 100, 100))
PictureBox1.image = b