半透明窗体1.frm

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   6090
   ClientLeft      =   3240
   ClientTop       =   2295
   ClientWidth     =   6345
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "半透明窗体1.frx":0000
   ScaleHeight     =   6090
   ScaleWidth      =   6345
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) 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 crkey As Long, 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
Private Const LWA_COLORKEY = &H1
Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type
Private Sub Form_Load()
    Dim Rtn As Long
    Dim Bm As BITMAP
    Dim Wid As Long, hgt As Long
    
    If Me.Picture <> 0 Then
        GetObject Form1.Picture, Len(Bm), Bm
        Wid = Bm.bmWidth
        hgt = Bm.bmHeight
        Form1.Height = hgt * Screen.TwipsPerPixelY
        Form1.Width = hgt * Screen.TwipsPerPixelX
    End If
    Rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
    Rtn = Rtn Or WS_EX_LAYERED
    SetWindowLong hwnd, GWL_EXSTYLE, Rtn
    SetLayeredWindowAttributes Me.hwnd, 0, 100, LWA_ALPHA   '为WIN2K新增的API
End Sub