Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/popup/popup.frm

Visual Basic Form | 1995-02-19 | 10.5 KB | 388 lines

VERSION 2.00
Begin Form NotePad
   BackColor       =   &H00C0C0C0&
   Caption         =   "Popup Menu Custom Control Demo"
   ClientHeight    =   5715
   ClientLeft      =   945
   ClientTop       =   1605
   ClientWidth     =   9510
   Height          =   6405
   Left            =   885
   LinkTopic       =   "Form1"
   ScaleHeight     =   5715
   ScaleWidth      =   9510
   Top             =   975
   Width           =   9630
   Begin Frame Frame2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Position Popup"
      Height          =   1815
      Left            =   7680
      TabIndex        =   7
      Top             =   3240
      Width           =   1695
      Begin OptionButton Leftpos
         BackColor       =   &H00C0C0C0&
         Caption         =   "Left"
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   1440
         Width           =   1455
      End
      Begin OptionButton Centrepos
         BackColor       =   &H00C0C0C0&
         Caption         =   "Centre"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   960
         Width           =   1455
      End
      Begin OptionButton Rightpos
         BackColor       =   &H00C0C0C0&
         Caption         =   "Right"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   480
         Width           =   1455
      End
   End
   Begin Frame Frame1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Use Button"
      Height          =   1455
      Left            =   7680
      TabIndex        =   4
      Top             =   1680
      Width           =   1695
      Begin OptionButton Either
         BackColor       =   &H00C0C0C0&
         Caption         =   "Either"
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   360
         Width           =   1455
      End
      Begin OptionButton Left
         BackColor       =   &H00C0C0C0&
         Caption         =   "Left"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   960
         Width           =   1455
      End
   End
   Begin CommandButton Command3
      Caption         =   "Custom Popup "
      Height          =   375
      Left            =   7680
      TabIndex        =   3
      Top             =   1080
      Width           =   1575
   End
   Begin CommandButton Command2
      Caption         =   "Popup Edit"
      Height          =   375
      Left            =   7680
      TabIndex        =   2
      Top             =   600
      Width           =   1575
   End
   Begin CommonDialog CMDialog1
      Left            =   7560
      Top             =   5160
   End
   Begin CommandButton Command1
      Caption         =   "Popup File"
      Height          =   375
      Left            =   7680
      TabIndex        =   1
      Top             =   120
      Width           =   1575
   End
   Begin Popup Popup1
      Enabled         =   -1  'True
      Left            =   8280
      MenuAlignment   =   0  'Right
      MenuCaption     =   ""
      Top             =   5160
      TrackingButton  =   0  'Left Button
   End
   Begin TextBox Document
      Height          =   5415
      HideSelection   =   0   'False
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   0
      Width           =   7455
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFNew
         Caption         =   "&New"
      End
      Begin Menu mnuFOpen
         Caption         =   "&Open..."
      End
      Begin Menu mnuFSave
         Caption         =   "&Save"
      End
      Begin Menu mnuFSaveAs
         Caption         =   "Save &As..."
      End
      Begin Menu mnuFSep
         Caption         =   "-"
      End
      Begin Menu mnuFExit
         Caption         =   "E&xit"
      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 mnuEDelete
         Caption         =   "De&lete"
         Shortcut        =   {DEL}
      End
      Begin Menu mnuESep1
         Caption         =   "-"
      End
      Begin Menu mnuESelectAll
         Caption         =   "Select &All"
      End
      Begin Menu mnuETime
         Caption         =   "Time/&Date"
      End
   End
Sub Centrepos_Click ()
 popup1.MenuAlignment = 1
End Sub
Sub Command1_Click ()
   popup1.Clear
   popup1.MenuCaption = "&File"
End Sub
Sub Command2_Click ()
  popup1.Clear
  popup1.MenuCaption = "&Edit"
End Sub
Sub Command3_Click ()
  popup1.Clear
  popup1.AddItem "&File"
  popup1.AddItem Chr$(9) & "1" & Chr$(9) & "&New"
  popup1.AddItem Chr$(9) & "2" & Chr$(9) & "&Open"
  popup1.AddItem Chr$(9) & "3" & Chr$(9) & "&Save"
  popup1.AddItem Chr$(9) & "4" & Chr$(9) & "Save &As"
  popup1.AddItem Chr$(9) & "-"
  popup1.AddItem Chr$(9) & "5" & Chr$(9) & "E&xit"
  popup1.AddItem "&Edit"
  popup1.AddItem Chr$(9) & "6" & Chr$(9) & "Cu&t"
  popup1.AddItem Chr$(9) & "7" & Chr$(9) & "&Copy"
  popup1.AddItem Chr$(9) & "8" & Chr$(9) & "&Paste"
  popup1.AddItem Chr$(9) & "9" & Chr$(9) & "De&lete"
  popup1.AddItem Chr$(9) & "-"
  popup1.AddItem Chr$(9) & "10" & Chr$(9) & "Select &All"
  popup1.AddItem Chr$(9) & "11" & Chr$(9) & "Time/&Date"
End Sub
Sub Document_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then      ' activate when user clicks the right mousebutton
  popup1.Activate = 1
  Select Case popup1.MenuReturnID
    Case 1
      mnuFNew_Click
    Case 2
      mnuFOpen_Click
    Case 3
      mnuFSave_Click
    Case 4
      mnuFSaveAs_Click
    Case 5
      mnuFExit_Click
    Case 6
      mnuECut_Click
    Case 7
      mnuECopy_Click
    Case 8
      mnuEPaste_Click
    Case 9
      mnuEDelete_Click
    Case 10
      mnuESelectAll_Click
    Case 11
      mnuETime_Click
  End Select
End If
End Sub
Sub EditCopyProc ()
    ClipBoard.SetText Document.SelText
End Sub
Sub EditCutProc ()
    ClipBoard.SetText Document.SelText
    Document.SelText = ""
End Sub
Sub EditPasteProc ()
    Document.SelText = ClipBoard.GetText()
End Sub
Sub Either_Click ()
  popup1.TrackingButton = 1
End Sub
Sub FileNew ()
    Document.Text = ""
    Document.SetFocus
End Sub
Sub FOpenProc ()
    Dim RetVal
    On Error Resume Next
    Dim OpenFileName As String
    CMDialog1.Filename = "*.txt"
    CMDialog1.Action = 1
    If Err <> 32755 Then 'user pressed cancel
    OpenFileName = CMDialog1.Filename
    OpenFile (OpenFileName)
    End If
End Sub
Sub Form_Load ()
  Either.Value = True
  Rightpos.Value = True
  Document.Text = "Click the right mousebutton to see the popup menu"
  popup1.MenuCaption = "&File"
End Sub
Sub Form_Resize ()
    If windowstate <> 1 And ScaleHeight <> 0 Then
    Document.Visible = False
    Document.Height = ScaleHeight
    Document.Width = ScaleWidth * .8
    Command1.Left = Document.Width + 100
    Command2.Left = Document.Width + 100
    Command3.Left = Document.Width + 100
    Frame1.Left = Document.Width + 100
    Frame2.Left = Document.Width + 100
    Document.Visible = True
    End If
End Sub
Function GetFileName ()
    On Error Resume Next
    CMDialog1.Filename = "File1.Txt"
    CMDialog1.Action = 2
    If Err <> 32755 Then      'User cancelled dialog
    GetFileName = CMDialog1.Filename
    Else
    GetFileName = "File1.Txt"
    End If
End Function
Sub Left_Click ()
  popup1.TrackingButton = 0
End Sub
Sub Leftpos_Click ()
   popup1.MenuAlignment = 2
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 Document.SelStart <> Len(Document.Text) Then
    ' If nothing is selected, extend selection by one.
    If Document.SelLength = 0 Then
      Document.SelLength = 1
      ' If cursor is on a blank line, extend selection by two.
      If Asc(Document.SelText) = 13 Then
    Document.SelLength = 2
      End If
    End If
    ' Delete selected text.
    Document.SelText = ""
  End If
End Sub
Sub mnuEPaste_Click ()
    EditPasteProc
End Sub
Sub mnuESelectAll_Click ()
    Document.SelStart = 0
    Document.SelLength = Len(Document.Text)
End Sub
Sub mnuETime_Click ()
    Dim TimeStr As String, DateStr As String
    Document.SelText = Now
End Sub
Sub mnuFExit_Click ()
    Unload Me
End Sub
Sub mnuFNew_Click ()
    FileNew
End Sub
Sub mnuFOpen_Click ()
    FOpenProc
End Sub
Sub mnuFSave_Click ()
    SaveFileAs "File1.Txt"
End Sub
Sub mnuFSaveAs_Click ()
    Dim SaveFileName As String
    SaveFileName = GetFileName()
    If SaveFileName <> "" Then
       SaveFileAs (SaveFileName)
    End If
End Sub
Sub OpenFile (Filename)
    Dim NL, TextIn, GetLine
    Dim fIndex As Integer
    NL = Chr$(13) + Chr$(10)
    On Error Resume Next
    ' open the selected file
    Open Filename For Input As #1
    If Err Then
    MsgBox "Can't open file: " + Filename
    Exit Sub
    End If
    ' change mousepointer to an hourglass
    screen.MousePointer = 11
    ' change form's caption and display new text
    Document.Tag = fIndex
    Document.Text = Input$(LOF(1), 1)
    Close #1
    ' reset mouse pointer
    screen.MousePointer = 0
End Sub
Sub Rightpos_Click ()
  popup1.MenuAlignment = 0
End Sub
Sub SaveFileAs (Filename)
On Error Resume Next
    Dim Contents As String
    ' open the file
    Open Filename For Output As #1
    ' put contents of the notepad into a variable
    Contents = Document.Text
    ' display hourglass
    screen.MousePointer = 11
    ' write variable contents to saved file
    Print #1, Contents
    Close #1
    ' reset the mousepointer
    screen.MousePointer = 0
    ' set the Notepad's caption
    If Err Then
    MsgBox Error, 48, App.Title
    End If
End Sub