درخواست کد فرم نامرئی برای vb6

Star-PCPack

Star-PCPack

Member
سلام دوستان من دنبال یه کد می خواستم که بشه با اون یه فرم نامرئی ساخت مثل پنجره انتخاب گجت ویندوز ویستا یا سون منتظرم :rose:
 
the_king

the_king

مدیرکل انجمن
Star-PCPack گفت:
سلام دوستان من دنبال یه کد می خواستم که بشه با اون یه فرم نامرئی ساخت مثل پنجره انتخاب گجت ویندوز ویستا یا سون منتظرم :rose:
کلیک کنید تا باز شود...

پنجره های نیمه شفافی که در ویندوز های Vista و 7 نمایش داده می شوند با یک پنجره نیمه شفاف عادی قدری
متفاوت اند، چون هم میزان Opacity (شفافیت) شان توسط تنظیمات ویندوز قابل تنظیم است و هم تصویر پشت شان
را محو نشان می دهند (تصویر پشت شان را Blur می کنند). این قابلیت با فرم ها و کنترل های ویژوال بیسیک 6
جور در نمی آید، چون زمانی که ویژوال بیسیک طراحی شد، چنین قابلیتی هم وجود نداشت. شاید با استفاده از
یکسری توابع API عملی باشد، اما تا حال چنین کدی ندیده ام، چون نیازمند پشتیبانی کامل از تصاویر نیمه شفاف است که
ویژوال بیسیک از آنها پشتیبانی نمی کند.

راهی وجود دارد که با یک سری کد نسبتا طولانی یک تصویر نیمه شفاف را که بعضی قسمت هایش کاملا شفاف و
بعضی قسمت هایش نیمه شفاف یا بدون شفافیت باشد را به عنوان بدنه فرم نمایش دهید، اما عیب بزرگ اش این
است که دیگر هیچ کنترل ای که روی فرم قرار داده باشید دیده نخواهد شد، و فقط همان تصویر مشاهده می شود.

راه حل اول :
شما می توانید به سادگی Opacity یک فرم استاندارد را کم کنید، مثلا 75 درصد :
کد: 
Option Explicit

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

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 crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Sub Form_Load()
    Dim Ret As Long, Opacity As Long
    Ret = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    SetWindowLong hWnd, GWL_EXSTYLE, Ret
    Opacity = 75
    SetLayeredWindowAttributes hWnd, 0, 255 * (Opacity / 100), LWA_ALPHA
End Sub
همچنین می توانید به فایل پیوستی Transparent Window.zip مراجعه کنید.


راه حل دوم :
بایستی به شفاف بودن دور فروم اکتفا کنید، راستش یادم نیست این کد رو از کجا داونلود کرده ام، به فایل پیوستی VB6 Glass.zip مراجعه کنید.

راه حل سوم :
یک فرم نیمه شفاف واقعی را زیر یک فرم معمول نشان دهید تا در ظاهر یک فرم ترکیبی بدون محدودیت داشته باشید.
کدی که از Planet-Source-Code.com دریافت کرده ام مثال خوبی است.
به فایل پیوستی Alpha Region.zip مراحعه کنید.

مجموعه کد های سه راه حل به همراه فایل اجرایی exe ضمیمه این پست می باشند.
 

پیوست ها

  • VB6 Glass.zip
    56.7 کیلوبایت · بازدیدها: 40
  • Alpha Region.zip
    571.9 کیلوبایت · بازدیدها: 57
  • Transparent Window.zip
    3.8 کیلوبایت · بازدیدها: 28
آخرین ویرایش:
Star-PCPack

Star-PCPack

Member
ج

the_king گفت:
پنجره های نیمه شفافی که در ویندوز های Vista و 7 نمایش داده می شوند با یک پنجره نیمه شفاف عادی قدری
متفاوت اند، چون هم میزان Opacity (شفافیت) شان توسط تنظیمات ویندوز قابل تنظیم است و هم تصویر پشت شان
را محو نشان می دهند (تصویر پشت شان را Blur می کنند). این قابلیت با فرم ها و کنترل های ویژوال بیسیک 6
جور در نمی آید، چون زمانی که ویژوال بیسیک طراحی شد، چنین قابلیتی هم وجود نداشت. شاید با استفاده از
یکسری توابع API عملی باشد، اما تا حال چنین کدی ندیده ام.

راهی وجود دارد که با یک سری کد نسبتا طولانی یک تصویر نیمه شفاف را که بعضی قسمت هایش کاملا شفاف و
بعضی قسمت هایش نیمه شفاف یا بدون شفافیت باشد را به عنوان بدنه فرم نمایش دهید، اما عیب بزرگ اش این
است که دیگر هیچ کنترل ای که روی فرم قرار داده باشید دیده نخواهد شد، و فقط همان تصویر مشاهده می شود.

اما شما می توانید به سادگی Opacity یک فرم استاندارد را کم کنید، مثلا 75 درصد :
کد: 
Option Explicit

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

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 crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Sub Form_Load()
    Dim Ret As Long, Opacity As Long
    Ret = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    SetWindowLong hWnd, GWL_EXSTYLE, Ret
    Opacity = 75
    SetLayeredWindowAttributes hWnd, 0, 255 * (Opacity / 100), LWA_ALPHA
End Sub
کلیک کنید تا باز شود...
ممنون از توضیحات خوبتون منم یه چیزی پیدا کردم ببینید با این میشه اینکاری رو که شما می گید انجام داد

---------------------------------------------------------------------------------------------------------------------------------
شفاف کردن فرم به صورت شیشه ای و مات

یک پروژه جدید باز کنید و تو قسمت جنرال فرمتون کدهای زیر رو کپی کنید :

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 crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Sub Command1_Click()

Dim Retval As Long

Retval = GetWindowLong(hWnd, -20)

Retval = Retval Or 524288

SetWindowLong hWnd, -20, Retval

SetLayeredWindowAttributes hWnd, 0, Val(Text1.Text), 2

End Sub

Private Sub Form_Load()

Text1.Text = 100

Command1_Click

End Sub

تو TextBox یک عدد از 0 تا 255 وارد کنید و کلید Command1 رو بزنید و شاهد شفاف شدن فرم باشید. فقط توجه داشته باشید که اگه از اعداد پایین مثل 1 استفاده کنید فرمتون تقریباً نامرئی میشه پس بهتون پیشنهاد میکنم تا حد امکان از اعداد بالای 50 استقاده کنید. موفق باشید.

نامرئی کردن قسمتهای اضافی فرم

این کد خیلی کاربردیه، حتماً به دردتون مبخوره. این کد باعث میشه که گوشه ها و قسمتهای اضافی فرم حذف بشه و فقط جاهایی که شما میخواید، قابل رویت باشه. مانند اسکین های Windows Media Player که بسیار زیباست.

یک پروژه جدید باز کنید و داخل فرمتون یک شئ Shape بذارید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

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.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Const LWA_COLORKEY = &H1

Const GWL_EXSTYLE = (-20)

Const WS_EX_LAYERED = &H80000

Const BM_SETSTATE = &HF3

Private Sub Form_Load()

Dim Ret As Long

Dim CLR As Long

Me.BackColor = RGB(1, 1, 1) '

CLR = Me.BackColor

Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)

Ret = Ret Or WS_EX_LAYERED

SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret

SetLayeredWindowAttributes Me.hWnd, CLR, 0, LWA_COLORKEY

End Sub
--------------------------------------------------------------------------------------
 
Star-PCPack

Star-PCPack

Member
دوست عزیز فایل پیوست vb6 glass خیلی با حاله ولی فقط تو ویندوز ویستا و سون ار می کنه
 
Star-PCPack

Star-PCPack

Member
ایول ممنون اینو می دونیستم که بهت گفتم ولی از همه بهتر اون دومی هستش باور نداری امتحان کن (اگه امتحان نکردی) با دومی اگه یک تصویر کار کنی که back اون transparent باشه و بجای اون فالی backgraund.png ذخیره کنی و فرم به اندازه تصویر بزرگ کنی خودش قسمت های نامرائی رو حذف می کنه و اگر هم شیشه ای کار کرده باشی شیشه ای نشون می ده مثل قسمت انتخاب ویندوز ویستا و سون خیلی توپه

در ضمن دومی امکانات سومی رو هم داره با قابلیت انتخاب میزان نامرئی بودن یا همون alpha و یا fade mode
 
آخرین ویرایش توسط مدیر:
R

reza0091

New Member
به نظر این کد ساده تر میاد!!!!

یک module ایجاد و کد زیر رو توش مینویسیم:


کد: 
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)
 
برای ارسال پاسخ شما باید وارد سیستم شوید.

آخرین مطالب مجیدآنلاین

جدیدترین ارسال ها

بالا