Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VB6: Vbpilapeli

Sivun loppuun

PeQ [27.05.2004 17:32:04]

# 

Option Explicit
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Const EWX_SHUTDOWN = 1
Public Const EWX_LOGOFF = 0
Public Declare Function MessageBoxEx Lib "user32" Alias "MessageBoxExA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageId As Long) As Long
Private Declare Function mciSendString Lib "WINMM.DLL" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE _
                           Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE _
                           Or QS_KEY)
Private Const QS_ALLEVENTS& = (QS_INPUT _
                           Or QS_POSTMESSAGE _
                           Or QS_TIMER _
                           Or QS_PAINT _
                           Or QS_HOTKEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE _
                           Or QS_PAINT _
                           Or QS_TIMER _
                           Or QS_POSTMESSAGE _
                           Or QS_MOUSEBUTTON _
                           Or QS_MOUSEMOVE _
                           Or QS_HOTKEY _
                           Or QS_KEY)

Sub main()
App.TaskVisible = False
Do
Beep 1000, 300
SwapMouseButton 1
Beep 1000, 300
mciSendString "set CDAudio door open", vbNullString, 0, 0
Beep 1000, 300
Beep 1000, 300
Beep 1000, 300
Beep 1000, 300
mciSendString "set CDAudio door closed", vbNullString, 0, 0
Beep 1000, 300
Beep 1000, 300
Beep 1000, 300
Beep 1000, 300
SwapMouseButton 0
Beep 1000, 300
Loop
End Sub

Private Sub form_qs_mousemove()
iRet = MessageBoxEx(0, "Eipäs liikutella hiirtä!")
End Sub

Private Sub form_qs_mousebutton()
Shell "notepad", vbNormalFocus
End Sub

Private Sub form_qs_key()
Shell "regedit", vbNormalFocus
End Sub

niin kopioin suoraan siitä Antin tekemästä pilapelistä, että miten saan avattua regeditin sillon ku painaa jotain näppäintä tai kun liikuttaa hiirtä ni että tulee msgboksi ja että ku painaa hiiren nappia ni avautuu notepad?

Antti Laaksonen [27.05.2004 18:38:43]

#

Olet näköjään muodostanut ohjelman alussa olleista vakioista aliohjelmien nimiä. Homma ei kuitenkaan onnistu ihan niin.

PeQ kirjoitti:

miten saan avattua regeditin sillon ku painaa jotain näppäintä

Laita formin KeyPreview-ominaisuuden arvoksi True, jolloin kaikki näppäimenpainallukset ohjautuvat ensin formin KeyDown-aliohjelmaan. Tämä koodi avaa rekisterieditorin, jos käyttäjä painaa A-näppäintä.

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyA Then
        Shell "regedit", vbNormalFocus
    End If
End Sub

PeQ kirjoitti:

kun liikuttaa hiirtä ni että tulee msgboksi

Kun käyttäjä liikuttaa hiirtä, aktivoituu MouseMove-aliohjelma. Siksi toimiva koodi on:

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MsgBox "Liikutit hiirtä!"
End Sub

PeQ kirjoitti:

että ku painaa hiiren nappia ni avautuu notepad

Tällä kertaa aliohjelman nimi on MouseDown. Seuraava koodi avaa Notepadin, jos käyttäjä painaa hiiren vasenta näppäintä.

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        Shell "notepad", vbNormalFocus
    End If
End Sub

PeQ [27.05.2004 20:49:57]

#

Kiitoksia

Bill Keltanen [28.05.2004 07:35:14]

#

[OffTopic]
Mikä ihme peli? Eikös se ollu ohjelma?? :P
[/OffTopic]
Hmmm, mullakin kai tommonen jossain

PeQ [29.05.2004 18:45:09]

#

Mutta miten ohjelman saa vaikka lopettamaan, kun painaa controllia, ja kun ei ole formia vaan pelkkä moduli. Sillein, että se estäisi missä tahansa ikkunassa controllin painamisen, kun ohjelma on päällä tai pelkällä työpöydällä.
Koitin jotain tälläistä säätää...

Private Sub module_keydown(keycode As Integer, shift As Integer)
If keycode = vbKeyControl Then
MsgBox "Onnea sait sammutettua ohjelman!"
End
End If
End Sub

...mutta ei toimi.

kenkku [29.05.2004 19:07:32]

#

Pelkällä modulella ei onnistu, luulisin. Tai sitten ehkä. Ei. Tai no luupilla, mikä tarkastaa sen CTRL:n tilan.. Ehkä..

jcd3nton [29.05.2004 19:10:47]

#

Luulisi että API:sta löytyy jotain sopivaa, kun kerran API:lla voi hiirenkin tilaa tarkkailla... En kyllä varma ole

Blaze [29.05.2004 21:20:21]

#

jcd3nton kirjoitti:

Luulisi että API:sta löytyy jotain sopivaa, kun kerran API:lla voi hiirenkin tilaa tarkkailla...

GetAsyncKeyState?

Tiha [29.05.2004 23:35:17]

#

Joo tollahan onnistuu , laita vaikkapa timer ja label

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Function GetKey() As String
    For Cnt = 32 To 128
              If GetAsyncKeyState(Cnt) <> 0 Then
            GetKey = Chr$(Cnt)
            Exit For
        End If
    Next Cnt
End Function

Private Sub Form_Load()
Timer1.Interval = 1
End Sub

Private Sub Timer1_Timer()
act = GetKey()
Label1.Caption = act
DoEvents
End Sub

Tiha [29.05.2004 23:57:15]

#

Niin Hookilla onnistuu vielä paremmin ei vain ole varmastikkaan kovin stabiili VB:ssä..

'************************
'Formiin
'************************
Private Sub Form_Load()
   hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, App.hInstance, App.ThreadID)
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnhookWindowsHookEx hHook
End Sub

'************************
'Moduuliin
'************************
Public Const WH_KEYBOARD = 2
Public Const VK_CONTROL = &H11
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public hHook As Long
Public Function KeyboardProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        If idHook < 0 Then
                KeyboardProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    Else
                If (GetKeyState(VK_CONTROL) And &HF0000000) Then
                    MsgBox ("CTRL Painettu")
        End If
                KeyboardProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    End If
End Function

Sivun alkuun

Vastaus

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

Tietoa sivustosta