There is a way to center a MessageBox without subclassing or hooking?
I'm looking for VB.NET code.
The solution for VB.NET:
This code is taken and translated from an asnwer of #Hans Passant: Winforms-How can I make MessageBox appear centered on MainForm?
Centered_MessageBox.vb
Imports System.Text
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Class Centered_MessageBox
Implements IDisposable
Private mTries As Integer = 0
Private mOwner As Form
Public Sub New(owner As Form)
mOwner = owner
owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End Sub
Private Sub findDialog()
' Enumerate windows to find the message box
If mTries < 0 Then
Return
End If
Dim callback As New EnumThreadWndProc(AddressOf checkWindow)
If EnumThreadWindows(GetCurrentThreadId(), callback, IntPtr.Zero) Then
If System.Threading.Interlocked.Increment(mTries) < 10 Then
mOwner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End If
End If
End Sub
Private Function checkWindow(hWnd As IntPtr, lp As IntPtr) As Boolean
' Checks if <hWnd> is a dialog
Dim sb As New StringBuilder(260)
GetClassName(hWnd, sb, sb.Capacity)
If sb.ToString() <> "#32770" Then
Return True
End If
' Got it
Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
Dim dlgRect As RECT
GetWindowRect(hWnd, dlgRect)
MoveWindow(hWnd, frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, dlgRect.Right - dlgRect.Left, dlgRect.Bottom - dlgRect.Top, True)
Return False
End Function
Public Sub Dispose() Implements IDisposable.Dispose
mTries = -1
End Sub
' P/Invoke declarations
Private Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
<DllImport("user32.dll")> _
Private Shared Function EnumThreadWindows(tid As Integer, callback As EnumThreadWndProc, lp As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll")> _
Private Shared Function GetCurrentThreadId() As Integer
End Function
<DllImport("user32.dll")> _
Private Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
End Function
<DllImport("user32.dll")> _
Private Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
End Function
<DllImport("user32.dll")> _
Private Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, w As Integer, h As Integer, repaint As Boolean) As Boolean
End Function
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
End Class
Usage:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Using New Centered_MessageBox(Me)
MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK)
End Using
End Sub
Sadly there is no way to centre a MessageBox to a parent. It centres on the screen by default, and cannot be changed.
Create Your Own - Easy Create a form (get rid of controlbox in properties set false)
Place Textbox (called TextBox_Prompt) and set it to multiline in properties
Add 3 Buttons (wide/height enough to hold "CANCEL" comfortably) below the text box
add below code to your form (I used the | character to denote a newline):
Public Class frmMsgBox
Private mName As String = "Message Box" ' default name for form
Private mLocation As Point = New Point(400, 400) ' default location in case user does set
Private mStyle As MsgBoxStyle
Private mPrompt As String
Private mResult As MsgBoxResult
Private b1Result As MsgBoxResult
Private b2Result As MsgBoxResult
Private b3Result As MsgBoxResult
Public WriteOnly Property Style As MsgBoxStyle
Set(value As MsgBoxStyle)
mStyle = value
End Set
End Property
Public WriteOnly Property Prompt As String
Set(value As String)
mPrompt = value
End Set
End Property
Public ReadOnly Property Result As MsgBoxResult
Get
Return mResult
End Get
End Property
Public WriteOnly Property pLocation As Point
Set(value As Point)
mLocation = value
End Set
End Property
Public WriteOnly Property sName As String
Set(value As String)
mName = value
End Set
End Property
Private Sub frmMsgBox_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim strPrompt() As String = mPrompt.Split("|") ' use | for splitting lines
Dim sWidth As Integer = 0
Dim sHeight As String = ""
Me.Text = mName
For Each sLine As String In strPrompt ' get maximum width and height necessary for Prompt TextBox
sWidth = Math.Max(sWidth, TextRenderer.MeasureText(sLine, TextBox_Prompt.Font).Width)
sHeight += "#" + vbCrLf ' TextRenderer.MeasureText("#", TextBox_Prompt.Font).Height
TextBox_Prompt.Text += sLine + vbCrLf
Next
TextBox_Prompt.Width = Math.Min(800, sWidth + 5) ' set max width arbitrarily at 800
TextBox_Prompt.Height = Math.Min(600, TextRenderer.MeasureText(sHeight, TextBox_Prompt.Font).Height) ' set max height to 600 pixels
Me.Width = Math.Max(Me.Width, TextBox_Prompt.Width + Me.Width - Me.ClientRectangle.Width + 20)
TextBox_Prompt.Left = Math.Max(10, (Me.ClientRectangle.Width - TextBox_Prompt.Width) \ 2)
Button1.Top = TextBox_Prompt.Top + TextBox_Prompt.Height + 20
Button2.Top = Button1.Top : Button3.Top = Button1.Top
Me.Height = Me.Height - Me.ClientRectangle.Height + 2 * TextBox_Prompt.Top + TextBox_Prompt.Height + Button1.Height + 20
Dim Space2 As Integer = (Me.ClientRectangle.Width - 2 * Button1.Width) / 3
Dim Space3 As Integer = (Me.ClientRectangle.Width - 3 * Button1.Width) / 4
Select Case mStyle
Case MsgBoxStyle.AbortRetryIgnore
Button1.Text = "Abort" : Button2.Text = "Retry" : Button3.Text = "Ignore"
Button1.Left = Space3
Button2.Left = 2 * Space3 + Button1.Width
Button3.Left = 3 * Space3 + 2 * Button1.Width
b1Result = MsgBoxResult.Abort : b2Result = MsgBoxResult.Retry : b3Result = MsgBoxResult.Ignore
Case MsgBoxStyle.YesNoCancel
Button1.Text = "Yes" : Button2.Text = "No" : Button3.Text = "Cancel"
Button1.Left = Space3
Button2.Left = 2 * Space3 + Button1.Width
Button3.Left = 3 * Space3 + 2 * Button1.Width
b1Result = MsgBoxResult.Yes : b2Result = MsgBoxResult.No : b3Result = MsgBoxResult.Cancel
Case MsgBoxStyle.YesNo
Button1.Text = "Yes" : Button2.Text = "No" : Button3.Visible = False
Button1.Left = Space2
Button2.Left = 2 * Space2 + Button1.Width
b1Result = MsgBoxResult.Yes : b2Result = MsgBoxResult.No
Case MsgBoxStyle.OkCancel
Button1.Text = "Ok" : Button2.Text = "Cancel" : Button3.Visible = False
Button1.Left = Space2
Button2.Left = 2 * Space2 + Button1.Width
b1Result = MsgBoxResult.Ok : b2Result = MsgBoxResult.Cancel
Case MsgBoxStyle.RetryCancel
Button1.Text = "Retry" : Button2.Text = "Cancel" : Button3.Visible = False
Button1.Left = Space2
Button2.Left = 2 * Space2 + Button1.Width
b1Result = MsgBoxResult.Retry : b2Result = MsgBoxResult.Cancel
Case MsgBoxStyle.OkOnly
Button1.Visible = False : Button2.Text = "Ok" : Button3.Visible = False
Button1.Left -= Space2 : Button2.Width += 2 * Space2
b2Result = MsgBoxResult.Ok
End Select
Me.Location = New Point(mLocation.X - Me.Width \ 2, mLocation.Y - Me.Height \ 2)
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
mResult = b1Result
Me.Close()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
mResult = b2Result
Me.Close()
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
mResult = b3Result
Me.Close()
End Sub
End Class
to use your program you can do the following
Dim ans as MsgBoxResult
Using f As New frmMsgBox With {
.sName = "form tile goes here ",
.Style = MsgBoxStyle.YesNoCancel, ' or whatever style
.Prompt = "Your prompt|2nd line||4th line",
.pLocation = New Point(Me.Left + Me.Width \ 2, Me.Top + Me.Height \ 2)
} ' this location will center MsgBox on form
f.ShowDialog()
ans = f.Result
End Using
If ans = MsgBoxResult.Yes Then
'do whatever
ElseIf ans = MsgBoxResult.No then
'do not whatever
Else ' was cancel
' do cancel
End If
I use this form all the time
You can also add a picture property/box to your form as well as other stuff.
Georg
This is my own message box use C# winform, In addition to the realization of the parent form in the center, can customize the button text and icon. You can convert it to VB code yourself.
Related
i have class inherited from textbox , and when i try to add the control from the toolbox i have this error in the picture.
this is class inherited from textbox control ,using listbox control to choose from auto complete list
Public Structure Account
Dim Name As String
Dim Number As String
Public Sub New(Namee As String, Num As String)
Name = Namee
Number = Num
End Sub
Public Overrides Function ToString() As String
Return Name
End Function
End Structure
Public Class AutoCompleteTextBox
Inherits TextBox
Private ACL As List(Of Account), CACL As List(Of Account)
Private CaseSensitive As Boolean
Private MinChar As Integer
Private LS As ListBox
Private OLDText As String
Private PN As Panel
Public Sub New()
MyBase.New
MinTypedCharacters = 2
CaseSesitivity = False
ACL = New List(Of Account)
LS = New ListBox
LS.Name = "SeggestionListBox"
LS.Font = Font
LS.Visible = True
PN = New Panel
PN.Visible = False
PN.Font = Font
PN.AutoSizeMode = AutoSizeMode.GrowAndShrink
PN.ClientSize = New Size(1, 1)
PN.Name = "SeggestionPanel"
PN.Padding = New Padding(0, 0, 0, 0)
PN.Margin = New Padding(0, 0, 0, 0)
PN.BackColor = Color.Transparent
PN.ForeColor = Color.Transparent
PN.PerformLayout()
If Not PN.Controls.Contains(LS) Then
PN.Controls.Add(LS)
End If
LS.Dock = DockStyle.Fill
LS.SelectionMode = SelectionMode.One
AddHandler LS.KeyDown, AddressOf LS_KeyDown
AddHandler LS.MouseClick, AddressOf LS_MouseClick
AddHandler LS.MouseDoubleClick, AddressOf LS_MouseDoubleClick
CACL = New List(Of Account)
LS.DataSource = CACL
OLDText = Text
End Sub
#Region "Properties"
Public Property AutoCompleteList As List(Of Account)
Get
Return ACL
End Get
Set(value As List(Of Account))
ACL.Clear()
ACL = value
End Set
End Property
Public Property CaseSesitivity As Boolean
Get
Return CaseSensitive
End Get
Set(value As Boolean)
CaseSensitive = value
End Set
End Property
Public Property MinTypedCharacters As Integer
Get
Return MinChar
End Get
Set(value As Integer)
MinChar = value
End Set
End Property
Public Property SelectedIndex As Integer
Get
Return LS.SelectedIndex
End Get
Set(value As Integer)
If LS.Items.Count <> 0 Then
LS.SelectedIndex = value
End If
End Set
End Property
Private ReadOnly Property ParentForm As Form
Get
Return Me.Parent.FindForm
End Get
End Property
#End Region
Public Sub HideSuggestionListBox()
If Not ParentForm Is Nothing Then
PN.Hide()
If ParentForm.Controls.Contains(PN) Then
ParentForm.Controls.Remove(PN)
End If
End If
End Sub
Private Function SelectItem() As Boolean
If LS.Items.Count > 0 AndAlso LS.SelectedIndex > -1 Then
Text = LS.SelectedItem.ToString
HideSuggestionListBox()
End If
Return True
End Function
Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
If e.KeyCode = Keys.Up Then
MoveSelection(SelectedIndex - 1)
e.Handled = True
ElseIf e.KeyCode = Keys.Down Then
MoveSelection(SelectedIndex + 1)
e.Handled = True
ElseIf e.KeyCode = Keys.PageUp Then
MoveSelection(SelectedIndex - 10)
e.Handled = True
ElseIf e.KeyCode = Keys.PageDown Then
MoveSelection(SelectedIndex + 10)
e.Handled = True
ElseIf e.KeyCode = Keys.Enter Then
SelectItem()
e.Handled = True
Else
MyBase.OnKeyDown(e)
End If
End Sub
Protected Overrides Sub OnLostFocus(e As EventArgs)
If Not PN.ContainsFocus Then
MyBase.OnLostFocus(e)
If Not CheckItem(Text) Then
Text = ""
End If
HideSuggestionListBox()
End If
End Sub
Protected Overrides Sub OnTextChanged(e As EventArgs)
If Not DesignMode Then
ShowSuggests()
End If
MyBase.OnTextChanged(e)
OLDText = Text
End Sub
Private Sub LS_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs)
If (e.KeyCode = Keys.Enter) Then
Me.SelectItem()
e.Handled = True
End If
End Sub
Private Sub LS_MouseClick(ByVal sender As Object, ByVal e As MouseEventArgs)
' select the current item
Me.SelectItem()
MsgBox(LS.SelectedItem.number)
End Sub
Private Sub LS_MouseDoubleClick(ByVal sender As Object, ByVal e As MouseEventArgs)
Me.SelectItem()
End Sub
Private Function CheckItem(ItemSTR As String) As Boolean
For Each STR As Account In ACL
If ItemSTR.ToLower = STR.ToString.ToLower Then
Return True
Exit Function
End If
Next
Return False
End Function
Private Sub MoveSelection(Index As Integer)
If Index <= -1 Then
SelectedIndex = 0
ElseIf Index > (LS.Items.Count - 1) Then
SelectedIndex = LS.Items.Count - 1
Else
SelectedIndex = Index
End If
End Sub
Private Sub ShowSuggests()
If Text.Length >= MinTypedCharacters Then
PN.SuspendLayout()
If Text.Length > 0 AndAlso OLDText = Text.Substring(0, Text.Length - 1) Then
UpdateCurrentAutoCompleteList()
ElseIf OLDText.Length > 0 AndAlso Text = OLDText.Substring(0, OLDText.Length - 1) Then
UpdateCurrentAutoCompleteList()
Else
UpdateCurrentAutoCompleteList()
End If
If Not CACL Is Nothing AndAlso CACL.Count > 0 Then
PN.Show()
PN.BringToFront()
Focus()
Else
HideSuggestionListBox()
End If
PN.ResumeLayout()
Else
HideSuggestionListBox()
End If
End Sub
Private Sub UpdateCurrentAutoCompleteList()
CACL.Clear()
For Each STR As Account In ACL
If CaseSesitivity = True Then
If STR.ToString.IndexOf(Text) > -1 Then
CACL.Add(STR)
End If
Else
If STR.ToString.ToLower.IndexOf(Text.ToLower) > -1 Then
CACL.Add(STR)
End If
End If
Next
If CACL.Count > 0 Then
UpdateListBoxItems()
Else
HideSuggestionListBox()
End If
End Sub
Private Sub UpdateListBoxItems()
If Not ParentForm Is Nothing Then
PN.Width = Width
'PN.Height = ParentForm.ClientSize.Height - Height - Location.Y
Dim F As Integer = ParentForm.ClientSize.Height - Height - Location.Y
Dim Ten As Integer = Font.Height * 10
Dim CUr As Integer = Font.Height * (CACL.Count + 1)
If F < CUr Then
PN.Height = F
ElseIf CUr < Ten Then
PN.Height = CUr
ElseIf Ten < F Then
PN.Height = Ten
Else
PN.Height = F
End If
'PN.Height = Font.Height * 10
PN.Location = Location + New Size(0, Height)
If Not ParentForm.Controls.Contains(PN) Then
ParentForm.Controls.Add(PN)
End If
CType(LS.BindingContext(CACL), CurrencyManager).Refresh()
End If
End Sub
End Class
firstly i used list(of string) before using the structure account .
the problem appears after using the structure
Any Idea about this error ?
**** additional picture show another problem after substitutes the structure with class and adds attribute.
***** changed the Structure to class
<Serializable> Public Class Account
Private Nam As String
Private Numbe As String
Public Sub New(Namee As String, Num As String)
Name = Namee
Number = Num
End Sub
Public Property Name As String
Get
Return Nam
End Get
Set(value As String)
Nam = value
End Set
End Property
Public Property Number As String
Get
Return Numbe
End Get
Set(value As String)
Numbe = value
End Set
End Property
Public Overrides Function ToString() As String
Return Name
End Function
End Class
Problem Resolved*
i will share the solve with you.
all the problem is coming from the line
ACL = New List(Of Account)
and the line
CACL = New List(Of Account)
because it declare new list(of account) in design time.
i solved the problem by deleting the both of line and modified the property (AutoCompleteList) to be like that.
Public WriteOnly Property AutoCompleteList As List(Of Account)
Set(value As List(Of Account))
ACL = value
CACL = New List(Of Account)
End Set
End Property
and the final code will be like that:-
the structure:
Public Structure Account
Public Name As String
Public Number As String
Public Sub New(Namee As String, Num As String)
Name = Namee
Number = Num
End Sub
Public Overrides Function ToString() As String
Return Name
End Function
End Structure
the class:
Public Class AutoCompleteTextBox
Inherits TextBox
Private ACL As List(Of Account), CACL As List(Of Account)
Private CaseSensitive As Boolean
Private MinChar As Integer
Private LS As ListBox
Private OLDText As String
Private PN As Panel
Public Sub New()
MyBase.New
MinTypedCharacters = 2
CaseSesitivity = False
LS = New ListBox
LS.Name = "SeggestionListBox"
LS.Font = Font
LS.Visible = True
PN = New Panel
PN.Visible = False
PN.Font = Font
PN.AutoSizeMode = AutoSizeMode.GrowAndShrink
PN.ClientSize = New Size(1, 1)
PN.Name = "SeggestionPanel"
PN.Padding = New Padding(0, 0, 0, 0)
PN.Margin = New Padding(0, 0, 0, 0)
PN.BackColor = Color.Transparent
PN.ForeColor = Color.Transparent
PN.PerformLayout()
If Not PN.Controls.Contains(LS) Then
PN.Controls.Add(LS)
End If
LS.Dock = DockStyle.Fill
LS.SelectionMode = SelectionMode.One
AddHandler LS.KeyDown, AddressOf LS_KeyDown
AddHandler LS.MouseClick, AddressOf LS_MouseClick
AddHandler LS.MouseDoubleClick, AddressOf LS_MouseDoubleClick
LS.DataSource = CACL
OLDText = Text
End Sub
Public WriteOnly Property AutoCompleteList As List(Of Account)
Set(value As List(Of Account))
'ACL.Clear()
ACL = value
CACL = New List(Of Account)
End Set
End Property
Public Property CaseSesitivity As Boolean
Get
Return CaseSensitive
End Get
Set(value As Boolean)
CaseSensitive = value
End Set
End Property
Public Property MinTypedCharacters As Integer
Get
Return MinChar
End Get
Set(value As Integer)
MinChar = value
End Set
End Property
Public Property SelectedIndex As Integer
Get
Return LS.SelectedIndex
End Get
Set(value As Integer)
If LS.Items.Count <> 0 Then
LS.SelectedIndex = value
End If
End Set
End Property
Private ReadOnly Property ParentForm As Form
Get
Return Me.Parent.FindForm
End Get
End Property
Public Sub HideSuggestionListBox()
If Not ParentForm Is Nothing Then
PN.Hide()
If ParentForm.Controls.Contains(PN) Then
ParentForm.Controls.Remove(PN)
End If
End If
End Sub
Private Function SelectItem() As Boolean
If LS.Items.Count > 0 AndAlso LS.SelectedIndex > -1 Then
Text = LS.SelectedItem.ToString
MsgBox(LS.SelectedItem.number)
HideSuggestionListBox()
End If
Return True
End Function
Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
If e.KeyCode = Keys.Up Then
MoveSelection(SelectedIndex - 1)
e.Handled = True
ElseIf e.KeyCode = Keys.Down Then
MoveSelection(SelectedIndex + 1)
e.Handled = True
ElseIf e.KeyCode = Keys.PageUp Then
MoveSelection(SelectedIndex - 10)
e.Handled = True
ElseIf e.KeyCode = Keys.PageDown Then
MoveSelection(SelectedIndex + 10)
e.Handled = True
ElseIf e.KeyCode = Keys.Enter Then
SelectItem()
e.Handled = True
Else
MyBase.OnKeyDown(e)
End If
End Sub
Protected Overrides Sub OnLostFocus(e As EventArgs)
If Not PN.ContainsFocus Then
MyBase.OnLostFocus(e)
If Not CheckItem(Text) Then
Text = ""
End If
HideSuggestionListBox()
End If
End Sub
Protected Overrides Sub OnTextChanged(e As EventArgs)
If Not DesignMode Then
ShowSuggests()
End If
MyBase.OnTextChanged(e)
OLDText = Text
End Sub
Private Sub LS_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs)
If (e.KeyCode = Keys.Enter) Then
Me.SelectItem()
e.Handled = True
End If
End Sub
Private Sub LS_MouseClick(ByVal sender As Object, ByVal e As MouseEventArgs)
' select the current item
Me.SelectItem()
MsgBox(LS.SelectedItem.number)
End Sub
Private Sub LS_MouseDoubleClick(ByVal sender As Object, ByVal e As MouseEventArgs)
Me.SelectItem()
End Sub
Private Function CheckItem(ItemSTR As String) As Boolean
For Each STR As Account In ACL
If ItemSTR.ToLower = STR.ToString.ToLower Then
Return True
Exit Function
End If
Next
Return False
End Function
Private Sub MoveSelection(Index As Integer)
If Index <= -1 Then
SelectedIndex = 0
ElseIf Index > (LS.Items.Count - 1) Then
SelectedIndex = LS.Items.Count - 1
Else
SelectedIndex = Index
End If
End Sub
Private Sub ShowSuggests()
If Text.Length >= MinTypedCharacters Then
PN.SuspendLayout()
If Text.Length > 0 AndAlso OLDText = Text.Substring(0, Text.Length - 1) Then
UpdateCurrentAutoCompleteList()
ElseIf OLDText.Length > 0 AndAlso Text = OLDText.Substring(0, OLDText.Length - 1) Then
UpdateCurrentAutoCompleteList()
Else
UpdateCurrentAutoCompleteList()
End If
If Not CACL Is Nothing AndAlso CACL.Count > 0 Then
PN.Show()
PN.BringToFront()
Focus()
Else
HideSuggestionListBox()
End If
PN.ResumeLayout()
Else
HideSuggestionListBox()
End If
End Sub
Private Sub UpdateCurrentAutoCompleteList()
CACL.Clear()
For Each STR As Account In ACL
If CaseSesitivity = True Then
If STR.ToString.IndexOf(Text) > -1 Then
CACL.Add(STR)
End If
Else
If STR.ToString.ToLower.IndexOf(Text.ToLower) > -1 Then
CACL.Add(STR)
End If
End If
Next
If CACL.Count > 0 Then
UpdateListBoxItems()
Else
HideSuggestionListBox()
End If
End Sub
Sub Fill()
For Each A As Account In CACL
LS.Items.Add(A)
Next
End Sub
Private Sub UpdateListBoxItems()
If Not ParentForm Is Nothing Then
PN.Width = Width
'PN.Height = ParentForm.ClientSize.Height - Height - Location.Y
Dim F As Integer = ParentForm.ClientSize.Height - Height - Location.Y
Dim Ten As Integer = Font.Height * 10
Dim CUr As Integer = Font.Height * (CACL.Count + 1)
If F < CUr Then
PN.Height = F
ElseIf CUr < Ten Then
PN.Height = CUr
ElseIf Ten < F Then
PN.Height = Ten
Else
PN.Height = F
End If
'PN.Height = Font.Height * 10
PN.Location = Location + New Size(0, Height)
If Not ParentForm.Controls.Contains(PN) Then
ParentForm.Controls.Add(PN)
End If
Fill()
End If
End Sub
End Class
thank you all.
I have a NumericUpDown control in the main thread.
I create an instance of a public class_A that stores the NumericUpDown value.
I create a BackgroundWorker that runs a separate thread.
In the BackgroundWorker thread I create an instance of a class_B that recalls the argument from the instance of class_A.
I don't understand why the instance of the class_A just created before, its result as Nothing.
Here is the code:
Imports System.ComponentModel
Public Class Form1
Dim WithEvents bgw As New BackgroundWorker
Dim WithEvents bgw2 As New BackgroundWorker
Dim lSide As Label
Public nudSide As NumericUpDown
Dim bCalculate As Button
Dim bCalculate2 As Button
Dim tbLog As TextBox
Dim calc As calc
Public calc2 As calc2
Public Delegate Function d_getSide() As Double
Public getSide As New d_getSide(AddressOf rungetSide)
Public Side As c_Side
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Size = New Size(400, 160)
bgw.WorkerSupportsCancellation = True
bgw2.WorkerSupportsCancellation = True
lSide = New Label
With lSide
.Text = "Side"
.Size = New Size(40, 20)
.Location = New Point(10, 10)
End With
Me.Controls.Add(lSide)
nudSide = New NumericUpDown
With nudSide
.Size = New Size(40, 20)
.Location = New Point(lSide.Location.X + lSide.Size.Width, lSide.Location.Y)
.DecimalPlaces = 0
.Minimum = 1
.Maximum = 100
.Increment = 1
.Value = 1
End With
Me.Controls.Add(nudSide)
bCalculate = New Button
With bCalculate
.Text = "Calculate"
.Size = New Size(60, 20)
.Location = New Point(nudSide.Location.X + nudSide.Size.Width + 40, nudSide.Location.Y)
AddHandler .Click, AddressOf bCalculate_Click
End With
Me.Controls.Add(bCalculate)
bCalculate2 = New Button
With bCalculate2
.Text = "Calculate 2"
.Size = New Size(60, 20)
.Location = New Point(bCalculate.Location.X + bCalculate.Size.Width + 10, bCalculate.Location.Y)
AddHandler .Click, AddressOf bCalculate2_Click
End With
Me.Controls.Add(bCalculate2)
tbLog = New TextBox
With tbLog
.Size = New Size(250, 60)
.Location = New Point(lSide.Location.X, lSide.Location.Y + 40)
.Multiline = True
.ScrollBars = ScrollBars.Vertical
End With
Me.Controls.Add(tbLog)
End Sub
Private Sub bCalculate_Click()
bgw.RunWorkerAsync(nudSide.Value)
End Sub
Private Sub bgw_Dowork(sender As Object, e As DoWorkEventArgs) Handles bgw.DoWork
'example 1)
'passing argument throught backGroundWorker
calc = New calc(e.Argument)
End Sub
Private Sub bgw_Runworkercompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles bgw.RunWorkerCompleted
getResult()
End Sub
Private Sub bCalculate2_Click()
'here i create an instance of the Side class (expose the side property)
Side = New c_Side
bgw2.RunWorkerAsync()
End Sub
Private Sub bgw2_Dowork(sender As Object, e As DoWorkEventArgs) Handles bgw2.DoWork
'example 2)
' in the backgroundworker thread i create an instance of the class calc2
calc2 = New calc2()
End Sub
Private Sub bgw2_Runworkercompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles bgw2.RunWorkerCompleted
getResult2()
End Sub
Private Sub write(ByVal message As String)
With tbLog
.SelectionStart = .Text.Length
.SelectedText = vbCrLf & message
End With
End Sub
Private Sub getResult()
tbLog.Clear()
write("area = " & calc.area & " cm^2")
write("volume = " & calc.volume & " cm^3")
End Sub
Private Sub getResult2()
tbLog.Clear()
write("area = " & calc2.area & " cm^2")
write("volume = " & calc2.volume & " cm^3")
End Sub
Public Function rungetSide() As Double
If Me.InvokeRequired Then
Me.Invoke(getSide)
Else
Return Side.Side
End If
Return Side.Side
End Function
End Class
Class calc
Sub New(ByVal Side As Double)
_area = Side ^ 2
_volume = Side ^ 3
End Sub
Private _area As Double
Public Property area As Double
Get
Return Math.Round(_area, 2)
End Get
Set(value As Double)
_area = Math.Round(value, 2)
End Set
End Property
Private _volume As Double
Public Property volume As Double
Get
Return Math.Round(_volume, 2)
End Get
Set(value As Double)
_volume = Math.Round(value, 2)
End Set
End Property
End Class
Public Class calc2
Sub New()
'the constructor, recall the value from the instance (public) of the class 'Side' just built in the main thread
'but i don't understand why the instance it's nothing
_area = Form1.Side.Side ^ 2
_volume = Form1.Side.Side ^ 3
End Sub
Private _area As Double
Public Property area As Double
Get
Return Math.Round(_area, 2)
End Get
Set(value As Double)
_area = Math.Round(value, 2)
End Set
End Property
Private _volume As Double
Public Property volume As Double
Get
Return Math.Round(_volume, 2)
End Get
Set(value As Double)
_volume = Math.Round(value, 2)
End Set
End Property
End Class
Public Class c_Side
Sub New()
_Side = Form1.nudSide.Value
'_Side = Form1.rungetSide
End Sub
Private _Side As Double
Public Property Side As Double
Get
Return Math.Round(_Side, 2)
End Get
Set(value As Double)
_Side = Math.Round(value, 2)
End Set
End Property
End Class
What I'm looking for is to create an instance of class_A in the main thread and store the NumericUpDown value, and in a separate thread (BackgroundWorker) create an instance of class_B and obtain the value of the NumericUpDown control, just before stored in the instance of class_A.
I've found the solution.
Just declare the variable as Public Shared
Public Shared Side As c_Side
So it's visible from all the application, and so, from all the threads.
So when i start the thread (or when i want or when i need), i backup all the values of the UI controls in a Public Shared instance of a Public Class, that can be 'read' from the backGroundWorker thread.
I'm creating a Quiz Application in VB and the quiz app reads the questions from a text file which is already created and it has got some questions in it.
1
Q.Who won the WorldCup last time?
I Don't know
May be he knows
Who knows
Who cares?
2
Question 2
Answer A
Answer B
Answer C
Answer D
3
Question 3
Ans 1
Ans 2
Ans 3
Ans 4
The first line is the question number,the second line is the question,lines 3 - 6 represents the answer choices.Now I have created a Form for quiz and when the next button is pressed it should display the next question i.e,After the first question it should go to Question 2 and print accordingly.But unfortunately i'm unable to calculate the logic to go to next question.
Public Class Quiz
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
End Function
Dim SCORE As Integer = 0
Dim val As Integer = 30
Dim QUES As Integer = 0
Dim Line As Integer = 1
Dim allLines As List(Of String) = New List(Of String)
Dim TextFilePath As String = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "Quiz.txt")
Private Sub Quiz_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = 30
Timer1.Enabled = True
Next_Prev_Ques(Line + QUES)
End Sub
Public Function Next_Prev_Ques(quesno As Integer) As Integer
Line = quesno
Using file As New System.IO.StreamReader(TextFilePath)
Do While Not file.EndOfStream
allLines.Add(file.ReadLine())
Loop
End Using
QUES = ReadLine(Line, allLines)
Label1.Text = ReadLine(Line + 1, allLines)
RadioButton1.Text = ReadLine(Line + 2, allLines)
RadioButton2.Text = ReadLine(Line + 3, allLines)
RadioButton3.Text = ReadLine(Line + 4, allLines)
RadioButton4.Text = ReadLine(Line + 5, allLines)
Return Line
End Function
Public Function ReadLine(lineNumber As Integer, lines As List(Of String)) As String
Return lines(lineNumber - 1)
End Function
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
ProgressBar1.Value += 1
val -= 1
Label2.Text = val & " Sec"
If ProgressBar1.Value = ProgressBar1.Maximum Then
Timer1.Enabled = False
End If
If ProgressBar1.Value > 25 Then
SendMessage(ProgressBar1.Handle, 1040, 2, 0)
End If
End Sub
Private Sub Quiz_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
Form1.Close()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
MsgBox(Line + QUES + 5)
Next_Prev_Ques(Line + QUES + 4)
Me.Refresh()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Next_Prev_Ques(Line + QUES + 5)
End Sub
The function Next_Prev_Ques Should run accordingly but its not.Can anyone post the correct code?
Below is some code that uses serialization to get the same results. You can create a class called Questions and properties on it like questionnumber, question and answer, store the data into a xml file and retrieve them with string methods. Check the code below:
The code for the class
Public Class clsQuestions
Private _Number As String
Private _Question As String
Private _Answer As String
Public Property Number() As String
Get
Number = _Number
End Get
Set(ByVal Value As String)
_Number = Value
End Set
End Property
Public Property Question() As String
Get
Question = _Question
End Get
Set(ByVal Value As String)
_Question = Value
End Set
End Property
Public Property Answer() As String
Get
Answer = _Answer
End Get
Set(ByVal Value As String)
_Answer = Value
End Set
End Property
End Class
The code for the form
Imports System.IO
Imports System.Xml.Serialization
Public Class Form1
Dim numQuestions() As String
Dim questions() As String
Dim answersGroup() As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Label1.Text = ""
Label2.Text = ""
Label3.Text = ""
Main()
End Sub
Private Sub Main()
Dim p As New clsQuestions
p.Number = "1,2,3,4,5,6,7,8,9,10"
p.Question = "Question 1,Question 2,Question 3," &
"Question 4,Question 5,Question 6,Question 7," &
"Question 8,Question 9,Question 10"
p.Answer = "Answer 1.1,Answer 1.2,Answer 1.3,Answer 1.4;" &
"Answer 2.1,Answer 2.2,Answer 2.3,Answer 2.4;" &
"Answer 3.1,Answer 3.2,Answer 3.3,Answer 3.4;" &
"Answer 4.1,Answer 4.2,Answer 4.3,Answer 4.4;" &
"Answer 5.1,Answer 5.2,Answer 5.3,Answer 5.4;" &
"Answer 6.1,Answer 6.2,Answer 6.3,Answer 6.4;" &
"Answer 7.1,Answer 7.2,Answer 7.3,Answer 7.4;" &
"Answer 8.1,Answer 8.2,Answer 8.3,Answer 8.4;" &
"Answer 9.1,Answer 9.2,Answer 9.3,Answer 9.4;" &
"Answer 10.1,Answer 10.2,Answer 10.3,Answer 10.4"
'Serialize object to a text file.
Dim objStreamWriter As New StreamWriter("C:\Users\Username\Documents\Questions.xml")
Dim x As New XmlSerializer(p.GetType)
x.Serialize(objStreamWriter, p)
objStreamWriter.Close()
'Deserialize text file to a new object.
Dim objStreamReader As New StreamReader("C:\Users\Username\Documents\Questions.xml")
Dim p2 As New clsQuestions
p2 = x.Deserialize(objStreamReader)
objStreamReader.Close()
numQuestions = p2.Number.Split(",")
questions = p2.Question.Split(",")
answersGroup = p2.Answer.Split(";")
End Sub
Private Sub btnNext_Click(sender As Object, e As EventArgs) Handles btnNext.Click
Static x As Integer
If x <= questions.Length - 1 Then
Label1.Text = ""
Label2.Text = ""
Label3.Text = ""
arrayIndex(x)
x += 1
End If
End Sub
Private Sub arrayIndex(ByVal num As Integer)
Label1.Text = numQuestions(num)
Label2.Text = questions(num)
Dim answers() As String
answers = answersGroup(num).Split(",")
For Each item As String In answers
Label3.Text &= item & Environment.NewLine
Next
End Sub
End Class
I'm making a hangman game in VB.Net and everything's going smooth except one thing.
I have a problem. Let me first explain.
You start the game, you press the button so it can generate a random word in form of "?" Then you press the keys built in the program. When you press a correct key, the "?" turns into the key you pressed. Yeah you know how hangman works.
Anyway, when i've guessed all the keys correct, i want it to tell me it was correct and randomly generate next word without pressing the "generate button"
Here's the code i wrote:
If Korrekt_Gissat = antal Then
MsgBox("Nice, " & HemligaOrdet & " is correct.")
Reset()
End If
Full code:
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim i As Integer
i = 0
'Tangentbordet
For Each ctrl In Controls
If ctrl.tag = "Tangentbordet" Then
ctrl.text() = Chr(90 - i)
i = i + 1
End If
Next
'Slumporden
Ordlistan(0) = "Zed"
Ordlistan(1) = "Ahri"
Ordlistan(2) = "Udyr"
Ordlistan(3) = "Ekko"
Ordlistan(4) = "Shen"
Ordlistan(5) = "Jinx"
Ordlistan(6) = "Draven"
Ordlistan(7) = "Thresh"
Ordlistan(8) = "Yasuo"
Ordlistan(9) = "Kassadin"
End Sub
Private Sub cmdSlumpa_Ord()
Dim slumptal As Integer
'Slumpa orden till textrutan
slumptal = Int((10 * Rnd()) + 1)
HemligaOrdet = Ordlistan(slumptal)
' TextBoxSlump.Text = HemligaOrdetu
If HemligaOrdet = "Zed" Then
PictureChampions.Image = My.Resources.Zed
End If
If HemligaOrdet = "Ahri" Then
PictureChampions.Image = My.Resources.ahri
End If
If HemligaOrdet = "Udyr" Then
PictureChampions.Image = My.Resources.Udyr
End If
If HemligaOrdet = "Ekko" Then
PictureChampions.Image = My.Resources.ekko
End If
If HemligaOrdet = "Shen" Then
PictureChampions.Image = My.Resources.shen
End If
If HemligaOrdet = "Jinx" Then
PictureChampions.Image = My.Resources.Jinx
End If
If HemligaOrdet = "Draven" Then
PictureChampions.Image = My.Resources.Draven
End If
If HemligaOrdet = "Thresh" Then
PictureChampions.Image = My.Resources.Thresh
End If
If HemligaOrdet = "Yasuo" Then
PictureChampions.Image = My.Resources.yasuo
End If
If HemligaOrdet = "Kassadin" Then
PictureChampions.Image = My.Resources.Kassadin
End If
Skapamall()
End Sub
Private Sub btnSlumpa_Click(sender As Object, e As EventArgs) Handles btnSlumpa.Click
cmdSlumpa_Ord()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click, MyBase.Click, Button9.Click, Button8.Click, Button7.Click, Button6.Click, Button5.Click, Button4.Click, Button3.Click, Button29.Click, Button28.Click, Button27.Click, Button26.Click, Button25.Click, Button24.Click, Button23.Click, Button22.Click, Button21.Click, Button20.Click, Button2.Click, Button19.Click, Button18.Click, Button17.Click, Button16.Click, Button15.Click, Button14.Click, Button13.Click, Button12.Click, Button11.Click, Button10.Click
Dim tecken As String
Korrekt_Gissat = False
For position = 1 To HemligaOrdet.Length
tecken = Mid(HemligaOrdet, position, 1)
If UCase(tecken) = sender.text Then
Korrekt_Gissat = True
Mid(Mallen, position, 1) = tecken
TextBox2.Text = Mallen
End If
Next
If Korrekt_Gissat = True Then
Dim btn As Button = DirectCast(sender, Button)
btn.Enabled = False
End If
If Korrekt_Gissat = False Then
AntalFel = AntalFel + 1
Bestraffa()
End If
If Korrekt_Gissat = antal Then
MsgBox("Nice, " & HemligaOrdet & " is correct.")
Reset()
End If
If AntalFel = 8 Then
MsgBox("You lost!")
End
End If
End Sub
Private Sub Bestraffa()
If AntalFel = 1 Then
PicturePenality.Image = My.Resources._1
End If
If AntalFel = 2 Then
PicturePenality.Image = My.Resources._2
End If
If AntalFel = 3 Then
PicturePenality.Image = My.Resources._3
End If
If AntalFel = 4 Then
PicturePenality.Image = My.Resources._4
End If
If AntalFel = 5 Then
PicturePenality.Image = My.Resources._5
End If
If AntalFel = 6 Then
PicturePenality.Image = My.Resources._6
End If
If AntalFel = 7 Then
PicturePenality.Image = My.Resources._7
End If
If AntalFel = 8 Then
PicturePenality.Image = My.Resources._8
End If
End Sub
Private Sub Skapamall()
Mallen = ""
antal = HemligaOrdet.Length
For i = 1 To antal
Mallen = Mallen + "?"
Next i
TextBox2.Text = Mallen
End Sub
End Class
Module:
Module Module1
Public Ordlistan(0 To 9) As String
Public HemligaOrdet As String
Public Mallen As String
Public antal As Integer
Public Korrekt_Gissat As Boolean
Public AntalFel As Integer
End Module
If Korrekt_Gissat = antal Then
This is comparing a Boolean (Korret_Gissat) with an Integer (antal). This is usually a bad idea. Instead, check for a win in the code that checks for a correct guess. (No one could ever win on a turn with an incorrect guess, right?)
If Korrekt_Gissat = True Then
Dim btn As Button = DirectCast(sender, Button)
btn.Enabled = False
If InStr(Mallen, "?") = 0 Then
MsgBox("Congratulations, you won!")
'any code you want to call to end or reset the game
End If
End If
Edit: Alternate Method
Per your request below, here is another way of checking for a win. This method uses a designated function to perform the check and a For loop instead of InStr.
First, create the new function within Module1:
Public Function CheckForWin() As Boolean
For i As Integer = 0 To Mallen.Length -1
If Mid(Mallen, i, 1) = "?" Then
Return False
End If
Next
'This point can only be reached if no instance of "?" was found
Return True
End Function
Next, call the function from your code (where in the first version I used InStr).
If Korrekt_Gissat = True Then
Dim btn As Button = DirectCast(sender, Button)
btn.Enabled = False
If CheckForWin() Then
MsgBox("Congratulations, you won!")
'any code you want to call to end or reset the game
End If
End If
Imports System.Windows.Threading
Imports System.Threading
Imports System.Net
Imports System.Drawing
Imports System.IO
Imports Microsoft.Win32
Class Window1
#Region "Fields"
Private geoDoc As XDocument
Private location As String
Private zoom As Integer
Private saveDialog As New SaveFileDialog
Private mapType As String
Private lat As Double
Private lng As Double
#End Region
Private Sub GetGeocodeData()
Dim geocodeURL As String = "http://maps.googleapis.com/maps/api/" & _
"geocode/xml?address=" & location & "&sensor=false"
Try
geoDoc = XDocument.Load(geocodeURL)
Catch ex As WebException
Me.Dispatcher.BeginInvoke(New ThreadStart(AddressOf HideProgressBar), _
DispatcherPriority.Normal, Nothing)
MessageBox.Show("Ensure that internet connection is available.", _
"Map App", MessageBoxButton.OK, MessageBoxImage.Error)
Exit Sub
End Try
Me.Dispatcher.BeginInvoke(New ThreadStart(AddressOf ShowGeocodeData), _
DispatcherPriority.Normal, Nothing)
End Sub
Private Sub ShowGeocodeData()
Dim responseStatus = geoDoc...<status>.Single.Value()
If (responseStatus = "OK") Then
Dim formattedAddress = geoDoc...<formatted_address>(0).Value()
Dim latitude = geoDoc...<location>(0).Element("lat").Value()
Dim longitude = geoDoc...<location>(0).Element("lng").Value()
Dim locationType = geoDoc...<location_type>(0).Value()
AddressTxtBlck.Text = formattedAddress
LatitudeTxtBlck.Text = latitude
LongitudeTxtBlck.Text = longitude
Select Case locationType
Case "APPROXIMATE"
AccuracyTxtBlck.Text = "Approximate"
Case "ROOFTOP"
AccuracyTxtBlck.Text = "Precise"
Case Else
AccuracyTxtBlck.Text = "Approximate"
End Select
lat = Double.Parse(latitude)
lng = Double.Parse(longitude)
If (SaveButton.IsEnabled = False) Then
SaveButton.IsEnabled = True
RoadmapToggleButton.IsEnabled = True
TerrainToggleButton.IsEnabled = True
End If
ElseIf (responseStatus = "ZERO_RESULTS") Then
MessageBox.Show("Unable to show results for: " & vbCrLf & _
location, "Unknown Location", MessageBoxButton.OK, _
MessageBoxImage.Information)
DisplayXXXXXXs()
AddressTxtBox.SelectAll()
End If
ShowMapButton.IsEnabled = True
ZoomInButton.IsEnabled = True
ZoomOutButton.IsEnabled = True
MapProgressBar.Visibility = Windows.Visibility.Hidden
End Sub
' Get and display map image in Image ctrl.
Private Sub ShowMapImage()
Dim bmpImage As New BitmapImage()
Dim mapURL As String = "http://maps.googleapis.com/maps/api/staticmap?" & _
"size=500x400&markers=size:mid%7Ccolor:red%7C" & _
location & "&zoom=" & zoom & "&maptype=" & mapType & "&sensor=false"
bmpImage.BeginInit()
bmpImage.UriSource = New Uri(mapURL)
bmpImage.EndInit()
MapImage.Source = bmpImage
End Sub
Private Sub ShowMapUsingLatLng()
Dim bmpImage As New BitmapImage()
Dim mapURL As String = "http://maps.googleapis.com/maps/api/staticmap?" & _
"center=" & lat & "," & lng & "&" & _
"size=500x400&markers=size:mid%7Ccolor:red%7C" & _
location & "&zoom=" & zoom & "&maptype=" & mapType & "&sensor=false"
bmpImage.BeginInit()
bmpImage.UriSource = New Uri(mapURL)
bmpImage.EndInit()
MapImage.Source = bmpImage
End Sub
' Zoom-in on map.
Private Sub ZoomIn()
If (zoom < 21) Then
zoom += 1
ShowMapUsingLatLng()
If (ZoomOutButton.IsEnabled = False) Then
ZoomOutButton.IsEnabled = True
End If
Else
ZoomInButton.IsEnabled = False
End If
End Sub
' Zoom-out on map.
Private Sub ZoomOut()
If (zoom > 0) Then
zoom -= 1
ShowMapUsingLatLng()
If (ZoomInButton.IsEnabled = False) Then
ZoomInButton.IsEnabled = True
End If
Else
ZoomOutButton.IsEnabled = False
End If
End Sub
Private Sub SaveMap()
Dim mapURL As String = "http://maps.googleapis.com/maps/api/staticmap?" & _
"center=" & lat & "," & lng & "&" & _
"size=500x400&markers=size:mid%7Ccolor:red%7C" & _
location & "&zoom=" & zoom & "&maptype=" & mapType & "&sensor=false"
Dim webClient As New WebClient()
Try
Dim imageBytes() As Byte = webClient.DownloadData(mapURL)
Using ms As New MemoryStream(imageBytes)
Image.FromStream(ms).Save(saveDialog.FileName, Imaging.ImageFormat.Png)
End Using
Catch ex As WebException
MessageBox.Show("Unable to save map. Ensure that you are" & _
" connected to the internet.", "Error!", _
MessageBoxButton.OK, MessageBoxImage.Stop)
Exit Sub
End Try
End Sub
Private Sub MoveUp()
' Default zoom is 15 and at this level changing
' the center point is done by 0.003 degrees.
' Shifting the center point is done by higher values
' at zoom levels less than 15.
Dim diff As Double
Dim shift As Double
' Use 88 to avoid values beyond 90 degrees of lat.
If (lat < 88) Then
If (zoom = 15) Then
lat += 0.003
ElseIf (zoom > 15) Then
diff = zoom - 15
shift = ((15 - diff) * 0.003) / 15
lat += shift
Else
diff = 15 - zoom
shift = ((15 + diff) * 0.003) / 15
lat += shift
End If
ShowMapUsingLatLng()
Else
lat = 90
End If
End Sub
Private Sub MoveDown()
Dim diff As Double
Dim shift As Double
If (lat > -88) Then
If (zoom = 15) Then
lat -= 0.003
ElseIf (zoom > 15) Then
diff = zoom - 15
shift = ((15 - diff) * 0.003) / 15
lat -= shift
Else
diff = 15 - zoom
shift = ((15 + diff) * 0.003) / 15
lat -= shift
End If
ShowMapUsingLatLng()
Else
lat = -90
End If
End Sub
Private Sub MoveLeft()
Dim diff As Double
Dim shift As Double
' Use -178 to avoid negative values below -180.
If (lng > -178) Then
If (zoom = 15) Then
lng -= 0.003
ElseIf (zoom > 15) Then
diff = zoom - 15
shift = ((15 - diff) * 0.003) / 15
lng -= shift
Else
diff = 15 - zoom
shift = ((15 + diff) * 0.003) / 15
lng -= shift
End If
ShowMapUsingLatLng()
Else
lng = 180
End If
End Sub
Private Sub MoveRight()
Dim diff As Double
Dim shift As Double
If (lng < 178) Then
If (zoom = 15) Then
lng += 0.003
ElseIf (zoom > 15) Then
diff = zoom - 15
shift = ((15 - diff) * 0.003) / 15
lng += shift
Else
diff = 15 - zoom
shift = ((15 + diff) * 0.003) / 15
lng += shift
End If
ShowMapUsingLatLng()
Else
lng = -180
End If
End Sub
Private Sub DisplayXXXXXXs()
AddressTxtBlck.Text = "XXXXXXXXX, XXXXX, XXXXXX"
LatitudeTxtBlck.Text = "XXXXXXXXXX"
LongitudeTxtBlck.Text = "XXXXXXXXXX"
AccuracyTxtBlck.Text = "XXXXXXXXX"
End Sub
Private Sub HideProgressBar()
MapProgressBar.Visibility = Windows.Visibility.Hidden
ShowMapButton.IsEnabled = True
End Sub
' ShowMapButton click event handler.
Private Sub ShowMapButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles ShowMapButton.Click
If (AddressTxtBox.Text <> String.Empty) Then
location = AddressTxtBox.Text.Replace(" ", "+")
zoom = 15
mapType = "roadmap"
Dim geoThread As New Thread(AddressOf GetGeocodeData)
geoThread.Start()
ShowMapImage()
AddressTxtBox.SelectAll()
ShowMapButton.IsEnabled = False
MapProgressBar.Visibility = Windows.Visibility.Visible
If (RoadmapToggleButton.IsChecked = False) Then
RoadmapToggleButton.IsChecked = True
TerrainToggleButton.IsChecked = False
End If
Else
MessageBox.Show("Enter location address.", _
"Map App", MessageBoxButton.OK, MessageBoxImage.Exclamation)
AddressTxtBox.Focus()
End If
End Sub
' SaveFileDialog FileOk event handler.
Private Sub saveDialog_FileOk(ByVal sender As Object, ByVal e As EventArgs)
Dim td As New Thread(AddressOf SaveMap)
td.Start()
End Sub
' ZoomInButton click event handler.
Private Sub ZoomInButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles ZoomInButton.Click
ZoomIn()
End Sub
' ZoomOutButton click event handler.
Private Sub ZoomOutButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles ZoomOutButton.Click
ZoomOut()
End Sub
' SaveButton click event handler.
Private Sub SaveButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles SaveButton.Click
saveDialog.ShowDialog()
End Sub
' RoadmapToggleButton Checked event handler.
Private Sub RoadmapToggleButton_Checked(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles RoadmapToggleButton.Checked
If (mapType <> "roadmap") Then
mapType = "roadmap"
ShowMapUsingLatLng()
TerrainToggleButton.IsChecked = False
End If
End Sub
' TerrainToggleButton Checked event handler.
Private Sub TerrainToggleButton_Checked(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles TerrainToggleButton.Checked
If (mapType <> "terrain") Then
mapType = "terrain"
ShowMapUsingLatLng()
RoadmapToggleButton.IsChecked = False
End If
End Sub
Private Sub MapImage_MouseLeftButtonUp(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles MapImage.MouseLeftButtonUp
If (location IsNot Nothing) Then
Dim gMapURL As String = "http://maps.google.com/maps?q=" & location
Process.Start("IExplore.exe", gMapURL)
End If
End Sub
Private Sub Window1_Loaded(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles Me.Loaded
AddressTxtBox.Focus()
With saveDialog
.DefaultExt = "png"
.Title = "Save Map Image"
.OverwritePrompt = True
.Filter = "(*.png)|*.png"
End With
AddHandler saveDialog.FileOk, AddressOf saveDialog_FileOk
End Sub
Private Sub MinimizeButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MinimizeButton.Click
Me.WindowState = Windows.WindowState.Minimized
End Sub
Private Sub CloseButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles CloseButton.Click
Me.Close()
End Sub
//ds
Private Sub BgndRectangle_MouseLeftButtonDown(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles BgndRectangle.MouseLeftButtonDown
Me.DragMove()
End Sub
//df
Private Sub MoveUpButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MoveUpButton.Click
MoveUp()
End Sub
//sdf
Private Sub MoveDownButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MoveDownButton.Click
MoveDown()
End Sub
Private Sub MoveLeftButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MoveLeftButton.Click
MoveLeft()
End Sub
Private Sub MoveRightButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MoveRightButton.Click
MoveRight()
End Sub
End Class
i have this class for searching through google maps.
how can i pass it a location so that on startup it can show the given location on the map?
The WPF form has a loaded event, you can add some code there to load your first map:
Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
ShowMapButton_Click(sender, e)
End Sub
In this case I hardcoded an address into the AddressTxtBox and called Show Map. You can add whatever code you need to set up the conditions for the first map.
If the question is "How do I pass information to a form to be used when it first load" that is a much shorter post!
I don't work a lot with WPF so I'm not up on naming conventions and best practices so keep that in mind... For example the called form would not be called MainWindow!
In Winforms a method like this could be used:
Public in_StartAddress As String = ""
Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If in_StartAddress.Length > 0 Then AddressTxtBox.Text = in_StartAddress
ShowMapButton_Click(sender, e)
End Sub
' calling routine on another form
Private Sub Button_Click(sender As Object, e As RoutedEventArgs)
Dim frm As New MainWindow
frm.in_StartAddress = "1600 Pensylvania Ave, Washington DC"
frm.Show()
frm = Nothing
End Sub
Look for posts on passing parameters to new forms/windows.