Keskustelu: Ohjelmointikysymykset: VB6: MouseDown?

Eli tarkoituksenani on ohjata askelmoottoria VB6:lla ja MSComm:lla. Olen saanut moottorin pyörähtämään 4 askelta kun kirjoitan command1:lle koodin:

Call PortOut(888, 1)
Sleep 10
Call PortOut(888, 2)
Sleep 10
Call PortOut(888, 4)
Sleep 10
Call PortOut(888, 8)
Sleep 10

Askelmoottoreita ennen ohjanneet tietävät miten tämä toimii, mutta tämä ei ole se mitä haen takaa. Vaan se että millä saan command1:n toistamaan tätä koodia niin kauan kun nappia pidetään pohjassa? Tämä MouseDown ei toimi. Olen yrittänyt tehdä Do While :lla mutta kone tilttaa heti nappia painamalla. MouseMoven avulla sain tämän toimimaan kun hiirtä liikuttaa napin päällä, mutta ei sellaista kukaan halua jos haluaa ohjata moottoria.

Kiitoksia etukäteen.

Lisää projektiisi Timeri, joka käynnistyy MouseDown:lla ja pysähtyy MouseUp:lla. Timerin Intervalliksi vastaava aika, minkä tuo Sleep nukkuu. Timerin koodiksi taas seuraavan kaltaista:

Dim i As Integer

i = Iif(i > 2, 0, i + 1) 'kasvatetaan arvoa yhdella, jos arvo on pienempi kuin 3
Select Case i
    Case 0: Call PortOut(888, 1)
    Case 1: Call PortOut(888, 2)
    Case 2: Call PortOut(888, 4)
    Case 3: Call PortOut(888, 8)
End Select

Noniin. Tuo antamasi koodisi pelaa mainiosti. Kiitoksia! Seuraavana ongelmana on se että VB ei anna pitää nappia pohjassa kun noin. 1-2 sekuntia. Koitin että muillakin ohjelmilla se tekee samaa. Pystyisikös tätä ominaisuutta poistamaan?

Jeps. Syy tuohon nappien itsestään nouseminen oli langallisessa hiiressä. Eli kun hiiri ei tunnista liikettä niin se lopettaa kommunikoinnin koneen kans.

^^Korjaan. Langattomassa

Olisiko tätä mahdollista toteuttaa jonku muun kuin timerin avulla? Timerin nopeus ei riitä saamaan moottorille tarpeeksi nopeaa pyörimistä. Jollain Do While komennoilla olen saanut sen pyörimään tasaisesti mutta kone jäi looppiin ja tilttas lopulta.

Lisää Do While:n DoEvents:

Do While true
..koodia..
DoEvents
Loop

DoEvents antaa windowsille/VB:lle aikaa miettiä.

Pystyykös tässä määrittelemään aikaa? Pelkkä doevents ei vielä riitä.

EIkö siis timerin aika ole tarpeeksi pieni?

Jos millisekunnin tarkkuus riittää, WinAPIn funktio timeGetTime voisi olla kelvollinen. Tässä on ohjelman alkuun tuleva funktion määrittely ja esimerkki funktion käytöstä. Esimerkki kasvattaa muuttujan a arvoa 10 millisekunnin välein, kunnes muuttuja saavuttaa lopulta arvon 100.

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Dim alku As Long
Do
    ' tässä tehdään jotain
    a = a + 1
    ' odotetaan 10 millisekuntia
    alku = timeGetTime
    Do While alku + 10 > timeGetTime
        DoEvents
    Loop
Loop While a < 100

Tarkempikin ajastin on saatavilla, mutta sen käyttö on hieman vaikeampaa. Tämän funktion nimi on QueryPerformanceCounter, ja kirjoitin sen käytöstä taannoin koodivinkin.

Ongelmana on se että tuo "tauko" pitäisi saada optimoitua sellaiseksi että askelmoottori kekiäisi tunnistamaan sen mutta kuitenkin sen verran nopeaksi että askellukset olisivat tasaisia. Eli askelmoottorin liikuttelu tapahtuu 4:llä koodirivillä:

Call PortOut(888, 1)
Call PortOut(888, 3)
Call PortOut(888, 2)
Call PortOut(888, 0)

Ja pelkästään tuollaisena ohjelma lukee ne liian nopeaa ja moottori ei kerkiä reagoimaan. Sleep komennolla olen saanut sen toimimaan oikein mutten tarpeeksi nopeaa. Tämä "tauko" pitäisi siis saada jokaisen Call PortOut komentojen väliin ja tuota timeGetTime:ä en saanut sovellettua niin. Sleep komentoa olen käyttänyt seuraavanlaisesti:

Call PortOut(888, 1)
Sleep nopeus
Call PortOut(888, 3)
Sleep nopeus
Call PortOut(888, 2)
Sleep nopeus
Call PortOut(888, 0)
Sleep nopeus

Ja nopeuden arvon olen ottanut text kentästä, joten nopeutta olen saanut säädeltyä. Huom. yksi Call PortOut komento kääntää moottorin akselia 1 asteen eli hidasta on liike, ja jos sleep:n arvo on 1 (minimi) niin moottorin yhteen kierrokseen menee ~4sec. Mutta koneen tilttaamisen loopin ansiosta nopeus oli puolet suurempi ja huomattavasti tasaisempi.

Moikka Dukex!

Kokeile tota alla olevaa säätöö ja sovella...

'Formille Slider-kontrolli, tekstiboxi, label & komentonappi

Dim viive As Single, lopeta As Boolean

Private Sub Form_Load()
 Slider1.Min = 0
 Slider1.Max = 100
 Slider1.SelectRange = True
 Slider1.SelStart = 0
 Command1.Caption = "Start"
 Label1.Caption = "0"
End Sub

Private Sub Command1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Select Case Command1.Caption
  Case "Start"
   Command1.Caption = "Stop"
   lopeta = False: anna_palaa: Exit Sub
  Case "Stop"
   Command1.Caption = "Start"
   lopeta = True: viivytys: anna_palaa: Exit Sub
 End Select
End Sub


Private Sub Slider1_Change()
 viive = Slider1.Value / 200
 Label1.Caption = viive
End Sub

Function viivytys()
 Dim xviive As Single
   xviive = viive + Timer()
  Do While xviive > Timer()
  DoEvents
  If lopeta Then Exit Do
  Loop
End Function

Sub anna_palaa()
 Do
  If Val(Text1) > 1000000 Then Text1 = ""
  DoEvents
  Text1 = Val(Text1) + 1
  viivytys
 Loop Until lopeta
End Sub

Hmm. Paljon vastauksia... joista itse en ehkä saisi paljoa irti. Laitan siis itsekin jotain avustavaa (kaikkea kuitenkaan paljastamatta):

Dim lopeta_kaskytys As Integer
'' Nappi, jota painamalla mennään 'ikuiseen' looppiin kunnes ympäristömuuttuja
'' lopeta_kaskytys asetetaan nollasta poikkeavaksi. DoEvents mahdollistaa
'' tämän arvon muuttamisen muualla kuin tässä funktiossa.
Sub Command1_Click()
Dim portti As Integer, viive As Integer, portti_jarj(4) As Integer
  lopeta_kaskytys = 0
  portti = 0
  '' Askelmoottorin ohjausjärjestys
  portti_jar(0) = 1: portti_jar(1) = 3: portti_jar(2) = 2: portti_jar(3) = 0

  While lopeta_kaskytys = 0
    '' Tässä se tarvittu osa - viive ja PortOut-kutsu.
    Call PortOut(888, portti_jarj(portti))
    '' Tähän kohtaan keksit sopivan, lyhyen viiveen - esim. Antin vinkit
    ''' Delay(?)
    DoEvents
    portti = portti + 1
    if portti > 3 Then portti = 0
  Wend
End Sub

'' Mikä tahansa nappi... joka kuitenkin reagoi 'ikuisen loopin'
'' aikana, kiitos DoEvents-komennon. Ja lopettaa ikuisen silmukan.
Sub Command2_Click()
  lopeta_kaskytys = 1
End Sub

Voit myös käyttää Sleep -Apikutsua

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Do
 'koodi
 Sleep 10 'Nukutaan 10 millisekuntia
 DoEvents
Loop

Heippa taas Dukex!

Toinen tapa lähestyä sarjaportin välityksellä ohjausta on tehdä se IO API:lla

io.dll kirjaston voi impata täältä
imppaamisen jälkeen io.dll olis hyvä siirtää \windows\system32 -hakemistoon.

Tässä olis koodia, jota ehkä kannattaisi kokeilla...

Private Declare Sub PortOut Lib "IO.DLL" (ByVal Port As Integer, ByVal Data As Byte)
Private Declare Function PortIn Lib "IO.DLL" (ByVal Port As Integer) As Byte
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim lopetus As Boolean

Private Sub Command1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Lopetus = False: OutPort: Exit Sub
End Sub

Private Sub Command1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Lopetus = True: Exit Sub
End Sub

Sub OutPort()

 Static tapaus As Integer

 Do While Not lopetus

  DoEvents

  Select Case tapaus
   Case 0: OutNum% = -1                  'Case 0: OutNum% = 1
   Case 1: OutNum% = -3                  'Case 1: OutNum% = 3
   Case 2: OutNum% = -2                  'Case 2: OutNum% = 2
   Case 3: OutNum% = 0                   'Case 3: OutNum% = 0
  End Select

  If tapaus < 3 Then
   tapaus = tapaus + 1
  Else: tapaus = 0
  End If

   PortAddress% = 888
   PortState% = PortIn(PortAddress%)
   portnum% = PortState% + Abs(OutNum%)
   PortOut PortAddress%, portnum%

   Sleep 1                               '(Sleep viive)

  If OutNum% = 0 Then
   PortOut PortAddress%, 0
  ElseIf OutNum% < 0 Then                'OutNum% > 0 Then
   PortOut PortAddress%, OutNum%         'OutNum% - (2 * OutNum%)
  End If

 Loop

End Sub

Hei neau33!

Koodisi heittää overflow:ta rivillä:

PortOut PortAddress%, Portnum%

Heippa taas Dukex!

Kokeile vaihtaa tämä:

Private Declare Sub PortOut Lib "IO.DLL" (ByVal Port As Integer, ByVal Data As Byte)

tähän:

Private Declare Sub PortOut Lib "IO.DLL" (ByVal Port As Integer, ByVal Data As Integer)

Hei Nea!

Tuo ensimmäinen esimerkkisi toimi hyvin.

Muutin kohdan: viive = Slider1.Value / 200
arvon 200 -> 20000:ksi ja kun viiveen arvo oli alle 0.001 niin kone tilttaa. Moottori toki pyöri jo ihan kivalla nopeudella. Eli se maaginen raja on vissiin tuo 0.001 tässä sinun ohjelmassa.

Pidän tätä jo hyvänä mutta jos juolahtaa jotain vielä parempaa niin en estä kertomaan :D