So I've spent the evening trying to design snake in VBA. Great stuff. It seemed to be working fine whenever I ran the Main Sub from the VBA window (by clicking the play button in the top ribbon), however when I added a button on the worksheet for the same sub, it runs with no errors but the controls don't behave in the same way. Originally each time you press an arrow you just change direction, however when running the macro through a button you can keep holding the arrow in the direction you're going and it speeds up the snake, so the cell select behaves as it normally would in Excel, rather than as required in snake. This defeats the purpose of the game as the rest of the snake can't catch up with the head and creates gaps within allowing the user to just jump through it.
I'm using GetAsyncKeyState to read key presses:
#If VBA7 Then
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
#Else
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
#End If
Private Const VK_LEFT = &H25 'LEFT ARROW key
Private Const VK_UP = &H26 'UP ARROW key
Private Const VK_RIGHT = &H27 'RIGHT ARROW key
Private Const VK_DOWN = &H28 'DOWN ARROW key
And then calling this with If Statements:
' Key press handling
WasteTime (speed)
If GetAsyncKeyState(VK_DOWN) Then
PressDown
ElseIf GetAsyncKeyState(VK_UP) Then
PressUp
ElseIf GetAsyncKeyState(VK_LEFT) Then
PressLeft
ElseIf GetAsyncKeyState(VK_RIGHT) Then
PressRight
End If
' Offset by key direction or default
ActiveCell.Offset(cellrow, cellcol).Select
For reference, this is all that each key function does:
Function PressUp()
cellrow = -1
cellcol = 0
End Function
Any help would be greatly appreciated. I suspect this has something to do with me declaring the GetAsyncKeyState function in the General Declarations section, but as I've never done this before, can't quite work out what I'm doing wrong. Thanks :)
Related
I got my project 95% done but a small issue remains. My code, run from a user form, opens a PDF document with its first line, identifies its window in the second and moves and resizes that window in the third.
ActiveWorkbook.FollowHyperlink Mail(0) & Mail(Me.Tag)
Wnd = FindWindow(vbNullString, AcrobatWindowID(Mail(Me.Tag)))
SetWindowPos Wnd, HWND_TOP, 1950, 10, 1100, 1300, SWP_NOACTIVATE
At the end of this operation the user form is dimmed out. The focus seems to remain with the PDF. That doesn't really matter because the form is fully developed and I can click on it or the PDF to activate either, just the way I wanted.
Nevertheless I tried to give the focus to the form and then to a particular control. I succeeded in finding the Excel window but failed to set the focus on the form, not to mention the control. In fact, I don't know how to check if I succeeded in setting the focus on the Excel window. I used this code in my attempt of whose syntax I'm not sure.
Public Const SWP_NOMOVE = &H2 ' ignore cx and cy
Public Const SWP_NOSIZE = &H1 ' ignore X and Y
SetWindowPos Wnd, HWND_TOP, 0, 0, 0, 0, (SWP_NOMOVE + SWP_NOSIZE)
Anyway, the form remains dimmed out. Does anyone have advice for me?
In order to obtain the form handler, you should proceed in this way:
Use API GetActiveWindow and create a Private variable on top of the form code module (in the declarations area):
Option Explicit
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private frmHwnd as LongPtr
Insert the next code line in the UserForm_Initialize event:
frmHwnd = GetActiveWindow
I have an Excel form in which I use controls' mouse move event for simulating hovering effect.
There's no problem when the form is showed modal.
When I show the form modeless, even with the stationary mouse, the mousemove event of every control is continuously fired (if the mouse is over that control). The CPU usage grows up to 26-30%.
Nothing changes if the mouse move event has no code inside.
If I comment the entire events this strange behavior disappears.
It seems that the mere existence of the mouseMove event it's enough to create the problem.
I've searched a lot, but it seems I'm the only one having this problem.
I can share the workbook if anyone wants to see it.
I have a relatively simple solution that should handle the CPU usage problem, this doesn't do anything against the event triggering while the mouse is stationary though. The idea is to use the sleep function provided by the windows API to decrease the frequency of the events activation.
So first you need to get the function:
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
#End If
and then inside your userform:
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
sleep 1 '1 should be the time in milliseconds that the code will wait,
'in practice it waits 15ms (see edit below)
'insert the rest of your code here
End Sub
The sleep 1 will make the code wait for one millisecond before resuming execution. Edit: in practice it will make the code wait for 15 milliseconds, see #GSergs comment to this answer.
This is usually enough to get rid of the cpu usage problem. If you don't need the event to trigger 65 times a second you can change the triggering frequency by waiting longer, for example with sleep 30.
If you only need the event to activate once every time the mouse goes from "not over the control" to "over the control" a solution is to use an activation flag:
Inside the Userforms Module:
Dim ControlActive As Boolean
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Not ControlActive Then
ControlActive = True
'insert the rest of your code here
End If
End Sub
Private Sub Userform_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If ControlActive Then
ControlActive = False
End If
End Sub
How can I write a voice command in Dragon NaturallySpeaking that holds a key down for X seconds?
The following voice command will hold the key CTRL for three seconds. You can change the key as well as how long the key is being hold down.
' Tested with Dragon NaturallySpeaking 12.5 Professional on Windows 7 SP1 x64 Ultimate
' From http://nuance-community.custhelp.com/posts/2cd74d2484
' Lindsay Adam
' www.pcbyvoice.com
Declare Function keybd_event Lib "user32.dll" (ByVal vKey As _
Long, bScan As Long, ByVal Flag As Long, ByVal exInfo As Long) As Long
' You can find all the virtual key codes in the following link:
' http://msdn.microsoft.com/en-us/library/ms927178.aspx
Const VK_CTRL = 17
Sub Main
keybd_event(VK_CTRL,0,0,0)
Wait(3)
keybd_event(VK_CTRL,0,2,0)
End Sub
http://msdn.microsoft.com/en-us/library/ms927178.aspx (their robots.txt doesn't allow me to mirror their website with https://web.archive.org):
rc = ws.DialogBox("SomeForm",True,True,,,,,,doc,True)
I have a dialogbox with a text field on it. The problem is when a user types in too much text (too many new lines being added to the text field), it will go beyond the size of the dialogbox and will not be displayed anymore. The only solution so far is to reopen the dialog, which will recalculate the size of the dialogbox.
So first I tried adding a vertical scroll bar:
rc = ws.DialogBox("SomeForm",True,,,,,,,doc,True)
This however adds a horizontal scroll bar too, which is totally unnecessary.
The my next approach was setting the size manually using the WIN-API:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (Byval lpClassName As Any, Byval lpWindowName As Any) As Long
Declare Function SetWindowPos Lib "user32" (Byval hwnd As Long, Byval hWndInsertAfter As Long, Byval x As Long, Byval y As Long, Byval cx As Long,Byval cy As Long, Byval wFlags As Long) As Long
Const SWP_NOMOVE = &H2
Dim myhWnd As Long
myhWnd = FindWindow("#32770", "Lotus Notes")
SetWindowPos myhWnd, -1, 0, 0, 617, 311, SWP_NOMOVE
This works fine, however I don't know when to execute it. Logically, this would have to run when a new line gets added in the text field, but I have no way to detect when this happens...
So, is there any way to make my dialogbox dynamic in terms of size? I know I'm probably at a dead end here, but I figured asking is worth a shot :)
Just change the text- field to be of type "Native OS style". Then you define a max height, and the Dialog becomes exactly the right size. The scrollbar then automatically appears in the Text- field, and the dialog does not have to change size.
this code is supposed to be used in VB. port number and IP address is available. how to prevent packets from entering is to be known. Its similar to the work a FireWall does.
Ur own Personal FIREwall!!
Here is some sample VB6 code to get You started.
It makes use of the winsock control to open and connect to a port itself.
Thereby it automatically denying access to port by other process.
Public Type MIB_TCPROW
dwState As Long
dwLocalAddr As Long
dwLocalPort As Long
dwRemoteAddr As Long
dwRemotePort As Long
End Type
Public Type MIB_TCPTABLE
dwNumEntries As Long
table(100) As MIB_TCPROW
End Type
Public MIB_TCPTABLE As MIB_TCPTABLE
Public Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As
MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Public Declare Function SetTcpEntry Lib "IPhlpAPI" (pTcpRow As MIB_TCPROW)
As Long
Public Declare Function ntohs Lib "WSOCK32.DLL" (ByVal netshort As Long) As
Long
Public Sub BlockPort
Dim LTmp As Long
Dim x As Integer, i As Integer, n As Integer
Dim RemP As String
Dim tcpt As MIB_TCPTABLE
LTmp = Len(MIB_TCPTABLE)
GetTcpTable tcpt, LTmp, 0
x = tcpt.dwNumEntries
For i = 0 To tcpt.dwNumEntries - 1
RemP = ntohs(tcpt.table(i).dwRemotePort)
If RemP = "8080" And tcpt.table(i).dwState <> 2 Then
tcpt.table(i).dwState = 12
SetTcpEntry tcpt.table(i)
End If
Next i
End Sub
If you are looking an easier way to block a single port then :
Use a Winsock Control in your VB form.
Set its localport property to the port number you want to block
Complete reference of Winsock for VB6 here
...and Thats IT!! Your own personal firewall is up!!
GoodLUCK!!
- CVS