Public ADrive As
String
Public Function Textload(File
As String)
CD.Flags = 4102
Me.Caption = FV & " - " & File
Open File For Binary
As #1
Main.Text = StrConv(InputB(LOF(1), 1), vbUnicode)
'load the file and display it in the RichTextBox
control 'Main'
Close #1
End Function
Private Sub Form_Load()
On Error Resume Next
'move to the next line if an error is encountered when retrieving the
appearance settings from the registry
Main.SelFontName = GetSetting(MA, FV, "Font")
Main.SelFontSize = GetSetting(MA, FV, "FontSize")
Main.SelBold = GetSetting(MA, FV, "FontBold")
Main.SelItalic = GetSetting(MA, FV, "FontItalic")
Main.SelStrikeThru = GetSetting(MA, FV, "FontStrikeThrough")
Main.SelUnderline = GetSetting(MA, FV, "FontUnderline")
Main.SelColor = GetSetting(MA, FV, "ForeColour")
Main.BackColor = GetSetting(MA, FV, "BackColour")
If Not Command() = ""
Then 'if the command line argument is not blank, then load the file
specified
If Allen.FExists(Replace(Command(),
Chr(34), "")) = True Then
CD.FileName = Replace(Command(),
Chr(34), "")
Textload Replace(Command(), Chr(34),
"")
End If
End If
End Sub
Private Sub Form_Resize()
On Error Resume Next
'prevent program crashing when the user minimises
Main.Height = File_Viewer.ScaleHeight
Main.Width = File_Viewer.ScaleWidth
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
'ignore errors when saving appearance values to the registry
SaveSetting MA, FV, "Font", Main.SelFontName
SaveSetting MA, FV, "FontSize", Main.SelFontSize
SaveSetting MA, FV, "FontBold", Main.SelBold
SaveSetting MA, FV, "FontItalic", Main.SelItalic
SaveSetting MA, FV, "FontStrikeThrough", Main.SelStrikeThru
SaveSetting MA, FV, "FontUnderline", Main.SelUnderline
SaveSetting MA, FV, "ForeColour", Main.SelColor
SaveSetting MA, FV, "BackColour", Main.BackColor
End Sub
Private Sub mnuBackground_Click()
On Error GoTo Error
CD.Flags = 3
CD.Color = Main.BackColor
CD.ShowColor
Main.BackColor = CD.Color
Exit Sub
Error:
End Sub
Private Sub mnuText_Click()
Dim i As Long, j
As Long
CD.Flags = 3
On Error GoTo Error
i = Main.SelStart
j = Main.SelLength
CD.Color = Main.SelColor
CD.ShowColor
Main.Visible = False
Main.SelStart = 0 'select all text to apply new format
Main.SelLength = Len(Main.Text)
Main.SelColor = CD.Color
CD.Color = CD.Color
Main.SelStart = i 'restore original cursor position
Main.SelLength = j
Error:
Main.Visible = True
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuFont_Click()
Dim i As Long, j
As Long
On Error GoTo Error
CD.Flags = 259
i = Main.SelStart
j = Main.SelLength
CD.FontName = Main.SelFontName
CD.FontSize = Main.SelFontSize
CD.FontBold = Main.SelBold
CD.FontItalic = Main.SelItalic
CD.FontStrikethru = Main.SelStrikeThru
CD.FontUnderline = Main.SelUnderline
CD.Color = Main.SelColor
CD.ShowFont
Main.Visible = False
Main.SelStart = 0 'select all text to apply new format
Main.SelLength = Len(Main.Text)
Main.SelFontName = CD.FontName
Main.SelFontSize = CD.FontSize
Main.SelBold = CD.FontBold
Main.SelItalic = CD.FontItalic
Main.SelStrikeThru = CD.FontStrikethru
Main.SelUnderline = CD.FontUnderline
Main.SelColor = CD.Color
CD.Color = CD.Color
Error:
Main.SelStart = i 'restore original cursor position
Main.SelLength = j
Main.Visible = True
End Sub
Private Sub mnuOpen_Click()
On Error GoTo Error
CD.Flags = 4102
CD.ShowOpen
Textload CD.FileName
Exit Sub
Error:
End Sub
Private Sub mnuRefresh_Click()
On Error GoTo Error
Textload CD.FileName
Error:
End Sub |
