Thiết kế UserForm bài số 10: Transparent UserForm Làm trong suốt UserForm

giaiphapvba

Administrator
Thành viên BQT
Bài học thiết kế số 01
Bài học thiết kế số 02
Bài học thiết kế số 03 .
Bài học thiết kế số 04 .
Bài học thiết kế số 05 .
Bài học thiết kế số 06 .
Bài học thiết kế số 07 .
Bài học thiết kế số 08 .
Bài học thiết kế số 09 .
==============================
Một vài trường hợp chúng ta muốn UserForm trong suốt để có thể nhìn được data ở phía sau. Trong trường hợp đó, chúng ta phải xử lý thế nào?
Bạn cần đăng nhập để thấy đính kèm


1. Code trên Module:
Mã:
#If VBA7 Then
    Private Declare PtrSafe Function FindWindow _
        Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetWindowLong _
        Lib "user32" Alias "GetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLong _
        Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function SetLayeredWindowAttributes _
        Lib "user32" _
        (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
#Else
    Private Declare Function FindWindow _
        Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong _
        Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong _
        Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SetLayeredWindowAttributes _
        Lib "user32" _
        (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
#End If

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2&

Public hWnd As Long

Sub MakeTransparent(frm As Object, TransparentValue As Integer)

    Dim bytOpacity As Byte

'Control the opacity setting.
    bytOpacity = TransparentValue

    hWnd = FindWindow("ThunderDFrame", frm.Caption)
    Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
    Call SetLayeredWindowAttributes(hWnd, 0, bytOpacity, LWA_ALPHA)

End Sub
2. Code trên UserForm:
Mã:
Private Sub UserForm_Initialize()
    'Make the form transparent.
    MakeTransparent Me, 200
End Sub
-Giá trị nhỏ nhất là 0
-Giá trị lớn nhất là 255.
Bạn có thể lựa chọn giá trị bất kỳ trong khoảng từ 165 tới 200.

Code trên đã phải sử dụng các hàm API. Tạm thời chúng ta chưa cần lý giải, copy và sử dụng vào chương trình của chúng ta là được.
Link file demo:

Nguồn tham khảo:
 

tuhocvba

Administrator
Thành viên BQT
Thấy anh em đang thảo luận về khai báo API của VB.net và VB. Mình cũng không rành. Ở topic này mình cứ làm như VB thôi.
Module 1:
Module Module1
    Private Declare Function FindWindow _
        Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong _
        Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong _
        Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SetLayeredWindowAttributes _
        Lib "user32" _
        (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
    Private Const GWL_EXSTYLE = (-20)
    Private Const WS_EX_LAYERED = &H80000
    Private Const LWA_ALPHA = &H2&

    Public hWnd As Long

    Sub MakeTransparent(frm As Object, TransparentValue As Integer)

        Dim bytOpacity As Byte

        'Control the opacity setting.
        bytOpacity = TransparentValue


        Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
        Call SetLayeredWindowAttributes(hWnd, 0, bytOpacity, LWA_ALPHA)

    End Sub
End Module
Form 1:
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        hWnd = Me.Handle
        MakeTransparent(Me, 200)
    End Sub
End Class
Kết quả cũng được cái form trong suốt trong VB.Net rồi.
Bạn cần đăng nhập để thấy đính kèm
 

NhanSu

SMod
Thành viên BQT
Bạn cần đăng nhập để thấy đính kèm


Mình thử VB.NET xem sao, chỉ cần đặt thuộc tính Opacity của form thành số <1 là được, các lệnh khác là VB tự sinh. Lần đầu dùng VB tìm mãi không thấy form đâu.
Mã:
Private Sub InitializeComponent()
        Me.Button1 = New System.Windows.Forms.Button()
        Me.TextBox1 = New System.Windows.Forms.TextBox()
        Me.SuspendLayout()
        '
        'Button1
        '
        Me.Button1.Location = New System.Drawing.Point(351, 85)
        Me.Button1.Name = "Button1"
        Me.Button1.Size = New System.Drawing.Size(149, 39)
        Me.Button1.TabIndex = 0
        Me.Button1.Text = "Button1"
        Me.Button1.UseVisualStyleBackColor = True
        '
        'TextBox1
        '
        Me.TextBox1.Location = New System.Drawing.Point(380, 242)
        Me.TextBox1.Name = "TextBox1"
        Me.TextBox1.Size = New System.Drawing.Size(197, 23)
        Me.TextBox1.TabIndex = 1
        '
        'Form1
        '
        Me.AutoScaleDimensions = New System.Drawing.SizeF(7.0!, 15.0!)
        Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
        Me.ClientSize = New System.Drawing.Size(800, 450)
        Me.Controls.Add(Me.TextBox1)
        Me.Controls.Add(Me.Button1)
        Me.Name = "Form1"
        Me.Text = "Form1"
        Me.ResumeLayout(False)
        Me.PerformLayout()
        
        //Chỉnh thuộc tính Opacity ở đây
        Me.Opacity = 0.5

    End Sub
 
Top