📄 frm_alert.vb
字号:
Me.Label9.Name = "Label9"
Me.Label9.Size = New System.Drawing.Size(104, 16)
Me.Label9.TabIndex = 17
'
'DataGrid1
'
Me.DataGrid1.BackgroundColor = System.Drawing.SystemColors.Info
Me.DataGrid1.DataMember = ""
Me.DataGrid1.HeaderForeColor = System.Drawing.SystemColors.ControlText
Me.DataGrid1.Location = New System.Drawing.Point(160, 208)
Me.DataGrid1.Name = "DataGrid1"
Me.DataGrid1.Size = New System.Drawing.Size(248, 136)
Me.DataGrid1.TabIndex = 18
'
'Timer1
'
Me.Timer1.Enabled = True
Me.Timer1.Interval = 1000
'
'frm_alert
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.BackColor = System.Drawing.SystemColors.InactiveCaptionText
Me.ClientSize = New System.Drawing.Size(418, 352)
Me.Controls.Add(Me.DataGrid1)
Me.Controls.Add(Me.Label9)
Me.Controls.Add(Me.Label8)
Me.Controls.Add(Me.Label7)
Me.Controls.Add(Me.TextBox6)
Me.Controls.Add(Me.TextBox5)
Me.Controls.Add(Me.TextBox4)
Me.Controls.Add(Me.TextBox3)
Me.Controls.Add(Me.TextBox2)
Me.Controls.Add(Me.TextBox1)
Me.Controls.Add(Me.Label6)
Me.Controls.Add(Me.Label5)
Me.Controls.Add(Me.Label4)
Me.Controls.Add(Me.Label3)
Me.Controls.Add(Me.Label2)
Me.Controls.Add(Me.GroupBox1)
Me.Controls.Add(Me.PictureBox1)
Me.Controls.Add(Me.Label1)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.MaximizeBox = False
Me.MinimizeBox = False
Me.Name = "frm_alert"
Me.Text = "PrisLogix's PIS"
Me.GroupBox1.ResumeLayout(False)
CType(Me.DataGrid1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
#End Region
#Region "CODE STARTS HERE"
Function insertin()
MyConnection.Open()
MyCommand = New OleDbCommand("INSERT INTO patalerts VALUES ('" & TextBox1.Text & "', '" & TextBox2.Text & "', '" & TextBox3.Text & "', '" & TextBox4.Text & "', '" & TextBox5.Text & "')", MyConnection)
MyCommand.ExecuteNonQuery()
MyConnection.Close()
MyCommand.dispose()
End Function
Function clearfields()
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
End Function
Function saveothers()
Dim filepath As String = " C:\" + TextBox1.Text + ".txt"
Try
Dim oFile As FileStream = New FileStream(filepath, FileMode.OpenOrCreate, FileAccess.Write)
Dim oStream As StreamWriter = New StreamWriter(oFile)
oStream.Write(TextBox6.Text)
oStream.Flush()
oStream.Close()
oFile.Close()
Catch e As Exception
MsgBox(e.ToString)
End Try
End Function
Function loadothers()
Dim myStreamReader As StreamReader = New StreamReader( _
New FileStream("C:\somefile.txt", FileMode.Open), _
System.Text.Encoding.Unicode, False, 4096)
Dim cBuffer() As Char
ReDim cBuffer(4096)
Do While myStreamReader.ReadBlock(cBuffer, 0, cBuffer.Length - 1) > 0
'Buffer filled and available for use
TextBox6.Text = cBuffer
Loop
myStreamReader.Close()
End Function
Function updatealerts()
MyConnection.Open()
Dim ww As String = "UPDATE patalerts SET patname ='" & TextBox2.Text & "',patalert ='" & TextBox3.Text & "', patdoc ='" & TextBox4.Text & "', patclinic ='" & TextBox5.Text & "' WHERE patcode ='" & TextBox1.Text & "' "
MyCommand = New OleDbCommand(ww, MyConnection)
MyCommand.ExecuteNonQuery()
MyConnection.Close()
MyCommand.dispose()
End Function
Function fillform()
MyConnection.Open()
MyCommand = New OleDbCommand("SELECT * FROM patalerts WHERE patcode ='" & TextBox1.Text & "'", MyConnection)
MyReader = MyCommand.ExecuteReader()
While MyReader.Read
TextBox2.Text = MyReader("patname")
TextBox3.Text = MyReader("patalert")
TextBox4.Text = MyReader("patdoc")
TextBox5.Text = MyReader("patclinic")
End While
MyConnection.Close()
MyReader.Close()
MyCommand.dispose()
End Function
Function checkid() As Integer
If TextBox1.Text.StartsWith("pat-0") = True Then
Return 1
ElseIf TextBox1.Text = "" Then
Return 2
Else
Return 0
End If
End Function
Private Sub frm_alert_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
dbset.Clear()
MyConnection.Open()
MyCommand = New OleDbCommand("Select * FROM patalerts", MyConnection)
dataA = New OleDbDataAdapter(MyCommand)
dataA.Fill(dbset, "patalerts")
DataGrid1.ReadOnly = True
DataGrid1.DataSource = dbset.Tables("patalerts")
MyConnection.Close()
MyCommand.Dispose()
dataA.Dispose()
dbset.Dispose()
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Label8.Text = CurrentTime.Now().ToShortTimeString
Label9.Text = CurrentDate.Now().ToShortDateString
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Me.Close()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
insertin()
saveothers()
End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
clearfields()
End Sub
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
updatealerts()
Button2.Visible = True
MsgBox("Patient has been updated", MsgBoxStyle.Information, "PrisLogix's PIS")
End Sub
Private Sub Button2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button2.Click
If checkid() = 2 Then
MsgBox("please enter in the patient id", MsgBoxStyle.Information, "PrisLogix's PIS")
ElseIf checkid() = 0 Then
MsgBox("please enter the correct id", MsgBoxStyle.Information, "PrisLogix's PIS")
Else
Button5.Visible = True
Button2.Visible = False
fillform()
End If
End Sub
#End Region
#Region "GLOW CODE"
Private Sub MouseEnterEvent(ByVal sender As Object, ByVal e As System.EventArgs) _
Handles Button1.MouseEnter, Button2.MouseEnter, Button3.MouseEnter, Button4.MouseEnter, Button5.MouseEnter
' A simple event handler that fires when the user's mouse arrow rolls
' over any of the buttons. It passes the button's identity to the Glow sub.
Dim ctrl As Control = CType(sender, Control)
Glow(ctrl, True)
End Sub
Private Sub MouseLeaveEvent(ByVal sender As Object, ByVal e As System.EventArgs) _
Handles Button1.MouseLeave, Button2.MouseLeave, Button3.MouseLeave, Button4.MouseLeave, Button5.MouseLeave
' A simple event handler that fires when the user's mouse arrow leaves the
' area of any of the buttons. It passes the button's identity to the Glow sub.
Dim ctrl As Control = CType(sender, Control)
Glow(ctrl, False)
End Sub
Private Sub Glow(ByVal ctrl As Control, ByVal Hovering As Boolean)
Dim Sb_R, Sb_G, Sb_B As Int16 ' <--- RGB values for the starting backcolor
Dim Sf_R, Sf_G, Sf_B As Int16 ' <--- RGB values for the starting forecolor
Dim Eb_R, Eb_G, Eb_B As Int16 ' <--- RGB values for the ending backcolor
Dim Ef_R, Ef_G, Ef_B As Int16 ' <--- RGB values for the ending forecolor
Select Case Hovering ' True for MouseEnter, False for MouseLeave
Case True
Sb_R = SystemColors.Control.R ' Assign the variables the
Sb_G = SystemColors.Control.G ' appropriate values based
Sb_B = SystemColors.Control.B ' on system-defined colors
' for control and control
Sf_R = SystemColors.ControlText.R ' text.
Sf_G = SystemColors.ControlText.G
Sf_B = SystemColors.ControlText.B
Eb_R = SystemColors.ActiveCaption.R ' Assign the variables the
Eb_G = SystemColors.ActiveCaption.G ' appropriate values based
Eb_B = SystemColors.ActiveCaption.B ' on system-defined colors
' for the title bar and the
Ef_R = SystemColors.ActiveCaptionText.R ' title bar's text.
Ef_G = SystemColors.ActiveCaptionText.G
Ef_B = SystemColors.ActiveCaptionText.B
Case False
Sb_R = SystemColors.ActiveCaption.R ' Assign the variables the
Sb_G = SystemColors.ActiveCaption.G ' appropriate values based
Sb_B = SystemColors.ActiveCaption.B ' on system-defined colors
' for the title bar and the
Sf_R = SystemColors.ActiveCaptionText.R ' title bar's text.
Sf_G = SystemColors.ActiveCaptionText.G
Sf_B = SystemColors.ActiveCaptionText.B
Eb_R = SystemColors.Control.R ' Assign the variables the
Eb_G = SystemColors.Control.G ' appropriate values based
Eb_B = SystemColors.Control.B ' on system-defined colors
' for control and control
Ef_R = SystemColors.ControlText.R ' text.
Ef_G = SystemColors.ControlText.G
Ef_B = SystemColors.ControlText.B
End Select
Dim b_RIncrement As Int16 = Round(((Eb_R - Sb_R) / 16), 0) ' Find the increments that
Dim b_GIncrement As Int16 = Round(((Eb_G - Sb_G) / 16), 0) ' the RGB values will take;
Dim b_BIncrement As Int16 = Round(((Eb_B - Sb_B) / 16), 0) ' 1/16th of the difference
' between the start and end
Dim f_RIncrement As Int16 = Round(((Ef_R - Sf_R) / 16), 0) ' values, rounded to the
Dim f_GIncrement As Int16 = Round(((Ef_G - Sf_G) / 16), 0) ' nearest integer.
Dim f_BIncrement As Int16 = Round(((Ef_B - Sf_B) / 16), 0)
Dim bR As Int16 = Sb_R ' \
Dim bG As Int16 = Sb_G ' }-- the RGB values for the backcolor as it changes.
Dim bB As Int16 = Sb_B ' /
Dim fR As Int16 = Sf_R ' \
Dim fG As Int16 = Sf_G ' }-- the RGB values for the forecolor as it changes.
Dim fB As Int16 = Sf_B ' /
Dim count As Int16
For count = 0 To 14
bR += b_RIncrement ' Add the appropriate increments to the
bG += b_GIncrement ' RGB values. The result is a nifty
bB += b_BIncrement ' "cross-fade" effect.
fR += f_RIncrement
fG += f_GIncrement
fB += f_BIncrement
ctrl.BackColor = Color.FromArgb(bR, bG, bB) ' Repaint the button using the
ctrl.ForeColor = Color.FromArgb(fR, fG, fB) ' current RGB values, and refresh
ctrl.Refresh() ' the button.
Threading.Thread.Sleep(30 - (count * 2)) ' Wait a certain number of milliseconds,
' which is a factor of the current count.
' I tweaked these numbers to get a decent
' effect; feel free to adjust these
' numbers to achieve an effect you like.
Next
Select Case Hovering
Case True
ctrl.BackColor = SystemColors.InactiveCaption ' Finish the effect by painting
ctrl.ForeColor = SystemColors.InactiveCaptionText ' the control with it's final
Case False ' look, depending on whether
ctrl.BackColor = SystemColors.Control ' we're fading in or out.
ctrl.ForeColor = SystemColors.ControlText
End Select
End Sub
#End Region
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -