📄 clientdata.frm
字号:
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Name"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Address"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "City, State, Zip"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "Notes"
Object.Width = 2540
EndProperty
End
End
End
Attribute VB_Name = "ClientData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim NewRecord As Boolean
Dim LastSortIndex As Long, LastSortDir As Long
Private VarOption As Integer
Private ModifyBS As Boolean
Public lstBillDocuIndex As Long
Private Sub Combo1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Combo1(Index).Text = ""
End Sub
Private Sub Combo1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
Combo1(Index).Text = ""
End Sub
Private Sub Command1_Click(Index As Integer)
Dim i As Integer
Dim TempRS As MYSQL_RS
Dim TempVar As Long
Dim TempSQL As String
Dim TempBillType As Integer
Select Case Index
Case 0
If lstBillDocu.SelectedItem Is Nothing Then Exit Sub
VarCrystal.DispalyClientdataReport
Case 1
ClearFrame
Frame1.Enabled = True
Frame1.Visible = True
lstBillDocu.Visible = False
For i = 0 To 1
With Command2(i)
.left = Command1(i + 1).left
.top = Command1(i + 1).top
.Visible = True
End With
Next i
For i = 0 To 4
Command1(i).Visible = False
Next i
SSStock.TabEnabled(0) = False
SSStock.Tab = 1
Case 2
If lstBillDocuIndex > 0 And lstBillDocu.ListItems.Count > 0 Then
ClearFrame
Frame1.Visible = True
lstBillDocu.Visible = False
For i = 0 To 1
With Command2(i)
.left = Command1(i + 1).left
.top = Command1(i + 1).top
.Visible = True
End With
Next i
For i = 0 To 4
Command1(i).Visible = False
Next i
SSStock.TabEnabled(0) = False
SSStock.Tab = 1
With lstBillDocu.ListItems(lstBillDocuIndex)
lblCoding = .Text
TexGoods(0) = .SubItems(1)
TexGoods(1) = .SubItems(2)
TexGoods(2) = .SubItems(3)
TexGoods(3) = .SubItems(4)
TexGoods(4) = .SubItems(5)
TexGoods(5) = .SubItems(6)
Combo1(0) = .SubItems(7)
Combo1(1) = .SubItems(8)
Combo1(2) = .SubItems(9)
TexGoods(7) = .SubItems(10)
TexGoods(8) = .SubItems(11)
TexGoods(9) = .SubItems(12)
TexGoods(10) = .SubItems(13)
End With
Frame1.Enabled = True
ModifyBS = True
End If
Case 3
If lstBillDocu.ListItems.Count > 0 And lstBillDocuIndex > 0 Then
If MsgBox("确定删除这一项吗?", vbOKCancel, "提示") = vbOK Then
TempSQL = "Delete From clientdatatable Where coding = " & Quote(Trim(lstBillDocu.ListItems(lstBillDocuIndex).Text))
gCnn.Execute TempSQL
TempSQL = VarInitData.DisplaySQLVal(6)
VarInitData.LoadData lstBillDocu, TempSQL
If lstBillDocuIndex > lstBillDocu.ListItems.Count Then
lstBillDocuIndex = lstBillDocu.ListItems.Count
End If
VarInitData.DealListView lstBillDocu, lstBillDocuIndex
End If
End If
Case 4
TempSQL = VarInitData.DisplaySQLVal(6)
VarInitData.LoadData lstBillDocu, TempSQL
If lstBillDocu.ListItems.Count > 0 Then
lstBillDocuIndex = 1
End If
VarInitData.DealListView lstBillDocu, lstBillDocuIndex
End Select
End Sub
Private Sub Command2_Click(Index As Integer)
Dim TempRS As MYSQL_RS
Dim i As Integer
Dim TempSQL As String
Dim TempAkey As Long
Select Case Index
Case 0 '保存
If LenB(TexGoods(0)) >= 50 Then
MsgBox "货品编码的内容太多了,操作失败", , VarInitData.SysPrompt
Exit Sub
End If
Set TempRS = New MYSQL_RS
If ModifyBS = True Then
TempSQL = "Select * From clientdatatable Where coding = " & Quote(Trim(lstBillDocu.ListItems(lstBillDocuIndex).Text))
Else
TempSQL = "Select * From counttable where countname =" & Quote("客户编号")
TempRS.OpenRs TempSQL, gCnn
TempRS.Fields("count").Value = TempRS.Fields("count").Value + 1
lblCoding = VarInitData.DealVarNo(CStr(TempRS.Fields("count")), 6, "K")
TempRS.Update
TempRS.CloseRecordset
TempRS.ReleaseMemory
Set TempRS = Nothing
Set TempRS = New MYSQL_RS
TempSQL = "Select * From clientdatatable" 'Where AKey = " & Val(txtAKey)
End If
TempRS.OpenRs TempSQL, gCnn
If ModifyBS = False Then
If TempRS.RecordCount > 0 Then
TempRS.MoveLast
TempRS.MoveNext
End If
End If
With TempRS
If .EOF Then .AddNew
.Fields("coding") = Trim(lblCoding.Caption)
.Fields("companyname") = Trim(TexGoods(0).Text)
.Fields("companyaddress") = Trim(TexGoods(1).Text)
.Fields("companyphone") = Trim(TexGoods(2).Text)
.Fields("linkman") = Trim(TexGoods(3).Text)
.Fields("handset") = Trim(TexGoods(4).Text)
.Fields("fax") = TexGoods(5).Text
.Fields("zone") = Combo1(0).Text
.Fields("clientsort") = Combo1(1).Text
.Fields("clientproperty") = Combo1(2).Text
.Fields("mailaddress") = TexGoods(7).Text
.Fields("mailcoding") = TexGoods(8).Text
.Fields("email") = TexGoods(9).Text
.Fields("webaddress") = TexGoods(10).Text
.Update
End With
TempRS.CloseRecordset
TempRS.ReleaseMemory
Set TempRS = Nothing
TempSQL = VarInitData.DisplaySQLVal(6)
VarInitData.LoadData lstBillDocu, TempSQL
If ModifyBS = False Then lstBillDocuIndex = lstBillDocu.ListItems.Count
Case 1
ClearFrame
If lstBillDocuIndex > 0 And lstBillDocu.ListItems.Count > 0 Then
With lstBillDocu.ListItems(lstBillDocuIndex)
lblCoding = .Text
TexGoods(0) = .SubItems(1)
TexGoods(1) = .SubItems(2)
TexGoods(2) = .SubItems(3)
TexGoods(3) = .SubItems(4)
TexGoods(4) = .SubItems(5)
TexGoods(5) = .SubItems(6)
Combo1(0) = .SubItems(7)
Combo1(1) = .SubItems(8)
Combo1(2) = .SubItems(9)
TexGoods(7) = .SubItems(10)
TexGoods(8) = .SubItems(11)
TexGoods(9) = .SubItems(12)
TexGoods(10) = .SubItems(13)
End With
End If
End Select
ModifyBS = False
SSStock.TabEnabled(0) = True
Frame1.Enabled = False
For i = 0 To 1
Command2(i).Visible = False
Next i
For i = 0 To 4
Command1(i).Visible = True
Next i
' DealListview
End Sub
Private Sub Form_Activate()
VarInitData.DealListView lstBillDocu, lstBillDocuIndex
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim TempSQL As String
VarInitData.InitBSE BSE1
Frame1.Visible = False
Frame1.Enabled = False
lstBillDocu.Visible = True
For i = 0 To 1
Command2(i).Visible = False
Next i
For i = 0 To 1
TempSQL = VarInitData.DisplayDynSQLVal(VarInitData.SureNameFrIndex(i))
VarInitData.LoadData Combo1(i), TempSQL, 1
Next i
TempSQL = VarInitData.DisplayDynSQLVal(VarInitData.SureNameFrIndex(7))
VarInitData.LoadData Combo1(2), TempSQL, 1
VarInitData.LoadData lstBillDocu, VarInitData.DisplaySQLVal(6)
frameInfo.BackColor = vb3DFace
End Sub
Private Sub Form_Resize()
If Me.ScaleHeight > 0 And Me.ScaleWidth > 0 Then
frameInfo.left = Me.ScaleLeft
frameInfo.top = Me.ScaleTop
frameInfo.Width = Me.ScaleWidth
SSStock.top = frameInfo.top + frameInfo.Height
SSStock.left = Me.ScaleLeft + 70
SSStock.Width = Me.ScaleWidth - 140
SSStock.Height = Me.ScaleHeight - frameInfo.Height - 50 'Screen.Height - 2650
lstBillDocu.top = 450
lstBillDocu.left = 70
lstBillDocu.Width = SSStock.Width - 140
lstBillDocu.Height = SSStock.Height - 550
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If BSE1.EngineStarted Then BSE1.EndSubClassing
End Sub
Private Sub lstBillDocu_ItemClick(ByVal Item As MSComctlLib.ListItem)
lstBillDocuIndex = Item.Index
End Sub
Private Sub Option1_Click(Index As Integer)
VarOption = Index + 1
End Sub
Private Sub SSStock_Click(PreviousTab As Integer)
Dim TempSQL As String
Dim TempStr As String
Dim TempRS As MYSQL_RS
Dim TempBillType As Integer
Dim i As Integer
If Frame1.Enabled = False Then
If PreviousTab <> 0 Then
lstBillDocu.Visible = True
Frame1.Visible = False
VarInitData.DealListView lstBillDocu, lstBillDocuIndex
Else
lstBillDocu.Visible = False
Frame1.Visible = True
ClearFrame
Frame1.Enabled = False
If lstBillDocuIndex > 0 And lstBillDocu.ListItems.Count > 0 Then
With lstBillDocu.ListItems(lstBillDocuIndex)
lblCoding = .Text
TexGoods(0) = .SubItems(1)
TexGoods(1) = .SubItems(2)
TexGoods(2) = .SubItems(3)
TexGoods(3) = .SubItems(4)
TexGoods(4) = .SubItems(5)
TexGoods(5) = .SubItems(6)
Combo1(0) = .SubItems(7)
Combo1(1) = .SubItems(8)
Combo1(2) = .SubItems(9)
TexGoods(7) = .SubItems(10)
TexGoods(8) = .SubItems(11)
TexGoods(9) = .SubItems(12)
TexGoods(10) = .SubItems(13)
End With
End If
End If
End If
End Sub
Private Sub ClearFrame()
Dim i As Integer
For i = 0 To 8
If i <> 6 Then
TexGoods(i).Text = ""
End If
Next i
For i = 0 To 2
Combo1(i) = ""
Next i
lblCoding = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -