📄 module_01.frm
字号:
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName As String * 128
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Dim work_bs '标识现在的状态
Dim nodename '分类标识
Dim selebs '上一次选择分类的标识
Private Function check() As Boolean
check = True
If Len(Text7.Text) > 0 And Len(Text7.Text) < 3 Then
MsgBox "如果要输入条形码的话 请至少输入3位条形码!否则请不要输入.", 48
check = False
End If
If Len(TextS(0).Text) <= 0 Then
MsgBox "请输入商品名称!", 48
check = False
End If
If Len(TextS(2).Text) <= 0 Then
MsgBox "请输入单位!", 48
check = False
End If
If Combo1.ListIndex = -1 Then
MsgBox "请选择部门!", 48
check = False
End If
If Len(Text7.Text) >= 3 Then
strSQL = "select * from bcd where bcd='" & Text7.Text & "'"
If USESQL(1, strSQL) Then
Else
check = False
End If
If Rsbdata.RecordCount Then
If (Trim(Rsbdata.Fields(1).Value) = Text1.Text) Then
Else
MsgBox "重复条形码!", 48
check = False
End If
End If
Rsbdata.Close
End If
If Len(TextS(1).Text) <= 0 Then
TextS(1).Text = 0
End If
If Len(TextS(10).Text) <= 0 Then
TextS(10).Text = 0
End If
If Len(TextS(11).Text) <= 0 Then
TextS(11).Text = 0
End If
TextS(10).Text = Format(TextS(10).Text, ".####") 'Round(temp, 4)
TextS(11).Text = Format(TextS(11).Text, ".####") 'Round(temp, 4)
End Function
'读取查看栏中的数据到控件中
Sub lit()
If ListView1.ListItems.Count Then
For i = 0 To 10
TextS(i).Text = ""
Next i
TextS(1).Text = 0
TextS(4).Text = 0
TextS(5).Text = 0
TextS(10).Text = 0
TextS(11).Text = 0
Check1.Value = 0
Check2.Value = 0
Combo1.Text = ""
text6.Text = ""
Text7.Text = ""
'------------------------------
If work_bs = 1 Then mb = MsgBox("现在处于新增状态 你是否放弃当前的编辑?", vbOKCancel + 32)
If mb = 2 Then
'继续编辑
Else
'取消
work_bs = 0
TextS(1).Locked = True
m_add.Enabled = True
Text1.Text = Trim(ListView1.SelectedItem) 'ListView1.ListItems(ListView1.SelectedItem).ListSubItems(1)
For i = 0 To 10 'Rsbdata.Fields.Count - 1
TextS(i).Text = Trim(ListView1.SelectedItem.SubItems(i + 1))
Next i
i = i + 1
TextS(11).Text = Trim(ListView1.SelectedItem.SubItems(i))
i = i + 1
If ListView1.SelectedItem.SubItems(i) = "y" Then
Check1.Value = 1
Else
Check1.Value = 0
End If
i = i + 1
If ListView1.SelectedItem.SubItems(i) = "y" Then
Check2.Value = 1
Else
Check2.Value = 0
End If
i = i + 1
On Error Resume Next
Combo1.ListIndex = Trim(ListView1.SelectedItem.SubItems(i)) - 1
i = i + 1
text6.Text = Trim(ListView1.SelectedItem.SubItems(i))
'另外再读取条形码表
Call USESQL(1, "select * from bcd where gdsid='" & Trim(ListView1.SelectedItem) & "'")
Do Until Rsbdata.EOF
Text7.Text = Trim(Rsbdata.Fields(0).Value) 'Format(Rsbdata.Fields(0).Value, "")
Rsbdata.MoveNext
Loop
Rsbdata.Close
End If
End If
End Sub
'清空数据
Sub rest()
For i = 0 To 10
TextS(i).Text = ""
Next i
TextS(1).Text = 0
TextS(4).Text = 17
TextS(5).Text = 17
TextS(10).Text = 0
TextS(11).Text = 0
Check1.Value = 0
Check2.Value = 0
Combo1.Text = ""
text6.Text = ""
Text7.Text = ""
Text1.Text = ""
ListView1.ColumnHeaders.Clear
ListView1.ListItems.Clear
m_add.Enabled = False
m_save.Enabled = False
m_del.Enabled = False
End Sub
'取得记录显示在列表栏中
Sub tnc()
TextS(1).Locked = True
work_bs = 0 '标识为正常查询状态
'取得分类标识
nodename = Mid(TreeView1.Nodes(TreeView1.SelectedItem.Index).Key, 2, Len(TreeView1.Nodes(TreeView1.SelectedItem.Index).Key)) '取得选中项的Key标识 此标识为数据库中表示的clsid
strSQL = "select gdsid,gdsdes,salprc,bsepkg,spc,taxrto,saltaxrto,bnd,mftloc,mftfct,srtcde,rfnprc,rfntaxprc,isstpsal,isstp,dptid,authorno from gds where clsid='" & nodename & "'"
'查询当前指向分类的所有记录
If USESQL(1, strSQL) Then
Else
Exit Sub
End If
'判断如果查询结果为空 则不执退出
'If Rsbdata.EOF Then
' Call rest
' Exit Sub
'End If
'----------------------------------------------
Dim tm As Date
tm = Now
ListView1.ColumnHeaders.Clear
ListView1.ListItems.Clear
'获取所有字段先
For i = 0 To Rsbdata.Fields.Count - 1
tl = 1000
Select Case (Rsbdata.Fields(i).Name)
Case "gdsid"
tn = "商品编码"
Case "gdsdes"
tn = "商品名称"
tl = 2000
Case "salprc"
tn = "售价"
Case "bsepkg"
tn = "单位"
Case "spc"
tn = "规格"
Case "taxrto"
tn = "进项税率"
Case "saltaxrto"
tn = "销项税率"
Case "bnd"
tn = "品牌"
Case "mftloc"
tn = "产地"
Case "mftfct"
tn = "制造商"
Case "srtcde"
tn = "助记码"
Case "rfnprc"
tn = "参考进价"
Case "rfntaxprc"
tn = "含税参考进价"
Case "isstpsal"
tn = "停售"
Case "isstp"
tn = "停进"
Case "dptid"
tn = "部门"
Case "authorno"
tn = "批准文号"
Case Else
tn = "未知的字段"
End Select
ListView1.ColumnHeaders.Add , , tn, tl '最后可加长度值
Next i
'------------------------------------------------
'循环取得所有数据
Do Until Rsbdata.EOF
'建立行头先
ListView1.ListItems.Add , , Trim(Rsbdata.Fields(0))
'每一次循环得到的数据
For i = 1 To Rsbdata.Fields.Count - 1
If i = 5 Or i = 6 Then
If Rsbdata.Fields(i).Value = 0 Then
ListView1.ListItems(Rsbdata.AbsolutePosition).SubItems(i) = 0
Else
'ts = Format(Rsbdata.Fields(i).Value, "")
ts = CStr(Rsbdata.Fields(i).Value)
'ts = Trim(ts)
'ListView1.ListItems(Rsbdata.AbsolutePosition).SubItems(i) = Mid(ts, 2, 2)
ts = Replace(ts, ".", "")
ListView1.ListItems(Rsbdata.AbsolutePosition).SubItems(i) = Replace(ts, "0", "")
End If
Else
'If Rsbdata.Fields(i).Name = "dptid" Then
'On Error Resume Next
'ListView1.ListItems(Rsbdata.AbsolutePosition).SubItems(i) = Combo1.List(Format(Rsbdata.Fields(i).Value, ""))
'Else
ListView1.ListItems(Rsbdata.AbsolutePosition).SubItems(i) = Format(Rsbdata.Fields(i).Value, "")
'End If
End If
Next i
Rsbdata.MoveNext
Loop
'总记录数
'Text13.Text =Rsbdata.RecordCount
StatusBar1.Panels(1).Text = "记录总数: " & Rsbdata.RecordCount
Rsbdata.Close '关闭记录集
'----------------------------
If ListView1.ListItems.Count Then
Call lit
'ListView1.Sorted = True '排序开始
ListView1.SetFocus
ListView1.ListItems(1).Selected = True
Else
Text1.Text = ""
For i = 0 To 10
TextS(i).Text = ""
Next i
Check1.Value = 0
Check2.Value = 0
Combo1.Text = ""
text6.Text = ""
Text7.Text = ""
End If
'Text5.Text = CDate(Now - tm)
StatusBar1.Panels(2).Text = "返回时间: " & CDate(Now - tm)
End Sub
Private Sub Command1_Click()
'Main.Show
End Sub
Private Sub Command2_Click()
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
TextS(4).SetFocus
TextS(4).SelLength = Len(TextS(4))
End If
End Sub
Private Sub Form_Load()
'控件初始化
m_save.Enabled = False
m_add.Enabled = False
m_del.Enabled = False
TreeView1.LineStyle = tvwRootLines
'调用连接目标数据库
If TxtSybase() Then
Else
Exit Sub
End If
StatusBar1.Panels(6).Text = "数据库: " + SRVR
StatusBar1.Panels(7).Text = "用户: " + UID
'得到所有商品总分类
If USESQL(1, "select * from cls where lvl=1") Then
Else
Exit Sub
End If
'------------------------------------------------
'处理结果
'On Error GoTo ErrMsg
'添加根结点
Set nodX = TreeView1.Nodes.Add(, , "list", "商品分类", 1)
'Set nodX = TreeView1.Nodes.Add(1, tvwChild, , Rsbdata.Fields(i).Value) ' Format(Rsbdata.Fields(i).Value, "")
'循环取得所有数据
Do Until Rsbdata.EOF
Set nodX = TreeView1.Nodes.Add(1, tvwChild, "l" & Trim(Rsbdata.Fields(0).Value), "[" & Trim(Rsbdata.Fields(0).Value) & "]" & Rsbdata.Fields(1).Value, 1)
Rsbdata.MoveNext
Loop
nodX.EnsureVisible '展开
selebs = 1 '保存本次选择的对象序号
TreeView1.Nodes(1).Image = 2
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
For i = 1 To Rsbdata.RecordCount
If USESQL(1, "select * from cls where prtclsid='0" & i & "'") Then
Else
Exit Sub
End If
'------------------------------------------------
'循环取得所有数据
Do Until Rsbdata.EOF
Set nodX = TreeView1.Nodes.Add(1 + i, tvwChild, "l" & Trim(Rsbdata.Fields(0).Value), "[" & Trim(Rsbdata.Fields(0).Value) & "]" & Rsbdata.Fields(1).Value, 1)
Rsbdata.MoveNext
Loop
Next i
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'nodX.EnsureVisible '展开
'MsgBox "数据处理完毕!", 64
Rsbdata.Close '关闭记录集
'--------------------------------------
Exit Sub
ErrMsg:
MsgBox "数据处理失败!", 16
End Sub
Private Sub Form_Resize()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -