form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   1740
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3045
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1740
   ScaleWidth      =   3045
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1725
      Left            =   0
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   115
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   203
      TabIndex        =   0
      Top             =   -15
      Width           =   3045
      Begin VB.Timer Timer1 
         Interval        =   30
         Left            =   330
         Top             =   900
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "www.mingrisoft.com"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF8080&
         Height          =   435
         Left            =   180
         TabIndex        =   1
         Top             =   660
         Width           =   2295
      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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, _
    ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, _
    ByVal X As Long, ByVal Y 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 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 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 Const WM_NCLBUTTONDOWN = &HA1
Private Const RGN_OR = 2
Private Const HTCAPTION = 2
Dim i As Integer
Private Sub Form_Load()     '系统初始化
  Dim X, Y, picbegin, x1, y1, color As Long
  Dim PicWidth, hDC, PicHeight As Long
  Dim picstart, picline As Boolean
  hDC = Picture1.hDC
  PicWidth = Picture1.ScaleWidth
  PicHeight = Picture1.ScaleHeight
  picstart = True
  picline = False
  i = 0
  Me.Width = Picture1.Width
  Me.Height = Picture1.Height
  X = 0
  Y = 0
  picbegin = 0
  color = GetPixel(hDC, 0, 0)
  For X = 0 To PicWidth - 1
       For Y = 0 To PicHeight - 1
       If GetPixel(hDC, X, Y) = color Or Y = PicHeight Then      '像素透明
           If picline Then
              x1 = CreateRectRgn(X, picbegin, X + 1, Y)          '获取区域值
              picline = False
                 If picstart Then
                    y1 = x1
                    picstart = False
                 Else
                    CombineRgn y1, y1, x1, RGN_OR                '刷新
                    DeleteObject x1
                 End If
           End If
        Else
           If Not picline Then
              picline = True
              picbegin = Y
           End If
       End If
       Next Y
  Next X
  SetWindowRgn Me.hWnd, y1, True
End Sub

Private Sub Timer1_Timer()    '半透明动画
  i = i + 1
  Select Case i
    Case 1
       Me.Left = Me.Left
       Me.Top = Me.Top + 80
    Case 3
       Me.Left = Me.Left + 40
       Me.Top = Me.Top + 80
       Picture1.Picture = LoadPicture(App.Path + "\fis1.bmp")
    Case 5
       Me.Left = Me.Left
       Me.Top = Me.Top - 80
    Case 7
       Me.Left = Me.Left + 40
       Me.Top = Me.Top - 80
       Picture1.Picture = LoadPicture(App.Path + "\fis2.bmp")
 End Select
 If i = 8 Then
    i = 0
 End If
End Sub

Private Sub Picture1_Click()
  End
End Sub