⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 animation.frm

📁 动态图形的实现
💻 FRM
字号:
VERSION 4.00
Begin VB.Form frmAnimation 
   BackColor       =   &H00FFFFFF&
   Caption         =   "Animation Demo"
   ClientHeight    =   3885
   ClientLeft      =   1530
   ClientTop       =   1545
   ClientWidth     =   9135
   Height          =   4290
   Icon            =   "Animation.frx":0000
   Left            =   1470
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   3885
   ScaleWidth      =   9135
   Top             =   1200
   Width           =   9255
   Begin VB.Timer Timer2 
      Interval        =   400
      Left            =   3960
      Top             =   1080
   End
   Begin VB.PictureBox picAnimate 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   900
      Left            =   2160
      Picture         =   "Animation.frx":0442
      ScaleHeight     =   900
      ScaleWidth      =   2100
      TabIndex        =   2
      Top             =   120
      Width           =   2100
   End
   Begin VB.Frame fraSpeed 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Speed"
      Height          =   615
      Left            =   2760
      TabIndex        =   0
      Top             =   2280
      Width           =   3855
      Begin VB.HScrollBar hsbSpeed 
         Height          =   255
         LargeChange     =   50
         Left            =   120
         Max             =   300
         Min             =   1
         SmallChange     =   10
         TabIndex        =   1
         Top             =   240
         Value           =   75
         Width           =   3615
      End
   End
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   2280
      Top             =   1080
   End
   Begin VB.Label lblWebPage 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      Caption         =   "http://www.geocities.com/area51/8315/"
      BeginProperty Font 
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   700
         size            =   8.25
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   2760
      MouseIcon       =   "Animation.frx":2954
      MousePointer    =   99  'Custom
      TabIndex        =   6
      Top             =   3240
      Width           =   3855
   End
   Begin VB.Label lblEmail 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      Caption         =   "donopark@awinc.com"
      BeginProperty Font 
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   700
         size            =   8.25
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   2760
      MouseIcon       =   "Animation.frx":2C5E
      MousePointer    =   99  'Custom
      TabIndex        =   5
      Top             =   3000
      Width           =   3855
   End
   Begin VB.Image imgSmile 
      Height          =   480
      Index           =   2
      Left            =   6240
      Picture         =   "Animation.frx":2F68
      Top             =   1320
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgSmile 
      Height          =   480
      Index           =   1
      Left            =   5640
      Picture         =   "Animation.frx":33AA
      Top             =   1320
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgSmile 
      Height          =   480
      Index           =   0
      Left            =   5040
      Picture         =   "Animation.frx":37EC
      Top             =   1320
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "Form Icon"
      Height          =   195
      Left            =   3960
      TabIndex        =   4
      Top             =   1560
      Visible         =   0   'False
      Width           =   705
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Form"
      Height          =   195
      Left            =   2280
      TabIndex        =   3
      Top             =   1560
      Visible         =   0   'False
      Width           =   345
   End
   Begin VB.Image imgLeopard 
      Height          =   900
      Index           =   7
      Left            =   0
      Picture         =   "Animation.frx":3C2E
      Top             =   2760
      Visible         =   0   'False
      Width           =   2100
   End
   Begin VB.Image imgLeopard 
      Height          =   900
      Index           =   6
      Left            =   0
      Picture         =   "Animation.frx":6140
      Top             =   2400
      Visible         =   0   'False
      Width           =   2100
   End
   Begin VB.Image imgLeopard 
      Height          =   900
      Index           =   5
      Left            =   0
      Picture         =   "Animation.frx":8652
      Top             =   1920
      Visible         =   0   'False
      Width           =   2100
   End
   Begin VB.Image imgLeopard 
      Height          =   900
      Index           =   4
      Left            =   0
      Picture         =   "Animation.frx":AB64
      Top             =   1560
      Visible         =   0   'False
      Width           =   2100
   End
   Begin VB.Image imgLeopard 
      Height          =   900
      Index           =   3
      Left            =   0
      Picture         =   "Animation.frx":D076
      Top             =   1200
      Visible         =   0   'False
      Width           =   2100
   End
   Begin VB.Image imgLeopard 
      Height          =   900
      Index           =   2
      Left            =   0
      Picture         =   "Animation.frx":F588
      Top             =   840
      Visible         =   0   'False
      Width           =   2100
   End
   Begin VB.Image imgLeopard 
      Height          =   900
      Index           =   1
      Left            =   0
      Picture         =   "Animation.frx":11A9A
      Top             =   480
      Visible         =   0   'False
      Width           =   2100
   End
   Begin VB.Image imgLeopard 
      Height          =   900
      Index           =   0
      Left            =   0
      Picture         =   "Animation.frx":13FAC
      Top             =   120
      Visible         =   0   'False
      Width           =   2100
   End
End
Attribute VB_Name = "frmAnimation"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit


Private Sub Form_Activate()



    'positions speed control
    fraSpeed.Left = (ScaleWidth - fraSpeed.Width) / 2
    fraSpeed.Top = (ScaleHeight - fraSpeed.Height) / 2
    
    lblEmail.Left = fraSpeed.Left
    lblEmail.Top = fraSpeed.Top + 700
    
    lblWebPage.Left = fraSpeed.Left
    lblWebPage.Top = fraSpeed.Top + 900

End Sub

Private Sub Form_Load()

'**Animation Example by Donovan Parks
'**donopark@awinc.com

    'positions animation image
    picAnimate.Left = 0 - picAnimate.Width
    picAnimate.Top = 500

End Sub


Private Sub Form_Resize()

    'positions speed control
    fraSpeed.Left = (ScaleWidth - fraSpeed.Width) / 2
    fraSpeed.Top = (ScaleHeight - fraSpeed.Height) / 2
    
    lblEmail.Left = fraSpeed.Left
    lblEmail.Top = fraSpeed.Top + 700
    
    lblWebPage.Left = fraSpeed.Left
    lblWebPage.Top = fraSpeed.Top + 900
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    'this API call tells windows to clear all windows - it is like sending a CLS command to every object
    Call InvalidateRect(0, 0, 0)
    
End Sub

Private Sub hsbSpeed_Change()

    'assigns the value of the scroll bar to the timers
    'interval propertie
    Timer1.Interval = hsbSpeed.Value
    Timer2.Interval = hsbSpeed.Value

End Sub

Private Sub hsbSpeed_Scroll()

    'assigns the value of the scroll bar to the timers
    'interval propertie
    Timer1.Interval = hsbSpeed.Value
    Timer2.Interval = hsbSpeed.Value
    
End Sub



Private Sub lblEmail_Click()

'uses Win API to call web browser
Dim iret As Long

    'opens email program
    iret = ShellExecute(Me.hwnd, vbNullString, "mailto: donopark@awinc.com", vbNullString, "c:\", 1)

End Sub

Private Sub lblWebPage_Click()

'uses Win API to call web browser
Dim iret As Long

    'opens web browser
    iret = ShellExecute(Me.hwnd, vbNullString, "http://www.geocities.com/area51/8315/", vbNullString, "c:\", 1)

End Sub

Private Sub Timer1_Timer()

'Static variables keep there value with each procedure call
Static currentpic As Integer
    
    'Determines if the animation is at the last picture and starts
    'at the beginning if so
    If currentpic = 7 Then currentpic = -1
    
    'moves to the next picture
    currentpic = currentpic + 1
    
    'moves the picture to the left
    picAnimate.Left = picAnimate.Left + 400
    
    'determines if image is off screen
    '-3600's causes a slight delay in the animation coming back around
    If (picAnimate.Left) > ScaleWidth Then picAnimate.Left = -3600

    'changes the image to the new image
    picAnimate.Picture = imgLeopard(currentpic).Picture
    
End Sub





Private Sub Timer2_Timer()
    
        'keeps value with each call
        Static x As Integer
        
        'keeps x in picture range
        If x = 2 Then x = -1
        
      
        'moves to next picture
        x = x + 1
        
        'displays next picture
        frmAnimation.Icon = imgSmile(x).Picture

End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -