📄 frmasklist.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"
Begin VB.Form frmAskList
BorderStyle = 1 'Fixed Single
Caption = "请领列表"
ClientHeight = 4515
ClientLeft = 405
ClientTop = 1605
ClientWidth = 8205
Icon = "frmAskList.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4515
ScaleWidth = 8205
Begin FPSpread.vaSpread spdDetail
Height = 2532
Left = 48
OleObjectBlob = "frmAskList.frx":0442
TabIndex = 7
Top = 1956
Width = 5412
End
Begin FPSpread.vaSpread spd
Height = 1545
Left = 30
OleObjectBlob = "frmAskList.frx":2B53
TabIndex = 1
Top = 405
Width = 8115
End
Begin ComnButtons.ButtonGroup btg
Height = 2265
Left = 5850
TabIndex = 6
Top = 2070
Width = 2115
_ExtentX = 3731
_ExtentY = 3995
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 = "&A.确定 &Q.查询 &E.关闭"
KeyEnabled = "1#1#1#"
End
Begin VB.TextBox txtDepart
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 990
TabIndex = 0
Text = "txtDepart"
Top = 60
Width = 2085
End
Begin MSMask.MaskEdBox mskDate
Height = 345
Index = 0
Left = 4110
TabIndex = 3
Top = 30
Width = 1200
_ExtentX = 2117
_ExtentY = 609
_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 = 330
Index = 1
Left = 5400
TabIndex = 4
Top = 30
Width = 1185
_ExtentX = 2090
_ExtentY = 582
_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 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 = 3150
TabIndex = 5
Top = 105
Width = 840
End
Begin VB.Label lblDepart
AutoSize = -1 'True
Caption = "请领对方"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 225
Left = 30
TabIndex = 2
Top = 90
Width = 960
End
End
Attribute VB_Name = "frmAskList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents CmnHlp As frmInputHelp
Attribute CmnHlp.VB_VarHelpID = -1
Private OldDepart As String
Public Event SelectAsk(TAsksObj As clsDrugItems)
Private HouseItemsobj As clsDrugItems
Private Sub InitForm()
Set CmnHlp = New frmInputHelp
Set CmnHlp.CN = gDbObj.CN
Init
FillData
End Sub
Private Sub Init()
txtDepart = ""
txtDepart.Tag = ""
spd.MaxRows = 0
mskDate(0).Text = gfnGetTime(gstrCOMN_DATE)
mskDate(1).Text = gfnGetTime(gstrCOMN_DATE)
End Sub
Private Sub btg_Click(ByVal WhichB As Integer)
Select Case WhichB
Case 0
If spd.ActiveRow >= 1 Then
RaiseEvent SelectAsk(HouseItemsobj)
Unload Me
End If
Case 1
FillData
Case 2
Unload Me
End Select
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
hisToActiveCtl(Me).SetFocus
End If
End Sub
Private Sub Form_Load()
hisFormToCenter Me, frmMain
InitForm
' FillData
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmAskList = Nothing
End Sub
Private Sub mskDate_LostFocus(Index As Integer)
If Not IsDate(mskDate(Index)) Then
MsgBox gstrDATE_ERROR_MSG, vbCritical
mskDate(Index).SetFocus
End If
End Sub
Private Sub spd_GotFocus()
spd.Row = spd.ActiveRow
spd.Col = 2
FillDataDetail spd.Text
End Sub
Private Sub spd_LeaveCell(ByVal Col As Long, ByVal Row As Long, ByVal NewCol As Long, ByVal NewRow As Long, Cancel As Boolean)
If Row > 0 And NewRow > 0 And Row <> NewRow Then
spd.Row = NewRow
spd.Col = 2
FillDataDetail spd.Text
End If
End Sub
Private Sub txtDepart_GotFocus()
OldDepart = txtDepart
End Sub
Private Sub txtDepart_LostFocus()
If OldDepart <> txtDepart Then
If txtDepart <> "" Then
CmnHlp.Sql = "SELECT m_Depart.DepCode,m_Depart.DepName FROM m_Depart" _
& " WHERE m_Depart.Brief LIKE '##%' AND m_Depart.Leaf = 1" _
& " AND Flag & 48 = 32 "
CmnHlp.InitPut = txtDepart.Text
CmnHlp.FormatHead = "药房编码|名 称 "
CmnHlp.WidthRate = 1
CmnHlp.ParmTag = "Depart"
CmnHlp.ShowHelp vbModal
Else
txtDepart.Tag = ""
End If
End If
End Sub
Private Sub CmnHlp_ResSelect(ByVal SelData As Variant, ByVal STag As String)
Me.SetFocus
If TypeName(SelData) <> "Nothing" Then
txtDepart.Tag = SelData(0)
txtDepart = SelData(1)
Else
txtDepart.Tag = ""
txtDepart = ""
End If
OldDepart = txtDepart
End Sub
Public Sub FillData()
Dim Sql As String
Dim tmpRS As Recordset
Sql = "SELECT House_BusMain.BusDate,House_BusMain.BusSerial," _
& "House_BusMain.SheetID,m_Depart.DepName,m_Handler.HdName " _
& "FROM (House_BusMain INNER JOIN m_Handler " _
& "ON House_BusMain.HdCode = m_Handler.HdCode) " _
& "INNER JOIN m_Depart ON House_BusMain.DsCode = m_Depart.DepCode " _
& "WHERE House_BusMain.Flag & 1 =1 AND House_BusMain.Flag & 2 = 0 " _
& "AND House_BusMain.Flag & 4 = 0 " _
& "AND House_BusMain.VsDepCode = '" & gtydSysConfig.DepCode & "'"
If txtDepart.Tag <> "" Then
Sql = Sql & " AND House_BusMain.DsCode = '" & txtDepart.Tag & "'"
End If
Sql = Sql & " AND BusDate >= '" & mskDate(0) & " 00:00:00' AND BusDate <='" & mskDate(0) & " 23:59:59'"
Set tmpRS = gDbObj.GetNewRs(Sql)
If tmpRS.RecordCount = 0 Then
spd.MaxRows = 0
Else
spd.Redraw = False
spd.MaxRows = tmpRS.RecordCount
spd.Row = 1
spd.Col = 1
spd.Row2 = spd.MaxRows
spd.Col2 = spd.MaxCols
spd.Clip = tmpRS.GetString
spd.Redraw = True
End If
If spd.MaxRows = 0 Then
spdDetail.MaxRows = 0
Else
If spd.Visible Then
hisActiveSpreadCell spd, 1, 1
spd.Row = 1
spd.Col = 2
FillDataDetail spd.Text
End If
End If
End Sub
Private Sub FillDataDetail(ByVal BusSerial As String)
Dim i As Integer
If HouseItemsobj Is Nothing Then
Set HouseItemsobj = New clsDrugItems
End If
HouseItemsobj.BusSerialByQuery = BusSerial
spdDetail.MaxRows = 0
spdDetail.MaxRows = HouseItemsobj.Count
For i = 1 To spdDetail.MaxRows
spdDetail.Row = i
spdDetail.Col = 1
spdDetail.Text = HouseItemsobj.Item(i).ItemName
spdDetail.Col = 2
spdDetail.Text = HouseItemsobj.Item(i).Model & " * " & HouseItemsobj.Item(i).Factor
spdDetail.Col = 3
spdDetail.Text = HouseItemsobj.Item(i).Unit
spdDetail.Col = 4
spdDetail.Text = HouseItemsobj.Item(i).Amount / HouseItemsobj.Item(i).Factor
Next i
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -