DP Tool Club 13/CD_ASCQ_13_0494.iso/maj/1697/samples/notepad.frm

Text File | 1994-01-09 | 11KB | 451 lines

VERSION 2.00
Begin Form frmNotePad
   Caption         =   "Untitled"
   ClientHeight    =   3555
   ClientLeft      =   480
   ClientTop       =   2220
   ClientWidth     =   5430
   Height          =   4185
   Icon            =   NOTEPAD.FRX:0000
   KeyPreview      =   -1  'True
   Left            =   450
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3555
   ScaleWidth      =   5430
   Top             =   1620
   Visible         =   0   'False
   Width           =   5490
   Begin Editor Text1
      BorderStyle     =   0  'None
      FileOpen        =   ""
      Height          =   3420
      InsertMode      =   -1  'True
      Left            =   0
      Password        =   0
      ReadOnly        =   0   'False
      ScrollBars      =   3  'Both
      SelDefaultType  =   1  'Stream
      TabIndex        =   0
      Top             =   0
      Width           =   5115
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFNew
     Caption         =   "&New"
     Shortcut        =   ^N
      End
      Begin Menu mnuFOpen
     Caption         =   "&Open..."
     Shortcut        =   ^O
      End
      Begin Menu mnuFClose
     Caption         =   "&Close"
      End
      Begin Menu mnuFSave
     Caption         =   "&Save"
     Shortcut        =   ^S
      End
      Begin Menu mnuFSaveAs
     Caption         =   "Save &As..."
      End
      Begin Menu mnuFSep
     Caption         =   "-"
      End
      Begin Menu mnuFExit
     Caption         =   "E&xit"
      End
      Begin Menu mnuRecentFile
     Caption         =   "-"
     Index           =   0
     Visible         =   0   'False
      End
      Begin Menu mnuRecentFile
     Caption         =   "RecentFile1"
     Index           =   1
     Visible         =   0   'False
      End
      Begin Menu mnuRecentFile
     Caption         =   "RecentFile2"
     Index           =   2
     Visible         =   0   'False
      End
      Begin Menu mnuRecentFile
     Caption         =   "RecentFile3"
     Index           =   3
     Visible         =   0   'False
      End
      Begin Menu mnuRecentFile
     Caption         =   "RecentFile4"
     Index           =   4
     Visible         =   0   'False
      End
   End
   Begin Menu mnuEdit
      Caption         =   "&Edit"
      Begin Menu mnuECut
     Caption         =   "Cu&t"
     Shortcut        =   ^X
      End
      Begin Menu mnuECopy
     Caption         =   "&Copy"
     Shortcut        =   ^C
      End
      Begin Menu mnuEPaste
     Caption         =   "&Paste"
     Shortcut        =   ^V
      End
      Begin Menu mnuESep1
     Caption         =   "-"
      End
      Begin Menu mnuESelectAll
     Caption         =   "Select &All"
      End
      Begin Menu mnuETime
     Caption         =   "Time/&Date"
      End
   End
   Begin Menu mnuSearch
      Caption         =   "&Search"
      Begin Menu mnuSFind
     Caption         =   "&Find..."
      End
      Begin Menu mnuSearchReplace
     Caption         =   "&Replace..."
      End
      Begin Menu mnuSFindNext
     Caption         =   "Re&peat"
     Shortcut        =   {F3}
      End
      Begin Menu mnuSSep
     Caption         =   "-"
      End
      Begin Menu mnuSGoto
     Caption         =   "&Goto Line..."
     Shortcut        =   ^G
      End
   End
   Begin Menu mnuOptions
      Caption         =   "&Options"
      Begin Menu mnuOToolbar
     Caption         =   "&Toolbar"
      End
      Begin Menu mnuFont
     Caption         =   "&Font..."
      End
   End
   Begin Menu mnuWindow
      Caption         =   "&Window"
      WindowList      =   -1  'True
      Begin Menu mnuWCascade
     Caption         =   "&Cascade"
      End
      Begin Menu mnuWindowTileHorizontal
     Caption         =   "&Tile"
      End
      Begin Menu mnuWArrange
     Caption         =   "&Arrange Icons"
      End
   End
   Begin Menu mnuHelp
      Caption         =   "&Help"
      Begin Menu mnuHelpAbout
     Caption         =   "&About..."
      End
   End
End
Option Explicit

Const SmallMarginTwipSize = 0
Declare Function GetKeyState Lib "User" (ByVal nVirtKey As Integer) As Integer

Dim BeginCaretX As Long
Dim BeginCaretY As Long
Dim BeginCount As Long
Dim MessageNesting As Integer

Sub Form_Activate ()
  Text1.InsertMode = gfInsertMode
  gfBlockType = Text1.SelDefaultType
  UpdateToolBar
  UpdateStatusLine
End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
    Dim Msg, Filename, NL
    Dim Response As Integer

    If Text1.IsDirty Then
    Filename = Me.Caption
    NL = Chr$(10) & Chr$(13)
    Msg = "The text in [" & Filename & "] has changed."
    Msg = Msg & NL
    Msg = Msg & "Do you want to save the changes?"
    Response = MsgBox(Msg, 51, frmMDI.Caption)
    Select Case Response
    ' User selects Yes
    Case 6
        If Left(Me.Caption, 8) = "Untitled" Then
        ' The file hasn't been saved yet,
        ' get the filename, then call the
        ' save procedure
        Filename = GetFileName()
        Else
        ' The caption contains the name of the open file
        Filename = Me.Caption
        End If

        'If the user did notspecify a file name,
        'cancel the unload; otherwise, save it.
        If Filename = "" Then
        Cancel = True
        Else
        SaveFileAs (Filename)
        End If

    ' User selects No
    ' Ok to unload
    Case 7
        Cancel = False
    ' User selects Cancel
    ' Cancel the unload
    Case 2
        Cancel = True
    End Select
    End If
End Sub

Sub Form_Resize ()
    If windowstate <> 1 And ScaleHeight <> 0 Then
    Text1.Visible = False
    Text1.Top = SmallMarginTwipSize
    Text1.Left = SmallMarginTwipSize
    Text1.Height = ScaleHeight - SmallMarginTwipSize
    Text1.Width = ScaleWidth - SmallMarginTwipSize
    Text1.Visible = True
    End If
End Sub

Sub Form_Unload (Cancel As Integer)
    ReleaseDocument (Me.Tag)

    UpdateToolBar
    UpdateStatusLine
End Sub

Sub mnuECopy_Click ()
    EditCopyProc
End Sub

Sub mnuECut_Click ()
    EditCutProc
End Sub

Sub mnuEDelete_Click ()
'  ' If cursor is not at the end of the notepad.
'  If screen.ActiveControl.SelStart <> Len(screen.ActiveControl.Text) Then
'    ' If nothing is selected, extend selection by one.
'    If screen.ActiveControl.SelLength = 0 Then
'      screen.ActiveControl.SelLength = 1
'      ' If cursor is on a blank line, extend selection by two.
'      If Asc(screen.ActiveControl.SelText) = 13 Then
'        screen.ActiveControl.SelLength = 2
'      End If
'    End If
'    ' Delete selected text.
'    screen.ActiveControl.SelText = ""
'  End If
End Sub

Sub mnuEPaste_Click ()
    EditPasteProc
End Sub

Sub mnuESelectAll_Click ()
    SendKeys "^{HOME}", True 'move caret to top of file
    SendKeys "+^{END}", True ' mark entire file
End Sub

Sub mnuETime_Click ()
    Text1.Redraw = False
    SendKeys Now, True
    Text1.Redraw = True

    ' You could also accomplish the task above this way...
    'Text1.SelText= Now
    '...I did it with SendKeys to show you that it's not
    'neccessary to have properties to accomplish everything,
    'the VBEditor control can be also be programmed by sending
    'key strokes to it.
End Sub

Sub mnuFClose_Click ()
    Unload Me
End Sub

Sub mnuFExit_Click ()
    ' Unloading the MDI form invokes the QueryUnload event
    ' for each child form, then the MDI form - before unloading
    ' the MDI form. Setting the Cancel argument to True in any of the
    ' QueryUnload events aborts the unload.

    Unload frmMDI


End Sub

Sub mnuFNew_Click ()
    FileNew
End Sub

Sub mnuFont_Click ()
    SetFontProc
End Sub

Sub mnuFOpen_Click ()
    FOpenProc
End Sub

Sub mnuFSave_Click ()
    Dim Filename As String

    If Left(Me.Caption, 8) = "Untitled" Then
    ' The file hasn't been saved yet,
    ' get the filename, then call the
    ' save procedure
    Filename = GetFileName()
    Else
    ' The caption contains the name of the open file
    Filename = Me.Caption
    End If
    ' call the save procedure, if Filename = Empty then
    ' the user selected Cancel in the Save As dialog, otherwise
    ' save the file
    If Filename <> "" Then
    SaveFileAs Filename
    End If
End Sub

Sub mnuFSaveAs_Click ()
    Dim SaveFileName As String

    SaveFileName = GetFileName()
    If SaveFileName <> "" Then SaveFileAs (SaveFileName)
    ' Update the recent files menu
    UpdateFileMenu (SaveFileName)
End Sub

Sub mnuHelpAbout_Click ()
    frmAbout.Show 1 'modal
End Sub

Sub mnuOptions_Click ()
    mnuOToolbar.Checked = frmMDI!picToolbar.Visible
End Sub

Sub mnuOToolbar_Click ()
    OptionsToolbarProc Me
End Sub

Sub mnuRecentFile_Click (index As Integer)
  Dim File2Open As String
  File2Open = mnuRecentFile(index).Caption
  If OpenFile(File2Open, False) = True Then
    ' Update recent files list for new notepad.
    GetRecentFiles
  End If
End Sub

Sub mnuSearchReplace_Click ()
    ReplaceProc
End Sub

Sub mnuSFind_Click ()
    FindProc
End Sub

Sub mnuSFindNext_Click ()
    FindNextProc
End Sub

Sub mnuSGoto_Click ()
    frmGotoLine.Show
End Sub

Sub mnuWArrange_Click ()
    frmMDI.Arrange ARRANGE_ICONS
End Sub

Sub mnuWCascade_Click ()
    frmMDI.Arrange CASCADE
End Sub

Sub mnuWindowTileHorizontal_Click ()
' if the shift key was help down when the menu item was
' clicked then tile the windows vertically otherwise tile
' them horizontally

    Dim ShiftDown As Integer
    ShiftDown = GetKeyState(&H10) And &H8000

    If ShiftDown Then
    frmMDI.Arrange TILE_VERTICAL
    Else
    frmMDI.Arrange TILE_HORIZONTAL
    End If
End Sub

Sub mnuWindowTileVertical_Click ()
    frmMDI.Arrange TILE_VERTICAL
End Sub

Sub Text1_BeginMessage (HControl As Long, HWindow As Integer, Message As Integer, WParam As Integer, LParam As Long, fProcessMessage As Integer)
    If MessageNesting = 0 Then
    BeginCaretY = Text1.CaretY
    BeginCaretX = Text1.CaretX
    BeginCount = Text1.Count
    End If
    MessageNesting = MessageNesting + 1
End Sub

Sub Text1_DblClick ()
    Text1.Redraw = False
    Text1.SelMark = 0' turn off block mark, if any
    If 1 < Text1.CaretX Then
    Text1.TextIndex = Text1.CaretY
    If Not IsBlankString(Mid(Text1.Text, Text1.CaretX - 1, 1)) Then
        'move to beginning of current word
        SendKeys "^{LEFT}", False
    End If
    End If
    SendKeys "+^{RIGHT}", True ' mark word

    Text1.Redraw = True
End Sub

Sub Text1_EndMessage (HControl As Long, HWindow As Integer, Message As Integer, WParam As Integer, LParam As Long)
    If MessageNesting = 1 Then
    If BeginCaretX <> Text1.CaretX Or BeginCaretY <> Text1.CaretY Or BeginCount <> Text1.Count Then
        UpdateStatusLine
    End If
    End If
    MessageNesting = MessageNesting - 1
End Sub

Sub Text1_GotFocus ()
    Text1.InsertMode = gfInsertMode
    If frmFind.Visible Then
    frmFind.ZOrder 0
    End If
End Sub

Sub Text1_KeyDown (KeyCode As Integer, Shift As Integer)
    ' If the Ins key is pressed and neither the Shift, Ctrl, nor Alt
    ' key is down then flip the insert mode property
    If KeyCode = KEY_INSERT And Shift = 0 Then
    FlipInsertMode
    End If
End Sub