冒泡法排序动画.frm

用vb制作的冒泡法动画演示过程

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "冒泡动画"
   ClientHeight    =   7620
   ClientLeft      =   2280
   ClientTop       =   2160
   ClientWidth     =   8340
   LinkTopic       =   "Form1"
   ScaleHeight     =   7620
   ScaleWidth      =   8340
   Begin VB.CommandButton Command4 
      Caption         =   "抓图"
      Height          =   495
      Left            =   6840
      TabIndex        =   7
      Top             =   1320
      Width           =   1215
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   7200
      Top             =   600
   End
   Begin VB.CommandButton Command2 
      Caption         =   "生成数组"
      Height          =   495
      Left            =   6960
      TabIndex        =   6
      Top             =   2160
      Width           =   1215
   End
   Begin VB.CommandButton Command6 
      Caption         =   "退出"
      Height          =   495
      Left            =   6960
      TabIndex        =   5
      Top             =   5880
      Width           =   1215
   End
   Begin VB.CommandButton Command5 
      Caption         =   "动画演示"
      Height          =   495
      Left            =   6960
      TabIndex        =   4
      Top             =   3960
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "清除数组"
      Height          =   495
      Left            =   6960
      TabIndex        =   2
      Top             =   4920
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "生成图形"
      Height          =   495
      Left            =   6960
      TabIndex        =   1
      Top             =   3120
      Width           =   1215
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   5535
      Left            =   240
      ScaleHeight     =   96.573
      ScaleMode       =   6  'Millimeter
      ScaleWidth      =   113.506
      TabIndex        =   0
      Top             =   1080
      Width           =   6495
   End
   Begin VB.Label L1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   495
      Left            =   1080
      TabIndex        =   3
      Top             =   360
      Width           =   4695
   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 a(1 To 6) As Integer
Dim b(1 To 6, 1 To 4)
Dim Pause As Boolean
Dim i, j, temp As Integer


Private Sub Command1_Click()
Call DrawLine '画水平线
'Picture1.FillStyle = 1
Dim i As Integer
Dim x0, y0, D As Integer
x0 = 15: y0 = 85: D = 5
Dim x1, y1, x2, y2 As Integer
'Picture1.FillStyle = 7
'将数据在图形框中以矩形画出来
x1 = x0
For i = 1 To 6
   Picture1.ForeColor = QBColor(i)
   
   x1 = x1 + 2 * D: b(i, 1) = x1
   y1 = y0: b(i, 2) = y1
   x2 = x1 + 5: b(i, 3) = x2
   y2 = y0 - a(i) * 8: b(i, 4) = y2
   
   
   Picture1.Line (x1, y1)-(x2, y2), , BF
   Picture1.CurrentX = x1 + 3
   Picture1.CurrentY = y1 + 5
   Picture1.Print a(i)
Next i



End Sub

Private Sub Command2_Click()
Dim i, j As Integer
Dim temp As Integer
'生成数组
L1.Caption = ""
For i = 1 To 6
  temp = Int(Rnd * 10) + 1
  '如果有重复数据则重新生成
  For j = i - 1 To 1 Step -1
   If a(j) = temp Then
      temp = Int(Rnd * 10) + 1
  End If
  Next j
  a(i) = temp
  L1.Caption = L1.Caption & "  " & a(i)
Next i
End Sub

Private Sub Command3_Click()
Dim i As Integer
'清空数组
For i = 1 To 6
  a(i) = 0
  Picture1.Cls
Next i
Call DrawLine
End Sub

Private Sub Command4_Click()
SavePicture Picture1.Image, "d:\bb.jpg"


End Sub

Private Sub Command5_Click()
Dim i, j, temp As Integer
Pause = False
For i = 1 To 5
   For j = 1 To 6 - i
      '设置闪烁效果
      delay (0.5)
      Picture1.ForeColor = vbRed
        Picture1.Line (b(j, 1), b(j, 2))-(b(j, 3), b(j, 4)), , BF
        Picture1.Line (b(j + 1, 1), b(j + 1, 2))-(b(j + 1, 3), b(j + 1, 4)), , BF
      delay (0.5)
        Picture1.ForeColor = QBColor(j + 1)
        Picture1.Line (b(j + 1, 1), b(j + 1, 2))-(b(j + 1, 3), b(j + 1, 4)), , BF
        Picture1.ForeColor = QBColor(j)
        Picture1.Line (b(j, 1), b(j, 2))-(b(j, 3), b(j, 4)), , BF
     
      If a(j) > a(j + 1) Then
        
        '交换元素内容
        temp = a(j): a(j) = a(j + 1): a(j + 1) = temp
           
      delay (1)
        '在原有位置先擦除矩形,采用擦除法动画原理
        Picture1.ForeColor = &H8000000F
        Picture1.Line (b(j, 1), b(j, 2))-(b(j, 3), b(j, 4)), , BF
        Picture1.Line (b(j + 1, 1), b(j + 1, 2))-(b(j + 1, 3), b(j + 1, 4)), , BF
        
        '交换元素的第二个y坐标
        temp = b(j + 1, 4): b(j + 1, 4) = b(j, 4): b(j, 4) = temp
        '将两个矩形交换
        Picture1.ForeColor = QBColor(j)
        Picture1.Line (b(j + 1, 1), b(j + 1, 2))-(b(j + 1, 3), b(j + 1, 4)), , BF
        Picture1.ForeColor = QBColor(j + 1)
        Picture1.Line (b(j, 1), b(j, 2))-(b(j, 3), b(j, 4)), , BF
      End If
   Next j
Next i
End Sub

Private Sub Command6_Click()
End
End Sub