Keskustelu: Ohjelmointikysymykset: VB6: objektin liikuttaminen klikattuun paikkaa?

Private Sub Timer1_Timer()
If Shape2.Left < kohde1 Then If koordinaatti1 < kohde1 Then Shape2.Left = Shape2.Left + 100
If Shape2.Top > kohde2 Then If koordinaatti2 > kohde2 Then Shape2.Top = Shape2.Top - 100
End Sub

Private Sub Timer2_Timer()
If Shape2.Left > kohde1 Then If koordinaatti1 > kohde1 Then Shape2.Left = Shape2.Left - 100
If Shape2.Top < kohde2 Then If koordinaatti2 < kohde2 Then Shape2.Top = Shape2.Top + 100
End Sub

Private Sub Timer3_Timer()
If Shape2.Left > kohde1 Then If koordinaatti1 > kohde1 Then Shape2.Left = Shape2.Left - 100
If Shape2.Top > kohde2 Then If koordinaatti2 > kohde2 Then Shape2.Top = Shape2.Top - 100
End Sub

Private Sub Timer4_Timer()
If Shape2.Left < kohde1 Then If koordinaatti1 < kohde1 Then Shape2.Left = Shape2.Left + 100
If Shape2.Top < kohde2 Then If koordinaatti2 < kohde2 Then Shape2.Top = Shape2.Top + 100
End Sub

Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim n As Boolean, s As Boolean, w As Boolean, e As Boolean, loppu As Long

Private Sub Form_Load()
n = False: s = False: w = False: e = False
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
n = False: s = False: w = False: e = False
If Button = 1 Then
If X < Shape1.Left + (Shape1.Width / 2) Then w = True
If X > Shape1.Left + (Shape1.Width / 2) Then e = True
If Y < Shape1.Top + (Shape1.Height / 2) Then n = True
If Y > Shape1.Top + (Shape1.Height / 2) Then s = True
End If


Do
loppu = GetTickCount() + 1

If w = True And Shape1.Left <> X Then Shape1.Left = Shape1.Left - 3

If e = True And Shape1.Left <> X Then Shape1.Left = Shape1.Left + 3

If n = True And Shape1.Top <> Y Then Shape1.Top = Shape1.Top - 3

If s = True And Shape1.Top <> Y Then Shape1.Top = Shape1.Top + 3

Do Until GetTickCount() >= loppu: DoEvents: Loop
If Shape1.Top = Y - (Shape1.Height / 2) And Shape1.Left = X - (Shape1.Width / 2) Then Exit Do
Loop

End Sub

Private Sub Form_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)

   Static doing As Boolean

   If Not doing And Button = 1 Then

      doing = True

      Dim mx As Single, my As Single
      Dim n As Boolean, s As Boolean, _
      w As Boolean, e As Boolean

      mx = X: my = Y

      Do: DoEvents

         n = False: s = False
         w = False: e = False

         If mx < Shape1.Left + (Shape1.Width / 2) Then w = True
         If mx > Shape1.Left + (Shape1.Width / 2) Then e = True
         If my < Shape1.Top + (Shape1.Height / 2) Then n = True
         If my > Shape1.Top + (Shape1.Height / 2) Then s = True

         If w Then Shape1.Left = Shape1.Left - 0.1
         If e Then Shape1.Left = Shape1.Left + 0.1
         If n Then Shape1.Top = Shape1.Top - 0.1
         If s Then Shape1.Top = Shape1.Top + 0.1

         'viive 0.005

         If CInt(Shape1.Left) = CInt(mx - (Shape1.Width / 2)) _
         And CInt(Shape1.Top) = CInt(my - (Shape1.Height / 2)) Then
            doing = False: Exit Sub
         End If

      Loop

   End If

End Sub

Private Sub viive(ByVal aika As Single)
   aika = aika + Timer
   Do While aika > Timer: DoEvents: Loop
End Sub

Public Class frmKenttä

    Private Const ASKELPITUUSNOIN As Single = 30 ' säädä sopivaksi

    Private kohdepiste As Point
    Private sijaintiNyt As Point
    Private askelMitta As Point
    Private askelKokLkm As Integer
    Private askelLkm As Integer

    Private Sub frmKenttä_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        With TheAjastin
            .Interval = 100 ' säädä sopivaksi
            .Enabled = False
        End With
    End Sub

    ' Lomaketta klikattaessa lasketaan askeltiedot
    '   - mitta
    '   - montako askelta tarvii ottaa
    ' ja laitetaan sijainniksi lähtöpiste, nollataan askel-laskuri,
    ' ja käynnistetään ajastin:
    Private Sub frmKenttä_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
        Dim lähtöpiste As Point = Ovaali.Location
        kohdepiste = e.Location ' klikkauksen paikka lomakkeella
        Dim kokoMatka As Point = kohdepiste - lähtöpiste
        Dim matkanPituus As Single

        With kokoMatka
            matkanPituus = Math.Sqrt(.X ^ 2 + .Y ^ 2)
            askelKokLkm = Int(matkanPituus / ASKELPITUUSNOIN + 0.5)
            ' Lasketaan tarkka askel:
            askelMitta = New Point(.X \ askelKokLkm, .Y \ askelKokLkm)
        End With

        sijaintiNyt = lähtöpiste
        askelLkm = 0

        TheAjastin.Enabled = True
    End Sub

    ' Ajastimen raksahtaessa lisätään askel sijaintiin ja lisätään otettujen askelten lukumäärää,
    ' ja katsotaan joko tultiin perille:
    Private Sub TheAjastin_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles TheAjastin.Tick
        sijaintiNyt.Offset(askelMitta)
        askelLkm += 1
        Ovaali.Location = sijaintiNyt
        If askelLkm >= askelKokLkm Then
            ' Asetetaan tarkasti kohdepisteeseen:
            Ovaali.Location = kohdepiste ' kokonaisluvuilla edettäessä ei välttämättä tulla juuri kohdepisteeseen
            ' Lopetetaan liikkuminen:
            TheAjastin.Enabled = False
        End If
    End Sub
End Class