Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/inpv10/inotepad.frm

Visual Basic Form | 1995-12-05 | 16.6 KB | 610 lines

VERSION 2.00
Begin Form form1
   Caption         =   "INOTEPAD"
   ClientHeight    =   4635
   ClientLeft      =   120
   ClientTop       =   1245
   ClientWidth     =   8865
   Height          =   5325
   Icon            =   INOTEPAD.FRX:0000
   Left            =   60
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   4635
   ScaleWidth      =   8865
   Top             =   615
   Width           =   8985
   Begin TextBox searchbut
      BorderStyle     =   0  'None
      Height          =   200
      Left            =   8400
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Width           =   100
   End
   Begin TextBox Text1
      BorderStyle     =   0  'None
      Height          =   3980
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   0
      Width           =   5775
   End
   Begin Menu filemenu
      Caption         =   "&File"
      Begin Menu newfilemenu
         Caption         =   "&New"
         Shortcut        =   ^N
      End
      Begin Menu openfilemenu
         Caption         =   "&Open"
      End
      Begin Menu savefilemenu
         Caption         =   "&Save"
         Shortcut        =   ^S
      End
      Begin Menu saveasfilemenu
         Caption         =   "Save &As"
      End
      Begin Menu choosefontmenu
         Caption         =   "&Choose Font"
      End
      Begin Menu printfilemenu
         Caption         =   "&Print"
      End
      Begin Menu sep1
         Caption         =   "-"
      End
      Begin Menu exitmenu
         Caption         =   "E&xit"
      End
   End
   Begin Menu editmenu
      Caption         =   "&Edit"
      Begin Menu undoeditmenu
         Caption         =   "&Undo"
      End
      Begin Menu sep2
         Caption         =   "-"
      End
      Begin Menu cuteditmenu
         Caption         =   "Cu&t"
         Shortcut        =   ^X
      End
      Begin Menu copyeditmenu
         Caption         =   "&Copy"
         Shortcut        =   ^C
      End
      Begin Menu pasteeditmenu
         Caption         =   "Pas&te"
         Shortcut        =   ^V
      End
      Begin Menu deleditmenu
         Caption         =   "De&l"
      End
      Begin Menu sep3
         Caption         =   "-"
      End
      Begin Menu selectalleditmenu
         Caption         =   "Select &All"
      End
      Begin Menu stripcrlfmenu
         Caption         =   "&Strip CrLf"
         Shortcut        =   ^Z
      End
      Begin Menu sep4
         Caption         =   "-"
      End
      Begin Menu macromenu
         Caption         =   "Edit &Macros"
      End
   End
   Begin Menu searchmenu
      Caption         =   "&Search"
      Begin Menu findsearchmenu
         Caption         =   "&Find"
      End
      Begin Menu findnextsearchmenu
         Caption         =   "Find &Next"
         Shortcut        =   {F3}
      End
   End
   Begin Menu macroexecutemenu
      Caption         =   "&Macros"
   End
   Begin Menu spacer1
      Caption         =   "                "
      Enabled         =   0   'False
   End
   Begin Menu helpmenu
      Caption         =   "&Help"
   End
DefInt A-Z
Dim EditFile As String, EditFileName As String
Dim Textfile(0) As String
Dim Temp() As String
Dim Changed As Integer
Dim DlgFlags As Long
Dim FindText As String
Dim StartPos As Integer
Dim PrinterHdc As Integer
Dim WindowsDir As String
Dim GetFileType As MhGetFileType
Dim FileFilterType() As MhFileFilterType
Dim PrintDlgType As MhPrintDlgType
Sub choosefontmenu_Click ()
'---------------------------
Dim ChooseFontType As MhChooseFontType
Dim LogFontType As MhLogFontType
Dim FontFlags As Long
ChooseFontType.hWnd = 0
ChooseFontType.pointSize = 100
FontFlags = CF_ANSIONLY + CF_BOTH + CF_LIMITSIZE + CF_SCALABLEONLY + CF_WYSIWYG
ChooseFontType.Flags = FontFlags
ChooseFontType.MinSize = 8
ChooseFontType.MaxSize = 12
ChooseFontType.FontType = Printer_Font
Result% = MhChooseFont%(LogFontType, ChooseFontType)
If Result% <> 0 And MhECode%() = 0 Then Exit Sub
If Result% <> 0 And MhECode%() <> 0 Then
    MsgBox "Error # " + Str$(MhECode%()) + "in selecting font"
    Exit Sub
End If
PrtFontName = RTrim$(LogFontType.FontFaceName)
PrtFontSize = LogFontType.FontHeight * -1
h = MhCtrlHwnd%(Text1)
Result% = MhSetFont%(h, 1, LogFontType)
End Sub
Sub copyeditmenu_Click ()
'-------------------------
ClipBoard.Clear
ClipBoard.SetText Text1.SelText
End Sub
Sub cuteditmenu_Click ()
'---------------------------
ClipBoard.Clear
ClipBoard.SetText Text1.SelText
Text1.SelText = ""
End Sub
Sub deleditmenu_Click ()
'-----------------------
Text1.SelText = ""
Text1.SetFocus
End Sub
Sub exitmenu_click ()
'-----------------------
SaveIniData
If Changed = True Then
    Check% = MsgBox("Do You need to save the file?  (Select Cancel to return to the Program.)", 3, "File Warning")
    If Check% = 2 Then Exit Sub
    If Check% = 6 Then savefilemenu_click
End If
End Sub
Sub findnextsearchmenu_Click ()
'------------------------------
tmp$ = Text1.Text
K = MhFwdInstrS%(StartPos, tmp$, FindText)
If K = 0 Then
    MsgBox " reached the end of the document"
    Exit Sub
End If
Text1.SelStart = K - 1
StartPos = K + Len(FindText)
End Sub
Sub findsearchmenu_Click ()
'------------------------------
StartPos = 0
MyKeyCode% = 255
MyHWnd% = MhCtrlHwnd(Searchbut)
DlgFlags = FR_DOWN + FR_NOWHOLEWORD + FR_NOUPDOWN + FR_MATCHCASE + FR_NOMATCHCASE
Find$ = FindText
Result% = MhFindText%(MyKeyCode%, MyHWnd%, DlgFlags, Find$)
If Result% < 0 Then
    MsgBox "Find Routine Failed"
    Exit Sub
End If
End Sub
Sub Form_Load ()
'---------------------
On Error Resume Next
WindowsDir = MhWinDir$()
IniFile = WindowsDir + "\inotepad.ini"
Dim P As Long
If MhFileExists%(IniFile) Then
    Open IniFile For Binary As #1
    P = 7
    Get #1, P, L%
    P = P + 2
    PrtFontName = Space$(L%)
    Get #1, P, PrtFontName
    P = P + L%
    Get #1, P, PrtFontSize
    P = P + 2
    For i% = 0 To 24
    Get #1, P, Macros(i%).Title
    P = P + 30
    Get #1, P, Macros(i%).Text
    P = P + 2000
    Next i%
    Close #1
    PuHandle = 99
End If
If RTrim$(PrtFontName) = "" Then
    Version% = MhWinVersion(Major%, Minor%)
    If Minor% = 10 Then
    PrtFontName = "Arial"
    Else
    PrtFontName = "Helv"
    End If
    PrtFontSize = 10
End If
Changed = False
Text1.FontName = PrtFontName
Text1.FontSize = PrtFontSize
If Command$ <> "" Then
    EditFile = Command$
    EditFileName = Right$(EditFile, 12)
    Open EditFile For Binary As #1
    filelength& = LOF(1)
    If filelength& > 64000 Then
    MsgBox "File is too long to edit", 16
    Close #1
    Exit Sub
    End If
    Textfile(0) = String$(filelength&, 0)
    Get #1, , Textfile(0)
    Close #1
    Form1.caption = "INOTEPAD - " + EditFile
    Text1.Text = Textfile(0)
    Text1.SetFocus
End If
Text1.SetFocus
TextLimit% = &HFFFF
retVal = SendMessage&(GetFocus(), EM_LIMITTEXT, TextLimit%, 0)
MakePuMenus
End Sub
Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If (Button And 2) Then
    Result% = MhPUTrack%((Form1.hWnd), PuHandle, 0, 0)
    If Result% < 0 Then
    MsgBox "Pop up Menu Execute Error"
    Exit Sub
    End If
    PuExecute Result%
End If
End Sub
Sub Form_Resize ()
'--------------------
If WindowState <> 1 Then
Text1.Move 0, 0, ScaleWidth, ScaleHeight
End If
End Sub
Sub Form_Unload (Cancel As Integer)
'-----------------------------------
If Changed = True Then
    Check% = MsgBox("Do You need to save the file?", 4, "File Warning")
    If Check% = 6 Then savefilemenu_click
End If
SaveIniData
End Sub
Sub helpmenu_Click ()
'----------------------
Form1.Mousepointer = 11
helpfile$ = "C:\windows\inotepad.hlp"
Tp% = Winhelp(hWnd, helpfile$, Help_Index, "0")
Form1.Mousepointer = 0
End Sub
Sub macroexecutemenu_Click ()
'----------------------------
Text1_Keyup 16, 2
End Sub
Sub macromenu_Click ()
'----------------------
Form2.Show
End Sub
Sub newfilemenu_Click ()
'--------------------------
If Changed = True Then
    Check% = MsgBox("Do You need to save the file?", 4, "File Warning")
    If Check% = 6 Then savefilemenu_click
End If
EditFile = ""
EditFileName = ""
Form1.caption = "INOTEPAD - <New File>"
Text1.SetFocus
Text1.Text = ""
Changed = False
End Sub
Sub openfilemenu_Click ()
'-------------------------
If Changed = True Then
    Check% = MsgBox("Do You need to save the file?", 4, "File Warning")
    If Check% = 6 Then savefilemenu_click
End If
On Error Resume Next
ReDim FileFilterType(1 To 5)  As MhFileFilterType
FileFilterType(1).Description = "Text Files (*.txt)"
FileFilterType(1).Mask = "*.txt"
FileFilterType(2).Description = "All Files(*.*)"
FileFilterType(2).Mask = "*.*"
FileFilterType(3).Description = "INI Files(*.ini)"
FileFilterType(3).Mask = "*.ini"
FileFilterType(4).Description = "System Files(*.sys)"
FileFilterType(4).Mask = "*.sys"
FileFilterType(5).Description = "Doc Files(*.doc;*.txt;*.bak"
FileFilterType(5).Mask = "*.doc;*.txt;*.bak"
GetFileType.FilterIndex = 1
GetFileType.InitDir = "C:\"
GetFileType.DefaultExtension = "txt"
GetFileType.HowManyFilters = UBound(FileFilterType)
GetFileType.hWnd = 0
EditFile = MhGetOpenFileNAme$(GetFileType, FileFilterType(1))
If EditFile = "" And MhECode%() = 0 Then Exit Sub
If EditFile = "" And MhECode%() < 0 Then
    MsgBox "Error # " + EditFile + " Opening file"
    Exit Sub
End If
EditFileName = MhGetFileTitle(EditFile)
Form1.caption = "INOTEPAD - " + EditFileName
On Error GoTo fileopentrouble
    Open EditFile For Binary As #1
On Error GoTo 0
    filelength& = LOF(1)
    If filelength& > 64000 Then
    MsgBox "File is too long to edit", 16
    Close #1
    Exit Sub
    End If
    Textfile(0) = String$(filelength&, 0)
    Get #1, , Textfile(0)
    On Error GoTo 0
    Close #1
    Form1.caption = "INOTEPAD - " + EditFileName
    Text1.Text = Textfile(0)
    Text1.SetFocus
    Changed = False
    Exit Sub
fileopentrouble:
     MsgBox "Unable to open file!!", 48, "File Error"
     Close #1
     Exit Sub
     Resume Next
End Sub
Sub pasteeditmenu_Click ()
'-----------------------
Text1.SelText = ClipBoard.GetText()
Text1.SetFocus
End Sub
Sub printfilemenu_Click ()
'---------------------------
Const LM = 1000
Const TM = 1000
Dim Curpos As Long
Dim Totalprint As Long
Dim Segment As String
ReDim Temp(0) As String
Dim TestChar As Integer
Dim Ptext As String
Dim PrintText As String
Dim FirstPageHead As String
Dim Testpos As Integer
Dim BreakPos As Integer
Dim PrtPos As Integer
Dim Lines As Integer
Dim MaxLines As Integer
Screen.Mousepointer = 11
Printer.FontName = PrtFontName
Printer.FontSize = PrtFontSize
Select Case PrtFontSize
    Case Is < 10
    TextPrintWidth = 100
    MaxLines = 62
    Case Is = 10
    TextPrintWidth = 85
    MaxLines = 56
    Case Is > 10
    TextPrintWidth = 72
    MaxLines = 48
End Select
FirstPageHead = EditFileName
If Len(Text1.SelText) = 0 Then
    Temp(0) = RTrim$(Text1.Text)
    PrintDlgType.hWnd = 0
    Flags& = PD_NOPAGENUMS + PD_USEDEVMODECOPIES
    PrintDlgType.Flags = Flags&
    Result% = MhPrintDlg%(PrintDlgType)
    If Result% <> 0 Then
    If MhECode%() = 0 Then
        GoTo exitlabel
    Else
        MsgBox "Error # " + Str$(Result%) + " in printing"
        GoTo exitlabel
    End If
    End If
    If (PrintDlgType.Flags And PD_SELECTION) Then
    Temp(0) = Text1.SelText
    If Temp(0) = "" Then
        Check% = MsgBox("No Text has been selected to print", 48, "Print Alert")
        GoTo exitlabel
    End If
    Else
    Temp(0) = RTrim$(Text1.Text)
    End If
End If
Screen.Mousepointer = 11
On Error GoTo Printproblem
Printer.FontBold = True
Printer.CurrentX = LM
Printer.CurrentY = TM
PrintText = FirstPageHead + " - Page < " + Str$(Printer.Page) + " >"
Printer.Print PrintText
Printer.Print
Printer.FontBold = False
Totalprint = Len(Temp(0))
Curpos = 1
Lines = 1
Segment = Space$(TextPrintWidth)
Do While Curpos < Totalprint
    Segment = Mid$(Temp(0), Curpos, TextPrintWidth)
    Testpos = 1
    TestChar = 13
    Result% = MhFwdInstrChar%(Testpos, TestChar, Segment)
    If Result% <> 0 Then
    BreakPos = Result% + 1
    PrtPos = Result% - 1
    GoTo ReadytoPrint
    End If
    TestChar = 32
    Result% = MhBkwdInstrChar%(TextPrintWidth, TestChar, Segment)
    If Result% = 0 Then
    BreakPos = TextPrintWidth
    PrtPos = TextPrintWidth
    Else
    BreakPos = Result%
    PrtPos = Result%
    End If
ReadytoPrint:
    Ptext = Mid$(Segment, 1, PrtPos)
    Printer.CurrentX = LM
    Printer.Print LTrim$(Ptext)
    Curpos = Curpos + BreakPos
    Lines = Lines + 1
    If Lines > MaxLines Then
    Printer.NewPage
    Printer.FontBold = True
    Printer.CurrentX = LM
    Printer.CurrentY = TM
    PrintText = FirstPageHead + " - Page < " + Str$(Printer.Page) + " >"
    Printer.Print PrintText
    Printer.Print
    Printer.FontBold = False
    Lines = 1
    End If
Printer.EndDoc
GoTo exitlabel
Printproblem:
    MsgBox "Print error: " + Error$
    Resume Next
exitlabel:
Screen.Mousepointer = 0
End Sub
Sub saveasfilemenu_click ()
'-----------------------------
On Error Resume Next
Dim EditFileTemp As String
ReDim FileFilterType(1 To 5)  As MhFileFilterType
FileFilterType(1).Description = "Text FIles (*.txt)"
FileFilterType(1).Mask = "*.txt"
FileFilterType(2).Description = "All Files(*.*)"
FileFilterType(2).Mask = "*.*"
FileFilterType(3).Description = "INI Files(*.ini)"
FileFilterType(3).Mask = "*.ini"
FileFilterType(4).Description = "System Files(*.sys)"
FileFilterType(4).Mask = "*.sys"
FileFilterType(5).Description = "Doc Files(*.doc;*.txt;*.bak"
FileFilterType(5).Mask = "*.doc;*.txt;*.bak"
GetFileType.FilterIndex = 1
GetFileType.InitDir = "C:\"
GetFileType.InitFileName = EditFileName
GetFileType.DefaultExtension = "txt"
GetFileType.HowManyFilters = UBound(FileFilterType)
GetFileType.hWnd = 0
EditFileTemp = MhGetSaveFileNAme$(GetFileType, FileFilterType(1))
If EditFileTemp = "" And MhECode%() = 0 Then Exit Sub
If EditFileTemp = "" And MhECode%() < 0 Then
    MsgBox "Error # " + EditFileTemp + " Opening file"
    Exit Sub
End If
Result% = MhFileExists%(EditFileTemp)
If Result% = True Then
    Check% = MsgBox("File already exists.  Replace?", 260, "File Warning")
    If Check% = 7 Then Exit Sub
End If
EditFile = EditFileTemp
EditFileName = MhGetFileTitle(EditFile)
Form1.caption = "INOTEPAD - " + EditFileName
On Error GoTo Filetrouble
Open EditFile For Output As #1
Print #1, Text1.Text,
Close #1
On Error GoTo 0
Changed = False
Exit Sub
Filetrouble:
    MsgBox "Could Not Save the File"
    Resume Next
End Sub
Sub savefilemenu_click ()
'--------------------------
On Error GoTo Filesavetrouble
If EditFile = "" Then
    saveasfilemenu_click
    Exit Sub
    Open EditFile For Output As #1
    Print #1, Text1.Text,
    Close #1
End If
Changed = False
Exit Sub
Filesavetrouble:
    MsgBox "Could Not Save the File"
    Resume Next
End Sub
Sub searchbut_KeyDown (Keycode As Integer, Shift As Integer)
'-------------------------------------------------------
If Keycode = 255 Then
    Replace$ = ""
    Result% = MhGetTextDialog%(Replace$, DlgFlags, FindText)
    If Result% <> 0 Then
    MsgBox "Find Operation Failed"
    Exit Sub
    End If
    StartPos = 1
    Textfile(0) = Text1.Text
    K = MhFwdInstrS%(StartPos, Textfile(0), FindText)
'    k = InStr(StartPos, TextFile(0), FindText)
    Text1.SelStart = K - 1
    StartPos = K + Len(FindText)
    MhKillDialog
    End If
End Sub
Sub selectalleditmenu_Click ()
'------------------------
Text1.SelStart = 0
Text1.SelLength = Len(RTrim$(Text1.Text))
End Sub
Sub stripcrlfmenu_Click ()
'----------------------
Dim Crlf As String
Dim Spacer As String
Dim Tp As String
Spacer = Space$(1)
Crlf = Chr$(13) + Chr$(10)
Tp = Text1.SelText
Text1.SelText = MhReplaceStr$(Count%, Tp, Crlf, Spacer)
End Sub
Sub Text1_Change ()
'----------------------------------------
Changed = True
End Sub
Sub Text1_Keyup (Keycode As Integer, Shift As Integer)
If Keycode = 16 And Shift = 2 Then
    Result% = MhPUTrack%((Form1.hWnd), PuHandle, 0, 200)
    If Result% < 0 Then
    MsgBox "Pop up Menu Execute Error"
    Exit Sub
    End If
    If Result% = 0 Then Exit Sub
    PuExecute Result%
End If
End Sub
Sub undoeditmenu_Click ()
'-------------------------
'MsgBox "NotYet Implemented"
Text1.SetFocus
retVal = SendMessage&(GetFocus(), EM_UNDO, 0, 0)
End Sub