frmwr24xx.frm

通过并口

    FrmSetIC.WMod = 0
End Select
With FrmSetIC
.Ltaddr.Caption = Hex(ICAddr)
.TSubaddr.Text = Hex(SubAddr)
.TLength.Text = Hex(DLength)
If Len(.Ltaddr.Caption) < 2 Then
    .Ltaddr.Caption = "0" + .Ltaddr.Caption
End If
If Len(.TSubaddr.Text) < 2 Then
    .TSubaddr.Text = "0" + .TSubaddr.Text
End If
If Len(.TLength.Text) < 4 Then
    .TLength.Text = "0" + .TLength.Text
End If
If Len(.TLength.Text) < 4 Then
    .TLength.Text = "0" + .TLength.Text
End If
If Len(.TLength.Text) < 4 Then
    .TLength.Text = "0" + .TLength.Text
End If
End With
FrmSetIC.Show vbModal
End Sub

Private Sub Bwrite_Click()
Dim Tsa As Long
Dim Ta As Integer
Dim Td As Integer
Dim i, j As Integer
Dim mx, my As Integer
Dim tv As Long

MSFG.Visible = False

Ta = ICAddr
Tsa = SubAddr
PB1.Visible = True
If DLength > HexLong Then
    DLength = HexLong
End If
Select Case ICType
Case 0, 1, 2
    '单字节写
    If (WPage = 1) Or (WPage > DLength) Then
        For i = 0 To DLength - 1
            mx = ((Tsa + i) Mod 16) + 1
            my = ((Tsa + i) \ 16) + 1
            If mx = MSFG.Cols Or my = MSFG.Rows Then
                GoTo EndNext1
            End If
            MSFG.Col = mx
            MSFG.Row = my
            Td = Int(Val("&H" & MSFG.Text))
            tv = i * PB1.Max \ DLength
            PB1.Value = tv
            If Tsa + i = HexLong Then Exit For
            WriteBIntoByteAddr Ta, Tsa + i, Td
        Next i
    '地址超出
    ElseIf (WPage = 0) Or (Tsa + DLength > &H100) Then
        GoTo EndNext1
    '页写
    Else
        For i = 0 To (DLength \ WPage) - 1
            For j = 0 To WPage - 1
                mx = ((Tsa) Mod 16) + 1
                my = ((Tsa) \ 16) + 1
                If mx = MSFG.Cols Or my = MSFG.Rows Then
                    GoTo EndNext1
                End If
                MSFG.Col = mx
                MSFG.Row = my
                Tsa = Tsa + 1
                Data(j + 1) = Int(Val("&H" & MSFG.Text))
            Next j
            tv = i * PB1.Max / (DLength \ WPage)
            PB1.Value = tv Mod PB1.Max
            WriteAIntoByteAddr Ta, Tsa - WPage, WPage, Data
        Next i
        '页写后剩余字节写
        For i = 0 To (DLength Mod WPage) - 1
            mx = ((Tsa + i) Mod 16) + 1
            my = ((Tsa + i) \ 16) + 1
            If mx = MSFG.Cols Or my = MSFG.Rows Then
                GoTo EndNext1
            End If
            MSFG.Col = mx
            MSFG.Row = my
            Td = Int(Val("&H" & MSFG.Text))
            WriteBIntoByteAddr Ta, Tsa + i - 1, Td
        Next i
    End If
Case 3, 4, 5
    '单字节写入
    If (WPage = 1) Or (WPage > DLength) Then
        For i = 0 To DLength - 1
            mx = ((Tsa + i) Mod 16) + 1
            my = ((Tsa + i) \ 16) + 1
            If mx = MSFG.Cols Or my = MSFG.Rows Then
                GoTo EndNext1
            End If
            MSFG.Col = mx
            MSFG.Row = my
            Td = Int(Val("&H" & MSFG.Text))
            If Tsa + i - 1 < &H100 Then
                Ta = Ta \ 2
                Ta = Ta * 2
            ElseIf Tsa + i - 1 < &H200 Then
                Ta = Ta \ 4
                Ta = Ta * 4 + 2
            ElseIf Tsa + i - 1 < &H300 Then
                Ta = Ta \ 8
                Ta = Ta * 8 + 4
            ElseIf Tsa + i - 1 < &H400 Then
                Ta = Ta \ 8
                Ta = Ta * 8 + 6
            ElseIf Tsa + i - 1 < &H500 Then
                Ta = Ta \ 16
                Ta = Ta * 16 + 8
            ElseIf Tsa + i - 1 < &H600 Then
                Ta = Ta \ 16
                Ta = Ta * 16 + 10
            ElseIf Tsa + i - 1 < &H700 Then
                Ta = Ta \ 16
                Ta = Ta * 16 + 12
            ElseIf Tsa + i - 1 < &H800 Then
                Ta = Ta \ 16
                Ta = Ta + 14
            End If
            tv = i * PB1.Max / DLength
            PB1.Value = tv Mod PB1.Max
            WriteBIntoByteAddr Ta, (Tsa + i - 1) Mod &H100, Td
        Next i
    '地址超出
    ElseIf (WPage = 0) Or (Tsa + DLength > &H1000) Then
        GoTo EndNext1
    '页写
    Else
        For i = 0 To (DLength \ WPage) - 1
            For j = 0 To WPage - 1
                mx = ((Tsa) Mod 16) + 1
                my = ((Tsa) \ 16) + 1
                If mx = MSFG.Cols Or my = MSFG.Rows Then
                    GoTo EndNext1
                End If
                MSFG.Col = mx
                MSFG.Row = my
                Tsa = Tsa + 1
                Data(j) = Int(Val("&H" & MSFG.Text))
            Next j
            If Tsa + i - 1 < &H100 Then
                Ta = Ta \ 2
                Ta = Ta * 2
            ElseIf Tsa + i - 1 < &H200 Then
                Ta = Ta \ 4
                Ta = Ta * 4 + 2
            ElseIf Tsa + i - 1 < &H300 Then
                Ta = Ta \ 8
                Ta = Ta * 8 + 4
            ElseIf Tsa + i - 1 < &H400 Then
                Ta = Ta \ 8
                Ta = Ta * 8 + 6
            ElseIf Tsa + i - 1 < &H500 Then
                Ta = Ta \ 16
                Ta = Ta * 16 + 8
            ElseIf Tsa + i - 1 < &H600 Then
                Ta = Ta \ 16
                Ta = Ta * 16 + 10
            ElseIf Tsa + i - 1 < &H700 Then
                Ta = Ta \ 16
                Ta = Ta * 16 + 12
            ElseIf Tsa + i - 1 < &H800 Then
                Ta = Ta \ 16
                Ta = Ta + 14
            End If
            tv = i * PB1.Max / (DLength \ WPage)
            PB1.Value = tv Mod PB1.Max
            WriteAIntoByteAddr Ta, Tsa - WPage, WPage, Data
        Next i
        '页写后剩余字节的写入
        For i = 0 To (DLength Mod WPage) - 1
            mx = ((Tsa + i) Mod 16) + 1
            my = ((Tsa + i) \ 16) + 1
            If mx = MSFG.Cols Or my = MSFG.Rows Then
                GoTo EndNext1
            End If
            MSFG.Col = mx
            MSFG.Row = my
            Td = Int(Val("&H" & MSFG.Text))
            If Tsa + i - 1 < &H100 Then
                Ta = Ta \ 2
                Ta = Ta * 2
            ElseIf Tsa + i - 1 < &H200 Then
                Ta = Ta \ 4
                Ta = Ta * 4 + 2
            ElseIf Tsa + i - 1 < &H300 Then
                Ta = Ta \ 8
                Ta = Ta * 8 + 4
            ElseIf Tsa + i - 1 < &H400 Then
                Ta = Ta \ 8
                Ta = Ta * 8 + 6
            ElseIf Tsa + i - 1 < &H500 Then
                Ta = Ta \ 16
                Ta = Ta * 16 + 8
            ElseIf Tsa + i - 1 < &H600 Then
                Ta = Ta \ 16
                Ta = Ta * 16 + 10
            ElseIf Tsa + i - 1 < &H700 Then
                Ta = Ta \ 16
                Ta = Ta * 16 + 12
            ElseIf Tsa + i - 1 < &H800 Then
                Ta = Ta \ 16
                Ta = Ta + 14
            End If
            WriteBIntoByteAddr Ta, Tsa + i - 1, Td
        Next i
    End If
Case 6, 7, 8, 9, 10
    '单字节写入
    If (WPage = 1) Or (WPage > DLength) Then
        For i = 0 To DLength - 1
            mx = ((Tsa + i) Mod 16) + 1
            my = ((Tsa + i) \ 16) + 1
            If mx = MSFG.Cols Or my = MSFG.Rows Then
                GoTo EndNext1
            End If
            MSFG.Col = mx
            MSFG.Row = my
            Td = Int(Val("&H" & MSFG.Text))
            tv = i * PB1.Max / DLength
            PB1.Value = tv Mod PB1.Max
            WriteBIntoWordAddr Ta, (Tsa + i - 1) \ &H100, (Tsa + i - 1) Mod &H100, Td
        Next i
    '地址超出
    ElseIf (WPage = 0) Or (Tsa + DLength > &H10000) Then
        GoTo EndNext1
    '页写入
    Else
        For i = 0 To (DLength \ WPage) - 1
            For j = 0 To WPage - 1
                mx = ((Tsa) Mod 16) + 1
                my = ((Tsa) \ 16) + 1
                If mx = MSFG.Cols Or my = MSFG.Rows Then
                    GoTo EndNext1
                End If
                MSFG.Col = mx
                MSFG.Row = my
                Tsa = Tsa + 1
                Data(j + 1) = Int(Val("&H" & MSFG.Text))
            Next j
            tv = i * PB1.Max / (DLength \ WPage)
            PB1.Value = tv Mod PB1.Max
            WriteAIntoWordAddr Ta, (Tsa - WPage) \ &H100, (Tsa - WPage) Mod &H100, WPage, Data
        Next i
        '页写后剩余字节的写入
        For i = 0 To (DLength Mod WPage) - 1
            mx = ((Tsa + i) Mod 16) + 1
            my = ((Tsa + i) \ 16) + 1
            If mx = MSFG.Cols Or my = MSFG.Rows Then
                GoTo EndNext1
            End If
            MSFG.Col = mx
            MSFG.Row = my
            Td = Int(Val("&H" & MSFG.Text))
            WriteBIntoWordAddr Ta, (Tsa + i - 1) \ &H100, (Tsa + i - 1) Mod &H100, Td
        Next i
    End If
End Select
EndNext1:
PB1.Visible = False

MSFG.Visible = True

End Sub

Private Sub Form_Load()
Dim Fso As New FileSystemObject
Dim hF As TextStream
On Error GoTo MyDefault
Set hF = Fso.OpenTextFile(App.Path + "data.sgw", ForReading, False)
SCL = Val(hF.ReadLine)
Scl_Level = Val(hF.ReadLine)
SDO = Val(hF.ReadLine)
Sdo_Level = Val(hF.ReadLine)
SDI = Val(hF.ReadLine)
Sdi_Level = Val(hF.ReadLine)
LPTAddressBase = Val(hF.ReadLine)
LPTOutData = Val(hF.ReadLine)
TL = Val(hF.ReadLine)
SubAddr = Val(hF.ReadLine)
WPage = Val(hF.ReadLine)
ICAddr = Val(hF.ReadLine)
ICType = Val(hF.ReadLine)
TimeD = Val(hF.ReadLine)
hF.Close
GoTo MyGO_ON
MyDefault:
SCL = 0
Scl_Level = 0
SDO = 1
Sdo_Level = 0
SDI = 3
Sdi_Level = 0
LPTAddressBase = &H378
LPTOutData = 255
TL = &H10
SubAddr = 0
WPage = 8
ICAddr = &HA0
ICType = 2
On Error Resume Next
MyGO_ON:
DLength = TL * 16
MEditCell = False
HexLong = TL * 16

InitMSFGDisplay TL

Unload frmLoadWR24
End Sub


Public Function AddressDisplay(ByVal a As Integer) As String
Dim Res As String
Res = Hex(a)
Res = Res + "0"
If Len(Res) < 4 Then
    Res = "0" + Res
End If
If Len(Res) < 4 Then
    Res = "0" + Res
End If
If Len(Res) < 4 Then
    Res = "0" + Res
End If
AddressDisplay = Res
End Function

Public Function ValHex(ByVal str As String) As Integer
Dim t As String
t = "&H" + str
ValHex = Val(t)
End Function

Private Sub Form_Unload(Cancel As Integer)
Dim Fso As New FileSystemObject
Dim hF As TextStream
On Error GoTo ExitSub1
Set hF = Fso.OpenTextFile(App.Path + "data.sgw", ForWriting, True)
hF.WriteLine str(SCL)
hF.WriteLine str(Scl_Level)
hF.WriteLine str(SDO)
hF.WriteLine str(Sdo_Level)
hF.WriteLine str(SDI)
hF.WriteLine str(Sdi_Level)
hF.WriteLine str(LPTAddressBase)
hF.WriteLine str(LPTOutData)
hF.WriteLine str(TL)
hF.WriteLine str(SubAddr)
hF.WriteLine str(WPage)
hF.WriteLine str(ICAddr)
hF.WriteLine str(ICType)
hF.WriteLine str(TimeD)
hF.Close
ExitSub1:
End Sub

Private Sub MAbout_Click()
frmAbout.Show vbModal
End Sub

Private Sub Mback_Click()
BBack_Click
End Sub

Private Sub Mclear_Click()
Bclear_Click
End Sub

Private Sub Medit_Click()
Bedit_Click
End Sub

Private Sub Mload_Click()
Bload_Click
End Sub

Private Sub Mread_Click()
Bread_Click
End Sub

Private Sub Msave_Click()
Bsave_Click
End Sub

Private Sub MsetIC_Click()
BsetIC_Click
End Sub

Private Sub MSetIO_Click()
BSetFace_Click
End Sub

Private Sub MSFG_LeaveCell()
'MSFG.CellBackColor = RGB(0, 0, 0)
'MSFG.CellForeColor = RGB(0, 0, 0)
End Sub

Private Sub MSFG_RowColChange()
Dim mx As Integer
Dim my As Integer
'MSFG.CellBackColor = RGB(0, 0, 255)
'MSFG.CellForeColor = RGB(255, 255, 0)
If MEditCell Then
    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
End Sub

Private Sub Mwrite_Click()
Bwrite_Click
End Sub

Private Sub Tin_Change()
Dim t, t1, t2 As String
'Dim i As Integer
t = UCase(Tin.Text)
t1 = Left(t, 1)
t2 = Right(t, 1)
If (t1 >= "0" And t1 <= "9") Or (t1 >= "A" And t1 <= "F") Then
    t = t1
Else
    t = "0"
End If
If (t2 >= "0" And t2 <= "9") Or (t2 >= "A" And t2 <= "F") Then
    t = t + t2
Else
    t = "0"
End If
MSFG.Text = t
Tin.Text = t
Tin.SelStart = CharPos
Tin.SelLength = 1
End Sub

Private Sub Tin_GotFocus()
Tin.SelLength = 1
CharPos = 0
End Sub
Public Function HexFileDisplay(ByVal s As String)
Dim t As String
Dim n As Integer
Dim addr As Long
Dim i As Integer
t = Mid(s, 2, 2)
n = Val("&h" & t)
If (n <= 0) Then
    Exit Function
End If
t = Mid(s, 4, 4)
addr = Val("&h" & t)
For i = 0 To n - 1
    MSFG.Col = ((addr + i) Mod 16) + 1
    MSFG.Row = ((addr + i) \ 16) + 1
    MSFG.Text = Mid(s, 10 + 2 * i, 2)
Next i
ExitHex:
End Function


Private Sub Tin_KeyDown(KeyCode As Integer, Shift As Integer)
CharPos = (CharPos + 1) Mod 2
End Sub

Public Sub InitMSFGDisplay(ByVal L As Long)
Dim i, j, t As Long
PB1.Visible = True
PB1.Max = 4096
If L < 17 Then L = 16
With MSFG
    .Visible = False
    .Cols = 18
    .Rows = L + 1
    .Row = 0
    .Col = 0
    .ColWidth(0) = 540
    .Text = "地址"
    For i = 1 To L  '&H7FF
        .Row = i
        .Text = AddressDisplay(i - 1)
    Next i
    .Row = 0
    For i = 0 To 15
        .Col = i + 1
        .ColWidth(i + 1) = 300
        .Text = Hex(i)
        .ColAlignment(i) = 4
    Next i
    .ColWidth(16) = 265
    For i = 1 To L
        .Row = i
        t = i
        t = 4096 * t / (L + 1)
        PB1.Value = Int(t)
        For j = 1 To 16 '&H800
            .Col = j
            .Text = "FF"
        Next j
    Next i
    .Col = 0
    .Row = 0
    .Text = ICStr(ICType Mod 11)
    .CellForeColor = RGB(255, 0, 255)
    .CellBackColor = RGB(255, 255, 128)
    .ColAlignment(16) = 4
    .Col = 1
    .Row = 1
    .Visible = True
End With
PB1.Visible = False
End Sub