WINDOWS - CLIPS.ZIP - MULTCLIP.FRM

 
Output of file : MULTCLIP.FRM contained in archive : CLIPS.ZIP

VERSION 2.00
Begin Form MClipForm
BackColor = &H00C0C0C0&
Caption = "Clips"
Height = 6000
Icon = MULTCLIP.FRX:0000
KeyPreview = -1 'True
Left = 1770
LinkTopic = "Form1"
ScaleHeight = 5310
ScaleWidth = 6360
Top = 1470
Width = 6480
Begin PushHelpButton PushHelp1
Caption = "index"
Destination = "CLPHELP,IDH_MAIN_INDEX,"
Height = 375
Index = 2
Left = 5160
TabIndex = 7
Top = 4800
Visible = 0 'False
Width = 1095
End
Begin PushHelpButton PushHelp1
Caption = "combine"
Destination = "CLPHELP,IDH_Combining_Captured_Text_Com,"
Height = 375
Index = 1
Left = 4080
TabIndex = 6
Top = 4800
Visible = 0 'False
Width = 1095
End
Begin PushHelpButton PushHelp1
Caption = "capture"
Destination = "CLPHELP,IDH_Capturing_Clipboard_Text,"
Height = 375
Index = 0
Left = 2880
TabIndex = 5
Top = 4800
Visible = 0 'False
Width = 1095
End
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 = 2 'Vertical
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 = 480
Left = 120
TabIndex = 0
Top = 360
Width = 5775
End
End
Begin CommonDialog CMDialog1
Left = 0
Top = 0
End
Begin Label lblStatus
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "lblStatus"
Height = 195
Left = 1920
TabIndex = 2
Top = 4800
Width = 750
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
Begin Menu eItem
Caption = "-"
Index = 8
End
Begin Menu eItem
Caption = "Co&mbine All"
Enabled = 0 'False
Index = 9
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 helpMenu
Caption = "&Help"
Begin Menu hItem
Caption = "&Contents"
Index = 0
End
Begin Menu hItem
Caption = "&Search..."
Index = 1
End
Begin Menu hItem
Caption = "Ca&pturing Clipboard Text..."
Index = 2
End
Begin Menu hItem
Caption = "Com&bining Clipboard Text..."
Index = 3
End
Begin Menu hItem
Caption = "-"
Index = 4
End
Begin Menu aboutMenu
Caption = "About Clips..."
End
End
End
DefInt A-Z
Option Explicit
Dim OldChoiceChanged%
Dim OldChoice%

Sub aboutMenu_Click ()
MsgBox "Clips 2.1a" + CRLF$ + "As seen in Windows Sources magazine" + CRLF$ + "and PC Magazine Visual Basic Utilities." + CRLF$ + "Copyright © 1993 by Paul Bonner." + CRLF$ + "All Rights Reserved.", 64, "Clips 2.1a"

End Sub

Function CheckChanges () As Integer
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' * determines whether ClipText has changed,
' * saves contents to Clip() array if necessary
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Dim OC$
CheckChanges = True
If OldChoiceChanged% Then
On Error GoTo TCMemError
OC$ = Clip(OldChoice%)
Clip(OldChoice%) = ClipText
On Error GoTo 0
End If
OldChoice% = Titles.ListIndex
OldChoiceChanged% = False
BD1:
Exit Function

TCMemError:
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' restore original contents of Clip() array member
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Screen.MousePointer = 0
Clip(OldChoice%) = OC$

CheckChanges% = False
DispErrorMsg "Ran out of memory trying to modify " + Title(OldChoice%)
Resume BD1
End Function

Sub ClipText_Change ()
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' set OldChoiceChanged% flag
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If IgnoreChange% = False Then OldChoiceChanged% = True: FileDirty% = True
End Sub

Sub ClipText_DragDrop (Source As Control, x As Single, Y As Single)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' called when title dropped on ClipText in combine mode
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Dim Drop$, S%, ddOriginal$
ddOriginal$ = ClipText
Drop$ = ddOriginal$
On Error GoTo DropError
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' dropped text inserted at selstart
' replaces any selected text in target
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
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
On Error GoTo 0
ddBD:
Exit Sub

DropError:
ClipText = ddOriginal$
Clip(CombineIndex%) = ddOriginal$
DispErrorMsg "These clips are too big to combine."
Resume ddBD
End Sub

Sub ClipText_GotFocus ()
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' don't accept focus if no clips in file
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If Titles.ListCount < 1 Then Titles.SetFocus
End Sub

Sub ClipText_KeyDown (KeyCode As Integer, Shift As Integer)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' don't accept focus if no clips in file
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If Titles.ListCount < 1 Then Titles.SetFocus : Exit Sub
End Sub

Sub ClipText_LostFocus ()
'If State% = sCombine Then Exit Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' Move insertion point to end of ClipText
'MClipForm.ClipText.SelStart = Len(MClipForm.Titles)
'MClipForm.ClipText.SelLength = 0
'LabelIt
End Sub

Sub eItem_Click (Index As Integer)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' processes Edit menu selections
'
' starts by making sure ClipText has focus for most operations
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If ActiveControl <> ClipText And Index < 6 Then ClipText.SetFocus

Select Case Index
Case 0 'Cut
SendKeys "+{DEL}"
Case 1 'Copy
SendKeys "^{INSERT}"
Case 2 'Paste
SendKeys "+{INSERT}"
Case 3 'Select All
ClipText.SelStart = 0
ClipText.SelLength = Len(ClipText)
Case 4 'Clear
ClipText = ""
Case 6 'Retitle
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$
FileDirty% = True
Case 7 'Delete
DeleteClip
Case 8 'separator
Case 9 'Combine All
CombineAll
End Select
End Sub

Sub fItem_Click (Index As Integer)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' processes File item selections
'
' start by calling CheckChanges() to
' save ClipText changes to Clip() array
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Dim x%
x% = CheckChanges()
Select Case Index
Case 1 'New
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' exit if file needs to be saved and user cancels
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If CheckDirty() = True Then Exit Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' reset state to On
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
OldState% = sOn
State% = sOn
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' reinitialize globals
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
cFile$ = ""
tFile$ = ""
IgnoreChange% = True

LabelIt
ReDim Clip(0)
ReDim Title(0)
ClipCount% = 0
CombineIndex% = 0
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' clear Titles list box and ClipText edit box
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Titles.Clear
ClipText = ""
IgnoreChange% = False
FileDirty% = False
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' reset menus and caption
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
MClipForm.Caption = "Clips"
ToggleMenu False
Case 2 'Open
If CheckDirty() = True Then Exit Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' set up common dialog
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
CMDialog1.Flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
CMDialog1.DefaultExt = "MCF"
CMDialog1.CancelError = True
On Error Resume Next
ExtenErrorLoop:
CMDialog1.Filter = "Clips files|*.MCF"
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' call common dialog
' exit if user cancels
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
CMDialog1.Action = 1
If Err = CancelButton Then Exit Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' don't accept extension other than default (MCF)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If CMDialog1.Flags And OFN_EXTENTIONDIFFERENT Then
MsgBox "File must have an MCF extension!"
GoTo ExtenErrorLoop
End If
On Error GoTo 0
tFile$ = CMDialog1.Filename
If tFile$ = "" Then Exit Sub
OldChoiceChanged% = False
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' load file
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
LoadFile tFile$
Case 3 'Save
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' call file naming routine if not yet named
' otherwise just save it
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If cFile$ = "" Then
SaveWithNewName
Else
SaveClipsFile
End If
Case 4 'Save As
SaveWithNewName
Case 5 'Exit
Unload MClipForm
End Select
End Sub

Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' calls GetClip when DLL notifies form that clipboard has changed
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'If (State% <> sOn) Or (GetActiveWindow() = hWnd) Then Exit Sub
'If KeyCode = &H7F Then GetClip

Select Case GetActiveWindow()
Case Is = hWnd
'Global Const KEY_F1 = &H70
If KeyCode = &H70 Then
If State% = sCombine Then
PushHelp1(1).DoContextHelp = True
Else
PushHelp1(0).DoContextHelp = True
End If
End If

Case Else
'If (State% <> sOn) Or (GetActiveWindow() = hWnd) Then Exit Sub
If State% <> sOn Then Exit Sub
If KeyCode = &H7F Then GetClip
End Select


End Sub

Sub Form_Load ()
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' exit if another instance of Clips already loaded
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If app.PrevInstance Then End
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' register this window as a clipboard viewer
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Dim OldViewer&
OldViewer& = RegClipViewer(hWnd, True)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' initialize some globals
CRLF$ = Chr$(13) + Chr$(10)
Path$ = app.Path
If Right$(Path$, 1) <> "\" Then Path$ = Path$ + "\"
OldState% = sOn
State% = sOn
Beeper% = True
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' update status label and menus
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
LabelIt
ToggleMenu False
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' process command line file spec, if any
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If Command$ <> "" Then
tFile$ = UCase$(Command$)
If InStr(tFile$, ".MCF") = 0 Then Exit Sub
LoadFile tFile$
End If
End Sub

Sub Form_Paint ()
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' draw 3d box around status label
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
FrameControl Me, lblStatus
End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' give user a chance to save file or to cancel operation
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Select Case CheckDirty()
Case True
Cancel = True
Case False
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' cancel clipboard viewer status
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Dim OldViewer&
OldViewer& = RegClipViewer(MClipForm.hWnd, False)
End Select
End Sub

Sub Form_Resize ()
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' if form isn't minimized
' resize everything
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
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%
lblStatus.Top = fHeight% * .832
FrameControl Me, lblStatus
End Sub

Sub hItem_Click (Index As Integer)
Dim hFile$, x%
hFile$ = app.Path
If Right$(hFile$, 1) <> "\" Then hFile$ = hFile$ + "\"
hFile$ = hFile$ + "CLPHELP.HLP"
Select Case Index
Case 0
PushHelp1(2).DoContextHelp = True
Case 1
x% = WinHelp(hWnd, hFile$, HELP_PARTIALKEY, "")
Case 2
PushHelp1(0).DoContextHelp = True
Case 3
PushHelp1(1).DoContextHelp = True
End Select
End Sub

Sub lblStatus_DblClick ()
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' increment state when user double clicks label
' skipping sCombine if fewer than 2 clips in file,
' and dropping back to sOn after sCombine
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Dim Y%
Y% = State% + 1
If Y% = 3 And Titles.ListCount < 2 Then Y% = 1
If Y% = 4 Then Y% = 1
sItem_Click Y%
End Sub

Sub sItem_Click (Index As Integer)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' process Settings menu choices
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Select Case Index
Case Is < 3 'turn On or Off
If State% = sCombine Then SetCombineMode False
ToggleSettings Index
State% = Index
LabelIt
Case Is = 3
If State% <> sCombine Then SetCombineMode True
ToggleSettings 3
Case Is = 5
Beeper% = Not Beeper%
sItem(5).Checked = Beeper%
End Select
End Sub

Sub Titles_Click ()
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' exit if Combine Mode active, else if list isn't empty
' save any changes in ClipText to Clip() array,
' then update ClipText
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Dim LI
If State% = sCombine Then Exit Sub
If Titles.ListCount Then
Screen.MousePointer = 11
If CheckChanges() = False Then Exit Sub
OldChoice% = Titles.ListIndex
OldChoiceChanged% = False
IgnoreChange% = True
LI = Titles.ListIndex: ClipText = Clip(LI)
IgnoreChange% = False
End If
Screen.MousePointer = 0
End Sub

Sub Titles_MouseDown (Button As Integer, Shift As Integer, x As Single, Y As Single)
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' if Combine Mode is active activate drag/drop
' * * * * * * * * * * * * * * * * * * * * * * * * * * * *
If Not State% = sCombine Then Exit Sub
Titles.Drag 1
End Sub