home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / VB_API_cod1852392132005.psc / clsClipboard.cls < prev    next >
Encoding:
Visual Basic class definition  |  2004-05-31  |  8.7 KB  |  283 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsClipboard"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Enum ClipType
  17.       Clip_Board
  18.       Code_Block
  19. End Enum
  20.  
  21.  
  22. Private fFile              As Integer
  23. Private mod_Clipboard()    As String
  24. Private mod_CodeBlock()    As String
  25.  
  26.  
  27. Public Property Get CurrClipContents(Which As ClipType, Index%) As String
  28.   '---------------------------------------
  29.   'since arr cant be public in object module
  30.   'this passes the value ,to frmBar,
  31.   'of the clipboard item the user wants to send
  32.   '--------------------------------------
  33.    If Which = Clip_Board Then
  34.        CurrClipContents = mod_Clipboard(Index)
  35.    Else
  36.        CurrClipContents = mod_CodeBlock(Index)
  37.    End If
  38. End Property
  39.  
  40.  
  41.  
  42. '----------------------------------------------------------------------
  43. '   INPUTS: |
  44. '  RETURNS: |
  45. ' COMMENTS: |this is called when user clicks "Apply" in frmClip
  46. '----------------------------------------------------------------------
  47. Sub AddToClipboard(Which As ClipType, sData$, mnuName As Variant, _
  48.                         Optional bLoadingCodeBlocks As Boolean = False, _
  49.                         Optional strCodeMenu As String)
  50. 'VARIABLES::
  51.     Dim iUpp%
  52.     Dim mnuLeft$
  53. 'CODE::
  54.     'redimension both the arr holding clipb data
  55.     'and the clipboard item itself
  56.     If Which = Clip_Board Then
  57.        iUpp = UBound(mod_Clipboard) + 1
  58.        Load mnuName(iUpp)
  59.        ReDim Preserve mod_Clipboard(iUpp)
  60.       'add the new clipboard data
  61.        mod_Clipboard(iUpp) = sData
  62.       'show first 40 chr's in menu as reminder
  63.       'to what clipboard contents are
  64.        mnuLeft = Left(sData, 40)
  65.        ' enable "remove" menu item
  66.        If frmBar.mnuClipboardRemove.Enabled = False Then
  67.            frmBar.mnuClipboardRemove.Enabled = True
  68.        End If
  69.     Else
  70.        iUpp = UBound(mod_CodeBlock) + 1
  71.        Load mnuName(iUpp)
  72.        ReDim Preserve mod_CodeBlock(iUpp)
  73.        'add the new clipboard data
  74.        mod_CodeBlock(iUpp) = sData
  75.        '
  76.        If bLoadingCodeBlocks = False Then
  77.             mnuLeft = InputBox("Enter a description for this code block that " & _
  78.                       "will serve as the menu caption.")
  79.        Else
  80.             mnuLeft = strCodeMenu
  81.        End If
  82.        
  83.        ' enable "remove" menu item
  84.        If frmBar.mnuRemoveCodeBlock.Enabled = False Then
  85.            frmBar.mnuRemoveCodeBlock.Enabled = True
  86.        End If
  87.     End If
  88.     '
  89.     mnuName(iUpp).Caption = mnuLeft
  90.     mnuName(iUpp).Visible = True
  91. 'END CODE::
  92. End Sub
  93.  
  94. Sub RemoveFromClipboard(Which As ClipType, Index%, mnuName As Variant)
  95. 'VARIABLES::
  96.   Dim i%, iUpper%
  97. 'CODE::
  98.     iUpper = mnuName.UBound
  99.    'move elements from menu 1 step down to
  100.    'the point of the index of the item to be removed
  101.     For i = Index To (iUpper - 1)
  102.         mnuName(i).Caption = mnuName(i + 1).Caption
  103.         '
  104.         If Which = Clip_Board Then
  105.            'do the same with the holder of clipb contents
  106.             mod_Clipboard(i) = mod_Clipboard(i + 1)
  107.         Else
  108.             mod_CodeBlock(i) = (mod_CodeBlock(i + 1))
  109.         End If
  110.     Next i
  111.     
  112.     'remove highest menu item
  113.     Unload mnuName(i)
  114.     
  115.     If Which = Clip_Board Then
  116.        'and the highest arr of dec_Clipboard
  117.        ReDim Preserve mod_Clipboard(i - 1)
  118.        'disable "remove" if there are no more mnuitems to remove
  119.        If iUpper <= 1 Then
  120.            frmBar.mnuClipboardRemove.Enabled = False
  121.        End If
  122.     Else
  123.        'and the highest arr of dec_Clipboard
  124.        ReDim Preserve mod_CodeBlock(i - 1)
  125.        'disable "remove" if there are no more mnuitems to remove
  126.        If iUpper <= 1 Then
  127.            frmBar.mnuRemoveCodeBlock.Enabled = False
  128.        End If
  129.     End If
  130.     '
  131.     Unload frmWaitForClipboardRemove
  132. 'END CODE::
  133. End Sub
  134. '----------------------------------------------------------------------
  135. '   INPUTS: |
  136. '  RETURNS: |
  137. ' COMMENTS: |saves the contents of dec_Clipboard to file
  138. '----------------------------------------------------------------------
  139. Sub SaveClipContents(Which As ClipType, cmDialog As CommonDialog)
  140.  On Error GoTo ERR:
  141. 'VARIABLES:
  142.   Dim i%
  143. 'CODE:
  144.   fFile = FreeFile
  145.   '
  146.   Open CmnDlgReturn(cmDialog, False) For Output As #fFile
  147.     If Which = Clip_Board Then
  148.         'saving clipboard contents
  149.         For i = 1 To UBound(mod_Clipboard)
  150.            Print #fFile, mod_Clipboard(i) & vbCrLf & "ENDL"
  151.         Next i
  152.     Else
  153.         'saving codeblock contents
  154.         For i = 1 To UBound(mod_CodeBlock)
  155.            Print #fFile, mod_CodeBlock(i) & vbCrLf
  156.            Print #fFile, "menucaption: " & frmBar.mnuArrCode(i).Caption
  157.         Next i
  158.     End If
  159.   Close #fFile
  160. 'END CODE:
  161. ERR:
  162. End Sub
  163. '----------------------------------------------------------------------
  164. '   INPUTS: |
  165. '  RETURNS: |
  166. ' COMMENTS: |load contents of clipboard file to mod_Clipboard
  167. '----------------------------------------------------------------------
  168. Sub LoadClipContents(Which As ClipType, mnuItem As Variant, cmDialog As CommonDialog)
  169.  On Error GoTo ERR:
  170. 'VARIABLES:
  171.   Dim sTemp$, sTemp2$
  172. 'CODE:
  173.   fFile = FreeFile
  174.   '
  175.   Open CmnDlgReturn(cmDialog, True) For Input As #fFile
  176.     Do Until EOF(fFile)
  177.        Line Input #fFile, sTemp
  178.           '
  179.           If Which = Clip_Board Then
  180.               If Trim(sTemp) = "ENDL" Then
  181.                 'function adds item to clipboard and the menu
  182.                  Call AddToClipboard(Clip_Board, sTemp2, mnuItem)
  183.                  sTemp2 = ""
  184.               Else
  185.                   sTemp2 = (sTemp2 & sTemp & vbCrLf)
  186.               End If
  187.           Else
  188.               If Left(Trim(sTemp), 12) = "menucaption:" Then
  189.                  Dim strMnuCaption  As String
  190.                  strMnuCaption = Mid(sTemp, 13, Len(sTemp) - 12)
  191.                  'function adds item to codeblock and the menu
  192.                  Call AddToClipboard(Code_Block, sTemp2, mnuItem, True, strMnuCaption)
  193.                  sTemp2 = ""
  194.               Else
  195.                   sTemp2 = (sTemp2 & sTemp & vbCrLf)
  196.               End If
  197.           End If
  198.           '
  199.           DoEvents
  200.     Loop
  201.   Close #fFile
  202. 'END CODE:
  203. ERR:
  204. End Sub
  205. '----------------------------------------------------------------------
  206. '   INPUTS: |
  207. '  RETURNS: |
  208. ' COMMENTS: |this will remove all items from the menu and mod_clipboard
  209. '----------------------------------------------------------------------
  210. Sub ClearAll(Which As ClipType)
  211. 'VARIABLES:
  212.   Dim i%, iYN%, mnuUpper%
  213.   Dim s$
  214. 'CODE:
  215.   If Which = Clip_Board Then
  216.     'user wants to save the menu items to file
  217.     iYN = MsgBox("Do you wish to save the " & CStr(UBound(mod_Clipboard)) & _
  218.                       " clipboard items ", vbYesNo)
  219.     If iYN = vbYes Then
  220.         Call SaveClipContents(Clip_Board, frmBar.cmDlg)
  221.     End If
  222.     'erase the arr holding the clipboards strings
  223.     Erase mod_Clipboard
  224.     ReDim mod_Clipboard(0)
  225.    'clear the menu items representing the arr
  226.     For i = 1 To frmBar.mnuArrClipboard.UBound
  227.         Unload frmBar.mnuArrClipboard(i)
  228.     Next i
  229.   Else
  230.     'user wants to save the menu items to file
  231.     iYN = MsgBox("Do you wish to save the " & CStr(UBound(mod_CodeBlock)) & _
  232.                       " code block items ")
  233.     If iYN = vbYes Then
  234.        Call SaveClipContents(Clip_Board, frmBar.cmDlg)
  235.     End If
  236.     'erase the array holding the codeblocks
  237.     Erase mod_CodeBlock
  238.     ReDim mod_CodeBlock(0)
  239.    'clear the menu items representing the arr
  240.     For i = 1 To frmBar.mnuArrCode.UBound
  241.         Unload frmBar.mnuArrCode(i)
  242.     Next i
  243.   End If
  244. 'END CODE:
  245. End Sub
  246.  
  247.  
  248. '----------------------------------------------------------------------
  249. '   INPUTS: |
  250. '  RETURNS: |the filepath chosen
  251. ' COMMENTS: |preset basic common dialog settings..used in load clipboard file
  252. '            or save clipboard to file
  253. '----------------------------------------------------------------------
  254. Function CmnDlgReturn(cmDlgName As CommonDialog, bShowOpen As Boolean) As String
  255.    On Error GoTo ERR:
  256. 'CODE::
  257.   With cmDlgName
  258.      .Filter = "Valid text based files(*.txt, *.wpd, *.ini)|*.txt;*.wpd;*.ini"
  259.      .InitDir = "C:\My Documents"
  260.      .Flags = &H2 'warn b4 overwriting
  261.      .CancelError = True
  262.      
  263.      If bShowOpen = True Then
  264.         .ShowOpen
  265.      Else
  266.         .ShowSave
  267.      End If
  268.      '
  269.      CmnDlgReturn = .FileName
  270.   End With
  271. Exit Function
  272. 'END CODE::
  273. ERR:
  274.   If ERR.Number = 32755 Then
  275.      CmnDlgReturn = ""
  276.   End If
  277. End Function
  278.  
  279. Private Sub Class_Initialize()
  280.      ReDim mod_Clipboard(0)
  281.      ReDim mod_CodeBlock(0)
  282. End Sub
  283.