frmreportitem.frm

VB6.0编写的医院影像系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmReportItem 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "报告项目设置"
   ClientHeight    =   8220
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   10215
   Icon            =   "frmReportItem.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8220
   ScaleWidth      =   10215
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   1440
      Top             =   7560
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmReportItem.frx":0442
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmReportItem.frx":0894
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList ImageList2 
      Left            =   360
      Top             =   7560
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   15
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   7
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmReportItem.frx":0CE6
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmReportItem.frx":1228
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmReportItem.frx":133A
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmReportItem.frx":144C
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmReportItem.frx":198E
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmReportItem.frx":1EC0
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmReportItem.frx":1FD2
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   555
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   10215
      _ExtentX        =   18018
      _ExtentY        =   979
      ButtonWidth     =   1455
      ButtonHeight    =   926
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList2"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   9
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "新增项目"
            Key             =   "NewItem"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "修改项目"
            Key             =   "ModifyItem"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "删除项目"
            Key             =   "DeleteItem"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "新增内容"
            Key             =   "NewDetail"
            ImageIndex      =   4
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "修改内容"
            Key             =   "ModifyDetail"
            ImageIndex      =   5
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "删除内容"
            Key             =   "DeleteDetail"
            ImageIndex      =   6
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "Exit"
            ImageIndex      =   7
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ListView lsvDetail 
      Height          =   7455
      Left            =   3000
      TabIndex        =   1
      Top             =   600
      Width           =   7095
      _ExtentX        =   12515
      _ExtentY        =   13150
      View            =   2
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   0
   End
   Begin MSComctlLib.TreeView trvItem 
      Height          =   7455
      Left            =   120
      TabIndex        =   0
      Top             =   600
      Width           =   2775
      _ExtentX        =   4895
      _ExtentY        =   13150
      _Version        =   393217
      Indentation     =   265
      LabelEdit       =   1
      Sorted          =   -1  'True
      Style           =   7
      SingleSel       =   -1  'True
      ImageList       =   "ImageList1"
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "frmReportItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Private CurrentClass As String                      '当前的类别
'Private rsReportClass As ADODB.Recordset            '与rsReportClass对应
Private rsItem As ADODB.Recordset

Private Sub Form_Load()
'设置报告项目树及内容列表框

    Call iniListView
    Call SetItemTree
       
End Sub

Private Sub iniListView()
    
    lsvDetail.View = lvwReport
    lsvDetail.LabelEdit = lvwManual
    lsvDetail.FullRowSelect = True
    
    lsvDetail.ListItems.Clear
    lsvDetail.ColumnHeaders.Add 1, "K1", "序号", 800, lvwColumnLeft
    lsvDetail.ColumnHeaders.Add 2, "K2", "内容", 3000, lvwColumnLeft
    lsvDetail.ColumnHeaders.Add 3, "K3", "频率", 1600, lvwColumnLeft
    lsvDetail.ColumnHeaders.Add 4, "K4", "频率", 0, lvwColumnLeft
    
End Sub

Private Sub SetItemTree()
Dim sSQL As String
Dim Nodx As MSComctlLib.Node
    
    With trvItem
        .Nodes.Clear
        .Nodes.Add , , "*-1", "报告项目", 1
    End With
    
    sSQL = "select * from us_report_item_class order by serial_id"
    Set rsItem = OpenRSClient(sSQL)
    With rsItem
    Do While Not .EOF
        Set Nodx = trvItem.Nodes.Add("*-1", tvwChild, "K" & CStr(rsItem!serial_id), rsItem!CLASS_NAME, 1)
        Nodx.Tag = rsItem!serial_id
        .MoveNext
    Loop
    End With
    
    trvItem.Nodes(1).Selected = True
    
End Sub

'Private Sub FillClass()
'
'    '填充类型列表
'    lstClass.Clear
'    With rsReportClass
'        .Filter = vbNullString
'        If .RecordCount > 0 Then
'            .MoveFirst
'            Do While Not .EOF
'                lstClass.AddItem !CLASS_NAME
'                .MoveNext
'            Loop
'        End If
'    End With
'    rsReportItem.Filter = "CLASS_NAME = '-1'"
'
'End Sub
    
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim Nodx As MSComctlLib.Node
Dim strItem As String
Dim sSQL As String
Dim rsTemp As String
Dim lSerialID As Long
Dim lDetailID As Long
Dim sTempName As String
Dim lTempID As Long
                   

    Select Case Button.Key
        Case "NewItem"
             '加入新的报告项目
             strItem = InputBox("请输入报告项目名称:", "新报告项目")
            If strItem = vbNullString Then Exit Sub
            If ExistRecord("US_REPORT_ITEM_CLASS", "CLASS_NAME", strItem) Then
                MsgBox "已经存在该记录,请重新输入！", vbExclamation + vbOKOnly, "输入错误"
                Exit Sub
            End If
                
                '加入新记录
                lSerialID = GetSerialID("us_report_item_class")
                sSQL = "insert into us_report_item_class(serial_id,class_name) values(" & lSerialID & ",'" & strItem & "')"
                GDB.Execute sSQL
                
                '将新记录加入列表框
            Set Nodx = trvItem.Nodes.Add("*-1", tvwChild, "K" & CStr(lSerialID), strItem, 1)
            Nodx.Tag = lSerialID
        
                
        Case "ModifyItem"
            sTempName = trvItem.SelectedItem.Text
            lTempID = trvItem.SelectedItem.Tag
            strItem = InputBox("请输入报告项目名称:", "新报告项目", sTempName)
            
            If strItem = vbNullString Then Exit Sub
            If ExistRecord("US_REPORT_ITEM_CLASS", "CLASS_NAME", strItem) Then
                MsgBox "已经存在该记录,请重新输入！", vbExclamation + vbOKOnly, "输入错误"
                Exit Sub
            End If
                
            '修改记录
            sSQL = "update us_report_item_class set class_name='" & strItem & "' where serial_id=" & lTempID
            GDB.Execute sSQL
            
            '将新记录加入列表框
'            Set trvItem.Nodes.Item.Text = strItem
                
        Case "DeleteItem"
            '删除字段
            If trvItem.SelectedItem.Index < 1 Then
                MsgBox "请先选择一个项目,再进行删除操作!", vbOKOnly + vbInformation, "提示"
                Exit Sub
            End If
            
            If MsgBox("这将删除当前的项目，确定吗？", vbQuestion + vbYesNo, "删除项目") = vbNo Then
                Exit Sub
            End If
            
            lSerialID = trvItem.SelectedItem.Tag
            sSQL = "delete from us_report_item_class where serial_id=" & lSerialID
            GDB.Execute (sSQL)

            trvItem.Nodes.Remove trvItem.SelectedItem.Index
        
        Case "NewDetail"
            frmItemDetailSet.msStatus = "New"
            frmItemDetailSet.mlClassID = trvItem.SelectedItem.Tag
            frmItemDetailSet.Show vbModal
        
        Case "ModifyDetail"
            '更新记录集
            frmItemDetailSet.msStatus = "Modify"
            frmItemDetailSet.mlClassID = trvItem.SelectedItem.Tag
            frmItemDetailSet.mlItemIndex = lsvDetail.SelectedItem.Text
            frmItemDetailSet.msItemData = lsvDetail.SelectedItem.SubItems(1)
            frmItemDetailSet.mlDetailID = lsvDetail.SelectedItem.Tag
            frmItemDetailSet.Show vbModal
            
        Case "DeleteDetail"
            '删除字段
            If lsvDetail.SelectedItem.Index < 1 Then
                MsgBox "请先选择一个项目,再进行删除操作!", vbOKOnly + vbInformation, "提示"
                Exit Sub
            End If
            
            If MsgBox("这将删除当前的内容，确定吗？", vbQuestion + vbYesNo, "删除内容") = vbNo Then
                Exit Sub
            End If
            
            '删除当前的ITEM
            lDetailID = lsvDetail.SelectedItem.Tag
            sSQL = "delete from us_report_item_detail where serial_id=" & lDetailID
            GDB.Execute (sSQL)

            lsvDetail.ListItems.Remove (lsvDetail.SelectedItem.Index)

        Case "Exit"
                
            Unload Me

    End Select
    
End Sub

Private Sub trvItem_Click()
Dim Nodex As MSComctlLib.Node
Dim rsDetail As ADODB.Recordset
Dim lsvItem As MSComctlLib.ListItem
Dim lClassID As String
Dim iCount As Long
Dim sSQL As String
Dim lRow As Long
    
    trvItem.DropHighlight = trvItem.SelectedItem
    
    If trvItem.SelectedItem.Index > 1 Then
        Set Nodex = trvItem.SelectedItem
        lClassID = Nodex.Tag
    Else
        lsvDetail.ListItems.Clear
        Exit Sub
    End If
                

    sSQL = "select * from us_report_item_detail where class_id= " & lClassID & " order by itemindex"
    Set rsDetail = OpenRSClient(sSQL)
    
    lsvDetail.ListItems.Clear
    
    iCount = 1
    With rsDetail
    Do While Not .EOF
       Set lsvItem = lsvDetail.ListItems.Add(iCount, "U" & iCount)
       lsvItem.Text = rsDetail!ITEMINDEX
       lsvItem.SubItems(1) = rsDetail!ItemData
       lsvItem.SubItems(2) = rsDetail!FREQUENCY
       lsvItem.SubItems(3) = rsDetail!CLASS_ID
       lsvItem.Tag = rsDetail!serial_id
       iCount = iCount + 1
       .MoveNext
    Loop
    End With
    
'    If lsvDetail.ListItems.Count >= 1 Then
'        lsvDetail.ListItems(1).Selected = True
'    End If
    
    rsDetail.Close
    Set rsDetail = Nothing

End Sub

Private Sub trvItem_NodeClick(ByVal Node As MSComctlLib.Node)
    
    Call trvItem_Click
    
End Sub