dlgauto.frm

本系统可用于医院和专业体检中心的健康体检管理

    optKShi_Click
    
    '添加杂项
    With cmbOther
        .AddItem "档案号"
        .ItemData(.NewIndex) = WHealthID
        
        .AddItem "查询码"
        .ItemData(.NewIndex) = WCXM
        
        .AddItem "体检序号"
        .ItemData(.NewIndex) = WSN
        
        .AddItem "姓名"
        .ItemData(.NewIndex) = WName
        
        .AddItem "性别"
        .ItemData(.NewIndex) = WSex
        
        .AddItem "年龄"
        .ItemData(.NewIndex) = WAge
        
        .AddItem "身份证号"
        .ItemData(.NewIndex) = WSFZH
       
        .AddItem "单位"
        .ItemData(.NewIndex) = WDWei
        
        .AddItem "联系电话"
        .ItemData(.NewIndex) = WPhone
        
        .AddItem "总检结论"
        .ItemData(.NewIndex) = WZJJLun
        
        .AddItem "总检建议"
        .ItemData(.NewIndex) = WZJJYi
        
        .AddItem "体检日期"
        .ItemData(.NewIndex) = WTJRQ
        
        .AddItem "打印日期"
        .ItemData(.NewIndex) = WDate
        
        .AddItem "体检套餐"
        .ItemData(.NewIndex) = WTJTC
    End With
    
    '查看原来的选择
    With txtAuto
        .Text = strAuto
        
        .FontName = objControl.FontName
        .FontSize = objControl.FontSize
        .FontBold = objControl.FontBold
        .FontItalic = objControl.FontItalic
        .FontUnderline = objControl.FontUnderline
        
        strTag = objControl.Tag
        If strTag <> "" Then
            intFlag = Left(strTag, InStr(1, strTag, ",") - 1)
            Select Case intFlag
                Case WKShi, WDX, WXX
                    optKShi.Value = True
                    
                    strID = Mid(strTag, 3)
                    For i = 1 To tvwKShi.Nodes.Count
                        If Len(strID) <= 4 Then
                            If Mid(tvwKShi.Nodes(i).Key, 2) = strID Then
                                Set tvwKShi.SelectedItem = tvwKShi.Nodes(i)
                                Exit For
                            End If
                        Else '小项
                            If Mid(tvwKShi.Nodes(i).Key, 6) = strID Then
                                Set tvwKShi.SelectedItem = tvwKShi.Nodes(i)
                                Exit For
                            End If
                        End If
                    Next
'                Case WDoctor
'                    optDoctor.Value = True
                Case WXJie
                    optXJie.Value = True
                    strID = Mid(strTag, 3)
                    For i = 1 To lstXJie.ListCount - 1
                        If lstXJie.ItemData(i) = Val(strID) Then
                            lstXJie.ListIndex = i
                            Exit For
                        End If
                    Next
                    
'                Case WJYi
'                    optJYi.Value = True
'                    strID = Mid(strTag, 3)
'                    For i = 1 To lstJYi.ListCount - 1
'                        If lstJYi.ItemData(i) = Val(strID) Then
'                            lstJYi.ListIndex = i
'                            Exit For
'                        End If
'                    Next
                Case Else
                    optOther.Value = True
                    For i = 0 To cmbOther.ListCount - 1
                        If cmbOther.ItemData(i) = intFlag Then
                            cmbOther.ListIndex = i
                            Exit For
                        End If
                    Next
            End Select
        End If
    End With
    
    Screen.MousePointer = vbDefault
    
    Me.Show vbModal
    
    If mstrAuto <> "" Then
        With objControl
            .FontName = mtypFont.FontName
            .FontSize = mtypFont.FontSize
            .FontBold = mtypFont.FontBold
            .FontItalic = mtypFont.FontItalic
            .FontUnderline = mtypFont.FontUnderline
            .Text = mstrAuto
            .Tag = mstrRelation
        End With
        
        ShowAutoText = True
    Else
        ShowAutoText = False
    End If
    
    Exit Function
ErrMsg:
    Screen.MousePointer = vbDefault
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
End Function

Private Sub cmbOther_Click()
    txtAuto.Text = cmbOther.Text
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdFont_Click()
On Error Resume Next
    With CommonDialog1
        .DialogTitle = "字体设置"
        .CancelError = True
        .FontName = txtAuto.FontName
        .FontSize = txtAuto.FontSize
        .FontBold = txtAuto.FontBold
        .FontItalic = txtAuto.FontItalic
        .FontUnderline = txtAuto.FontUnderline
        .Flags = cdlCFBoth
        .ShowFont
        If Err.Number = 0 Then
            txtAuto.FontName = .FontName
            txtAuto.FontSize = .FontSize
            txtAuto.FontBold = .FontBold
            txtAuto.FontItalic = .FontItalic
            txtAuto.FontUnderline = .FontUnderline
        End If
    End With
End Sub

Private Sub cmdOK_Click()
    '是否为空
    If txtAuto.Text = "" Then
        MsgBox "请选择一种自动文本！", vbInformation, "提示"
        Exit Sub
    End If
    
    '记录文本
    mstrAuto = txtAuto.Text
    '记录字体
    With mtypFont
        .FontName = txtAuto.FontName
        .FontSize = txtAuto.FontSize
        .FontBold = txtAuto.FontBold
        .FontItalic = txtAuto.FontItalic
        .FontUnderline = txtAuto.FontUnderline
        .Alignment = txtAuto.Alignment
    End With
    
    '***********************************************************************
    '生成关联字符串
    '***********************************************************************
    If optKShi.Value = True Then '体检数据
        '是否有选择
        If tvwKShi.SelectedItem Is Nothing Then
            MsgBox "请选择一种体检数据！", vbInformation, "提示"
'            tvwKShi.SetFocus
            Exit Sub
        End If
        
        Select Case Len(tvwKShi.SelectedItem.Key)
            Case 3 '选择了科室
                mstrRelation = WKShi
                mstrRelation = mstrRelation & "," & Mid(tvwKShi.SelectedItem.Key, 2)
            Case 5 '选择了大项
                mstrRelation = WDX
                mstrRelation = mstrRelation & "," & Mid(tvwKShi.SelectedItem.Key, 2)
            Case Is >= 8 '选择了小项
                mstrRelation = WXX
                mstrRelation = mstrRelation & "," & Mid(tvwKShi.SelectedItem.Key, 6)
            Case Else
                MsgBox "请在左侧的树型中选择科室、大项，或者小项！", vbInformation, "提示"
                Exit Sub
        End Select
        
'    ElseIf optOther.Value = True Then '日期
'        '是否有选择
'        If cmbOther.Text = "" Then
'            MsgBox "请选择日期格式！", vbInformation, "提示"
'            cmbOther.SetFocus
'            Exit Sub
'        End If
'
'        If cmbOther.ListIndex = 0 Then
'            mstrRelation = WTJRQ
'        Else
'            mstrRelation = WDate
'        End If
'    ElseIf optDoctor.Value = True Then '体检医生
'        mstrRelation = WDoctor
    ElseIf optXJie.Value = True Then '科室小结
        '是否有选择
        If lstXJie.Text = "" Then
            MsgBox "请选择打印某个科室的小结！", vbInformation, "提示"
            Exit Sub
        End If
        
        mstrRelation = WXJie & "," & LongToString(lstXJie.ItemData(lstXJie.ListIndex), 2)
    ElseIf optOther.Value = True Then '杂项
        '是否有选择
        If cmbOther.Text = "" Then
            MsgBox "请选择打印的项目！", vbInformation, "提示"
            cmbOther.SetFocus
            Exit Sub
        End If
        
        mstrRelation = cmbOther.ItemData(cmbOther.ListIndex) & "," '为了统一，在后面加一个逗号
    End If

    Unload Me
End Sub

Private Sub lstXJie_Click()
    txtAuto.Text = lstXJie.Text
End Sub

'Private Sub optDoctor_Click()
'    tvwKShi.Enabled = Not optDoctor.Value
'    cmbOther.Enabled = Not optDoctor.Value
'
'    txtAuto.Text = optDoctor.Caption
'End Sub

Private Sub optKShi_Click()
    tvwKShi.Enabled = optKShi.Value
    cmbOther.Enabled = Not optKShi.Value
    lstXJie.Enabled = Not optKShi.Value
End Sub

Private Sub optOther_Click()
    cmbOther.Enabled = optOther.Value
    tvwKShi.Enabled = Not optOther.Value
    lstXJie.Enabled = Not optOther.Value
    
    txtAuto.Text = optOther.Caption
End Sub

Private Sub optXJie_Click()
    lstXJie.Enabled = optXJie.Value
    tvwKShi.Enabled = Not optXJie.Value
    cmbOther.Enabled = Not optXJie.Value
End Sub

Private Sub tvwKShi_NodeClick(ByVal Node As MSComctlLib.Node)
    txtAuto.Text = Node.Text
End Sub