vb google maps specific location - vb.net

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.

Related

VB.NET MouseEventArgs for dynamiclly added controls

I'm currently trying to create a tower building tool, this is based on drag and drop functionality. I'm currently ready for the user to build his tower, but now I would also like to add the option that he can adjust his tower. This by dragging the added blocks so they swap position.
I'm currently using the flowlayoutpanel to arrange my added block's (groupboxes). These are newly created after each dragevent based on the input.
Public Class Form1
Private Sub BODY_ADD_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles _
BODY_ADD_CILINDER.MouseMove,
BODY_ADD_CONE_DOWN.MouseMove,
BODY_ADD_CONE_UP.MouseMove,
BODY_ADD_HEAD_DOWN.MouseMove,
BODY_ADD_HEAD_UP.MouseMove
' Initiate dragging.
Me.DoDragDrop(sender, DragDropEffects.Copy)
End Sub
Private Sub BODY_Arrange_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles _
BODY_LAYOUT_PANEL.MouseMove
' Initiate dragging.
Me.DoDragDrop(sender, DragDropEffects.Copy)
End Sub
Private Sub FlowLayoutPanel1_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles BODY_LAYOUT_PANEL.DragEnter
' Check the format of the data being dropped.
If (e.Data.GetDataPresent(GetType(PictureBox))) Then
' Display the copy cursor.
e.Effect = DragDropEffects.Copy
Else
' Display the no-drop cursor.
e.Effect = DragDropEffects.None
End If
End Sub
Private Sub BODY_LAYOUT_PANEL_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles BODY_LAYOUT_PANEL.DragDrop
Dim oPB = e.Data.GetData(GetType(PictureBox))
Dim oGB As New GroupBox
oGB.Name = "Test" & GET_BODY_ITEM_NO()
oGB.Visible = True
oGB.Width = 520
oGB.Height = 119
If oPB.name = BODY_ADD_CILINDER.Name Then
oGB.Text = "Cilinder" & GET_CILINDER_ITEM_NO()
BODY_LAYOUT_PANEL.Controls.Add(oGB)
FILL_CILINDER_GROUP_BOX(oGB)
ElseIf oPB.name = BODY_ADD_CONE_DOWN.Name Then
oGB.Text = "Cone down" & GET_BODY_ITEM_NO()
BODY_LAYOUT_PANEL.Controls.Add(oGB)
ElseIf oPB.name = BODY_ADD_CONE_UP.Name Then
oGB.Text = "Cone up" & GET_BODY_ITEM_NO()
BODY_LAYOUT_PANEL.Controls.Add(oGB)
ElseIf oPB.name = BODY_ADD_HEAD_DOWN.Name Then
oGB.Text = "Head down" & GET_HEAD_DOWN_ITEM_NO()
BODY_LAYOUT_PANEL.Controls.Add(oGB)
ElseIf oPB.name = BODY_ADD_HEAD_UP.Name Then
oGB.Text = "Head up" & GET_BODY_ITEM_NO()
BODY_LAYOUT_PANEL.Controls.Add(oGB)
End If
End Sub
Private Sub FILL_CILINDER_GROUP_BOX(ByVal oGB As GroupBox)
Dim oPB As New PictureBox
oPB.Dock = DockStyle.Left
oPB.SizeMode = PictureBoxSizeMode.StretchImage
oPB.Image = My.Resources.ResourceManager.GetObject("Cilinder")
oPB.Name = oGB.Name & "_PictureBox"
oGB.Controls.Add(oPB)
Dim oLBL1 As New Label
oLBL1.Name = oGB.Name & "_LABEL_HOOGTE"
oLBL1.Text = "Hoogte"
oLBL1.Location = New System.Drawing.Point(128, 25)
oLBL1.Width = 42
oGB.Controls.Add(oLBL1)
Dim oLBL2 As New Label
oLBL2.Name = oGB.Name & "_LABEL_DIKTE"
oLBL2.Text = "Dikte"
oLBL2.Location = New System.Drawing.Point(138, 52)
oLBL2.Width = 32
oGB.Controls.Add(oLBL2)
Dim oLBL3 As New Label
oLBL3.Name = oGB.Name & "_LABEL_ORIENTATIE"
oLBL3.Text = "Orientatie LW"
oLBL3.Location = New System.Drawing.Point(311, 25)
oLBL3.Width = 72
oGB.Controls.Add(oLBL3)
Dim oLBL4 As New Label
oLBL4.Name = oGB.Name & "_LABEL_SEGMENTEN"
oLBL4.Text = "Segmenten"
oLBL4.Location = New System.Drawing.Point(322, 52)
oLBL4.Width = 61
oGB.Controls.Add(oLBL4)
Dim oTB1 As New TextBox
oTB1.Name = oGB.Name & "_TB_HOOGTE"
oTB1.Location = New System.Drawing.Point(176, 22)
oGB.Controls.Add(oTB1)
Dim oTB2 As New TextBox
oTB2.Name = oGB.Name & "_TB_DIKTE"
oTB2.Location = New System.Drawing.Point(176, 49)
oGB.Controls.Add(oTB2)
Dim oTB3 As New TextBox
oTB3.Name = oGB.Name & "_TB_ORIENTATIE"
oTB3.Location = New System.Drawing.Point(389, 22)
oGB.Controls.Add(oTB3)
Dim oTB4 As New TextBox
oTB4.Name = oGB.Name & "_TB_SEGMENTEN"
oTB4.Location = New System.Drawing.Point(389, 45)
oGB.Controls.Add(oTB4)
End Sub
Private Function GET_BODY_ITEM_NO()
Return (BODY_LAYOUT_PANEL.Controls.Count)
End Function
Private Function GET_CILINDER_ITEM_NO()
Dim s As String
Dim y As Integer = 1
For i = 0 To BODY_LAYOUT_PANEL.Controls.Count - 1
s = BODY_LAYOUT_PANEL.Controls.Item(i).Text
If s.Contains("Cilinder") Then
y = y + 1
End If
Next
Return (y)
End Function
Private Function GET_HEAD_DOWN_ITEM_NO()
Dim s As String
Dim y As Integer = 1
For i = 0 To BODY_LAYOUT_PANEL.Controls.Count - 1
s = BODY_LAYOUT_PANEL.Controls.Item(i).Text
If s.Contains("Head down") Then
y = y + 1
End If
Next
Return (y)
End Function
End Class
For the rearranging part I would have to create a drag-event for the dynamically added groupboxes. How do you write this? How should I specify what to handle?
So the Question is: How do I hook the mouse-event to the dynamically added group-box control?
Private Sub BODY_REARRANGE_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles
Also if there are any comments on my sample code I could use some pointers!

How to automatically restart a program after it's closed

I'm developing a timer for my kids that will automatically shut down the computer once the time is up and I was trying to figure out a way that the program would automatically restart if it were to be closed via task manager.
I've posted my code for my program bellow if it's any help.
Imports System
Imports System.IO
Imports System.Text
Imports System.Collections.Generic
Public Class Digparent
'add to startupp:
' My.Computer.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True).SetValue(Application.ProductName, Application.ExecutablePath)
'remove from startup
'My.Computer.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True).DeleteValue(Application.ProductName)
'use application setting boolean to not add same application to startup more than once
'charge for this feature
'to do
'
'wrongn height when make timer unstopable
'above all
Dim X, Y As Integer
Dim NewPoint As New System.Drawing.Point
Public second As Integer
Public checkdone As Boolean
Public checkoff As Boolean
Public unstop As Boolean
Dim Mondayt As String
Dim Tuesdayt As String
Dim Wendsdayt As String
Dim Thursdayt As String
Dim Fridayt As String
Dim Saturdayt As String
Dim Sundayt As String
Private Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' //
' //
' //
' //Start reader
' //
Dim timeinfo As String = "C:\Users\DigiParent\Desktop\Project data\good.txt"
' IO.File.SetAttributes("C:\Users\DigiParent\Desktop\Project data\Digitimeinfo.txt", IO.FileAttributes.Hidden)
Dim timeChecker As New System.IO.StreamWriter(timeinfo, True)
timeChecker.Close()
Dim readertime As New System.IO.StreamReader(timeinfo, Encoding.Default)
Dim texttime As String = readertime.ReadToEnd
readertime.Close()
If texttime = "" Then
Dim timeobjWriter As New System.IO.StreamWriter(timeinfo, True)
timeobjWriter.Write(",,,,")
timeobjWriter.Close()
End If
Dim startup As String = "C:\Users\DigiParent\Desktop\Project data\good.txt"
Dim reader As New System.IO.StreamReader(startup, Encoding.Default)
Dim data As String = reader.ReadToEnd
Dim aryTextFile(6) As String
aryTextFile = data.Split(",")
Mondayt = aryTextFile(0)
Tuesdayt = aryTextFile(1)
Wendsdayt = aryTextFile(2)
Thursdayt = aryTextFile(3)
Fridayt = aryTextFile(4)
'
'enable this for saturday and sunday
'
'Saturdayt = aryTextFile(5)
'Sundayt = aryTextFile(6)
reader.Close()
' //
' //
' //Finish reader
' //
End Sub
Private Sub Panel2_MouseMove(sender As Object, e As MouseEventArgs) Handles Panel2.MouseMove, time.MouseMove, timeup.MouseMove
If unstop = True Then
If e.Button = Windows.Forms.MouseButtons.Left Then
NewPoint = Control.MousePosition
NewPoint.X -= (X)
NewPoint.Y -= (Y)
Me.Location = NewPoint
End If
End If
End Sub
Private Sub Panel2_MouseDown(sender As Object, e As MouseEventArgs) Handles Panel2.MouseDown, time.MouseDown, timeup.MouseDown
If unstop = True Then
X = Control.MousePosition.X - Me.Location.X
Y = Control.MousePosition.Y - Me.Location.Y
End If
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
NumericUpDownhrs.Left -= 40
NumericUpDownmin.Left -= 40
NumericUpDownsec.Left -= 29 '25
Hourstxt.Left -= 40
Minutestxt.Left -= 30
secondstxt.Left -= 30
Panel1.Left -= 30
RadioButton2.Left -= 30
RadioButton1.Left -= 30
Label4.Left -= 30
Label5.Left -= 30
Button4.Left -= 30
time.Left -= 30
timeup.Left -= 30
If RadioButton1.Location = RadioButton5.Location Then
Timer1.Stop()
Else
End If
If Me.Height < 265 Then
Me.Height = Me.Height + 1
End If
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
more.Visible = False
updateb.Visible = False
feedbackb.Visible = False
Timer1.Start()
Button1.Visible = False
End Sub
Private Sub RadioButton5_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton5.CheckedChanged
End Sub
Private Sub Button4_Click(snder As Object, e As EventArgs) Handles Button4.Click
My.Settings.Data = True
If RadioButton6.Checked = True Then
My.Settings.unstopable = True
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
Me.ShowInTaskbar = False
Me.ControlBox = False
Me.Text = ""
Me.ShowIcon = False
Me.ShowInTaskbar = False
Me.ControlBox = False
unstop = True
Me.Height = 149
Else
My.Settings.unstopable = False
End If
If RadioButton1.Checked = True Then
My.Settings.Shutdown = True
checkoff = True
' System.Diagnostics.Process.Start("ShutDown", "/s")
Else
My.Settings.Shutdown = False
End If
vhrs = NumericUpDownhrs.Value
vmin = NumericUpDownmin.Value
vsec = NumericUpDownsec.Value
My.Settings.hours = vhrs
My.Settings.min = vmin
My.Settings.second = vsec
PictureBox1.Dock = DockStyle.None
PictureBox1.Visible = False
starttime.Start()
realTimer.Start()
End Sub
Public Hrs As Integer 'number of hours '
Public Min As Integer 'number of Minutes '
Public Sec As Integer 'number of Sec '
Public Function GetTime(Time As Integer) As String
'Seconds'
Sec = Time Mod 60
'Minutes'
Min = ((Time - Sec) / 60) Mod 60
'Hours'
Hrs = ((Time - (Sec + (Min * 60))) / 3600) Mod 60
Return Format(Hrs, "00") & ":" & Format(Min, "00") & ":" & Format(Sec, "00")
End Function
Private Sub realTimer_Tick(sender As Object, e As EventArgs) Handles realTimer.Tick
second = second + 1
time.Text = GetTime(second)
'now
If Min >= vmin And Hrs >= vhrs And Sec >= vsec Then
checkdone = True
Me.TopMost = True
'Me.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
endtime.Start()
If unstop = True Then
closeb.Visible = True
End If
realTimer.Stop()
End If
If checkdone = True And checkoff = True Then
endtime.Start()
System.Diagnostics.Process.Start("ShutDown", "/s")
End If
End Sub
Private Sub starttime_Tick(sender As Object, e As EventArgs) Handles starttime.Tick
time.Left -= 30
Panel1.Left -= 30
RadioButton2.Left -= 30
RadioButton1.Left -= 30
Label4.Left -= 30
Label5.Left -= 30
Button4.Left -= 30
timeup.Left -= 30
If time.Location = Label2.Location Then
starttime.Stop()
End If
If Me.Height > 189 Then
Me.Height = Me.Height - 5
End If
End Sub
Private Sub endtime_Tick(sender As Object, e As EventArgs) Handles endtime.Tick
time.Left -= 30
timeup.Left -= 30
If timeup.Location = labeltimeup.Location Then
endtime.Stop()
End If
End Sub
Private Sub more_Click(sender As Object, e As EventArgs) Handles more.Click
Form3.Show()
'more.Visible = False
'moretimer.Start()
End Sub
Private Sub moretimer_Tick(sender As Object, e As EventArgs) Handles moretimer.Tick
If updateb.Location = Updatebutton.Location Then
moretimer.Stop()
End If
feedbackb.Left += 15
updateb.Left -= 15
End Sub
Private Sub updateb_Click(sender As Object, e As EventArgs) Handles updateb.Click
System.Diagnostics.Process.Start("http://digiparent.weebly.com/beta-20-update.html")
End Sub
Private Sub feedbackb_Click(sender As Object, e As EventArgs) Handles feedbackb.Click
System.Diagnostics.Process.Start("http://digiparent.weebly.com/feedback.html")
End Sub
Private Sub closeb_Click(sender As Object, e As EventArgs) Handles closeb.Click
Me.Close()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
NumericUpDownsec.Value = My.Settings.second
NumericUpDownmin.Value = My.Settings.min
NumericUpDownhrs.Value = My.Settings.hours
If My.Settings.Shutdown = True Then
RadioButton1.Checked = True
End If
If My.Settings.unstopable = True Then
RadioButton6.Checked = True
End If
Button2.Visible = False
End Sub
Private Sub Numericchanged(sender As Object, e As EventArgs) Handles NumericUpDownsec.ValueChanged, NumericUpDownmin.ValueChanged, NumericUpDownhrs.ValueChanged
If NumericUpDownsec.Value = 0 Then ' NumericUpDownhrs.Value = 0 NumericUpDownmin.Value = 0 Then
If NumericUpDownhrs.Value = 0 Then
If NumericUpDownmin.Value = 0 Then
Button2.Visible = True
Else
Button2.Visible = False
End If
Else
Button2.Visible = False
End If
Else
Button2.Visible = False
End If
End Sub
Private Sub Label4_Click(sender As Object, e As EventArgs) Handles Label4.Click
End Sub
End Class
Here's a very basic windowless watchdog app.
Start with a standard WinForms project.
Add a Module.
Add a Public Sub Main to it.
Go to Project --> Properties --> Application Tab, and Uncheck the "Enable Application Framework" box.
Above that, change the "Startup object:" dropdown from "Form1" to "Sub Main".
The code...
Module Module1
Public Sub Main()
Application.Run(New Watchdog)
End Sub
End Module
Public Class Watchdog
Inherits ApplicationContext
Private AppToWatch As String
Private FullPath As String = "C:\WINDOWS\system32\calc.exe"
Private WithEvents P As Process
Public Sub New()
AppToWatch = System.IO.Path.GetFileNameWithoutExtension(FullPath)
Dim PS() As Process = Process.GetProcessesByName(AppToWatch)
If PS.Length = 0 Then
StartIt()
Else
P = PS(0)
P.EnableRaisingEvents = True
End If
End Sub
Private Sub P_Exited(sender As Object, e As EventArgs) Handles P.Exited
StartIt()
End Sub
Private Sub StartIt()
P = Process.Start(FullPath)
P.EnableRaisingEvents = True
End Sub
End Class
Compile the program as a service, and configure it to start automatically.

Resizing drawn rectangle on Picturebox relative to image using Zoom

I have a Picturebox that I can draw a rectangle on and I have it so that the rectangle dimensions, in percent, are logged so that if the size of the form changes, then so does the rectangle size (see code below the text)
However, when I have the Picturebox in "Zoom" mode, the rectangle does not match up when resizing (see here: First one, with corners on defined points on image http://i1262.photobucket.com/albums/ii602/bmgh85/Size1.png and then second one after resizing the form http://i1262.photobucket.com/albums/ii602/bmgh85/Size2.png
It works fine in "Stretch" mode, but that skews the images, which is no use to me (I need to keep the proportions). How can I manipulate my code to get it to work as intended?
Private x, y As Integer
Private Rct As New Rectangle(0, 0, 0, 0)
Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
x = e.X
y = e.Y
End If
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
Rct.X = Math.Min(x, e.X)
Rct.Y = Math.Min(y, e.Y)
Rct.Height = Math.Abs(e.Y - y)
Rct.Width = Math.Abs(e.X - x)
PictureBox1.Refresh()
PictureBox1.Tag = calculatePercent(Rct.X, Rct.Y, Rct.Height, Rct.Width, PictureBox1)
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
MsgBox(PictureBox1.Tag)
Dim lst1 As List(Of Int32) = returnPercent(PictureBox1.Tag)
For i = 0 To lst1.Count - 1
MsgBox(lst1(i))
Next
End Sub
Private Sub PictureBox1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
e.Graphics.DrawRectangle(Pens.Red, Rct)
End Sub
Function calculatePercent(ByVal X As Long, Y As Long, Ht As Long, Wth As Long, pBox As PictureBox)
Dim wPercent As Long = 100 * Wth / pBox.Width
Dim hPercent As Long = 100 * Ht / pBox.Height
Dim yPercent As Long = 100 * Y / pBox.Height
Dim xPercent As Long = 100 * X / pBox.Width
Return "X:" & xPercent & ", Y:" & yPercent & ", Ht:" & hPercent & ", Wth:" & wPercent
End Function
Function returnPercent(ByVal myTag As String)
Dim lst As New List(Of Int32)
Dim getX As String = getNum(Mid(myTag, InStr(myTag, "X:"), InStr(myTag, ", Y:") - InStr(myTag, "X:")))
Dim getY As String = getNum(Mid(myTag, InStr(myTag, ", Y:"), InStr(myTag, ", Ht:") - InStr(myTag, ", Y:")))
Dim getH As String = getNum(Mid(myTag, InStr(myTag, ", Ht:"), InStr(myTag, ", Wth:") - InStr(myTag, ", Ht:")))
Dim getW As String = getNum(Mid(myTag, InStr(myTag, ", Wth:")))
lst.Add(getX)
lst.Add(getY)
lst.Add(getH)
lst.Add(getW)
Return lst
End Function
Function getNum(ByVal txt As String)
Dim rtn As String = vbNullString
Dim coln As MatchCollection = Regex.Matches(txt, "\d+")
For Each mtch As Match In coln
rtn = rtn & mtch.ToString
Next
Return Convert.ToInt32(rtn)
End Function
Private Sub PictureBox1_SizeChanged(sender As Object, e As EventArgs) Handles PictureBox1.SizeChanged
Dim lst As New List(Of Int32)
If PictureBox1.Tag <> "" Then
lst = returnPercent(PictureBox1.Tag)
Rct.X = lst(0) * PictureBox1.Width / 100
Rct.Y = lst(1) * PictureBox1.Height / 100
Rct.Height = lst(2) * PictureBox1.Height / 100
Rct.Width = lst(3) * PictureBox1.Width / 100
PictureBox1.Refresh()
End If
End Sub
I have some code that might help you:
' Rectangle to draw
Private Rct As New Rectangle(0, 0, 0, 0)
Private offsetX As Integer = 0
Private offsetY As Integer = 0
Sub Main() Handles MyBase.Load
' Some image to use
MiniPictureBox.Image = My.Resources.P6130003
MainPictureBox.Image = My.Resources.P6130003
End Sub
Private Sub MiniPictureBox_MouseDown(sender As Object, e As MouseEventArgs) Handles MiniPictureBox.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
If Not Rct.Contains(e.Location) Then
' New rectangle
Rct.Location = New Point(e.X, e.Y)
Else
' Moving a rectangle
offsetX = Rct.X - e.X
offsetY = Rct.Y - e.Y
End If
ElseIf e.Button = Windows.Forms.MouseButtons.Right Then
' Clears the screen of a rectangle
Rct = New Rectangle(0, 0, 0, 0)
MiniPictureBox.Invalidate()
End If
End Sub
Private Sub MiniPictureBox_MouseMove(sender As Object, e As MouseEventArgs) Handles MiniPictureBox.MouseMove
' Event handler to update the picture of the rectangle
If e.Button = Windows.Forms.MouseButtons.Left Then
If Rct.Contains(e.Location) Then
' Move the box
Rct.X = e.X + offsetX
Rct.Y = e.Y + offsetY
MainPictureBox.Invalidate()
Else
' Update the size of the box
Rct.Width = e.X - Rct.X
Rct.Height = e.Y - Rct.Y
End If
MiniPictureBox.Invalidate()
End If
End Sub
Private Sub MiniPictureBox_MouseUp(sender As Object, e As MouseEventArgs) Handles MiniPictureBox.MouseUp
' Event handler to call the paint event for runtime display
MiniPictureBox.Invalidate()
MainPictureBox.Invalidate()
End Sub
Private Sub MiniPictureBox_Paint(sender As Object, e As PaintEventArgs) Handles MiniPictureBox.Paint
Dim myPen As Pen = New Pen(Brushes.Red, 2)
e.Graphics.DrawRectangle(myPen, Rct)
End Sub
Private Sub MainPictureBox_Paint(sender As Object, e As PaintEventArgs) Handles MainPictureBox.Paint
If Rct.Width > 0 Then
Dim biggerRec As Rectangle = CalculateRectangle(MainPictureBox)
Dim myPen As Pen = New Pen(Brushes.Red, 2)
e.Graphics.DrawRectangle(myPen, biggerRec)
End If
End Sub
Private Function CalculateRectangle(currentPicture As PictureBox) As Rectangle
Try
Dim newWidth As Integer = (Rct.Width / MiniPictureBox.Width) * currentPicture.Image.Width
Dim newHeight As Integer = (Rct.Height / MiniPictureBox.Height) * currentPicture.Image.Height
Dim newX As Integer = (Rct.X / MiniPictureBox.Width) * currentPicture.Image.Width
Dim newY As Integer = (Rct.Y / MiniPictureBox.Height) * currentPicture.Image.Height
Return New Rectangle(newX, newY, newWidth, newHeight)
Catch ex As Exception
MessageBox.Show(ex.Message + Environment.NewLine + Environment.NewLine + ex.StackTrace)
End Try
End Function
This code will allow you to create, move, and clear a rectangle. One point of caution is in the calculations for changing the size of the rectangle, you have to ensure exception handling is properly inserted for any arithmetic exceptions.

code modified lines added

I have data like this
date value
24sep2014 2:23:01 0.1
24sep2014 2:23:02 0.3
24sep2014 2:23:03 0.2
24sep2014 2:23:04 0.3
These are not coma seprated value. I wanted to write in CSV file. Apend the value for next row.
1)How to open file only once here. when it run next time file name has to change to other name
2) How to append the next values
Imports System
Imports System.IO.Ports
Imports System.ComponentModel
Imports System.Threading
Imports System.Drawing
Imports System.Windows.Forms.DataVisualization.Charting
Public Class Form1
Dim myPort As Array
Dim Distance As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
myPort = IO.Ports.SerialPort.GetPortNames()
PortComboBox.Items.AddRange(myPort)
BaudComboBox.Items.Add(9600)
BaudComboBox.Items.Add(19200)
BaudComboBox.Items.Add(38400)
BaudComboBox.Items.Add(57600)
BaudComboBox.Items.Add(115200)
ConnectButton.Enabled = True
DisconnectButton.Enabled = False
Chart1.Series.Clear()
Chart1.Titles.Add("Demo")
'Create a new series and add data points to it.
Dim s As New Series
s.Name = "CURRENT"
s.ChartType = SeriesChartType.Line
End Sub
Private Sub ConnectButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ConnectButton.Click
SerialPort1.PortName = PortComboBox.Text
SerialPort1.BaudRate = BaudComboBox.Text
SerialPort1.Open()
Timer1.Start()
Timer2.Start()
'lblMessage.Text = PortComboBox.Text & " Connected."
ConnectButton.Enabled = False
DisconnectButton.Enabled = True
End Sub
Private Sub DisconnectButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DisconnectButton.Click
SerialPort1.Close()
DisconnectButton.Enabled = False
ConnectButton.Enabled = True
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Dim counter As Integer
counter = 0
Try
SerialPort1.Write("c")
System.Threading.Thread.Sleep(250)
Dim k As Double
Dim distance As String = SerialPort1.ReadLine()
k = CDbl(distance)
ListBoxSensor.Text = k
Dim s As New Series
s.Points.AddXY(1000, k)
Chart1.Series.Add(s)
Dim headerText = ""
Dim csvFile As String = Path.Combine(My.Application.Info.DirectoryPath, "Current.csv")
If Not File.Exists(csvFile)) Then
headerText = "Date& time ,Current"
End If
Using outFile = My.Computer.FileSystem.OpenTextFileWriter(csvFile, True)
If headerText.Length > 0 Then
outFile.WriteLine(headerText)
End If
Dim y As String = DateAndTime.Now
Dim x As String = y + "," + distance
outFile.WriteLine(x)
End Using
Catch ex As Exception
End Try
End Sub
Private Sub Relay_ON_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Relay_ON.Click
SerialPort1.Write("1")
End Sub
Private Sub Relay_Off_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Relay_Off.Click
SerialPort1.Write("0")
End Sub
End Class
Here i am opening file again and again. that reason i can store only one value
# steve error
The second parameter of OpenTextFileWriter allows to append instead of overwrite your file.
So it is simply a matter to check if the file exists (so you insert the header names) and then write your data
Dim headerText = ""
Dim csvFile As String = Path.Combine(My.Application.Info.DirectoryPath, "Current.csv")
If Not File.Exists(csvFile) Then
headerText = "Date& time ,Current"
End If
Using outFile = My.Computer.FileSystem.OpenTextFileWriter(csvFile, True)
If headerText.Length > 0 Then
outFile.WriteLine(headerText)
End If
Dim y As String = DateAndTime.Now
Dim x As String = y + "," + distance
outFile.WriteLine(x)
End Using
Notice the Using Statement to be sure to close and dispose the file resource also in case of exceptions.
However given the simple text that need to be written you could also choose to use the method WriteAllText
Dim headerText = ""
Dim csvFile As String = Path.Combine(My.Application.Info.DirectoryPath, "Current.csv")
If Not File.Exists(csvFile) Then
headerText = "Date& time ,Current" & Environment.NewLine
End If
Dim y As String = DateAndTime.Now
Dim x As String = headerText & y & "," + distance & Environment.NewLine
My.Computer.FileSystem.WriteAllText(csvFile, x, True)

Visual Basic - Calculator II coding dilemmas

Here is an assignment I was issued in Computer Science I [Visual Basic 2010]
Objective:
Modify the CalculatorII case study to display "ERROR" if a division by 0 is attempted. "ERROR should also be displayed if more than one decimal points are entered for a single number.
I can't get the ERROR message to show up when I divide by zero or add more decimal points. Here's what I have in coding:
Public Class Form1
Dim operand1 As Double = 0
Dim operand2 As Double = 0
Dim op As String = Nothing
Dim newOperand As Boolean = True
Private Sub Number_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles _
btnDot.Click, btn0.Click, btn1.Click, btn2.Click, btn3.Click, btn4.Click, btn5.Click, _
btn6.Click, btn7.Click, btn8.Click, btn9.Click
Dim btnNumberClicked As Button = sender
If newOperand Then
Me.txtDisplay.Text = btnNumberClicked.Tag
newOperand = False
Else
Me.txtDisplay.Text &= btnNumberClicked.Tag
End If
End Sub
Private Sub btnClear_Click(ByVal sender As Object, ByVal e As System.EventArgs) _
Handles btnClear.Click
Me.txtDisplay.Text = "0"
operand1 = 0
operand2 = 0
newOperand = True
op = Nothing
End Sub
Private Sub btnOff_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles _
btnOff.Click
Application.Exit()
End Sub
Private Sub btnOperator_Click(ByVal sender As Object, ByVal e As System.EventArgs) _
Handles btnPlus.Click, btnMinus.Click, btnTimes.Click, btnDivide.Click, btnEqual.Click, btnIntDivide.Click
Dim operatorSelected As Button = sender
If (operand1 = 0 And op = Nothing) Or op = "=" Then
operand1 = Val(Me.txtDisplay.Text)
ElseIf (operand1 = 0 And op = "/") Then
MessageBox.Show("ERROR")
Else
operand2 = Val(Me.txtDisplay.Text)
operand1 = Calculate(operand1, operand2, op)
Me.txtDisplay.Text = operand1
End If
op = operatorSelected.Tag
newOperand = True
End Sub
Function Calculate(ByVal firstOperand As Double, ByVal secondOperand As Double, _
ByVal op As String) As Double
Select Case op
Case "+"
Return (firstOperand + secondOperand)
Case "-"
Return (firstOperand - secondOperand)
Case "X"
Return (firstOperand * secondOperand)
Case "/"
Return (firstOperand / secondOperand)
Case "\"
End Select
End Function
End Classenter code here
Operand 2 has to be the error-field, you just check if the first operand is 0
change
"ElseIf (operand1 = 0 And op = "/") Then
to ElseIf (operand2 = 0 And op = "/") Then
Give it a try :)