📄 appendform.frm
字号:
VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form buyappendform
BorderStyle = 0 'None
ClientHeight = 5070
ClientLeft = 0
ClientTop = 0
ClientWidth = 5145
LinkTopic = "Form1"
Picture = "appendform.frx":0000
ScaleHeight = 338
ScaleMode = 3 'Pixel
ScaleWidth = 343
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin MSComCtl2.DTPicker data_e
Height = 300
Left = 2400
TabIndex = 11
Top = 765
Width = 1695
_ExtentX = 2990
_ExtentY = 529
_Version = 393216
CalendarBackColor= 16777215
Format = 24510464
CurrentDate = 37417
End
Begin VB.TextBox data_c
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 270
Left = 2400
MaxLength = 25
TabIndex = 9
Top = 2475
Width = 1215
End
Begin MSDataListLib.DataCombo data_d
Bindings = "appendform.frx":552D2
Height = 330
Left = 2400
TabIndex = 10
Top = 3030
Width = 1455
_ExtentX = 2566
_ExtentY = 582
_Version = 393216
Appearance = 0
Style = 2
BackColor = 14737632
Text = ""
Object.DataMember = "rs商家表预览"
End
Begin VB.TextBox data_b
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 270
Left = 2400
MaxLength = 25
TabIndex = 8
Top = 1875
Width = 1215
End
Begin VB.TextBox data_a
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 270
Left = 2400
MaxLength = 10
TabIndex = 7
Top = 1395
Width = 1215
End
Begin VB.Label appendfrmmove
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Height = 285
Left = 360
TabIndex = 16
Top = 0
Width = 4320
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "日 期"
ForeColor = &H00000000&
Height = 255
Left = 600
TabIndex = 15
Top = 840
Width = 1500
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "厂 商"
ForeColor = &H00000000&
Height = 255
Left = 600
TabIndex = 14
Top = 3120
Width = 1500
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "产 地"
ForeColor = &H00000000&
Height = 255
Left = 600
TabIndex = 13
Top = 2520
Width = 1500
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "商品名"
ForeColor = &H00000000&
Height = 255
Left = 600
TabIndex = 12
Top = 1920
Width = 1500
End
Begin VB.Label lb_a
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "商品号"
ForeColor = &H00000000&
Height = 255
Left = 600
TabIndex = 6
Top = 1440
Width = 1500
End
Begin VB.Label append_a
BackStyle = 0 'Transparent
Height = 330
Left = 1440
TabIndex = 5
Top = 4200
Width = 885
End
Begin VB.Label exit_a
BackStyle = 0 'Transparent
Height = 330
Left = 2880
TabIndex = 4
Top = 4200
Width = 885
End
Begin VB.Label append_b
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "填 加"
ForeColor = &H00404040&
Height = 180
Left = 1620
TabIndex = 3
Top = 4275
Width = 540
End
Begin VB.Shape append_c
BorderColor = &H00C0C0C0&
FillColor = &H00C0C0C0&
Height = 330
Left = 1440
Top = 4200
Width = 885
End
Begin VB.Label exit_b
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "返 回"
ForeColor = &H00404040&
Height = 180
Left = 3090
TabIndex = 2
Top = 4275
Width = 495
End
Begin VB.Shape exit_c
BorderColor = &H00C0C0C0&
FillColor = &H00C0C0C0&
Height = 330
Left = 2880
Top = 4200
Width = 885
End
Begin VB.Label formcaption
BackStyle = 0 'Transparent
Caption = "填加数据"
ForeColor = &H00000000&
Height = 165
Left = 2130
TabIndex = 1
Top = 90
Width = 735
End
Begin VB.Label frmcaption2
BackStyle = 0 'Transparent
Caption = "填加数据"
ForeColor = &H00FFFFFF&
Height = 165
Left = 2130
TabIndex = 0
Top = 75
Width = 735
End
End
Attribute VB_Name = "buyappendform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim fd商家表 As ADODB.Recordset
Dim rsTemp As ADODB.Recordset
Sub ClearData()
data_a.Text = ""
data_b.Text = ""
data_c.Text = ""
End Sub
Sub AppendRecord()
On Error GoTo err_exit
If Trim(data_a.Text) = "" Or Trim(data_b.Text) = "" Or Trim(data_c.Text) = "" Or Trim(data_d.Text) = "" Then
vMessageBox GetLStr(1), 2, 0
data_a.SetFocus
Exit Sub
End If
rsTemp.Open "select 商品号,商品名 from 商品表 where 商品号='" & _
Trim(data_a.Text) & "'", mydata.condata, adOpenStatic, adLockReadOnly
If rsTemp.RecordCount > 0 Then
vMessageBox GetLStr(4) & Trim(rsTemp("商品名")), 1, 0
data_a.SetFocus
Else
mydata.condata.Execute "insert into 商品表 " & _
"(商品号,商品名,产地,商家名,日期) values ('" & _
Trim(data_a.Text) & "','" & _
Trim(data_b.Text) & "','" & _
Trim(data_c.Text) & "','" & _
data_d.Text & "'," & _
"#" & Format(data_e.Value, "YYYY-MM-DD") & "#" & _
")"
vMessageBox GetLStr(3), 1, 0
ClearData
data_a.SetFocus
End If
rsTemp.Close
Exit Sub
err_exit:
vMessageBox Err.Description, 2, 0
End Sub
Private Sub append_a_Click()
AppendRecord
End Sub
Private Sub appendfrmmove_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0
End Sub
Private Sub data_a_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_b_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_c_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_d_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
AppendRecord
End If
End Sub
Private Sub exit_a_Click()
Unload Me
buyreg.Show
ReGird 100
End Sub
Private Sub Form_Load()
CenterForm Me
Set rsTemp = New ADODB.Recordset
Set fd商家表 = New ADODB.Recordset
fd商家表.Open "select 商家名称 from 商家表", mydata.condata, adOpenStatic, adLockReadOnly
With data_d
Set .DataSource = fd商家表
.ListField = "商家名称"
.BoundColumn = "商家名称"
End With
SetLForm 11 '语言
End Sub
Private Sub append_a_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
append_c.BorderColor = &H808080
End Sub
Private Sub append_a_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
append_c.BorderColor = &HC0C0C0
End Sub
Private Sub exit_a_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
exit_c.BorderColor = &H808080
End Sub
Private Sub exit_a_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
exit_c.BorderColor = &HC0C0C0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set rsTemp = Nothing
Set fd商家表 = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -