formclass2.frm

prescription management

    .TextMatrix(0, 1) = "方名"
    .TextMatrix(0, 2) = "方源"
    .TextMatrix(0, 3) = "组成"
    .TextMatrix(0, 4) = "功效"
    .TextMatrix(0, 5) = "主治"
    .TextMatrix(0, 6) = "用法"
    .TextMatrix(0, 7) = "服用禁忌"
    .TextMatrix(0, 8) = "典型病例"
    .TextMatrix(0, 9) = "备注"
    
    .ColWidth(0) = 100
    .ColWidth(1) = 1000
    .ColWidth(2) = 1000
    .ColWidth(3) = 10000
    .ColWidth(4) = 1800
    .ColWidth(5) = 6000
    .ColWidth(6) = 1800
    .ColWidth(7) = 1700
    .ColWidth(8) = 1800
    .ColWidth(9) = 1800
    
    .FixedRows = 1
    For i = 1 To 9
      .ColAlignment(i) = 0
    Next i
    .FillStyle = flexFillSingle
    .Col = 0
    .Row = 0
    .RowSel = 1
    .ColSel = .Cols - 1
    .CellAlignment = 4
    .Row = 1
    End With
End Sub

Public Sub classshowdata()
Dim j As Integer
Dim i As Integer

Dim mrc1 As ADODB.Recordset
  Set mrc1 = ExecuteSQL(Trim(txtsql))
  If mrc1.EOF = False Then
   mrc1.MoveFirst
   With MSF1
    .Rows = 1
    Do While Not mrc1.EOF
     .Rows = .Rows + 1
     For i = 1 To mrc1.Fields.Count
     If IsNull(mrc1.Fields(i - 1)) Then
      .TextMatrix(.Rows - 1, i) = ""
     Else
      .TextMatrix(.Rows - 1, i) = mrc1.Fields(i - 1)
     End If
     Next i
     mrc1.MoveNext
    Loop
    mrc1.Close
 End With
 
 Else
   If classfind = True Then
    Formclass2.Hide
    Formclass3.Show
    zzz = MsgBox("对不起，没有此方剂的档案记录！", vbOKOnly, "查询")
    Formclass3.ZOrder (0)
    Formclass3.Text1(0).SetFocus
   End If
 End If
End Sub

Private Sub Form_Activate()
If classfind = True Then
  Formclass3.ZOrder 0
End If
If classfind = True Then
  Exit Sub
ElseIf classmodi = True Then
   classshowdata
 ' TreeView1_DblClick
  classmodi = False
Else
  classtree
End If
'If classfind = True Then
'  Exit Sub
'Else
'  MDIForm1.clabrowse
'End If
End Sub

Public Sub classtree()
TreeView1.Nodes.Clear
Dim nodex As Node
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset

Dim str As String
Dim a As String
Dim b As String

b = "所有方剂"
Set nodX = TreeView1.Nodes.Add(, , b, b, 1, 1)
a = "备注"
TreeView1.LineStyle = tvwRootLines
str = "select distinct 备注 from prescribe order by 备注"
Set mrc = ExecuteSQL(str)
str = "select distinct 备注,方名 from prescribe order by 备注,方名"
Set mrc1 = ExecuteSQL(str)
  
  
  Do Until mrc.EOF
    mrc1.MoveFirst
     Set nodex = TreeView1.Nodes.Add(b, tvwChild, a, mrc.Fields(0), 1, 1)
    Do While Not mrc1.EOF
     If mrc1.Fields(0) = mrc.Fields(0) Then
       Set nodex = TreeView1.Nodes.Add(a, tvwChild, , mrc1.Fields(1), 2, 2)
     End If
     mrc1.MoveNext
    Loop
    a = a & "1"
    mrc.MoveNext
  Loop



 mrc1.Close
 mrc.Close

 Set mrc = Nothing
  Set mrc1 = Nothing

End Sub



Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Tag
        Case "find"
        Formclass2.Hide
        Formclass3.Show
        Formclass3.ZOrder (0)
        Formclass3.Text1(0).SetFocus
        Case "modi"
        If Trim(Me.MSF1) <> "" Then
                If Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) = "" Then
                  sssss = MsgBox("你还没有选择记录！", vbOKOnly + vbExclamation, "警告")
                  Exit Sub
                Else
                  qxstr = Executeqx(2)
                  If qxstr = "readonly" Then
                    ss = MsgBox("对不起，你是只读用户不能修改记录，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
                    Exit Sub
                  End If
                  classmodi = True
                  Formclass2.Hide
                  Formclass1.Show
                  Formclass1.classload
                  Formclass1.ZOrder 0
                End If
         Else
         sssss = MsgBox("你还没有选择记录！", vbOKOnly + vbExclamation, "警告")
                  Exit Sub
         End If
        Case "del"
          qxstr = Executeqx(2)
            If qxstr = "readonly" Then
            ss = MsgBox("对不起，你是只读用户不能删除记录，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
              Exit Sub
               End If
              Dim mrc As ADODB.Recordset
               Dim msgtext As String
              Dim intcount As Integer
              If Trim(Me.MSF1) <> "" Then
                If Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) = "" Then
                 sssss = MsgBox("你还没有选择记录！", vbOKOnly + vbExclamation, "警告")
                Exit Sub
               End If
             Else
         sssss = MsgBox("你还没有选择记录！", vbOKOnly + vbExclamation, "警告")
                  Exit Sub
         End If
              If MsgBox("确定要删除方名为 " & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & " 的记录吗？" & Chr(13) & Chr(10) & "继续会导致该药方记录的数据丢失，继续吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
                txtsql = "delete * from prescribe where 方名='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'"
                 Set mrc = ExecuteSQL(txtsql)
                  
                 End If
              'If IsNull(TreeView1.SelectedItem.Index) Then
              'sssss = MsgBox("你还没有选择记录！", vbOKOnly + vbExclamation, "警告")
              'Exit Sub
              'Else
              'txtsql = TreeView1.Nodes.Item(TreeView1.SelectedItem.Index)
              'End If
              If str1 = "所有方剂" Then
  txtsql = " select * from prescribe"
Else
   
   txtsql = " select * from prescribe where 备注 ='" & str1 & "' or 方名='" & str1 & "' order by 备注 ,方名 "
  
End If
              'txtsql = " select * from prescribe where 方源='" & Trim(txtsql) & "' or 方名='" & Trim(txtsql) & "' order by 方源 ,方名 "
              classshowtitle
              classshowdata
              classtree
           End Select
End Sub



Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
  Select Case ButtonMenu.Key
  Case "dang"
  If Trim(printstr) = "" Then
    sssss = MsgBox("没有当前记录！", vbOKOnly + vbExclamation, "警告")
    Exit Sub
  End If
    If DataEnv1.rsCommand2.State = adStateOpen Then
     DataEnv1.rsCommand2.Close
    End If
     DataEnv1.rsCommand2.Open printstr
     If DataEnv1.rsCommand2.EOF = True Then
            sssss = MsgBox("没有当前记录！", vbOKOnly + vbExclamation, "警告")
      Exit Sub
    End If
    DataReportclass2.Show 1
   Case "all"
     If DataEnv1.rsCommand2.State = adStateOpen Then
     DataEnv1.rsCommand2.Close
    End If
     DataEnv1.rsCommand2.Open ("select * from prescribe")
     If DataEnv1.rsCommand2.EOF = True Then
            sssss = MsgBox("没有当前记录！", vbOKOnly + vbExclamation, "警告")
      Exit Sub
    End If
    DataReportclass2.Show 1
  End Select
End Sub

Private Sub TreeView1_DblClick()
On Error GoTo ss
If TreeView1.SelectedItem.Index = 0 Then
MSF1.Clear
Exit Sub
End If
txtsql = TreeView1.Nodes.Item(TreeView1.SelectedItem.Index)

If Trim(txtsql) = "所有方剂" Then
  str1 = "所有方剂"
  txtsql = " select * from prescribe"
Else
   str1 = Trim(txtsql)
   txtsql = " select * from prescribe where 备注 ='" & Trim(txtsql) & "' or 方名='" & Trim(txtsql) & "' order by 备注 ,方名 "
End If
   
printstr = txtsql
Me.Caption = "浏览方剂"
Me.classshowtitle
Me.classshowdata
Exit Sub


ss:
MSF1.Clear
End Sub