VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form ROMView 
   AutoRedraw      =   -1  'True
   Caption         =   "PokeFile Viewer"
   ClientHeight    =   7365
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9555
   BeginProperty Font 
      Name            =   "Courier New"
      Size            =   9
      Charset         =   204
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   ScaleHeight     =   491
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   637
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command4 
      Caption         =   "Jump"
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   204
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   6000
      TabIndex        =   7
      TabStop         =   0   'False
      Top             =   360
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   204
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   120
      Locked          =   -1  'True
      TabIndex        =   6
      TabStop         =   0   'False
      Text            =   "Text1"
      Top             =   120
      Width           =   5655
   End
   Begin VB.CommandButton Command2 
      Caption         =   "load ROM"
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9
         Charset         =   204
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   7200
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   0
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "display"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   204
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   6000
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   0
      Width           =   1215
   End
   Begin MSForms.Frame Frame1 
      Height          =   375
      Left            =   7320
      OleObjectBlob   =   "ROMView.frx":0000
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   360
      Width           =   615
   End
   Begin VB.Shape hexShape 
      BorderColor     =   &H000000FF&
      Height          =   135
      Left            =   120
      Shape           =   4  'Rounded Rectangle
      Top             =   1080
      Width           =   375
   End
   Begin MSForms.TextBox HexView 
      Height          =   5880
      Left            =   120
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   1080
      Width           =   6495
      VariousPropertyBits=   -2147467233
      BackColor       =   -2147483644
      ForeColor       =   0
      ScrollBars      =   3
      Size            =   "11456;10372"
      Value           =   "hexhexhex"
      FontName        =   "Courier New"
      FontHeight      =   180
      FontCharSet     =   204
      FontPitchAndFamily=   2
   End
   Begin MSForms.TextBox TextBox1 
      Height          =   375
      Left            =   8160
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   360
      Width           =   1095
      VariousPropertyBits=   746604569
      Size            =   "1931;661"
      FontName        =   "Courier New"
      FontEffects     =   1073750016
      FontHeight      =   195
      FontCharSet     =   204
      FontPitchAndFamily=   2
   End
   Begin VB.Shape txtShape 
      BorderColor     =   &H000000FF&
      Height          =   135
      Left            =   6720
      Top             =   1080
      Width           =   135
   End
   Begin MSForms.TextBox TxtView 
      Height          =   5895
      Left            =   6720
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   1080
      Width           =   2775
      VariousPropertyBits=   -1609545697
      ScrollBars      =   3
      Size            =   "4895;10398"
      Value           =   "texttext"
      SpecialEffect   =   6
      FontName        =   "Courier New"
      FontHeight      =   180
      FontCharSet     =   204
   End
End
Attribute VB_Name = "ROMView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Call Form_Load
End Sub

Private Sub Command4_Click()
CursorInROM = Val(InputBox("куда прыгаем", , "&H"))
CursorRow = 1
CursorCol = 1
Call DoDisplay
Call ShowCursor
End Sub

Sub DoRecalcAndResize()
SingleCharHeight = ROMView.TextHeight("Й")
SingleCharWidth = ROMView.TextWidth("Ж")
CursorAddition = 1
If TrTableType <> "DBCS" Then 'если это однобайтовая таблица
   hexMaxCols = Int((HexView.Width / SingleCharWidth) / 3)
Else
   CursorAddition = 2
   hexMaxCols = Int((HexView.Width / SingleCharWidth) / 5)
End If
hexMaxRows = Int(HexView.Height / SingleCharHeight)
'txtMaxCols = Int(TxtView.Width / SingleCharWidth)
'txtMaxRows = Int(TxtView.Height / SingleCharHeight)
   txtCursorHeight = ROMView.TextHeight("X") ' + SingleCharHeight / 4
   txtCursorWidth = SingleCharWidth ' + SingleCharWidth / 2

txtMaxCols = hexMaxCols
txtMaxRows = hexMaxRows

Call DoDisplay
Call ShowCursor
End Sub

Private Sub Form_Load()
CursorInROM = 0
CursorRow = 1
CursorCol = 1
Call DoRecalcAndResize
End Sub

Private Sub Command2_Click()
Call OpenRom(InputRomFileName)
End Sub

Private Sub Form_GotFocus()
Frame1.SetFocus
End Sub

Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
HexView.Left = 8
HexView.Top = 72
HexView.Width = Me.ScaleWidth - 204
HexView.Height = Me.ScaleHeight - 99
TxtView.Left = HexView.Width + 8 + HexView.Left
TxtView.Top = HexView.Top
TxtView.Height = HexView.Height
TxtView.Width = Me.ScaleWidth - 16 - HexView.Width
Call DoRecalcAndResize
End If
End Sub

Private Sub Frame1_KeyDown(KeyCode As MSForms.ReturnInteger, Shift As Integer)
Dim myKeycode
myKeycode = KeyCode
Select Case myKeycode
 Case Is = vbKeyUp
     CursorRow = CursorRow - 1
 Case Is = vbKeyDown
     CursorRow = CursorRow + 1
 Case Is = vbKeyLeft
     If Shift = 0 Then 'если нажали БЕЗ Shift/Alt/Ctrl
     CursorCol = CursorCol - 1
     Else 'а иначе мы как джампнем...
        If CursorInROM > 0 Then
           CursorInROM = CursorInROM - CursorAddition
        End If
        Call DoDisplay
        Call ShowCursor
     End If
 Case Is = vbKeyRight
     If Shift = 0 Then 'если нажали БЕЗ Shift/Alt/Ctrl
     CursorCol = CursorCol + 1
     Else 'а иначе мы как джампнем...
        If CursorInROM < InputROMFileSize Then
           CursorInROM = CursorInROM + CursorAddition
        End If
        Call DoDisplay
        Call ShowCursor
     End If
 Case Is = vbKeyPageUp
     CursorRow = 1
     Call DoScrollUp(hexMaxRows)
 Case Is = vbKeyPageDown
     Call DoScrollDown(hexMaxRows)
 Case Is = vbKeyHome
     CursorRow = 1
     CursorCol = 1
     CursorInROM = 0
     Call DoDisplay
 Case Is = vbKeyEnd
     CursorRow = hexMaxRows
     CursorCol = hexMaxCols
     If TrTableType <> "DBCS" Then 'если это однобайтовая таблица
        CursorInROM = InputROMFileSize - hexMaxRows * hexMaxCols
     Else
        CursorInROM = InputROMFileSize - hexMaxRows * hexMaxCols * 2
     End If
     Call DoDisplay
'Case Else
End Select
If CursorCol < 1 Then
   'CursorCol = 1
   CursorCol = hexMaxCols
   CursorRow = CursorRow - 1
End If
If CursorCol > hexMaxCols Then
   'CursorCol = txtMaxCols
   CursorCol = 1
      CursorRow = CursorRow + 1
End If
If CursorRow < 1 Then
   CursorRow = 1
   Call DoScrollUp
End If
If CursorRow > hexMaxRows Then
   CursorRow = hexMaxRows
   Call DoScrollDown
End If
Call ShowCursor
End Sub

Sub ShowCursor()
If TrTableType <> "DBCS" Then 'если это однобайтовая таблица
   txtShape.Move TxtView.Left + (CursorCol - 1) * SingleCharWidth + 5, TxtView.Top + (CursorRow - 1) * SingleCharHeight + SingleCharHeight + 2, txtCursorWidth - 1, 2
   hexShape.Move HexView.Left + (CursorCol - 1) * SingleCharWidth * 3 + 2, HexView.Top + (CursorRow - 1) * SingleCharHeight + 3, txtCursorWidth * 2 + 4, SingleCharHeight + 3
   Text1.Text = Str(CursorRow) & "," & Str(CursorCol) & "," & Str(CursorInROM) & "," & Str(CursorInROM + (CursorRow - 1) * hexMaxCols + (CursorCol - 1)) & "(" & Hex(CursorInROM + (CursorRow - 1) * hexMaxCols + (CursorCol - 1)) & ")"
Else
   txtShape.Move TxtView.Left + (CursorCol - 1) * SingleCharWidth + 5, TxtView.Top + (CursorRow - 1) * SingleCharHeight + SingleCharHeight + 2, txtCursorWidth - 1, 2
   hexShape.Move HexView.Left + (CursorCol - 1) * SingleCharWidth * 5 + 2, HexView.Top + (CursorRow - 1) * SingleCharHeight + 3, txtCursorWidth * 4 + 4, SingleCharHeight + 3
   Text1.Text = Str(CursorRow) & "," & Str(CursorCol) & "," & Str(CursorInROM) & "," & Str(CursorInROM + (CursorRow - 1) * hexMaxCols * CursorAddition + (CursorCol - 1) * CursorAddition) & "(" & Hex(CursorInROM + (CursorRow - 1) * hexMaxCols * CursorAddition + (CursorCol - 1) * CursorAddition) & ")"
End If
End Sub

Private Sub form_KeyDown(KeyCode As Integer, Shift As Integer)
Frame1.SetFocus
End Sub


Sub DoDisplay()
Dim r As Long
Dim c As Long
Dim db As Long
Dim b As Byte
Dim b1 As Byte
Dim txtline As String
Dim hexline As String
Dim hexb As String
Dim hexb1 As String
Dim iterator As Long
hexViewBuffer = ""
txtViewBuffer = ""
iterator = 1
If CursorInROM < 0 Then
CursorInROM = 0
End If
If InputROMLoaded = False Then
DoLog "ROM еще не загружен"
Exit Sub
End If
For r = 1 To hexMaxRows
'----------------'
'TrTableType = "SBCS2"
'txtline = DumpBufferFromROM(CursorInROM, CursorInROM + r * hexMaxCols)
If TrTableType <> "DBCS" Then 'если это однобайтовая таблица
'----------------'
    txtline = ""
    hexline = ""
    For c = 1 To hexMaxCols
        If CursorInROM + iterator <= UBound(InputROMBodyPart) Then
            b = InputROMBodyPart(CursorInROM + iterator)
            hexb = Hex(b)
        If TableLoaded = True Then 'если загружена таблица
            If Len(TrTable(b)) = 1 Then
                txtline = txtline + TrTable(b)
            Else
                txtline = txtline + NotInTableChar
            End If
        Else 'если таблицы нету, то покажем, как умеем
            If b > 31 Then
                txtline = txtline + Chr(b)
            Else
                txtline = txtline + NotInTableChar
            End If
        End If
            iterator = iterator + 1
            If Len(hexb) < 2 Then
                hexb = "0" + hexb
            End If
            hexline = hexline + hexb + " "
        End If
Next
'-----------------'
Else 'если тип таблицы оказался DBCS
    txtline = ""
    hexline = ""
    For c = 1 To hexMaxCols
        If CursorInROM + iterator + 1 <= UBound(InputROMBodyPart) Then
            b = InputROMBodyPart(CursorInROM + iterator)
            b1 = InputROMBodyPart(CursorInROM + iterator + 1)
            db = b * CLng(256) + b1
            hexb = Hex(b)
            hexb1 = Hex(b1)
        If TableLoaded = True Then 'если загружена таблица
            If Len(TrTable(db)) = 1 Then
                txtline = txtline + TrTable(db)
            Else
                txtline = txtline + NotInTableChar
            End If
        Else 'если таблицы нету, то покажем, как умеем
            If db > 31 Then
                txtline = txtline + ChrW(db)
            Else
                txtline = txtline + NotInTableChar
            End If
        End If
            iterator = iterator + 2
            If Len(hexb) < 2 Then
                hexb = "0" + hexb
            End If
            If Len(hexb1) < 2 Then
                hexb1 = "0" + hexb1
            End If
            hexline = hexline + hexb + hexb1 + " "
        End If
Next

End If
If r < hexMaxRows Then
txtline = txtline + vbCrLf
hexline = hexline + vbCrLf
End If
hexViewBuffer = hexViewBuffer + hexline
txtViewBuffer = txtViewBuffer + txtline
Next
HexView.Text = hexViewBuffer
TxtView.Text = txtViewBuffer

End Sub

Sub DoScrollUp(Optional NumLines As Long)
If NumLines = 0 Then
   NumLines = 1
End If
If TrTableType <> "DBCS" Then 'если это однобайтовая таблица
   If CursorInROM >= hexMaxCols * NumLines Then
      CursorInROM = CursorInROM - hexMaxCols * NumLines
   Else
      CursorInROM = 0
   End If
Else
   If CursorInROM >= hexMaxCols * NumLines * 2 Then
      CursorInROM = CursorInROM - hexMaxCols * NumLines * 2
   Else
      CursorInROM = 0
   End If
End If
Call DoDisplay
End Sub

Sub DoScrollDown(Optional NumLines As Long)
If NumLines = 0 Then
   NumLines = 1
End If
If TrTableType <> "DBCS" Then 'если это однобайтовая таблица
   If InputROMFileSize > CursorInROM + hexMaxCols * hexMaxRows Then
      CursorInROM = CursorInROM + hexMaxCols * NumLines
   Else
      CursorInROM = InputROMFileSize - hexMaxCols * hexMaxRows
   End If
Else
   If InputROMFileSize > CursorInROM + hexMaxCols * hexMaxRows Then
      CursorInROM = CursorInROM + hexMaxCols * NumLines * 2
   Else
      CursorInROM = InputROMFileSize - hexMaxCols * hexMaxRows * 2
   End If
End If
   Call DoDisplay
End Sub

'Private Sub txtView_GotFocus()
'Frame1.SetFocus
'End Sub

'Private Sub HexView_GotFocus()
'Frame1.SetFocus
'End Sub