frmanimaker.frm

大量优秀的vb编程

      Width           =   975
   End
   Begin VB.Label lbsprite 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      Height          =   255
      Left            =   8280
      TabIndex        =   18
      Top             =   6240
      Width           =   615
   End
End
Attribute VB_Name = "frmAnimaker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub btnAdd_Click()
Dim a As Integer
Dim c As Integer
    If lstAni.ListIndex <> -1 Then
        c = lstAni.ListIndex
        a = ani(c).spritecount
        If a < NUMBER_OF_SPRITES_IN_ANIMATION Then
            ani(c).spritelst(a) = lstSprites.ListIndex
            ani(c).spritecount = ani(c).spritecount + 1
            Call display_anidesc
        Else
            MsgBox "Max. " + Str(NUMBER_OF_SPRITES_IN_ANIMATION) + " sprites per animation. Change the Type-Def for more !", vbOKOnly, "Error"
        End If
    End If
End Sub

Private Sub btnAniDelete_Click()
Dim a As Integer
    If lstAni.ListIndex <> -1 Then
        For a = lstAni.ListIndex + 1 To anicount + 1
            ani(a - 1) = ani(a)
        Next a
        anicount = anicount - 1
        Call readd_anilist
    End If
End Sub

Private Sub btnChange_Click()
    If lstSprites.ListIndex <> -1 Then
        msindex = lstSprites.ListIndex
        Load frmSprite
        frmSprite.Show 1
    End If
End Sub

Private Sub btnDeleteA_Click()
Dim a As Integer
Dim b As Integer
    If lstAnidesc.ListIndex <> -1 And lstAni.ListIndex <> -1 Then
        a = lstAnidesc.ListIndex
        For b = a + 1 To lstAnidesc.ListCount
            ani(lstAni.ListIndex).spritelst(b - 1) = ani(lstAni.ListIndex).spritelst(b)
        Next b
        ani(lstAni.ListIndex).spritecount = ani(lstAni.ListIndex).spritecount - 1
        display_anidesc
    End If
End Sub

Private Sub btnDeleteS_Click()
Dim a As Integer
    If lstSprites.ListIndex <> -1 Then
        For a = lstSprites.ListIndex To lstSprites.ListCount
            sprites(a) = sprites(a + 1)
        Next a
        spritecount = spritecount - 1
        Call readd_spritelist
    End If
End Sub

Private Sub btnGrid_Click()
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer

Dim frame As String
    frame = InputBox("Frames? (Y/N)", "Frames", "Y")
    a = Val(InputBox("Sizex=", "SizeX", "49"))
    b = Val(InputBox("Sizey=", "SizeY", "49"))
    spritecount = 0
    If a <> 0 And b <> 0 Then
        For c = 0 To Int(bmpsizeY / b) - 1
            For d = 0 To Int(bmpsizeX / a) - 1
                If frame = "Y" Then
                    sprites(spritecount).X = d * a
                    sprites(spritecount).Y = c * b
                    sprites(spritecount).W = a - 1
                    sprites(spritecount).H = b - 1
                Else
                    sprites(spritecount).X = d * a
                    sprites(spritecount).Y = c * b
                    sprites(spritecount).W = a
                    sprites(spritecount).H = b
                End If
                spritecount = spritecount + 1
            
            Next d
        Next c
        readd_spritelist
    
    End If
End Sub

Private Sub btnHelp_Click()
Dim a As String
    a = a + "1. Open a bmp containing your sprites." + vbCrLf
    a = a + "2. Click on 'Get Sprites' and specify" + vbCrLf
    a = a + "   the width and height of one sprite." + vbCrLf
    a = a + "   Or insert and change the sprite-values" + vbCrLf
    a = a + "   manually for different sprite sizes." + vbCrLf
    a = a + "3. Test the frames by clicking on the sprites." + vbCrLf
    a = a + "4. Select 'New' form 'animations' and name" + vbCrLf
    a = a + "   the animation. Select it from the list." + vbCrLf
    a = a + "5. Rightclick on the bmp to add a sprite to" + vbCrLf
    a = a + "   the animation." + vbCrLf
    a = a + "6. Select 'Play' to preview the animation!" + vbCrLf
    a = a + "" + vbCrLf
    MsgBox a, vbOKOnly, "A little help..."
End Sub

Private Sub btnLoad_Click()
Dim name As String
    With comDlg
        .DialogTitle = "Load Animation file"
        .Filter = "Animation file (*.ani)|*.ani"
        .InitDir = workpath
        .FileName = ""
        .ShowOpen
        name = .FileName
    End With
    If name <> "" Then
        Call load_ani(name)
        Call readd_spritelist
        Call readd_anilist
    End If

End Sub

Private Sub btnLoadBmp_Click()
Dim a As Integer
    
    With comDlg
        .DialogTitle = "Load Bitmap"
        .Filter = "All Images (*.bmp;*.jpg;*.jpeg;*.gif)|*.bmp;*.jpg;*.jpeg;*.gif)|All Files (*.*)|*.*"
        .InitDir = workpath
        .ShowOpen
        bmpname = .FileName
    End With
    
    If bmpname <> "" Then
        With frmAnimaker
            .picBmp.Picture = LoadPicture(bmpname)
            .picBmp.Refresh
            a = .picBmp.Width - 425
            If a > 0 Then
                .HScroll1.Max = a
            Else
                .HScroll1.Max = 0
            End If
            a = .picBmp.Height - 425
            If a > 0 Then
                .VScroll1.Max = a
            Else
                .VScroll1.Max = 0
            End If
            bmpsizeX = .picBmp.Width
            bmpsizeY = .picBmp.Height
            txtPath.Text = bmpname
        End With
    End If
End Sub

Private Sub btnNew_Click()
Dim a As String
    a = InputBox("Name:", "New Animation", "unnamed")
    If a <> "" Then
        ani(anicount).name = a
        anicount = anicount + 1
        Call readd_anilist
    End If
End Sub

Private Sub btnNewS_Click()
Dim a As Integer
    If lstSprites.ListIndex <> -1 Then
        For a = lstSprites.ListCount To lstSprites.ListIndex + 1 Step -1
            sprites(a + 1) = sprites(a)
        Next a
    Else
        lstSprites.AddItem ("")
        lstSprites.ListIndex = 0
    End If
    spritecount = spritecount + 1
    sprites(lstSprites.ListIndex + 1).X = 0
    sprites(lstSprites.ListIndex + 1).Y = 0
    sprites(lstSprites.ListIndex + 1).W = 0
    sprites(lstSprites.ListIndex + 1).H = 0
    Call readd_spritelist
End Sub

Private Sub btnPlay_Click()
    Timer1.Enabled = True
    btnPlay.Enabled = False
    btnStop.Enabled = True
End Sub

Private Sub btnQuit_Click()
    End
End Sub

Private Sub btnSave_Click()
Dim name As String
    With comDlg
        .DialogTitle = "Save Animation file"
        .Filter = "Animation file (*.ani)|*.ani"
        .InitDir = workpath
        .FileName = ""
        .ShowSave
        name = .FileName
    End With
    If name <> "" Then
        Call save_ani(name)
        
        
    End If
End Sub

Private Sub btnStop_Click()
    Timer1.Enabled = False
    btnPlay.Enabled = True
    btnStop.Enabled = False

End Sub

Private Sub Form_Load()
    ani_init
    init
End Sub


Private Sub HScroll1_Change()
    picBmp.Left = -HScroll1.Value
    picBmp.Refresh
End Sub




Private Sub lstAni_Click()
    txtspeed.Text = Trim(Str(ani(lstAni.ListIndex).speed))
    btnPlay.Enabled = True
    Call display_anidesc
End Sub

Private Sub lstAnidesc_Click()
    shpSprite.Top = sprites(ani(lstAni.ListIndex).spritelst(lstAnidesc.ListIndex)).Y
    shpSprite.Left = sprites(ani(lstAni.ListIndex).spritelst(lstAnidesc.ListIndex)).X
    shpSprite.Height = sprites(ani(lstAni.ListIndex).spritelst(lstAnidesc.ListIndex)).H
    shpSprite.Width = sprites(ani(lstAni.ListIndex).spritelst(lstAnidesc.ListIndex)).W

    shpSprite.Visible = True

End Sub

Private Sub lstSprites_Click()
    shpSprite.Top = sprites(lstSprites.ListIndex).Y
    shpSprite.Left = sprites(lstSprites.ListIndex).X
    shpSprite.Height = sprites(lstSprites.ListIndex).H
    shpSprite.Width = sprites(lstSprites.ListIndex).W

    shpSprite.Visible = True
End Sub

Private Sub lstSprites_DblClick()
    Call btnChange_Click
End Sub

Private Sub picBmp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim a As Integer
Dim b As Integer

    For a = 0 To spritecount
        If X > sprites(a).X And X < sprites(a).X + sprites(a).W And Y > sprites(a).Y And Y < sprites(a).Y + sprites(a).H Then
            lstSprites.ListIndex = a
            lstSprites.Refresh
            If Button = 2 Then
                'add to anilst
                Call btnAdd_Click
            End If
            Exit For
            
        End If
    Next a
End Sub

Private Sub picBmp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    frmAnimaker.Caption = "X=" + Str(X) + "           Y=" + Str(Y)
End Sub

Private Sub Timer1_Timer()
    'animate!
    If lstAni.ListIndex <> -1 Then
        
        'This is an example of an "engine"-call !!!
    
        Call animate(lstAni.ListIndex)
        picAni.Cls
        Call drawAnimatedSprite(0, 0, lstAni.ListIndex)
    End If
End Sub

Private Sub txtspeed_Change()
    ani(lstAni.ListIndex).speed = Val(txtspeed.Text)
End Sub

Private Sub VScroll1_Change()
    picBmp.Top = -VScroll1.Value
    picBmp.Refresh
End Sub