Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/virtltxt/virtual.frm

Visual Basic Form | 1994-01-22 | 53.5 KB | 1,703 lines

VERSION 2.00
Begin Form VirtualText
   Caption         =   "Virtual Text - (Untitled)"
   ClientHeight    =   5280
   ClientLeft      =   960
   ClientTop       =   1650
   ClientWidth     =   8370
   FontBold        =   0   'False
   FontItalic      =   0   'False
   FontName        =   "Fixedsys"
   FontSize        =   9
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   5940
   Left            =   915
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   36
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   36
   Top             =   1035
   Width           =   8460
   Begin HScrollBar HScroll1
      Height          =   240
      LargeChange     =   5
      Left            =   0
      Max             =   255
      Min             =   1
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   6060
      Value           =   1
      Width           =   9600
   End
   Begin Timer Timer1
      Interval        =   100
      Left            =   8895
      Top             =   540
   End
   Begin SSPanel Panel3D1
      Align           =   2  'Align Bottom
      BorderWidth     =   1
      FloodColor      =   &H00C0C0C0&
      FloodShowPct    =   0   'False
      Height          =   345
      Left            =   0
      Outline         =   -1  'True
      TabIndex        =   5
      Top             =   4935
      Width           =   8370
      Begin SSPanel pnlMessages2
         Alignment       =   2  'Left Justify - BOTTOM
         BevelOuter      =   1  'Inset
         BorderWidth     =   1
         Height          =   225
         Left            =   7600
         RoundedCorners  =   0   'False
         TabIndex        =   12
         Top             =   60
         Width           =   735
      End
      Begin SSPanel pnlPageValue
         Alignment       =   2  'Left Justify - BOTTOM
         BevelOuter      =   1  'Inset
         BorderWidth     =   1
         Height          =   225
         Left            =   3750
         RoundedCorners  =   0   'False
         TabIndex        =   11
         Top             =   60
         Width           =   1275
      End
      Begin SSPanel pnlPageText
         Alignment       =   2  'Left Justify - BOTTOM
         BevelOuter      =   0  'None
         BorderWidth     =   1
         Caption         =   "Page"
         Height          =   225
         Left            =   3270
         RoundedCorners  =   0   'False
         TabIndex        =   10
         Top             =   45
         Width           =   450
      End
      Begin SSPanel pnlRowValue
         Alignment       =   2  'Left Justify - BOTTOM
         BevelOuter      =   1  'Inset
         BorderWidth     =   1
         Height          =   225
         Left            =   1635
         RoundedCorners  =   0   'False
         TabIndex        =   9
         Top             =   60
         Width           =   1590
      End
      Begin SSPanel pnlRowText
         Alignment       =   2  'Left Justify - BOTTOM
         BevelOuter      =   0  'None
         BorderWidth     =   1
         Caption         =   "Row"
         Height          =   225
         Left            =   1215
         RoundedCorners  =   0   'False
         TabIndex        =   8
         Top             =   45
         Width           =   390
      End
      Begin SSPanel pnlColValue
         Alignment       =   2  'Left Justify - BOTTOM
         BevelOuter      =   1  'Inset
         BorderWidth     =   1
         Height          =   225
         Left            =   450
         RoundedCorners  =   0   'False
         TabIndex        =   7
         Top             =   60
         Width           =   585
      End
      Begin SSPanel pnlColText
         Alignment       =   2  'Left Justify - BOTTOM
         BevelOuter      =   0  'None
         BorderWidth     =   1
         Caption         =   "Col"
         Height          =   225
         Left            =   135
         RoundedCorners  =   0   'False
         TabIndex        =   6
         Top             =   45
         Width           =   285
      End
      Begin SSPanel pnlMessages
         Alignment       =   2  'Left Justify - BOTTOM
         BevelOuter      =   1  'Inset
         BorderWidth     =   1
         Height          =   225
         Left            =   5145
         RoundedCorners  =   0   'False
         TabIndex        =   4
         Top             =   60
         Width           =   2350
      End
   End
   Begin CommonDialog CMDialog1
      Left            =   8880
      Top             =   30
   End
   Begin PictureBox Picture1
      BackColor       =   &H00808080&
      BorderStyle     =   0  'None
      ClipControls    =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   270
      Left            =   9075
      ScaleHeight     =   270
      ScaleWidth      =   330
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   5430
      Width           =   330
   End
   Begin VScrollBar VScroll1
      Height          =   5370
      Left            =   9375
      Min             =   1
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Value           =   1
      Width           =   270
   End
   Begin TextBox TextArray
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Fixedsys"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   6030
      Index           =   1
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   1  'Horizontal
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   30000
   End
   Begin Menu mnuFileTop
      Caption         =   "&File"
      Begin Menu mnuOpenFile
         Caption         =   "&Open ..."
         Shortcut        =   ^O
      End
      Begin Menu mnuCloseFile
         Caption         =   "&Close"
      End
      Begin Menu mnuPrintFile
         Caption         =   "&Print"
         Shortcut        =   ^P
      End
      Begin Menu mnuPrinterSetup
         Caption         =   "Printer &Setup..."
      End
      Begin Menu zBar11
         Caption         =   "-"
      End
      Begin Menu mnuShowInformation
         Caption         =   "Show &Information"
      End
      Begin Menu zBar10
         Caption         =   "-"
      End
      Begin Menu mnuExitEditBox
         Caption         =   "E&xit"
      End
      Begin Menu zBar1
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin Menu mnuFileList
         Caption         =   "&1"
         Index           =   1
         Visible         =   0   'False
      End
      Begin Menu mnuFileList
         Caption         =   "&2"
         Index           =   2
         Visible         =   0   'False
      End
      Begin Menu mnuFileList
         Caption         =   "&3"
         Index           =   3
         Visible         =   0   'False
      End
      Begin Menu mnuFileList
         Caption         =   "&4"
         Index           =   4
         Visible         =   0   'False
      End
      Begin Menu mnuFileList
         Caption         =   "&5"
         Index           =   5
         Visible         =   0   'False
      End
   End
   Begin Menu mnuEditTop
      Caption         =   "&Edit"
      Begin Menu mnuCopy
         Caption         =   "&Copy"
         Shortcut        =   ^C
      End
      Begin Menu zBar12
         Caption         =   "-"
      End
      Begin Menu mnuSelectAll
         Caption         =   "Select &All"
      End
   End
   Begin Menu mnuView
      Caption         =   "&View"
      Begin Menu mnuTextMode
         Caption         =   "&Text Mode"
         Checked         =   -1  'True
         Shortcut        =   ^T
      End
      Begin Menu mnuHexMode
         Caption         =   "&Hex Mode"
         Shortcut        =   ^H
      End
   End
   Begin Menu mnuSearchTop
      Caption         =   "&Search"
      Begin Menu mnuFindText
         Caption         =   "&Find ..."
         Shortcut        =   ^F
      End
      Begin Menu mnuFindNext
         Caption         =   "Find &Next"
         Shortcut        =   {F3}
      End
      Begin Menu mnuFindPrevious
         Caption         =   "Find &Previous"
         Shortcut        =   +{F3}
      End
      Begin Menu zBar6
         Caption         =   "-"
      End
      Begin Menu mnuGotoLine
         Caption         =   "&Go to Line..."
         Shortcut        =   ^G
      End
   End
   Begin Menu mnuOptions
      Caption         =   "&Options"
      Begin Menu mnuShowVerticalScroll
         Caption         =   "Show &Vertical Scroll"
         Checked         =   -1  'True
      End
      Begin Menu mnuShowHorizontalScroll
         Caption         =   "Show &Horizontal Scroll"
         Checked         =   -1  'True
      End
      Begin Menu mnuShowStatusBar
         Caption         =   "Show Status &Bar"
         Checked         =   -1  'True
      End
      Begin Menu zBar7
         Caption         =   "-"
      End
      Begin Menu mnuExpandTabs
         Caption         =   "Expand &Tabs"
      End
      Begin Menu mnuVerticalDrag
         Caption         =   "Vertical &Drag"
      End
      Begin Menu zBar4
         Caption         =   "-"
      End
      Begin Menu mnuSetFont
         Caption         =   "Set &Font"
         Begin Menu mnuSetFontScreen
            Caption         =   "&Screen..."
         End
         Begin Menu mnuSetFontPrinter
            Caption         =   "&Printer..."
         End
      End
      Begin Menu mnuSetColors
         Caption         =   "Set &Colors"
         Begin Menu mnuSetBackground
            Caption         =   "Bac&kground..."
         End
         Begin Menu mnuSetForeground
            Caption         =   "F&oreground..."
         End
      End
      Begin Menu zBar9
         Caption         =   "-"
      End
      Begin Menu mnuSaveWindowPosition
         Caption         =   "Save Window &Position"
      End
      Begin Menu zBar20
         Caption         =   "-"
      End
      Begin Menu mnuSaveOptions
         Caption         =   "&Save Options"
      End
   End
   Begin Menu mnuHelpTop
      Caption         =   "&Help"
      Begin Menu mnuAboutEditBox
         Caption         =   "&About Virtual Text..."
      End
   End
'VIRTUAL.FRM: VBC Version
DefInt A-Z
Sub CloseCurrent ()
DisableMenuItems
' Unload all but first array
If NumArrays > 1 Then
    For X = 2 To NumArrays Step 1
    Unload TextArray(X)
    Next
End If
TextArray(1).Enabled = True
' Put array 1 back to proper position, may be horizontally scrolled
Dim Posn As RECT
rtn& = SendMessageAsAny(TextArray(1).hWnd, EM_GETRECT, 0, Posn)
Posn.Left = 0
rtn& = SendMessageAsAny(TextArray(1).hWnd, EM_SETRECT, 0, Posn)
TextArray(1).Text = " "
TextArray(1).Enabled = False
Me.Caption = "Virtual Text - (Untitled)"
InitializeVariables
UpdateStatusBar
End Sub
Sub DisableMenuItems ()
' Disable if no open document
mnuFindText.Enabled = False
mnuFindNext.Enabled = False
mnuFindPrevious.Enabled = False
mnuGoToLine.Enabled = False
mnuCloseFile.Enabled = False
mnuShowInformation.Enabled = False
mnuPrintFile.Enabled = False
mnuCopy.Enabled = False
mnuSelectAll.Enabled = False
End Sub
Sub DragandDrop ()
Totfiles = 0
PM_NOREMOVE = 0
PM_NOYIELD = 2
wRemoveMsg = PM_NOREMOVE Or PM_NOYIELD   'parameters for PeekMessage call
Me.Show
Handle = Me.hWnd
Filenum = -1
DragAcceptFiles Handle, True    'identify form as able to accept d/d messages
'Do While DoEvents()
Gotone% = False
Do While Gotone% = False And Me.WindowState = 1
    DoEvents
    X = PeekMessage(NewMessage, Handle, 563, 563, wRemoveMsg) 'determine if a d/d message is waiting
    If X <> 0 Then  'if a dd message is waiting
    'calling DragQueryFile with a -1 value for FileNum returns # of files dropped
    NameOfFile = Space$(129)
    X = DragQueryFile(NewMessage.wparam, Filenum, NameOfFile, 128)
    For Counter = 0 To 0 '  X - 1   ' for each file dropped
        'calling with a value greater than -1 returns name of corresponding file
    Y = DragQueryFile(NewMessage.wparam, Counter, NameOfFile, 128)
        'add NameOfFile to List
    Next Counter    'get next file
    Totfiles = Totfiles + X
    Gotone% = True
    'always call dragfinish to release d/d memory buffer
    DragFinish NewMessage.wparam
    End If
If Gotone% = True Then
    MenuSelect = True
    Me.WindowState = 0  'Normal
    Z = InStr(Trim$(NameOfFile), Chr$(0))  'Strip trailing junk
    If Z > 0 Then
    FullFilePath = Mid$(NameOfFile, 1, Z - 1)
    Else
    FullFilePath = LCase$(NameOfFile)
    End If
    OpenFile
End If
End Sub
Sub EnableMenuItems ()
mnuFindText.Enabled = True
mnuFindNext.Enabled = True
mnuFindPrevious.Enabled = True
mnuGoToLine.Enabled = True
mnuCloseFile.Enabled = True
mnuShowInformation.Enabled = True
mnuPrintFile.Enabled = True
' No copy allowed for now!
'Copy.Enabled = True
'SelectAll.Enabled = True
End Sub
Function Exists% (f$)
' A simplistic file existence check
On Error Resume Next
X& = FileLen(f$)
If X& Then Exists% = True
End Function
Sub ExpandTabs ()
' Setting TABS about every 4 characters
ReDim tabvals%(7)
tabvals%(0) = 16
tabvals%(1) = 32
tabvals%(2) = 48
tabvals%(3) = 64
tabvals%(4) = 80
tabvals%(5) = 96
tabvals%(6) = 112
tabvals%(7) = 128
For X = 1 To NumArrays
    TextArray(X).Enabled = True
    TextArray(X).SetFocus
    Success& = SendMessageAsAny(TextArray(X).hWnd, EM_SETTABSTOPS, 8, tabvals%(0))
    TextArray(X).Enabled = False
    TextArray(X).Refresh
End Sub
Sub FindLongestLine ()
' Not used for Hex - that line is always a fixed length.
' This routine really slows up the load of the document - but to get
' an accurate Horizontal scroll bar it is needed.
' Assumes only one byte for a TAB
' Look for line feed
LF$ = Chr$(10)
Dim X!
Dim Y!
Dim Z!
Z = 1
For X = 1 To MaxBytestoRead
    Y = InStr(X, FL(1).FixedLengthTemp, LF$)
    If Y = 0 Then Exit For  'outta here
    If Y - Z > LongestLine Then
    LongestLine = Y - Z
    End If
    Z = Y
    X = Y + 2  'Start after the carriage return - line feed
End Sub
Sub FindTextString ()
If FindStr = "" Then Exit Sub
If FromTopFlag = True Then
    FromTopFlag = False
    StartArray = 1
    StartLine = 1
    ' Where is the search starting?
    StartArray = Active        ' Array were starting in
    If StartArray = 1 Then
    StartLine = VScroll1.Value + 1
    Else
    StartLine = VScroll1.Value - FixedLines(StartArray - 1) + 1
    End If
End If
SearchLine% = VScroll1.Value
Dim linetoshow%, linelength%
Dim linebuf$
Dim lc%
Dim linechar%
pnlMessages.Caption = "Searching line number"
For X = StartArray To NumArrays
    TextArray(X).Enabled = True
    If X > StartArray Then StartLine = 1      ' When we go to new array start at 1
    BoxLines% = SendMessage(TextArray(X).hWnd, EM_GETLINECOUNT, 0, 0)
    For Y = StartLine To BoxLines% 'Lines in array
    SearchLine% = SearchLine% + 1
    If Right$(Str$(SearchLine%), 1) = "0" Then
    pnlMessages2.Caption = Str$(SearchLine%)
    End If
    linetoshow% = Y
    ' Find out the character offset to the first character
    ' in the specified line
    lchar& = SendMessageBynum(TextArray(X).hWnd, EM_LINEINDEX, linetoshow%, 0&)
    ' Convert from long integer to usage VB integer (signed)
    If lchar& > 32767 Then
    SignedEquivalent% = CInt(lchar& - &H10000)
    Else
    SignedEquivalent% = lchar&
    End If
    ' The character offset is used to determine the length of the line
    ' containing that character.
    lc% = SendMessageBynum(TextArray(X).hWnd, EM_LINELENGTH, SignedEquivalent%, 0&) + 1
    ' Now allocate a string long enough to hold the result
    linebuf$ = String$(lc% + 2, 0)
    Mid$(linebuf$, 1, 1) = Chr$(lc% And &HFF)
    Mid$(linebuf$, 2, 1) = Chr$(lc% / &H100)
    ' Now get the line
    lc% = SendMessageByString(TextArray(X).hWnd, EM_GETLINE, linetoshow%, linebuf$)
    ' linebuf$ Contains the string to look at
    ' FindStr is the string we are looking for
    linebuf1$ = RTrim$(linebuf$)
    If CaseSensitiveFlag = True Then
    i = InStr(1, linebuf1$, FindStr, 0)
    Else
    i = InStr(1, linebuf1$, FindStr, 1)
    End If
    If i > 0 Then  ' Okay we got one
    If X = 1 Then   'This will scroll to proper array and line
    VScroll1.Value = Y
    Else
    VScroll1.Value = FixedLines(X - 1) + Y
    End If
    pnlMessages2.Caption = ""
    Exit Sub
    End If
    Next
    TextArray(X).Enabled = False
' If we got here - no match.
pnlMessages2.Caption = ""
UpdateStatusBar
Msg$ = "Text string " & FindStr & " not found."
Response = MBoxWarning(Msg$)    ' Get user response.
End Sub
Sub FindTextStringPrev ()
If FindStr = "" Then Exit Sub
' Where is the search starting?
' No "From Top" here.
StartArray = Active        ' Array were starting in
If StartArray = 1 Then
    StartLine = VScroll1.Value - 1
    StartLine = VScroll1.Value - FixedLines(StartArray - 1) - 1
End If
Dim linetoshow%, linelength%
Dim linebuf$
Dim lc%
Dim linechar%
SearchLine% = VScroll1.Value
pnlMessages.Caption = "Searching line number"
For X = StartArray To 1 Step -1
    TextArray(X).Enabled = True
    If X < StartArray Then
    BoxLines% = SendMessage(TextArray(X).hWnd, EM_GETLINECOUNT, 0, 0)
    StartLine = BoxLines%
    End If
    For Y = StartLine To 1 Step -1 'Go backwards
    SearchLine% = SearchLine% - 1
    If Right$(Str$(SearchLine%), 1) = "0" Then
    pnlMessages2.Caption = Str$(SearchLine%)
    End If
    linetoshow% = Y
    ' Find out the character offset to the first character
    ' in the specified line
    lchar& = SendMessageBynum(TextArray(X).hWnd, EM_LINEINDEX, linetoshow%, 0&)
    ' Convert from long integer to usage VB integer (signed)
    If lchar& > 32767 Then
    SignedEquivalent% = CInt(lchar& - &H10000)
    Else
    SignedEquivalent% = lchar&
    End If
    ' The character offset is used to determine the length of the line
    ' containing that character.
    lc% = SendMessageBynum(TextArray(X).hWnd, EM_LINELENGTH, SignedEquivalent%, 0&) + 1
    ' Now allocate a string long enough to hold the result
    linebuf$ = String$(lc% + 2, 0)
    Mid$(linebuf$, 1, 1) = Chr$(lc% And &HFF)
    Mid$(linebuf$, 2, 1) = Chr$(lc% / &H100)
    ' Now get the line
    lc% = SendMessageByString(TextArray(X).hWnd, EM_GETLINE, linetoshow%, linebuf$)
    ' linebuf$ Contains the string to look at
    ' FindStr is the string we are looking for
    linebuf1$ = RTrim$(linebuf$)
    If CaseSensitiveFlag = True Then
    i = InStr(1, linebuf1$, FindStr, 0)
    Else
    i = InStr(1, linebuf1$, FindStr, 1)
    End If
    If i > 0 Then  ' Okay we got one
    ' Where are we?  Y is position within text array
    If X = 1 Then   'This will scroll to proper array and line
    VScroll1.Value = Y
    Else
    VScroll1.Value = FixedLines(X - 1) + Y
    End If
    pnlMessages2.Caption = ""
    Exit Sub
    End If
    Next
    TextArray(X).Enabled = False
' If we got here - no match
pnlMessages2.Caption = ""
UpdateStatusBar
Msg$ = "Text string " & FindStr & " not found."
Response = MBoxWarning(Msg$)    ' Get user response.
End Sub
Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
' Set KeyAscii to 0 in the form's KeyPress event,
' and set KeyCode to 0 in the form's KeyDown event.
Select Case KeyCode
    Case KEY_DOWN
    If VScroll1.Value <> VScroll1.Max Then
    If VScroll1.Value + 1 < VScroll1.Max Then
    VScroll1.Value = VScroll1.Value + 1
    Else
    VScroll1.Value = VScroll1.Max
    End If
    End If
    Case KEY_UP
    If VScroll1.Value <> 1 Then
    VScroll1.Value = VScroll1.Value - 1
    End If
    Case KEY_LEFT
    If HScroll1.Value - 5 >= HScroll1.Min Then
    HScroll1.Value = HScroll1.Value - 5
    Else
    HScroll1.Value = HScroll1.Min
    End If
    Case KEY_RIGHT
    If HScroll1.Value + 5 <= HScroll1.Max Then
    HScroll1.Value = HScroll1.Value + 5
    Else
    HScroll1.Value = HScroll1.Max
    End If
    Case KEY_PRIOR  ' Page Up
    If VScroll1.Value > MaxRowsInEditBox Then
    VScroll1.Value = VScroll1.Value + (MaxRowsInEditBox * -1)
    Else
    VScroll1.Value = 1
    End If
    Case KEY_NEXT   ' Page Down
    If VScroll1.Value <> VScroll1.Max Then
    If VScroll1.Value + MaxRowsInEditBox < VScroll1.Max Then
    VScroll1.Value = VScroll1.Value + MaxRowsInEditBox
    Else
    VScroll1.Value = VScroll1.Max
    End If
    End If
    Case KEY_END   ' Bottom
    VScroll1.Value = VScroll1.Max
    Case KEY_HOME  ' Top
    VScroll1.Value = 1
    Case KEY_F3 Or CTRL_MASK  ' Find
    FindTextString
End Select
KeyCode = 0
End Sub
Sub Form_KeyPress (KeyAscii As Integer)
KeyAscii = 0
End Sub
Sub Form_Load ()
InitialLoad = True
MenuSelect = False
KeyPreview = True
Virtual = False
TooBig = False
ScrollEvent = False
InitializeVariables
TextArray(Active).Text = ""
ReDim FL(1 To 1)
' Get current saved settings
ReadINIFile
InitialLoad = False
Me.Show
DisableMenuItems
'Don't show the actual text box scrollbar - we use our own
Call ShowScrollBar(TextArray(NumArrays).hWnd, SB_HORZ, 0)
VScroll1.Value = 1
VScroll1.ZOrder 0
ProcessCommandLine
MaxRowsInEditBox% = GetVisibleLines()
End Sub
Sub Form_Resize ()
' Rearrange controls to fit screen
If InitialLoad = True Then Exit Sub
If Me.ScaleWidth < 200 Or Me.ScaleHeight < 200 Then
    Exit Sub
End If
For X = 1 To NumArrays
    If mnuShowVerticalScroll.Checked = True Then
    TextArray(X).Width = ScaleWidth - VScroll1.Width
    Else
    TextArray(X).Width = ScaleWidth
    End If
    If mnuShowHorizontalScroll.Checked = True Then
    If mnuShowStatusBar.Checked = True Then
    TextArray(X).Height = ScaleHeight - HScroll1.Height - Panel3D1.Height
    Else
    TextArray(X).Height = ScaleHeight - HScroll1.Height
    End If
    Else
    If mnuShowStatusBar.Checked = True Then
    TextArray(X).Height = ScaleHeight - Panel3D1.Height
    Else
    TextArray(X).Height = ScaleHeight
    End If
    End If
'Vertical Scroll bar
VScroll1.Left = ScaleWidth - VScroll1.Width
If mnuShowHorizontalScroll.Checked = True Then
    If mnuShowStatusBar.Checked = True Then
    VScroll1.Height = ScaleHeight - (HScroll1.Height + Panel3D1.Height)
    Else
    VScroll1.Height = ScaleHeight - HScroll1.Height
    End If
    If mnuShowStatusBar.Checked = True Then
    VScroll1.Height = ScaleHeight - Panel3D1.Height
    Else
    VScroll1.Height = ScaleHeight
    End If
End If
'Horizontal Scroll bar
If mnuShowVerticalScroll.Checked = True Then
    HScroll1.Width = ScaleWidth - VScroll1.Width
    HScroll1.Width = ScaleWidth
End If
If mnuShowStatusBar.Checked = True Then
    HScroll1.Top = ScaleHeight - (HScroll1.Height + Panel3D1.Height)
    HScroll1.Top = ScaleHeight - HScroll1.Height
End If
'Picture Box
If mnuShowVerticalScroll.Checked = False Or mnuShowHorizontalScroll.Checked = False Then
    Picture1.Top = Me.Top
    Picture1.Left = VScroll1.Left - 2
    Picture1.Top = VScroll1.Height - 2
'   Picture1.ZOrder 1
End If
MaxRowsInEditBox = GetVisibleLines()
VScroll1.LargeChange = MaxRowsInEditBox
UpdateStatusBar
End Sub
Function GetVisibleLines% ()
' Determines the number of lines actually visible in the
' text control.
Dim RC As RECT
Dim hdc%
Dim lfont%, oldfont%
Dim tm As TEXTMETRIC
Dim di%
' Get the formatting rectangle - this describes the
' rectangle in the control in which text is placed.
lc% = SendMessageAsAny(TextArray(1).hWnd, EM_GETRECT, 0, RC)
' Get a handle to the logical font used by the control.
' The VB font properties are accurately reflected by
' this logical font.
lfont% = SendMessageBynum(TextArray(1).hWnd, WM_GETFONT, 0, 0&)
' Get a device context to the text control.
hdc% = GetDC(TextArray(1).hWnd)
' Select in the logical font to obtain the exact font metrics.
If lfont% <> 0 Then oldfont% = SelectObject(hdc%, lfont%)
di% = GetTextMetrics(hdc%, tm)
' Select out the logical font
If lfont% <> 0 Then lfont% = SelectObject(hdc%, oldfont%)
' The lines depends on the formatting rectangle and font height
AveCharWidth% = tm.tmAveCharWidth
HeightOfRow% = tm.tmHeight
MaxRowsInEditBox = (RC.bottom - RC.Top) / tm.tmHeight
GetVisibleLines% = MaxRowsInEditBox
' Release the device context when done.
di% = ReleaseDC(TextArray(1).hWnd, hdc%)
End Function
Sub HScroll1_Change ()
If TotalLines = 0 Then
    HScroll1.Value = Holdh
    ScrollEvent = False
    Exit Sub
End If
If Holdh = HScroll1.Value Then Exit Sub
Dim rtn&
Dim Posn As RECT
' How much to scroll dependent on the Average Character Width
' For a Large change do 5 * Average Character Width
' For a Small Change do 1 * Average Character Width
HType% = Abs(Holdh - HScroll1.Value)
If Holdh < HScroll1.Value Then
    direction% = -1 * (AveCharWidth * HType%)
    For X = 1 To NumArrays
    rtn& = SendMessageAsAny(TextArray(X).hWnd, EM_GETRECT, 0, Posn)
    Posn.Left = Posn.Left + direction%
    rtn& = SendMessageAsAny(TextArray(X).hWnd, EM_SETRECT, 0, Posn)
    Next
    direction% = (AveCharWidth * HType%)
    For X = 1 To NumArrays
    rtn& = SendMessageAsAny(TextArray(X).hWnd, EM_GETRECT, 0, Posn)
    Posn.Left = Posn.Left + direction%
    rtn& = SendMessageAsAny(TextArray(X).hWnd, EM_SETRECT, 0, Posn)
    Next
End If
Holdh = HScroll1.Value
UpdateStatusBar
End Sub
Sub HScroll1_Scroll ()
ScrollEvent = True
End Sub
Sub InitializeVariables ()
NumArrays = 1
Virtual = False
Active = 1
Holdv = 1
Holdh = 1
HScroll1.Value = 1
VScroll1.Min = 1
VScroll1.Max = 1
VScroll1.Value = 1
TotalLines = 0
SwitchMode = False
End Sub
Sub LoadHexArrays ()
' Read into temp area
BytesRead& = 0
Dim OneByte As String * 1
NumArrays = 0
ReDim FH(1 To 1)
'*************
ReadLoopHex:
'*************
If TooBig = True Then GoTo ExitReadLoopHex
ManyBytes$ = ""
Get #Filenum, , FH(1).FixedLengthTempHex
' Did we get an entire record?
If EOF(Filenum) Then
    MoveToHexBox    'move to text and exit
    GoTo ExitReadLoopHex
End If
BytesRead& = BytesRead& + MaxBytesToReadHex
MoveToHexBox
GoTo ReadLoopHex
ExitReadLoopHex:
HScroll1.Max = 75
LongestLine = 75
End Sub
Sub LoadTextArrays ()
' Read into temp area
' Read MaxBytesToRead then look for CRLF (do not look for CRLF on last)
Dim OneByte As String * 1
ManyBytes$ = ""
NumArrays = 0
ReDim FL(1 To 1)
EOFFlag = False
LongestLine = 1
'*************
ReadLoop:
'*************
If TooBig = True Then GoTo ExitReadLoop
ManyBytes$ = ""
Get #Filenum, , FL(1).FixedLengthTemp
FindLongestLine
' Did we get an entire record?
If EOF(Filenum) Then
    EOFFlag = True
    MoveToTextBox    'move to text and exit
    GoTo ExitReadLoop
End If
TwoBytes$ = Right$(FL(1).FixedLengthTemp, 2)
' See if we have only a CR or only a LF on the end
If Right$(TwoBytes$, 1) = Chr$(10) Then ' Remove last 2
    Mid$(FL(1).FixedLengthTemp, (MaxBytestoRead - 1), 2) = "  "
    MoveToTextBox
    GoTo ReadLoop
    If Right$(TwoBytes$, 1) = Chr$(13) Then ' Remove last 1, skip 1
    Mid$(FL(1).FixedLengthTemp, MaxBytestoRead, 1) = " "
    Seek #Filenum, Seek(Filenum) + 1 'skip LF
    MoveToTextBox
    GoTo ReadLoop
    End If
End If
'When we go from one array to the next we do not want split lines!
For Y = 0 To 254  'Lets get a complete line
    Get #Filenum, , OneByte$
    If EOF(Filenum) Then
    MoveToTextBox    'move to text and exit
    GoTo ExitReadLoop
    End If
    If OneByte$ = Chr$(13) Then
    Seek #Filenum, Seek(Filenum) + 1
    MoveToTextBox    'move to text and exit
    GoTo ReadLoop
    Exit For
    Else
    ManyBytes$ = ManyBytes$ + OneByte$
    End If
MoveToTextBox
GoTo ReadLoop
ExitReadLoop:
HScroll1.Max = LongestLine - 2
End Sub
Function MBoxStop (Msg$)
MTitle$ = "Virtual Text"
DgDef = MB_YESNO + MB_ICONSTOP + MB_DEFBUTTON2 ' Describe dialog.
MBoxStop = MsgBox(Msg$, DgDef, MTitle$)    ' Get user response.
End Function
Function MBoxWarning (Msg$)
MTitle$ = "Virtual Text"
DgDef = MB_OK + MB_ICONEXCLAMATION  ' Describe dialog.
MBoxWarning = MsgBox(Msg$, DgDef, MTitle$)    ' Get user response.
End Function
Sub mnuAboutEditBox_Click ()
   About.Show MODAL
End Sub
Sub mnuCloseFile_Click ()
CloseCurrent
FullFilePath = ""
End Sub
Sub mnuCopy_Click ()
' Not in use !
End Sub
Sub mnuExitEditBox_Click ()
  Unload Me
End Sub
Sub mnuExpandTabs_Click ()
If mnuExpandTabs.Checked = True Then
    mnuExpandTabs.Checked = False
    ReDim tabvals%(7)  ' Using 0 does not seem to work for the array values
    tabvals%(0) = 1
    tabvals%(1) = 2
    tabvals%(2) = 3
    tabvals%(3) = 4
    tabvals%(4) = 5
    tabvals%(5) = 6
    tabvals%(6) = 7
    tabvals%(7) = 8
    For X = 1 To NumArrays
    TextArray(X).Enabled = True
    TextArray(X).SetFocus
    Success& = SendMessageAsAny(TextArray(X).hWnd, EM_SETTABSTOPS, 8, tabvals%(0))
    TextArray(X).Enabled = False
    TextArray(X).Refresh
    Next
    mnuExpandTabs.Checked = True
    ' Perform routine
    ExpandTabs
End If
End Sub
Sub mnuFileList_Click (Index As Integer)
FullFilePath = Mid$(mnuFileList(Index).Caption, 4)
MenuSelect = True
OpenFile
End Sub
Sub mnuFindNext_Click ()
FindTextString
End Sub
Sub mnuFindPrevious_Click ()
FindTextStringPrev
End Sub
Sub mnuFindText_Click ()
Search.lblTo.Caption = "Enter text to search for:"
Search.Show 1
' What if Canceled?
If FindStr = "" Then Exit Sub
FindTextString
End Sub
Sub mnuGotoLine_Click ()
Search.lblTo.Caption = "Enter Line number to go to:"
Search.FromTop.Visible = False
Search.CaseSensitive.Visible = False
Search.Check3D1.Visible = False
Search.Check3D2.Visible = False
Search.Show 1
GoToLineNumber = Val(FindStr)
If GoToLineNumber > 0 And GoToLineNumber <= TotalLines Then
    VScroll1.Value = GoToLineNumber
End If
FindStr = ""
End Sub
Sub mnuHexMode_Click ()
If mnuHexMode.Checked = True Then Exit Sub
mnuHexMode.Checked = True
mnuTextMode.Checked = False
If TotalLines = 0 Then Exit Sub
SwitchMode = True
MenuSelect = True
OpenFile
End Sub
Sub mnuOpenFile_Click ()
OpenFile
End Sub
Sub mnuPrinterSetup_Click ()
On Error GoTo ErrorHandlerPS
CMDialog1.Flags = &H40&
CMDialog1.CancelError = True
CMDialog1.Action = 5
Exit Sub
ErrorHandlerPS:
Resume ErrorResumePS
ErrorResumePS:
End Sub
Sub mnuPrintFile_Click ()
On Error GoTo ErrorHandler1
'CMDialog1.Flags = CF_PRINTERFONTS
'CMDialog1.CancelError = True
'CMDialog1.Action = 4
PrintFile1
Exit Sub
ErrorHandler1:
Resume ErrorResume
ErrorResume:
End Sub
Sub mnuSaveOptions_Click ()
SaveOptions
End Sub
Sub mnuSaveWindowPosition_Click ()
SaveFormPosition
End Sub
Sub mnuSetBackground_Click ()
On Error GoTo SetBackgroundError:
    CMDialog1.Color = BackColor
    CMDialog1.CancelError = True
    CMDialog1.Flags = CC_PREVENTFULLOPEN  'Or CC_SHOWHELP CC_RGBINIT
    CMDialog1.Action = 3
    BackColor = CMDialog1.Color
    For X = 1 To NumArrays
    TextArray(X).BackColor = BackColor
    Next
SetBackgroundError:
    Resume SetBackgroundError_Cont
SetBackgroundError_Cont:
End Sub
Sub mnuSetFontPrinter_Click ()
On Error GoTo Printer_Font_Error
    CMDialog1.Flags = CF_PRINTERFONTS 'CF_BOTH ' Or CF_ANSIONLY
    CMDialog1.CancelError = True
    CMDialog1.FontName = optPrinterFont
    CMDialog1.FontSize = optPrinterFontSize
    CMDialog1.FontBold = optPrinterFontBold
    CMDialog1.FontItalic = optPrinterFontItalic
    CMDialog1.Action = 4
    optPrinterFont = CMDialog1.FontName
    optPrinterFontSize = CMDialog1.FontSize
    optPrinterFontBold = CMDialog1.FontBold
    optPrinterFontItalic = CMDialog1.FontItalic
Printer_Font_Error:
    Resume Printer_Font_Error_Cont
Printer_Font_Error_Cont:
End Sub
Sub mnuSetFontScreen_Click ()
On Error GoTo Screen_Font_Error
    CMDialog1.Flags = CF_SCREENFONTS 'CF_BOTH ' Or CF_ANSIONLY
    CMDialog1.CancelError = True
    CMDialog1.FontName = TextArray(Active).FontName
    CMDialog1.FontSize = TextArray(Active).FontSize
    CMDialog1.FontBold = TextArray(Active).FontBold
    CMDialog1.FontItalic = TextArray(Active).FontItalic
    CMDialog1.Action = 4
    For X = 1 To NumArrays
    TextArray(X).FontName = CMDialog1.FontName
    TextArray(X).FontSize = CMDialog1.FontSize
    TextArray(X).FontBold = CMDialog1.FontBold
    TextArray(X).FontItalic = CMDialog1.FontItalic
    Next
    ' Get the new value for the maximum rows showing in edit box
    MaxRowsInEditBox% = GetVisibleLines()
    VerticalDrag
Screen_Font_Error:
    Resume Screen_Font_Error_Cont
Screen_Font_Error_Cont:
End Sub
Sub mnuSetForeground_Click ()
On Error GoTo SetForegroundError:
    CMDialog1.Color = ForeColor
    CMDialog1.CancelError = True
    CMDialog1.Flags = CC_PREVENTFULLOPEN  'Or CC_SHOWHELP CC_RGBINIT
    CMDialog1.Action = 3
    ForeColor = CMDialog1.Color
    For X = 1 To NumArrays
    TextArray(X).ForeColor = ForeColor
    Next
SetForegroundError:
    Resume SetForegroundError_Cont
SetForegroundError_Cont:
End Sub
Sub mnuShowHorizontalScroll_Click ()
If mnuShowHorizontalScroll.Checked = True Then
    mnuShowHorizontalScroll.Checked = False
    HScroll1.Visible = False
    mnuShowHorizontalScroll.Checked = True
    HScroll1.Visible = True
End If
Form_Resize
End Sub
Sub mnuShowInformation_Click ()
NL$ = Chr$(13) + Chr$(10)
Dim Msg1 As String, TimeStamp As String  ' Declare variables.
FName$ = FullFilePath  ' Get selected file name.
TimeStamp = FileDateTime(FName$) ' Get file date/time info.
Msg1 = "File: " & LCase(FName$) & NL$
Msg1 = Msg1 & "Date: " & Format(TimeStamp, "dddddd") & NL$
Msg1 = Msg1 & "Time: " & Format(TimeStamp, "h:mm AM/PM") & NL$
Msg1 = Msg1 & "Size: " & Format(FileLen(FName$), "###,###,###") & " bytes."
X = MsgBox(Msg1, 64, "Virtual Text")  ' Display message.
End Sub
Sub mnuShowStatusBar_Click ()
If mnuShowStatusBar.Checked = True Then
    mnuShowStatusBar.Checked = False
    Panel3D1.Visible = False
    mnuShowStatusBar.Checked = True
    Panel3D1.Visible = True
End If
Form_Resize
End Sub
Sub mnuShowVerticalScroll_Click ()
If mnuShowVerticalScroll.Checked = True Then
    mnuShowVerticalScroll.Checked = False
    VScroll1.Visible = False
    mnuShowVerticalScroll.Checked = True
    VScroll1.Visible = True
End If
Form_Resize
End Sub
Sub mnuTextMode_Click ()
If mnuTextMode.Checked = True Then Exit Sub
mnuTextMode.Checked = True
mnuHexMode.Checked = False
If TotalLines = 0 Then Exit Sub
SwitchMode = True
MenuSelect = True
OpenFile
'Form_Resize
End Sub
Sub mnuVerticalDrag_Click ()
If mnuVerticalDrag.Checked = True Then
    mnuVerticalDrag.Checked = False
    mnuVerticalDrag.Checked = True
End If
End Sub
Sub MoveToHexBox ()
CRLF$ = Chr$(13) + Chr$(10)
NumArrays = NumArrays + 1
If NumArrays = 1 Then
    Hexline = 0
    VScroll1.LargeChange = GetVisibleLines()
End If
' Load Hex box
If NumArrays > 1 Then
    Load TextArray(NumArrays)
    TextArray(NumArrays).Visible = True
End If
' Let text box hold more lines
TextArray(NumArrays) = " "
Me.SetFocus
TextLimit% = &HFAAA
RetVal& = SendMessage(TextArray(NumArrays).hWnd, EM_LIMITTEXT, TextLimit%, 0)
If LOF(Filenum) > (NumArrays * MaxBytesToReadHex) Then  '? full read
    TotalHexLines& = (MaxBytesToReadHex / 16)  'This will be even
    If NumArrays = 1 Then
    TotalHexLines& = (LOF(Filenum) / 16) + 1
    Else
    TotalHexLines& = ((LOF(Filenum) - ((NumArrays - 1) * MaxBytesToReadHex)) / 16) + 1
    End If
End If
Dim RCode As Integer
Dim Pos  As Single
Dim Handle As Integer
Dim Selector As Integer
Dim OffSet As Long
Dim R As Long
Dim X As Single
' Global allocate enough memory for TotalHexLines
Handle = GlobalAlloc(GMEM_FIXED, TotalHexLines& * ELEMENT_SIZE)
' Display error message if alloction failed.
If Handle = 0 Then
    Screen.MousePointer = 0
    MsgBox "Could not allocate memory"
    Exit Sub
End If
' Get the selector.
Selector = GlobalHandleToSel(Handle)
Pos! = 1
For X! = 1 To TotalHexLines&  '  TotalHexLines
    'Get 16 bytes
    W1$ = Hex$((Hexline + X! - 1) * 16)
    W2! = Len(W1$)
    HexAddress$ = " " + String$((6 - W2!), "0") + W1$ + " "
    String16$ = Mid$(FH(1).FixedLengthTempHex, Pos!, 16)
    StringT$ = " "
    For Y! = 1 To 16
    StringX$ = Hex$(Asc(Mid$(String16$, Y!, 1)))
    If Len(StringX$) = 1 Then StringX$ = "0" & StringX$
        If Y! = 8 Then
        StringT$ = StringT$ + StringX$ + "-"
        Else
        StringT$ = StringT$ + StringX$ + " "
        End If
    Select Case Mid$(String16$, Y!, 1)
    Case Is > Chr$(127), Is < Chr$(32)  ' Show "." instead of funny chars
        Mid$(String16$, Y!, 1) = Chr$(46)
    End Select
    Next
    String48 = StringT$
    If X! < TotalHexLines& Then
    Hex77 = HexAddress$ & String48 & "   " & String16$ & CRLF$
    Else
    Hex77 = HexAddress$ & String48 & "   " & String16$ & "  "
    End If
    OffSet = (X - 1) * ELEMENT_SIZE
    ' Use global memory, faster ?!
    R = MemoryWrite(Selector, OffSet, ByVal Hex77, ELEMENT_SIZE)
    Pos! = Pos! + 16
Hexline = Hexline + TotalHexLines&
BigHexBuffer = Space$(30800)
OffSet = 0
R = MemoryRead(Selector, OffSet, ByVal BigHexBuffer, TotalHexLines& * ELEMENT_SIZE)
X = GlobalFree(Handle)
If Hexline = 400 Then
    TextArray(NumArrays).Text = BigHexBuffer
    TextArray(NumArrays).Text = Left$(BigHexBuffer, TotalHexLines& * ELEMENT_SIZE)
End If
PctRead$ = Format$(BytesRead / FileLength, "0%")
pnlMessages.Caption = "Loading File " + PctRead$
pnlMessages.Refresh
ReDim Preserve FixedLines(NumArrays)
BoxLines% = SendMessage(TextArray(NumArrays).hWnd, EM_GETLINECOUNT, 0, 0)
FixedLines(NumArrays) = BoxLines% + TotalLines
TotalLines = FixedLines(NumArrays)
If FixedLines(NumArrays) > MaxLinesAllowed Then
    Msg$ = "Only " & Str$(MaxLinesAllowed) & " lines allowed, take a partial view?"
    Response = MBoxStop(Msg$)    ' Get user response.
    If Response = IDYES Then    ' Evaluate response
    If NumArrays > 1 Then
    Unload TextArray(NumArrays)
    NumArrays = NumArrays - 1
    End If
    ReDim Preserve FixedLines(NumArrays)
    TotalLines = FixedLines(NumArrays)
    TooBig = True
    Else    ' action.
    TooBig = True
    CloseCurrent
    Exit Sub
    End If
End If
'Disable after loading
Call ShowScrollBar(TextArray(NumArrays).hWnd, SB_HORZ, 0)
TextArray(NumArrays).Enabled = False
End Sub
Sub MoveToTextBox ()
NumArrays = NumArrays + 1
If NumArrays = 1 Then
  VScroll1.LargeChange = MaxRowsInEditBox
  TextArray(NumArrays).Enabled = True
' Load text array
    Load TextArray(NumArrays)
    TextArray(NumArrays).Visible = True  ' Will be enabled
End If
' Let text box hold more lines
TextArray(NumArrays) = " "
Me.SetFocus
TextLimit% = &HFAAA
RetVal& = SendMessage(TextArray(NumArrays).hWnd, EM_LIMITTEXT, TextLimit%, 0)
'RetVal& = SendMessage(TextArray(NumArrays).hWnd, EM_SETREADONLY, 1, 0)
TextArray(NumArrays).Text = FL(1).FixedLengthTemp + ManyBytes$
PctRead$ = Format$(Seek(Filenum) / FileLength, "0%")
pnlMessages.Caption = "Loading File " + PctRead$
pnlMessages.Refresh
ReDim Preserve FixedLines(NumArrays)
BoxLines% = SendMessage(TextArray(NumArrays).hWnd, EM_GETLINECOUNT, 0, 0)
FixedLines(NumArrays) = BoxLines% + TotalLines
If FixedLines(NumArrays) > MaxLinesAllowed Then
    Msg$ = "Only " & Str$(MaxLinesAllowed) & " lines allowed, take a partial view?"
    Response = MBoxStop(Msg$)    ' Get user response.
    If Response = IDYES Then    ' Evaluate response
    If NumArrays > 1 Then
    Unload TextArray(NumArrays)
    NumArrays = NumArrays - 1
    End If
    ReDim Preserve FixedLines(NumArrays)
    TooBig = True
    Else    ' action.
    TooBig = True
    CloseCurrent
    Exit Sub
    End If
End If
TotalLines = FixedLines(NumArrays)
'Disable after loading
Call ShowScrollBar(TextArray(NumArrays).hWnd, SB_HORZ, 0)
TextArray(NumArrays).Enabled = False
End Sub
Sub OpenFile ()
'If FullFilePath = "" Then Exit Sub
If SwitchMode = True Then GoTo ByPassOpen
MaxRowsInEditBox% = GetVisibleLines()
UserCancel = False
If MenuSelect = False And CommandLine = False Then  ' Already have file?
    OpenFileDialogue
    If UserCancel = True Then Exit Sub
    MenuSelect = False
    If Not Exists%(FullFilePath) Then
    Msg$ = FullFilePath & " - File does not exist."
    Response = MBoxWarning(Msg$)    ' Get user response.
    Exit Sub
    End If
End If
ByPassOpen:
On Error GoTo OpenFileError
SwitchMode = False
MenuSelect = False
CommandLine = False
TooBig = False
MousePointer = 11
Filenum = FreeFile
CloseCurrent
Me.Caption = "Virtual Text - " + FullFilePath
Open FullFilePath For Binary As #Filenum
FileLength& = LOF(Filenum)
VarString$ = String$(100, " ")
Get #Filenum, , VarString$
If mnuTextMode.Checked = True And ((Not TextFileCheck(VarString$)) Or (FileLength& = 0)) Then
    MousePointer = 0
    Msg$ = FullFilePath & " - is not a valid text file, open in HEX mode?"
    Response = MBoxStop(Msg$)    ' Get user response.
    If Response = IDNO Then
    Me.Caption = "Virtual Text - (Untitled)"
    Close
    Exit Sub
    Else
    MousePointer = 11
    mnuTextMode.Checked = False
    mnuHexMode.Checked = True
    End If
End If
Seek #Filenum, 1  'Reset to the beginning of the file
TextArray(1).Visible = True
TotalLines = 0
'   Read and load the text boxes
If mnuTextMode.Checked = True Then
    LoadTextArrays
    LoadHexArrays
End If
'   Set the scrollbar ranges
VScroll1.Min = 1
If TotalLines > 0 Then
    VScroll1.Max = TotalLines
    VScroll1.Max = 1 ' Do not scroll
End If
ChangeFileList (FullFilePath)
UpdateStatusBar
EnableMenuItems
Active = 1
Close #Filenum
MousePointer = 0
Exit Sub
OpenFileError:
MousePointer = 0
Msg$ = "Problem opening file - " & Error$(Err)
Response = MBoxWarning(Msg$)    ' Get user response.
Resume OpenFileError1
OpenFileError1:
End Sub
Sub OpenFileDialogue ()
On Error GoTo errhandler
' Set filters
CMDialog1.Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
' Specify default filter
CMDialog1.FilterIndex = 2
' Cancel error ON
CMDialog1.CancelError = 1
' display the File Open dialog
CMDialog1.Action = 1
If Not Exists%(LCase$(CMDialog1.Filename)) Then
    Msg$ = LCase$(CMDialog1.Filename) & " - File does not exist."
    Response = MBoxWarning(Msg$)    ' Get user response.
    UserCancel = True
    Exit Sub
End If
FullFilePath = LCase$(CMDialog1.Filename)
Exit Sub
errhandler:
' user pressed cancel button
UserCancel = True
Resume errhandler1
errhandler1:
End Sub
Sub PaneltoTop (TopArray%)
' Do not bypass this routine !!!!!!
Call SetWindowPos(TextArray(TopArray%).hWnd, Panel3D1.hWnd, 0, 0, 0, 0, DONT_REPOS)
End Sub
Sub PrintFile1 ()
CRLF$ = Chr$(13) & Chr$(10)
On Error GoTo ErrorhandlerP
    MousePointer = 11
'   Do printer routine
Printer.FontName = optPrinterFont
Printer.FontSize = optPrinterFontSize
Printer.FontBold = optPrinterFontBold
Printer.FontItalic = optPrinterFontItalic
Dim TextLine As String
f = FreeFile
Open FullFilePath For Input As #f
Do While Not EOF(f) ' Check for end of file.
    Line Input #f, TextLine   ' Read data.
    Printer.Print TextLine
Close #f    ' Close file.
Printer.EndDoc
MousePointer = 0
Exit Sub
ErrorhandlerP:
    Resume ErrorResume1
ErrorResume1:
    MousePointer = 0
    Msg$ = "There was a problem printing." & CRLF$ & CRLF$ & "Check your Printer."
    Response = MBoxWarning(Msg$)
    Exit Sub
End Sub
Sub ProcessCommandLine ()
CommandLine = False
MousePointer = 11
On Error GoTo OpenFileError2
CommandTxt$ = LCase$(Trim$(Command$))
If CommandTxt$ = "" Then
    MousePointer = 0
    Exit Sub
End If
If Not Exists(CommandTxt$) Then
    MousePointer = 0
    Msg$ = CommandTxt$ & "- file does not exist."
    Response = MBoxWarning(Msg$)
    Exit Sub
End If
CommandLine = True
FullFilePath = LCase$(CommandTxt$)
HScroll1.Refresh
VScroll1.Refresh
Panel3D1.Refresh
OpenFile
Exit Sub
OpenFileError2:
    MousePointer = 0
    Msg$ = "Problem opening file - " & Error$(Err)
    Response = MBoxWarning(Msg$)
Resume OpenFileError3
OpenFileError3:
    MousePointer = 0
End Sub
Function ScrollText& (TextBox As Control, vLines As Integer, hLines As Integer)
    ' Place the number of horizontal columns to scroll in the high-
    ' order 2 bytes of Lines&. The vertical lines to scroll is
    ' placed in the low-order 2 bytes.
    Lines& = CLng(&H10000 * hLines) + vLines
    ' Get the window handle of the control that currently has the focus
    SavedWnd% = Screen.ActiveControl.hWnd
    ' Set the focus to the passed control (text control).
    TextBox.Enabled = True
    TextBox.SetFocus
    ' Scroll the lines.
    Success& = SendMessage(TextBox.hWnd, EM_LINESCROLL, 0, Lines&)
    ' Restore the focus to the original control
    R% = PutFocus%(SavedWnd%)
    ' Return the number of lines actually scrolled.
    ScrollText& = Success&
    TextBox.Enabled = False
End Function
Sub TextArray_GotFocus (Index As Integer)
' Put back Later?
Picture1.SetFocus
End Sub
Sub TextArray_KeyDown (Index As Integer, KeyCode As Integer, Shift As Integer)
Picture1.SetFocus
End Sub
Sub TextArray_KeyPress (Index As Integer, KeyAscii As Integer)
Picture1.SetFocus
End Sub
Sub TextArray_MouseDown (Index As Integer, button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.SetFocus
End Sub
Sub TextArraytoTop (WhichArray%)
Num& = ScrollText&(TextArray(WhichArray%), ToTop%, 0) ' top
End Sub
Function TextFileCheck (VarString$)
' Simple check for valid text file which VB can display
TextFileCheck = True
' Look at first hundred bytes
For X = 1 To 100
    If Asc(Mid$(VarString$, X, 1)) > 128 Then
    TextFileCheck = False
    Exit For
    End If
End Function
Sub Timer1_Timer ()
If Me.WindowState = 1 Then
     DragandDrop
End If
End Sub
Sub UpdateStatusBar ()
If TotalLines = 0 Then
    pnlColValue.Caption = ""
    pnlRowValue.Caption = ""
    pnlPageValue.Caption = ""
    pnlMessages.Caption = ""
    pnlMessages2.Caption = ""
    Exit Sub
End If
pnlColValue.Caption = Format$(HScroll1.Value, "@@@@@")
pnlRowValue.Caption = Format$(VScroll1.Value, "@@@@@") + " of " + Format$(TotalLines, "@@@@@")
PageX% = Int(VScroll1.Value / MaxRowsInEditBox)
PageY = VScroll1.Value Mod MaxRowsInEditBox
If PageY <> 0 Then PageX% = PageX% + 1
TotalPagesX% = Int(VScroll1.Max / MaxRowsInEditBox)
TotalPagesY = VScroll1.Max Mod MaxRowsInEditBox
If TotalPagesY <> 0 Then TotalPagesX% = TotalPagesX% + 1
pnlPageValue.Caption = Format$(PageX%, "@@@@@") + " of " + Format$(TotalPagesX%, "@@@@@")
If Virtual = True Then
    a$ = Format$(Active, "@@@") + "/" + Format$(Active + 1, "@@@")
    a$ = Format$(Active, "@@@")
End If
VirtualPage$ = "Virtual Zone " + a$ + " of " + Str$(NumArrays)
pnlMessages.Caption = VirtualPage$
pnlMessages.Refresh
End Sub
Sub VerticalDrag ()
If TotalLines = 0 Then Exit Sub ' Resizing closed document
PriorActive% = Active
VirtualBefore% = Virtual
If VScroll1.Value <= FixedLines(1) Then
    Active = 1
    Active = NumArrays
    For X = (NumArrays - 1) To 1 Step -1
    If VScroll1.Value > FixedLines(X) Then Active = X + 1: Exit For
    Next
End If
If Active = NumArrays Then
   VirtualAfter% = False
    If VScroll1.Value + (MaxRowsInEditBox - 1) < FixedLines(Active) Then
    VirtualAfter% = False
    Else
    VirtualAfter% = True
    End If
End If
Action% = 0
If VScroll1.Value = 1 Then
    Action% = 1  ' To Top
    If VScroll1.Value = FixedLines(NumArrays) Then
    Action% = 2  ' To Bottom
    Else
    If PriorActive% = Active Then  ' Case 3 through 6 within same array
    If VirtualBefore% = False Then
    If VirtualAfter% = False Then
        Action% = 3 ' Case 3  Drag within text array no virtual - before or after.
    Else
        Action% = 4 ' Case 4  Drag within text array no virtual before, virtual after.
    End If
    Else
    If VirtualAfter% = False Then
        Action% = 6 ' Case 6  Drag within text array virtual before but not after.
    Else
        Action% = 5 ' Case 5  Drag within text array virtual - before and after.
    End If
    End If
    Else
    If VirtualBefore% = False Then
    If VirtualAfter% = False Then
        Action% = 9 ' Case 9  Drag outside text array not virtual to another array not virtual.
    Else
        Action% = 10' Case 10 Drag outside text array not virtual to another virtual.
    End If
    Else
    If VirtualAfter% = False Then
        Action% = 7 ' Case 7  Drag outside text array from virtual to another array not virtual.
    Else
        Action% = 8 ' Case 8  Drag outside text array from virtual to another virtual.
    End If
    End If
    End If
    End If
End If
Select Case Action%
Case 0   ' Problem
    MsgBox "Error no code for this action!"
Case 1 ' Drag to Top
    TextArraytoTop (Active) 'Scroll to top
'   To top
    PaneltoTop (Active)
    Virtual = False
Case 2 ' Drag to Bottom
    If TextArray(Active).Top <> 0 Then TextArray(Active).Top = 0
    Num& = ScrollText&(TextArray(Active), ToBottom%, 0) ' Bottom
'   To top
    PaneltoTop (Active)
    Virtual = False
Case 3 'Drag within text array no virtual - before or after.
    SLines% = VScroll1.Value - Holdv
    Num& = ScrollText&(TextArray(Active), SLines%, 0) ' up or down
    Virtual = False
Case 4 'Drag within text array no virtual before, virtual after.
    SLines% = VScroll1.Value - Holdv
    Num& = ScrollText&(TextArray(Active), SLines%, 0)
    TextArraytoTop (Active + 1)
    Diff% = (FixedLines(Active) - VScroll1.Value) + 1  ' lines from top
    VTop& = Diff% * HeightOfRow
    If VTop& <> 0 Then
    TextArray(Active + 1).Top = VTop& + SpaceBetweenLines
    Else
    If TextArray(Active + 1).Top <> 0 Then TextArray(Active + 1).Top = 0
    End If
    PaneltoTop (Active + 1)
    Virtual = True
Case 5 'Drag within text array virtual - before and after.
    Diff% = (FixedLines(Active) - VScroll1.Value) + 1  ' lines from top
    VTop& = Diff% * HeightOfRow
    SLines% = VScroll1.Value - Holdv
    If SLines% < 0 Then TextArray(Active + 1).Top = VTop& + SpaceBetweenLines
    Num& = ScrollText&(TextArray(Active), SLines%, 0) ' down
    If SLines% >= 0 Then TextArray(Active + 1).Top = VTop& + SpaceBetweenLines
    Virtual = True
Case 6 ' Case 6  Drag within text array virtual before but not after.
    SLines% = VScroll1.Value - Holdv
    Num& = ScrollText&(TextArray(Active), SLines%, 0) ' up or down
    Diff% = (FixedLines(Active) - VScroll1.Value) + 1  ' lines from top
'   Active + 1 down in ZOrder
    Call SetWindowPos(TextArray(Active + 1).hWnd, TextArray(Active).hWnd, 0, 0, 0, 0, DONT_REPOS)
    Virtual = False
Case 7, 9  'Case 7  Drag outside text array from virtual to another array not virtual.
       'Case 9  Drag outside text array not  virtual to another array not virtual.
    If TextArray(Active).Top <> 0 Then TextArray(Active).Top = 0
    TextArraytoTop (Active)
    If Active > 1 Then
    SLines% = (VScroll1.Value - FixedLines(Active - 1)) - 1
    Else
    SLines% = VScroll1.Value - 1
    End If
    Num& = ScrollText&(TextArray(Active), SLines%, 0) ' up or down
'   To top
    PaneltoTop (Active)
    Virtual = False
Case 8, 10 'Case 8  Drag outside text array from virtual to another virtual.
       'Case 10 Drag outside text array not virtual to another virtual.
    If TextArray(Active).Top <> 0 Then TextArray(Active).Top = 0
    TextArraytoTop (Active)
    If Active > 1 Then
    SLines% = (VScroll1.Value - FixedLines(Active - 1)) - 1
    Else
    SLines% = VScroll1.Value - 1
    End If
    Num& = ScrollText&(TextArray(Active), SLines%, 0) ' up or down
    '
    TextArraytoTop (Active + 1)
    Diff% = (FixedLines(Active) - VScroll1.Value) + 1  ' lines from top
    VTop& = Diff% * HeightOfRow
    TextArray(Active + 1).Top = VTop& + SpaceBetweenLines
'   Active, behind Active + 1
'   Active + 1 To top
    Call SetWindowPos(TextArray(Active).hWnd, TextArray(Active + 1).hWnd, 0, 0, 0, 0, DONT_REPOS)
    PaneltoTop (Active + 1)
    Virtual = True
End Select
HScroll1.ZOrder 0
Holdv = VScroll1.Value    'Keep value
UpdateStatusBar
End Sub
Static Sub VScroll1_Change ()
' If the scroll bar is at the top or bottom this is not executed
If Holdv = VScroll1.Value Or TotalLines = 0 Then
      VScroll1.Value = Holdv
      Exit Sub
End If
VerticalDrag
End Sub
Sub VScroll1_Scroll ()
If Holdv = VScroll1.Value Then Exit Sub
If mnuVerticalDrag.Checked = True Then
    VerticalDrag
End If
End Sub