📄 frmtransact.frm
字号:
VERSION 5.00
Object = "{AA0D501B-0C16-11D4-8531-00E098160F52}#4.0#0"; "COMNBUTTONS.OCX"
Object = "{B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5#0"; "SS32X25.OCX"
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Object = "{D52F4AA5-2D61-11D3-8E3D-0080C879E48B}#54.0#0"; "USERSPREAD.OCX"
Begin VB.Form frmTransact
BorderStyle = 1 'Fixed Single
Caption = "药品流向查询"
ClientHeight = 5370
ClientLeft = 1170
ClientTop = 1095
ClientWidth = 9330
Icon = "frmTransact.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5370
ScaleWidth = 9330
Begin FPSpread.vaSpread spd
Height = 4212
Left = 24
OleObjectBlob = "frmTransact.frx":0442
TabIndex = 8
Top = 840
Width = 9264
End
Begin VB.CheckBox chkPatient
Caption = "门诊病人(不含今天)"
ForeColor = &H00FF0000&
Height = 228
Left = 2904
TabIndex = 11
Top = 528
Visible = 0 'False
Width = 2565
End
Begin VB.CheckBox chkSick
Caption = "住院病人(不含今天)"
ForeColor = &H000000FF&
Height = 228
Left = 2904
TabIndex = 10
Top = 192
Visible = 0 'False
Width = 2700
End
Begin ComnButtons.ButtonGroup btg
Height = 330
Left = 6630
TabIndex = 9
Top = 5070
Width = 2655
_ExtentX = 4683
_ExtentY = 582
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor = -2147483638
ButtonCount = 3
ButtonCaption = "&Q.查询 &P.打印 &E.关闭"
KeyEnabled = "1#1#1#"
End
Begin SpreadEnhanced.UserSpread usp
Left = 9030
Top = -30
_ExtentX = 847
_ExtentY = 847
ID = "House_Transact"
SumRowStr = "<9><11><13><14>"
End
Begin VB.CheckBox chkAllTran
Caption = "所有发生事物"
Height = 210
Left = 30
TabIndex = 7
Top = 540
Width = 1395
End
Begin VB.CommandButton cmdSelectTran
Caption = "选择事物"
Height = 315
Left = 1485
TabIndex = 6
Top = 480
Width = 1200
End
Begin VB.CommandButton cmdSelect
Caption = "选择药品"
Height = 315
Left = 1485
TabIndex = 5
Top = 135
Width = 1200
End
Begin VB.CheckBox chkAll
Caption = "所有药品"
Height = 210
Left = 30
TabIndex = 4
Top = 216
Width = 1140
End
Begin MSMask.MaskEdBox mskDate
Height = 288
Index = 0
Left = 6504
TabIndex = 0
Top = 492
Width = 1176
_ExtentX = 2064
_ExtentY = 503
_Version = 393216
AutoTab = -1 'True
MaxLength = 10
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mask = "####-##-##"
PromptChar = " "
End
Begin MSMask.MaskEdBox mskDate
Height = 285
Index = 1
Left = 8040
TabIndex = 1
Top = 480
Width = 1230
_ExtentX = 2170
_ExtentY = 503
_Version = 393216
AutoTab = -1 'True
MaxLength = 10
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mask = "####-##-##"
PromptChar = " "
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "--"
Height = 180
Left = 7764
TabIndex = 3
Top = 540
Width = 180
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "发生日期"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 5580
TabIndex = 2
Top = 540
Width = 840
End
End
Attribute VB_Name = "frmTransact"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents DrugObj As frmDrugSelect
Attribute DrugObj.VB_VarHelpID = -1
Private WithEvents TranObj As frmTranSelect
Attribute TranObj.VB_VarHelpID = -1
Private mItemCode As String
Private ConditionTran As String
Private Sub InitForm()
Set usp.DBInter = gDbObj
Set usp.CurSpread = spd
usp.Load
spd.MaxRows = 0
chkAll.Value = 1
chkAllTran.Value = 1
mskDate(0) = gfnGetTime(gstrCOMN_DATE)
mskDate(1) = gfnGetTime(gstrCOMN_DATE)
End Sub
Private Sub btg_Click(ByVal WhichB As Integer)
Select Case WhichB
Case 0
FillData
Case 1
spd.PrintHeader = " /fz""12"" /fb1 药品流向 /n" _
& "/fz""10"" /fb0 开始日期：" & mskDate(0) & Space(40) _
& "结束日期:" & mskDate(1) & "/r/n"
spd.PrintRowHeaders = False
spd.PrintShadows = False
spd.PrintMarginLeft = 0
spd.PrintUseDataMax = False
spd.Action = SS_ACTION_PRINT
Case 2
Unload Me
End Select
End Sub
Private Sub chkAll_Click()
If chkAll = 1 Then
cmdSelect.Enabled = False
mItemCode = ""
Else
cmdSelect.Enabled = True
End If
End Sub
Private Sub chkAllTran_Click()
If chkAllTran = 1 Then
Me.cmdSelectTran.Enabled = False
ConditionTran = ""
Else
cmdSelectTran.Enabled = True
End If
End Sub
Private Sub FillData()
Dim SQL As String, i As Integer, J As Integer
Dim TimeSQL As String
Dim Sum As String
Sum = "<11><13><14>"
SQL = "SELECT m_Drug.ItemName,f_DrugsTransact.Des,case when m_Depart.DepName is null then marker else depname end," _
& "House_BusMain.SheetID,House_BusMain.BusDate,m_Handler.HdName," _
& "m_Drug.Model + ' * ' + CONVERT(varchar(10),House_BusSub.factor)," _
& "House_BusSub.Unit,House_BusSub.Amount/House_BusSub.Factor," _
& "House_BusSub.Gprice * House_BusSub.Factor,House_BusSub.GMoney," _
& "House_BusSub.Cprice * House_BusSub.Factor,House_BusSub.CMoney," _
& "House_BusSub.CMoney-House_BusSub.GMoney " _
& "FROM (((((House_BusMain INNER JOIN House_BusSub " _
& "ON House_BusMain.BusSerial = House_BusSub.BusSerial) " _
& "INNER JOIN m_Handler ON House_BusMain.HdCode = m_Handler.HdCode)" _
& "INNER JOIN f_DrugsTransact ON House_BusMain.DtCode = f_DrugsTransact.DtCode)" _
& "INNER JOIN m_Drug ON House_BusSub.ItemCode = m_Drug.ItemCode) " _
& "LEFT JOIN m_Depart ON House_BusMain.vsDepCode = m_Depart.DepCode) " _
& "WHERE House_BusMain.DsCode = '" & gtydSysConfig.DepCode & "'" _
& " AND House_BusMain.Flag & 1 = 0 AND House_BusMain.Flag & 4 = 0"
If mskDate(0) <> gstrMASK_INIT Then
If Not IsDate(mskDate(0)) Then
MsgBox "日期错误!", vbCritical
mskDate(0).SetFocus
Exit Sub
End If
TimeSQL = "House_BusMain.BusDate >='" & mskDate(0).Text & "'"
End If
If mskDate(1) <> gstrMASK_INIT Then
If Not IsDate(mskDate(1)) Then
MsgBox "日期错误!", vbCritical
mskDate(1).SetFocus
Exit Sub
End If
TimeSQL = IIf(TimeSQL = "", "", TimeSQL & " AND ") _
& "House_BusMain.BusDate <='" & mskDate(1).Text & " 23:59:59'"
End If
If TimeSQL = "" Then
TimeSQL = IIf(mItemCode = "", "", " m_Drug.ItemCode Like '" & mItemCode & "%'")
Else
TimeSQL = IIf(mItemCode = "", "", " m_Drug.ItemCode Like '" & mItemCode & "%' AND ") & TimeSQL
End If
If TimeSQL <> "" Then
SQL = SQL & " AND " & TimeSQL
If ConditionTran <> "" Then
SQL = SQL & " AND " & ConditionTran
End If
Else
If ConditionTran <> "" Then
SQL = SQL & " AND " & ConditionTran
End If
End If
Me.MousePointer = 11
spd.Redraw = False
spd.MaxRows = 0
If Not (ConditionTran = "" And Me.chkAllTran.Value = 0) Then
If gDbObj.GetRs(SQL) > 0 Then
spd.MaxRows = gDbObj.RecordCount
spd.BlockMode = True
spd.Row = 1
spd.Col = 1
spd.Row2 = spd.MaxRows
spd.Col2 = spd.MaxCols
spd.Clip = gDbObj.Rs.GetString
spd.BlockMode = False
End If
End If
If Sum <> "" Then
spd.MaxRows = spd.MaxRows + 1
spd.Row = spd.MaxRows
spd.Col = 1
spd.Text = "合计"
For i = 1 To spd.MaxCols
If InStr(1, Sum, "<" & i & ">", vbTextCompare) <> 0 Then
Value = 0#
spd.Col = i
For J = 1 To spd.MaxRows - 1
spd.Row = J
Value = Value + Val(spd.Text)
Next J
spd.Row = spd.MaxRows
spd.Text = Value
End If
Next i
End If
spd.Redraw = True
'usp.SumRowStr =
Me.MousePointer = 0
End Sub
Private Sub chkPatient_Click()
If chkPatient.Value = 1 Then
chkSick.Value = 0
End If
End Sub
Private Sub chkSick_Click()
If chkSick.Value = 1 Then
chkPatient.Value = 0
End If
End Sub
Private Sub cmdSelect_Click()
If DrugObj Is Nothing Then
Set DrugObj = New frmDrugSelect
DrugObj.Show
End If
End Sub
Private Sub cmdSelectTran_Click()
If TranObj Is Nothing Then
Set TranObj = New frmTranSelect
TranObj.Show vbModal
End If
End Sub
Private Sub DrugObj_AckSelect(ByVal CondiSQL As String)
End Sub
Private Sub DrugObj_Cancel()
Set DrugObj = Nothing
End Sub
Private Sub DrugObj_SelectItem(ByVal ItemCode As String)
mItemCode = ItemCode
Set DrugObj = Nothing
End Sub
Private Sub Form_Load()
hisFormToCenter Me, frmMain
InitForm
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmTransact = Nothing
End Sub
Private Sub spd_DblClick(ByVal Col As Long, ByVal Row As Long)
SortSpread spd, Col, NoSortMaxNum:=1
End Sub
Private Sub spd_RightClick(ByVal ClickType As Integer, ByVal Col As Long, ByVal Row As Long, ByVal MouseX As Long, ByVal MouseY As Long)
Call usp.RightClick
End Sub
Private Sub TranObj_AckSelect(ByVal CondiSQL As String)
ConditionTran = CondiSQL
If CondiSQL = "" Then
chkAllTran.Value = 1
End If
Set TranObj = Nothing
End Sub
Private Sub TranObj_Cancel()
Set TranObj = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -