providedata.frm
来自「一个关于电脑管理汽车的软件」· FRM 代码 · 共 867 行 · 第 1/2 页
FRM
867 行
Index = 6
Left = 240
TabIndex = 24
Top = 2400
Width = 1215
End
Begin VB.Label Label1
Caption = "联系人："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Index = 7
Left = 240
TabIndex = 23
Top = 2880
Width = 1215
End
Begin VB.Label Label1
Caption = " 手 机："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Index = 8
Left = 120
TabIndex = 22
Top = 3360
Width = 1215
End
Begin VB.Label Label1
Caption = "传真："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Index = 9
Left = 240
TabIndex = 21
Top = 3840
Width = 1215
End
Begin VB.Label Label1
Caption = "邮寄地址："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Index = 10
Left = 240
TabIndex = 20
Top = 4320
Width = 1215
End
Begin VB.Label Label1
Caption = "邮政编码："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Index = 11
Left = 240
TabIndex = 19
Top = 4800
Width = 1215
End
End
Begin MSComctlLib.ListView lstBillDocu
Height = 3615
Left = 120
TabIndex = 8
Top = 1920
Width = 9855
_ExtentX = 17383
_ExtentY = 6376
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = 0
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
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 = "ProvideData"
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 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.DispalyProvidedataReport
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 = 1 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 = 1 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)
TexGoods(6) = .SubItems(7)
TexGoods(7) = .SubItems(8)
TexGoods(8) = .SubItems(9)
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 providedatatable Where coding = " & Quote(Trim(lstBillDocu.ListItems(lstBillDocuIndex).Text))
gCnn.Execute TempSQL
TempSQL = VarInitData.DisplaySQLVal(5)
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(5)
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 '保存
Set TempRS = New MYSQL_RS
If ModifyBS = True Then
TempSQL = "Select * From providedatatable 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, "G")
TempRS.Update
TempRS.CloseRecordset
TempRS.ReleaseMemory
Set TempRS = Nothing
Set TempRS = New MYSQL_RS
TempSQL = "Select * From providedatatable" '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("clientsimple") = Trim(TexGoods(0).Text)
.Fields("companyname") = Trim(TexGoods(1).Text)
.Fields("companyaddress") = Trim(TexGoods(2).Text)
.Fields("companyphone") = Trim(TexGoods(3).Text)
.Fields("linkman") = Trim(TexGoods(4).Text)
.Fields("handset") = Trim(TexGoods(5).Text)
.Fields("fax") = TexGoods(6).Text
.Fields("mailaddress") = TexGoods(7).Text
.Fields("mailcoding") = TexGoods(8).Text
.Update
End With
TempRS.CloseRecordset
TempRS.ReleaseMemory
Set TempRS = Nothing
TempSQL = VarInitData.DisplaySQLVal(5)
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)
TexGoods(6) = .SubItems(7)
TexGoods(7) = .SubItems(8)
TexGoods(8) = .SubItems(9)
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 = 1 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
VarInitData.InitBSE BSE1
Frame1.Visible = False
Frame1.Enabled = False
lstBillDocu.Visible = True
For i = 0 To 1
Command2(i).Visible = False
Next i
VarInitData.LoadData lstBillDocu, VarInitData.DisplaySQLVal(5)
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
TempSQL = VarInitData.DisplaySQLVal(3)
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)
TexGoods(6) = .SubItems(7)
TexGoods(7) = .SubItems(8)
TexGoods(8) = .SubItems(9)
End With
End If
End If
End If
End Sub
Private Sub ClearFrame()
Dim i As Integer
For i = 0 To 8
TexGoods(i).Text = ""
Next i
lblCoding = ""
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?