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
Nyt en kyllä ymmärrä kovin hyvin ongelmaasi. Pistä jonnekin zip-tiedosto ladattavaksi.
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.
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
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
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)
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.
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.
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
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ä.
jep kiitos avusta, nyt se objekti rullaa ruudulla mukavasti. Vielku sais sen jotenki lopettamaan tai edes rajoittamaan tota vilkkumista sillon ku se liikkuu.
Aihe on jo aika vanha, joten et voi enää vastata siihen.