飘云阁

 找回密码
 加入我们

QQ登录

只需一步,快速开始

查看: 2039|回复: 1

几款VB美化代码

[复制链接]

该用户从未签到

发表于 2008-3-9 02:18:57 | 显示全部楼层 |阅读模式
窗体半透明效果
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 Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1

Private Sub Command1_Click()
  Dim rtn As Long
  rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
  rtn = rtn Or WS_EX_LAYERED
  SetWindowLong hwnd, GWL_EXSTYLE, rtn
  SetLayeredWindowAttributes hwnd, 0, 200, LWA_ALPHA
End Sub
二。窗体靠边自动隐藏
Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type

Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40


Private Sub Form_Load()
'窗体放在最前面
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub

Private Sub Timer1_Timer()
Dim p As POINTAPI
Dim f As RECT
GetCursorPos p '得到MOUSE位置
GetWindowRect Me.hwnd, f '得到窗体的位置
If Me.WindowState <> 1 Then
If p.X > f.Left And p.X < f.Right And p.Y > f.Top And p.Y < f.Bottom Then
'MOUSE 在窗体上
If Me.Top < 0 Then
Me.Top = -10
Me.Show
ElseIf Me.Left < 0 Then
Me.Left = -10
Me.Show
ElseIf Me.Left + Me.Width >= Screen.Width Then
Me.Left = Screen.Width - Me.Width + 10
Me.Show
End If

Else
If f.Top <= 4 Then
Me.Top = 40 - Me.Height
ElseIf f.Left <= 4 Then
Me.Left = 40 - Me.Width
ElseIf Me.Left + Me.Width >= Screen.Width - 4 Then
Me.Left = Screen.Width - 40
End If
End If
End If

End Sub
PYG19周年生日快乐!

该用户从未签到

发表于 2008-4-2 14:10:00 | 显示全部楼层
/:013 谢谢
PYG19周年生日快乐!
您需要登录后才可以回帖 登录 | 加入我们

本版积分规则

快速回复 返回顶部 返回列表