home *** CD-ROM | disk | FTP | other *** search
- '------------------------------------------------------------------------
- '-- DDEPM.BAS - Copyright (c) 1993 Gregg S. Irwin
- '
- '-- You may use, modify, reproduce and distribute this module (and/or
- ' any modified version) in any way you find useful. It is provided as
- ' is and no warranties of any kind whatsoever are provided. It is not
- ' a completed product, just a starting point to get you going.
- '
- '-- If you make any modicfications or post updated versions please leave
- ' this message in place and add your own name and comments as well as
- ' what changes were made. If you do update it please send me a note or
- ' a copy about what you're doing with it, that helps make the effort
- ' worthwhile.<g> If you have questions or comments you can reach me at
- ' CIS:ID[72450,676]. Enjoy!
- '
- '-- Date Version Author Notes
- '------------------------------------------------------------------------
- ' 09/09/93 1.00 Gregg S. Irwin Thanks to Thomas R. Goulding for his feedback
- ' and Hot-Key detecitve work.
- '
- '------------------------------------------------------------------------
- Option Explicit
- DefInt A-Z
-
-
- Type T_ProgManGroupItem
- Name As String
- CmdLine As String
- IconPath As String
- IconIndex As Integer
- xPos As Integer
- yPos As Integer
- DefaultDir As String
- HotKey As Integer
- RunMinimized As Integer
- End Type
-
-
- Global Const HOTKEY_MOD_SHIFT = &H100
- Global Const HOTKEY_MOD_CTRL = &H200
- Global Const HOTKEY_MOD_ALT = &H400
-
- ' Used by ParseString
- Global Const ERR_ITEMS_TRUNCATED = -2
-
- '---------------------------------------------------
- '-- Comment out the lines below if you have them
- ' declared in another module in your application.
- '---------------------------------------------------
- Global Const NONE = 0
-
- ' Message Box
- Global Const MB_OK = 0
-
- ' MousePointer
- Global Const DEFAULT = 0 ' 0 - Default
- Global Const HOURGLASS = 11 ' 11 - Hourglass
-
- ' LinkMode (forms and controls)
- Global Const LINK_NONE = 0 ' 0 - None
- Global Const LINK_SOURCE = 1 ' 1 - Source (forms only)
- Global Const LINK_AUTOMATIC = 1 ' 1 - Automatic (controls only)
- Global Const LINK_MANUAL = 2 ' 2 - Manual (controls only)
- Global Const LINK_NOTIFY = 3 ' 3 - Notify (controls only)
-
- Sub ddepmAddItem (lblLink As Label, CmdLine$, ItemName$)
- '-----------------------------------------------------------
- '-- This is the basic version. ddepmAddItemExt gives you
- ' more options but you may never use them so why make it
- ' any harder than it should be? Oh Yeah, its purpose is
- ' to add an icon to an existing ProgMan group.
- '
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' CmdLine$ A string that contains the
- ' command line for the item/icon.
- ' i.e. "c:\myapp\setup.exe"
- ' ItemName$ A string that contains the item's
- ' caption.
- '-----------------------------------------------------------
- Dim ddeCmd$
-
- ddeCmd$ = "[AddItem(" & CmdLine$ + "," & ItemName$ & ")]"
- Call ddepmExecute(lblLink, ddeCmd$)
-
-
- End Sub
-
- Sub ddepmAddItemExt (lblLink As Label, CmdLine$, ItemName$, IconPath$, IconIndex%, xPos%, yPos%, DefaultDir$, HotKey%, RunMinimized%)
- '------------------------------------------------------------
- '-- This is the extended version of ddepmAddItem. This
- ' version allows you to use all the parameters supported
- ' by the AddItem command.
- '
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' CmdLine$ A string that contains the
- ' command line for the item/icon.
- ' i.e. "c:\myapp\setup.exe"
- ' ItemName$ A string that contains the item's
- ' caption.
- ' IconPath$ Identifies the Filename for the
- ' Icon to be displayed in the
- ' group window.
- ' IconIndex% Specifies the Index of the Icon
- ' in the file identified by the
- ' IconPath$ parameter.
- ' xPos% Specifies the horizontal position
- ' of the Icon in the group window
- ' yPos% Specifies the vertical position
- ' of the Icon in the group window
- ' DefaultDir$ Specifies the working directory
- ' HotKey% Identifies a hot-key that is
- ' specified by the user. Note that
- ' this is an Integer. It's the Ascii
- ' value of the HotKey.
- ' RunMinimized% Specifies whether an application
- ' window should be minimized when
- ' it is first displayed.
- '------------------------------------------------------------
- Dim ddeCmd$
-
- ddeCmd$ = "[AddItem(" & CmdLine$ & "," & ItemName$ & ","
- ddeCmd$ = ddeCmd$ & IconPath$ & "," & IconIndex% & ","
- ddeCmd$ = ddeCmd$ & xPos% & "," & yPos% & ","
- ddeCmd$ = ddeCmd$ & DefaultDir$ & "," & HotKey% & ","
- ddeCmd$ = ddeCmd$ & RunMinimized% & ")]"
-
- Call ddepmExecute(lblLink, ddeCmd$)
-
- End Sub
-
- Sub ddepmAddItemExtT (lblLink As Label, tItem As T_ProgManGroupItem)
- '-----------------------------------------------------------
- '-- This is the Type'd version of ddepmAddItemExt. The Type
- ' definition in the declarations section covers all the
- ' parameters you need for a ProgMan Item. This is just an
- ' idea that may help if you have a bunch of items, maybe
- ' in a setup INI file, and you want to grab them into an
- ' array of Type variables so you can just loop through
- ' that array to add all the items. If you think it's
- ' useless go ahead and yank it(and the associated
- ' pmItemCmdLineFromTypeVar procedure). Oh yeah, if you're
- ' creating a bunch of items then it will also be a whole
- ' lot more efficient to pass a Type Variable as opposed to
- ' all those parameters.
- '
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' tItem A Type Variable that should be
- ' initialized with all the data
- ' required for advanced setup.
- '
- '-- See ddepmAddItemExt for an explanation of what each
- ' element in the type specifies.
- '-----------------------------------------------------------
- Dim ddeCmd$
- Dim ItemCmdLine$
-
- '-- Build a commmand Line based on the elements of Item
- ItemCmdLine$ = pmItemCmdLineFromTypeVar(tItem)
-
- ddeCmd$ = "[AddItem(" & ItemCmdLine$ & ")]"
- Call ddepmExecute(lblLink, ddeCmd$)
-
-
- End Sub
-
- Sub ddepmCreateGroup (lblLink As Label, GroupName$, GroupPath$)
- '----------------------------------------------------------------
- '-- Creates a new ProgMan group. If a group already exists with
- ' the name GroupName$ then that group will be activated
- ' rather than creating a new group.
- '
- '-- Arguments: lblLink The Label used for DDE with Progman.
- ' GroupName$ A string that contains the group name
- ' GroupPath$ A string that contains the group file
- ' name.(i.e. "myapp.grp") It must
- ' be a valid DOS file name.
- '----------------------------------------------------------------
- Dim ddeCmd$
-
- ddeCmd$ = "[CreateGroup(" & GroupName$ + "," & GroupPath$ & ")]"
- Call ddepmExecute(lblLink, ddeCmd$)
-
- End Sub
-
- Sub ddepmDeleteGroup (lblLink As Label, GroupName$)
- '-----------------------------------------------------------
- '-- This procedure deletes an existing ProgMan group.
- '
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' GroupName$ Name of the Group to Delete.
- '-----------------------------------------------------------
- Dim ddeCmd$
-
- ddeCmd$ = "[DeleteGroup(" & GroupName$ & ")]"
- Call ddepmExecute(lblLink, ddeCmd$)
-
-
- End Sub
-
- Sub ddepmDeleteItem (lblLink As Label, ItemName$, GroupName$)
- '-----------------------------------------------------------
- '-- Deletes the ItemName$ icon from the group GroupName$.
- ' If GroupName$ is Null("") then ItemName$ will be deleted
- ' from the currently active group.
- '
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' ItemName$ A string that contains the
- ' name of the item/icon to delete.
- '-----------------------------------------------------------
- Dim ddeCmd$
-
- If Len(GroupName$) Then
- Call ddepmShowGroup(lblLink, GroupName$, 1)
- End If
-
- ddeCmd$ = "[DeleteItem(" & ItemName$ & ")]"
- Call ddepmExecute(lblLink, ddeCmd$)
-
-
- End Sub
-
- Private Sub ddepmErrorHandler (theError%)
- '------------------------------------------------------------
- '-- Pretty extravagant huh?<g> You can decide how you
- ' want to handle the DDE errors in your own app. I may
- ' post an update in the future if I come up with something
- ' really good.
- '------------------------------------------------------------
- Dim Msg$
- Dim Cap$
-
- Msg$ = Error$(theError%)
- Cap$ = "ProgMan DDE Error"
-
- MsgBox Msg$, MB_OK, Cap$
-
-
- End Sub
-
- Private Sub ddepmExecute (CtlLink As Control, ddeCmd$)
- '--------------------------------------------------------
- '-- Execute the DDECommand String through a LinkExecute
- ' for the CtlLink control.
- '
- '-- NOTE: Only Text Boxes, Picture Boxes, and Labels are
- ' valid controls to use.
- '--------------------------------------------------------
- Dim i%
- Dim OldLinkTimeout%
-
- Screen.MousePointer = HOURGLASS
-
- '-- Save the LinkTimeout so we can leave
- ' it like we found it.
- OldLinkTimeout% = CtlLink.LinkTimeout
-
- On Error GoTo ddepmExecuteError
- '---------------------------------------------------------
- '-- Set LinkTopic to PROGRAM MANAGER
- '---------------------------------------------------------
- CtlLink.LinkTopic = "ProgMan|Progman"
- CtlLink.LinkMode = LINK_MANUAL
-
- For i% = 1 To 10
- DoEvents
- Next i%
-
- CtlLink.LinkTimeout = 100
-
- '---------------------------------------------------------
- '-- Execute the DDE Command. The burden of making sure the
- ' DDECommand is valid rests on the calling program or
- ' routine. Normally I wouldn't want to do it that way
- ' but this is a Private Procedure so only the other
- ' procs in this module can get at it so it's my own
- ' fault if something goes wrong.
- '---------------------------------------------------------
- CtlLink.LinkExecute ddeCmd$
-
- On Error GoTo 0
-
- '---------------------------------------------------------
- '-- Reset properties
- '---------------------------------------------------------
- CtlLink.LinkTimeout = OldLinkTimeout%
- CtlLink.LinkMode = NONE
-
-
- ddepmExecuteExit:
- Screen.MousePointer = DEFAULT
- On Error GoTo 0
- Exit Sub
-
- ddepmExecuteError:
- Call ddepmErrorHandler(Err)
- Resume ddepmExecuteExit
-
-
- End Sub
-
- Sub ddepmExitProgMan (lblLink As Label, bSaveGroups%)
- '-----------------------------------------------------------
- '-- This only works if ProgMan is not the Shell
- '
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' bSaveGroups% An integer telling Progman to
- ' save Group information before
- ' closing if it's non-zero.
- '-----------------------------------------------------------
- Dim ddeCmd$
-
- ddeCmd$ = "[ExitProgman(" & bSaveGroups% & ")]"
- Call ddepmExecute(lblLink, ddeCmd$)
-
-
- End Sub
-
- Function ddepmGetGroups% (lblLink As Label, arrGroups$())
- '---------------------------------------------------------
- '-- Returns: True if all goes well.
- ' False if any DDE errors occur. If this is the
- ' case then no group names will have been
- ' loaded.
- ' ERR_ITEMS_TRUNCATED(-2) if an error occurs
- ' while parsing the Group Names.
- '
- '-- NOTE: Even if errors occur(-2) some GroupNames may
- ' have been loaded successfully into the array.
- '
- '-- Returns arrGroups$() filled with all the available
- ' groups in ProgMan. The array is 0 based so the calling
- ' procedure should read from 0 to Ubound(arrGroups$) -1
- ' in order to read all the group names.
- '
- '-- arrGroups$() should be a dynamic string array. This
- ' procedure will resize it as necessary.
- '---------------------------------------------------------
- Dim i%
- Dim OldLinkTimeout%
- Dim GroupList$
- Dim Delimiter$
- Dim NumGroups%
- Dim CRLFPos%
- Dim GroupsParsedOK%
-
- OldLinkTimeout% = lblLink.LinkTimeout
-
- '---------------------------------------------------------
- '-- Set LinkTopic to PROGRAM MANAGER
- '---------------------------------------------------------
- lblLink.LinkTopic = "ProgMan|Progman"
- lblLink.LinkMode = LINK_MANUAL
- lblLink.LinkTimeout = 100
-
- On Error GoTo ddepmGetGroupsError
- '---------------------------------------------------------
- '-- Ask for the program manager group information
- ' (returned in lblLink.Caption)
- '---------------------------------------------------------
- lblLink.LinkItem = "PROGMAN"
- lblLink.LinkRequest
-
- '-- Set return value
- GroupList$ = lblLink.Caption
-
- On Error GoTo 0
-
- '---------------------------------------------------------
- '-- Reset properties
- '---------------------------------------------------------
- lblLink.LinkTimeout = OldLinkTimeout%
- lblLink.LinkMode = 0
-
-
- '---------------------------------------------------------
- '-- Load the array with the names of the groups
- '---------------------------------------------------------
- Delimiter$ = Chr$(13) & Chr$(10)
- GroupsParsedOK% = ParseString(GroupList$, arrGroups$(), Delimiter$)
- If GroupsParsedOK% = True Then
- ddepmGetGroups% = True
- ElseIf GroupsParsedOK% = ERR_ITEMS_TRUNCATED Then
- ddepmGetGroups% = ERR_ITEMS_TRUNCATED
- End If
-
-
- ddepmGetGroupsExit:
- Screen.MousePointer = DEFAULT
- On Error GoTo 0
- Exit Function
-
-
- ddepmGetGroupsError:
- ddepmGetGroups% = False
- Call ddepmErrorHandler(Err)
- Resume ddepmGetGroupsExit
-
-
- End Function
-
- Function ddepmGroupInfo% (txtLink As TextBox, GroupName$, tarrGroupItems() As T_ProgManGroupItem)
- '----------------------------------------------------------
- '-- This procedure will retrieve all the items in the
- ' specified group into an array of type variables. The
- ' array needs to be a dynamic array and this procedure
- ' will redimension it as necessary.
- '
- '-- Returns: True(-1) if no errors occur
- ' False(0) if a DDE error occurs which would
- ' indicate that no Item information was
- ' retrieved or if no group is specified.
- ' ERR_ITEMS_TRUNCATED(-2) if an error occurs
- ' while parsing the group information.
- '
- '-- NOTE: If the return code is -2 some elements may have
- ' been loaded successfully into the array.
- '
- '!! NOTE: Right now there is no distinction between
- ' truncation of Properties and Items. If Items are
- ' truncated it will still tell you things are OK
- ' as long as the Properties aren't truncated. This
- ' should be addressed.
- '
- '!! NOTE: This procedure is the only one that takes a
- ' Textbox as a parameter instead of a label. The
- ' reason for this is that the label will only
- ' return the first 1024 characters in it's caption
- ' which will truncate the large amount of data that
- ' we get with this call. Hmmm. I guess GetGroups
- ' could be overloaded as well. Make a note of that.
- '----------------------------------------------------------
- Dim ItemIndex%
- Dim OldLinkTimeout%
- Dim ItemDelimiter$
- Dim PropertyDelimiter$
- Dim GroupItemInfo$
- Dim ItemsParsedOK%
- Dim ItemPropertiesParsedOK%
-
-
- OldLinkTimeout% = txtLink.LinkTimeout
-
- '---------------------------------------------------------
- '-- Default to retreiving list of available Groups
- ' if GroupName is Null("")
- '---------------------------------------------------------
- If Len(GroupName$) = 0 Then
- '-- Set return code to indicate error
- ddepmGroupInfo% = False
- Exit Function
- End If
-
- '---------------------------------------------------------
- '-- Set LinkTopic to PROGRAM MANAGER
- '---------------------------------------------------------
- txtLink.LinkTopic = "ProgMan|Progman"
- txtLink.LinkMode = LINK_MANUAL
- txtLink.LinkTimeout = 100
-
- On Error GoTo ddepmGroupInfoError
- '---------------------------------------------------------
- '-- Ask for the program manager group information
- ' (returned in txtLink.Caption)
- '---------------------------------------------------------
- txtLink.LinkItem = GroupName$
- txtLink.LinkRequest
-
- On Error GoTo 0
-
- '---------------------------------------------------------
- '-- Reset properties
- '---------------------------------------------------------
- txtLink.LinkTimeout = OldLinkTimeout%
- txtLink.LinkMode = 0
-
-
- '---------------------------------------------------------
- '-- Parse the data we got from ProgMan
- '---------------------------------------------------------
- ReDim arrItems$(0)
- ReDim arrItemProperties$(0)
- ItemDelimiter$ = Chr$(13) + Chr$(10)
- PropertyDelimiter$ = ","
- GroupItemInfo$ = txtLink.Text
-
- '-- Parse the big chunk we got back into lines which
- ' each contain the data for a single item
- ItemsParsedOK% = ParseString(GroupItemInfo$, arrItems$(), ItemDelimiter$)
- If ItemsParsedOK% Then
-
- ReDim tarrGroupItems(UBound(arrItems$))
-
- For ItemIndex% = 0 To UBound(arrItems$)
-
- '-- Parse the line containing the item info into fields
- ' so we can set them into our type variables.
- ItemPropertiesParsedOK% = ParseString(arrItems$(ItemIndex%), arrItemProperties$(), PropertyDelimiter$)
- If ItemPropertiesParsedOK% Then
- On Error Resume Next
- '-- The first line holds the GroupName and GroupPath. We don't
- ' need to strip quotes from the GroupPath but we do for the
- ' rest of the items.
- arrItemProperties$(0) = StripQuotes(arrItemProperties$(0))
- If ItemIndex% > 0 Then
- arrItemProperties$(1) = StripQuotes(arrItemProperties$(1))
- End If
-
- '-- Fill the Type Variable with the properties we found
- tarrGroupItems(ItemIndex%).Name = arrItemProperties$(0)
- tarrGroupItems(ItemIndex%).CmdLine = arrItemProperties$(1)
- tarrGroupItems(ItemIndex%).DefaultDir = arrItemProperties$(2)
- tarrGroupItems(ItemIndex%).IconPath = arrItemProperties$(3)
- tarrGroupItems(ItemIndex%).xPos = Val(arrItemProperties$(4))
- tarrGroupItems(ItemIndex%).yPos = Val(arrItemProperties$(5))
- tarrGroupItems(ItemIndex%).IconIndex = Val(arrItemProperties$(6))
- tarrGroupItems(ItemIndex%).HotKey = Val(arrItemProperties$(7))
- tarrGroupItems(ItemIndex%).RunMinimized = Val(arrItemProperties$(8))
- On Error GoTo ddepmGroupInfoError
- Else
- '-- Set the return code to indicate an error
- If ItemPropertiesParsedOK% = False Then
- ddepmGroupInfo% = False
- Else
- ItemPropertiesParsedOK% = ERR_ITEMS_TRUNCATED
- End If
- End If
- Next ItemIndex%
- Else
- '-- Set the return code to indicate an error
- If ItemsParsedOK% = False Then
- ddepmGroupInfo% = False
- Else
- ddepmGroupInfo% = ERR_ITEMS_TRUNCATED
- End If
-
- End If
-
-
- ddepmGroupInfoExit:
- Screen.MousePointer = DEFAULT
- On Error GoTo 0
- Exit Function
-
-
- ddepmGroupInfoError:
- ddepmGroupInfo% = False
- Call ddepmErrorHandler(Err)
- Resume ddepmGroupInfoExit
-
-
- End Function
-
- Sub ddepmReloadGroup (lblLink As Label, GroupName$)
- '-----------------------------------------------------------
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' GroupName$ Name of the Group to Reload.
- '-----------------------------------------------------------
- Dim ddeCmd$
-
- ddeCmd$ = "[Reload (" & GroupName$ & ")]"
- Call ddepmExecute(lblLink, ddeCmd$)
-
-
- End Sub
-
- Sub ddepmReplaceItem (lblLink As Label, OldItem$, NewItemCmdLine$, NewItemName$)
- '-----------------------------------------------------------
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' OldItem$
- ' NewItemCmdLine$
- ' NewItemName$
- '-----------------------------------------------------------
- Dim DDEReplaceItemCmd$
- Dim DDEAddItemCmd$
-
- DDEReplaceItemCmd$ = "[ReplaceItem(" & OldItem$ & ")]"
- Call ddepmExecute(lblLink, DDEReplaceItemCmd$)
-
- DDEAddItemCmd$ = "[AddItem(" & NewItemCmdLine$ & "," + NewItemName$ & ")]"
- Call ddepmExecute(lblLink, DDEAddItemCmd$)
-
-
- End Sub
-
- Sub ddepmSelectGroup (lblLink As Label, GroupName$)
- '----------------------------------------------------------
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' GroupName$ A string that contains the group
- ' name to Show and Select.
- '
- '-- NOTE: This routine selects the group automatically
- ' rather than taking nCmd as a parameter. It also
- ' doesn't work if the Group is *not* minimized.
- '----------------------------------------------------------
- Dim ddeCmd$
-
- ddeCmd$ = "[ShowGroup(" & GroupName$ & ",1)]"
- Call ddepmExecute(lblLink, ddeCmd$)
-
-
- End Sub
-
- Sub ddepmShowGroup (lblLink As Label, GroupName$, ShowCmd%)
- '--------------------------------------------------------------
- '-- Arguments: lblLink The Label used for DDE with
- ' Progman.
- ' GroupName$ A string that contains the group
- ' name.
- ' ShowCmd% The command for how the window
- ' is to be displayed.
- '--------------------------------------------------------------
- Dim ddeCmd$
-
- '-- Make sure ShowCmd% is valid
- If (ShowCmd% < 1) Or (ShowCmd% > 8) Then
- ShowCmd% = 1
- End If
-
- ddeCmd$ = "[ShowGroup(" & GroupName$ + "," & ShowCmd% & ")]"
- Call ddepmExecute(lblLink, ddeCmd$)
-
-
- End Sub
-
- Private Function ParseString% (StringIn$, arrOut$(), Delimiter$)
- '----------------------------------------------------------
- '-- Returns: True as long as we don't bomb out due to
- ' a delimiter or String not being passed.
- ' ERR_ITEMS_TRUNCATED(-2) if we try to load more
- ' elements than exist in the array. If this is
- ' the case then some elements will have been
- ' loaded properly but some may have been
- ' truncated.
- '
- '-- StringIn$ = The string to parse
- ' arrOut$() = The array to fill (should be dynamic as
- ' it will be ReDim'ed in this procedure)
- ' Delimiter$= The character(s) separating the elements
- ' in Stringin$
- '----------------------------------------------------------
- Dim LastItemPos%, NextItemPos%
- Dim StartPos%
- Dim ItemLen%
- Dim DelimiterLength%
- Dim NumItems%
- Dim ItemNum%
- Dim bGetLastItem%
-
-
- If Len(StringIn$) = 0 Then
- ParseString% = False
- Exit Function
- End If
-
- DelimiterLength% = Len(Delimiter$)
- If DelimiterLength% = 0 Then
- ParseString% = False
- Exit Function
- End If
-
- On Error Resume Next
- '-----------------------------------------------------
- '-- First time through we're just counting
- '-----------------------------------------------------
- NextItemPos% = InStr(StringIn$, Delimiter$)
- While NextItemPos%
- NumItems% = NumItems% + 1
- StartPos% = NextItemPos% + DelimiterLength%
- NextItemPos% = InStr(StartPos%, StringIn$, Delimiter$)
- Wend
-
- '-----------------------------------------------------
- '-- We now know how many items are in the string so
- ' we can initialize our array. The exception to this
- ' would be if the Delimiter is the last thing in the
- ' string in which case we need to ReDim to one less
- ' item than we counted.
- '-----------------------------------------------------
- If StartPos% <> Len(StringIn$) + 1 Then
- ReDim arrOut$(NumItems%)
- '-- Set a flag so we know to get the last element
- bGetLastItem% = True
- Else
- ReDim arrOut$(NumItems% - 1)
- End If
-
- '-- This needs to be initialized
- LastItemPos% = 1
-
- '-----------------------------------------------------
- '-- Now it's for real. Get the items from the string.
- '-----------------------------------------------------
- NextItemPos% = InStr(StringIn$, Delimiter$)
- While NextItemPos%
- StartPos% = LastItemPos%
- ItemLen% = (NextItemPos% - LastItemPos%)
-
- arrOut$(ItemNum%) = Mid$(StringIn$, StartPos%, ItemLen%)
- ItemNum% = ItemNum% + 1
- If ItemNum% > UBound(arrOut$) Then
- ParseString = ERR_ITEMS_TRUNCATED
- Exit Function
- End If
-
- LastItemPos% = NextItemPos% + DelimiterLength%
- NextItemPos% = InStr(LastItemPos%, StringIn$, Delimiter$)
- Wend
-
- '-- If the bGetLastItem% flag is on then
- ' we have one more element to get.
- If bGetLastItem% Then
- arrOut$(ItemNum%) = Mid$(StringIn$, LastItemPos%)
- End If
-
- On Error GoTo 0
-
- ParseString% = True
-
- End Function
-
- Function pmItemCmdLineFromTypeVar$ (tItem As T_ProgManGroupItem)
- '----------------------------------------------------------
- '
- '-- Used by: ddepmAddItemExtT
- '----------------------------------------------------------
- Dim CmdLine$
-
- CmdLine$ = ""
- CmdLine$ = tItem.CmdLine$ & "," & tItem.Name$ & "," & tItem.IconPath$
- CmdLine$ = CmdLine$ & tItem.IconIndex% & "," & tItem.xPos% & "," & tItem.yPos%
- CmdLine$ = CmdLine$ & tItem.DefaultDir$ & "," & tItem.HotKey% & "," & tItem.RunMinimized%
-
- pmItemCmdLineFromTypeVar$ = CmdLine$
-
- End Function
-
- Private Function StripQuotes$ (theString$)
- '-- This was just added as a quickie when I got the
- ' item info stuff working and decided to strip off
- ' the quotes.
-
- StripQuotes$ = Mid$(theString$, 2, Len(theString$) - 2)
-
- End Function
-
-