Dropping shadow on WinForm distorts interface - vb.net

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

Related

Issue with Lockbits in DrawImage

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

vb.net basics, How do I create a public function for handling dynamically created buttons

I'm new to vb.net. To be honest I've only been using it for a week or so. I've actually hit a wall when it comes to creating a Public Function for dynamically created buttons.
I've got a form in which I've got the following button creation code:
'Function for creating buttons
Public Sub CreateNewButton(font As String, x As Integer, y As Integer,
width As Integer, height As Integer,
name As String, text As String,
menu_type As Integer,
Optional hidden As Boolean = True,
Optional centered As Boolean = False)
'Create a button as an entity
Dim btn As Button = New Button
'Assign the location
If centered = True Then
btn.Location = New Point(x - width / 2, y - height / 2)
Else
btn.Location = New Point(x, y)
End If
'Assign other variables from function parameters
btn.Name = name
btn.Text = text
btn.Height = height
btn.Width = width
'Should the button be hidden when created?
If hidden = True Then
btn.Hide()
End If
'Change the font
If font = "Normal" Then
btn.Font = setFont(btn.Font, "Consolas", 18)
ElseIf font = "Small" Then
btn.Font = setFont(btn.Font, "Consolas", 12)
End If
'Assign the Handlers and non-function variables
btn.BackColor = Color.Gray
btn.Anchor = AnchorStyles.None
Me.Controls.Add(btn)
AddHandler btn.Click, AddressOf ButtonOnMouseClick
AddHandler btn.MouseHover, AddressOf ButtonOnMouseHover
AddHandler btn.MouseLeave, AddressOf ButtonOnMouseLeave
End Sub
So basically, it works like a charm when being used in this form. But when I've tried using it in a different form I realized that I had to create the same function again. This process would become tedious if I had to do it for each and every form.
That's why I decided to create a new module called Public Functions in which I would have common functions shared by each module. The problem is that once it's created it cannot be executed because it returns an error that 'Controls.add' was not previously declared.
I do believe that this is something really simple. I've tried looking for the libraries which could be missing and I've tried importing System.Windows.Forms.Controls but I still get the same error.
How do I actually create a Public Function which can be shared between different forms?
Thanks in advance, Alex
Sample code as requested:
Method 1 Passing the Controls collection to your helper function.
Public Sub CreateNewButton(parentControls As ControlCollection,
font As String, x As Integer, y As Integer,
width As Integer, height As Integer,
name As String, text As String,
menu_type As Integer,
Optional hidden As Boolean = True,
Optional centered As Boolean = False)
' Abbreviated implementation to illustrate the point
Dim newButton As New Button
newButton.Top = y
newButton.Left = x
newButton.Name = name
newButton.Text = text
parentControls.Add(newButton)
End Sub
Method 2 Passing the Parent container to your helper function.
Public Sub CreateNewButton(parent As Control,
font As String, x As Integer, y As Integer,
width As Integer, height As Integer,
name As String, text As String,
menu_type As Integer,
Optional hidden As Boolean = True,
Optional centered As Boolean = False)
' Abbreviated implementation to illustrate the point
Dim newButton As New Button
newButton.Top = y
newButton.Left = x
newButton.Name = name
newButton.Text = text
parent.Controls.Add(newButton)
End Sub
Screen shot of what it looks like.
* New 1 is from the first function
* New 2 is from the second function
These two functions can be called like this:
CreateNewButton(Me.Controls, "", 10, 10, 50, 20, "btnNew1", "New 1", 1)
CreateNewButton(Me, "", 100, 100, 50, 20, "btnNew2", "New 2", 1)
Create a class library(.DLL), say MyFunctionsLib.DLL which contains your functions and place it in the same folder of your new project folder (or in any sub folder).
When another new project is created, you add a reference to your 'DLL' file and you can access the functions.
In visual Studio 2017, File->New Project ->Visual Basic-> .NET Standard-> Class Library
and give a suitable name say MyFunctionsLib, click Ok
Eg.
Public NotInheritable Class MyFunctionsLib
Public Shared Function addTwoNums(a As Integer, b As Integer) As Integer
Return a+b
End Function
End Class
Build your project and use your 'DLL' with any other project.

Transparency of picture box

Im just looking for an answer in my simple problem. Here it is
I have a pricturebox that has image with transparent background i Set the picturebox backcoloras transparent.
and after that, the picture has transparent bg. But after i added this code
ìmg1.Left = windows.forms.cursor.Position.X - me.Left
ìmg1.Top= windows.forms.cursor.Position.Y - me.Top
'code for using img as cursor
the image bg is not really transparent like this
I think the transaparent backcoloris not really transparent. it will only get the backcolorof form and use it as backcolorof image instead of transparent.
Is there any solution to make it fully transparent?
You are correct in your assumption.
Transparency in winforms does not mean that the object is actually transparent. Instead, it means that it will display it's parent object instead of it's background, including it's background, images and text, but not including any other controls on it, hence your problem.
Since the parent control of your top most picture box is not and can not be the other picture boxes, the fact that your top most picture box have a transparent background will not help.
Unfortunately, using the form's TransparencyKey property will also not help for this. (It will make the selected color transparent, but will yield unexpected (and usually undesired) results.
In order to achieve your goal, you will have to follow OneFineDay's advice in the comments, and use Graphics to draw the image yourself.
Fortunately, this is very easy to do:
Public Sub DrawImage(Image as Image, Location As Point)
Using(Dim g as Graphics = Me.CreateGraphics())
g.DrawImage(Image, Location)
EndUsing
End Sub
This blog article inspired this SO answer. These were the basis for a more robust control with scaling, text, contentalignment etc.
The following is a scaled back version (in VB) to primarily implement the appearance of true transparency. The core painting is nearly identical to the original SO post except to account for a border in the painting. A few control level features have also been retained.
'Namespace omitted to reduce indentation
Imports System.Windows.Forms
Imports System.Drawing
Imports System.ComponentModel
Imports System.Drawing.Drawing2D
Public Class TransPicBox
Inherits PictureBox
Public Enum ImageSizing
None
Stretch
Scale
End Enum
Public Sub New()
' defaults for a new one
MyBase.BackColor = Color.Transparent
MyBase.InitialImage = Nothing
MyBase.ErrorImage = Nothing
MyBase.Image = Nothing
End Sub
Public Overloads Property Image As Image
Get
Return MyBase.Image
End Get
Set(value As Image)
MyBase.Image = value
InvalidateParent()
End Set
End Property
Private imgSizing As ImageSizing = ImageSizing.None
Public Property ImageSizing As ImageSizing
Get
Return imgSizing
End Get
Set(value As ImageSizing)
imgSizing = value
InvalidateParent()
End Set
End Property
' because the child control displays are interdependent
' tell the parent to update when some things change
' Image, Scaling, Border, Text, BackColor etc
Private Sub InvalidateParent()
Invalidate()
If MyBase.Parent IsNot Nothing Then
MyBase.Parent.Invalidate()
End If
End Sub
' since the display depends on ZOrder, provide
' a control method to alter it
Public Sub MoveUpZOrder()
ChangeZOrder(-1)
End Sub
Public Sub MoveDownZOrder()
ChangeZOrder(+1)
End Sub
Private Sub ChangeZOrder(value As Int32)
Dim ndx As Integer = Parent.Controls.GetChildIndex(Me)
If ((ndx + value) >= 0) AndAlso ((ndx + value) < Me.Parent.Controls.Count) Then
Me.Parent.Controls.SetChildIndex(Me, ndx + value)
End If
End Sub
' if you want to remove properties, this is how
<Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Property ErrorImage As Image
Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs)
If MyBase.BackColor = Color.Transparent Then
' magic happens here!
PaintSiblings(pevent)
Else
' do nothing special when the backcolor is not Transparent
MyBase.OnPaintBackground(pevent)
End If
End Sub
' code for painting the image
Protected Overrides Sub OnPaint(pe As PaintEventArgs)
Dim rect As Rectangle
If (MyBase.Image IsNot Nothing) Then
rect = GetImgRect(Bounds)
pe.Graphics.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
pe.Graphics.CompositingQuality = CompositingQuality.HighQuality
pe.Graphics.SmoothingMode = SmoothingMode.HighQuality
pe.Graphics.DrawImage(Image, rect)
End If
End Sub
Private Sub PaintSiblings(e As PaintEventArgs)
' need to access the parent' controls collection
If (Parent IsNot Nothing) Then
Dim borderSize As Integer = 0
Dim thisLeft As Single = -Left
Dim thisTop As Single = -Top
' fix
Select Case MyBase.BorderStyle
Case BorderStyle.FixedSingle
borderSize = SystemInformation.BorderSize.Width
Case BorderStyle.Fixed3D
borderSize = SystemInformation.Border3DSize.Width
End Select
' Shift ClipBounds to form relative coords
e.Graphics.TranslateTransform(thisLeft, thisTop)
' Get Parent to paint the part behind us:
' we cant know if thats been done or not
Using pea As New PaintEventArgs(e.Graphics, e.ClipRectangle)
InvokePaintBackground(Parent, pea)
InvokePaint(Parent, pea)
End Using
' shift back
e.Graphics.TranslateTransform(-thisLeft, -thisTop)
' starting control index is...well, ours
Dim startAt As Integer = Parent.Controls.GetChildIndex(Me)
Dim ctl As Control
' Controls are in z-Order, so loop
' thru the controls "behind" me
For n As Int32 = Parent.Controls.Count - 1 To startAt + 1 Step -1
ctl = Parent.Controls(n)
' skip if they are invisible, too small or do not overlap me
If (ctl.Visible = False OrElse
ctl.Width = 0 OrElse
ctl.Height = 0 OrElse
Bounds.IntersectsWith(ctl.Bounds) = False) Then
Continue For
Else
Using bmp As New Bitmap(ctl.Width, ctl.Height, e.Graphics)
' draw this sibling to a bitmap
ctl.DrawToBitmap(bmp, New Rectangle(0, 0, ctl.Width, ctl.Height))
' shift the orientation relative to sibling and draw it
thisLeft = ctl.Left - Left
thisTop = ctl.Top - Top
'offset, then draw the image, reset
e.Graphics.TranslateTransform(thisLeft - borderSize,
thisTop - borderSize)
e.Graphics.DrawImageUnscaled(bmp,
New Point(0, 0))
e.Graphics.TranslateTransform(-thisLeft + borderSize,
-thisTop + borderSize)
End Using
End If
Next
Else
' not sure how this could happen
Using br As New SolidBrush(MyBase.BackColor)
e.Graphics.FillRectangle(br, ClientRectangle)
End Using
End If
End Sub
' image scaling is mainly a matter of the size and location
' of the img rect we use in Paint
Private Function GetImgRect(destRect As Rectangle) As Rectangle
Dim pt As New Point(0, 0)
Dim sz As Size
If MyBase.Image IsNot Nothing Then
Select Case Me.ImageSizing
Case ImageSizing.None
sz = Image.Size
Case ImageSizing.Scale
If Width > Height Then
sz = New Size(GetScaledWidth(Height), Height)
Else
sz = New Size(Width, GetScaledHeight(Width))
End If
Case ImageSizing.Stretch
sz = Me.Size
End Select
End If
' ToDo: move the pt if you add an Image ContentAlignment
' (Top, TopLeft, BottomRight...) property
Return New Rectangle(pt, sz)
End Function
Private Function GetScaledWidth(h As Integer) As Integer
Dim scale As Single = CSng(Image.Width / Image.Height)
Return CInt(h * scale)
End Function
Private Function GetScaledHeight(w As Integer) As Integer
Dim scale As Single = CSng(Image.Height / Image.Width)
Return CInt(w * scale)
End Function
End Class
How to Use It
Create a Class Library
Replace the new class boilerplate code with the above
Add references for the NameSpaces listed in the Imports statements
Build the Library. A new TransPicBox should show in the toolbox.
You can also just include the class code file in your project and rebuild to avoid a DLL dependency which includes just one thing. Results:
Four small PNGs under a larger one; all are on a Panel (rose BG)
The TopLeft and BottomRight images use a Transparent BG, the other 2 do not
They all have the border turned on to show the client area; the BL Clock uses a 3D border
The larger PNG uses ImageSizing.Scale to be about 150% larger
The parent backcolor shows thru the TL and BR images as well as the overlapping larger one in front. The control will display BMP and JPGs normally and still show whats behind empty areas (if any) when the control's back color is Transparent.
Notes:
This is a fairly expensive Paint. Each time one of these needs to be painted, at least a portion of the parent and every control under it must be repainted as well.
When moving a TransPicBox in the form designer, VS temporarily brings the control to the front, so the display is temporarily whacked
Windows ambles on normally so things behind your special control are still hidden as far as it is concerned. The image below shows that the portions of a button partially behind a TransPicBox will not 'glow' when the mouse is over it. As far as Windows knows, that portion of it cant be seen so it is not repainted.
Drawing the image using a graphics object is the recommended procedure if you're going to use it as a cursor. But if you sometime want to use a PictureBox (for reasons like being able to quickly change image using it's Image property, etc), that is possible too.
This code will draw a better "transparent" background, by drawing each control behind your PictureBox on it's background.
How to use:
1) Create a custom class.
2) Put Inherits PictureBox below the Public Class ... line.
3) Paste this code inside the class:
Protected Overrides Sub OnPaintBackground(e As System.Windows.Forms.PaintEventArgs)
MyBase.OnPaintBackground(e)
If Parent IsNot Nothing Then
Dim index As Integer = Parent.Controls.GetChildIndex(Me)
For i As Integer = Parent.Controls.Count - 1 To index + 1 Step -1
Dim c As Control = Parent.Controls(i)
If c.Bounds.IntersectsWith(Bounds) AndAlso c.Visible = True Then
Dim bmp As New Bitmap(c.Width, c.Height, e.Graphics)
c.DrawToBitmap(bmp, c.ClientRectangle)
e.Graphics.TranslateTransform(c.Left - Left, c.Top - Top)
e.Graphics.DrawImageUnscaled(bmp, Point.Empty)
e.Graphics.TranslateTransform(Left - c.Left, Top - c.Top)
bmp.Dispose()
End If
Next
End If
End Sub
4) Build your project.
5) Select your class from the toolbox and add it to your form/usercontrol.

Code error for contour anlaysis in VB.net

I'm trying to use emgu.cv lib for contour function in vb.net. The problem is my var is not defined. This should come under lib emgu.cv which I have already imported.
Dim borderPen As New Pen(Color.FromArgb(150, 0, 255, 0))
Dim processor As ImageProcessor
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs)
Dim borderPen As New Pen(Color.FromArgb(150, 0, 255, 0))
If RadioButton1.Checked = True Then
For Each contour As var In processor.contours
If contour.Total > 1 Then
e.Graphics.DrawLines(Pens.Red, contour.ToArray())
End If
Next
End If
SyncLock processor.foundTemplates
For Each found As FoundTemplateDesc In processor.foundTemplates
If found.template.name.EndsWith(".png") OrElse found.template.name.EndsWith(".jpg") Then
DrawAugmentedReality(found, e.Graphics)
Continue For
End If
Next
End SyncLock
End Sub
Private Sub DrawAugmentedReality(found As FoundTemplateDesc, gr As Graphics)
Dim fileName As String = "C:\Users\pnasguna\Desktop\A56.jpg"
Dim AugmentedRealityImages As New Dictionary(Of String, Image)()
Dim img As Image = AugmentedRealityImages(fileName)
Dim p As Point = found.sample.contour.SourceBoundingRect.Center()
Dim state = gr.Save()
gr.TranslateTransform(p.X, p.Y)
gr.RotateTransform(CSng(180.0F * found.angle / Math.PI))
gr.ScaleTransform(CSng(found.scale), CSng(found.scale))
gr.DrawImage(img, New Point(-img.Width / 2, -img.Height / 2))
gr.Restore(state)
End Sub
I could not compile as var is not defined. How to fix this problem?
You get the Type <typename> is not defined error because the type var is not defined. You fix this by doing one of the following steps:
Remove As var.
For Each contour In processor.contours
Replace var with the correct data type.
For Each contour As <THE_CORRECT_TYPE> In processor.contours
Emgu
Looking at the source code for emgu (written in C#), the ImageProcessor.cs file will reveal the data type of contours:
public List<Contour<Point>> contours;
Translated into vb.net:
Public contours As List(Of Contour(Of Point))
Solution
So with this information it's pretty easy to pick the correct data type.
For Each contour As Contour(Of Point) In Me.processor.contours
Note: You should always have Option Strict set to On.

Capture Snapshot image from video in AxWindowsMediaPlayer in vb.net

I am looking for a function to take a screenshot from an embedded Windows Media Player control in a VB.NET Windows form. I am currently using the following function; it works fine, but the problem is that x and y are different on each screen so it would be better if I could use a function in the AxWindowsMediaPlayer control itself, like .Capture() or a similar method.
Private Function TakeImage(ByVal X As Integer, ByVal Y As Integer, ByVal Width As Integer, ByVal Height As Integer) As Bitmap
Dim Img As New Bitmap(Width, Height)
Dim g As Graphics = Graphics.FromImage(Img)
g.CopyFromScreen(X, Y, 0, 0, Img.Size)
g.Dispose()
Return Img
End Function
Dim bmp As Bitmap = TakeImage(x, y - 20, AxWindowsMediaPlayer1.Width, AxWindowsMediaPlayer1.Height)
bmp.Save("E:\pics\" & i.ToString & ".jpg", Drawing.Imaging.ImageFormat.Jpeg)
You could try Ctl.PointToScreen() to get an absolute screen point for CopyFromScreen.
I would get the AxWMP.PointToScreen in the procedure each time since the form could move. Pass them to CopyFromScreen and see if that works. I am not sure if it expects X,Y relative to the app, form or what but Screen, does mean screen.