form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   1620
   ClientLeft      =   4995
   ClientTop       =   1335
   ClientWidth     =   2880
   LinkTopic       =   "Form1"
   ScaleHeight     =   1620
   ScaleWidth      =   2880
   ShowInTaskbar   =   0   'False
   Begin VB.Timer Timer1 
      Interval        =   800
      Left            =   2190
      Top             =   630
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   1350
      Left            =   180
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   1290
      ScaleWidth      =   1770
      TabIndex        =   0
      Top             =   15
      Width           =   1830
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "下雨了！！！"
         Height          =   225
         Left            =   285
         TabIndex        =   1
         Top             =   270
         Width           =   1095
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, _
    ByVal Y As Long) As Long
    
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, _
    ByVal bRedraw As Boolean) 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _
    ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const RGN_OR = 2
Private Sub Form_Load()
  Picture1.ScaleMode = vbPixels          '设置度量单位为像素
  Picture1.AutoRedraw = True             '自动重绘
  Picture1.AutoSize = True
  Picture1.BorderStyle = vbBSNone
  Me.BorderStyle = vbBSNone
  Set Picture1.Picture = LoadPicture(App.Path & "\y4.bmp")
  Dim WindowRegion As Long
  WindowRegion = getpic(Picture1)
  SetWindowRgn Me.hWnd, WindowRegion, True
End Sub
Public Function getpic(pic As PictureBox) As Long
  Dim I As Long, j As Long, linex As Long
  Dim lineall, myline, mycolor As Long
  Dim mystart, mybool As Boolean
  Dim hDC As Long, PicWidth, PicHeight As Long
  hDC = pic.hDC
  mystart = True
  mybool = False
  I = 0
  j = 0
  PicWidth = pic.ScaleWidth
  PicHeight = pic.ScaleHeight
  linex = 0
  mycolor = GetPixel(hDC, 0, 0)
  For j = 0 To PicHeight - 1
    For I = 0 To PicWidth - 1
      If GetPixel(hDC, I, j) = mycolor Or I = PicWidth Then        ' 如果是透明像素
        If mybool Then
           mybool = False
           myline = CreateRectRgn(linex, j + 1, I, j)
           If mystart Then
              lineall = myline
              mystart = False
            Else
              CombineRgn lineall, lineall, myline, RGN_OR          '剪裁区域
           End If
        End If
       Else
        If Not mybool Then
           mybool = True
           linex = I + 2
        End If
      End If
      Next
    Next
  getpic = lineall
End Function

Private Sub Timer1_Timer()          ' 半透明动画
  Me.Top = Me.Top - 20
  Dim WindowRegion As Long
  Set Picture1.Picture = LoadPicture(App.Path & "\Y5.bmp")
  Label1.Caption = "太阳出来了！"
  WindowRegion = getpic(Picture1)
  SetWindowRgn Me.hWnd, WindowRegion, True
End Sub

Private Sub Picture1_Click()
  End
End Sub