frmckquery.frm
来自「通用书店管理系统」· FRM 代码 · 共 1,357 行 · 第 1/4 页
FRM
1,357 行
ColumnFooters = -1 'True
DefColWidth = 0
HeadLines = 1
FootLines = 1
MultipleLines = 0
CellTipsWidth = 0
DeadAreaBackColor= 13160660
RowDividerColor = 13160660
RowSubDividerColor= 13160660
DirectionAfterEnter= 1
MaxRows = 250000
ViewColumnCaptionWidth= 0
ViewColumnWidth = 0
_PropDict = "_ExtentX,2003,3;_ExtentY,2004,3;_LayoutType,512,2;_RowHeight,16,3;_StyleDefs,513,0;_WasPersistedAsPixels,516,2"
_StyleDefs(0) = "_StyleRoot:id=0,.parent=-1,.alignment=3,.valignment=0,.bgcolor=&H80000005&"
_StyleDefs(1) = ":id=0,.fgcolor=&H80000008&,.wraptext=0,.locked=0,.transparentBmp=0"
_StyleDefs(2) = ":id=0,.fgpicPosition=0,.bgpicMode=0,.appearance=0,.borderSize=0,.ellipsis=0"
_StyleDefs(3) = ":id=0,.borderColor=&H80000005&,.borderType=0,.bold=0,.fontsize=900,.italic=0"
_StyleDefs(4) = ":id=0,.underline=0,.strikethrough=0,.charset=134"
_StyleDefs(5) = ":id=0,.fontname=宋体"
_StyleDefs(6) = "Style:id=1,.parent=0,.namedParent=33"
_StyleDefs(7) = "CaptionStyle:id=4,.parent=2,.namedParent=37"
_StyleDefs(8) = "HeadingStyle:id=2,.parent=1,.namedParent=34,.alignment=2"
_StyleDefs(9) = "FooterStyle:id=3,.parent=1,.namedParent=35"
_StyleDefs(10) = "InactiveStyle:id=5,.parent=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
_StyleDefs(11) = "SelectedStyle:id=6,.parent=1,.namedParent=36"
_StyleDefs(12) = "EditorStyle:id=7,.parent=1"
_StyleDefs(13) = "HighlightRowStyle:id=8,.parent=1,.namedParent=38"
_StyleDefs(14) = "EvenRowStyle:id=9,.parent=1,.namedParent=39"
_StyleDefs(15) = "OddRowStyle:id=10,.parent=1,.namedParent=40"
_StyleDefs(16) = "RecordSelectorStyle:id=11,.parent=2,.namedParent=41"
_StyleDefs(17) = "FilterBarStyle:id=12,.parent=1,.namedParent=42"
_StyleDefs(18) = "Splits(0).Style:id=13,.parent=1"
_StyleDefs(19) = "Splits(0).CaptionStyle:id=22,.parent=4"
_StyleDefs(20) = "Splits(0).HeadingStyle:id=14,.parent=2"
_StyleDefs(21) = "Splits(0).FooterStyle:id=15,.parent=3"
_StyleDefs(22) = "Splits(0).InactiveStyle:id=16,.parent=5"
_StyleDefs(23) = "Splits(0).SelectedStyle:id=18,.parent=6"
_StyleDefs(24) = "Splits(0).EditorStyle:id=17,.parent=7"
_StyleDefs(25) = "Splits(0).HighlightRowStyle:id=19,.parent=8"
_StyleDefs(26) = "Splits(0).EvenRowStyle:id=20,.parent=9"
_StyleDefs(27) = "Splits(0).OddRowStyle:id=21,.parent=10"
_StyleDefs(28) = "Splits(0).RecordSelectorStyle:id=23,.parent=11"
_StyleDefs(29) = "Splits(0).FilterBarStyle:id=24,.parent=12"
_StyleDefs(30) = "Splits(0).Columns(0).Style:id=28,.parent=13"
_StyleDefs(31) = "Splits(0).Columns(0).HeadingStyle:id=25,.parent=14"
_StyleDefs(32) = "Splits(0).Columns(0).FooterStyle:id=26,.parent=15"
_StyleDefs(33) = "Splits(0).Columns(0).EditorStyle:id=27,.parent=17"
_StyleDefs(34) = "Splits(0).Columns(1).Style:id=32,.parent=13"
_StyleDefs(35) = "Splits(0).Columns(1).HeadingStyle:id=29,.parent=14"
_StyleDefs(36) = "Splits(0).Columns(1).FooterStyle:id=30,.parent=15"
_StyleDefs(37) = "Splits(0).Columns(1).EditorStyle:id=31,.parent=17"
_StyleDefs(38) = "Named:id=33:Normal"
_StyleDefs(39) = ":id=33,.parent=0"
_StyleDefs(40) = "Named:id=34:Heading"
_StyleDefs(41) = ":id=34,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
_StyleDefs(42) = ":id=34,.wraptext=-1"
_StyleDefs(43) = "Named:id=35:Footing"
_StyleDefs(44) = ":id=35,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
_StyleDefs(45) = "Named:id=36:Selected"
_StyleDefs(46) = ":id=36,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
_StyleDefs(47) = "Named:id=37:Caption"
_StyleDefs(48) = ":id=37,.parent=34,.alignment=2"
_StyleDefs(49) = "Named:id=38:HighlightRow"
_StyleDefs(50) = ":id=38,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
_StyleDefs(51) = "Named:id=39:EvenRow"
_StyleDefs(52) = ":id=39,.parent=33,.bgcolor=&HFFFF00&"
_StyleDefs(53) = "Named:id=40:OddRow"
_StyleDefs(54) = ":id=40,.parent=33"
_StyleDefs(55) = "Named:id=41:RecordSelector"
_StyleDefs(56) = ":id=41,.parent=34"
_StyleDefs(57) = "Named:id=42:FilterBar"
_StyleDefs(58) = ":id=42,.parent=33"
End
End
End
Attribute VB_Name = "frmCKQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private strQuery(2) As String
Public Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub chkFields_Click(Index As Integer)
Select Case Index
Case 0 '出库类型
If chkFields(Index).Value = 1 Then
cmdSearch(2).Enabled = True
Else
cmdSearch(2).Enabled = False
End If
Case 1 '书号
If chkFields(Index).Value = 1 Then
cmdSearch(3).Enabled = True
Else
cmdSearch(3).Enabled = False
End If
Case 2 '书名
If chkFields(Index).Value = 1 Then
cmdSearch(4).Enabled = True
Else
cmdSearch(4).Enabled = False
End If
' Case 3 '是否审批
' If chkFields(Index).Value = 1 Then
' dtpDate(0).Visible = True
' dtpDate(1).Visible = True
' Label1(0).Visible = True
' Label1(1).Visible = True
' Else
' dtpDate(0).Visible = False
' dtpDate(1).Visible = False
' Label1(0).Visible = False
' Label1(1).Visible = False
' End If
Case 5 '出库类型
If chkFields(Index).Value = 1 Then
cmdSearch(7).Enabled = True
Else
cmdSearch(7).Enabled = False
End If
Case 6 '书号
' If chkFields(Index).Value = 1 Then
' cmdSearch(7).Enabled = True
' Else
' cmdSearch(7).Enabled = False
' End If
Case 4 '书名
If chkFields(Index).Value = 1 Then
cmdSearch(5).Enabled = True
Else
cmdSearch(5).Enabled = False
End If
' Case 7 '是否审批
' If chkFields(Index).Value = 1 Then
' dtpDate(2).Visible = True
' dtpDate(3).Visible = True
' Label1(2).Visible = True
' Label1(3).Visible = True
' Else
' dtpDate(2).Visible = False
' dtpDate(3).Visible = False
' Label1(2).Visible = False
' Label1(3).Visible = False
' End If
End Select
End Sub
Private Sub cmdExit_Click(Index As Integer)
Select Case Index
Case 0
Frame1(0).Visible = False
Case 1
Frame1(1).Visible = False
End Select
End Sub
Private Sub cmdOK_Click(Index As Integer)
Dim i As Integer
Dim strSubQuery(6) As String
Dim strFoot As String
Dim sqlstring As String
Dim rstmp As New ADODB.Recordset
Dim rsNewTmp As New ADODB.Recordset
On Error GoTo err
For i = 0 To 4
strSubQuery(i) = ""
Next i
Select Case Index
Case 0
'出库类型
If chkFields(0).Value = 1 And Trim(txtFields(0).Text) <> "" Then
strSubQuery(0) = "T2.ChrOutStorageNo like '%" & Trim(txtFields(0).Text) & "%'"
End If
'书号
If chkFields(1).Value = 1 And Trim(txtFields(1).Text) <> "" Then
strSubQuery(1) = "T1.chrBookNO like '%" & Trim(txtFields(1).Text) & "%'"
End If
'书名
If chkFields(2).Value = 1 And Trim(txtFields(2).Text) <> "" Then
strSubQuery(2) = "T1.chrBookName like '%" & Trim(txtFields(2).Text) & "%'"
End If
'出库单号
If chkFields(8).Value = 1 And Trim(txtFields(6).Text) <> "" Then
strSubQuery(4) = "T2.ChrCKDH like '%" & Trim(txtFields(6).Text) & "%'"
End If
'是否审批
If chkFields(3).Value = 1 Then
Select Case cmbFields(0)
Case "是"
strSubQuery(3) = "DatSPDate between #" & Format(dtpDate(0).Value, "yyyy-mm-dd") & _
"# and #" & Format(dtpDate(1).Value, "yyyy-mm-dd") & "#"
Case "否"
strSubQuery(3) = "DatSPDate is null"
End Select
End If
strQuery(0) = "where "
For i = 0 To 4
If Trim(strSubQuery(i)) <> "" Then
strQuery(0) = strQuery(0) & strSubQuery(i) & " and "
End If
Next
If Trim(strQuery(0)) = "where" Then
strQuery(0) = strQuery(0) & " 2=2 and "
End If
strQuery(0) = Mid(strQuery(0), 1, Len(strQuery(0)) - 4)
If Trim(strQuery(0)) = "where" Then '没选任何条件
Frame1(0).Visible = False
Exit Sub
Else
'明细
sqlstring = "SELECT T1.ChrCKDH, T1.ChrBookNo, T1.ChrBookName, T3.ChrOutStorageName, T2.ChrStorageNo1, T2.ChrStorageNo2, T1.DecPrice, T1.DecAgio, " & _
" T1.IntAmount,T1.IntAmount*T1.decPrice as decMoney,T1.IntAmount*T1.decPrice*T1.decAgio as decFactMoney FROM (OutstorageInformation_List T1 " & _
" LEFT JOIN OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) LEFT JOIN OutStorageType T3 ON T2.ChrOutStorageNo = T3.ChrOutStorageNo " & strQuery(0) & " order by T1.ChrCKDH desc"
Set rstmp = New ADODB.Recordset
rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
Set tdbQuery(0).DataSource = rstmp
sqlstring = "SELECT sum(T1.IntAmount),sum(T1.IntAmount*T1.decPrice),sum(T1.IntAmount*T1.decPrice*T1.decAgio) FROM (OutstorageInformation_List T1 " & _
" LEFT JOIN OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) LEFT JOIN OutStorageType T3 ON T2.ChrOutStorageNo = T3.ChrOutStorageNo " & strQuery(0)
Set rsNewTmp = New ADODB.Recordset
rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
If Not rsNewTmp.EOF Then
strFoot = "||||||||" & Format(rsNewTmp.Fields(0), "#,##0") & "| " & Format(rsNewTmp.Fields(1), "#,##0.00") & "| " & Format(rsNewTmp.Fields(2), "#,##0.00") & _
"|||||"
Else
strFoot = "||||||||||||"
End If
Call SetGridheader("出库单号|书号|书名|出库类型|出库区号|入库区号|单价|折扣|数量|码洋|实洋", 0, "20|15|25|10|10|10|10|8|15|15|15", strFoot)
Call clearAll
End If
Frame1(0).Visible = False
Case 1
'出库类型
If chkFields(5).Value = 1 And Trim(txtFields(4).Text) <> "" Then
strSubQuery(0) = "T1.ChrOutStorageNo like '%" & Trim(txtFields(3).Text) & "%'"
End If
'书号
' If chkFields(6).Value = 1 And Trim(txtFields(4).Text) <> "" Then
' strSubQuery(1) = "T1.chrBookNO like'%" & Trim(txtFields(4).Text) & "%'"
' End If
'书名
If chkFields(4).Value = 1 And Trim(txtFields(5).Text) <> "" Then
strSubQuery(2) = "T1.chrBookName like'%" & Trim(txtFields(5).Text) & "%'"
End If
'是否审批
If chkFields(7).Value = 1 Then
Select Case cmbFields(1)
Case "是"
strSubQuery(3) = "DatSPDate between #" & Format(dtpDate(2).Value, "yyyy-mm-dd") & _
"# and #" & Format(dtpDate(3).Value, "yyyy-mm-dd") & "#"
Case "否"
strSubQuery(3) = "DatSPDate is null"
End Select
End If
strQuery(1) = "where "
For i = 0 To 3
If Trim(strSubQuery(i)) <> "" Then
strQuery(1) = strQuery(1) & strSubQuery(i) & " and "
End If
Next
If Trim(strQuery(1)) = "where" Then
strQuery(1) = strQuery(1) & " 2=2 and "
End If
strQuery(1) = Mid(strQuery(1), 1, Len(strQuery(1)) - 4)
If Trim(strQuery(1)) = "where" Then '没选任何条件
Frame1(1).Visible = False
Exit Sub
Else
'汇总
sqlstring = "SELECT count(chrBookNo),chrBookNo,chrBookName,sum(intAmount) as intTotal,sum(decMoney) as decTotalMoney," & _
"sum(decFactMoney) as decTotalFactMoney From (SELECT T1.ChrBookNo, T1.ChrBookName,T1.IntAmount," & _
"T1.IntAmount*T1.decPrice as decMoney,T1.IntAmount*T1.decPrice*T1.decAgio as decFactMoney " & _
" FROM (OutstorageInformation_List T1 LEFT JOIN OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) " & _
strQuery(1) & " )A Group by chrBookNo,chrBookName"
Set rstmp = New ADODB.Recordset
rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
Set tdbQuery(1).DataSource = rstmp
sqlstring = "Select sum(intTotal),sum(decTotalMoney),sum(decTotalFactMoney) From (SELECT count(chrBookNo),chrBookNo," & _
" chrBookName,sum(intAmount) as intTotal,sum(decMoney) as decTotalMoney,sum(decFactMoney) as decTotalFactMoney " & _
" From (SELECT T1.ChrBookNo, T1.ChrBookName,T1.IntAmount,T1.IntAmount*T1.decPrice as decMoney," & _
" T1.IntAmount*T1.decPrice*T1.decAgio as decFactMoney FROM (OutstorageInformation_List T1 LEFT JOIN " & _
" OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) " & strQuery(1) & ")A Group by chrBookNo,chrBookName)T"
Set rsNewTmp = New ADODB.Recordset
rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
If Not rsNewTmp.EOF Then
strFoot = "|||" & Format(rsNewTmp.Fields(0), "#,##0") & "| " & Format(rsNewTmp.Fields(1), "#,##0.00") & "| " & Format(rsNewTmp.Fields(2), "#,##0.00")
Else
strFoot = "|||||"
End If
Call SetGridheader("笔数|书号|书名|数量|码洋|实洋", 1, "8|15|25|15|15|15", strFoot)
Call clearAll
End If
Frame1(1).Visible = False
End Select
Exit Sub
err:
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?