frmwr24xx.frm

通过并口

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form FrmWR24XX 
   Caption         =   "24系列IC读写程序(未注册版)"
   ClientHeight    =   4455
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   6705
   Icon            =   "FrmWR24XX.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4455
   ScaleWidth      =   6705
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton BComp 
      Caption         =   "Comp"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   12
      Top             =   1704
      Width           =   975
   End
   Begin VB.CommandButton BSetFace 
      Caption         =   "Set I/&O"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   11
      Top             =   3408
      Width           =   975
   End
   Begin MSComctlLib.ProgressBar PB1 
      Height          =   255
      Left            =   0
      TabIndex        =   10
      Top             =   4200
      Visible         =   0   'False
      Width           =   6615
      _ExtentX        =   11668
      _ExtentY        =   450
      _Version        =   393216
      Appearance      =   1
      Max             =   4096
   End
   Begin VB.CommandButton BsetIC 
      Caption         =   "Set &IC"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   9
      Top             =   2556
      Width           =   975
   End
   Begin VB.CommandButton Bclear 
      Caption         =   "&Clear"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   8
      Top             =   2982
      Width           =   975
   End
   Begin VB.TextBox Tin 
      Appearance      =   0  'Flat
      BackColor       =   &H80000016&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1560
      MaxLength       =   2
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   2880
      Visible         =   0   'False
      Width           =   400
   End
   Begin VB.CommandButton Bedit 
      Caption         =   "&Edit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   6
      Top             =   2130
      Width           =   975
   End
   Begin VB.CommandButton Bback 
      Caption         =   "E&xit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   5
      Top             =   3840
      Width           =   975
   End
   Begin VB.CommandButton Bwrite 
      Caption         =   "&Write"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   4
      Top             =   1278
      Width           =   975
   End
   Begin VB.CommandButton Bread 
      Caption         =   "&Read"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   3
      Top             =   852
      Width           =   975
   End
   Begin VB.CommandButton Bsave 
      Caption         =   "&Save"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   2
      Top             =   426
      Width           =   975
   End
   Begin VB.CommandButton Bload 
      Caption         =   "&Load"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   5700
      TabIndex        =   0
      Top             =   0
      Width           =   975
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   600
      Top             =   2880
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSFlexGridLib.MSFlexGrid MSFG 
      Height          =   4215
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   5685
      _ExtentX        =   10028
      _ExtentY        =   7435
      _Version        =   393216
      Rows            =   17
      Cols            =   20
      ScrollTrack     =   -1  'True
      Enabled         =   -1  'True
      ScrollBars      =   2
   End
   Begin VB.Menu Mload 
      Caption         =   "装载"
   End
   Begin VB.Menu Msave 
      Caption         =   "保存"
   End
   Begin VB.Menu Mread 
      Caption         =   "读数"
   End
   Begin VB.Menu Mwrite 
      Caption         =   "写数"
   End
   Begin VB.Menu MComp 
      Caption         =   "比较"
   End
   Begin VB.Menu Medit 
      Caption         =   "编辑"
   End
   Begin VB.Menu MsetIC 
      Caption         =   "设置IC"
   End
   Begin VB.Menu Mclear 
      Caption         =   "清除"
   End
   Begin VB.Menu MSetIO 
      Caption         =   "设置IO"
   End
   Begin VB.Menu MAbout 
      Caption         =   "关于"
   End
   Begin VB.Menu Mback 
      Caption         =   "退出"
   End
End
Attribute VB_Name = "FrmWR24XX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public MEditCell As Boolean  'Cell Edit Enable/Disable
Public WPage As Byte         'Write Page Mode:1 Byte/8 Byte/16 Byte/32 Byte/64 Byte
Public TL As Long            'Cell Rows
Dim Data(1 To 64) As Integer 'Page Write Data
Public SubAddr As Integer    '24XX IC Sub Address
Public ICAddr As Integer     '24XX IC Address
Public DLength As Long    'Write 24XX IC Data Length
Public ICType As Integer     'IC Type
Public HexLong As Long       'IC 的存储容量
Public CharPos As Integer

Private Sub BBack_Click()
Unload Me
End Sub

Private Sub Bclear_Click()
Dim i, j As Integer

MSFG.Visible = False

PB1.Visible = True
PB1.Max = TL
For i = 1 To TL
    MSFG.Row = i
    For j = 1 To 16
        MSFG.Col = j
        MSFG.Text = "FF"
    Next j
    PB1.Value = i - 1
Next i
PB1.Visible = False

MSFG.Visible = True

End Sub

Private Sub BComp_Click()
Dim Address As Integer
Dim Res As Integer
Dim Tb As Boolean
Dim TStr As String
Dim i, t As Integer
MSFG.Visible = False
Address = 0
I_Start
Tb = I_Send(ICAddr)
If ICType < 6 Then
    Tb = I_Send(Address)
Else
    Tb = I_Send(Address \ &H100)
    Tb = I_Send(Address Mod &H100)
End If
If DLength > HexLong Then
    DLength = HexLong
End If
I_Start
I_Send (ICAddr + 1)
PB1.Visible = True
PB1.Max = DLength
For i = 1 To DLength
    Res = I_Receive
    MSFG.Col = (Address Mod 16) + 1
    MSFG.Row = (Address \ 16) + 1
    If Val("&H" + MSFG.Text) <> Res Then
        t = MsgBox("R:" + Hex(Res) + "  TRUE:" + MSFG.Text, vbOKCancel)
        If t = 2 Then
            MSFG.Visible = True
            Exit Sub '=2 Cancel;=1 OK
        End If
    End If
    Address = Address + 1
    PB1.Value = i - 1
    If i = HexLong Then
        I_NoAck
    Else
        I_Ack
    End If
Next i
PB1.Visible = False

MSFG.Visible = True

End Sub

Private Sub Bedit_Click()
If MEditCell Then
'    MSFG.CellBackColor = RGB(0, 0, 0)
    Tin.Visible = False
'    MSFG.CellForeColor = RGB(0, 0, 0)
Else
    Tin.Visible = True
'    MSFG.CellBackColor = RGB(0, 0, 255)
'    MSFG.CellForeColor = RGB(255, 255, 0)
'    mx = MSFG.ColPos(MSFG.Col) + MSFG.Left + 500
'    my = MSFG.RowPos(MSFG.Row) + MSFG.Top + 500
    Tin.FontSize = MSFG.CellFontSize
    Tin.Height = MSFG.CellHeight
    Tin.Width = MSFG.CellWidth
    Tin.Top = MSFG.CellTop
    Tin.Left = MSFG.CellLeft
    Tin.Text = MSFG.Text
    Tin.SetFocus
End If
MEditCell = Not MEditCell
End Sub

Private Sub Bload_Click()
Dim f, tsl
Dim j As Integer
On Error GoTo ExitBLoad1
CommonDialog1.Filter = "十六进制文件(*.Hex)|*.Hex"
CommonDialog1.ShowOpen
Set f = CreateObject("Scripting.FileSystemObject")
Set tsl = f.OpenTextFile(CommonDialog1.FileName, ForReading, False)
On Error Resume Next
MSFG.Visible = False
Do While Not tsl.AtEndOfLine
    j = HexFileDisplay(tsl.ReadLine)
Loop
tsl.Close
ExitBLoad1:
MSFG.Visible = True
End Sub

Private Sub Bread_Click()
Dim Address As Integer
Dim Res As Integer
Dim Tb As Boolean
Dim TStr As String
Dim i As Integer
Address = 0
I_Start
Tb = I_Send(ICAddr)
If ICType < 6 Then
    Tb = I_Send(Address)
Else
    Tb = I_Send(Address \ &H100)
    Tb = I_Send(Address Mod &H100)
End If
I_Start
I_Send (ICAddr + 1)
PB1.Visible = True
PB1.Max = HexLong
MSFG.Visible = False
For i = 1 To HexLong
    Res = I_Receive
    MSFG.Col = (Address Mod 16) + 1
    MSFG.Row = (Address \ 16) + 1
    TStr = Hex(Res)
    If Len(TStr) < 2 Then
        TStr = "0" + TStr
    End If
    MSFG.Text = TStr
    Address = Address + 1
    PB1.Value = i - 1
    If i = HexLong Then
        I_NoAck
    Else
        I_Ack
    End If
Next i
PB1.Visible = False
MSFG.Visible = True
End Sub

Private Sub Bsave_Click()
Dim j, i As Integer
Dim fs As FileSystemObject
Dim ts As TextStream
Dim sl, st As String
Dim jl As Byte
CommonDialog1.Filter = "十六进制文件(*.Hex)|*.Hex"
CommonDialog1.ShowSave
On Error GoTo BSaveError1
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(CommonDialog1.FileName, ForWriting, True)
On Error Resume Next
sl = ":10"
'MSFG.Row = 1
'MSFG.Col = 0
st = MSFG.TextMatrix(1, 0)
sl = sl + st
sl = sl + "00"
jl = Int(Val("&H" & Left(st, 2))) + Int(Val("&H" & Right(st, 2)))
For j = 1 To 16
    'MSFG.Col = j
    st = MSFG.TextMatrix(1, j)
    sl = sl + st
    jl = jl + Int(Val("&h" & st))
Next j
jl = jl + &H10
jl = &H100 - jl
st = Hex(jl)
If Len(st) < 2 Then
    st = "0" + st
End If
sl = sl + st
ts.WriteLine (sl)
ts.Close
PB1.Visible = True
PB1.Max = 4096
Set ts = fs.OpenTextFile(CommonDialog1.FileName, ForAppending, False)
For i = 2 To (HexLong \ &H10)
    sl = ":10"
'    MSFG.Row = i
'    MSFG.Col = 0
    st = MSFG.TextMatrix(i, 0)
    sl = sl + st
    sl = sl + "00"
    jl = Int(Val("&H" & Left(st, 2))) + Int(Val("&H" & Right(st, 2)))
    For j = 1 To 16
        'MSFG.Col = j
        st = MSFG.TextMatrix(i, j)
        sl = sl + st
        jl = jl + Int(Val("&h" & st))
    Next j
    jl = jl + &H10
    jl = &H100 - jl
    st = Hex(jl)
    If Len(st) < 2 Then
        st = "0" + st
    End If
    sl = sl + st
    ts.WriteLine (sl)
    PB1.Value = 4095 * i \ (HexLong \ 16)
Next i
sl = ":00000001FF"
ts.WriteLine (sl)
ts.Close
PB1.Visible = False
Exit Sub
BSaveError1:
End Sub

Private Sub BSetFace_Click()
FrmSetInterface.Show vbModal
End Sub

Private Sub BsetIC_Click()
Select Case WPage
Case 1:
    FrmSetIC.WMod = 0
Case 8:
    FrmSetIC.WMod = 1
Case 16:
    FrmSetIC.WMod = 2
Case 32:
    FrmSetIC.WMod = 3
Case 64:
    FrmSetIC.WMod = 4
Case Else