📄 frmselectbill.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmSelectBill
BorderStyle = 1 'Fixed Single
Caption = "选择单据"
ClientHeight = 5310
ClientLeft = 45
ClientTop = 330
ClientWidth = 8775
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5310
ScaleWidth = 8775
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdOkCancel
Caption = "全部取消(&C)"
Height = 350
Index = 3
Left = 7500
TabIndex = 3
Tag = "1002"
Top = 1410
UseMaskColor = -1 'True
Width = 1210
End
Begin MSRDC.MSRDC Data1
Height = 330
Left = 7500
Top = 4860
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 582
_Version = 393216
Options = 0
CursorDriver = 0
BOFAction = 0
EOFAction = 0
RecordsetType = 3
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.CommandButton cmdOkCancel
Caption = "全部选择(&A)"
Height = 350
Index = 2
Left = 7500
TabIndex = 2
Tag = "1002"
Top = 1020
UseMaskColor = -1 'True
Width = 1210
End
Begin VB.CommandButton cmdOkCancel
Cancel = -1 'True
Height = 350
Index = 1
Left = 7500
Style = 1 'Graphical
TabIndex = 1
Tag = "1002"
Top = 630
UseMaskColor = -1 'True
Width = 1210
End
Begin VB.CommandButton cmdOkCancel
Default = -1 'True
Height = 350
Index = 0
Left = 7500
Style = 1 'Graphical
TabIndex = 0
Tag = "1001"
Top = 240
UseMaskColor = -1 'True
Width = 1210
End
Begin MSFlexGridLib.MSFlexGrid GrdCol
Bindings = "frmselectbill.frx":0000
Height = 4995
Left = 60
TabIndex = 6
Top = 240
Width = 7365
_ExtentX = 12991
_ExtentY = 8811
_Version = 393216
Cols = 20
FixedCols = 0
RowHeightMin = 270
BackColorBkg = -2147483643
GridColor = -2147483633
GridColorFixed = -2147483640
AllowBigSelection= 0 'False
FocusRect = 0
GridLinesFixed = 0
SelectionMode = 1
AllowUserResizing= 1
End
Begin VB.Label lblTitle
AutoSize = -1 'True
Caption = "币种:"
Height = 180
Index = 1
Left = 1410
TabIndex = 5
Top = 30
Visible = 0 'False
Width = 540
End
Begin VB.Label lblTitle
AutoSize = -1 'True
Caption = "单位:"
Height = 180
Index = 0
Left = 120
TabIndex = 4
Top = 30
Visible = 0 'False
Width = 540
End
End
Attribute VB_Name = "frmSelectBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private frmName As Form
Private lngReceiptTypeID As Long
Private strQueryName As String
Private strColName() As String
Private strCurrDec As String
Private blnSucceed As Boolean
Private mclsGrid As Grid
Attribute mclsGrid.VB_VarHelpID = -1
Private xlngColNo() As Long
Private lngSelected() As Long
Private blnFirst As Boolean
Public Function ShowMe(frmTmp As Form) As Boolean
Set frmName = frmTmp
If UCase(frmName.Name) = UCase("FrmSubmitAdjustBill") Then
lngReceiptTypeID = 26
Else
lngReceiptTypeID = C2lng(frmName.lblHead(2).Tag)
End If
Me.Show vbModal
ShowMe = blnSucceed
End Function
Private Sub Form_Activate()
If Me.HelpContextID <> 0 Then
SetHelpID Me.HelpContextID
End If
If blnFirst = True Then
Screen.MousePointer = vbHourglass
Me.Left = -32000
Dim i As Long
Dim lngTmp As Long
Dim lngBorrow As Long
If lngReceiptTypeID = 2 Then
lngBorrow = 0
ElseIf lngReceiptTypeID = 3 Then
lngBorrow = 0
ElseIf lngReceiptTypeID = 4 Then
lngBorrow = -1
End If
If UCase(frmName.Name) = "FRMSUBMITADJUSTBILL" Then
Set Data1.Resultset = GetReceiptList(strQueryName, frmName.getFieldID(7), _
C2lng(frmName.lblHead(0).Tag), 0, 0, frmName.getOutActivityID(), lngBorrow, 0)
Else
Set Data1.Resultset = GetReceiptList(strQueryName, frmName.getFieldID(7), _
C2lng(frmName.lblHead(0).Tag), 0, 0, frmName.getID(), lngBorrow, 0)
End If
If Not Data1.Resultset.EOF Then
Data1.Resultset.MoveLast
Else
cmdOkCancel(2).Enabled = False
cmdOkCancel(3).Enabled = False
End If
mclsGrid.ListSet.Columns = GrdCol.Cols - 1
GrdCol.TextMatrix(0, 1) = "选择"
ReDim strColName(GrdCol.Cols - 1)
ReDim xlngColNo(GrdCol.Cols - 1)
For i = 0 To GrdCol.Cols - 1
If InStr(GrdCol.TextMatrix(0, i), "数量") <> 0 Or InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
GrdCol.ColAlignment(i) = flexAlignRightCenter
' mclsGrid.ColType(i) = 1
Else
GrdCol.ColAlignment(i) = flexAlignLeftCenter
' mclsGrid.ColType(i) = 0
End If
strColName(i) = GrdCol.TextMatrix(0, i)
xlngColNo(i) = i
' mclsGrid.ColSort(i) = True
Next
ReDim lngSelected(frmName.GrdCol.Rows - 1)
For i = 1 To frmName.GrdCol.Rows - 1
If lngReceiptTypeID <> 26 Then
lngSelected(i) = C2lng(frmName.TextOfGrid(i, 29))
Else
lngSelected(i) = C2lng(frmName.GrdCol.TextMatrix(i, 30))
End If
Next
For i = GrdCol.Rows - 1 To 1 Step -1
lngTmp = C2lng(GrdCol.TextMatrix(i, 1))
GrdCol.RowData(i) = lngTmp
If lngSelectedRow(i) <> 0 Then
GrdCol.TextMatrix(i, 1) = "√"
Else
GrdCol.TextMatrix(i, 1) = ""
End If
Next
mclsGrid.ColOfs = 2
' mclsGrid.ListSetToGrid
mclsGrid.SetupStyle
If GrdCol.Rows > GrdCol.FixedRows Then
GrdCol.Row = GrdCol.FixedRows
GrdCol.RowSel = GrdCol.FixedRows
GrdCol.ColSel = GrdCol.Cols - 1
End If
Set GrdCol.MouseIcon = Utility.GetFormResPicture(2001, 2)
GrdCol.MousePointer = flexDefault
LoadGrdColWidth
If GrdCol.ColWidth(0) <> 0 Then
GrdCol.ColWidth(0) = 0
End If
GrdCol.Redraw = True
Me.Left = (Screen.width - Me.width) / 2
blnFirst = False
Screen.MousePointer = vbDefault
End If
End Sub
Private Sub Form_Load()
Dim i As Long
Dim j As Long
Dim lngTmp As Long
blnFirst = True
Utility.LoadFormResPicture Me
' Me.Icon = Utility.GetFormResPicture(139, vbResIcon) '窗体图标
' cmdOkCancel(0).Picture = Utility.GetFormResPicture(1001, vbResBitmap) '确定
' cmdOkCancel(3).Picture = Utility.GetFormResPicture(1021, vbResBitmap) '清除
' cmdOkCancel(1).Picture = Utility.GetFormResPicture(1002, vbResBitmap) '取消
Select Case lngReceiptTypeID
Case 2, 3, 4
strQueryName = "选择采购订单"
Me.Caption = "选择采购订单"
Case 13, 15, 18
strQueryName = "选择销售订单"
Me.Caption = "选择销售订单"
Case 8
strQueryName = "入库单开票"
Me.Caption = "选择开票入库单"
Case 20
strQueryName = "出库单开票"
Me.Caption = "选择开票出库单"
Case 14
strQueryName = "直运采购销售"
Me.Caption = "选择直运采购单"
Case 5
strQueryName = "受托代销结算"
Me.Caption = "选择受托代销入库单"
Case 19
strQueryName = "分期付款结算"
Me.Caption = "选择分期收款出库单"
Case 16
strQueryName = "委托代销结算"
Me.Caption = "选择委托代销出库单"
Case 26
strQueryName = "委托代销调拨"
Me.Caption = "选择委托代销出库单"
End Select
strCurrDec = FormatString(CurrencyDec(frmName.getFieldID(7)))
lblTitle(0).Caption = lblTitle(0).Caption & " " & frmName.lblHead(1).Caption
lblTitle(1).Caption = lblTitle(1).Caption & " " & frmName.lblField(7).Caption
If lngReceiptTypeID <> 14 Then
lblTitle(0).Visible = True
End If
lblTitle(1).Left = GrdCol.Left + GrdCol.width - lblTitle(1).width - (lblTitle(0).Left - GrdCol.Left)
lblTitle(1).Visible = True
GrdCol.Redraw = False
Set mclsGrid = New Grid
Set mclsGrid.Grid = GrdCol
mclsGrid.ListSet.ViewId = 999999999 '虚拟视图
mclsGrid.ColOfs = 1
' With gclsBase.BaseDB.QueryDefs(strQueryName)
' .Parameters("CurrencyID") = frmName.getFieldID(7)
' If lngReceiptTypeID <> 14 Then
' .Parameters("CustomerID") = C2lng(frmName.LblHead(0).Tag)
' End If
' .Parameters("ItemID") = 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -