Solitare Game 2

[rann]

Hi,
I would like to open a solitare game after Disabling some of the menu options.I can open any application from my VB
code but it need to disable some of the menu options.
Can this be done using API calls.


Thanks in Advance,

Any suggestions would be helpfull.

RANN

 

[vanvb]

If you are talking about disabling some of the menu options within solitaire, I think you're hooped on this one. There doesn't seem to be any command line switches available, and there also are no registry keys that I found that have to do with solitaire...so I don't see how this is possible. API calls also are not possible in this situation either as far as I know of.

 

[ADoozer]

ok first off, it is possible (how reliable the technique is i dont know, this code was thrown together very quickly and has not been tested fully (but should provide the ground work))

you will need to get the handle for the solitaire window (i used winspy and just bodged it in) for this code to run

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
'Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Const MF_BYPOSITION = &H400&
Private Const MF_GRAYED = &H1&
Private Const MF_ENABLED = &H0&


Dim myhwnd As Long
Dim myhMenu As Long
'Dim myMenuCount As Integer
Dim myhSubMenu As Long

Private Sub Command1_Click()

'disables exit menu of solitaire

'quick bodge using winspy
myhwnd = 1115426

myhMenu = GetMenu(myhwnd)
myhSubMenu = GetSubMenu(myhMenu, 0)
' myMenuCount = GetMenuItemCount(myhSubMenu)
stuff = EnableMenuItem(myhSubMenu, 6, MF_BYPOSITION + MF_GRAYED)

End Sub

Private Sub Command2_Click()

'enables exit menu of solitaire

'quick bodge using winspy
myhwnd = 1115426

myhMenu = GetMenu(myhwnd)
myhSubMenu = GetSubMenu(myhMenu, 0)
' myMenuCount = GetMenuItemCount(myhSubMenu)
stuff = EnableMenuItem(myhSubMenu, 6, MF_BYPOSITION + MF_ENABLED)

End Sub

hope this gets you started... ill try and throw a nicer bit of code together tomorrow... (unless someones got some ready written stuff!

good luck!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------

http://www.climateprediction.net/index.php

come on... get involved!
To get the best response to a question, please check out FAQ222-2244 first
A General Guide To Excel in VB FAQ222-3383

 

[ADoozer]

ok its a little bit prettier!

Private Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String _
) As Long

Private Declare Function GetMenu Lib "user32" ( _
    ByVal hwnd As Long _
) As Long

Private Declare Function EnableMenuItem Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal wIDEnableItem As Long, _
    ByVal wEnable As Long _
) As Long

Private Declare Function GetSubMenu Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal nPos As Long _
) As Long

Private Const MF_BYPOSITION = &H400&
Private Const MF_GRAYED = &H1&
Private Const MF_ENABLED = &H0&

Dim myhWnd As Long
Dim myhMenu As Long
Dim myhSubMenu As Long


Private Sub cmdCreateSolitaire_Click()
    
    Shell "C:\WINNT\SYSTEM32\sol.EXE", vbNormalFocus
    
End Sub

Private Sub cmdDisableExit_Click()
       
    myhWnd = FindWindow("Solitaire", "Solitaire")
    
    myhMenu = GetMenu(myhWnd)
    myhSubMenu = GetSubMenu(myhMenu, 0) '0=file 1=help
    stuff = EnableMenuItem(myhSubMenu, 6, MF_BYPOSITION + MF_GRAYED) 'mainmenu(0) 0=deal 2=undo 3=deck 4=options 6=exit : mainmenu(1) 0=contents 1=search 2=how to use 4=about
    
End Sub

Private Sub cmdEnableExit_Click()
    
    myhWnd = FindWindow("Solitaire", "Solitaire")
    
    myhMenu = GetMenu(myhWnd)
    myhSubMenu = GetSubMenu(myhMenu, 0)
    stuff = EnableMenuItem(myhSubMenu, 6, MF_BYPOSITION + MF_ENABLED)
    
End Sub

hope that makes sense (PS usual 3 minute testing applies)

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------

http://www.climateprediction.net/index.php

come on... get involved!
To get the best response to a question, please check out FAQ222-2244 first
A General Guide To Excel in VB FAQ222-3383

 

[vanvb]

I think we've established here that ADoozer is much smarter than me. Good Job!

 

[DrJavaJoe]

and probably cheats at Solitaire

 

[LPlates]

Well I dont have Solitaire but I tested the code on Notepad and works great, have a star!

 

[ADoozer]

vanvb: not necessarily, ive recently been playing around lots with menus... lol

DrJJ: cheeky!!!

LPlates: dont trust the code outright, its mearly an example, it doesnt take into account multiple games of solitaire(or notepad).

thnx for the *

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------

http://www.climateprediction.net/index.php

come on... get involved!
To get the best response to a question, please check out FAQ222-2244 first
A General Guide To Excel in VB FAQ222-3383