Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VB6: objektin liikuttaminen klikattuun paikkaa?

Sivun loppuun

Flayer [17.01.2009 12:19:18]

#

Eli oon tässä pari päivää koittanu saada shape objektia liikkumaan painetun kuvan päälle niin, että ajastin käynnistyy kuvaa painettaessa ja shape lähtee liikkumaan kohti kuvaa (vähän ku kävelis). Homma kuitenki kusahta täysin jos sitä koittaa copy pastee toiseen lomakkeesee (en tajuu miks) tai jos painaakin toista sijaintia sillon kun shape on viellä matkalla.

Koodi on jotai tällästä

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

Eli neljä ajastinta koittaa liikuttaa sitä sinne minne pitää ja noita ajastimia ohjaillaan funktiolla näin:

If koordinaatti1 < kohde1 And koordinaatti2 > kohde2 Then lomake.Timer1.Enabled = True
If koordinaatti1 > kohde1 And koordinaatti2 < kohde2 Then lomake.Timer2.Enabled = True
If koordinaatti1 > kohde1 And koordinaatti2 > kohde2 Then lomake.Timer3.Enabled = True
If koordinaatti1 < kohde1 And koordinaatti2 < kohde2 Then lomake.Timer4.Enabled = True

koodinaattiX kertoo missä oot nyt ja kohdeX sitä mihin sen pitäis liikkua. Missä vika?

Mod. lisäsi kooditagit

Juhko [17.01.2009 20:32:40]

#

Nyt en kyllä ymmärrä kovin hyvin ongelmaasi. Pistä jonnekin zip-tiedosto ladattavaksi.

Jorgga [17.01.2009 21:29:11]

#

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

Purkkasin. Varmaan 1000 tapaa tehdä paremmin.

neau33 [18.01.2009 14:09:36]

#

Moikka Jorgga!

API-virityksesi toimii paitsi, että luuppista ei pääse ulos mikäli välimatka X <-> Shape1.Left - (Shape1.Width / 2) tai välimatka Y <-> Shape1.Top - (Shape1.Height / 2) ei ole jaollinen 3:lla...voisi ehkä myös vielä viritellä...

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

Flayer [18.01.2009 15:23:02]

#

Kiitti vinkeistä btw miten tota viivettä nostetaan neau33 ? 'viive 0.005 tollee lukee tossa koodissa mut en honaa mitä pitää tehä et saisin ton liikkuu hitaammin

neau33 [18.01.2009 18:38:27]

#

Heippa taas Flayer!

esim. raahaa formille Textbox- ja Spinbutton kontrollit ja lisää koodin...

Private Sub Form_Load()
   Spinbutton1.Max = 10
   Spinbutton1.Value = 5
End Sub

Private Sub SpinButton1_Change()
 TextBox1.Text = "0." & Format$(SpinButton1.Value, "000")
End Sub
'viive 0.005 <-vaihda tämä rivi alla olevaan...
viive Val(TextBox1.Value)

Flayer [19.01.2009 09:43:28]

#

Pystyskö tota mitenkää laittaa timeriin? sillee et se ois ihan kiinteesti joku arvo ja pystyyks tolle vilkkumiselle tekee mitää? ku nyt toi shape1 vilkkuu törkeesti tossa ruudulla ku se menee niin tarkasti ja kovaa.

Flayer [20.01.2009 08:24:40]

#

jatko kyssärinä viel sellai et saako tota shapen vilkkumista mitenkää korjattuu? eli tarkotan sitä et jos siin on esim joku taustakuva ja sitte toi shape kipittii -1 / +1 johku suuntaa suht nopeella vauhdilla ni tulee törkeetä vilkkumista siin shapen kohalla ja siin välähtelee taustakuvan läpi harmaata.

vesimies [20.01.2009 15:38:55]

#

Tässä on nyt yhdenlainen viritys, paranneltavaa varmasti löytyy vielä... Tässä liikkuminen alkaa lomakkeen klikkauksesta. Yksinkertaisuuden vuoksi koordinaatteina on shapen vasen yläkulma, ei keskipiste.

Lomakkeelle kontrollit:
Timer: TheAjastin
OvalShape: Ovaali

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

vesimies [20.01.2009 18:47:44]

#

Sorry taas tuli väärällä kielellä. :(

Toimintaidean tuosta kuitenkin voi katsoa, jos haluaa.

Point tarkoittaa käytännössä kahta Integer-muuttujaa (x,y). Ja Offset lisää Pointiin toisen Pointin:

piste1.Offset(piste2)

on sama kuin

x1 = x1 + x2
y1 = y1 + y2

Niin ja shape nyt voi olla mikä vaan eihän sillä tässä väliä.

Flayer [21.01.2009 07:23:12]

#

jep kiitos avusta, nyt se objekti rullaa ruudulla mukavasti. Vielku sais sen jotenki lopettamaan tai edes rajoittamaan tota vilkkumista sillon ku se liikkuu.


Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta