图像.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "图象多媒体演示程序"
   ClientHeight    =   8625
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   6810
   LinkTopic       =   "Form1"
   ScaleHeight     =   4940.551
   ScaleMode       =   0  'User
   ScaleWidth      =   3588.933
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox imgSrc 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   8670
      Left            =   240
      Picture         =   "图像.frx":0000
      ScaleHeight     =   8670
      ScaleWidth      =   6225
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   6225
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu mnuEffectSelect 
      Caption         =   "效果选择"
      Begin VB.Menu mnuEffects 
         Caption         =   "Wipe Down（从上往下滑入）"
         Checked         =   -1  'True
         Index           =   0
      End
      Begin VB.Menu mnuEffects 
         Caption         =   "Wipe Right（从左往右滑入）"
         Index           =   1
      End
      Begin VB.Menu mnuEffects 
         Caption         =   "Push Down（从上往下推入）"
         Index           =   2
      End
      Begin VB.Menu mnuEffects 
         Caption         =   "Push Down（从左往右推入）"
         Index           =   3
      End
      Begin VB.Menu mnuEffects 
         Caption         =   "Door Close（关门）"
         Index           =   4
      End
      Begin VB.Menu mnuEffects 
         Caption         =   "Book Open（打开书本）"
         Index           =   5
      End
      Begin VB.Menu mnuEffects 
         Caption         =   "Mirror（镜像）"
         Index           =   6
      End
      Begin VB.Menu mnuEffects 
         Caption         =   "Column（垂直百叶窗方式 ）"
         Index           =   7
      End
      Begin VB.Menu mnuEffects 
         Caption         =   "Column（水平百叶窗方式 ）"
         Index           =   8
      End
   End
   Begin VB.Menu mnuShow 
      Caption         =   "效果演示"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public NowEffect As Integer     '要显示的效果
' ADDPIXONCE最小值为8,应设置为8的倍数
' 其值约大,显示的速度约快,时间约短
Private Const ADDPIXONCE As Integer = 8

Private Sub Form_Load()
    NowEffect = 0
    ' 请在这里按代码加入你要显示的图片
    ' 建议图片大小800×600左右
    ' 如果仅仅观看显示效果，建议使用原来的图片
    imgSrc.Picture = LoadPicture(App.Path + "/mypic.bmp")
End Sub

Private Sub mnuFileExit_Click()
    End
End Sub

Private Sub mnuShow_Click()
    Me.Picture = LoadPicture()
    Me.Cls
' 由NowEffect选择应有的功能函数
' 0为Wipe Down（从上往下滑入）
' 1为Wipe Right（从左往右滑入）
' 2为Push Down（从上往下推入）
' 3为Push Right（从左往右推入）
' 4为Door Close（关门）
' 5为Book Open（打开书本）
' 6为Mirror（镜像）
' 7为Column（水平百叶窗方式）
' 8为Row（垂直百叶窗方式  ）
    Select Case NowEffect
        Case 0
            WipeDown
        Case 1
            WipeRight
        Case 2
            PushDown
        Case 3
            PushRight
        Case 4
            DoorClose
        Case 5
            BookOpen
        Case 6
            Mirror
        Case 7
            Column
        Case 8
            Row
    End Select
End Sub

' 通过菜单选择图形显示的效果
' 0为Wipe Down（从上往下滑入）
' 1为Wipe Right（从左往右滑入）
' 2为Push Down（从上往下推入）
' 3为Push Right（从左往右推入）
' 4为Door Close（关门）
' 5为Book Open（打开书本）
' 6为Mirror（镜像）
' 7为Column（水平百叶窗方式）
' 8为Row（垂直百叶窗方式  ）
Private Sub mnuEffects_Click(Index As Integer)
    Dim i As Integer
    For i = 0 To 8
        mnuEffects(i).Checked = False
    Next i
    mnuEffects(Index).Checked = True
    NowEffect = Index
End Sub

' Wipe Down（从上往下滑入）
Public Sub WipeDown()
    Dim Total As Integer
    Total = 0
    Do While Total < imgSrc.Height - ADDPIXONCE
        Me.PaintPicture imgSrc, 0, Total, Me.ScaleWidth, ADDPIXONCE, _
                        0, Total, imgSrc.Width, ADDPIXONCE, vbSrcCopy
        Total = Total + ADDPIXONCE
    Loop
End Sub

' Wipe Right（从左往右滑入）
Public Sub WipeRight()
    Dim Total As Integer
    Total = 0
    Do While Total < imgSrc.Width - ADDPIXONCE
        Me.PaintPicture imgSrc, Total, 0, ADDPIXONCE, Me.ScaleHeight, _
                        Total, 0, ADDPIXONCE, imgSrc.Height, vbSrcCopy
        Total = Total + ADDPIXONCE
    Loop
End Sub

' Push Down（从上往下推入）
Public Sub PushDown()
    Dim Total As Integer
    Total = 8
    Do While Total < imgSrc.Height - ADDPIXONCE
        Me.PaintPicture imgSrc, 0, 0, Me.ScaleWidth, Total, _
                        0, imgSrc.Height - Total, imgSrc.Width, Total, vbSrcCopy
        Total = Total + ADDPIXONCE
    Loop
End Sub

' Push Right（从左往右推入）
Public Sub PushRight()
    Dim Total As Integer
    Total = 8
    Do While Total < imgSrc.Width - ADDPIXONCE
        Me.PaintPicture imgSrc, 0, 0, Total, Me.ScaleHeight, _
                        imgSrc.Width - Total, 0, Total, imgSrc.Height, vbSrcCopy
        Total = Total + ADDPIXONCE
    Loop
End Sub

' Door Close（关门）
Public Sub DoorClose()
    Dim Total As Integer
    Total = 0
    Do While Total < imgSrc.Width / 2 - ADDPIXONCE
        Me.PaintPicture imgSrc, Total, 0, ADDPIXONCE, Me.ScaleHeight, _
                        Total, 0, ADDPIXONCE, imgSrc.Height, vbSrcCopy
        Me.PaintPicture imgSrc, Me.ScaleWidth - Total, 0, ADDPIXONCE, Me.ScaleHeight, _
                        imgSrc.Width - Total - ADDPIXONCE, 0, ADDPIXONCE, imgSrc.Height, vbSrcCopy
        Total = Total + ADDPIXONCE
    Loop
End Sub
' Mirror（镜像）
Public Sub Mirror()
    Dim Total As Integer
    Total = 0
    Do While Total < imgSrc.Width - ADDPIXONCE
        Me.PaintPicture imgSrc, Me.ScaleWidth - Total, 0, ADDPIXONCE, Me.ScaleHeight, _
                        Total, 0, ADDPIXONCE, imgSrc.Height, vbSrcCopy
        Total = Total + ADDPIXONCE
    Loop
End Sub

' Book Open（打开书本）
Public Sub BookOpen()
    Dim Total As Integer
    Total = 0
    Do While Total < imgSrc.Width / 2 - ADDPIXONCE
        Me.PaintPicture imgSrc, Me.ScaleWidth / 2 - Total, 0, ADDPIXONCE, Me.ScaleHeight, _
                        imgSrc.Width / 2 - Total, 0, ADDPIXONCE, imgSrc.Height, vbSrcCopy
        Me.PaintPicture imgSrc, Me.ScaleWidth / 2 + Total, 0, ADDPIXONCE, Me.ScaleHeight, _
                        imgSrc.Width / 2 + Total, 0, ADDPIXONCE, imgSrc.Height, vbSrcCopy
        Total = Total + ADDPIXONCE
    Loop
End Sub

Public Sub Column()  ' 垂直百叶窗方式
    ' 20列
    Const ColNumber = 20
    Dim ColNum As Integer
    Dim i As Integer
    Dim Total As Integer
    ColNum = Val(InputBox("请输入列数（1-99）"))
    If ColNum = 0 Then
        ColNum = ColNumber
    End If
    Total = 0
    Do While Total < imgSrc.Width / ColNum - ADDPIXONCE
        For i = 0 To ColNum - 1
            Me.PaintPicture imgSrc, (imgSrc.Width / ColNum) * i + Total, 0, ADDPIXONCE, Me.ScaleHeight, _
                            (imgSrc.Width / ColNum) * i + Total, 0, ADDPIXONCE, imgSrc.Height, vbSrcCopy
        Next i
        Total = Total + ADDPIXONCE
    Loop
End Sub

Public Sub Row()  ' 水平百叶窗方式
    ' 50行
    Const RowNumber = 50
    Dim RowNum As Integer
    Dim i As Integer
    Dim Total As Integer
    RowNum = Val(InputBox("请输入行数（1-99）"))
    If RowNum = 0 Then
        RowNum = RowNumber
    End If
    Total = 0
    Do While Total < imgSrc.Height / RowNum - ADDPIXONCE
        For i = 0 To RowNum - 1
            Me.PaintPicture imgSrc, 0, (imgSrc.Height / RowNum) * i + Total, Me.ScaleWidth, ADDPIXONCE, _
                             0, (imgSrc.Height / RowNum) * i + Total, imgSrc.ScaleWidth, ADDPIXONCE, vbSrcCopy
        Next i
        Total = Total + ADDPIXONCE
    Loop
End Sub