frmprops.frm

一个为公安系统接警中心控制软件,不错哦.

VERSION 5.00
Begin VB.Form frmProperties 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "通信端口属性"
   ClientHeight    =   3435
   ClientLeft      =   4140
   ClientTop       =   1665
   ClientWidth     =   4035
   Icon            =   "frmProps.frx":0000
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3435
   ScaleWidth      =   4035
   ShowInTaskbar   =   0   'False
   Begin VB.Frame fraSettings 
      BorderStyle     =   0  'None
      Height          =   3495
      Left            =   0
      TabIndex        =   8
      Top             =   0
      Width           =   4245
      Begin VB.Frame Frame2 
         Caption         =   "未知报警"
         Height          =   1770
         Left            =   2640
         TabIndex        =   15
         Top             =   1635
         Width           =   1335
         Begin VB.CheckBox chkAuto 
            Caption         =   "自动处理"
            Height          =   255
            Left            =   120
            TabIndex        =   5
            Top             =   360
            Width           =   1095
         End
      End
      Begin VB.CommandButton cmdCancel 
         Caption         =   "取消"
         Height          =   300
         Left            =   2760
         TabIndex        =   7
         Top             =   840
         Width           =   1080
      End
      Begin VB.Frame Frame1 
         Caption         =   "最大速度"
         Height          =   870
         Left            =   180
         TabIndex        =   14
         Top             =   630
         Width           =   2340
         Begin VB.ComboBox cboSpeed 
            Height          =   300
            Left            =   375
            Style           =   2  'Dropdown List
            TabIndex        =   1
            Top             =   360
            Width           =   1695
         End
      End
      Begin VB.Frame fraConnection 
         Caption         =   "优化连接"
         Height          =   1770
         Left            =   180
         TabIndex        =   9
         Top             =   1635
         Width           =   2325
         Begin VB.ComboBox cboStopBits 
            Height          =   300
            Left            =   1050
            Style           =   2  'Dropdown List
            TabIndex        =   4
            Top             =   1260
            Width           =   1140
         End
         Begin VB.ComboBox cboParity 
            Height          =   300
            Left            =   1050
            Style           =   2  'Dropdown List
            TabIndex        =   3
            Top             =   810
            Width           =   1140
         End
         Begin VB.ComboBox cboDataBits 
            Height          =   300
            Left            =   1080
            Style           =   2  'Dropdown List
            TabIndex        =   2
            Top             =   360
            Width           =   1140
         End
         Begin VB.Label Label5 
            Caption         =   "停止位:"
            Height          =   285
            Left            =   180
            TabIndex        =   13
            Top             =   1320
            Width           =   885
         End
         Begin VB.Label Label4 
            Caption         =   "奇偶位:"
            Height          =   285
            Left            =   180
            TabIndex        =   12
            Top             =   855
            Width           =   735
         End
         Begin VB.Label Label3 
            Caption         =   "数据位:"
            Height          =   285
            Left            =   180
            TabIndex        =   11
            Top             =   375
            Width           =   825
         End
      End
      Begin VB.ComboBox cboPort 
         Height          =   315
         Left            =   900
         Style           =   2  'Dropdown List
         TabIndex        =   0
         Top             =   150
         Width           =   1425
      End
      Begin VB.CommandButton cmdOK 
         Caption         =   "确定"
         Default         =   -1  'True
         Height          =   300
         Left            =   2760
         MaskColor       =   &H00000000&
         TabIndex        =   6
         Top             =   240
         Width           =   1080
      End
      Begin VB.Label Label1 
         Caption         =   "端口:"
         Height          =   315
         Left            =   330
         TabIndex        =   10
         Top             =   180
         Width           =   495
      End
   End
End
Attribute VB_Name = "frmProperties"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private iFlow As Integer, iTempEcho As Boolean


Sub LoadPropertySettings()
Dim i As Integer, Settings As String, Offset As Integer

' 载入端口设置
For i = 1 To 16
    cboPort.AddItem "Com" & Trim$(Str$(i))
Next i

' Load Speed Settings
cboSpeed.AddItem "110"
cboSpeed.AddItem "300"
cboSpeed.AddItem "600"
cboSpeed.AddItem "1200"
cboSpeed.AddItem "2400"
cboSpeed.AddItem "4800"
cboSpeed.AddItem "9600"
cboSpeed.AddItem "14400"
cboSpeed.AddItem "19200"
cboSpeed.AddItem "28800"
cboSpeed.AddItem "38400"
cboSpeed.AddItem "56000"
cboSpeed.AddItem "57600"
cboSpeed.AddItem "115200"
cboSpeed.AddItem "128000"
cboSpeed.AddItem "256000"

' 载入数据位设置
cboDataBits.AddItem "4"
cboDataBits.AddItem "5"
cboDataBits.AddItem "6"
cboDataBits.AddItem "7"
cboDataBits.AddItem "8"

' 载入奇偶检验设置


cboParity.AddItem "None"
cboParity.AddItem "Odd"
cboParity.AddItem "Even"

'cboParity.AddItem "Mark"
'cboParity.AddItem "Space"

' 载入停止位设置
cboStopBits.AddItem "1"
cboStopBits.AddItem "1.5"
cboStopBits.AddItem "2"

' 设置默认的设置
    Dim rs As ADODB.Recordset
   
      Set rs = New ADODB.Recordset
    rs.Open "select FBaud,Fparity,FStopBits,FCom,FDataBits from System", m_gCnAlarm
    If Not (rs.EOF And rs.BOF) Then
    cboSpeed.Text = rs!Fbaud
    cboPort.ListIndex = rs!FCom - 1
    cboDataBits.Text = rs!Fdatabits
    cboParity.ListIndex = rs!Fparity
    cboStopBits.ListIndex = rs!FStopbits
    End If
    rs.Close
 End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdOk_Click()
Dim OldPort As Integer, ReOpen As Boolean

On Error Resume Next

SavePrivateSetting SYSTEM_SECTION, "UnknowAlarm", chkAuto.Value

Echo = iTempEcho
OldPort = m_gMainForm.MSComm1.CommPort
NewPort = cboPort.ListIndex + 1

If NewPort <> OldPort Then                   ' 如果端口号被更改, 关闭原来的端口。
    If m_gMainForm.MSComm1.PortOpen Then
           m_gMainForm.MSComm1.PortOpen = False
           ReOpen = True
    End If

    m_gMainForm.MSComm1.CommPort = NewPort          ' 设置新的端口号。
    
    If Err = 0 Then
        If ReOpen Then
            m_gMainForm.MSComm1.PortOpen = True
            
        End If
    End If
        
    If Err Then
        MsgBox Error$, 48
        m_gMainForm.MSComm1.CommPort = OldPort
        Exit Sub
    End If
End If


m_gMainForm.MSComm1.Settings = Trim$(cboSpeed.Text) & "," & Left$(cboParity.Text, 1) _
    & "," & Trim$(cboDataBits.Text) & "," & Trim$(cboStopBits.Text)
If Err Then
    MsgBox Error$, 48
    Exit Sub
End If

Dim rs As ADODB.Recordset
   
      Set rs = New ADODB.Recordset
    rs.Open "select FBaud,Fparity,FStopBits,FCom,FDataBits from System", m_gCnAlarm, adOpenStatic, adLockOptimistic
    If Not (rs.EOF And rs.BOF) Then
    rs!Fbaud = cboSpeed.Text
    rs!FCom = cboPort.ListIndex + 1
    rs!Fdatabits = cboDataBits.Text
    rs!Fparity = cboParity.ListIndex
    rs!FStopbits = cboStopBits.ListIndex
    rs.Update
    End If
    rs.Close

    Unload Me

End Sub

Private Sub Form_Load()
    ' 设置窗体尺寸
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 2
    ' 载入当前的属性设置
    LoadPropertySettings
    ' 未知报警事件默认手工处理
    chkAuto.Value = GetPrivateSetting(SYSTEM_SECTION, "UnknowAlarm", 0)
End Sub