How can you detect key presses in vb console mode? - vb.net

I wanted to make a program involving a menu at the start but instead of using the typical select case I wanted to do it differently.
I wanted it to give the user some options and then they would use the arrow keys to move a little arrow next to the options.
Finally you press enter and then you would advance to the next screen that you selected. I have been searching the web but I could only find this kind of stuff in form mode, not console. If this isn't possible let me know and I would appreciate any feedback.

One simple way is with a menu class that will print out the menu and highlight the item number passed to it:
Class Menu
Private MenuList As New List(Of String)
Public ReadOnly Property LineCount As Integer
Get
Return MenuList.Count
End Get
End Property
Public Sub CreateNewMenu(strings As IEnumerable(Of String))
MenuList.Clear()
For Each s In strings
MenuList.Add(s)
Next
End Sub
Public Sub PrintMenu(highlight As Integer)
If highlight < 0 OrElse highlight > MenuList.Count - 1 Then
Throw New Exception("Invalid menu index")
End If
For I = 0 To MenuList.Count - 1
If I = highlight Then
SwapColors()
Console.WriteLine(MenuList(I))
Console.ResetColor()
Else
Console.WriteLine(MenuList(I))
End If
Next
End Sub
Private Sub SwapColors()
Dim temp = Console.BackgroundColor
Console.BackgroundColor = Console.ForegroundColor
Console.ForegroundColor = temp
End Sub
End Class
To use it would look like this:
Dim MainMenu As New Menu
MainMenu.CreateNewMenu(
{
"Option A",
"Option B",
"Option C"
})
Dim CurrentItem As Integer = 0
Dim CurrentKey As ConsoleKey
While CurrentKey <> ConsoleKey.Enter
Console.Clear()
MainMenu.PrintMenu(CurrentItem)
CurrentKey = Console.ReadKey(True).Key
If CurrentKey = ConsoleKey.UpArrow Then
CurrentItem -= 1
ElseIf CurrentKey = ConsoleKey.DownArrow Then
CurrentItem += 1
End If
CurrentItem = (CurrentItem + MainMenu.LineCount) Mod MainMenu.LineCount
End While
This will use inverted colors to highlight the selected item, but this can easily be changed to add an indicator when writing the item to the console, if desired.
When the while loop exits CurrentItem will hold the 0-based index of the selected menu item.
One advantage of this approach is that you can have several collections of menus that will allow you to show specific ones based on the selection.

Related

DropDownMenuItem check should uncheck other DropDownMenuItems

I'm creating a ToolStripMenuItem's DropDownItems at runtime.
Me.mnuExtrasSecondaryLCID.DropDownItems.Clear()
Dim iCount As Integer = -1
For Each nLang As clsLanguage In g_LCIDs
If nLang.IsLeader Then
iCount += 1
Dim n As New ToolStripMenuItem
n.Name = "mnuSecondaryLCID" & iCount.ToString()
n.Text = nLang.Title
n.Tag = nLang.LCID
n.Available = True
n.CheckOnClick = True
Me.mnuExtrasSecondaryLCID.DropDownItems.Add(n)
AddHandler n.Click, AddressOf Me.SecondaryLCIDClick
End If
Next
This works fine.
When I then check one of the DropDownItems at runtime, any other DropDownItems in the same "list" stay checked.
I would instead like to have only one checked (=the last clicked one).
Is there a property that would let me do this automatically, or do I need to code this by unchecking all other DropDropItems manually?
You need to code it manually. When clicking on a sub menu, uncheck all other siblings:
For index = 1 To 5
Dim subMenu = New ToolStripMenuItem(index.ToString())
subMenu.CheckOnClick= True
AddHandler subMenu.Click, Sub(obj, arg)
Dim item = DirectCast(obj, ToolStripMenuItem)
For Each sibling In item.Owner.Items.OfType(Of ToolStripMenuItem).Except({obj})
sibling.Checked = False
Next sibling
End Sub
Menu1ToolStripMenuItem.DropDownItems.Add(subMenu)
Next

A Sub Procedure holds a list, but only the first item is changed through SetCursorPosition

Module Module1
Dim MenuList As New List(Of String)
Function LineCount() As Integer
Return MenuList.Count
End Function
Sub CreateNewMenu(strings() As String)
For Each s In strings
MenuList.Add(s)
Next
End Sub
Sub PrintMenu(highlight As Integer)
For I = 0 To MenuList.Count - 1
If I = highlight Then
SwapColors()
Console.WriteLine(MenuList(I))
Console.ResetColor()
Else
Console.WriteLine(MenuList(I))
End If
Next
End Sub
Sub SwapColors()
Dim temp = Console.BackgroundColor
Console.BackgroundColor = Console.ForegroundColor
Console.ForegroundColor = temp
End Sub
Sub Main()
CreateNewMenu(
{
"Option A",
"Option B",
"Option C"
})
Dim CurrentItem As Integer = 0
Dim CurrentKey As ConsoleKey
While CurrentKey <> ConsoleKey.Enter
Console.Clear()
PrintMenu(CurrentItem)
'Console.SetCursorPosition(10, 10)
'Console.SetCursorPosition(10, 11)
'Console.SetCursorPosition(10, 12)
CurrentKey = Console.ReadKey(True).Key
Select Case CurrentKey
Case ConsoleKey.DownArrow
CurrentItem += 1
Case ConsoleKey.UpArrow
CurrentItem -= 1
End Select
CurrentItem = (CurrentItem + LineCount()) Mod LineCount()
End While
End Sub
End Module
This is a Code, A changed Post written 2014. The following link should be the source. How can you detect key presses in vb console mode?
The PrintMenu Procedure spotted in the Main Sub Procedure is the line i try to Change with a SetCursorPosition command.
I am able to Change the Output to be screened on row 10 line 10. But only for the Option A.
What has to be done, to manage every item that can be listed on Screen? I want to change the row and line for every item through the PrintMenu Procedure.
The problem is that the cursor position is set for the first item in the list but when WriteLine is called, the cursor position is reset to the next line on column = 0. I would change the PrintMenu method to accept the left and top cursor positiion. Something like this (untested):
Sub PrintMenu(highlight As Integer, left As Integer, top As Integer)
For I = 0 To MenuList.Count - 1
Console.CursorLeft = left
Console.CursorTop = top + I 'Use loop variable to adjust top position
If I = highlight Then
SwapColors()
Console.Write(MenuList(I)) 'Changed to use Write instead
Console.ResetColor()
Else
Console.Write(MenuList(I))
End If
Next
End Sub

VB.Net Hangman Game Multiple Rounds

I need some help.
I'm currently creating a Hangman Game in VB.Net.
I'm at the stage where a random word is loaded in from a text file of 6 words, and you can click buttons to guess it. If you guess letters wrong, the frame is shown etc, if they're right, the letter shows in the word through labels.
The next bit, that I'm stuck on, is that multiple rounds are needed. I need there to be 3 turns of this hangman game, so, if you guess the word right you get 10 points, and if you fail, you get 0, And then the game resets with your points and you can play again in Turn 2. Then again in Turn 3, and after Turn 3 finishes, the High Score Form is loaded.
You could create a variable to hold the current round in your Module, at the beginning of each round increase it, and at the end of the round check the current round and make a if then logic.
Dim myRound as Integer = 0
And in the PlayForm in the constructor.
myRound += 1
Once the round is complete.
if myRound >= 3 Then
'open the score page
Else
'start the next round
End if
'In General Declarations:
Dim ButtonList As New List(Of Button) 'or Of Control if you have other types of controls
Dim HgmList As New List(Of PowerPacks.Shape)
Dim AnswerList As New List(Of Label)
'In PlayForm_Load:
With ButtonList
.Clear()
.Add(Me.BtnA)
.Add(Me.BtnB)
.Add(Me.BtnC)
'You get the idea
'Add all your buttons you want to re-enable to the list
End With
With HgmList
.Clear()
.Add(Me.SideFrameLine)
.Add(Me.TopFrameLine)
.Add(Me.CornerFrameLine)
'etc.
End With
With AnswerList
.Add(Me.FirstLetterLbl)
'etc. Just like the other two.
End With
'At the end of your `If Correct = False Then` Block:
Else 'Check for win after each correct guess
Dim Winner As Boolean = True
Dim CheckLetter As Label
For Each CheckLetter in AnswerList
If Not CheckLetter.Visible Then
Winner = False
Exit For
End If
Next
If Winner Then
NextRound(10)
End If
End If
'Somewhere inside your form code:
Private Sub NextRound(RoundScore As Integer)
UserScore += RoundScore
If TurnNumber = 3 Then 'Game Over
MsgBox("Game Over" & vbNewLine & "Score: " & UserScore)
Else 'This is the part you asked about: resetting the form
TurnNumber += 1
PlayForm_Load(Nothing, Nothing)
Dim ResetControl As Control
Dim ResetShape As PowerPacks.Shape
For Each ResetControl In ButtonList
ResetControl.Enabled = True
Next
For Each ResetShape In HgmList
ResetControl.Visible = False
Next
End If
End Sub
I only added the .Clear() to the list builders because you already have your code to get a new word in PlayForm_Load. If you move it (say to a new Sub called NewWord), you don't need .Clear, and you would call your new sub instead of PlayForm_Load.

How to move item in listBox up and down access VBA?

I have a list box contains 10 times . I have UP and Down buttons to move item up and down. My VBA works only if i set listbox multiselect property to 'None'. For the multiselect=simple option it throws error like in valid use of null in this line of code
sText = lbfNames.Column(0, iIndex)
My VBA
Private Sub cmdUP_Click()
Dim sText As String
Dim iIndex As Integer
iIndex = lbfNames.ListIndex
'check: only proceed if there is a selected item
If lbfNames.ListCount > 1 Then
'index 0 is top item which can't be moved up!
If iIndex <= 0 Then
MsgBox ("Can not move the item up any higher.")
Exit Sub
End If
' If iIndex = -1 Or lbfNames.ListCount > 1 Then
'save items text and items indexvalue
sText = lbfNames.Column(0, iIndex)
lbfNames.RemoveItem iIndex
'place item back on new position
lbfNames.AddItem sText, iIndex - 1
'if you keep that item selected
'you can keep moving it by pressing cmdUp
lbfNames.Selected(iIndex - 1) = True
iIndex = iIndex - 1
End If
End sub
And i was trying to convert the below C# code(found in stackoverflow) to Access VBA throwing errors. Some data members not found.
public void MoveUp()
{
MoveItem(-1);
}
public void MoveDown()
{
MoveItem(1);
}
public void MoveItem(int direction)
{
// Checking selected item
if (listBox1.SelectedItem == null || listBox1.SelectedIndex < 0)
return; // No selected item - nothing to do
// Calculate new index using move direction
int newIndex = listBox1.SelectedIndex + direction;
// Checking bounds of the range
if (newIndex < 0 || newIndex >= listBox1.Items.Count)
return; // Index out of range - nothing to do
object selected = listBox1.SelectedItem;
// Removing removable element
listBox1.Items.Remove(selected);
// Insert it in new position
listBox1.Items.Insert(newIndex, selected);
// Restore selection
listBox1.SetSelected(newIndex, true);
}
Is there anyway to do this in access vba.
if you don't want the wrap around feature modify the above solution to this ..
Option Explicit
Private Enum directions
down = -1
up = 1
End Enum
Private Sub cmdDown_Click()
moveListItem (down)
End Sub
Private Sub cmdMvUp_Click()
moveListItem (up)
End Sub
Private Sub moveListItem(direction As directions)
With Me.ListBox1
Select Case .ListIndex
' at bottom and moving down then wrap around to top
Case Is >= .ListCount + direction
' at top and moving up then wrap around to bottom
Case Is < direction
Case Else
.AddItem .Column(0, .ListIndex - direction), .ListIndex + ((direction + 1) / 2)
.RemoveItem (.ListIndex - direction)
End Select
End With
End Sub
I actually reconstructed this setting but could never get the error you mentioned. I did play around with the code to adjust it to what you were trying to do. Try this:
Private Sub cmdup_Click()
Dim sText As String
Dim iIndex As Variant
Dim selection() As Integer
Dim n, topSelection As Integer
' save the indexes of the selected items,
' they will be deselected after the first removal
For Each iIndex In lbfnames.ItemsSelected
ReDim Preserve selection(0 To n)
selection(n) = iIndex
n = n + 1
Next
'loop through all the selected indexes
'this will also ensure you will only proceed if there is a selected item
For n = LBound(selection) To UBound(selection)
'save items text and items indexvalue
sText = lbfnames.Column(0, selection(n))
If selection(n) <= topSelection Then 'index topSelection is top item which can't be moved up!
MsgBox ("Can not move item '" & sText & "' up any higher.")
topSelection = topSelection + 1
Else
'first remove item from old position
lbfnames.RemoveItem selection(n)
'place item back on new position
lbfnames.AddItem sText, selection(n) - 1
'change the index of the selected value to the new index (for reselection)
selection(n) = selection(n) - 1
End If
Next
'loop through the selection again to reselect
For n = LBound(selection) To UBound(selection)
lbfnames.Selected(selection(n)) = True
Next
End Sub
The code and comments are self-explanatory I think, but here is a quick run-through:
I save the selected elements indexes first because I noticed
after the removal/addition of the element that the selection was
gone.
I then run through this selection, I reused your code here.
Changed the condition for the pop up message, because if you select
the top 2 elements for example (say 1 and 2), you don't want to only
get the messagebox for 1 and then in the next loop put 2 ahead of 1.
(Unless that is what you want, then change this condition back to 0)
Add the end I loop through the selected elements a second time to select them again for moving them further up the list.
Note: the example C# code shows a more generic function for both directions of movement. I did not adapt that, I think that is a good idea but leave it to you to implement (always a good exercise to understand the code).
The following code is type safe for direction by using an enum.
The solution allows movement up and down the list.
The solution wraps the movement (e.g. if at top of list and attempting to move up it wraps the item to the bottom.
Private Enum directions
down = -1
up = 1
End Enum
Private Sub cmdDown_Click()
moveListItem (down)
End Sub
Private Sub cmdMvUp_Click()
moveListItem (up)
End Sub
Private Sub moveListItem(direction As directions)
With Me.ListBox1
Select Case .ListIndex
' at bottom and moving down then wrap around to top
Case Is >= .ListCount + direction
.AddItem .Column(0, .ListCount - 1), 0
.RemoveItem (.ListCount - 1)
.Selected(0) = True
' at top and moving up then wrap around to bottom
Case Is < direction
.AddItem .Column(0, 0), .ListCount
.RemoveItem (0)
.Selected(.ListCount - 1) = True
Case Else
.AddItem .Column(0, .ListIndex - direction), .ListIndex + ((direction + 1) / 2)
.RemoveItem (.ListIndex - direction)
End Select
End With
End Sub

Get the name of controls (buttons) dynamically

I have 10 buttons namely button01, button02 ... button10. What I want is how to manipulate it.
For x=1 to 10
button(x).text = "blah" 'from database...or something
next
I need to do this because I have 10 buttons or more and I want to manipulate it through initialization. So that I don't do it manually one by one. I don't know how to do this. I'm still new in .NET.
You should not need to do it in this error-prone way just to save you some lines of code. But if you really want....
You can use a Panel or another container control that groups the related controls logically. Then use MyPanel.Controls.OfType(Of Button)() to filter and find all the buttons there.
For Each btn As Button In MyPanel.Controls.OfType(Of Button)()
btn.Text = "blah" 'from database...or something
Next
Another way is to put them all in an array or other collection type like List(Of Button) first and loop over them afterwards:
Dim myButtons = {button1, button2, button3, button4, button5, button6}
For Each btn In myButtons
btn.Text = "blah" 'from database...or something
Next
Last you could use ControlCollection.Find to find controls with a given string for its name:
For i As Int32 = 1 To 10
Dim btns = Me.Controls.Find("button" & i, True)
If btns.Length > 0 Then
btns(0).Text = "blah" 'from database...or something
End If
Next
Simply:
For i As Integer = 1 To 10
Me.Controls("button" & i.ToString("00")).Text = "blah"
Next
You have to iterate through the parent container of these buttons.
Say you are holding these controls inside a panel called PnlTest, then you have to do it like this:
For Each xControls As Control In PnlTest.Controls
If TypeOf xControls Is Button Then
xControls.Text = "blah" 'from database...or something
End If
Next
You could try using the method FindControl as such from the WebControl:
For x=1 to 10
FindControl("button" & if(x < 10, "0" & x, x) = "blah" 'from database...or something
next
EDIT: I primarily use C#, not VB, so it may need some alteration. However, the approach is the same I would believe.
zeroyevi cubosoft.cl -- DevExpress -- la clave esta (bar.button.item) en Me.RibbonControl.Items("NAME_BUTTON" ).Enabled = True or false
Private Sub GetSearchPerfilModulosBotones(ByVal _id_perfil As String)
Dim dt As New DataTable
Dim _act_btns As Boolean
Dim _name_btns As String
Dim _name_module As String = Me.Name.ToString()
Try
Dim _ControlDatosSistema As New ControlDatosSistema()
With _ControlDatosSistema
dt = .GetSearchPerfilModulosBotones(_id_perfil, _name_module )'SQL QUERY
If (dt.Rows.Count >= 1) Then
For Each row As DataRow In dt.Rows
_act_btns = row("ACT_BTNS") 'BOTONES PERFIL True or False
_name_btns = row("NAME_BTNS").ToString()'NOMBRE BOTONES TABLA
Me.RibbonControl.Items(_name_btns ).Enabled = _act_btns
Next
End If
End With
_ControlDatosSistema = Nothing
dt.Dispose()
Catch ex As Exception
End Try
End Sub