📄 frmlistcostprice.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 frmListCostPrice
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 = 324
Left = 5208
Top = 3192
Visible = 0 'False
Width = 1308
_ExtentX = 2307
_ExtentY = 572
_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 = "frmListCostPrice.frx":0000
Height = 2655
Left = 0
TabIndex = 5
Tag = "ctPayMethod////101"
Top = 480
Width = 6495
_ExtentX = 11451
_ExtentY = 4678
_Version = 393216
Rows = 20
Cols = 3
FixedCols = 0
BackColor = -2147483634
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 = "frmListCostPrice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'郑权
'1999.1.7
'入库成本仅针对“自制入库”
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 '列表对象
Attribute mclsList.VB_VarHelpID = -1
Private mclsPurchase As clsPurchase
'////////////////////////////////////////////////
'///// 赋值
'////////////////////////////////////////////////
Private Const intViewID = 124 '入库成本单：不同的列表窗口，其值不同
Private blnMenuBuilded As Boolean
Private strOldMenuCaption As String
Private theEditForm As Form
Private mIsShowEdit As Boolean '编辑窗口是否已调出标志
Private theEditRow As Long '弹出编辑窗口时本列表的当前行，编辑窗口的记录移动操作影响此值
Private bDblClick As Boolean
Private blnIsPost As Boolean '是否已记帐
Private blnIsVoid As Boolean '是否已作废
Private strReceiptType As String '单据类型名称
Private blnEdit As Boolean '编辑权限
Private blnChange As Boolean '只能编辑和删除自己制作的单据
Private mblnEnable As Boolean 'Whether or not save lngViewID in list
Private Sub cMsgBox(strMsg As String, Optional strTitle As String, Optional hwnd As Long = 0)
If Trim(strTitle) = "" Then
strTitle = "提示信息"
End If
If hwnd = 0 Then hwnd = Me.hwnd
ShowMsg 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
'获得当前行的lngCostPriceID
Private Function GetlngCostPriceID()
With grdList
If .Row > 0 Then
GetlngCostPriceID = CLng(.TextMatrix(.Row, 0))
Else
GetlngCostPriceID = -1
End If
End With
End Function
Private Function GetItemStatus(lngCostPriceID As Long, Optional hwnd As Long = 0) As Boolean
Dim recTemp As rdoResultset
If hwnd = 0 Then hwnd = Me.hwnd
strSql = "SELECT CostPrice.blnIsPost ,CostPrice.lngOperatorID, CostPrice.blnIsVoid From CostPrice WHERE (((CostPrice.lngCostPriceID)=" & lngCostPriceID & "))"
Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recTemp.BOF And recTemp.EOF Then
cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！", , hwnd
Exit Function
End If
blnIsPost = recTemp(0)
If gclsBase.OperatorID = recTemp(1) Then
blnChange = True
Else
blnChange = False
End If
blnIsVoid = recTemp(2)
Set recTemp = Nothing
GetItemStatus = True
End Function
Public Function GetList() As rdoResultset
Dim BeginDate As Date
Dim EndDate As Date
Dim recTemp As rdoResultset
Dim strSelect As String
Dim strFrom As String
Dim strWhere As String
Dim strGroup As String
Dim strHavingofsql As String
On Error Resume Next
strSelect = mclsList.ListSet.SelectOfSql
strFrom = mclsList.ListSet.FromOfSql
strWhere = mclsList.ListSet.WhereOfSql
strHavingofsql = mclsList.ListSet.HavingOfSql
If Trim(strSelect) = "" Or Trim(strFrom) = "" Then
Set GetList = Nothing
Exit Function
End If
If Trim(strHavingofsql) <> "" Then
strHavingofsql = " having " & strHavingofsql
End If
If mclsList.ListSet.ListID < 1 Then
BeginDate = gclsBase.PeriodBegin
EndDate = gclsBase.PeriodEnd
If Trim(strWhere) <> "" Then
strWhere = " WHERE " & strWhere & " and (To_Date(CostPrice.strDate,'rrrr-mm-dd')>=To_Date('" & _
BeginDate & "','rrrr-mm-dd') And To_Date(CostPrice.strDate,'rrrr-mm-dd')<=To_Date('" & _
EndDate & "','rrrr-mm-dd'))"
Else
strWhere = " WHERE " & "(To_Date(CostPrice.strDate,'rrrr-mm-dd')>=To_Date('" & _
BeginDate & "','rrrr-mm-dd') And To_Date(CostPrice.strDate,'rrrr-mm-dd')<=To_Date('" & _
EndDate & "','rrrr-mm-dd'))"
End If
Else
If Trim(strWhere) <> "" Then
strWhere = " where " & strWhere
End If
End If
strSelect = "SELECT CostPrice.lngCostPriceID, min(Decode(CostPrice.blnIsVoid,1,'√','')) AS ""作废""," & strSelect
strGroup = " GROUP BY CostPrice.lngCostPriceID"
strSql = strSelect & strFrom & strWhere & strGroup & strHavingofsql
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
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
.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
.mnuEditEdit.Caption = "修改(&E)"
.mnuEditNew.Caption = "新增(&N)"
.mnuEditDel.Caption = "删除(&D)"
.mnuEditInActive.Caption = "作废(&H)"
.mnuEditShowAll.Caption = "全部显示(&W)"
.mnuEditInActive.Visible = False
Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0) '修改
Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1) '新增
Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2) '删除
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -