8-3.frm

vb6.0编程实例详解,很详细的介绍,对学习VB有帮助

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "图片特技"
   ClientHeight    =   3915
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7425
   LinkTopic       =   "Form1"
   ScaleHeight     =   261
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   495
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   495
      Left            =   5160
      TabIndex        =   4
      Top             =   3240
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "马赛克"
      Height          =   495
      Index           =   3
      Left            =   5160
      TabIndex        =   3
      Top             =   2400
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "百叶窗"
      Height          =   495
      Index           =   2
      Left            =   5160
      TabIndex        =   2
      Top             =   1680
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "进入"
      Height          =   495
      Index           =   1
      Left            =   5160
      TabIndex        =   1
      Top             =   960
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "切换"
      Height          =   495
      Index           =   0
      Left            =   5160
      TabIndex        =   0
      Top             =   240
      Width           =   2055
   End
   Begin VB.PictureBox Picture1 
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   120
      ScaleHeight     =   33
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   81
      TabIndex        =   5
      Top             =   120
      Width           =   1215
   End
   Begin VB.Image Image1 
      Height          =   735
      Index           =   1
      Left            =   2400
      Top             =   240
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Image Image1 
      Height          =   735
      Index           =   0
      Left            =   3600
      Top             =   240
      Visible         =   0   'False
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ImageIndex As Long '图像索引号
Dim PicWidth As Long '图像宽度
Dim PicHeight As Long '图像高度


Private Sub Command1_Click(Index As Integer)
    Dim i As Integer
    Dim j As Integer
    Dim OneBlock As Integer
    Dim A(6400) As Integer
    Dim MaxBlock As Integer '最大分块数
    Dim OneWidth As Integer '各块宽度
    Dim OneHeight As Integer
    Dim Random As Integer
    Dim Block As Integer
    
    '更新图像索引
    ImageIndex = (ImageIndex + 1) Mod 2
    
    '禁止特技按钮
    For i = 0 To Command1.Count - 1
        Command1(i).Enabled = False
    Next i
    
    Select Case Index
        Case 0
            '绘制全部图像
            Picture1.PaintPicture Image1(ImageIndex), 0, 0
        Case 1
            For i = -PicWidth To 0
                Picture1.PaintPicture Image1(ImageIndex), i, i / PicWidth * PicHeight
                DoEvents
            Next i
        Case 2
            Block = 20 '百叶窗数
            OneBlock = PicWidth / Block '各块最大宽度
            For i = 1 To OneBlock
            '百叶窗打开过程循环
                For j = 0 To Block - 1
                '绘制各百叶窗
                    Picture1.PaintPicture Image1(ImageIndex), j * OneBlock, 0, i, PicHeight, _
                                            j * OneBlock, 0, i, PicHeight
                Next j
            Next i
        Case 3
        '马赛克效果。
        '本程序使用的算法可以保证有限次循环实现图像切换
            Block = 80
            OneWidth = PicWidth / Block
            OneHeight = PicHeight / Block
            MaxBlock = Block * Block - 1
            '为数组赋值
            For i = 0 To MaxBlock
                A(i) = i
            Next i
            '循环 MaxBlock 次，实现图像切换
            For i = 0 To Block * Block - 1
                Random = Rnd(1) * MaxBlock '获得 0 到 MaxBlock 之间的随机数
                '绘制指定块
                Picture1.PaintPicture Image1(ImageIndex), (A(Random) \ Block) * OneWidth, (A(Random) Mod Block) * OneHeight, OneWidth, OneHeight, _
                                        (A(Random) \ Block) * OneWidth, (A(Random) Mod Block) * OneHeight, OneWidth, OneHeight
                '与数组最后项交换
                '该语句可保证数组A(0)-A(MaxBlock)为未绘图像块
                A(Random) = A(MaxBlock)
                MaxBlock = MaxBlock - 1
            Next i
    End Select
    
    '恢复特技按钮
    For i = 0 To Command1.Count - 1
        Command1(i).Enabled = True
    Next i
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    PicWidth = 320
    PicHeight = 240
    Picture1.Width = PicWidth
    Picture1.Height = PicHeight
    '装载图片
    Image1(0).Picture = LoadPicture(App.Path + "\Pic1.gif")
    Image1(1).Picture = LoadPicture(App.Path + "\Pic2.gif")
End Sub

Private Sub Picture1_Paint()
    Command1_Click (0)
End Sub