آموزشی ساخت یوزر فرم شفاف

[میثم مقدم نیا]

شاید براتون پیش اومده باشه، بخواهید یوزر فرمی داشته باشید که پشت اون معلوم باشه یا همون شفاف باشه
برای این کار کافیه که صفحه کد یوزر فرم خود را باز کنید و کد زیر را درون آن وارد کنید

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

Private Sub UserForm_Initialize()
Dim bytOpacity As Byte
bytOpacity = 192 ' تنظیم حجم نزولی متغیر  
hWnd = FindWindow("ThunderDFrame", Me.Caption)
Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
Call SetLayeredWindowAttributes(Me.hWnd, 0, bytOpacity, LWA_ALPHA)
End Sub 

در ضمن فراموش نکنید که برای میزان شفافیت یوزر فورم (Bytopacity) را میتوان در محدوده نوع بایت، از 0 تا 255 تنظیم کرد.

توجه داشته باشید که این کد برای ویندوز ۳۲ بیتی است و چنانچه شما از ویندوز ۶۴ بیتی استفاده میکنید در هرجای کد Declare دارید تبدیلش کنید به Declare PtrSafe مشکل حل میشود.


اگه به کارتون اومد سپاس یادتون نره ممنون

[reza_gh_tak]

من تو اين فرمم هرجا كژي ميكنم خطا ميده ممنون مي شم كمكم كنيد

[iranweld]

من تو اين فرمم هرجا كژي ميكنم خطا ميده ممنون مي شم كمكم كنيد

فایل پیوست را بررسی کنید

[majid_mx4]

با سلام

احتمالا سیستم شما bit-64 است اگر دستورات جناب IranWeld جواب نداد قسمت اول دستورات را بشکل زیر تغییر دهید .

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

پایدار باشید میر