⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm_alert.vb

📁 application file which contains the notes on Ado.net
💻 VB
📖 第 1 页 / 共 2 页
字号:
        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 + -