Home>

I want to make the background of the label control on the translucent form transparent in VB.NET

I created a translucent form using UpdateLayerdWindow.
At the same time, I want to make the background of the label control on the form transparent, but I don't know how to do it.
In particular, I hope that the problem can be solved without using UpdateLayerdWindow.
I would appreciate it if you could answer.
Corresponding source code
Imports System.Runtime.InteropServices
Public Class Form 1
    Private img As Bitmap
    Private g As Graphics
#Region "UpdateLayerdWindow related API"
  <DllImport ("gdi32.dll", ExactSpelling: = True, SetLastError: = True)>  Public Shared Function CreateCompatibleDC (ByVal hDC As IntPtr) As IntPtr
    End Function
  <DllImport ("gdi32.dll", ExactSpelling: = True, SetLastError: = True)>  Public Shared Function DeleteDC (ByVal hdc As IntPtr) As Boolean
    End Function
  <DllImport ("gdi32.dll", ExactSpelling: = True, SetLastError: = True)>  Private Shared Function DeleteObject (ByVal hObject As IntPtr) As Boolean
    End Function
  <DllImport ("gdi32.dll", ExactSpelling: = True, SetLastError: = True)>  Private Shared Function SelectObject (ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
    End Function
  <DllImport ("user32.dll", ExactSpelling: = True, SetLastError: = True)>  Private Shared Function GetDC (ByVal hWnd As IntPtr) As IntPtr
    End Function
  <DllImport ("user32.dll", ExactSpelling: = True, SetLastError: = True)>  Private Shared Function Release DC (ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
    End Function
  <DllImport ("user32.dll", ExactSpelling: = True, SetLastError: = True)>  Private Shared Function UpdateLayeredWindow (
        ByVal hwnd As IntPtr,
        ByVal hdcDst As IntPtr,
      <System.Runtime.InteropServices.In ()>      ByRef pptDst As Point,
      <System.Runtime.InteropServices.In ()>      ByRef psize As Size,
        ByVal hdcSrc As IntPtr,
      <System.Runtime.InteropServices.In ()>      ByRef pptSrc As Point,
        ByRef crKey As Integer,
      <System.Runtime.InteropServices.In ()>      ByRef pblend As BLEND FUNCTION,ByVal dwFlags As Integer
        ) As Boolean
    End Function
  <StructLayout (LayoutKind.Sequential, Pack: = 1)>  Private Structure BLENDFUNCTION
        Public BlendOp As Byte
        Public BlendFlags As Byte
        Public SourceConstantAlpha As Byte
        Public AlphaFormat As Byte
    End Structure
    Private Const WS_EX_LAYERED As Integer =&H80000'Layered window
    Private Const WS_BORDER As Integer =&H800000'Create a window with a border
    Private Const WS_THICKFRAME As Integer =&H40000'Create a window with resizing boundaries
    'Blend action settings
    Private Const AC_SRC_ALPHA As Byte = 1'Transfer source image has alpha value
    Private Const ULW_ALPHA As Integer = 2
#End Region
#Region "Apply layered window style to Form1"
    Protected Overrides ReadOnly Property CreateParams () As CreateParams
        'Main public properties of CreateParams
        '[ExStyle] Get or set the initial state to apply to the appearance and controls of the extended window
        'Get or set the initial state to apply to the appearance and controls of the [Style] window
        'Get or set the initial text for the [Caption] control
        '[ClassName] Get or set the name of the Windows class from which the control is derived
        '[ClassStyle] Get or set a bit-by-bit combination of class style values
        'Get or set additional parameter information needed to create the [Param] control
        '[Parent] Get or set the parent of the control
        Get
            Dim cp As CreateParams = MyBase.CreateParams
            cp.ExStyle = cp.ExStyle Or WS_EX_LAYERED
            Return cp
        End Get
    End Property
#End Region
#Region "Form Event"
    Private Sub Form1_Load (sender As Object, e As EventArgs) Handles MyBase.Load
        'Prepare frameless form
        Me.FormBorderStyle = FormBorderStyle.None
        Me.ControlBox = False
        Me.MaximizeBox = False
        Me.MinimizeBox = False
        Me.Text = String.Empty
        Me.Left = 100
        Me.Top = 300
        img = New Bitmap (Me.Width, Me.Height)g = Graphics.FromImage (img)
        g.Clear (Color.FromArgb (100, Color.Black))'Black with opacity = 100
        UpdateWindow ()
    End Sub
#End Region
#Region "Update layered window"
    Private Sub UpdateWindow ()
        Dim hScreenDC As IntPtr = GetDC (IntPtr.Zero)'Get the handle of the DC corresponding to the entire screen
        Dim memoryDC As IntPtr = CreateCompatibleDC (hScreenDC)'Create a memory DC
        Dim hBitmap As IntPtr = IntPtr.Zero'Initialize bitmap handle
        Dim hOldBitmap As IntPtr = IntPtr.Zero'Initialize bitmap handle
        Try
            hBitmap = img.GetHbitmap (Color.Empty)'Get the bitmap handle of [img]
            hOldBitmap = SelectObject (memoryDC, hBitmap)'Associate [img] with memory DC
            'Initialize BLENDFUNCTION structure
            Dim blend As BLEND FUNCTION
            blend.BlendOp = 0'Blend operation
            blend.BlendFlags = 0'always 0
            blend.SourceConstantAlpha = 255'Alpha value (0-255) applied to the entire source bitmap
            blend.AlphaFormat = AC_SRC_ALPHA'When the source bitmap has an alpha value (AC_SRC_ALPHA)
            'Update layered window
            'Prepare a framebuffer in memory for translucency, write data in it, transfer the result with the UpdateLayeredWindow function, and display it on the screen.
            Dim r As Boolean = UpdateLayeredWindow (Me.Handle,'Handle of layered window
                                                   hScreenDC,'Screen DC handle
                                                   Me.Location,'New screen position for layered windows
                                                   New Size (img.Width, img.Height),'New size for layered windows
                                                   memoryDC,'Handle of the surface DC that defines the layered window (obtained by CreateCompatibleDC)
                                                   New Point (0, 0),'Position of layer in device context
                                                   0,'COLORREF type with color keys used to configure layered windows
                                                   blend,'Pointer to the TBLENDfunction type that contains the transparency value to use when constructing the layered window
                                                   ULW_ALPHA)' flag
        Finally
            ReleaseDC (IntPtr.Zero, hScreenDC)'DC release
            If hBitmap<>IntPtr.Zero Then
                SelectObject (memoryDC, hOldBitmap)'Return bitmap of memory DC
                DeleteObject (hBitmap)'Release bitmap handle
            End If
            DeleteDC (memoryDC)'Free memory DC
        End Try
    End Sub
#End Region
End Class
What I tried Supplementary information (FW/tool version, etc.)

VB.NET (Visual Studio 2019)

  • Answer # 1

    If you just want to make the whole thing translucent, why not set the Form.Opacity property instead of UpdateLayerdWindow?

    For the time being, it is a method that does not use UpdateLayerdWindow
    Prepare two forms.
    Form1 is a form that is made translucent, and here we place what is displayed as translucent.
    Then set the Opacity property to make it translucent.

    Form2 makes the background a single color (for example, Color.Black) and uses the TransparencyKey property to make that single color transparent. Display Form1 as owner in the same position as Form1.

    that way

    It can be displayed in this way.

    If the background of the Label is not the same as the background of the Form but a different color as shown in the above figure, only the area of ​​the background will be drawn in some form on the transparent form. ..

    Postscript

    It ’s a timer process.

      Private t As Timers.Timer
        Private Sub TimerStart ()
            t = New Timers.Timer (15)
            AddHandler t.Elapsed, AddressOf Timer_Elapsed
            t.Start ()
        End Sub
        Private Sub Timer_Elapsed (sender As Object, e As Event Args)
            Static prevtime As DateTime = Now
            Console.WriteLine ($"{(Now --prevtime) .TotalMilliseconds} ms")
            prevtime = Now
        End Sub


    As you can see by executing such processing, there are rare cases where the interval is as long as 30ms.
    I don't think it feels like it's going to happen at such times.

    Private Sub TaskStart ()
        Static prevtime As DateTime = Now
        Task.Run (Sub ()
                        While True
                            Console.WriteLine ($"{(Now --prevtime) .TotalMilliseconds} ms")
                            prevtime = Now
                            Threading.Thread.Sleep (15)
                        End While
                    End Sub)
    End Sub


    If you run it in a separate thread like this, I don't think there will be much variation in the execution interval.
    I don't know what kind of processing is actually used to move the characters, but if it is a hindrance due to variations in the timer execution interval, it may be effective.