form1.frm

在一些多媒体教学软件中常常可以看到图像的显示特效

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "图片百叶窗效果"
   ClientHeight    =   4890
   ClientLeft      =   1605
   ClientTop       =   330
   ClientWidth     =   5970
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4890
   ScaleWidth      =   5970
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command4 
      Caption         =   "退出"
      Height          =   330
      Left            =   4950
      TabIndex        =   4
      Top             =   4560
      Width           =   1000
   End
   Begin VB.CommandButton Command2 
      Caption         =   "从左到右"
      Height          =   330
      Left            =   3900
      TabIndex        =   3
      Top             =   4560
      Width           =   1000
   End
   Begin VB.CommandButton Command1 
      Caption         =   "从上到下"
      Height          =   330
      Left            =   2850
      TabIndex        =   2
      Top             =   4560
      Width           =   1000
   End
   Begin VB.PictureBox Picture1 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   4470
      Left            =   -15
      ScaleHeight     =   298
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   400
      TabIndex        =   0
      Top             =   0
      Width           =   6000
   End
   Begin VB.PictureBox Picture2 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   3255
      Left            =   1455
      ScaleHeight     =   217
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   169
      TabIndex        =   1
      Top             =   0
      Width           =   2535
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim stepheight, i, j, countx, county As Long
Private Sub Form_Load()
  Picture1.Picture = LoadPicture(App.Path & "\QT221.jpg")
  Picture2.Width = Picture1.Width
  Picture2.Height = Picture1.Height
  countx = Picture1.ScaleHeight / 5
  county = Picture1.ScaleWidth / 5
  Picture2.Top = 20
  Picture2.Left = (Me.Width - Picture2.Width) / 2
End Sub

Private Sub Command1_Click()       '从上到下变换
  Picture1.Visible = False
  Set Picture2.Picture = Nothing
  For i = 0 To countx - 1 Step 3
      Picture2.PaintPicture Picture1.Picture, 0, i * 5, , , 0, i * 5, Picture2.Width, _
      5, vbSrcCopy
      DoEvents
      Sleep (10)
  Next i
  For i = 0 To countx - 1 Step 2
      Picture2.PaintPicture Picture1.Picture, 0, i * 5, , , 0, i * 5, Picture2.Width, _
      5, vbSrcCopy
      DoEvents
      Sleep (10)
  Next i
  For i = 0 To countx - 1 Step 1
      Picture2.PaintPicture Picture1.Picture, 0, i * 5, , , 0, i * 5, Picture2.Width, _
      5, vbSrcCopy
      DoEvents
      Sleep (10)
  Next i
End Sub

Private Sub Command2_Click()      '从左到右
  Picture1.Visible = False
  Set Picture2.Picture = Nothing
  For i = 0 To county - 1 Step 4
      Picture2.PaintPicture Picture1.Picture, i * 5, 0, , , i * 5, 0, 5, Picture2.Height, vbSrcCopy
      DoEvents
      Sleep (10)
  Next i
  For i = 0 To county - 1 Step 3
      Picture2.PaintPicture Picture1.Picture, i * 5, 0, , , i * 5, 0, 5, Picture2.Height, vbSrcCopy
      DoEvents
      Sleep (10)
  Next i
  For i = 0 To county - 1 Step 2
      Picture2.PaintPicture Picture1.Picture, i * 5, 0, , , i * 5, 0, 5, Picture2.Height, vbSrcCopy
      DoEvents
      Sleep (10)
  Next i
  For i = 0 To county - 1 Step 1
      Picture2.PaintPicture Picture1.Picture, i * 5, 0, , , i * 5, 0, 5, Picture2.Height, vbSrcCopy
      DoEvents
      Sleep (10)
  Next i
End Sub
Private Sub Command4_Click()
  End
End Sub