frm_reports.vb

来自「application file which contains the note」· VB 代码 · 共 310 行

Imports System.Data.OleDb
Imports System.Xml
Imports System.Xml.Schema
Imports CrystalDecisions.CrystalReports
Imports CrystalDecisions.ReportSource
Imports System.Math
Public Class frm_reports
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    Friend WithEvents Label1 As System.Windows.Forms.Label
    Friend WithEvents PictureBox1 As System.Windows.Forms.PictureBox
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents ReportDocument1 As CrystalDecisions.CrystalReports.Engine.ReportDocument
    Friend WithEvents CrystalReportViewer1 As CrystalDecisions.Windows.Forms.CrystalReportViewer
    Friend WithEvents Adodc1 As Microsoft.VisualBasic.Compatibility.VB6.ADODC
    Friend WithEvents Button2 As System.Windows.Forms.Button
    Friend WithEvents Label2 As System.Windows.Forms.Label
    Friend WithEvents TextBox1 As System.Windows.Forms.TextBox
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(frm_reports))
        Me.Label1 = New System.Windows.Forms.Label
        Me.PictureBox1 = New System.Windows.Forms.PictureBox
        Me.Button1 = New System.Windows.Forms.Button
        Me.ReportDocument1 = New CrystalDecisions.CrystalReports.Engine.ReportDocument
        Me.CrystalReportViewer1 = New CrystalDecisions.Windows.Forms.CrystalReportViewer
        Me.Adodc1 = New Microsoft.VisualBasic.Compatibility.VB6.ADODC
        Me.Button2 = New System.Windows.Forms.Button
        Me.Label2 = New System.Windows.Forms.Label
        Me.TextBox1 = New System.Windows.Forms.TextBox
        Me.SuspendLayout()
        '
        'Label1
        '
        Me.Label1.Font = New System.Drawing.Font("Arial Black", 20.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label1.Location = New System.Drawing.Point(72, 8)
        Me.Label1.Name = "Label1"
        Me.Label1.Size = New System.Drawing.Size(256, 40)
        Me.Label1.TabIndex = 0
        Me.Label1.Text = "Report Viewer"
        '
        'PictureBox1
        '
        Me.PictureBox1.Image = CType(resources.GetObject("PictureBox1.Image"), System.Drawing.Image)
        Me.PictureBox1.Location = New System.Drawing.Point(40, 8)
        Me.PictureBox1.Name = "PictureBox1"
        Me.PictureBox1.Size = New System.Drawing.Size(32, 32)
        Me.PictureBox1.TabIndex = 1
        Me.PictureBox1.TabStop = False
        '
        'Button1
        '
        Me.Button1.BackColor = System.Drawing.SystemColors.ControlLight
        Me.Button1.Location = New System.Drawing.Point(832, 368)
        Me.Button1.Name = "Button1"
        Me.Button1.TabIndex = 2
        Me.Button1.Text = "Cancel"
        '
        'ReportDocument1
        '
        Me.ReportDocument1.PrintOptions.PaperOrientation = CrystalDecisions.Shared.PaperOrientation.DefaultPaperOrientation
        Me.ReportDocument1.PrintOptions.PaperSize = CrystalDecisions.Shared.PaperSize.DefaultPaperSize
        Me.ReportDocument1.PrintOptions.PaperSource = CrystalDecisions.Shared.PaperSource.Upper
        Me.ReportDocument1.PrintOptions.PrinterDuplex = CrystalDecisions.Shared.PrinterDuplex.Default
        '
        'CrystalReportViewer1
        '
        Me.CrystalReportViewer1.ActiveViewIndex = -1
        Me.CrystalReportViewer1.DisplayGroupTree = False
        Me.CrystalReportViewer1.Location = New System.Drawing.Point(8, 88)
        Me.CrystalReportViewer1.Name = "CrystalReportViewer1"
        Me.CrystalReportViewer1.ReportSource = Nothing
        Me.CrystalReportViewer1.Size = New System.Drawing.Size(912, 272)
        Me.CrystalReportViewer1.TabIndex = 4
        '
        'Adodc1
        '
        Me.Adodc1.BackColor = System.Drawing.SystemColors.Control
        Me.Adodc1.BOFAction = Microsoft.VisualBasic.Compatibility.VB6.ADODC.BOFActionEnum.adDoMoveFirst
        Me.Adodc1.CommandTimeout = 0
        Me.Adodc1.CommandType = ADODB.CommandTypeEnum.adCmdUnknown
        Me.Adodc1.ConnectionString = Nothing
        Me.Adodc1.CursorLocation = ADODB.CursorLocationEnum.adUseClient
        Me.Adodc1.CursorType = ADODB.CursorTypeEnum.adOpenStatic
        Me.Adodc1.EOFAction = Microsoft.VisualBasic.Compatibility.VB6.ADODC.EOFActionEnum.adDoMoveLast
        Me.Adodc1.Location = New System.Drawing.Point(0, 0)
        Me.Adodc1.LockType = ADODB.LockTypeEnum.adLockOptimistic
        Me.Adodc1.Mode = ADODB.ConnectModeEnum.adModeUnknown
        Me.Adodc1.Name = "Adodc1"
        Me.Adodc1.Orientation = Microsoft.VisualBasic.Compatibility.VB6.ADODC.OrientationEnum.adHorizontal
        Me.Adodc1.Size = New System.Drawing.Size(130, 26)
        Me.Adodc1.TabIndex = 0
        Me.Adodc1.Text = "Adodc1"
        Me.Adodc1.UserName = "" & Microsoft.VisualBasic.ChrW(0)
        '
        'Button2
        '
        Me.Button2.BackColor = System.Drawing.SystemColors.ControlLight
        Me.Button2.Location = New System.Drawing.Point(600, 56)
        Me.Button2.Name = "Button2"
        Me.Button2.TabIndex = 5
        Me.Button2.Text = "View Report"
        '
        'Label2
        '
        Me.Label2.Location = New System.Drawing.Point(256, 64)
        Me.Label2.Name = "Label2"
        Me.Label2.Size = New System.Drawing.Size(72, 16)
        Me.Label2.TabIndex = 6
        Me.Label2.Text = "Patient ID"
        '
        'TextBox1
        '
        Me.TextBox1.BackColor = System.Drawing.SystemColors.Info
        Me.TextBox1.Location = New System.Drawing.Point(336, 56)
        Me.TextBox1.Name = "TextBox1"
        Me.TextBox1.TabIndex = 7
        Me.TextBox1.Text = ""
        '
        'frm_reports
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.BackColor = System.Drawing.SystemColors.InactiveCaptionText
        Me.ClientSize = New System.Drawing.Size(930, 392)
        Me.Controls.Add(Me.TextBox1)
        Me.Controls.Add(Me.Label2)
        Me.Controls.Add(Me.Button2)
        Me.Controls.Add(Me.CrystalReportViewer1)
        Me.Controls.Add(Me.Button1)
        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_reports"
        Me.Text = "PrisLogix's PIS"
        Me.ResumeLayout(False)

    End Sub

#End Region
    Dim MyConnection As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\PIS.mdb")
    Dim MyCommand
    Dim e As Exception
    Dim MyCommand2
    Dim MyReader As OleDbDataReader
    Dim MyReader2 As OleDbDataReader
    Dim dbset As New DataSet
    Dim dataA
    Dim ref
    Dim aim As CrystalDecisions.ReportSource.RemoteReportSource
    Dim myreport As New CrystalReport26
#Region "CODE STARTS HERE"
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Me.Close()
    End Sub
    Private Sub frm_reports_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub
    Private Sub Button2_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If TextBox1.Text = "" Or TextBox1.Text.StartsWith("pat") = False Then
            MsgBox("Please Enter A Correct Patient ID", MsgBoxStyle.Information, "PrisLogix's PIS")
        Else
            myreport.Refresh()
            myreport.RecordSelectionFormula = "{Accounts.patcode} = '" & TextBox1.Text & "' "
            CrystalReportViewer1.ReportSource = myreport
        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

        ' 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

        ' 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