How to create translucent effect in visual basic windows forms? - vb.net

Like the image below:
![The transparency effect i mean ][1]
http://i.stack.imgur.com/ststz.jpg
That effect in vb.You can actually see the background but its not purely transparent .Its translucent afaik.

I give you some ideas:
You can set the BackColor and TransparencyKey Color properties of your form to the same color.
Then assign the transparent image that you want, through handling the Mybase.Paint event, in this way:
Private Sub frmLogin_Paint(ByVal sender As Object,
ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
If Not Me.cObjImagen Is Nothing Then
e.Graphics.DrawImage(Me.cObjImagen, 0, 0, Me.Width, Me.Height)
End If
End Sub
Where 'cObjImagen' is a system.drawing.Image loaded from 'form_load' event, or from ' public sub new() ', for example...
If you need to move the form, this will help you to process the messages correctly:
Private Const WM_NCHITTEST As Integer = 132
Private Const HTCAPTION As Integer = 2
Protected Overloads Overrides Sub WndProc(ByRef m As Message)
If m.Msg = WM_NCHITTEST Then
m.Result = New IntPtr(HTCAPTION)
Else
MyBase.WndProc(m)
End If
End Sub

Related

How to stop a timer when mouse is scrolling or on top of scrollbar in listbox

I'm looking for a way to detect and switch off a timer when the mouse cursor is scrolling a listbox.
There is an easy way despite to create a new class like this one?link
Would be possible to check rectangle location of listbox 1 scroll bar and say: if mouse is in this range then timer1.stop?
EDIT1:
In order to create a rectangle I'm using
If e.X >= 364 AndAlso e.X <= 446 AndAlso e.Y >= 86 AndAlso e.Y <= 144 Then
MessageBox.Show("Clicked within the rectangle")
Else
MessageBox.Show("Clicked outside the rectangle")
End If
449-359 are the Top left corner location of the rectangle
while the rectangle size is x30 y156
The problem is I don't know in which event let it run!
Listbox click event doesn't recognize scrollbar as "inside of listbox"
Form_mouse click event doesn't recognize listbox scroll bar as a click in the form.
There is an event that despite the control you are on, it will let you play with this workaround?
Thanks
Here is what I posted on MSDN using this C# code. There is no code presented below that will restart the Timer.
Public Class BetterListBox
Inherits ListBox
' Event declaration
Public Delegate Sub BetterListBoxScrollDelegate(ByVal Sender As Object, ByVal e As BetterListBoxScrollArgs)
Public Event Scroll As BetterListBoxScrollDelegate
' WM_VSCROLL message constants
Private Const WM_VSCROLL As Integer = &H115
Private Const SB_THUMBTRACK As Integer = 5
Private Const SB_ENDSCROLL As Integer = 8
Protected Overrides Sub WndProc(ByRef m As Message)
' Trap the WM_VSCROLL message to generate the Scroll event
MyBase.WndProc(m)
If m.Msg = WM_VSCROLL Then
Dim nfy As Integer = m.WParam.ToInt32() And &HFFFF
If (nfy = SB_THUMBTRACK OrElse nfy = SB_ENDSCROLL) Then
RaiseEvent Scroll(Me, New BetterListBoxScrollArgs(Me.TopIndex, nfy = SB_THUMBTRACK))
End If
End If
End Sub
Public Class BetterListBoxScrollArgs
' Scroll event argument
Private mTop As Integer
Private mTracking As Boolean
Public Sub New(ByVal top As Integer, ByVal tracking As Boolean)
mTop = top
mTracking = tracking
End Sub
Public ReadOnly Property Top() As Integer
Get
Return mTop
End Get
End Property
Public ReadOnly Property Tracking() As Boolean
Get
Return mTracking
End Get
End Property
End Class
End Class
Then in your form subscribe to the Scroll event. Requires the ListBox above in your project, one Timer enabled and a Label.
Private Sub BetterListBox1_Scroll(Sender As Object, e As BetterListBox.BetterListBoxScrollArgs) _
Handles BetterListBox1.Scroll
Timer1.Enabled = False
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Label1.Text = Now.ToString()
End Sub

How can I apply a MouseHover and MouseLeave to two controls to act as one control?

I have two labels in my form which are placed side-by-side to act as one label. When I hover over the labels, I have a function that fades the labels to different colours, which works well. I am trying to apply the MouseHover and MouseLeave event to both labels, so that when I hover over Label1 and move to Label2 (and vice versa), the function doesn't then fade the colour back to the original colour. Currently, moving between the two labels activates MouseLeave followed by MouseHover again in the new label.
I have tried to add both labels to the event trigger, but this hasn't worked. I have also tried placing both labels in a Panel, but that then doesn't trigger the event.
Private Sub fadeHeaderIn(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseHover, Label2.MouseHover
Call fadeLabel("In")
End Sub
Private Sub fadeHeaderOut(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseLeave, Label2.MouseLeave
Call fadeLabel("Out")
End Sub
If the functionality to change the colour of part of the label existed, I'd not need the two labels, so if there is a better way of doing this altogether, I'm happy to do so. Thanks!
I have also tried placing both labels in a Panel, but that then
doesn't trigger the event.
That should work. The panel would act as the boundaries for both labels. You'll get a MouseLeave, though, when you move from the panel to the labels contained within. To prevent a false trigger, simply check if the mouse is still within the bounds of the panel. You can prevent multiple fade ins when moving from label to label by tracking the faded state with a boolean. It'd look something like this:
Public Faded As Boolean = False
Private Sub fadeHeaderIn(sender As Object, e As EventArgs) Handles Label1.MouseHover, Label2.MouseHover
If Not Faded Then
Faded = True
fadeLabel("In")
End If
End Sub
Private Sub fadeHeaderOut(sender As Object, e As EventArgs) Handles Panel1.MouseLeave
If Not Panel1.ClientRectangle.Contains(Panel1.PointToClient(Cursor.Position)) Then
If Faded Then
Faded = False
fadeLabel("Out")
End If
End If
End Sub
Here's a sample of what has been described in comments.
The Text of a control (here, derived from a standard Label) is split in two sections of the same measure. Each section can have a different color.
The active and inactive colors are custom public properties, they can be set in the designer.
Each section is tracked, meaning that the control is aware of what side the Mouse Pointer is currently hovering.
The size of the text is measured using the TextRenderer.MeasureText method. This size is used to calculate the rectangles that include the sections of text.
The Rectangle.Contains([Point]) method is then used to determine which section of the text the mouse pointer in hovering. [Point] is calculated using the MousePosition property, translated to client coordinates using the Control.PointToClient() method.
When the mouse pointer is moved from one section of text to the other (here, just two sections, more could be defined adding more rectangles), the control is Invalidated, causing a call to the OnPaint method of the control.
If the mouse pointer is not hovering a section of text, base.OnPaint(e) is called (also causing the Paint event to raise), which draws the default text with the default color.
In the OnPaint method, the Graphics region is clipped using the Rectangles that define the text sections. A subsequent call to TextRenderer.DrawText, setting the TextFormatFlags.PreserveGraphicsClipping flag, clips the text in the defined region, so just the section of text that fits in the clipping region is painted.
The Graphics.ExcludeClip() method is used here to define these clipping regions.
The TextFormatFlags.ExternalLeading and TextFormatFlags.TextBoxControl are also used to replicate the default text rendering, so the custom text is rendered in the same relative position.
This is how it behaves:
Custom Control Class to test the functionality:
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
<DesignerCategory("Code")>
Public Class LabelSplitText
Inherits Label
Private m_Text As String = String.Empty
Private m_Sections As RectangleF() = Nothing
Private m_PaintText As Boolean = False
ReadOnly flags As TextFormatFlags = TextFormatFlags.ExternalLeading Or
TextFormatFlags.PreserveGraphicsClipping Or
TextFormatFlags.TextBoxControl
Public Sub New()
InitializeComponent()
End Sub
Private Sub InitializeComponent()
ResizeRedraw = True
End Sub
Public ReadOnly Property ActiveRectangle As RectangleF
Public ReadOnly Property ActiveSide As String = String.Empty
Public Property ActiveColor As Color = Color.White
Public Property InactiveColor As Color = Color.DimGray
Protected Overrides Sub OnLayout(e As LayoutEventArgs)
MyBase.OnLayout(e)
Me.AutoSize = False
m_Text = Me.Text
End Sub
Protected Overrides Sub OnMouseEnter(e As EventArgs)
m_Text = Me.Text
Text = String.Empty
m_PaintText = True
MyBase.OnMouseEnter(e)
Invalidate()
End Sub
Protected Overrides Sub OnMouseLeave(e As EventArgs)
m_PaintText = False
Me.Text = m_Text
MyBase.OnMouseLeave(e)
End Sub
Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
MyBase.OnMouseMove(e)
Invalidate()
If m_Sections Is Nothing Then Return
Me._ActiveRectangle = If(m_Sections(0).Contains(e.Location), m_Sections(0), m_Sections(1))
End Sub
Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
Me._ActiveSide = If(m_Sections(0).Contains(e.Location), "left", "right")
MyBase.OnMouseClick(e)
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
If Not m_PaintText Then
MyBase.OnPaint(e)
Return
End If
Dim textSize As SizeF = TextRenderer.MeasureText(e.Graphics, m_Text, Me.Font, Me.ClientSize, flags)
m_Sections = GetTextAreaSections(textSize)
e.Graphics.ExcludeClip(Rectangle.Round(m_Sections(1)))
TextRenderer.DrawText(e.Graphics, m_Text, Me.Font, Point.Empty, GetSectionColor(0), flags)
e.Graphics.ResetClip()
e.Graphics.ExcludeClip(Rectangle.Round(m_Sections(0)))
TextRenderer.DrawText(e.Graphics, m_Text, Me.Font, Point.Empty, GetSectionColor(1), flags)
End Sub
Private Function GetSectionColor(section As Integer) As Color
Return If(m_Sections(section).Contains(PointToClient(MousePosition)),
Me.ActiveColor, Me.InactiveColor)
End Function
Private Function GetTextAreaSections(textSize As SizeF) As RectangleF()
If textSize.Width > Me.ClientSize.Width Then textSize.Width = Me.ClientSize.Width
Dim rectLeft = New RectangleF(PointF.Empty,
New SizeF(textSize.Width / 2.0F, Me.ClientSize.Height))
Dim rectRight = New RectangleF(New PointF(textSize.Width / 2.0F, 0),
New SizeF(textSize.Width / 2.0F, Me.ClientSize.Height))
Return {rectLeft, rectRight}
End Function
End Class

VB.net Move Form with FormBorderStyle None [duplicate]

This question already has answers here:
How to move form without form border (visual studio)
(9 answers)
Closed 5 years ago.
I wanna make simple form application with FormBorderStyle set to None, but the problem is I cant move this form, its just.. static? I wanna make something like this:
http://i.imgur.com/TlQCWJx.png
Any ideas how to fix it?
You can use code like this to make the form draggable:
Public Class Form1
Private Const HTCLIENT As Integer = &H1
Private Const HTCAPTION As Integer = &H2
Private Const WM_NCHITTEST As Integer = &H84
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_NCHITTEST AndAlso m.Result = HTCLIENT Then
m.Result = HTCAPTION
End If
End Sub
End Class
You could take a look at WPF.
It's a newer version of WinForms and you have much more possibilities to design your dialogs.
But it's also very different to WinForms. You will need time to find into WPF.
Microsoft Docs about WPF
Here's a very simple example of moving a borderless form to get you started:
Add a panel to your form, name it pnlTopBorder and dock it to the top. When you mousedown on the panel, capture the mouse position. When you mousemove on the panel, if the left button is pressed, then you calculate and set the new form position.
Public Class Form1
Private newpoint As System.Drawing.Point
Private xpos1 As Integer
Private ypos1 As Integer
Private Sub pnlTopBorder_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles pnlTopBorder.MouseDown
xpos1 = Control.MousePosition.X - Me.Location.X
ypos1 = Control.MousePosition.Y - Me.Location.Y
End Sub
Private Sub pnlTopBorder_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles pnlTopBorder.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
newpoint = Control.MousePosition
newpoint.X -= (xpos1)
newpoint.Y -= (ypos1)
Me.Location = newpoint
End If
End Sub
End Class
If you want the window title and form controls, you'll have to draw them in the Paint event and handle all the events to get them to work. It's all doable, but it's just more complex.

VB.NET - Non-client painting with Graphics.FromHwnd as Handle

I'm trying to do some non-client area painting to get a MS Office like windowsform. I have one or two other posts of the sort, but here is the one that is done with Graphics.FromHwnd passing IntPtr.Zero as arg. I consulted a lot of information, that I tried and just simply cannot get it to work. Dwm functions, GetWindowDC, and or combination of these. Nothing works. Except this example that I post.
Public Class Form6
Protected Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
Select Case m.Msg
Case WinAPI.Win32Messages.WM_ACTIVATEAPP
Me.Invalidate()
End Select
End Sub
Private Sub Form6_LocationChanged(sender As Object, e As EventArgs) Handles Me.LocationChanged
Me.Invalidate()
End Sub
Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
MyBase.OnPaint(e)
Dim usedColor As Color = Color.Beige
Me.BackColor = usedColor
Dim usedBrush As Brush = New SolidBrush(usedColor)
'Dim hDC As IntPtr = WinAPI.GetWindowDC(Me.Handle.ToInt64)
Using g As Graphics = Graphics.FromHwnd(IntPtr.Zero)
'Using g As Graphics = Graphics.FromHdc(hDC)
'Caption
Dim rect As Rectangle = New Rectangle(Me.Left, Me.Top, Me.Width, SystemInformation.CaptionHeight + 2 * SystemInformation.FrameBorderSize.Height)
g.FillRectangle(usedBrush, rect)
'left border
rect = New Rectangle(Me.Left, Me.Top + SystemInformation.CaptionHeight + 2 * SystemInformation.FrameBorderSize.Height, (Me.Width - Me.ClientSize.Width) / 2, Me.ClientSize.Height)
g.FillRectangle(usedBrush, rect)
'right border
rect = New Rectangle(Me.Right - 2 * SystemInformation.FrameBorderSize.Width, Me.Top + SystemInformation.CaptionHeight + 2 * SystemInformation.FrameBorderSize.Height, (Me.Width - Me.ClientSize.Width) / 2, Me.ClientSize.Height)
g.FillRectangle(usedBrush, rect)
'bottom border
'If on maximize this border isn't drawn, by default the windowsize "drawing" is correct
If Me.WindowState <> FormWindowState.Maximized Then
rect = New Rectangle(Me.Left, Me.Bottom - 2 * SystemInformation.FrameBorderSize.Width, Me.Width, 2 * SystemInformation.FrameBorderSize.Height)
g.FillRectangle(usedBrush, rect)
End If
End Using
'WinAPI.ReleaseDC(Me.Handle.ToInt64, hDC)
End Sub
Private Sub Form6_Resize(sender As Object, e As EventArgs) Handles Me.Resize
Me.Invalidate()
End Sub
Private Sub Form6_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
Me.Invalidate()
End Sub
End Class
To generate graphics, I pass IntPtr.Zero for the hole screen.
I tried the GetWindowDC API (commented in code), and nothing happens. The handle was passed as Me.Handle, Me.Handle.ToInt32 and .ToInt64, and no result.
The invalidate called is to try to draw in every situation possible.
Problems that bring me here:
Form does not start up painted (can't figure it out);
Resizing flickers a lot (probably because the handle is to the entire screen, even form being double-buffered);
On the resizing, it's visible the painting over the cursor (again probably because of the handle for the graphics isn't the form's handle);
On mouse over control buttons (min, max and close), all drawing disappears;
Although I can detect problems, I can't get other ways to work, like the famous GetWindowDC, regardless of how many examples I tried that don't work, or even the DWM functions.
Being the purpose of getting my own "Office" like form, I ask some help in getting improvements to this code or some other ideas, that are welcome.
[EDIT]
Another flavor of the above code. This code was tried in form_load event, but nothing happened.
Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
MyBase.OnPaint(e)
If Not DwmAPI.DwmIsCompositionEnabled(True) Then
Dim myHandle As IntPtr = WinAPI.FindWindow(vbNullString, Me.Text)
Dim hDC As IntPtr = WinAPI.GetWindowDC(myHandle)
Dim rect As WinAPI.RECT
With rect
.Left = 0
.Right = Me.Width
.Top = 0
.Bottom = 30
End With
Using g As Graphics = Graphics.FromHdc(hDC)
g.DrawString("TESTER", New Font(Me.Font.Name, 50), Brushes.Red, New Point(0, 0))
End Using
WinAPI.ReleaseDC(myHandle, hDC)
End If
End Sub
The result is this:
http://postimg.org/image/yyg07zf87/
As it would be clear, I want to have whatever if graphics drawn over titlebar and not under, although it's visible that the coords for the drawing are from full form area and not client area. If I doublebuffer the form, nothing is drawn. Any ideas?
Thanks for your patience. Best regards.

How can I set a transparent background colour for a WebBrowser in VB.Net?

I'm using a web-browser to load up images from the web automatically in a VB.Net forms applications, however, there is a white background where the image doesn't fill the whole of the navigator object on the form.
How can I go about setting a transparent background for the web browser object in my application?
Thanks,
C.
Set the form's transparency key to white.
The color you choose as the transparency key is transparent-ed out. Anything on the entire form with that color is turned into transparent. As the browser's background is of white color, a white transparency key will make it transparent, you can use Windows Aero Glass DWM effect for a glassy transparency but it would only work on Windows Vista onwards, for previous version of Windows, you'll have to paint it manually which is a long job to do. The simplest and the most quickest thing for you is to set the Transparency Key to White :)
Me.TransparencyKey = Color.White
If you want to use Aero Glass DWM, use the code below:
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Runtime.InteropServices
Private mExtendedFrameMargins As MARGINS
Protected Overrides Sub _
OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
'use either one
e.Graphics.SmoothingMode = SmoothingMode.HighQuality
End Sub
Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
If IsGlassEnabled() Then
'You should paint the extended frame black for proper composition, but I'm painting it white as you need it
e.Graphics.FillRectangle(Brushes.White, 0, 0, Me.ClientRectangle.Width, mExtendedFrameMargins.cyTopHeight)
End If
End Sub
Private Function IsGlassEnabled() As Boolean
If Environment.OSVersion.Version.Major < 6 Then
Return False
End If
Dim isGlassSupported As Boolean = False
DwmIsCompositionEnabled(isGlassSupported)
Return isGlassSupported
End Function
<DllImport("dwmapi.dll")> _
Private Shared Function DwmIsCompositionEnabled(<MarshalAs(UnmanagedType.Bool)> ByRef pfEnabled As Boolean) As Integer
End Function
<DllImport("dwmapi.dll")> _
Private Shared Function DwmExtendFrameIntoClientArea(ByVal hwnd As IntPtr, ByRef pMarInset As MARGINS) As Integer
End Function
<StructLayout(LayoutKind.Sequential)> _
Private Structure MARGINS
Public cxLeftWidth As Integer
Public cxRightWidth As Integer
Public cyTopHeight As Integer
Public cyBottomHeight As Integer
End Structure
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If IsGlassEnabled() Then
mExtendedFrameMargins = New MARGINS
mExtendedFrameMargins.cyTopHeight = Me.Height 'type height here, this is going to be a number (integer)
DwmExtendFrameIntoClientArea(Me.Handle, mExtendedFrameMargins)
End If
End Sub
I've used this code in an app that I'm creating