📄 frmlistcompose.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 frmListCompose
BackColor = &H80000004&
Caption = "商品拆卸组装单列表"
ClientHeight = 3750
ClientLeft = 2580
ClientTop = 2595
ClientWidth = 6885
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 3750
ScaleWidth = 6885
Tag = "ctPayMethod////101"
Begin MSRDC.MSRDC datGrid
Height = 348
Left = 5208
Top = 3192
Visible = 0 'False
Width = 1284
_ExtentX = 2275
_ExtentY = 609
_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 = "frmListCompose.frx":0000
Height = 2655
Left = 0
TabIndex = 5
Tag = "ctPayMethod////101"
Top = 480
Width = 6495
_ExtentX = 11456
_ExtentY = 4683
_Version = 393216
Rows = 20
Cols = 3
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 = "frmListCompose"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'王成
'拆卸组装仅针对“自制入库”
Option Explicit
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 '列表对象
Attribute mclsList.VB_VarHelpID = -1
Private mclsPurchase As clsPurchase
'////////////////////////////////////////////////
'///// 赋值
'////////////////////////////////////////////////
Private Const intViewID = 142 '拆卸组装单：不同的列表窗口，其值不同
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 lngActivityTypeID As Long
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
'获得当前行的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 GetlngActivityTypeID(lngActivityID As Long) As Long
Dim strSql As String
Dim recTemplete As rdoResultset
strSql = "SELECT lngActivityTypeID From ItemActivity where lngActivityID=" & lngActivityID
Set recTemplete = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recTemplete.RowCount > 0 Then GetlngActivityTypeID = recTemplete!lngActivityTypeID
End Function
'返回本张单的各种状态
Private Function GetItemStatus(lngActivityID As Long) As Boolean
Dim strSql As String
Dim recTemp As rdoResultset
strSql = "SELECT ItemActivity.lngVoucherID, ItemActivity.lngOperatorID, ItemActivity.blnIsVoid, ItemActivity.lngActivityTypeID From ItemActivity WHERE (ItemActivity.lngActivityID)=" & lngActivityID
Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recTemp.BOF And recTemp.EOF Then
cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
Exit Function
End If
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
blnIsVoid = recTemp(2)
lngActivityTypeID = recTemp(3)
Set recTemp = Nothing
GetItemStatus = True
End Function
'获得记录集
Public Function GetList() As rdoResultset
Dim strSql As String
Dim recTemp As rdoResultset
Dim strSelect As String
Dim strFrom As String
Dim strWhere As String
On Error Resume Next
strSelect = mclsList.ListSet.GetSelect
strFrom = mclsList.ListSet.FromOfSql
strWhere = mclsList.ListSet.WhereOfSql
If Trim(strSelect) = "" Or Trim(strFrom) = "" Then
Set GetList = Nothing
Exit Function
End If
If Trim(strWhere) <> "" Then
strWhere = " WHERE " & strWhere & " AND "
Else
strWhere = " WHERE "
End If
strSelect = "SELECT ItemActivity.lngActivityID, decode(ItemActivity.blnIsVoid,1,'√','') AS ""作废""," & strSelect
'strWhere = strWhere & "(CDate([ItemActivity]![strDate])>=#" & BeginDate & "# And CDate([ItemActivity]![strDate])<=#" & EndDate & "#) AND (((ItemActivity.lngActivityTypeID) In (30,33)))"
If mclsList.ListSet.ListID < 1 Then
strWhere = strWhere & " (To_Date(ItemActivity.strDate,'rrrr-mm-dd')>=To_date('" & Format(gclsBase.PeriodBegin, "yyyy-mm-dd") & "','rrrr-mm-dd')) " & _
" AND (To_Date(ItemActivity.strDate,'rrrr-mm-dd')<=To_date('" & Format(gclsBase.PeriodEnd, "yyyy-mm-dd") & "','rrrr-mm-dd')) " & _
" AND (ItemActivity.lngActivityTypeID In (30,33))"
Else
strWhere = strWhere & " (ItemActivity.lngActivityTypeID In (30,33))"
End If
strSql = strSelect & strFrom & strWhere
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
'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
Dim blnIsnotEmpty As Boolean
Dim blnFindNoChange As Boolean
If grdList.Rows > 1 And grdList.ColSel <> 0 Then
blnIsnotEmpty = True
Else
blnIsnotEmpty = False
End If
If Not blnMenuBuilded Then
MakeListEditMenu
End If
With frmMain
.mnuEditEdit.Caption = "修改(&E)"
.mnuEditNew.Caption = "新增(&N)"
.mnuEditDel.Caption = "删除(&D)"
.mnuEditCopy.Enabled = blnIsnotEmpty
.mnuEditEdit.Enabled = blnIsnotEmpty And blnEdit
.mnuEditNew.Enabled = blnEdit
.mnuEditDel.Enabled = blnIsnotEmpty And blnEdit
.mnuEditInActive.Checked = False
.mnuEditInActive.Enabled = blnIsnotEmpty And blnEdit
If chkShowAll.Value = 1 Then
.mnuEditShowAll.Checked = True
Else
.mnuEditShowAll.Checked = False
End If
If chkShowAll.Enabled = True Then
.mnuEditShowAll.Enabled = True
Else
.mnuEditShowAll.Enabled = False
End If
.mnuEditColumn.Enabled = True
.mnuEditFilter.Enabled = True
.mnuFilePrint.Enabled = True
.mnuFilePrintSetup.Enabled = True
.mnuFilePrintReceipt.Enabled = True
.mnuReportQuick.Enabled = blnIsnotEmpty
.mnuToolRefresh.Enabled = True
Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0) '修改
Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1) '新增
Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2) '删除
Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3) '----
Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4) '作废
.mnuListEditMenu(4).Visible = True
Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5) '显示所有/显示非作废
.mnuListEditMenu(5).Visible = True
Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6) '----
.mnuListEditMenu(6).Visible = True
Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(7) '筛选
Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(8) '栏目设置
Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9) '----
Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(10) '刷新
Utility.CloneMenu .mnuFilePrintReceipt, .mnuListEditMenu(11)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -