图像显示特效.frm

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

VERSION 5.00
Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
Begin VB.Form Form1 
   Caption         =   "图像显示特效实例"
   ClientHeight    =   6345
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8400
   LinkTopic       =   "Form1"
   ScaleHeight     =   6345
   ScaleWidth      =   8400
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command6 
      Caption         =   "涡旋式"
      Height          =   375
      Left            =   7020
      TabIndex        =   6
      Top             =   5760
      Width           =   1155
   End
   Begin PicClip.PictureClip PictureClip1 
      Left            =   6060
      Top             =   5040
      _ExtentX        =   556
      _ExtentY        =   767
      _Version        =   393216
   End
   Begin VB.CommandButton Command5 
      Caption         =   "马赛克"
      Height          =   375
      Left            =   5723
      TabIndex        =   5
      Top             =   5760
      Width           =   1155
   End
   Begin VB.CommandButton Command4 
      Caption         =   "水平百页窗"
      Height          =   375
      Left            =   4448
      TabIndex        =   4
      Top             =   5760
      Width           =   1155
   End
   Begin VB.CommandButton Command3 
      Caption         =   "中间->左右"
      Height          =   375
      Left            =   3083
      TabIndex        =   3
      Top             =   5760
      Width           =   1155
   End
   Begin VB.CommandButton Command2 
      Caption         =   "上->下"
      Height          =   375
      Left            =   1658
      TabIndex        =   2
      Top             =   5760
      Width           =   1155
   End
   Begin VB.CommandButton Command1 
      Caption         =   "左->右"
      Height          =   375
      Left            =   263
      TabIndex        =   1
      Top             =   5760
      Width           =   1155
   End
   Begin VB.PictureBox Picture1 
      Height          =   4215
      Left            =   1193
      ScaleHeight     =   4155
      ScaleWidth      =   5955
      TabIndex        =   0
      Top             =   660
      Width           =   6015
   End
   Begin VB.Image Image1 
      Height          =   4500
      Left            =   120
      Picture         =   "图像显示特效.frx":0000
      Top             =   5580
      Visible         =   0   'False
      Width           =   6000
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
    Dim i As Long
    
    Picture1.Cls
    PictureClip1.Cols = 100
    PictureClip1.Rows = 1
    For i = 0 To 99
        ys
        Picture1.PaintPicture PictureClip1.GraphicCell(i), Picture1.Width / 100 * i, 0
    Next
End Sub

Private Sub Command2_Click()
    Dim i As Long
    
    Picture1.Cls
    PictureClip1.Cols = 1
    PictureClip1.Rows = 100
    For i = 0 To 99
        ys
        Picture1.PaintPicture PictureClip1.GraphicCell(i), 0, Picture1.Height / 100 * i
    Next
End Sub

Private Sub Command3_Click()
    Dim i As Long
    
    Picture1.Cls
    PictureClip1.Cols = 100
    PictureClip1.Rows = 1
    For i = 0 To 49
        ys
        Picture1.PaintPicture PictureClip1.GraphicCell(i + 50), Picture1.Width / 100 * (i + 50), 0
        Picture1.PaintPicture PictureClip1.GraphicCell(49 - i), Picture1.Width / 100 * (49 - i), 0
    Next
End Sub

Private Sub Command4_Click()
    Dim i As Long, j As Long
    
    Picture1.Cls
    PictureClip1.Cols = 1
    PictureClip1.Rows = 100
    For i = 1 To 10
        
        For j = 1 To 10
            ys
            Picture1.PaintPicture PictureClip1.GraphicCell((j - 1) * 10 + i - 1), 0, Picture1.Height / 100 * ((j - 1) * 10 + i - 1)
        Next
    Next
End Sub

Private Sub Command5_Click()
    Dim Temp(99) As Long
    Dim j As Long
    Dim i As Long
    
    Picture1.Cls
    PictureClip1.Cols = 10
    PictureClip1.Rows = 10
    Temp(0) = Int(Rnd * 100)
    For i = 1 To 99
a0:     Temp(i) = Int(Rnd * 100)
        For j = 0 To i - 1
            If Temp(j) = Temp(i) Then GoTo a0
        Next
    Next
    For i = 0 To 99
        ys
        Picture1.PaintPicture PictureClip1.GraphicCell(Temp(i)), Picture1.Width / 10 * (Temp(i) Mod 10), Picture1.Height / 10 * (Temp(i) \ 10)
    Next
End Sub

Private Sub Command6_Click()
    
    Dim i As Integer
    Dim LeftTop As Long
    Dim RightTop As Long
    Dim BottomRight As Long
    Dim BottomLeft As Long
    Dim lefttopFlag As Boolean
    Dim righttopFlag As Boolean
    Dim bottomrightFlag As Boolean
    Dim bottomleftFlag As Boolean
    Dim IndexNum As Long
    
    LeftTop = 10
    RightTop = 9
    BottomRight = 99
    BottomLeft = 90
    IndexNum = 0
    lefttopFlag = True
    Picture1.Cls
    PictureClip1.Cols = 10
    PictureClip1.Rows = 10
    For i = 0 To 99
        ys
        Debug.Print IndexNum
        Picture1.PaintPicture PictureClip1.GraphicCell(IndexNum), Picture1.Width / 10 * (IndexNum Mod 10), Picture1.Height / 10 * (IndexNum \ 10)
        If lefttopFlag Then
            IndexNum = IndexNum + 1
        End If
        If righttopFlag Then
            IndexNum = IndexNum + 10
        End If
        If bottomrightFlag Then
            IndexNum = IndexNum - 1
        End If
        If bottomleftFlag Then
            IndexNum = IndexNum - 10
        End If
        If IndexNum = RightTop Then
            righttopFlag = True
            lefttopFlag = False
            bottomleftFlag = False
            bottomrightFlag = False
            RightTop = RightTop + 9
        End If
        If IndexNum = BottomRight Then
            bottomrightFlag = True
            lefttopFlag = False
            righttopFlag = False
            bottomleftFlag = False
            BottomRight = BottomRight - 11
        End If
        If IndexNum = BottomLeft Then
            bottomleftFlag = True
            lefttopFlag = False
            righttopFlag = False
            bottomrightFlag = False
            BottomLeft = BottomLeft - 9
        End If
        If IndexNum = LeftTop Then
            lefttopFlag = True
            righttopFlag = False
            bottomrightFlag = False
            bottomleftFlag = False
            LeftTop = LeftTop + 11
        End If
    Next
            
End Sub

Private Sub Form_Load()
    Randomize
    Picture1.Height = Image1.Height
    Picture1.Width = Image1.Width
    PictureClip1.Picture = Image1.Picture
End Sub
Private Sub ys()
    Dim k As Long
    Dim max As Long
    
    If Command4.Value Or Command5.Value Then
        max = 300000
    Else
        max = 600000
    End If
    For k = 0 To max
    Next
End Sub