vbAccelerator - Contents of code file: fMain.frm

VERSION 5.00
Begin VB.Form frmGoldfish 
   Caption         =   "Goldfish"
   ClientHeight    =   5535
   ClientLeft      =   2475
   ClientTop       =   2535
   ClientWidth     =   6900
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "fMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5535
   ScaleWidth      =   6900
   Begin pGoldFish.vbalStatusBar sbrMain 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   6
      Top             =   5160
      Width           =   6900
      _ExtentX        =   12171
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   -2147483633
      SimpleStyle     =   0
   End
   Begin pGoldFish.cToolbar tbrEdit 
      Left            =   60
      Top             =   1500
      _ExtentX        =   10081
      _ExtentY        =   661
   End
   Begin VB.PictureBox picDetails 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2595
      Left            =   240
      ScaleHeight     =   2535
      ScaleWidth      =   6255
      TabIndex        =   2
      Top             =   2220
      Width           =   6315
      Begin VB.ComboBox cboTypes 
         Height          =   315
         Left            =   780
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   0
         Width           =   2295
      End
      Begin pGoldFish.vbalRichEdit edtDetails 
         Height          =   2115
         Left            =   0
         TabIndex        =   3
         Top             =   360
         Width           =   6255
         _ExtentX        =   11033
         _ExtentY        =   3731
         Version         =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Lucida Console"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ViewMode        =   1
      End
      Begin VB.Label lblTypes 
         Caption         =   "Types:"
         Height          =   255
         Left            =   60
         TabIndex        =   4
         Top             =   60
         Width           =   1215
      End
   End
   Begin VB.ListBox lstClipboard 
      Height          =   2595
      IntegralHeight  =   0   'False
      Left            =   60
      TabIndex        =   1
      Top             =   1920
      Width           =   6615
   End
   Begin pGoldFish.cToolbar tbrMain 
      Left            =   60
      Top             =   1080
      _ExtentX        =   10081
      _ExtentY        =   661
   End
   Begin pGoldFish.cReBar rbrMain 
      Left            =   60
      Top             =   0
      _ExtentX        =   12091
      _ExtentY        =   1085
   End
   Begin VB.PictureBox picIcon 
      AutoSize        =   -1  'True
      BackColor       =   &H00000000&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   5820
      ScaleHeight     =   435
      ScaleWidth      =   495
      TabIndex        =   0
      Top             =   660
      Visible         =   0   'False
      Width           =   495
      Begin VB.Image imgIcon 
         Height          =   480
         Left            =   0
         Picture         =   "fMain.frx":0442
         Top             =   0
         Width           =   480
      End
   End
   Begin pGoldFish.cToolbar tbrMenu 
      Left            =   60
      Top             =   660
      _ExtentX        =   10081
      _ExtentY        =   661
   End
End
Attribute VB_Name = "frmGoldfish"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function SetWindowTheme Lib "uxtheme.dll" _
   (ByVal hwnd As Long, ByVal pszSubAppName As Long, ByVal pszSubIdList As
    Long) As Long


' Toolbar Menu
Private WithEvents m_cMenu As cPopupMenu
Attribute m_cMenu.VB_VarHelpID = -1

' clipboard support:
Private WithEvents m_cClipView As cClipboardViewer
Attribute m_cClipView.VB_VarHelpID = -1
Private m_cClipboard As cCustomClipboard

' clipboard items to cache:
Private m_cCache() As cClipboardCache
Private m_iCount As Long

' items to make copies of:
Private m_lID() As Long
Private m_iCopyCount As Long

' all posible IDs:
Private m_lFormatID() As Long
Private m_sFormatName() As String
Private m_lFormatCount As Long

' systray interface:
Private WithEvents m_frmSysTray As frmSysTray
Attribute m_frmSysTray.VB_VarHelpID = -1
Private m_bInSysTray As Boolean
Private m_bSysTrayUnload As Boolean

' always on top:
Private m_bAlwaysOnTop As Boolean

' Start in systry:
Private m_bSysTray As Boolean

' toolbar/statusbar:
Private m_bToolbarStandard As Boolean
Private m_bToolbarEdit As Boolean
Private m_bCaptions As Boolean
Private m_bStatusBar As Boolean

' registry access:
Private m_cReg As New cRegistry

' item being copied:
Private m_iCopyItem  As Long

' Initial directory to save to:
Private m_sInitSaveDir As String

' Restrict size of form:
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
Private Const WM_GETMINMAXINFO = &H24

' Subclassing
Implements ISubclass

Public Property Let AlwaysOnTop(ByVal bState As Boolean)
   
   ' set always on top for the form.
   m_bAlwaysOnTop = bState
   If (bState) Then
      SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
       Or SWP_NOACTIVATE
   Else
      SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or
       SWP_NOSIZE Or SWP_NOACTIVATE
   End If
   
End Property
Public Property Get AlwaysOnTop() As Boolean
   AlwaysOnTop = m_bAlwaysOnTop
End Property

Public Sub ParseCommand(ByVal sCommand As String)
Dim sFile As String
Dim sOutFile As String
Dim sChar As String
Dim i As Long
Dim bIsValidCommand As Boolean
Dim bPrint As Boolean

   If (Len(sCommand) > 0) Then
      ' Evaluate whether we are printing or opening:
      If (Left$(sCommand, 2) = "/p/index.html") Then
         ' Print
         If (Len(sCommand) > 4) Then
            sFile = Trim$(Mid$(sCommand, 3))
            bPrint = True
         End If
      Else
         sFile = Trim$(sCommand)
      End If
                  
      If (Len(sFile) > 0) Then
         ' Strip quotes if we have them:
         For i = 1 To Len(sFile)
            sChar = Mid$(sFile, i, 1)
            If (sChar <> """") Then
               sOutFile = sOutFile & sChar
            End If
         Next i
         
         If (Len(sOutFile) > 0) Then
            ' Is it a valid file?
            On Error Resume Next
            sFile = Dir(sOutFile)
            If (Err.Number = 0) And (sFile <> "") Then
               ' We attempt to load it:
               bIsValidCommand = True
               If (pbLoadFile(sFile)) Then
                  If (bPrint) Then
                     pCommandHandler "FILE:PRINT"
                  End If
               End If
            End If
         End If
         
      End If
      
      If Not (bIsValidCommand) Then
         MsgBox "The command line '" & sCommand & "' could not be
          interpreted.", vbInformation
      End If
      
   End If
End Sub

Private Function AddToSysTray()

   ' Add to systray (easy way...)
   If (m_frmSysTray Is Nothing) Then
      Set m_frmSysTray = New frmSysTray
      With m_frmSysTray
         .AddMenuItem "&Open Goldfish...", "SYSTRAY:OPEN", True
         .AddMenuItem "-", "sep1"
         .AddMenuItem "&About Goldfish...", "HELP:ABOUT"
         .AddMenuItem "-", "sep2"
         .AddMenuItem "E&xit", "SYSTRAY:CLOSE"
         .ToolTip = "Goldfish Clipboard Cache"
         .IconHandle = Me.Icon.handle
      End With
   End If
   m_bInSysTray = True
    
End Function
Private Function RemoveFromSysTray()
   
   ' remove systray if we have it:
   If Not (m_frmSysTray Is Nothing) Then
      Unload m_frmSysTray
      Set m_frmSysTray = Nothing
   End If
   m_bInSysTray = False
    
End Function

Public Property Let NumberOfLines(ByVal lLines As Long)
Dim iLine As Long
Dim bMore As Boolean
Dim iFC As Long
    
   ' set number of clipboard items to store:
   If (m_iCount <> lLines) Then
      If (lLines < m_iCount) Then
         ' it is required to set the extra ones to nothing:
         For iLine = lLines + 1 To m_iCount
            Set m_cCache(iLine) = Nothing
         Next iLine
      Else
         bMore = True
         iFC = m_iCount + 1
      End If
      m_iCount = lLines
      ReDim Preserve m_cCache(1 To m_iCount) As cClipboardCache
      If (bMore) Then
         For iLine = iFC To m_iCount
            Set m_cCache(iLine) = New cClipboardCache
            m_cCache(iLine).Order = iLine
         Next iLine
      End If
      For iLine = lstClipboard.ListCount - 1 To 0 Step -1
         If lstClipboard.ItemData(iLine) > m_iCount Then
            lstClipboard.RemoveItem iLine
         End If
      Next iLine
   End If
   
End Property
Public Property Get NumberOfLines() As Long
    NumberOfLines = m_iCount
End Property
Public Property Get InSysTray() As Boolean
    InSysTray = m_bInSysTray
End Property
Public Property Let InSysTray(ByVal bState As Boolean)
    If (bState <> m_bInSysTray) Then
        If (bState) Then
            AddToSysTray
        Else
            RemoveFromSysTray
        End If
    End If
End Property

Public Property Get Clipboard() As cCustomClipboard
    ' Interface to the options form
    Set Clipboard = m_cClipboard
End Property

Public Property Get FormatID(ByVal sName As String) As Long
Dim iFmt As Long
   ' Find the clipboard format ID for a given clipboard format name:
   For iFmt = 1 To m_lFormatCount
      If (m_sFormatName(iFmt) = sName) Then
         FormatID = m_lFormatID(iFmt)
         Exit Property
      End If
   Next iFmt
End Property

Public Property Get DoStoreFormat(ByVal lID As Long) As Boolean
Dim iItem As Long
   ' Interface to the options form
   For iItem = 1 To m_iCopyCount
      If (m_lID(iItem) = lID) Then
         DoStoreFormat = True
         Exit For
      End If
   Next iItem
   
End Property
Public Property Let DoStoreFormat(ByVal lID As Long, ByVal bState As Boolean)
Dim iItem As Long
Dim iIndex As Long
Dim bCurrentState As Long

   ' Interface to the options form
   For iItem = 1 To m_iCopyCount
      If (m_lID(iItem) = lID) Then
         iIndex = iItem
         bCurrentState = True
         Exit For
      End If
   Next iItem
    
   If (bCurrentState <> bState) Then
       If (bState) Then
         ' must add:
         m_iCopyCount = m_iCopyCount + 1
         ReDim Preserve m_lID(1 To m_iCopyCount) As Long
         m_lID(m_iCopyCount) = lID
       Else
         ' must remove:
         If (m_iCopyCount > 1) Then
            For iItem = iIndex + 1 To m_iCopyCount
               m_lID(iItem - 1) = m_lID(iItem)
            Next iItem
            m_iCopyCount = m_iCopyCount - 1
            ReDim Preserve m_lID(1 To m_iCopyCount) As Long
         Else
            m_iCopyCount = 0
            Erase m_lID
         End If
       End If
   End If
    
End Property

Private Sub cboTypes_Click()
Dim lIndex As Long
   ' Show the type chosen in detail view:
   If (cboTypes.ListIndex > -1) Then
      lIndex = lstClipboard.ItemData(lstClipboard.ListIndex)
      m_cCache(lIndex).RenderFormat m_cClipboard, edtDetails,
       cboTypes.ItemData(cboTypes.ListIndex)
   End If
End Sub

Private Function pbLoadOptions(ByRef cR As cRegistry, ByVal hKey As
 ERegistryClassConstants) As Boolean
Dim lWidth As Long
Dim lLeft As Long
Dim lTop As Long
Dim lHeight As Long

   ' Load options from the registry:
    cR.ClassKey = hKey
    cR.SectionKey = "Software\vbaccelerator\Goldfish"
    cR.ValueKey = "EntriesToKeep"
    If (cR.KeyExists) Then
        cR.ValueType = REG_DWORD
        ' Number of entries:
        m_iCount = cR.Value
        If (m_iCount <= 0) Then
            m_iCount = 10
        End If
        If (m_iCount > 512) Then
            m_iCount = 512
        End If
        
        ' Type of entries to store:
         cR.ValueKey = "StoreText"
         cR.Default = -1
         DoStoreFormat(m_lFormatID(1)) = (cR.Value <> 0)
         cR.ValueKey = "StoreRTF"
         cR.Default = -1
         DoStoreFormat(m_lFormatID(2)) = (cR.Value <> 0)
         cR.ValueKey = "StoreHTML"
         cR.Default = 0
         DoStoreFormat(m_lFormatID(3)) = (cR.Value <> 0)
         cR.ValueKey = "StoreCSV"
         cR.Default = 0
         DoStoreFormat(m_lFormatID(4)) = (cR.Value <> 0)
         
        ' Position:
        cR.ValueKey = "Maximised"
        cR.Default = 0
        If (cR.Value <> 0) Then
            Me.WindowState = vbMaximized
        Else
            cR.ValueKey = "Left"
            If (cR.KeyExists) Then
                lLeft = cR.Value
            Else
                lLeft = (Screen.Width - 448 * Screen.TwipsPerPixelX)
            End If
            cR.ValueKey = "Top"
            If (cR.KeyExists) Then
                lTop = cR.Value
            Else
                lTop = (Screen.Height - 315 * Screen.TwipsPerPixelY)
            End If
            cR.ValueKey = "Width"
            If (cR.KeyExists) Then
                lWidth = cR.Value
                If (lWidth < 448 * Screen.TwipsPerPixelX) Then
                    lWidth = 448 * Screen.TwipsPerPixelX
                End If
            Else
                lWidth = 448 * Screen.TwipsPerPixelX
            End If
            cR.ValueKey = "Height"
            If (cR.KeyExists) Then
                lHeight = cR.Value
                If (lHeight < 180 * Screen.TwipsPerPixelY) Then
                    lHeight = 180 * Screen.TwipsPerPixelY
                End If
            Else
                lHeight = 180 * Screen.TwipsPerPixelY
            End If
            If (lLeft + lWidth > Screen.Width - 4 * Screen.TwipsPerPixelX) Then
                lLeft = Screen.Width - lWidth - 4 * Screen.TwipsPerPixelX
            End If
            If (lTop + lHeight > Screen.Height - 4 * Screen.TwipsPerPixelY) Then
                lHeight = Screen.Height - lHeight - 4 * Screen.TwipsPerPixelY
            End If
            Me.Move lLeft, lTop, lWidth, lHeight
         End If
            
         ' Sys Tray:
         cR.ValueKey = "ShowInSysTray"
         cR.Default = -1
         InSysTray = (cR.Value <> 0)
         
         ' Always on top:
         cR.ValueKey = "AlwaysOnTop"
         cR.Default = 0
         m_bAlwaysOnTop = (cR.Value <> 0)
         
         ' Toolbar captions:
         cR.ValueKey = "ToolbarCaptions"
         cR.Default = -1
         m_bCaptions = (cR.Value <> 0)
         
         cR.ValueKey = "StandardToolbar"
         cR.Default = 1
         If cR.Value = 1 Then
            ' Toolbar (v1.0 compatibility mode):
            cR.ValueKey = "Toolbar"
            cR.Default = -1
            m_bToolbarStandard = (cR.Value <> 0)
            m_bToolbarEdit = (cR.Value <> 0)
         Else
            cR.Default = -1
            m_bToolbarStandard = (cR.Value <> 0)
            
            cR.ValueKey = "EditToolbar"
            cR.Default = -1
            m_bToolbarEdit = (cR.Value <> 0)
         End If
         
         ' Status bar:
         cR.ValueKey = "Statusbar"
         cR.Default = -1
         m_bStatusBar = (cR.Value <> 0)
                  
         ' Initial directory to save in:
         cR.ValueKey = "InitSaveDir"
         cR.ValueType = REG_SZ
         cR.Default = App.Path
         m_sInitSaveDir = cR.Value
        
        pbLoadOptions = True
    End If
End Function

Private Function pbSaveOptions(ByRef cR As cRegistry, ByVal hKey As
 ERegistryClassConstants) As Boolean
Dim sPath As String
   ' Save options from the registry:
   cR.ClassKey = hKey
   cR.SectionKey = "Software\vbaccelerator\Goldfish"
   cR.ValueKey = "EntriesToKeep"
   cR.ValueType = REG_DWORD
   cR.Value = m_iCount
   ' Type of entries to store:
   cR.ValueKey = "StoreText"
   cR.Value = CLng(DoStoreFormat(m_lFormatID(1)))
   cR.ValueKey = "StoreRTF"
   cR.Value = CLng(DoStoreFormat(m_lFormatID(2)))
   cR.ValueKey = "StoreHTML"
   cR.Value = CLng(DoStoreFormat(m_lFormatID(3)))
   cR.ValueKey = "StoreCSV"
   cR.Value = CLng(DoStoreFormat(m_lFormatID(4)))
   ' position:
   cR.ValueKey = "Maximised"
   cR.Value = Abs(Me.WindowState = vbMaximized)
   If (Me.WindowState = vbNormal) Then
       cR.ValueKey = "Left"
       cR.Value = CLng(Me.Left)
       cR.ValueKey = "Top"
       cR.Value = CLng(Me.Top)
       cR.ValueKey = "Width"
       cR.Value = CLng(Me.Width)
       cR.ValueKey = "Height"
       cR.Value = CLng(Me.Height)
   End If
   cR.ValueKey = "ShowInSysTray"
   cR.Value = CLng(InSysTray)
   cR.ValueKey = "StandardToolbar"
   cR.Value = CLng(rbrMain.BandVisible(rbrMain.BandIndexForData("ToolbarBand")))
   cR.ValueKey = "EditToolbar"
   cR.Value =
    CLng(rbrMain.BandVisible(rbrMain.BandIndexForData("EditToolbarBand")))

   cR.ValueKey = "ToolbarCaptions"
   cR.Value = CLng(tbrMain.ButtonTextVisible(0))
   cR.ValueKey = "Statusbar"
   cR.Value = CLng(sbrMain.Visible)
   cR.ValueKey = "AlwaysOnTop"
   cR.Value = CLng(m_bAlwaysOnTop)
   cR.ValueKey = "InitSaveDir"
   cR.ValueType = REG_SZ
   cR.Value = m_sInitSaveDir
    
   If (cR.ClassKey = HKEY_LOCAL_MACHINE) Then
      cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\Run"
      cR.ValueKey = "Goldfish"
      cR.ValueType = REG_SZ
      If (InSysTray) Then
          ' add to the auto-start:
          sPath = App.Path
          If (Right$(sPath, 1) <> "\") Then sPath = sPath & "\"
          sPath = sPath & App.EXEName
          cR.Value = sPath
      Else
         ' remove from the auto-start:
          On Error Resume Next
          cR.DeleteValue
          Err.Clear
      End If
   End If
    
End Function

Private Sub Form_Load()
Dim iItem As Long
Dim lID As Long
Dim lIndex As Long
Dim lSubIndex As Long
Dim sFile As String
Dim sPath As String

   ' Initialise the app.
   
   ' 1) start subclassing so we can restrict form size and respond
   '    to command lines form other instances
   AttachMessage Me, Me.hwnd, WM_GETMINMAXINFO
   AttachMessage Me, Me.hwnd, WM_COPYDATA
        
   m_iCount = 10
   sPath = App.Path
   ' What are you doing in the root of the drive anyway?????
   If (Right$(sPath, 1) <> "\") Then sPath = sPath & "\"
   sFile = sPath & App.EXEName & ".Exe" ' Please remember to add the extension!

   Dim cR As New cRegistry
   
   If Not (InDevelopment()) Then
      ' 2) set my App Path entry:
      cR.ClassKey = HKEY_LOCAL_MACHINE
      cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\App Paths"
      cR.ValueKey = ""
      cR.Value = sFile
    
      ' 3) Register my file association:
      cR.CreateEXEAssociation sFile, "Goldfish.ClipboardFile", "Goldfish
       Clipboard Files", "GCF", , True, , , , , , 24
   End If
    
   ' 4) Initialise the clipboard access object:
   Set m_cClipboard = New cCustomClipboard
    
   ' 5) Set up potential formats to store:
   m_lFormatCount = 4
   ReDim m_sFormatName(1 To 4) As String
   ReDim m_lFormatID(1 To 4) As Long
   m_sFormatName(1) = "Text"
   m_lFormatID(1) = CF_TEXT
   DoStoreFormat(CF_TEXT) = True
   m_sFormatName(2) = "Rich Text Format"
   m_lFormatID(2) = m_cClipboard.AddFormat(m_sFormatName(2))
   DoStoreFormat(m_lFormatID(2)) = True
   m_sFormatName(3) = "HTML Format"
   m_lFormatID(3) = m_cClipboard.AddFormat(m_sFormatName(3))
   DoStoreFormat(m_lFormatID(3)) = False
   m_sFormatName(4) = "Csv"
   m_lFormatID(4) = m_cClipboard.AddFormat(m_sFormatName(4))
   DoStoreFormat(m_lFormatID(4)) = False
      
   ' 6) Get options from current users settings if they are present:
   If Not (pbLoadOptions(cR, HKEY_CURRENT_USER)) Then
      ' Otherwise load from local machine (if possible):
      pbLoadOptions cR, HKEY_LOCAL_MACHINE
   End If
    
   ' ------------------
   ' 7) Set up display:
   
   ' Get appropriate toolbar resource (if in Development we load
   ' from file to show what it will look like):
   If (GetDeviceCaps(Me.hdc, BITSPIXEL) > 8) Then
      lID = 101
      sFile = sPath & "gftbar24.bmp"
   Else
      lID = 102
      sFile = sPath & "gftbar24-16.bmp"
   End If
    
   picIcon.Width = imgIcon.Width
      
   ' Set up the main toolbar:
   With tbrMain
      If (InDevelopment) Then
         ' if in development, it helps to see the buttons:
         .ImageSource = CTBLoadFromFile
         .ImageFile = sFile
      Else
         ' otherwise use the internal resources:
         .ImageSource = CTBResourceBitmap
         .ImageResourcehInstance = App.hInstance
         .ImageResourceID = lID
      End If
      .CreateToolbar 24, , True
      .AddButton "Copy (CTRL-C)", 4, , , " Copy ", CTBAutoSize, "EDIT:COPY"
      .AddButton , , , , , CTBSeparator
      .AddButton "Open all From File (CTRL-O)", 25, , , "  Open  ",
       CTBAutoSize, "FILE:OPEN"
      .AddButton "Save all to File  (CTRL-S)", 24, , , "  Save  ", CTBAutoSize,
       "FILE:SAFE"
      .AddButton "Print  (CTRL-P)", 13, , , " Print ", CTBAutoSize, "FILE:PRINT"
      .AddButton , , , , , CTBSeparator
      .AddButton "Show List  (CTRL-L)", 26, , , "  List  ", CTBCheckGroup Or
       CTBAutoSize, "VIEW:LIST"
      .AddButton "Show Details  (CTRL-D)", 27, , , "Details", CTBCheckGroup Or
       CTBAutoSize, "VIEW:DETAILS"
      .AddButton , , , , , CTBSeparator
      .AddButton "Set Options", 30, , , "Configure", CTBAutoSize,
       "VIEW:CONFIGURE"
      .ButtonChecked("list") = True
   End With
   
   ' Set up the clipboard cache editing toolbar:
   With tbrEdit
      If (InDevelopment) Then
         .ImageSource = CTBLoadFromFile
         .ImageFile = sFile
      Else
         .ImageSource = CTBResourceBitmap
         .ImageResourcehInstance = App.hInstance
         .ImageResourceID = lID
      End If
      .CreateToolbar 24, , True
      .AddButton "Previous", 0, , , "Previous Entry", CTBAutoSize,
       "VIEW:PREVIOUS"
      .AddButton "Next", 1, , , "Next Entry", CTBAutoSize, "VIEW:NEXT"
      .AddButton , , , , , CTBSeparator
      .AddButton "Delete (Del)", 9, , , "Delete", CTBAutoSize, "EDIT:DELETE"
      .AddButton "Move Up", 28, , , "Move Up", CTBAutoSize, "EDIT:UP"
      .AddButton "Move Down", 29, , , "Move Down", CTBAutoSize, "EDIT:DOWN"
   End With
   
   ' Build the menu:
   Set m_cMenu = New cPopupMenu
   With m_cMenu
      .hWndOwner = Me.hwnd
      .OfficeXpStyle = True
      lIndex = .AddItem("&File", , , , , , , "FILE:TOP")
      .AddItem "&Open..." & vbTab & "Ctrl+O", , , lIndex, , , , "FILE:OPEN"
      .AddItem "&Save..." & vbTab & "Ctrl+S", , , lIndex, , , , "FILE:SAVE"
      .AddItem "-", , , lIndex, , , , "FILE:SEP1"
      .AddItem "&Print..." & vbTab & "Ctrl+P", , , lIndex, , , , "FILE:PRINT"
      .AddItem "-", , , lIndex, , , , "FILE:SEP2"
      .AddItem "&Close", , , lIndex, , , , "FILE:CLOSE"
      lIndex = .AddItem("&Edit", , , , , , , "EDIT:TOP")
      .AddItem "&Copy" & vbTab & "Ctrl+C", , , lIndex, , , , "EDIT:COPY"
      .AddItem "-", , , lIndex, , , , "EDIT:SEP1"
      .AddItem "&Delete" & vbTab & "Del", , , lIndex, , , , "EDIT:DELETE"
      .AddItem "&Rename...", , , lIndex, , , , "EDIT:RENAME"
      .AddItem "Move U&p", , , lIndex, , , , "EDIT:UP"
      .AddItem "Move Do&wn", , , lIndex, , , , "EDIT:DOWN"
      .AddItem "-", , , lIndex, , , , "EDIT:SEP2)"
      .AddItem "C&lear", , , lIndex, , , , "EDIT:CLEAR"
      lIndex = .AddItem("&View", , , , , , , "VIEW:TOP")
      lSubIndex = .AddItem("&Toolbars", , , lIndex, , , , "VIEW:TOOLBARS")
      .AddItem "&Standard Buttons", , , lSubIndex, , True, , "VIEW:STANDARD"
      .AddItem "&Edit Buttons", , , lSubIndex, , True, , "VIEW:EDIT"
      .AddItem "-", , , lSubIndex, , , , "VIEW:SEP1"
      .AddItem "&Text Labels", , , lSubIndex, , True, , "VIEW:TEXTLABELS"
      .AddItem "&Status Bar", , , lIndex, , True, , "VIEW:STATUSBAR"
      .AddItem "-", , , lIndex, , , , "VIEW:SEP2"
      .AddItem "&Next Item" & vbTab & "Alt+Right Arrow", , , lIndex, , , False,
       "VIEW:NEXT"
      .AddItem "&Previous Item" & vbTab & "Alt+Left Arrow", , , lIndex, , ,
       False, "VIEW:PREVIOUS"
      .AddItem "-", , , lIndex, , , , "VIEW:SEP3"
      .AddItem "&List" & vbTab & "Ctrl+L", , , lIndex, , True, , "VIEW:LIST"
      .AddItem "&Details" & vbTab & "Ctrl+D", , , lIndex, , , , "VIEW:DETAILS"
      .AddItem "-", , , lIndex, , , , "VIEW:SEP4"
      .AddItem "&Configure...", , , lIndex, , , , "VIEW:CONFIGURE"
      lIndex = .AddItem("&Help", , , , , , , "HELP:TOP")
      .AddItem "Contents" & vbTab & "F1", , , lIndex, , , , "HELP:CONTENTS"
      .AddItem "vbAccelerator on the &Web...", , , lIndex, , , , "HELP:VBA"
      .AddItem "-", , , lIndex, , , , "HELP:SEP1"
      .AddItem "&About...", , , lIndex, , , , "HELP:ABOUT"
   End With
   tbrMenu.CreateFromMenu m_cMenu
      On Error Resume Next
      SetWindowTheme tbrMenu.hwnd, StrPtr(""), StrPtr("")
      On Error GoTo 0
   
   
   ' This is only here to help see it during design time:
   picDetails.BorderStyle = 0
   
   ' Set up the rebar:
   rbrMain.CreateRebar Me.hwnd
   rbrMain.AddBandByHwnd tbrMenu.hwnd, , , , "MenuBand"
   rbrMain.AddBandByHwnd tbrMain.hwnd, , True, False, "ToolbarBand"
   rbrMain.AddBandByHwnd tbrEdit.hwnd, , False, False, "EditToolbarBand"
   'rbrMain.AddBandByHwnd picIcon.hwnd, , False, True, "Goldfish"
   rbrMain.BandChevron(1) = False
   rbrMain.BandChevron(2) = False
   ' A favourites bar would be a good idea here.
            
   edtDetails.ReadOnly = True
            
   ' Status bar:
   sbrMain.AddPanel estbrStandard, "Goldfish."
   sbrMain.PanelSpring(1) = True
   sbrMain.AddPanel estbrStandard, ""
   
   ' ------------------

   ' 8) Create objects for caching clipboard memory:
   ReDim m_cCache(1 To m_iCount) As cClipboardCache
   For iItem = 1 To m_iCount
      Set m_cCache(iItem) = New cClipboardCache
      m_cCache(iItem).hWndOwner = Me.hwnd
      m_cCache(iItem).Order = iItem
   Next iItem
   
   ' 9) Initialise the clipboard notification:
   Set m_cClipView = New cClipboardViewer
   ' This will cause the ClipboardChanged notification immediately:
   m_cClipView.InitClipboardChangeNotification Me.hwnd
       
   ' 11) Set the buttons:
   pSetView
   
   ' 12) Tag this window with a property so future instances
   '     will know we are running:
   TagWindow Me.hwnd
    
   ' 13) Set toolbar and status bar states based on saved options:
   If Not (m_bToolbarStandard) Then
      m_cMenu_Click m_cMenu.IndexForKey("VIEW:STANDARD")
   End If
   If Not (m_bToolbarEdit) Then
      m_cMenu_Click m_cMenu.IndexForKey("VIEW:EDIT")
   End If
   If Not (m_bCaptions) Then
      m_cMenu_Click m_cMenu.IndexForKey("VIEW:TEXTLABELS")
   End If
   If Not (m_bStatusBar) Then
      m_cMenu_Click m_cMenu.IndexForKey("VIEW:STATUSBAR")
   End If
    
   ' 14) Show me so we can set always on top:
   Me.Show
   Me.Refresh
   AlwaysOnTop = m_bAlwaysOnTop
    
   ' 15) Command line?
   ParseCommand Command
    
   ' 16) Introduce myself.
   If (InDevelopment) Then ' check if its working :)
      ' Hi everybody.  Hope you enjoy the code and have a beer on me.
      MsgBox "You are running Goldfish in development mode." & vbCrLf & vbCrLf
       & "There may be an error during Form Unload " & vbCrLf & "(trapped in
       EXE or set Toggle->Break on Unhandled Errors in VB).", vbInformation
   End If
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim iItem As Long
Dim cR As New cRegistry

   ' Check for whether we are in systray or not to see whether to cancel
    unloading.
   ' If we are unloading for a dramatic reason, then do it regardless:
   If (UnloadMode <> vbAppWindows) And (UnloadMode <> vbAppTaskManager) Then
      If (m_bInSysTray) Then
         If Not (m_bSysTrayUnload) Then
            ' In SysTray and not unloading from SysTray so just hide.
            Me.Hide
            Cancel = True
            Exit Sub
         End If
      End If
   End If
    
   ' Save options:
   pbSaveOptions cR, HKEY_CURRENT_USER
   pbSaveOptions cR, HKEY_LOCAL_MACHINE
   ' Clear up:
   ' a) From SysTray:
   RemoveFromSysTray
   ' b) From Clipboard notifications:
   m_cClipView.StopClipboardChangeNotification
   Set m_cClipView = Nothing
   ' c) Clear up clipboard object:
   Set m_cClipboard = Nothing
   ' d) Free any memory we're using up to store clipboard objects:
   For iItem = 1 To m_iCount
       m_cCache(iItem).ClearUp
       Set m_cCache(iItem) = Nothing
   Next iItem
   Erase m_cCache
   ' e) Ensure the Rebar will unload happily:
   rbrMain.RemoveAllRebarBands
   ' f) Clear up the status bar object:
   
   ' g) Stop subclassing for form resizing and commands sent from
   '    another instance:
   DetachMessage Me, Me.hwnd, WM_GETMINMAXINFO
   DetachMessage Me, Me.hwnd, WM_COPYDATA
   ' h) Ensure no other instances think I'm running:
   EndApp
   
   ' bye!!!

End Sub

Private Sub Form_Resize()
Dim lT As Long
Dim lH As Long
Dim lW As Long
   
   ' Resize:
   rbrMain.RebarSize
   lT = rbrMain.RebarHeight * Screen.TwipsPerPixelY
   lH = Me.ScaleHeight - lT - 4 * Screen.TwipsPerPixelY + sbrMain.Height *
    sbrMain.Visible
   lW = Me.ScaleWidth
   If (lH > 0) And (lW > 0) Then
      lstClipboard.Move 0, lT + 2 * Screen.TwipsPerPixelX, lW, lH
      With lstClipboard
         picDetails.Move .Left, .Top, .Width, .Height
      End With
      lH = lH - edtDetails.Top
      If (lH > 0) Then
         edtDetails.Move 0, edtDetails.Top, picDetails.ScaleWidth, lH
      End If
   End If
End Sub

Private Function GetNextClipboardCache() As Long
Dim iCache As Long
Dim iMaxCache As Long

   ' Find the next object to store clipboard information in:
   For iCache = 1 To m_iCount
      If (m_cCache(iCache).Order = m_iCount) Then
         iMaxCache = iCache
         Exit For
      End If
   Next iCache
        
   For iCache = 1 To m_iCount
      If (iCache <> iMaxCache) Then
         If (m_cCache(iCache).Order <> 0) Then
            m_cCache(iCache).Order = m_cCache(iCache).Order + 1
         End If
      Else
         m_cCache(iCache).Order = 1
         m_cCache(iCache).Used = True
      End If
   Next iCache
    
   GetNextClipboardCache = iMaxCache
   Debug.Print "MaxCache:", iMaxCache, m_cCache(iMaxCache).Order
    
End Function

Private Property Let ISUbClass_MsgResponse(ByVal RHS As EMsgResponse)
   ' This shouldn't really be in SSUBTMR.
   ' In fact, SSUBTMR should have a BeforeMessage and AfterMessage
   ' function if it was going to be easier to use.
   ' Sometime....
End Property

Private Property Get ISUbClass_MsgResponse() As EMsgResponse
   ' This will tell you which message you are responding to:
   If (CurrentMessage = WM_GETMINMAXINFO) Then
      ' Tell the subclasser what to do for this message (here we do all
       processing):
      ISUbClass_MsgResponse = emrConsume
   Else
      ' WM_COPYDATA, send response after we've done with it:
      ISUbClass_MsgResponse = emrPostProcess
   End If
   
End Property

Private Function ISUbClass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
Dim mmiT As MINMAXINFO
Dim tCDS As COPYDATASTRUCT
Dim b() As Byte
Dim sCommand As String

   Select Case iMsg
   Case WM_GETMINMAXINFO
      ' Copy parameter to local variable for processing
      CopyMemory mmiT, ByVal lParam, LenB(mmiT)
      
      ' Minimium width and height for sizing
      mmiT.ptMinTrackSize.x = 377
      mmiT.ptMinTrackSize.y = 174
          
      ' Copy modified results back to parameter
      CopyMemory ByVal lParam, mmiT, LenB(mmiT)
   
   Case WM_COPYDATA
      ' Copy for processing:
      CopyMemory tCDS, ByVal lParam, Len(tCDS)
      If (tCDS.cbData > 0) Then
         ReDim b(0 To tCDS.cbData - 1) As Byte
         CopyMemory b(0), ByVal tCDS.lpData, tCDS.cbData
         sCommand = StrConv(b, vbUnicode)
         
         ' We've got the info, now do it:
         ParseCommand sCommand
      Else
         ' We are invisible, i.e. in SysTray
         If Me.Visible = False Then
            m_frmSysTray_MenuClick 0, "open"
         End If
         
      End If
      
   End Select
   
End Function

Private Sub lstClipboard_Click()
Dim iCache As Long
Dim bSel As Boolean
Dim bState As Boolean
   
   ' set up available types in detail view:
   If (lstClipboard.ListIndex > -1) Then
      iCache = lstClipboard.ItemData(lstClipboard.ListIndex)
      m_cCache(iCache).ShowFormats m_cClipboard, cboTypes
      bSel = True
   End If
   pEnableForListSelection
   
End Sub

Private Sub lstClipboard_DblClick()
   ' Equivalent to choosing Details:
   If (lstClipboard.ListIndex > -1) Then
      m_cMenu_Click m_cMenu.IndexForKey("VIEW:DETAILS")
   End If
End Sub

Private Sub m_cClipView_ClipboardChanged()
Dim iFmt As Long
Dim lCount As Long
Dim iClipFmt As Long
Dim lID As Long
Dim lIndex As Long

On Error GoTo ClipboardError

   ' load the latest clipboard data:
   Debug.Print "Clipboard has changed"
   If (m_iCopyItem = 0) Then
    
      With m_cClipboard
         lCount = .GetCurrentFormats(Me.hwnd)
         m_cClipboard.ClipboardOpen Me.hwnd
         If (lCount > 0) Then
            For iClipFmt = 1 To lCount
                lID = .GetCurrentFormatID(iClipFmt)
                For iFmt = 1 To m_iCopyCount
                    If (m_lID(iFmt) = lID) Then
                        Debug.Print "Storing clipboard data with format " &
                         .FormatName(lID)
                        ' We want to copy this item:
                        If lIndex = 0 Then
                            lIndex = GetNextClipboardCache()
                            Debug.Print "Storing in cache " & lIndex
                        End If
                        m_cCache(lIndex).CacheItem
                         m_cClipboard.GetClipboardMemoryHandle(lID), lID
                        Exit For
                    End If
                Next iFmt
            Next iClipFmt
         End If
         m_cClipboard.ClipboardClose
      End With
        
      RenderCache
        
   Else
      m_iCopyItem = 0
   End If
   pSetView
    
   Exit Sub
   
ClipboardError:
   '
   ' *** Generally can't open clipboard.  Not a problem as this
   ' doesn't seem to occur when there is something useful in there! ***
   '
   ' An example of this type of error is when VB IDE loads and you
   ' have an add-in.
   '
   ' This occurs because VB Add-ins generally have to use the ridiculous
   ' PasteFace method to set up a button on the toolbar.
   '
   Exit Sub
End Sub
Private Sub RenderCache()
Dim iCache As Long
Dim iOrder As Long
Dim lListIndex As Long

   ' Display what's currently in the list of clipboard items:
   lstClipboard.Visible = False
   lListIndex = lstClipboard.ListIndex
   lstClipboard.Clear
   For iOrder = 1 To m_iCount
      For iCache = 1 To m_iCount
         If (m_cCache(iCache).Order = iOrder) And (m_cCache(iCache).Used) Then
            Debug.Print "Cache Item " & iCache & " has order " & iOrder
            lstClipboard.AddItem m_cCache(iCache).RenderString
            lstClipboard.ItemData(lstClipboard.NewIndex) = iCache
            Exit For
         End If
      Next iCache
   Next iOrder
   If (lListIndex <> -1) Then
       If (lListIndex + 1) >= lstClipboard.ListCount Then
           lstClipboard.ListIndex = lstClipboard.ListCount - 1
       Else
           lstClipboard.ListIndex = lListIndex + 1
       End If
   Else
      If (lstClipboard.ListCount > 0) Then
         lstClipboard.ListIndex = 0
      Else
         pSetView
      End If
   End If
   lstClipboard.Visible = True
End Sub
Private Sub pSetView()
Dim bSel As Boolean
Dim bSomething As Boolean
    
   ' Set toolbar and menus to reflect what we have stored:
   
   If (lstClipboard.ListCount > 0) Then
       bSomething = True
   End If
   If (bSomething) Then
       If (lstClipboard.ListIndex <> -1) And (cboTypes.ListCount > 0) Then
           bSel = True
       End If
   End If
   If (m_cMenu.Checked(m_cMenu.IndexForKey("VIEW:LIST"))) Then
      lstClipboard.Visible = True
      picDetails.Visible = False
      tbrMain.ButtonEnabled("FILE:OPEN") = True
      tbrMain.ButtonToolTip("FILE:SAVE") = "Save Clipboard list (CTRL-S)"
      tbrMain.ButtonToolTip("FILE:PRINT") = "Print Clipboard list (CTRL-P)"
   Else
      picDetails.Visible = True
      lstClipboard.Visible = False
      tbrMain.ButtonEnabled("FILE:OPEN") = False
      tbrMain.ButtonToolTip("FILE:SAVE") = "Save This Item (CTRL-S)"
      tbrMain.ButtonToolTip("FILE:PRINT") = "Print This Item (CTRL-P)"
   End If
   tbrMain.ButtonEnabled("EDIT:COPY") = bSel
   m_cMenu.Enabled(m_cMenu.IndexForKey("EDIT:COPY")) = bSel
   tbrMain.ButtonEnabled("FILE:SAVE") = bSomething
   m_cMenu.Enabled(m_cMenu.IndexForKey("FILE:SAVE")) = bSel
   tbrMain.ButtonEnabled("FILE:PRINT") = bSomething
   m_cMenu.Enabled(m_cMenu.IndexForKey("FILE:PRINT")) = bSel
   tbrMain.ButtonEnabled("VIEW:DETAILS") = bSel
   m_cMenu.Enabled(m_cMenu.IndexForKey("VIEW:DETAILS")) = bSel
   tbrEdit.ButtonEnabled("delete") = bSel
   m_cMenu.Enabled(m_cMenu.IndexForKey("EDIT:DELETE")) = bSel
   m_cMenu.Enabled(m_cMenu.IndexForKey("EDIT:RENAME")) = bSel
   
   pEnableForListSelection
   
End Sub

Private Sub m_cMenu_Click(ItemNumber As Long)
Dim sKey As String
Dim iPos As Long
Dim iNextPos As Long
Dim iIdx As Integer
Dim sMenu As String

   If ItemNumber > 0 Then
      sKey = m_cMenu.ItemKey(ItemNumber)
      pCommandHandler sKey
   End If
End Sub

Private Sub m_frmSysTray_MenuClick(ByVal lIndex As Long, ByVal sKey As String)
   pCommandHandler sKey
End Sub

Private Sub m_frmSysTray_SysTrayDoubleClick(ByVal eButton As
 MouseButtonConstants)
   ' Systray interface:
   If (eButton = vbLeftButton) Then
      Me.Show
      Me.ZOrder
   End If
End Sub

Private Sub m_frmSysTray_SysTrayMouseUp(ByVal eButton As MouseButtonConstants)
   ' Systry interface:
   If (eButton = vbRightButton) Then
      m_frmSysTray.ShowMenu
   End If
End Sub



Private Sub pSaveDetail()
Dim sPath As String
Dim sName As String
Dim iFilterIndex As Long
Dim sTitle As String
Dim iPos As Long
Dim eType As ERECFileTypes
Dim sExt As String
Dim iIndex As Long
    
   ' Saves the currently selected detail item out
   ' to a file.
    
   Dim cc As New cCommonDialog
    
   iIndex = lstClipboard.ItemData(lstClipboard.ListIndex)
   sName = m_cCache(iIndex).Filename
   iFilterIndex = 1
   If cc.VBGetSaveFileName(sName, sTitle, True, "Rich Text Document
    (*.RTF)|*.RTF|Text Document (*.TXT)|*.TXT|All FIles (*.*)|*.*",
    iFilterIndex, m_sInitSaveDir, "Choose Location to Save Document to", "RTF",
    Me.hwnd, OFN_PATHMUSTEXIST) Then
      If (sName <> "") Then
         iPos = InStr(sName, sTitle)
         If (iPos <> 0) Then
            m_sInitSaveDir = Left$(sName, (iPos - 1))
         End If
        
         If iFilterIndex = 1 Then
            eType = SF_RTF
         ElseIf iFilterIndex = 2 Then
            eType = SF_TEXT
         Else
            ' check extension:
            For iPos = Len(sTitle) To 1 Step -1
               If (Mid$(sTitle, iPos, 1) = ".") Then
                  sExt = UCase$(Mid$(sTitle, iPos + 1))
               End If
            Next iPos
            Select Case sExt
            Case "TXT"
               eType = SF_TEXT
            Case Else
               eType = SF_RTF
            End Select
         End If
         KillFileCacheInfo sName
         edtDetails.SaveToFile sName, eType
         ReplaceFileAttributes
      End If
   End If
    
End Sub

Private Sub rbrMain_HeightChanged(lNewHeight As Long)
   ' ensure form looks right for new rebar height:
   imgIcon.Top = (lNewHeight * Screen.TwipsPerPixelY - imgIcon.Height) \ 2
   Form_Resize
End Sub



Private Sub tbrEdit_ButtonClick(ByVal lButton As Long)
   pCommandHandler tbrEdit.ButtonKey(lButton)
End Sub

Private Sub tbrMain_ButtonClick(ByVal lButton As Long)
   pCommandHandler tbrMain.ButtonKey(lButton)
End Sub

Private Sub pSerialiseList()
Dim sFileName As String
Dim iFile As Long
Dim i As Long
Dim lIndex As Long

On Error GoTo ErrorHandler

   ' Saves the entire contents of Goldfish to a binary file.
   ' Undocumented file format, and a bit nasty.  If you were doing
   ' this for real and IE5 is available, perhaps consider using XML instead.

   Dim cc As New cCommonDialog
   If cc.VBGetSaveFileName(sFileName, , , "Goldfish Clipboard Files
    (*.CCF)|*.GCF|All Files (*.*)|*.*", 1, , , "CCF", Me.hwnd) Then
      KillFileCacheInfo sFileName
      iFile = FreeFile
      Open sFileName For Binary Access Write As #iFile
      Put #iFile, , "GOLDFISH.CLIPBOARDFI02"
      Put #iFile, , 4
      For i = 1 To 4
         Put #iFile, , m_lFormatID(i)
      Next i
      For i = 1 To lstClipboard.ListCount
         lIndex = lstClipboard.ItemData(i - 1)
         m_cCache(lIndex).Serialise iFile
      Next i
      Close #iFile
      ReplaceFileAttributes
      iFile = 0
   End If
   Exit Sub

ErrorHandler:
   MsgBox "An error occurred whilst trying to save the clipboard list:" &
    vbCrLf & Err.Description, vbExclamation
   If iFile <> 0 Then
      Close #iFile
   End If
   iFile = 0
   Exit Sub

End Sub
Private Sub pDeserialiseList()
Dim sFileName As String

   ' The reverse of pSerialiseList.

   Dim cc As New cCommonDialog
   If cc.VBGetOpenFileName(sFileName, , , , , , "Goldfish Clipboard Files
    (*.GCF)|*.GCF|All Files (*.*)|*.*", 1, , , "CCF", Me.hwnd) Then
      pbLoadFile sFileName
   End If
   
End Sub
Private Sub pEnableForListSelection()
Dim bState As Boolean
Dim bSel As Boolean

   ' Set up which buttons you can click:
   bState = (lstClipboard.ListIndex > 0)
   tbrEdit.ButtonEnabled("EDIT:UP") = bState
   m_cMenu.Enabled(m_cMenu.IndexForKey("EDIT:UP")) = bState
   tbrEdit.ButtonEnabled("VIEW:NEXT") = bState
   m_cMenu.Enabled(m_cMenu.IndexForKey("VIEW:NEXT")) = bState

   bState = (lstClipboard.ListIndex < lstClipboard.ListCount - 1)
   tbrEdit.ButtonEnabled("EDIT:DOWN") = bState
   m_cMenu.Enabled(m_cMenu.IndexForKey("EDIT:DOWN")) = bState
   tbrEdit.ButtonEnabled("VIEW:PREVIOUS") = bState
   m_cMenu.Enabled(m_cMenu.IndexForKey("VIEW:PREVIOUS")) = bState
End Sub
Private Sub pDelete()
Dim iOrder As Long
Dim iCache As Long
Dim iThisItem As Long
Dim iMaxOrder As Long
   iOrder = lstClipboard.ListIndex + 1
   For iCache = 1 To m_iCount
      If (m_cCache(iCache).Order = iOrder) Then
         iThisItem = iCache
      ElseIf (m_cCache(iCache).Order > iOrder) Then
         If (m_cCache(iCache).Order > iMaxOrder) Then
            iMaxOrder = m_cCache(iCache).Order
         End If
         m_cCache(iCache).Order = m_cCache(iCache).Order - 1
      End If
   Next iCache
   Debug.Assert (iThisItem <> 0)
   If (iThisItem > 0) Then
      m_cCache(iThisItem).Order = iMaxOrder
      m_cCache(iThisItem).ClearUp
   End If
   RenderCache
   pSetView

End Sub
Private Sub pRename()
Dim sName As String
   ' rename:
   If (lstClipboard.ListIndex < 0) Then
      MsgBox "Please choose an item to rename.", vbInformation
   Else
      sName = InputBox$("Enter a new title for this clipboard entry:", ,
       m_cCache(lstClipboard.ItemData(lstClipboard.ListIndex)).RenderString)
      If (sName <> "") Then
         m_cCache(lstClipboard.ItemData(lstClipboard.ListIndex)).RenderString =
          sName
         RenderCache
         pSetView
      End If
   End If

End Sub
Private Sub pMoveItem(ByVal bUp As Boolean)
Dim iOrder As Long
Dim iCache As Long
Dim iThisItem As Long
Dim iSwapItem As Long
   If (bUp) Then
      iOrder = lstClipboard.ListIndex + 1
      For iCache = 1 To m_iCount
         If (m_cCache(iCache).Order = iOrder) Then
            iThisItem = iCache
         ElseIf (m_cCache(iCache).Order = iOrder - 1) Then
            iSwapItem = iCache
         End If
      Next iCache
      If (iThisItem > 0) And (iSwapItem > 0) Then
         m_cCache(iThisItem).Order = m_cCache(iSwapItem).Order
         m_cCache(iSwapItem).Order = iOrder
         RenderCache
         lstClipboard.ListIndex = m_cCache(iThisItem).Order - 1
      End If
   Else
      iOrder = lstClipboard.ListIndex + 1
      For iCache = 1 To m_iCount
         If (m_cCache(iCache).Order = iOrder) Then
            iThisItem = iCache
         ElseIf (m_cCache(iCache).Order = iOrder + 1) Then
            iSwapItem = iCache
         End If
      Next iCache
      If (iThisItem > 0) And (iSwapItem > 0) Then
         m_cCache(iThisItem).Order = m_cCache(iSwapItem).Order
         m_cCache(iSwapItem).Order = iOrder
         RenderCache
      End If
   End If
End Sub
Private Sub pCommandHandler(ByVal sKey As String)
Dim iItem As Long
Dim iCache As Long
Dim bS As Boolean
Dim bState As Boolean
Dim lIndex As Long

   Select Case sKey
   Case "FILE:OPEN"
      pDeserialiseList
   Case "FILE:SAVE"
      If (m_cMenu.Checked(m_cMenu.IndexForKey("VIEW:DETAILS"))) Then
          ' detail view
          pSaveDetail
      Else
          ' list view
          pSerialiseList
      End If
   Case "FILE:PRINT"
      edtDetails.PrintDoc "Clipboard document " &
       Trim$(lstClipboard.List(lstClipboard.ListIndex))
   Case "FILE:CLOSE"
      Unload Me

   Case "EDIT:COPY"
         If m_cMenu.Checked(m_cMenu.IndexForKey("VIEW:LIST")) Then
         If (lstClipboard.ListIndex > -1) Then
            iCache = lstClipboard.ItemData(lstClipboard.ListIndex)
            m_cCache(iCache).Copy m_cClipboard
         End If
      Else
         If edtDetails.SelectedText <> "" Then
            edtDetails.Copy
         End If
      End If
   Case "EDIT:RENAME"
      pRename
   Case "EDIT:UP"
      pMoveItem True
   Case "EDIT:DOWN"
      pMoveItem False
   Case "EDIT:DELETE"
      pDelete
   Case "EDIT:CLEAR"
      ' clear
      For iItem = 1 To m_iCount
          m_cCache(iItem).ClearUp
          m_cCache(iItem).Order = iItem
      Next iItem
      RenderCache
      pSetView

   Case "VIEW:STANDARD"
      ' Standard bar off:
      lIndex = m_cMenu.IndexForKey("VIEW:STANDARD")
      bState = Not (m_cMenu.Checked(lIndex))
      m_cMenu.Checked(lIndex) = bState
      rbrMain.BandVisible(rbrMain.BandIndexForData("ToolbarBand")) = bState
   Case "VIEW:EDIT"
      ' Edit bar off
      lIndex = m_cMenu.IndexForKey("VIEW:EDIT")
      bState = Not (m_cMenu.Checked(lIndex))
      m_cMenu.Checked(lIndex) = bState
      rbrMain.BandVisible(rbrMain.BandIndexForData("EditToolbarBand")) = bState
   Case "VIEW:TEXTLABELS"
      lIndex = m_cMenu.IndexForKey("VIEW:TEXTLABELS")
      bState = Not (m_cMenu.Checked(lIndex))
      m_cMenu.Checked(lIndex) = bState
      tbrMain.ButtonTextVisible(0) = bState
      tbrEdit.ButtonTextVisible(0) = bState
      rbrMain.BandChildResized rbrMain.BandIndexForData("ToolbarBand"),
       tbrMain.ToolbarWidth, tbrMain.ToolbarHeight
      rbrMain.BandChildResized rbrMain.BandIndexForData("EditToolbarBand"),
       tbrEdit.ToolbarWidth, tbrEdit.ToolbarHeight
   Case "VIEW:STATUSBAR"
      bState = Not (m_cMenu.Checked(m_cMenu.IndexForKey("VIEW:STATUSBAR")))
      m_cMenu.Checked(m_cMenu.IndexForKey("VIEW:STATUSBAR")) = bState
      sbrMain.Visible = bState
      Form_Resize

   Case "VIEW:PREVIOUS"
      If (lstClipboard.ListIndex < lstClipboard.ListCount) Then
         lstClipboard.ListIndex = lstClipboard.ListIndex + 1
      End If
   Case "VIEW:NEXT"
      If (lstClipboard.ListIndex > 0) Then
         lstClipboard.ListIndex = lstClipboard.ListIndex - 1
      End If

   Case "VIEW:LIST"
      m_cMenu.Checked(m_cMenu.IndexForKey("VIEW:LIST")) = True
      m_cMenu.Checked(m_cMenu.IndexForKey("VIEW:DETAILS")) = False
      tbrMain.ButtonChecked("VIEW:LIST") = True
      tbrMain.ButtonChecked("VIEW:DETAILS") = False
      pSetView
   Case "VIEW:DETAILS"
      m_cMenu.Checked(m_cMenu.IndexForKey("VIEW:LIST")) = False
      m_cMenu.Checked(m_cMenu.IndexForKey("VIEW:DETAILS")) = True
      tbrMain.ButtonChecked("VIEW:LIST") = False
      tbrMain.ButtonChecked("VIEW:DETAILS") = True
      pSetView
   Case "VIEW:CONFIGURE"
      Dim fc As New frmOptions
      fc.OwnerForm = Me
      fc.Show vbModal, Me

   
   Case "HELP:CONTENTS"
      ' help contents...
       MsgBox "The help file for this application is not installed on your
        system." & vbCrLf & vbCrLf & "This isn't entirely surprising because it
        hasn't been written ;)", vbInformation
   Case "HELP:VBA"
      ' Shell vbAccelerator:
      On Error Resume Next
      ShellEx "/index.html", , , , , Me.hwnd
      If (Err.Number <> 0) Then
          MsgBox "Sorry, I failed to open the web site
           '/index.html' due to an error." & vbCrLf & vbCrLf & "["
           & Err.Description & "]", vbExclamation
      End If
   Case "HELP:ABOUT"
      ' If we're going to show a modal form, better make sure we're
      ' not TOPMOST first:
      bS = AlwaysOnTop
      If (bS) Then
         AlwaysOnTop = False
      End If
      frmAbout.Show vbModal, Me
      If (bS) Then
         AlwaysOnTop = True
      End If
   
   Case "SYSTRAY:OPEN"
      Me.Show
      Me.ZOrder
   Case "SYSTRAY:CLOSE"
      m_bSysTrayUnload = True
      Unload Me
   End Select

End Sub
Private Function pbLoadFile(ByVal sFile As String) As Boolean
Dim iFile As Long
Dim i As Long
Dim lIndex As Long
Dim sIdentifier As String
Dim iVersion As Long
Dim lFmtMap() As Long
Dim lFmtCount As Long
   
On Error GoTo ErrorHandler
   
   iFile = FreeFile
   Open sFile For Binary Access Read As #iFile
   sIdentifier = Space$(Len("GOLDFISH.CLIPBOARDFILE"))
   Get #iFile, , sIdentifier
   If (sIdentifier = "GOLDFISH.CLIPBOARDFILE") Then
      ' A version 1 clipboard file
      iVersion = 1
      ReDim lFmtMap(1 To 2, 1 To 4) As Long
   ElseIf (sIdentifier = "GOLDFISH.CLIPBOARDFI02") Then
      ' Version 2 clipboard file (works!)
      iVersion = 2
      Get #iFile, , lFmtCount ' For future expansion
      ReDim lFmtMap(1 To 2, 1 To lFmtCount) As Long
      For i = 1 To lFmtCount
         Get #iFile, , lFmtMap(1, i)
      Next i
      If lFmtCount < 4 Then
         ReDim Preserve lFmtMap(1 To 2, 1 To 4) As Long
      End If
   End If
   
   If iVersion > 0 Then
      For i = 1 To m_iCopyCount
         lFmtMap(2, i) = m_lFormatID(i)
      Next i
      If iVersion = 1 Then
         lFmtMap(1, 1) = CF_TEXT
         lFmtMap(2, 1) = CF_TEXT
      End If
   
      i = 1
      Do While Not EOF(iFile)
         lIndex = GetNextClipboardCache()
         m_cCache(lIndex).InitFormatMapping lFmtMap(), 4
         m_cCache(lIndex).Deserialise iFile
      Loop
      Close #iFile
      iFile = 0
      
      RenderCache
      pSetView
      
      pbLoadFile = True
   Else
      Close #iFile
      iFile = 0
      MsgBox "The file '" & sFile & "' is not a valid Goldfish clipboard
       file.", vbInformation
   End If
   Exit Function

ErrorHandler:
   MsgBox "An error occurred whilst trying to read this file:" & vbCrLf &
    Err.Description, vbExclamation
   If (iFile <> 0) Then
      Close #iFile
   End If
   iFile = 0
   ' Clear any contents:
   pCommandHandler "EDIT:CLEAR"
   Exit Function
End Function