I am trying to create labels which have all four corners rounded, the label is being created programatically as seen below:
Dim lbl1 As Label = New Label()
lbl1.AutoSize = False 'allow resizing
lbl1.BackColor = Color.Yellow
lbl1.Text = newid
lbl1.Height = 46
lbl1.Width = 42
lbl1.Padding = New Padding(1, 1, 1, 1)
How would I switch from the square corners to a more XP styled rounding.
Imports System.Runtime.InteropServices
<DllImport("Gdi32.dll", EntryPoint:="CreateRoundRectRgn")> _
Private Shared Function CreateRoundRectRgn(ByVal iLeft As Integer, ByVal iTop As Integer, ByVal iRight As Integer, ByVal iBottom As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer) As IntPtr
End Function
ex.)
Imports System.Runtime.InteropServices
Public Class Form1
<DllImport("Gdi32.dll", EntryPoint:="CreateRoundRectRgn")> _
Private Shared Function CreateRoundRectRgn(ByVal iLeft As Integer, ByVal iTop As Integer, ByVal iRight As Integer, ByVal iBottom As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer) As IntPtr
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim newid$ = "mylabel"
Dim lbl1 As Label = New Label()
With lbl1
lbl1.AutoSize = False 'allow resizing
lbl1.BackColor = Color.Yellow
lbl1.Text = newid
lbl1.Height = 46
lbl1.Width = 42
lbl1.Padding = New Padding(1, 1, 1, 1)
lbl1.Region = System.Drawing.Region.FromHrgn(CreateRoundRectRgn(2, 2, lbl1.Width - 2, lbl1.Height - 2, 5, 1))
End With
Me.Controls.Add(lbl1)
End Sub
End Class
Related
This question may have been asked before but im just starting out with VB.Net and was given this application to fix that uses the webcam of the pc/ tablet but I cant figure out the pinvoke error
here is my code:
Imports System.IO
Public Class frm
CaptureWebCam
Const CAP As Short = &H400S
Const CAP_DRIVER_CONNECT As Integer = CAP + 10
Const CAP_DRIVER_DISCONNECT As Integer = CAP + 11
Const CAP_EDIT_COPY As Integer = CAP + 30
Const CAP_SET_PREVIEW As Integer = CAP + 50
Const CAP_SET_PREVIEWRATE As Integer = CAP + 52
Const CAP_SET_SCALE As Integer = CAP + 53
Const WS_CHILD As Integer = &H40000000
Const WS_VISIBLE As Integer = &H10000000
Const SWP_NOMOVE As Short = &H2S
Const SWP_NOSIZE As Short = 1
Const SWP_NOZORDER As Short = &H4S
Const HWND_BOTTOM As Short = 1
Dim iDevice As Integer = 0 ' Normal device ID
Dim hHwnd As Integer ' Handle value to preview window
Public image_base64String As String
' Declare function from AVI capture DLL.
Declare Auto Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Object) As Integer
Declare Auto Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
Declare Auto Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
Declare Auto Function capCreateCaptureWindowA Lib "avicap32.dll" (ByVal lpszWindowName As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Short, ByVal hWndParent As Integer, ByVal nID As Integer) As Integer
Private Sub OpenForm()
Dim iHeight As Integer = picCapture.Height
Dim iWidth As Integer = picCapture.Width
' Open Preview window in picturebox .
' Create a child window with capCreateCaptureWindowA so you can display it in a picturebox.
hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 600, 480, picCapture.Handle, IntPtr.Zero)
' Connect to device
If SendMessage(hHwnd, CAP_DRIVER_CONNECT, iDevice, IntPtr.Zero) Then
' Set the preview scale
SendMessage(hHwnd, CAP_SET_SCALE, True, IntPtr.Zero)
' Set the preview rate in milliseconds
SendMessage(hHwnd, CAP_SET_PREVIEWRATE, 66, IntPtr.Zero)
' Start previewing the image from the camera
SendMessage(hHwnd, CAP_SET_PREVIEW, True, IntPtr.Zero)
' Resize window to fit in picturebox
SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, picCapture.Width, picCapture.Height, SWP_NOMOVE Or SWP_NOZORDER)
Else
' Error connecting to device close window
DestroyWindow(hHwnd)
End If
End Sub
Private Function btnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCapture.Click
Dim data As IDataObject
Dim bmap As Image
' Copy image to clipboard
SendMessage(hHwnd, CAP_EDIT_COPY, 0, 0)
' Get image from clipboard and convert it to a bitmap
data = Clipboard.GetDataObject()
If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
picCapture.Image = bmap
Dim saveFileDialog1 As New SaveFileDialog()
saveFileDialog1.Filter = "Jpeg Image|*.jpg|Bitmap Image|*.bmp|Gif Image|*.gif"
saveFileDialog1.Title = "Save an Image File"
saveFileDialog1.FileName = "Image001"
If saveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
' If the file name is not an empty string open it for saving.
If saveFileDialog1.FileName <> "" Then
' Saves the Image via a FileStream created by the OpenFile method.
Dim fs As System.IO.FileStream = CType(saveFileDialog1.OpenFile(), System.IO.FileStream)
picCapture.Image.Save(fs, System.Drawing.Imaging.ImageFormat.Jpeg)
fs.Close()
End If
End If
End If
End Function
Public Function getImage() As String
Dim bmap As Image
Dim ms As New MemoryStream
bmap.Save(ms, System.Drawing.Imaging.ImageFormat.Jpeg)
Dim bytes() As Byte = ms.ToArray
' Dim image_base64String As String = Convert.ToBase64String(bytes)
image_base64String = Convert.ToBase64String(bytes)
'MsgBox(image_base64String)
Return image_base64String
End Function
Private Sub frmcap_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Leave
' Disconnect from device
SendMessage(hHwnd, CAP_DRIVER_DISCONNECT, iDevice, 0)
' close window
DestroyWindow(hHwnd)
End Sub
Private Sub frmCaptureWebCam_Load(sender As Object, e As EventArgs) Handles MyBase.Load
OpenForm()
End Sub
End Class
you will notice that I'm also trying to return the image via the image_base64 variable
Can someone help me with the code as I get the following error:
PInvokeStackImbalance was detected
Message: A call to PInvoke function
'GCOS3_Mobile_Host_Application!GCOS3_Mobile_Host_Application.frmCaptureWebCam::SendMessage'
has unbalanced the stack. This is likely because the managed PInvoke
signature does not match the unmanaged target signature. Check that
the calling convention and parameters of the PInvoke signature match
the target unmanaged signature.
SendMessage declaration according to pinvoke should be like this
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
Also see the tips for Overloads there.
In your code you have declared lParam, which provides additional message-specific information, as object.
And you are passing IntPtr.Zero, so I think using ByVal lParam As IntPtr will be more specific.
I used the emgu library and got it to return the base 64 string:
Imports Emgu.CV
Imports Emgu.CV.Util
Imports System.IO
Public Class frmEmguCapture
Private imagecapture As Capture
Private imageCaptureReady As Boolean = False
Public b64 As String
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles tmrUpdateImage.Tick
tmrUpdateImage.Enabled = False
If imageCaptureReady Then
pbWebCamStream.Visible = True
lblConnecting.Visible = False
btnCapture.Enabled = True
pbWebCamStream.Image = imagecapture.QueryFrame.Bitmap
tmrUpdateImage.Enabled = True
Else
MessageBox.Show("Error connecting to camera.", "Error conecting to camera.", MessageBoxButtons.OK, MessageBoxIcon.Error)
Me.Close()
End If
End Sub
Public Function btnCapture_Click(sender As Object, e As EventArgs) Handles btnCapture.Click
tmrUpdateImage.Enabled = False
pbWebCamStream.Visible = True
lblConnecting.Visible = False
btnCapture.Enabled = True
pbWebCamStream.Image = imagecapture.QueryFrame.Bitmap
Dim bmap As Image
bmap = imagecapture.QueryFrame.Bitmap
Dim ms As New MemoryStream
bmap.Save(ms, System.Drawing.Imaging.ImageFormat.Jpeg)
Dim bytes() As Byte = ms.ToArray
Dim image_base64String As String = Convert.ToBase64String(bytes)
image_base64String = Convert.ToBase64String(bytes)
b64 = image_base64String
imagecapture.Dispose()
Me.Close()
'MsgBox(image_base64String)
Return image_base64String
End Function
Private Sub frmEmguCapture_Load(sender As Object, e As EventArgs) Handles MyBase.Load
tmrLoad.Enabled = True
End Sub
Private Sub tmrLoad_Tick(sender As Object, e As EventArgs) Handles tmrLoad.Tick
tmrLoad.Enabled = False
Try
imagecapture = New Capture
imageCaptureReady = True
tmrUpdateImage.Enabled = True
Catch ex As Exception
MessageBox.Show("Error connecting to camera.", "Error conecting to camera.", MessageBoxButtons.OK, MessageBoxIcon.Error)
Me.Close()
End Try
End Sub
End Class
I am using Visual Studio express 2013, VB. Simplifying the problem as much as I can, I have a form with a tab control that has 2 tab pages. I want to print both tab pages on the click of one button. Currently I am trying to use CreateGraphics on the individual tabs but I just get the first tab printing on both pages. Here is my code, can anyone please see what I am doing wrong or if I am on completely the wrong lines. It looks to me like the CreateGraphics is not retrieving the right tabpages graphics.
Private Declare Auto Function BitBlt Lib "gdi32.dll" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As System.Int32) As Boolean
Private Const SRCCOPY As Integer = &HCC0020
Private PagePrinting As Integer
Private Sub ToolStripButton2_Click(sender As Object, e As EventArgs) Handles ToolStripButton2.Click
If PrintDialog1.ShowDialog() = DialogResult.OK Then
PagePrinting = 0
PrintDocument1.Print()
End If
End Sub
Private Sub PrintDocument1_PrintPage(sender As Object, e As PrintPageEventArgs) Handles PrintDocument1.PrintPage
If PagePrinting = 0 Then
e.Graphics.DrawImage(GetImage1(), e.MarginBounds)
Else
e.Graphics.DrawImage(GetImage2(), e.MarginBounds)
End If
PagePrinting = PagePrinting + 1
If PagePrinting = 2 Then e.HasMorePages = False Else e.HasMorePages = True
End Sub
Private Function GetImage1() As Bitmap
Dim me_gr As Graphics = Me.BillTabControl.TabPages("PAGE1").CreateGraphics
Dim bm As New Bitmap(Me.BillTabControl.TabPages("PAGE1").ClientSize.Width, Me.BillTabControl.TabPages("PAGE1").ClientSize.Height, me_gr)
Dim bm_gr As Graphics = Graphics.FromImage(bm)
Dim bm_hdc As IntPtr = bm_gr.GetHdc
Dim me_hdc As IntPtr = me_gr.GetHdc
BitBlt(bm_hdc, 0, 0, Me.BillTabControl.TabPages("PAGE1").ClientSize.Width, Me.BillTabControl.TabPages("PAGE1").ClientSize.Height, me_hdc, 0, 0, SRCCOPY)
me_gr.ReleaseHdc(me_hdc)
bm_gr.ReleaseHdc(bm_hdc)
GetImage1 = bm
End Function
Private Function GetImage2() As Bitmap
Dim me_gr As Graphics = Me.BillTabControl.TabPages("PAGE2").CreateGraphics
Dim bm As New Bitmap(Me.BillTabControl.TabPages("PAGE2").ClientSize.Width, Me.BillTabControl.TabPages("PAGE2").ClientSize.Height, me_gr)
Dim bm_gr As Graphics = Graphics.FromImage(bm)
Dim bm_hdc As IntPtr = bm_gr.GetHdc
Dim me_hdc As IntPtr = me_gr.GetHdc
BitBlt(bm_hdc, 0, 0, Me.BillTabControl.TabPages("PAGE2").ClientSize.Width, Me.BillTabControl.TabPages("PAGE2").ClientSize.Height, me_hdc, 0, 0, SRCCOPY)
me_gr.ReleaseHdc(me_hdc)
bm_gr.ReleaseHdc(bm_hdc)
GetImage2 = bm
End Function
Have you tried selecting the second tab before creating the graphics with SelectTab?
You may also want to add a breakpoint to this line to make sure it is being called:
e.Graphics.DrawImage(GetImage2(), e.MarginBounds)
Here is the code that works.
Private Function GetImage1() As Bitmap
Dim bm As New Bitmap(Me.BillTabControl.TabPages("PAGE1").ClientSize.Width, Me.BillTabControl.TabPages("PAGE1").ClientSize.Height)
Me.BillTabControl.TabPages("PAGE1").DrawToBitmap(bm, Me.BillTabControl.TabPages("PAGE1").ClientRectangle)
GetImage1 = bm
End Function
Private Function GetImage2() As Bitmap
Dim bm As New Bitmap(Me.BillTabControl.TabPages("PAGE2").ClientSize.Width, Me.BillTabControl.TabPages("PAGE2").ClientSize.Height)
Me.BillTabControl.TabPages("PAGE2").DrawToBitmap(bm, Me.BillTabControl.TabPages("PAGE2").ClientRectangle)
GetImage2 = bm
End Function
I tried to rebuild the BitBlt function in VB.NET, and it works not sooo bad, but my image is always blitted/drawn on 0,0 on the destination bitmap.
Does anybody see my mistake?
As one can see, I am trying to copy the rect (0, 0, 50, 50) from the source bitmap to the point (25,25) in the destination bitmap, but it does not do that:
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
' Make a Bitmap to hold the result.
Dim bm As New Bitmap(Me.PictureBox1.Width, Me.PictureBox1.Height)
CopyBitmap(Me.PictureBox1.Image, bm, 25, 25, 50, 50, 0, 0)
Me.PictureBox2.Image = bm
End Sub
Public Sub CopyBitmap(ByRef uSource As Bitmap, ByRef uTarget As Bitmap, ByVal uDestX As Integer, ByVal uDestY As Integer, ByVal uSrcWidth As Integer, ByVal uSrcHeight As Integer, ByVal uSrcX As Integer, ByVal uSrcY As Integer)
Dim nSrc As New Rectangle
nSrc = Rectangle.FromLTRB(uSrcX, uSrcY, uSrcX + uSrcWidth, uSrcY + uSrcHeight)
Dim nDst As New Rectangle
nDst = Rectangle.FromLTRB(uDestX, uDestY, uDestX + uSrcWidth, uDestY + uSrcHeight)
Using g As Graphics = Graphics.FromImage(uTarget)
' Draw the specified section of the source bitmap to the new one
g.DrawImage(uSource, nSrc, nDst, GraphicsUnit.Pixel)
End Using
End Sub
Doh, I swapped nSrc and nDst.
The 2nd argument in DrawImage should be nDst, and the 3rd argument should be nSrc.
''//begin cross threaded component
Private Sub dBgRIDvIEWNotInvokeRequired(ByVal dBGridViewcomponentname As DataGridView, ByVal dvalue As String)
dBGridViewcomponentname.Text = dvalue
dBGridViewcomponentname.Update()
End Sub
Private Delegate Sub deldBGrridView(ByVal dBGridViewcomponentname As DataGridView, ByVal dvalue As String)
Private Sub ThreadedDbGridViewAddress(ByVal dBGridViewcomponentname As DataGridView, ByVal dvalue As String)
Try
If InvokeRequired Then
Dim udd As New deldBGrridView(AddressOf ThreadedDbGridViewAddress)
Invoke(udd, New Object() {dBGridViewcomponentname, dvalue})
Else
dBgRIDvIEWNotInvokeRequired(dBGridViewcomponentname, dvalue)
End If
Catch ex As Exception
End Try
End Sub
Private CrossThreadedDbGridView As New deldBGrridView(AddressOf ThreadedDbGridViewAddress)
''//end cross threaded component
when used is like this CrossThreadedDbGridView(DataGridView1, "TheText")
But what if I have lots of member or property to used like this code:
DbGridPapers.ColumnCount = 5
DbGridPapers.RowCount = rc
DbGridPapers.Update()
DbGridPapers.Columns(0).HeaderText = "PaperSize"
DbGridPapers.Columns(1).HeaderText = "#of_Pages"
DbGridPapers.Columns(2).HeaderText = "#of_Images"
DbGridPapers.Columns(3).HeaderText = "Payable"
DbGridPapers.Columns(4).HeaderText = "CountedImage"
DbGridPapers.Update()
DbGridPapers.Rows(rc).HeaderCell.Value = FileName
DbGridPapers.Rows(rc).Cells(0).Value = xpapersize
DbGridPapers.Rows(rc).Cells(1).Value = xpNumbers
DbGridPapers.Rows(rc).Cells(2).Value = xiNumbers
DbGridPapers.Rows(rc).Cells(3).Value = xTotImageCounts
DbGridPapers.Rows(rc).Cells(4).Value = xTotImageCounts
DbGridPapers.Update()
What should I do to make this simple and generally a nice thread safe component
Any ideas? that I can call them like this:
CrossThreadedDbGridView(DataGridView1.ColumnCount, 5)
CrossThreadedDbGridView(DataGridView1.RowCount, rc)
CrossThreadedDbGridView(DataGridView1.Columns(0).HeaderText, "PaperSize")
...
...
Or is there a better way of doing this
''//It's not really a generalized safe thread datagridview, i just input the details to run safely.
''//This is a bad programming code style I know, but there's many way to kill a chicken.
''//begin cross threaded DataGridView component
Private Sub dBgRIDvIEWNotInvokeRequired(ByVal yselect As Integer, ByVal dBGridViewcomponentname As DataGridView, _
ByVal dvalue As Integer, ByVal yfilename As String, ByVal ypapersize As String, _
ByVal ynumpages As Integer, ByVal yimagecount As Integer, ByVal yregularprice As Decimal, ByVal ycountedimages As Integer)
If yselect = 1 Then
dBGridViewcomponentname.ColumnCount = 5
dBGridViewcomponentname.RowCount = dvalue
dBGridViewcomponentname.Update()
dBGridViewcomponentname.Columns(0).HeaderText = "PaperSize"
dBGridViewcomponentname.Columns(1).HeaderText = "Charge_Pages"
dBGridViewcomponentname.Columns(2).HeaderText = "#of_Images"
dBGridViewcomponentname.Columns(3).HeaderText = "Payable"
dBGridViewcomponentname.Columns(4).HeaderText = "CountedImage"
dBGridViewcomponentname.Update()
ElseIf yselect = 2 Then
dBGridViewcomponentname.Rows(dvalue).ErrorText = yfilename
dBGridViewcomponentname.Rows(dvalue).HeaderCell.Value = yfilename
dBGridViewcomponentname.Rows(dvalue).Cells(0).Value = ypapersize
dBGridViewcomponentname.Rows(dvalue).Cells(1).Value = ynumpages
dBGridViewcomponentname.Rows(dvalue).Cells(2).Value = yimagecount
dBGridViewcomponentname.Rows(dvalue).Cells(3).Value = yregularprice
dBGridViewcomponentname.Rows(dvalue).Cells(4).Value = ycountedimages
dBGridViewcomponentname.Update()
ElseIf yselect = 3 Then
dBGridViewcomponentname.Update()
ElseIf yselect = 4 Then
dBGridViewcomponentname.Rows.RemoveAt(dvalue)
End If
End Sub
Private Sub CrossThreadedDbGridView(ByVal yselect As Integer, ByVal dBGridViewcomponentname As DataGridView, _
ByVal dvalue As Integer, ByVal yfilename As String, ByVal ypapersize As String, _
ByVal ynumpages As Integer, ByVal yimagecount As Integer, ByVal yregularprice As Decimal, ByVal ycountedimages As Integer)
Try
If InvokeRequired Then
Dim udd As New deldBGrridView(AddressOf CrossThreadedDbGridView)
Invoke(udd, New Object() {yselect, dBGridViewcomponentname, dvalue, yfilename, ypapersize, ynumpages, yimagecount, yregularprice, ycountedimages})
Else
dBgRIDvIEWNotInvokeRequired(yselect, dBGridViewcomponentname, dvalue, yfilename, ypapersize, ynumpages, yimagecount, yregularprice, ycountedimages)
End If
Catch ex As Exception
End Try
End Sub
Private Delegate Sub deldBGrridView(ByVal yselect As Integer, ByVal dBGridViewcomponentname As DataGridView, _
ByVal dvalue As Integer, ByVal yfilename As String, ByVal ypapersize As String, _
ByVal ynumpages As Integer, ByVal yimagecount As Integer, ByVal yregularprice As Decimal, ByVal ycountedimages As Integer)
''//end cross threaded DataGridView component
''//usage:
CrossThreadedDbGridView(2, DbGridPapers, rc, FileName, xpapersize, xpNumbers, xiNumbers, ((xRegularPrice * xpNumbers) + xTotImageCounts), xTotImageCounts)
Hello i have this code which i got from another forum.
Imports System
Imports System.Drawing
Imports System.Collections
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Data
Imports System.Runtime.InteropServices
Public Class mainform
Private Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
End Structure
Private Structure APPBARDATA
Public cbSize As Integer
Public hWnd As IntPtr
Public uCallbackMessage As Integer
Public uEdge As Integer
Public rc As RECT
Public lParam As IntPtr
End Structure
Private Enum ABMsg As Integer
ABM_NEW = 0
ABM_REMOVE = 1
ABM_QUERYPOS = 2
ABM_SETPOS = 3
ABM_GETSTATE = 4
ABM_GETTASKBARPOS = 5
ABM_ACTIVATE = 6
ABM_GETAUTOHIDEBAR = 7
ABM_SETAUTOHIDEBAR = 8
ABM_WINDOWPOSCHANGED = 9
ABM_SETSTATE = 10
End Enum
Private Enum ABNotify As Integer
ABN_STATECHANGE = 0
ABN_POSCHANGED
ABN_FULLSCREENAPP
ABN_WINDOWARRANGE
End Enum
Private Enum ABEdge As Integer
ABE_LEFT = 0
ABE_TOP
ABE_RIGHT
ABE_BOTTOM
End Enum
Private fBarRegistered As Boolean = False
Private Declare Function SHAppBarMessage Lib "shell32.dll" Alias "SHAppBarMessage" _
(ByVal dwMessage As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef pData As _
APPBARDATA) As Integer
Private Declare Function GetSystemMetrics Lib "user32" Alias "GetSystemMetrics" _
(ByVal nIndex As Integer) As Integer
Private Declare Function MoveWindow Lib "user32" Alias "MoveWindow" (ByVal hwnd As
Integer, _
ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As
Integer, _
ByVal bRepaint As Integer) As Integer
Private Declare Function RegisterWindowMessage Lib "user32" Alias
"RegisterWindowMessageA" _
(ByVal lpString As String) As Integer
Private uCallBack As Integer
Private Sub mainform_FormClosing(ByVal sender As Object, ByVal e As
System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
RegisterBar()
End Sub
Private Sub appBar_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles MyBase.Load
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(600, 960)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow
RegisterBar()
Me.Invalidate()
End Sub
Private Sub mainform_Paint(ByVal sender As Object, ByVal e As
System.Windows.Forms.PaintEventArgs) Handles Me.Paint
e.Graphics.DrawLine(New Pen(Color.White, 3), 0, 0, Me.Width, 0)
e.Graphics.DrawLine(New Pen(Color.White, 3), 0, 0, 0, Me.Height)
e.Graphics.DrawLine(New Pen(Color.Black, 3), 0, Me.Height - 3, Me.Width, Me.Height
- 3)
e.Graphics.DrawLine(New Pen(Color.Black, 3), Me.Width - 3, 0, Me.Width - 3,
Me.Height)
End Sub
Private Sub RegisterBar()
Dim abd As New APPBARDATA
abd.cbSize = Marshal.SizeOf(abd)
abd.hWnd = Me.Handle
If Not fBarRegistered Then
uCallBack = RegisterWindowMessage("AppBarMessage")
abd.uCallbackMessage = uCallBack
Dim ret As Integer = SHAppBarMessage(CType(ABMsg.ABM_NEW, Integer), abd)
fBarRegistered = True
ABSetPos()
Else
SHAppBarMessage(CType(ABMsg.ABM_REMOVE, Integer), abd)
fBarRegistered = False
End If
End Sub
Private Sub ABSetPos()
Dim abd As New APPBARDATA()
abd.cbSize = Marshal.SizeOf(abd)
abd.hWnd = Me.Handle
abd.uEdge = CInt(ABEdge.ABE_RIGHT)
If abd.uEdge = CInt(ABEdge.ABE_LEFT) OrElse abd.uEdge = CInt(ABEdge.ABE_RIGHT) Then
abd.rc.top = 0
abd.rc.bottom = SystemInformation.PrimaryMonitorSize.Height
If abd.uEdge = CInt(ABEdge.ABE_LEFT) Then
abd.rc.left = 0
abd.rc.right = Size.Width
Else
abd.rc.right = SystemInformation.PrimaryMonitorSize.Width
abd.rc.left = abd.rc.right - Size.Width
End If
Else
abd.rc.left = 0
abd.rc.right = SystemInformation.PrimaryMonitorSize.Width
If abd.uEdge = CInt(ABEdge.ABE_TOP) Then
abd.rc.top = 0
abd.rc.bottom = Size.Height
Else
abd.rc.bottom = SystemInformation.PrimaryMonitorSize.Height
abd.rc.top = abd.rc.bottom - Size.Height
End If
End If
' Query the system for an approved size and position.
SHAppBarMessage(CInt(ABMsg.ABM_QUERYPOS), abd)
' Adjust the rectangle, depending on the edge to which the
' appbar is anchored.
Select Case abd.uEdge
Case CInt(ABEdge.ABE_LEFT)
abd.rc.right = abd.rc.left + Size.Width
Exit Select
Case CInt(ABEdge.ABE_RIGHT)
abd.rc.left = abd.rc.right - Size.Width
Exit Select
Case CInt(ABEdge.ABE_TOP)
abd.rc.bottom = abd.rc.top + Size.Height
Exit Select
Case CInt(ABEdge.ABE_BOTTOM)
abd.rc.top = abd.rc.bottom - Size.Height
Exit Select
End Select
' Pass the final bounding rectangle to the system.
SHAppBarMessage(CInt(ABMsg.ABM_SETPOS), abd)
' Move and size the appbar so that it conforms to the
' bounding rectangle passed to the system.
MoveWindow(abd.hWnd, abd.rc.left, abd.rc.top, abd.rc.right - abd.rc.left,
abd.rc.bottom - abd.rc.top, True)
End Sub
Protected Overloads Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = uCallBack Then
Select Case m.WParam.ToInt32()
Case CInt(ABNotify.ABN_POSCHANGED)
ABSetPos()
Exit Select
End Select
End If
MyBase.WndProc(m)
End Sub
Protected Overloads Overrides ReadOnly Property CreateParams() As
System.Windows.Forms.CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
cp.Style = cp.Style And (Not 12582912)
' WS_CAPTION
cp.Style = cp.Style And (Not 8388608)
' WS_BORDER
cp.ExStyle = 128 Or 8
' WS_EX_TOOLWINDOW | WS_EX_TOPMOST
Return cp
End Get
End Property
End Class
and what i want to do is maybe put it in a .dll file or separate class so i don't have to make my form1's code enormous. and example may be
Public Class Docker
'all the appBar code can go here
End Class
Private Sub appBar_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles MyBase.Load
Docker.enabled = true
End Sub
i don't know how to do this at all so if you could please give me a detailed example that would be great thankyou :)
In your solution explorer right click solution>>add new project>>select class library project
Then build the new project (after you've added the class up there)
In the UI project (where your form exists) right click >> add reference >> projects tab >> select the dll project
Now you can see your class in the form, but don't forget to import the dll project
Import YourDLLProject
Create an empty form "MyForm" that use this code, and then inherit all your other forms from MyForm