www.pudn.com > 645-485.rar > Project_Configure.frm, change:2007-09-27,size:14513b


VERSION 5.00 
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX" 
Begin VB.Form Project_Configure  
   Caption         =   "用户方案配置" 
   ClientHeight    =   6780 
   ClientLeft      =   60 
   ClientTop       =   450 
   ClientWidth     =   9810 
   LinkTopic       =   "Form1" 
   LockControls    =   -1  'True 
   MDIChild        =   -1  'True 
   ScaleHeight     =   6780 
   ScaleWidth      =   9810 
   WindowState     =   2  'Maximized 
   Begin VB.PictureBox Picture3  
      Align           =   2  'Align Bottom 
      Appearance      =   0  'Flat 
      BackColor       =   &H80000005& 
      BorderStyle     =   0  'None 
      ForeColor       =   &H80000008& 
      Height          =   270 
      Left            =   0 
      ScaleHeight     =   270 
      ScaleWidth      =   9810 
      TabIndex        =   8 
      Top             =   6510 
      Width           =   9810 
      Begin VB.Image Image2  
         Height          =   255 
         Left            =   120 
         Stretch         =   -1  'True 
         Top             =   0 
         Width           =   9495 
      End 
   End 
   Begin VB.PictureBox Picture1  
      Align           =   1  'Align Top 
      Appearance      =   0  'Flat 
      BackColor       =   &H80000005& 
      BorderStyle     =   0  'None 
      ForeColor       =   &H80000008& 
      Height          =   375 
      Left            =   0 
      ScaleHeight     =   375 
      ScaleWidth      =   9810 
      TabIndex        =   7 
      Top             =   0 
      Width           =   9810 
      Begin VB.Label Label2  
         BackStyle       =   0  'Transparent 
         Caption         =   "用户方案配置" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   14.25 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00800000& 
         Height          =   375 
         Left            =   240 
         TabIndex        =   9 
         Top             =   45 
         Width           =   7815 
      End 
      Begin VB.Image Image1  
         Height          =   495 
         Left            =   120 
         Picture         =   "Project_Configure.frx":0000 
         Stretch         =   -1  'True 
         Top             =   0 
         Width           =   9615 
      End 
   End 
   Begin VB.PictureBox Pic  
      Align           =   1  'Align Top 
      Height          =   4920 
      Left            =   0 
      ScaleHeight     =   4860 
      ScaleWidth      =   9750 
      TabIndex        =   1 
      Top             =   1110 
      Width           =   9810 
      Begin VB.ComboBox RW  
         Height          =   300 
         ItemData        =   "Project_Configure.frx":06B4 
         Left            =   4800 
         List            =   "Project_Configure.frx":06C1 
         TabIndex        =   11 
         Text            =   "读" 
         Top             =   1320 
         Visible         =   0   'False 
         Width           =   735 
      End 
      Begin MSFlexGridLib.MSFlexGrid Grid_Fa  
         Height          =   4815 
         Left            =   0 
         TabIndex        =   2 
         Top             =   0 
         Width           =   9735 
         _ExtentX        =   17171 
         _ExtentY        =   8493 
         _Version        =   393216 
         Cols            =   8 
         AllowUserResizing=   3 
         BorderStyle     =   0 
         Appearance      =   0 
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
            Name            =   "宋体" 
            Size            =   9.75 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
      End 
   End 
   Begin VB.PictureBox Picture8  
      Align           =   1  'Align Top 
      Appearance      =   0  'Flat 
      BorderStyle     =   0  'None 
      ForeColor       =   &H80000008& 
      Height          =   735 
      Left            =   0 
      ScaleHeight     =   735 
      ScaleWidth      =   9810 
      TabIndex        =   0 
      Top             =   375 
      Width           =   9810 
      Begin VB.CommandButton Command4  
         Caption         =   "退出" 
         Height          =   375 
         Left            =   7920 
         TabIndex        =   10 
         Top             =   200 
         Width           =   1215 
      End 
      Begin VB.CommandButton Command3  
         Caption         =   "删除方案" 
         Height          =   375 
         Left            =   6360 
         TabIndex        =   6 
         Top             =   200 
         Width           =   1215 
      End 
      Begin VB.CommandButton Command2  
         Caption         =   "保存方案" 
         Height          =   375 
         Left            =   3360 
         TabIndex        =   5 
         Top             =   200 
         Width           =   1215 
      End 
      Begin VB.ComboBox Fang_a  
         Height          =   300 
         Left            =   1320 
         TabIndex        =   4 
         Top             =   240 
         Width           =   1815 
      End 
      Begin VB.Label Label1  
         Caption         =   "用户方案:" 
         Height          =   255 
         Left            =   360 
         TabIndex        =   3 
         Top             =   280 
         Width           =   1095 
      End 
   End 
   Begin VB.Menu sys  
      Caption         =   "sys" 
      Visible         =   0   'False 
      Begin VB.Menu sys_tj  
         Caption         =   "添加行" 
      End 
      Begin VB.Menu menuline001  
         Caption         =   "-" 
      End 
      Begin VB.Menu sys_sc  
         Caption         =   "删除行" 
      End 
   End 
End 
Attribute VB_Name = "Project_Configure" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
'**************************************************************************** 
'人人为我,我为人人 
'枕善居收藏整理 
'发布日期:2007/09/27 
'描    述:电表业645规约的电表485通讯代码 
'网    站:http://www.Mndsoft.com/  (VB6源码博客) 
'网    站:http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005) 
'e-mail  :Mndsoft@163.com 
'e-mail  :Mndsoft@126.com 
'OICQ    :88382850 
'          如果您有新的好的代码别忘记给枕善居哦! 
'**************************************************************************** 
 
Dim Rs As ADODB.Recordset 
 
Private Sub Command2_Click() 
FangAn_BaoCun Trim(Fang_a.Text) 
End Sub 
 
Private Sub Command3_Click() 
FangAn_ShanChu 
End Sub 
 
Private Sub Command4_Click() 
  Unload Me 
End Sub 
 
Private Sub Fang_a_Click() 
XinXi 
End Sub 
 
Private Sub Form_Load() 
 
  
RW.ListIndex = 1 
Image2.Picture = Image1.Picture 
Grid_Fa.TextMatrix(0, 0) = "序号" 
    Grid_Fa.ColWidth(0) = 600 
Grid_Fa.TextMatrix(0, 1) = "字段名称" 
    Grid_Fa.ColWidth(1) = 4000 
Grid_Fa.TextMatrix(0, 2) = "规约标志" 
    Grid_Fa.ColWidth(2) = 1000 
Grid_Fa.TextMatrix(0, 3) = "规约格式" 
    Grid_Fa.ColWidth(3) = 3000 
   
Grid_Fa.TextMatrix(0, 4) = "项字节数" 
    
Grid_Fa.TextMatrix(0, 5) = "控制码" 
    
Grid_Fa.TextMatrix(0, 6) = "读写" 
   Grid_Fa.ColWidth(6) = 800 
Grid_Fa.TextMatrix(0, 7) = "写编程密码" 
   Grid_Fa.ColWidth(7) = 1500 
   
LoadFa 
 
End Sub 
 
Private Sub Form_Resize() 
On Error Resume Next 
 
Pic.Height = Me.ScaleHeight - Picture8.Height - Picture1.Height - Picture3.Height 
Grid_Fa.Top = 0 
Grid_Fa.Left = 0 
Grid_Fa.Width = Pic.ScaleWidth 
Grid_Fa.Height = Pic.ScaleHeight 
     
Image1.Top = 0 
Image1.Left = 0 
Image1.Width = Me.ScaleWidth 
Image1.Height = Picture1.Height 
 
Image2.Top = 0 
Image2.Left = 0 
Image2.Width = Me.ScaleWidth 
Image2.Height = Picture3.Height 
 
End Sub 
 
Private Sub Grid_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    If Button = 2 Then PopupMenu SYS 
End Sub 
 
Private Sub Grid_Fa_EnterCell() 
 If Grid_Fa.Col = 6 Then 
        RW.Visible = True 
        RW.Left = Grid_Fa.CellLeft + Grid_Fa.Left 
        RW.Top = Grid_Fa.CellTop + Grid_Fa.Top 
        RW.Width = Grid_Fa.CellWidth 
'        RW.Height = Grid_Fa.CellHeight 
        RW.ForeColor = Grid_Fa.CellForeColor 
        RW.Text = Grid_Fa.TextMatrix(Grid_Fa.Row, Grid_Fa.Col) 
 Else 
        RW.Visible = False 
 End If 
End Sub 
 
Private Sub Grid_Fa_KeyPress(KeyAscii As Integer) 
'If Grid_fa.Col < 2 Then Exit Sub 
On Error Resume Next 
Select Case KeyAscii 
   Case 8    '退格 
     Grid_Fa.TextMatrix(Grid_Fa.Row, Grid_Fa.Col) = Mid(Grid_Fa.TextMatrix(Grid_Fa.Row, Grid_Fa.Col), 1, Len(Grid_Fa.TextMatrix(Grid_Fa.Row, Grid_Fa.Col)) - 1) 
   Case 13   '回车 
     Grid_Fa.Col = Grid_Fa.Col + 1 
   Case Else '其他键 
     Grid_Fa.TextMatrix(Grid_Fa.Row, Grid_Fa.Col) = Grid_Fa.TextMatrix(Grid_Fa.Row, Grid_Fa.Col) & UCase(Chr$(KeyAscii)) 
End Select 
End Sub 
 
Private Sub Grid_Fa_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
If Button = 2 Then PopupMenu SYS 
End Sub 
 
Private Sub Grid_Fa_Scroll() 
  RW.Visible = False 
End Sub 
 
Private Sub RW_Click() 
    On Error Resume Next 
    If Grid_Fa.Col = 6 Then 
       Grid_Fa.TextMatrix(Grid_Fa.Row, Grid_Fa.Col) = RW.Text 
    End If 
End Sub 
 
Private Sub sys_sc_Click() 
On Error GoTo Ex 
 
If MsgBox("确认要删除此项规约?", vbOKCancel, "删除确认") = vbOK Then 
    Dim Rs As ADODB.Recordset 
    Set Rs = New ADODB.Recordset 
    Rs.CursorType = adOpenKeyset 
    Rs.LockType = adLockOptimistic 
    Connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\fa.mdb;Persist Security Info=True" 
    SQL = " delete From 方案 where 方案名称='" & Trim(Fang_a.Text) & "' and 字段名称='" & Trim(Grid_Fa.TextMatrix(Grid_Fa.Row, 1)) & "'" 
    Rs.Open SQL, Connstr, , , adCmdText 
    Grid_Fa.RemoveItem Grid_Fa.Row 
End If 
 
XuHao 
 
Exit Sub 
Ex: 
  MsgBox (Err.Description) 
End Sub 
 
Private Sub sys_tj_Click() 
Grid_Fa.Rows = Grid_Fa.Rows + 1 
XuHao 
End Sub 
 
 
 
 
 
 
 
 
Public Sub LoadFa() 
On Error GoTo ErrMsg 
Dim p As Variant 
Dim SQL As String 
Set Rs = New ADODB.Recordset 
Rs.CursorType = adOpenKeyset 
Rs.LockType = adLockOptimistic 
Connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\fa.mdb;Persist Security Info=True" 
SQL = " Select 方案名称 From 方案 Group by 方案名称" 
Rs.Open SQL, Connstr, , , adCmdText 
If Not Rs.EOF Then 
Fang_a.Clear 
Rs.MoveFirst 
     For p = 1 To Rs.RecordCount 
      Fang_a.AddItem Trim(Rs.Fields("方案名称").Value), p - 1 
      Rs.MoveNext 
     Next p 
End If 
 
XuHao 
 
Exit Sub 
 
ErrMsg: 
   MsgBox (Err.Description) 
    
End Sub 
 
Public Sub XinXi() 
On Error Resume Next 
 
If Trim(Fang_a.Text) = "" Then Exit Sub 
 
Dim p As Variant 
Dim SQL As String 
Set Rs = New ADODB.Recordset 
Rs.CursorType = adOpenKeyset 
Rs.LockType = adLockOptimistic 
Connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\fa.mdb;Persist Security Info=True" 
SQL = " Select * From 方案 where 方案名称='" & Trim(Fang_a.Text) & "'" 
Rs.Open SQL, Connstr, , , adCmdText 
If Not Rs.EOF Then 
    Grid_Fa.Rows = Rs.RecordCount + 1 
      Rs.MoveFirst 
     For p = 1 To Rs.RecordCount 
      Grid_Fa.TextMatrix(p, 1) = Trim(Rs.Fields("字段名称").Value) 
      Grid_Fa.TextMatrix(p, 2) = Trim(Rs.Fields("规约标识").Value) 
      Grid_Fa.TextMatrix(p, 3) = Trim(Rs.Fields("规约格式").Value) 
      Grid_Fa.TextMatrix(p, 4) = Trim(Rs.Fields("项字节数").Value) 
      Grid_Fa.TextMatrix(p, 5) = Trim(Rs.Fields("控制码").Value) 
      Grid_Fa.TextMatrix(p, 6) = Trim(Rs.Fields("读写").Value) 
      Grid_Fa.TextMatrix(p, 7) = Trim(Rs.Fields("编程密码").Value) 
      Rs.MoveNext 
     Next p 
Else 
    Grid_Fa.Rows = 1 
End If 
 
XuHao 
End Sub 
 
Private Sub FangAn_BaoCun(FangA_MC As String) 
On Error GoTo ErrMsg 
Dim SQL As String 
SQL = "" 
Dim G As Variant 
Set Rs = New ADODB.Recordset 
Rs.CursorType = adOpenKeyset 
Rs.LockType = adLockOptimistic 
Connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\fa.mdb;Persist Security Info=True" 
For G = 1 To Grid_Fa.Rows - 1 
  SQL = " Select * From 方案 where 方案名称='" & Trim(Fang_a.Text) & "' and 字段名称='" & Trim(Grid_Fa.TextMatrix(G, 1)) & "'" 
  Rs.Open SQL, Connstr, , , adCmdText 
  If Not Rs.EOF Then   '找到 
    '更新 
    Rs.Fields("方案名称").Value = Trim(Fang_a.Text) 
    Rs.Fields("规约标识").Value = Trim(Grid_Fa.TextMatrix(G, 2)) 
    Rs.Fields("规约格式").Value = Trim(Grid_Fa.TextMatrix(G, 3)) 
    Rs.Fields("项字节数").Value = Trim(Grid_Fa.TextMatrix(G, 4)) 
    Rs.Fields("字段名称").Value = Trim(Grid_Fa.TextMatrix(G, 1)) 
    Rs.Fields("控制码").Value = Trim(Grid_Fa.TextMatrix(G, 5)) 
    Rs.Fields("编程密码").Value = Trim(Grid_Fa.TextMatrix(G, 7)) 
    Rs.Fields("读写").Value = Trim(Grid_Fa.TextMatrix(G, 6)) 
    Rs.Update 
    Rs.Close 
  Else 
    '添加 
    Rs.AddNew 
    Rs.Fields("方案名称").Value = Trim(Fang_a.Text) 
    Rs.Fields("规约标识").Value = Trim(Grid_Fa.TextMatrix(G, 2)) 
    Rs.Fields("规约格式").Value = Trim(Grid_Fa.TextMatrix(G, 3)) 
    Rs.Fields("项字节数").Value = Trim(Grid_Fa.TextMatrix(G, 4)) 
    Rs.Fields("字段名称").Value = Trim(Grid_Fa.TextMatrix(G, 1)) 
    Rs.Fields("控制码").Value = Trim(Grid_Fa.TextMatrix(G, 5)) 
    Rs.Fields("编程密码").Value = Trim(Grid_Fa.TextMatrix(G, 7)) 
    Rs.Fields("读写").Value = Trim(Grid_Fa.TextMatrix(G, 6)) 
    Rs.Update 
    Rs.Close 
  End If 
Next G 
MsgBox ("更新完成") 
 
Exit Sub 
ErrMsg: 
  MsgBox (Err.Description) 
End Sub 
 
Private Sub FangAn_ShanChu() 
On Error GoTo ErrMsg 
If MsgBox("确认要删除此用户方案?", vbOKCancel, "删除确认") = vbOK Then 
    Set Rs = New ADODB.Recordset 
    Rs.CursorType = adOpenKeyset 
    Rs.LockType = adLockOptimistic 
    Connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\fa.mdb;Persist Security Info=True" 
    SQL = " Delete From 方案 where 方案名称='" & Trim(Fang_a.Text) & "' " 
    Rs.Open SQL, Connstr, , , adCmdText 
End If 
LoadFa 
XinXi 
XuHao 
Exit Sub 
ErrMsg: 
  MsgBox (Err.Description) 
End Sub 
 
Private Sub XuHao() 
Dim p As Variant 
Grid_Fa.Col = 0 
For p = 1 To Grid_Fa.Rows - 1 
   Grid_Fa.TextMatrix(p, 0) = CStr(p) 
   Grid_Fa.Row = p 
Next p 
End Sub