📄 frmlistlendadjust.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmListLendAdjust
BackColor = &H80000004&
Caption = "委托代销商品调拨单列表"
ClientHeight = 3756
ClientLeft = 2580
ClientTop = 2592
ClientWidth = 6888
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 3756
ScaleWidth = 6888
Tag = "ctPayMethod////101"
Begin MSRDC.MSRDC datGrid
Height = 348
Left = 5448
Top = 3192
Visible = 0 'False
Width = 960
_ExtentX = 1693
_ExtentY = 614
_Version = 393216
Options = 0
CursorDriver = 0
BOFAction = 0
EOFAction = 0
RecordsetType = 1
LockType = 3
QueryType = 0
Prompt = 3
Appearance = 1
QueryTimeout = 30
RowsetSize = 100
LoginTimeout = 15
KeysetSize = 0
MaxRows = 0
ErrorThreshold = -1
BatchSize = 15
BackColor = -2147483643
ForeColor = -2147483640
Enabled = -1 'True
ReadOnly = 0 'False
Appearance = -1 'True
DataSourceName = ""
RecordSource = ""
UserName = ""
Password = ""
Connect = ""
LogMessages = ""
Caption = "MSRDC1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.CheckBox chkShowAll
Caption = "全部显示"
Height = 350
Left = 4080
TabIndex = 8
Top = 3180
Width = 1095
End
Begin VB.TextBox txtFind
Height = 300
Left = 3195
TabIndex = 3
Top = 75
Width = 3015
End
Begin VB.CommandButton cmdAgain
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 6240
Style = 1 'Graphical
TabIndex = 4
Tag = "1017"
ToolTipText = "再找"
Top = 90
UseMaskColor = -1 'True
Width = 300
End
Begin VB.ComboBox cboFindKind
Height = 300
Left = 720
Style = 2 'Dropdown List
TabIndex = 1
Top = 90
Width = 1515
End
Begin MSFlexGridLib.MSFlexGrid grdList
Bindings = "frmListLendAdjust.frx":0000
Height = 2655
Left = 0
TabIndex = 5
Tag = "ctPayMethod////101"
Top = 480
Width = 6495
_ExtentX = 11451
_ExtentY = 4678
_Version = 393216
Rows = 20
Cols = 13
FixedCols = 0
BackColor = 16777215
BackColorFixed = -2147483644
BackColorSel = -2147483646
BackColorBkg = 16777215
Redraw = -1 'True
AllowBigSelection= 0 'False
FocusRect = 0
SelectionMode = 1
AllowUserResizing= 1
End
Begin MSForms.CommandButton cmdReport
Height = 345
Left = 1260
TabIndex = 7
Tag = "1018"
Top = 3240
Visible = 0 'False
WhatsThisHelpID = 5010
Width = 1215
Caption = "报表"
PicturePosition = 196613
Size = "2143;609"
TakeFocusOnClick= 0 'False
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdEdit
Height = 350
Left = 50
TabIndex = 6
Tag = "1018"
Top = 3240
WhatsThisHelpID = 5010
Width = 1215
Caption = "编辑"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin VB.Label lblFind
AutoSize = -1 'True
Caption = "内容(&C)"
Height = 180
Left = 2460
TabIndex = 2
Top = 150
Width = 630
End
Begin VB.Label lblFindKind
AutoSize = -1 'True
Caption = "查找(&B)"
Height = 180
Left = 50
TabIndex = 0
Top = 150
Width = 630
End
End
Attribute VB_Name = "frmListLendAdjust"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'王成
Option Explicit
'采购业务包括如下的类型：
Private strSql As String
Private lngOldOperatorID As Long
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClass As SubClass32.SubClass '钩子对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass
Attribute mclsSubClassform.VB_VarHelpID = -1
Private mclsList As list '列表对象
Private mclsAdjust As clsAdjust
'////////////////////////////////////////////////
'///// 赋值
'////////////////////////////////////////////////
Private Const intViewID = 80 '代销调拨：不同的列表窗口，其值不同
Private blnMenuBuilded As Boolean
Private strOldMenuCaption As String
Private theEditForm As Form
Private mIsShowEdit As Boolean '编辑窗口是否已调出标志
Private theEditRow As Long '弹出编辑窗口时本列表的当前行，编辑窗口的记录移动操作影响此值
Private BeginDate As Date
Private EndDate As Date
Private bDblClick As Boolean
Private blnIsVouchered As Boolean '是否已生成凭证
Private blnIsVoid As Boolean '是否已作废
Private blnEdit As Boolean '编辑权限
Private blnChange As Boolean '只能编辑和删除自己制作的单据
Private mblnIsSaveListset As Boolean 'Whether or not save lngViewID in list
Private mblnFinish As Boolean
Private Sub cMsgBox(strMsg As String, Optional strTitle As String)
If Trim(strTitle) = "" Then
strTitle = "提示信息"
End If
ShowMsg Me.hwnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub
Private Sub GotoRow(lngRow As Long)
With grdList
.Row = lngRow
.ColSel = .Cols - 1
End With
End Sub
'返回行为row，列为col的cell在TextArray中的位置
Private Function pos(Row As Long, col As Long) As Long
pos = col + grdList.Cols * Row
End Function
'获得当前行的lngActivityID
Private Function GetlngActivityID()
With grdList
If .Row > 0 And .RowHeight(.Row) > 0 And .ColSel <> 0 Then
GetlngActivityID = CLng(.TextMatrix(.Row, 0))
Else
GetlngActivityID = 0
End If
End With
End Function
'返回本张单的各种状态
Private Function GetItemStatus(lngActivityID As Long) As Boolean
Dim recTemp As rdoResultset
strSql = "SELECT ItemActivity.lngVoucherID, ItemActivity.lngOperatorID From ItemActivity" _
& " WHERE (ItemActivity.lngActivityID)=" & lngActivityID
Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recTemp.BOF And recTemp.EOF Then Exit Function
If recTemp(0) > 0 Then
blnIsVouchered = True
Else
blnIsVouchered = False
End If
If gclsBase.OperatorID = recTemp(1) Then
blnChange = True
Else
blnChange = False
End If
Set recTemp = Nothing
GetItemStatus = True
End Function
'获得记录集
Public Function GetList() As rdoResultset
Dim recTemp As rdoResultset
Dim strSelect As String
Dim strFrom As String
Dim strWhere As String
Dim strGroup As String
Dim strHaving As String
' Dim arrHaving(12) As String
On Error Resume Next
' arrHaving(0) = "Sum([ItemActivityDetail]![dblQuantity])/2" '调拨数量
' arrHaving(1) = "IIF([ItemActivity]![lngActivityTypeID]=25,Sum([ItemActivityDetail]![dblAmount]),0)" '调出本币金额
' arrHaving(2) = "IIF([ItemActivity]![lngActivityTypeID]=25,Sum([ItemActivityDetail]![dblCurrAmount]),0)" '调出原币金额
' arrHaving(3) = "IIF([ItemActivity]![lngActivityTypeID]=25,Sum([ItemActivityDetail]![dblTaxAmount]),0)" '调出本币税额
' arrHaving(4) = "IIF([ItemActivity]![lngActivityTypeID]=25,Sum([ItemActivityDetail]![dblCurrTaxAmount]),0)" '调出原币税额
' arrHaving(5) = "IIF([ItemActivity]![lngActivityTypeID]=25,Sum([ItemActivityDetail]![dblTaxAmount]+[ItemActivityDetail]![dblAmount]),0)" '调出本币价税合计
' arrHaving(6) = "IIF([ItemActivity]![lngActivityTypeID]=25,Sum([ItemActivityDetail]![dblCurrTaxAmount]+[ItemActivityDetail]![dblCurrAmount]),0)" '调出原币价税合计
'
' arrHaving(7) = "IIF([ItemActivity_1]![lngActivityTypeID]=24,Sum([ItemActivityDetail_1]![dblAmount]),0)" '调入本币金额
' arrHaving(8) = "IIF([ItemActivity_1]![lngActivityTypeID]=24,Sum([ItemActivityDetail_1]![dblCurrAmount]),0)" '调入原币金额
' arrHaving(9) = "IIF([ItemActivity_1]![lngActivityTypeID]=24,Sum([ItemActivityDetail_1]![dblTaxAmount]),0)" '调入本币税额
' arrHaving(10) = "IIF([ItemActivity_1]![lngActivityTypeID]=24,Sum([ItemActivityDetail_1]![dblCurrTaxAmount]),0)" '调入原币税额
' arrHaving(11) = "IIF([ItemActivity_1]![lngActivityTypeID]=24,Sum([ItemActivityDetail_1]![dblTaxAmount]+[ItemActivityDetail_1]![dblAmount]),0)" '调入本币价税合计
' arrHaving(12) = "IIF([ItemActivity_1]![lngActivityTypeID]=24,Sum([ItemActivityDetail_1]![dblCurrTaxAmount]+[ItemActivityDetail_1]![dblCurrAmount]),0)" '调入原币价税合计
strSelect = mclsList.ListSet.GetSelect
' strSelect = strSelect & ",First(Currencys.bytCurrencyDec) AS CurDec,First(Currencys.bytRateDec) AS RateDec,First(" & gclsBase.NaturalCurDec & ") As NaturalCurDec "
strFrom = mclsList.ListSet.FromOfSql
strWhere = mclsList.ListSet.WhereOfSql
strHaving = mclsList.ListSet.HavingOfSql
If Trim(strSelect) = "" Or Trim(strFrom) = "" Then
Set GetList = Nothing
Exit Function
End If
' strWhere = Filter.ModifyCond(strWhere, arrHaving(), strHaving)
If Trim(strHaving) <> "" Then
strHaving = " AND " & strHaving
End If
If Trim(strWhere) <> "" Then
strWhere = " WHERE " & strWhere
If mclsList.ListSet.ListID < 1 Then
strWhere = strWhere & " And To_Date(ItemActivity.strDate,'rrrr-mm-dd')>=To_date('" & Format(gclsBase.PeriodBegin, "yyyy-mm-dd") & "') " & _
" And To_Date(ItemActivity.strDate,'rrrr-mm-dd')<=To_date('" & Format(gclsBase.PeriodEnd, "yyyy-mm-dd") & "') "
End If
' Else
' strWhere = " WHERE "
End If
strSelect = "SELECT ItemActivity_1.lngActivityID AS 调入ID, min(decode(ItemActivity.blnIsVoid,1,'√','')) AS ""作废""," & strSelect
'strWhere = strWhere & "CDate([ItemActivity]![strDate])>=#" & BeginDate & "# And CDate([ItemActivity]![strDate])<=#" & EndDate & "#"
' If Trim(strWhere) <> "" Then
' strWhere = strWhere & " and ((ItemActivity_1.lngActivityTypeID)=24) and ((ItemActivity.lngActivityTypeID)=25) "
'
' Else
' strWhere = " Where ((ItemActivity_1.lngActivityTypeID)=24) and ((ItemActivity.lngActivityTypeID)=25) "
' End If
strGroup = " GROUP BY ItemActivity_1.lngActivityID,ItemActivity_1.lngActivityTypeID,ItemActivity.lngActivityTypeID "
strHaving = " HAVING ItemActivity_1.lngActivityTypeID=24 and ItemActivity.lngActivityTypeID=25 " & strHaving
strSql = strSelect & strFrom & strWhere & strGroup & strHaving
Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'列表是否为空
If recTemp.RowCount = 0 Then
grdList.HighLight = flexHighlightNever '光标亮条消失
cmdAgain.Enabled = False
Else
grdList.HighLight = flexHighlightAlways '光标亮条显示
cmdAgain.Enabled = True
End If
' recTemp.FindFirst "作废 = '√'"
' If recTemp.NoMatch Then
' chkShowAll.Enabled = False '《全部显示》置灰
' frmMain.mnuEditShowAll.Enabled = False
' Else
' chkShowAll.Enabled = True
' frmMain.mnuEditShowAll.Enabled = True
' End If
mclsList.ShowAll = True
Set GetList = recTemp
End Function
'根据列表中记录数，设置菜单可用属性
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -