📄 companyinfo.frm
字号:
VERSION 5.00
Begin VB.Form frmCompanyInfo
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "配置公司信息"
ClientHeight = 4950
ClientLeft = 45
ClientTop = 330
ClientWidth = 4860
Icon = "CompanyInfo.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4950
ScaleWidth = 4860
ShowInTaskbar = 0 'False
Begin VB.Frame Frame2
Caption = "联系方式"
Height = 2145
Left = 60
TabIndex = 14
Top = 2160
Width = 4755
Begin VB.TextBox txtAddress
Height = 315
Left = 1050
TabIndex = 5
Text = "Text12"
Top = 210
Width = 3525
End
Begin VB.TextBox txtFax
Height = 315
Left = 1050
TabIndex = 8
Text = "Text10"
Top = 930
Width = 1935
End
Begin VB.TextBox txtTel
Height = 315
Left = 1050
TabIndex = 6
Text = "Text9"
Top = 570
Width = 1935
End
Begin VB.TextBox txtPostCode
Height = 315
Left = 3570
TabIndex = 7
Text = "Text4"
Top = 570
Width = 1005
End
Begin VB.TextBox txtRelaPhone
Height = 315
Left = 3420
TabIndex = 11
Text = "Text3"
Top = 1680
Width = 1155
End
Begin VB.TextBox txtRelaman
Height = 315
Left = 1050
TabIndex = 10
Text = "Text2"
Top = 1680
Width = 1215
End
Begin VB.TextBox txtMobile
Height = 330
Left = 1050
TabIndex = 9
Text = "Text1"
Top = 1290
Width = 3525
End
Begin VB.Label Label6
Caption = "邮编："
Height = 255
Left = 3090
TabIndex = 27
Top = 600
Width = 795
End
Begin VB.Label Label5
Caption = "联系人电话："
Height = 225
Left = 2370
TabIndex = 26
Top = 1740
Width = 1095
End
Begin VB.Label Label4
Caption = "联系人："
Height = 180
Left = 90
TabIndex = 25
Top = 1755
Width = 900
End
Begin VB.Label Label2
Caption = "手机："
Height = 180
Left = 120
TabIndex = 24
Top = 1365
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "公司地址："
Height = 180
Index = 2
Left = 90
TabIndex = 23
Top = 270
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "公司传真："
Height = 180
Index = 1
Left = 90
TabIndex = 22
Top = 990
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "公司电话："
Height = 180
Index = 0
Left = 90
TabIndex = 21
Top = 630
Width = 900
End
End
Begin VB.Frame Frame1
Caption = "基本信息"
Height = 2055
Left = 60
TabIndex = 12
Top = 60
Width = 4755
Begin VB.TextBox txtMemo
Height = 285
Left = 1080
TabIndex = 4
Text = "Text7"
Top = 1620
Width = 3495
End
Begin VB.TextBox txtManager
Height = 315
Left = 1080
TabIndex = 1
Text = "Text11"
Top = 600
Width = 1455
End
Begin VB.TextBox txtName
Height = 315
Left = 1080
TabIndex = 0
Text = "Text8"
Top = 240
Width = 3495
End
Begin VB.TextBox txtTax
Height = 285
Left = 1080
TabIndex = 3
Text = "Text6"
Top = 1290
Width = 3495
End
Begin VB.TextBox txtBanck
Height = 285
Left = 1080
TabIndex = 2
Text = "Text5"
Top = 960
Width = 3495
End
Begin VB.Label Label9
Caption = "备注："
Height = 180
Left = 120
TabIndex = 20
Top = 1650
Width = 900
End
Begin VB.Label Label8
Caption = "税号："
Height = 180
Left = 120
TabIndex = 19
Top = 1305
Width = 900
End
Begin VB.Label Label7
Caption = "帐号："
Height = 180
Left = 120
TabIndex = 18
Top = 975
Width = 900
End
Begin VB.Label Label1
Caption = "公司名称："
Height = 180
Left = 120
TabIndex = 17
Top = 300
Width = 900
End
Begin VB.Label Label3
Caption = "负责人："
Height = 180
Index = 3
Left = 120
TabIndex = 16
Top = 600
Width = 795
End
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 315
Left = -1200
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 4200
Width = 1140
End
Begin VB.CommandButton CancelExit
Cancel = -1 'True
Caption = "关闭(&C)"
Default = -1 'True
Height = 345
Left = 3000
TabIndex = 15
Top = 4470
Width = 1275
End
Begin VB.CommandButton OkSave
Caption = "保存(&S)"
Height = 345
Left = 990
TabIndex = 13
Top = 4470
Width = 1275
End
End
Attribute VB_Name = "frmCompanyInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mbAdd As Boolean '是否新增
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
SendKeys "{tab}"
ElseIf KeyAscii = vbKeyEscape Then
KeyAscii = 0
Unload Me
End If
End Sub
Private Sub Form_Load()
Center Me
Me.KeyPreview = True
Call mInitForm
End Sub
Private Sub mInitForm()
Dim Rst As New ADODB.Recordset
Dim sSql As String
On Error GoTo ErrHandle
sSql = "Select CName,CManager,CTel,CFax,CMobile,CRelaMan,CRelaPhone,CAddress,CPostCode,CBankAccount,CTaxAccount,CMemo from Company"
Screen.MousePointer = vbHourglass
Rst.Open sSql, CN
Screen.MousePointer = vbDefault
If Rst.EOF Then
mbAdd = True
Call mClearCtrl
Else
mbAdd = False
Call mClearCtrl
txtName = IIf(IsNull(Rst!CName), "", Rst!CName)
txtManager = IIf(IsNull(Rst!CManager), "", Rst!CManager)
txtTel = IIf(IsNull(Rst!CTel), "", Rst!CTel)
txtFax = IIf(IsNull(Rst!CFax), "", Rst!CFax)
txtMobile = IIf(IsNull(Rst!CMobile), "", Rst!CMobile)
txtRelaman = IIf(IsNull(Rst!CRelaman), "", Rst!CRelaman)
txtRelaPhone = IIf(IsNull(Rst!CRelaPhone), "", Rst!CRelaPhone)
txtAddress = IIf(IsNull(Rst!CAddress), "", Rst!CAddress)
txtPostCode = IIf(IsNull(Rst!CPostCode), "", Rst!CPostCode)
txtBanck = IIf(IsNull(Rst!CBankAccount), "", Rst!CBankAccount)
txtTax = IIf(IsNull(Rst!CTaxAccount), "", Rst!CTaxAccount)
txtMemo = IIf(IsNull(Rst!CMemo), "", Rst!CMemo)
End If
Rst.Close
Exit Sub
ErrHandle:
Screen.MousePointer = vbDefault
gShowMsg "初始化窗体时出错，frmCompanyInfo.mInitFrom()"
End Sub
Private Function mbSaveCompanyInfo() As Boolean
'**********************************************
'Purpose:
' 保存公司信息
'
'**********************************************
Dim sSql As String
Dim sName As String
Dim sManager As String
Dim sTel As String
Dim sFax As String
Dim sMobile As String
Dim sRelaMan As String
Dim sRelaPhone As String
Dim sAddress As String
Dim sPostCode As String
Dim sBankAccount As String
Dim sTaxAccount As String
Dim sMemo As String
Dim bBegin As Boolean
On Error GoTo ErrHandle
sName = Trim(txtName)
sManager = Trim(txtManager)
sTel = Trim(txtTel)
sFax = Trim(txtFax)
sMobile = Trim(txtMobile)
sRelaMan = Trim(txtRelaman)
sRelaPhone = Trim(txtRelaPhone)
sAddress = Trim(txtAddress)
sPostCode = Trim(txtPostCode)
sBankAccount = Trim(txtBanck)
sTaxAccount = Trim(txtTax)
sMemo = Trim(txtMemo)
If mbAdd Then
sSql = "insert Company(CName,CManager,CTel,CFax,CMobile,CRelaMan,CRelaPhone,CAddress,CPostCode,CBankAccount,CTaxAccount,CMemo) values('"
sSql = sSql & sName & "','" & sManager & "','" & sTel & "','" & sFax & "','" & sMobile & "','" & sRelaMan & "','" & sRelaPhone & "','" & sAddress & "','" & sPostCode & "','" & sBankAccount & "','" & sTaxAccount & "','" & sMemo & "')"
Else
sSql = "delete from Company"
sSql = sSql & vbCrLf & "insert Company(CName,CManager,CTel,CFax,CMobile,CRelaMan,CRelaPhone,CAddress,CPostCode,CBankAccount,CTaxAccount,CMemo) values('"
sSql = sSql & sName & "','" & sManager & "','" & sTel & "','" & sFax & "','" & sMobile & "','" & sRelaMan & "','" & sRelaPhone & "','" & sAddress & "','" & sPostCode & "','" & sBankAccount & "','" & sTaxAccount & "','" & sMemo & "')"
End If
Screen.MousePointer = vbHourglass
CN.Execute sSql
Screen.MousePointer = vbDefault
mbSaveCompanyInfo = True
Exit Function
ErrHandle:
Screen.MousePointer = vbDefault
mbSaveCompanyInfo = False
gShowMsg "保存公司信息时出错，frmCompanyInfo.mbSaveCompanyInfo()"
End Function
Private Sub mClearCtrl()
Dim i As Integer
On Error GoTo ErrHandle
For i = 0 To Me.Controls.Count - 1
If TypeOf Me.Controls(i) Is TextBox Then
Me.Controls(i).Text = ""
End If
Next
Exit Sub
ErrHandle:
gShowMsg "清空控件值时出错，frmCompanyInfo.mClearCtrl()"
End Sub
Private Sub CancelExit_Click()
Unload Me
End Sub
Private Sub OkSave_Click()
If mbSaveCompanyInfo Then
Unload Me
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -