form1.frm

vb 窗体实例 都是自己的例子

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   1470
   ClientLeft      =   10245
   ClientTop       =   7275
   ClientWidth     =   1425
   LinkTopic       =   "Form1"
   ScaleHeight     =   1470
   ScaleWidth      =   1425
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   -105
      TabIndex        =   1
      Text            =   "0"
      Top             =   30
      Width           =   600
   End
   Begin VB.Timer Timer1 
      Interval        =   800
      Left            =   105
      Top             =   420
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   1305
      Left            =   -15
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   1245
      ScaleWidth      =   1305
      TabIndex        =   0
      Top             =   0
      Width           =   1365
   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
Const RGN_OR = 2
Dim I As Integer, j, myint, linex As Integer
Dim Fullr, myColor, crn As Long
Dim Region, PicWidth, PicHeight As Long
Dim mystart, mybool As Boolean
Private Sub Form_Load()
  Dim hDC As Long
  Me.Width = Picture1.Width    '设置窗体宽度等于图形宽度
  Me.Height = Picture1.Height    '设置窗体宽度等于图形宽度
  Picture1.ScaleMode = vbPixels    '设置Picture1度量单位为像素
  Picture1.AutoRedraw = True    '设置Picture1自动重绘有效
  Picture1.AutoSize = True    '设置Picture1自动调整大小
  Picture1.BorderStyle = vbBSNone   '设置Picture1的边框样式
  Me.BorderStyle = vbBSNone   '设置窗体的边框样式
  hDC = Picture1.hDC
  mystart = True
  mybool = False
  I = 0
  j = 0
  PicWidth = Picture1.ScaleWidth
  PicHeight = Picture1.ScaleHeight
  linex = 0
  myColor = GetPixel(hDC, 0, 0)    '获取picture1指定像素的rgb值
  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
                crn = CreateRectRgn(linex, j, I, j - 1)   '创建矩形区域
                If mystart Then
                   Fullr = crn
                   mystart = False
                  Else
                   CombineRgn Fullr, Fullr, crn, RGN_OR    '合并区域
                   DeleteObject CreateRectRgn(linex, j, I, j - 1)   '删除透明区域
                End If
             End If
            Else   '非透明像素
              If Not mybool Then
                 mybool = True
                 linex = I
              End If
          End If
          Next
        Next
  Region = Fullr
  SetWindowRgn Me.hWnd, Region, True  '设置窗体区域
  myint = 0
End Sub
Private Sub Timer1_Timer()  '形成动画
  Dim hDC As Long
  myint = myint + 1
  If myint = 1 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz3.bmp")
  If myint = 2 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz4.bmp")
  If myint = 3 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz5.bmp")
  If myint = 4 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz6.bmp")
  If myint = 5 Then myint = 0
  hDC = Picture1.hDC
  mystart = True
  mybool = False
  I = 0
  j = 0
  Me.Width = Picture1.Width
  Me.Height = Picture1.Height
  PicWidth = Picture1.ScaleWidth
  PicHeight = Picture1.ScaleHeight
  linex = 0
  myColor = GetPixel(hDC, 0, 0)   '获取picture1指定像素的rgb值
  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
                crn = CreateRectRgn(linex, j, I, j - 1)   '创建矩形区域
                If mystart Then
                   Fullr = crn
                   mystart = False
                  Else
                   CombineRgn Fullr, Fullr, crn, RGN_OR    '合并区域
                   DeleteObject CreateRectRgn(linex, j, I, j - 1)   '删除透明区域
                End If
             End If
            Else    '非透明像素
              If Not mybool Then
                 mybool = True
                 linex = I
              End If
          End If
          Next
        Next
  Region = Fullr
  SetWindowRgn Me.hWnd, Region, True   '设置窗体区域
End Sub
Private Sub Picture1_Click()
  End
End Sub