📄
字号:
VERSION 5.00
Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
Begin VB.Form KF_FrmStockChoice
BorderStyle = 3 'Fixed Dialog
Caption = "采购入库单选择"
ClientHeight = 4335
ClientLeft = 45
ClientTop = 330
ClientWidth = 8865
Icon = "采购入库单选择.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4335
ScaleWidth = 8865
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Gridsz
Caption = "保存表格格式"
Height = 300
Index = 0
Left = 7260
TabIndex = 4
Top = 3960
Visible = 0 'False
Width = 1335
End
Begin VB.CommandButton CmdOK
Caption = "确定(&O)"
Height = 315
Left = 3420
TabIndex = 3
Top = 3960
Width = 1245
End
Begin VB.CommandButton CmdChoice
Caption = "选定(&C)"
Height = 315
Left = 1830
TabIndex = 2
Top = 3960
Width = 1245
End
Begin VB.CommandButton CmdExit
Caption = "退出(&E)"
Height = 315
Left = 240
TabIndex = 1
Top = 3960
Width = 1245
End
Begin VSFlex8Ctl.VSFlexGrid vs
Height = 3675
Left = 120
TabIndex = 0
Top = 120
Width = 8595
_ExtentX = 15161
_ExtentY = 6482
Appearance = 1
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 = -2147483633
ForeColorFixed = -2147483630
BackColorSel = -2147483635
ForeColorSel = -2147483634
BackColorBkg = -2147483636
BackColorAlternate= -2147483643
GridColor = -2147483633
GridColorFixed = -2147483632
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 1
HighLight = 1
AllowSelection = -1 'True
AllowBigSelection= -1 'True
AllowUserResizing= 0
SelectionMode = 0
GridLines = 1
GridLinesFixed = 2
GridLineWidth = 1
Rows = 1
Cols = 1
FixedRows = 1
FixedCols = 0
RowHeightMin = 0
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = 0 'False
ScrollBars = 3
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 0 'False
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
End
End
Attribute VB_Name = "KF_FrmStockChoice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************
'* 模 块 名 称 :采购入库单选择
'* 功 能 描 述 :
'* 程序员姓名 :张万成
'* 最后修改人 :张万成
'* 最后修改时间:2001/09/20
'* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
'******************************************************************
Dim GridCode As String '显示网格网格代码
Dim GridInf() As Variant '整个网格设置信息
Dim Tsxx As String '系统提示信息
Dim Qslz As Long '网格隐藏(非操作显示)列数
Dim Sjhgd As Double '网格数据行高度
Dim Sfxshjwg As Boolean '是否显示合计网格
Dim GridBoolean() As Boolean '网格列信息(布尔型)
Dim GridStr() As String '网格列信息(字符型)
Dim GridInt() As Integer '网格列信息(整型)
Dim Szzls As Integer '数组总列数(网格列数-1)
Dim strMain As String
Dim strSub As String
Public Bln As Boolean
Private Sub CmdChoice_Click()
With vs
For Rowjsq = .FixedRows To .Rows - 1
If .IsSelected(Rowjsq) Then
vs.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = "√"
Else
vs.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = ""
End If
Next Rowjsq
End With
End Sub
Private Sub CmdExit_Click()
KF_FrmMateInCxjg.StrTemp1 = ""
KF_FrmMateInCxjg.StrTemp2 = ""
Unload Me
End Sub
Private Sub CmdOK_Click()
strMain = ""
strSub = ""
With vs
For Rowjsq = .FixedRows To .Rows - 1
If vs.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = "√" Then
strMain = strMain + Trim(.TextMatrix(Rowjsq, 0)) + ","
strSub = strSub + Trim(.TextMatrix(Rowjsq, 1)) + ","
End If
Next Rowjsq
End With
If strMain <> "" Then
KF_FrmMateInCxjg.StrTemp1 = Mid(Trim(strMain), 1, Len(Trim(strMain)) - 1)
End If
If strSub <> "" Then
KF_FrmMateInCxjg.StrTemp2 = Mid(Trim(strSub), 1, Len(Trim(strSub)) - 1)
End If
Unload Me
End Sub
Private Sub Form_Load()
GridCode = "KF_StockChoice"
Call BzWgcsh(vs, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
Qslz = GridInf(1)
Sjhgd = GridInf(2)
Sfxshjwg = GridInf(7)
Szzls = vs.Cols - 1
vs.ExplorerBar = flexExNone
strMain = ""
strSub = ""
Call Fillstock(Bln)
End Sub
Private Sub Fillstock(Bln As Boolean)
Dim str As String
Dim adostock As New ADODB.Recordset
Dim jsq As Long
If Trim(KF_FrmMateInCxjg.strWhCode) <> "" And Trim(KF_FrmMateInCxjg.strMnumber) <> "" Then
If KF_FrmMateInCxjg.Option2.Value Then
If Bln Then
str = "select mnumber,mname,emoney,suppliercode,supplierName,inoutmainid,inoutsubid,FactReceiptquan ,billnum from kf_v_stockin where suppliercode in(" & Trim(Mid(Trim(KF_FrmMateInCxjg.strWhCode), 1, Len(Trim(KF_FrmMateInCxjg.strWhCode)) - 1)) & ") and balancedate is null order by inoutmainid"
Else
str = "select mnumber,mname,emoney,suppliercode,supplierName,inoutmainid,inoutsubid,FactReceiptquan,billnum from kf_v_stockin where suppliercode in(" & Trim(Mid(Trim(KF_FrmMateInCxjg.strWhCode), 1, Len(Trim(KF_FrmMateInCxjg.strWhCode)) - 1)) & ") and balancedate is not null order by inoutmainid"
End If
Else
If Bln Then
str = "select mnumber,mname,emoney,suppliercode,supplierName,inoutmainid,inoutsubid,FactReceiptquan,billnum from kf_v_stockin where mnumber in(" & Trim(Mid(Trim(KF_FrmMateInCxjg.strMnumber), 1, Len(Trim(KF_FrmMateInCxjg.strMnumber)) - 1)) & ") and balancedate is null order by inoutmainid"
Else
str = "select mnumber,mname,emoney,suppliercode,supplierName,inoutmainid,inoutsubid,FactReceiptquan,billnum from kf_v_stockin where mnumber in(" & Trim(Mid(Trim(KF_FrmMateInCxjg.strMnumber), 1, Len(Trim(KF_FrmMateInCxjg.strMnumber)) - 1)) & ") and balancedate is not null order by inoutmainid"
End If
End If
Set adostock = Cw_DataEnvi.DataConnect.Execute(str)
vs.Rows = vs.FixedRows
jsq = vs.FixedRows
With adostock
If Not .EOF Then
Do While Not .EOF
vs.AddItem ""
vs.TextMatrix(jsq, 0) = Val(.Fields("inoutmainid"))
vs.TextMatrix(jsq, 1) = Val(.Fields("inoutsubid"))
vs.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("suppliername") & "")
vs.TextMatrix(jsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("billnum") & "")
vs.TextMatrix(jsq, Sydz("003", GridStr(), Szzls)) = Val(.Fields("Emoney") & "")
vs.TextMatrix(jsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("mnumber") & "") + "-" + Trim(.Fields("mname") & "")
vs.TextMatrix(jsq, Sydz("006", GridStr(), Szzls)) = Val(.Fields("FactReceiptquan") & "")
vs.RowHeight(jsq) = Sjhgd
jsq = jsq + 1
.MoveNext
Loop
End If
End With
vs.SelectionMode = flexSelectionListBox
End If
End Sub
Public Sub Bcwggs(Bcgsgrid As vsFlexGrid, Wggsdm As String, GridStr() As String) '保存网格格式(包括网格列宽,网格列顺序)
'过程参数:Bcgsgrid 保存格式网格对象,Wggsdm 网格格式代码(网格参数),GridStr() 从中取网格列索引信息
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim Qslzte As Integer '起始列值
Dim Tsxx As String '系统信息提示
Cw_DataEnvi.DataConnect.BeginTrans
On Error GoTo Swcwcl
If RecTemp.State = 1 Then RecTemp.Close
RecTemp.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With RecTemp
If Not .EOF Then
Qslzte = .Fields("BeginCol")
.MoveNext
End If
Do While Not .EOF
For jsqte = Qslzte To Bcgsgrid.Cols - 1
If Trim(.Fields("ColIndex")) = Trim(GridStr(jsqte, 1)) Then
Exit For
End If
Next jsqte
If jsqte <= Bcgsgrid.Cols - 1 Then
.Fields("ColId") = jsqte - Qslzte + 1
.Fields("ColWidth") = Bcgsgrid.ColWidth(jsqte)
.Update
End If
.MoveNext
Loop
End With
Cw_DataEnvi.DataConnect.CommitTrans
Tsxx = "表格格式保存完毕!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End Sub
Private Sub Gridsz_Click(Index As Integer)
Call Bcwggs(vs, GridCode, GridStr())
End Sub
Private Sub vs_DblClick()
If vs.TextMatrix(vs.Row, Sydz("004", GridStr(), Szzls)) = "√" Then
vs.TextMatrix(vs.Row, Sydz("004", GridStr(), Szzls)) = ""
Else
vs.TextMatrix(vs.Row, Sydz("004", GridStr(), Szzls)) = "√"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -