?? formclass2.frm
字號:
.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("對不起,你是只讀用戶不能修改記錄,請與管理員聯(lián)系!", 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("對不起,你是只讀用戶不能刪除記錄,請與管理員聯(lián)系!", 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) & "繼續(xù)會導(dǎo)致該藥方記錄的數(shù)據(jù)丟失,繼續(xù)嗎?", 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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -