شیشه ای کردن فرم Bugs Fixed (Window Vista Or Later):D

[Mr'Jamshidy]

سلام دوستان

با توجه به مشکلاتی که دوستان در شیشه ای کردم فرم هاشون در ویندوز ویستا به بعد داشتن تصمیم گرفتم تا پیگیر این مشکل بشم و تا اونجایی که من دیدم تو انجمن بحثی که به سرانجام رسیده باشه پیدا نکردم و بلاخره بعد از کلی تلاش و جمع آوری اطلاعات از این انجمن و سراسر وب تونستم به نتیجه زیر برسم

86100

در آخر روی کدهایی که تو این انجمن پیدا کردم و بررسی اون ها تونستم کلی پیدا کنم که بدرد همه بخوره

فقط کافیه کد زیر رو تو یک ماژول کپی کنید

Option Explicit

Private Const LWA_COLORKEY As Long = &H1
Private Const GWL_EXSTYLE As Long = (-20)
Private Const WS_EX_LAYERED As Long = &H80000
Private Const WS_EX_TRANSPARENT As Long = &H20&
Private Const LWA_ALPHA As Long = &H2&

Private Type tRect
m_Left As Long
m_Right As Long
m_Top As Long
m_Buttom As Long
End Type

Private Declare Function apiApplyGlass Lib "dwmapi.dll" Alias "DwmExtendFrameIntoClientArea" (ByVal hWnd As Long, rect As tRect) 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 Long, ByVal bAlpha As Byte, ByVal dwflags As Long) As Long

Public Function ApplyAero(frm As Form, tColor As Long) As Long
Dim lOldStyle As Long

lOldStyle = GetWindowLong(frm.hWnd, GWL_EXSTYLE)
SetWindowLong frm.hWnd, GWL_EXSTYLE, lOldStyle Or WS_EX_LAYERED
SetLayeredWindowAttributes frm.hWnd, tColor, 0, LWA_COLORKEY
frm.BackColor = tColor

Dim GRect As tRect
Dim lngReturn As Long

GRect.m_Buttom = -1
GRect.m_Left = -1
GRect.m_Right = -1
GRect.m_Top = 0

lngReturn = apiApplyGlass(frm.hWnd, GRect)

ApplyAero = lngReturn
End Function



و بصورت زیر از کد استفاده کنید

ApplyAero Me, RGB(1, 1, 1)

بجای Me فرمی که میخواهید شیشه ای بشه رو جایگزین کنید و بجای RGB(1,1,1) رنگی که اصلا داخل فرم استفاده نمیکنید رو جایگزین کنید

اگر مطلب مفید بود تشکر یادتون نره Vote Me :چشمک:

موفق باشید

[M.T.P]

مرسی

برای از بین بردن رنگ پس زمینه بعضی اشیائ هم باید رنگ BackColor اونها با رنگی که برای شیشه ای کردن در نظر گرفتیم یکی باشه.

کد فرم:


Option Explicit

Private Sub Form_Load()
SetBackcolors
ApplyAero Me, vbCyan
End Sub

Sub SetBackcolors()
On Error Resume Next
Dim ctl As Control

For Each ctl In Me.Controls
ctl.BackColor = vbCyan
Next ctl
End Sub

[IamOverlord]

برای این که وقتی روی فرم کلیک می کنیم، پشتش کلیک نشه باید چی کار کنیم؟

[M.T.P]

به خاطر رنگ

rgb(1,1,1)
هست رنگ رو بزارید vbCyan حله