📄 frmmuchvillage.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form FrmMuchvillage
BorderStyle = 3 'Fixed Dialog
Caption = "多村数据通讯"
ClientHeight = 5685
ClientLeft = 45
ClientTop = 330
ClientWidth = 8205
Icon = "FrmMuchVillage.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5685
ScaleWidth = 8205
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command7
Caption = "处理数据(&D)"
Height = 375
Left = 6705
TabIndex = 14
Top = 3285
Width = 1320
End
Begin VB.CommandButton Command6
Caption = "密码维护(&P)"
Height = 345
Left = 6690
TabIndex = 12
Top = 4575
Width = 1350
End
Begin VB.CommandButton Command2
Caption = "下载数据(&S)"
Height = 360
Left = 6690
TabIndex = 11
Top = 1320
Width = 1305
End
Begin VB.CommandButton Command3
Caption = "上载数据(&R)"
Height = 375
Left = 6690
TabIndex = 10
Top = 2595
Width = 1320
End
Begin VB.CommandButton Command4
Caption = "通讯配置(&T)"
Height = 360
Left = 6690
TabIndex = 9
Top = 3930
Width = 1335
End
Begin VB.CommandButton Command5
Caption = "退出(&E)"
Height = 360
Left = 6690
TabIndex = 8
Top = 5205
Width = 1350
End
Begin VB.Frame Frame1
Height = 4380
Left = 225
TabIndex = 0
Top = 1200
Width = 6150
Begin VB.Frame Frame2
Caption = "文本选择"
Height = 705
Left = 2010
TabIndex = 17
Top = 3615
Width = 2775
Begin VB.CheckBox Check2
Caption = "丰富类型"
Height = 270
Left = 150
TabIndex = 19
Top = 285
Width = 1095
End
Begin VB.CheckBox Check4
Caption = "单一类型"
Height = 240
Left = 1455
TabIndex = 18
Top = 285
Width = 1200
End
End
Begin VB.CheckBox Check3
Caption = "通讯结束自动关闭"
Height = 240
Left = 195
TabIndex = 16
Top = 4065
Width = 1830
End
Begin MSComctlLib.ProgressBar Progress1
Height = 3975
Left = 4950
TabIndex = 15
Top = 300
Width = 360
_ExtentX = 635
_ExtentY = 7011
_Version = 393216
Appearance = 0
Orientation = 1
End
Begin VB.CheckBox Check1
Caption = "抄表器密码"
Height = 240
Left = 195
TabIndex = 6
Top = 3765
Width = 1260
End
Begin VB.ListBox List2
BackColor = &H00FFFFFF&
Height = 3300
Left = 2265
MultiSelect = 1 'Simple
TabIndex = 2
Top = 315
Width = 2520
End
Begin VB.ListBox List1
Height = 3300
Left = 195
TabIndex = 1
Top = 315
Width = 1755
End
Begin MSComctlLib.ProgressBar Progress
Height = 3975
Left = 5580
TabIndex = 3
Top = 300
Width = 390
_ExtentX = 688
_ExtentY = 7011
_Version = 393216
Appearance = 0
Orientation = 1
End
Begin VB.Label Label3
Height = 585
Left = 5070
TabIndex = 7
Top = 2115
Width = 855
End
Begin VB.Image Image2
Height = 480
Left = 5250
Picture = "FrmMuchVillage.frx":038A
Top = 330
Width = 480
End
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = " 提 示"
Height = 180
Left = 390
TabIndex = 13
Top = 855
Width = 600
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = $"FrmMuchVillage.frx":0694
Height = 630
Left = 1275
TabIndex = 5
Top = 330
Width = 6360
End
Begin VB.Image Image1
Height = 480
Left = 450
Picture = "FrmMuchVillage.frx":0754
Top = 315
Width = 480
End
Begin VB.Label Label1
BackColor = &H00CCB400&
BorderStyle = 1 'Fixed Single
Height = 1065
Left = 240
TabIndex = 4
Top = 105
Width = 7710
End
End
Attribute VB_Name = "FrmMuchvillage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ShengY As Boolean, RegVal As Boolean, NoTag As Boolean
Dim temp_str As String
Dim tempDBF As Recordset
Dim tempDBF0 As Recordset
Private Sub Check1_Click()
If Check1.Value Then
Command6.Enabled = True
Else
Command6.Enabled = False
End If
End Sub
Private Sub Check2_Click()
SetKeyValue HKEY_CURRENT_USER, "Software\VB and VBA Program Settings\Eps\SysSetup\", "XsTag", Check2.Value, REG_SZ
If Check2.Value = 1 Then
Check4.Value = 0
NoTag = False
RegVal = True
Else
RegVal = False
End If
End Sub
Private Sub Check3_Click()
SetKeyValue HKEY_CURRENT_USER, "Software\VB and VBA Program Settings\Nx3DataTransmit\其他\", "ExitData", Check3.Value, REG_SZ
End Sub
Private Sub Check4_Click()
SetKeyValue HKEY_CURRENT_USER, "Software\VB and VBA Program Settings\Eps\SysSetup\", "NoTag", Check4.Value, REG_SZ
'无相数时为单独A
If Check4.Value = 1 Then
Check2.Value = 0
NoTag = True
' RegVal = True
Else
'RegVal = False
NoTag = True
End If
End Sub
'Private Sub Command1_Click()
Sub CreaTxt()
Dim I As Integer, j As Integer, k As Integer, l As Integer, CunCount As Integer, p As Integer, PPP As Integer, tempLin As Integer
Dim Cun_Sum As String
On Error GoTo CreaErr
'Command1.Enabled = False
Screen.MousePointer = 11
NdMd.Execute "DELETE * From sendMDB "
NdMd.Execute "DELETE * From Temp0 "
NdMd.Execute "DELETE * From TempTxt"
Set tempDBF = NdMd.OpenRecordset("sendmdb")
I = 1
For j = 0 To List2.ListCount - 1
If List2.Selected(j) Then
l = l + Val(convert_Num(Mid(List2.List(j), Loca_Space(List2.List(j)), 6))) '总数据
With tempDBF
.AddNew
.Fields!区号 = Left(List1.Text, 3) & Left(List2.List(j), 3)
.Fields!户数 = Right("0000" & convert_Num(Mid(List2.List(j), Loca_Space(List2.List(j)), 6)), 4)
If I = 0 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -