无边框窗体(透明、半透明、特殊按钮、淡入淡出)

作者在 2007-08-27 07:15:00 发布以下内容

    这个程序演示了不规则窗体的建立(稍稍修改即可显示任意形状窗体),透明、半透明窗体,无边框窗体的移动(移动时窗体半透明)及窗体的淡入淡出。并演示了建立特殊按钮(以图片为按钮)。想自己做个漂亮窗体的朋友们可以下载下来参考参考。

 
'附:下面是Form文件全部的内容。

'Form代码开始

Option Explicit

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 Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Integer
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 TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private OldMode As Integer, MouseDown As Boolean, OldMode1 As Integer, MD0 As Boolean
'Private TFlag As Boolean

Private Sub CBExit_Click()
  Unload Me
End Sub

Private Sub CBOK_Click()
  Unload Me
End Sub

Private Sub CBExitI_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If MouseDown And Button <> 1 Then Exit Sub
  MackCBExit 3
End Sub

Private Sub CBExitI_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Button <> 1 Then MackCBExit 2
End Sub

Private Sub CBExitI_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  MackCBExit 0
  If Button = 1 And (Me.ScaleX(X, 1, 3) > 0 And Me.ScaleY(Y, 1, 3) > 0 And Me.ScaleX(X, 1, 3) < 69 And Me.ScaleY(Y, 1, 3) < 21) Then CBOK_Click
End Sub

Private Sub CBOKI_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If MouseDown And Bu

旧日志 | 阅读 2397 次
文章评论,共0条
游客请输入验证码
浏览13072次
文章归档