📄 frmsentry.frm
字号:
VERSION 5.00
Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "vsflex7.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmSEntry
BorderStyle = 3 'Fixed Dialog
Caption = "选择工序"
ClientHeight = 6660
ClientLeft = 45
ClientTop = 435
ClientWidth = 10845
Icon = "frmSEntry.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6660
ScaleWidth = 10845
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.Frame fraLeft
Height = 6645
Left = 30
TabIndex = 0
Top = 0
Width = 10815
Begin VB.CheckBox chkAll
Appearance = 0 'Flat
Caption = "全选"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 195
Left = 180
TabIndex = 5
Top = 270
Width = 795
End
Begin VB.CommandButton cmdOK
Caption = "确定"
Height = 315
Left = 8460
TabIndex = 2
Top = 240
Width = 825
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消"
Height = 315
Left = 9540
TabIndex = 1
Top = 240
Width = 825
End
Begin MSComctlLib.StatusBar stbTitle
Height = 315
Left = 60
TabIndex = 3
Top = 660
Width = 10710
_ExtentX = 18891
_ExtentY = 556
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 18838
Text = "内容"
TextSave = "内容"
EndProperty
EndProperty
End
Begin VSFlex7Ctl.VSFlexGrid vfgList
Height = 5535
Left = 60
TabIndex = 4
TabStop = 0 'False
Top = 1020
Width = 10710
_cx = 18891
_cy = 9763
_ConvInfo = 1
Appearance = 0
BorderStyle = 1
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = -2147483643
ForeColor = -2147483640
BackColorFixed = 14737632
ForeColorFixed = -2147483630
BackColorSel = 16250352
ForeColorSel = 16711680
BackColorBkg = 16777215
BackColorAlternate= -2147483643
GridColor = 12632256
GridColorFixed = -2147483632
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 2
HighLight = 1
AllowSelection = 0 'False
AllowBigSelection= 0 'False
AllowUserResizing= 1
SelectionMode = 1
GridLines = 1
GridLinesFixed = 2
GridLineWidth = 1
Rows = 20
Cols = 10
FixedRows = 1
FixedCols = 0
RowHeightMin = 300
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = $"frmSEntry.frx":0442
ScrollTrack = 0 'False
ScrollBars = 3
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = 0 'False
AutoSizeMode = 0
AutoSearch = 1
AutoSearchDelay = 3
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 2
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 1
OwnerDraw = 0
Editable = 0
ShowComboButton = 1
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
DataMember = ""
ComboSearch = 3
AutoSizeMouse = -1 'True
FrozenRows = 0
FrozenCols = 0
AllowUserFreezing= 0
BackColorFrozen = 0
ForeColorFrozen = 0
WallPaperAlignment= 9
End
End
End
Attribute VB_Name = "frmSEntry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mstrID As String
Private mblnOK As Boolean
Private mstrNumberList As String
Private Const conSelected = 0
Private Const conID = 1
Private Const conProcessNumber = 2
Private Const conProcessName = 3
Private Const conQty = 4
Private Const conPayDate = 5
Private Const conPreEndDate = 6
Private Const conEndDate = 7
Private Const conWorker = 8
Private Const conRemark = 9
'==================================
'函数名： GetEntry
'功能 ：
'参数 ： strID --- 业务号
'返回 : 是否成功
'==================================
Public Function GetEntry(ByRef strID As String, ByRef vfgEntry As VSFlexGrid) As Boolean
On Error GoTo Err
Dim lngI As Long
Dim lngJ As Long
Dim lngRow As Long
Dim blnExist As Boolean
mblnOK = False
mstrID = strID
'过滤出已存在的记录
mstrNumberList = ""
With vfgEntry
For lngI = 1 To .Rows - 1
If Trim(.TextMatrix(lngI, 1)) <> "" Then mstrNumberList = mstrNumberList & "'" & .TextMatrix(lngI, 1) & "',"
Next
If mstrNumberList <> "" Then mstrNumberList = "(" & Left(mstrNumberList, Len(mstrNumberList) - 1) & ")"
End With
Call RefreshList
Me.Show 1
If mblnOK Then
With vfgList
lngRow = vfgEntry.Row
For lngI = 1 To .Rows - 1
If .TextMatrix(lngI, conSelected) <> "" Then
vfgEntry.AddItem "", lngRow + 1
For lngJ = conID To conRemark
vfgEntry.TextMatrix(lngRow, lngJ - 1) = .TextMatrix(lngI, lngJ)
Next
lngRow = lngRow + 1
End If
Next lngI
End With
End If
GetEntry = mblnOK
Exit Function
Err:
Call ErrTreat(Err.Number, Err.Source, Err.Description)
End Function
'==================================
'刷新数据
'==================================
Private Sub RefreshList()
On Error GoTo Err
Dim rstTmp As ADODB.Recordset
Dim strSQL As String
Dim lngI As Long
strSQL = " SELECT * FROM ( " & _
" SELECT a.*,c.FCheck FROM t_GP_PGBillEntry a " & _
" LEFT JOIN t_GP_PEBillEntry b on b.FID=a.FID and b.FProcessNumber=a.FProcessNumber " & _
" LEFT JOIN t_GP_PEBill c on c.FBillID=b.FBillID " & _
" ) t Where t.FCheck Is Null AND t.FID='" & mstrID & "'"
If mstrNumberList <> "" Then strSQL = strSQL & " AND t.FProcessNumber NOT IN " & mstrNumberList
Set rstTmp = GetRecordset(strSQL)
vfgList.Rows = 1
'显示表体
If rstTmp.RecordCount > 0 Then
rstTmp.MoveFirst
With vfgList
.Rows = rstTmp.RecordCount + 1
For lngI = 1 To rstTmp.RecordCount
.TextMatrix(lngI, conID) = rstTmp!FEntryID
.TextMatrix(lngI, conProcessNumber) = rstTmp!FProcessNumber
.TextMatrix(lngI, conProcessName) = rstTmp!FProcessName
.TextMatrix(lngI, conQty) = rstTmp!FQty
.TextMatrix(lngI, conPayDate) = rstTmp!FPayDate
.TextMatrix(lngI, conPreEndDate) = rstTmp!FEndDate
' .TextMatrix(lngI, conEndDate) = rstTmp!FEndDate & ""
.TextMatrix(lngI, conWorker) = rstTmp!FWorker
.TextMatrix(lngI, conRemark) = rstTmp!FRemark & ""
rstTmp.MoveNext
Next
End With
End If
Set rstTmp = Nothing
Exit Sub
Err:
Set rstTmp = Nothing
Call ErrTreat(Err.Number, Err.Source, Err.Description)
End Sub
Private Sub chkAll_Click()
Dim lngI As Long
With vfgList
For lngI = 1 To .Rows - 1
.TextMatrix(lngI, 0) = chkAll.Value = 1
Next
End With
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
mblnOK = True
Me.Hide
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then Call cmdCancel_Click
End Sub
Private Sub vfgList_Click()
With vfgList
If .MouseCol <> conSelected Then Exit Sub
If .MouseRow < 1 Then Exit Sub
If .Row < 1 Then Exit Sub
.TextMatrix(.Row, conSelected) = IIf(.TextMatrix(.Row, conSelected) = "", True, "")
End With
End Sub
Private Sub vfgList_StartEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
If Not (Col = conSelected Or Col = conQty) Then Cancel = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -