Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/clipswin/multclip.frm

Visual Basic Form | 1995-05-08 | 11.6 KB | 400 lines

VERSION 2.00
Begin Form MClipForm
   BackColor       =   &H00C0C0C0&
   Caption         =   "Clips"
   ClientHeight    =   4935
   ClientLeft      =   1590
   ClientTop       =   1800
   ClientWidth     =   6405
   Height          =   5625
   Icon            =   MULTCLIP.FRX:0000
   Left            =   1530
   LinkTopic       =   "Form1"
   ScaleHeight     =   4935
   ScaleWidth      =   6405
   Top             =   1170
   Width           =   6525
   Begin Frame Frame2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Clip Text:"
      Height          =   2535
      Left            =   120
      TabIndex        =   4
      Top             =   2040
      Width           =   6135
      Begin TextBox ClipText
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "Arial"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   1935
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   1
         Top             =   360
         Width           =   5775
      End
   End
   Begin Frame Frame1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Clip Titles:"
      Height          =   1695
      Left            =   120
      TabIndex        =   3
      Top             =   240
      Width           =   6135
      Begin ListBox Titles
         DragIcon        =   MULTCLIP.FRX:0302
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "Arial"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   1155
         Left            =   120
         TabIndex        =   0
         Top             =   360
         Width           =   5775
      End
   End
   Begin CommonDialog CMDialog1
      Left            =   1560
      Top             =   4560
   End
   Begin Timer Timer2
      Interval        =   1000
      Left            =   720
      Top             =   4560
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Label1"
      Height          =   195
      Left            =   2400
      TabIndex        =   2
      Top             =   4680
      Width           =   1065
   End
   Begin Menu fMenu
      Caption         =   "&File"
      Begin Menu fItem
         Caption         =   "&New"
         Index           =   1
      End
      Begin Menu fItem
         Caption         =   "&Open"
         Index           =   2
      End
      Begin Menu fItem
         Caption         =   "&Save"
         Enabled         =   0   'False
         Index           =   3
      End
      Begin Menu fItem
         Caption         =   "Save &As..."
         Enabled         =   0   'False
         Index           =   4
      End
      Begin Menu fItem
         Caption         =   "E&xit"
         Index           =   5
      End
   End
   Begin Menu eMenu
      Caption         =   "&Edit"
      Begin Menu eItem
         Caption         =   "Cu&t"
         Enabled         =   0   'False
         Index           =   0
         Shortcut        =   ^X
      End
      Begin Menu eItem
         Caption         =   "&Copy"
         Enabled         =   0   'False
         Index           =   1
         Shortcut        =   ^C
      End
      Begin Menu eItem
         Caption         =   "&Paste"
         Enabled         =   0   'False
         Index           =   2
         Shortcut        =   ^V
      End
      Begin Menu eItem
         Caption         =   "Select &All"
         Enabled         =   0   'False
         Index           =   3
      End
      Begin Menu eItem
         Caption         =   "Clea&r"
         Enabled         =   0   'False
         Index           =   4
      End
      Begin Menu eItem
         Caption         =   "-"
         Index           =   5
      End
      Begin Menu eItem
         Caption         =   "Change &Title"
         Enabled         =   0   'False
         Index           =   6
      End
      Begin Menu eItem
         Caption         =   "De&lete Clip"
         Enabled         =   0   'False
         Index           =   7
      End
   End
   Begin Menu setMenu
      Caption         =   "&Settings"
      Begin Menu sItem
         Caption         =   "&On"
         Checked         =   -1  'True
         Index           =   1
      End
      Begin Menu sItem
         Caption         =   "O&ff"
         Index           =   2
      End
      Begin Menu sItem
         Caption         =   "&Combine"
         Index           =   3
      End
      Begin Menu sItem
         Caption         =   "-"
         Index           =   4
      End
      Begin Menu sItem
         Caption         =   "&Beep"
         Checked         =   -1  'True
         Index           =   5
      End
   End
   Begin Menu hMenu
      Caption         =   "&Help"
      Begin Menu aboutItem
         Caption         =   "&About..."
      End
   End
DefInt A-Z
Option Explicit
Sub aboutItem_Click ()
MsgBox "Clips 1.0" + CRLF$ + "Copyright
 1993 by Paul Bonner." + CRLF$ + "All Rights Reserved.", 0, "Clips"
End Sub
Sub ClipText_Change ()
If IgnoreChange% = False Then
     Clip(Titles.ListIndex) = ClipText
     FileDirty% = True
End If
End Sub
Sub ClipText_DragDrop (Source As Control, X As Single, Y As Single)
Dim Drop$, S%
Drop$ = ClipText.Text
S% = ClipText.SelStart + ClipText.SelLength
ClipText.Text = Left$(Drop$, S%) + Clip(Titles.ListIndex) + Mid$(Drop$, S% + 1)
ClipText.SelStart = S% + Len(Clip(Titles.ListIndex))
Clip(CombineIndex%) = ClipText
FileDirty% = True
End Sub
Sub ClipText_GotFocus ()
     If Titles.ListCount < 1 Then Titles.SetFocus
     If State% = sCombine Then Exit Sub
     YesEdit
     OldLI% = Titles.ListIndex
End Sub
Sub ClipText_KeyDown (KeyCode As Integer, Shift As Integer)
     If Titles.ListCount < 1 Then Titles.SetFocus : Exit Sub
     If State% <> sCombine Then YesEdit
End Sub
Sub ClipText_LostFocus ()
     If State% = sCombine Then Exit Sub
     NoEdit
     LabelIt
End Sub
Sub eItem_Click (Index As Integer)
If ActiveControl <> ClipText And Index < 6 Then ClipText.SetFocus
Select Case Index
Case 0 'Cut

     SendKeys "+{DEL}"
Case 1    'Copy
     SendKeys "^{INSERT}"
Case 2
     SendKeys "+{INSERT}"
Case 3
          ClipText.SelStart = 0
          ClipText.SelLength = Len(ClipText)
Case 4
     ClipText = ""
Case 6
     Dim LI, DefVal$, Answer$
     LI = Titles.ListIndex
     If LI < 0 Then Exit Sub
     DefVal$ = Titles.List(LI)
     Answer$ = InputBox("Enter a new title for this item:", "Change Title", DefVal$)
     If Answer$ <> "" Then Titles.List(LI) = Answer$
Case 7
     DeleteRoutine
End Select
End Sub
Sub fItem_Click (Index As Integer)
     Const OFN_HIDEREADONLY = &H4&
     Const OFN_OVERWRITEPROMPT = &H2&
     Const OFN_EXTENTIONDIFFERENT = &H400&
     Const OFN_FILEMUSTEXIST = &H1000&
     Const CancelButton = 32755
     CMDialog1.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_EXTENTIONDIFFERENT
Select Case Index
Case 1    'New
     If CheckDirty() = True Then Exit Sub
     IgnoreClip% = True
     Label1 = "State is ON"
     OldState% = sOn
     State% = sOn
     cFile$ = ""
     tFile$ = ""
     IgnoreChange% = True
     ReDim Clip(0)
     ReDim Title(0)
     ClipCount% = 0
     CombineIndex% = 0
     OldLI% = 0
     Titles.Clear
     ClipText = ""
     IgnoreChange% = False
Case 2    'Open
     If CheckDirty() = True Then Exit Sub
     CMDialog1.Flags = OFN_HIDEREADONLY Or OFN_EXTENTIONDIFFERENT Or OFN_FILEMUSTEXIST
     CMDialog1.DefaultExt = "MCF"
     CMDialog1.Filter = "Clips files|*.MCF"
     Dim T%
     T% = CMDialog1.Flags
ExtenErrorLoop:
     CMDialog1.CancelError = -1
     On Error Resume Next
     CMDialog1.Action = 1
     If CMDialog1.Flags And OFN_EXTENTIONDIFFERENT And Err <> CancelButton Then
          MsgBox "File must have an MCF extension!"
          GoTo ExtenErrorLoop
     End If
     If Err = CancelButton Then Exit Sub
     On Error GoTo 0
     tFile$ = CMDialog1.Filename
     If tFile$ = "" Then Exit Sub
     cFile$ = Left$(tFile$, InStr(tFile$, ".")) + "CLP"
     Titles.Enabled = False
     Screen.MousePointer = 11
     Titles.Clear
     GetFiles
     Titles.Enabled = True
     If Titles.ListCount Then Titles.ListIndex = 0
     Screen.MousePointer = 1
Case 3    'Save
     CMDialog1.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_EXTENTIONDIFFERENT
     Dim fName$
     If cFile$ = "" Then
          SaveWithNewName
     Else
          SaveCurrFile
     End If
Case 4    'Save As
     CMDialog1.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_EXTENTIONDIFFERENT
     SaveWithNewName
Case 5
     If CheckDirty() = True Then Exit Sub
     End
End Select
End Sub
Sub Form_Load ()
CRLF$ = Chr$(13) + Chr$(10)
Path$ = App.Path
If Right$(Path$, 1) <> "\" Then Path$ = Path$ + "\"
IgnoreClip% = True
Label1 = "State is ON"
OldState% = sOn
State% = sOn
Beeper% = True
Label1.Left = mCLipForm.Width / 2 - Label1.Width / 2
End Sub
Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
     Cancel = CheckDirty()
End Sub
Sub Form_Resize ()
If Windowstate = 1 Then Exit Sub
Dim fHeight%, X%
fHeight% = mCLipForm.Height
X% = mCLipForm.Width - 400
If X% > 400 Then
     Frame1.Width = X%
     Frame2.Width = X%
End If
X% = Frame1.Width - 240
If X% > 240 Then
     Titles.Width = X%
     ClipText.Width = X%
End If
Frame1.Top = .0425 * fHeight%
Titles.Top = 240
Frame1.Height = .3 * fHeight%
X% = Frame1.Height - 480
If X% > 480 Then Titles.Height = X%
Frame2.Top = .363 * fHeight%
Frame2.Height = .449 * fHeight%
ClipText.Top = 240
X% = Frame2.Height - 480
If X% > 480 Then ClipText.Height = X%
Label1.Top = fHeight% * .832
Label1.Left = mCLipForm.Width / 2 - Label1.Width / 2
End Sub
Sub sItem_Click (Index As Integer)
     Select Case Index
          Case Is = 1
               If State% = sCombine Then SetCombineMode
               ToggleSettings 1
               State% = sOn
               IgnoreClip% = True
               Label1 = "State is On"
          Case Is = 2
               ToggleSettings 2
               If State% = sCombine Then SetCombineMode
               State% = sOff
               Label1 = "State is Off"
          Case Is = 3
               If Titles.ListCount = 0 Then MsgBox ("You can't activate Combine mode when Clips is empty!"): Exit Sub
               If State% <> sCombine Then
                    SetCombineMode
                    ToggleSettings 3
               End If
          Case Is = 5
               Beeper% = Not Beeper%
               sItem(5).Checked = Beeper%
     End Select
End Sub
Sub Timer2_Timer ()
If State% <> sOn Then Exit Sub
If GetActiveWindow() = hWnd Then Exit Sub
GetClip
End Sub
Sub Titles_Click ()
Dim LI
If State% = sCombine Then Exit Sub
If Titles.ListCount Then
     IgnoreChange% = True
     LI = Titles.ListIndex: ClipText = Clip(LI)
     IgnoreChange% = False
End If
End Sub
Sub Titles_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not State% = sCombine Then Exit Sub
Titles.Drag 1
End Sub
Sub Titles_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Combine% = False
End Sub