home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code1 / fp_demo / gifpdemo.bas < prev    next >
BASIC Source File  |  1994-01-18  |  11KB  |  313 lines

  1. Option Explicit
  2. DefInt A-Z
  3.  
  4. Global Const MODELESS = 0
  5. Global Const MODAL = 1
  6.  
  7. Global Const FPERR_NULL_STRING = -1
  8. Global Const FPERR_NULL_DELIMITER = -2
  9.  
  10. Global Const FP_DELIM_FIRST = 0
  11. Global Const FP_DELIM_LAST = -1
  12.  
  13. Function DlmStrNumFields% (StringIn$, Delimiter$)
  14.  
  15.     DlmStrNumFields% = DS_CountDlms(StringIn$, Delimiter$) + 1
  16.  
  17. End Function
  18.  
  19. Function FileOpenDialog$ ()
  20. '------------------------------------------------
  21. '-- Display the common dialog strictly for the
  22. '   purpose of getting a File Spec.
  23. '------------------------------------------------
  24.  
  25.     frmMain!cmdlgMain.Filter = "All Files (*.*)|*.*"
  26.     frmMain!cmdlgMain.Action = 1
  27.     FileOpenDialog$ = frmMain!cmdlgMain.Filename
  28.  
  29.  
  30. End Function
  31.  
  32. Function fpCollapsePath$ (PathSpec$, MaxChars%)
  33. '---------------------------------------------------
  34. '-- Takes a PathSpec such as "C:\VB\SAMPLES\VBCOMM"
  35. '   and removes intermediate directory names until
  36. '   the path spec is <= MaxChars%. If any directory
  37. '   names are removed and ellipsis(...) will be
  38. '   inserted to denote that fact.
  39. '---------------------------------------------------
  40.     Dim WorkingPath$
  41.     Dim Delim$
  42.     Dim NumDelims%
  43.     Dim MaxDirLen%
  44.     Dim DirToTrim$
  45.     Dim TrimmedDir$
  46.     Dim DelimPos%
  47.     Dim LeftSide$
  48.     Dim RightSide$
  49.  
  50.     '-- First we'll check to see if we even need
  51.     '   to bother doing anything.
  52.     If Len(PathSpec$) > MaxChars% Then
  53.         WorkingPath$ = PathSpec$
  54.         Delim$ = "\"
  55.         
  56.         '-- Replace the first directory with an
  57.         '   ellipsis. If the path contains only
  58.         '   one directory then we need to trim
  59.         '   it and prepend the ellipsis to it.
  60.         NumDelims% = DS_CountDlms(WorkingPath$, Delim$)
  61.         If NumDelims% > 1 Then
  62.             '-- Replace the first directory
  63.             '   with an ellipsis.
  64.             WorkingPath$ = DS_PutField(WorkingPath$, Delim$, 2, "...")
  65.         Else
  66.             '-- There's only 1 directory, and it's
  67.             '   too long so we have to trim it.
  68.             DirToTrim$ = DS_GetField(WorkingPath$, Delim$, 2)
  69.             '-- The max length of the directory
  70.             '   name has to allow for "C:\..."
  71.             MaxDirLen% = MaxChars% - (Len("C:\..."))
  72.             TrimmedDir$ = "..." & Right(DirToTrim$, MaxDirLen%)
  73.             WorkingPath$ = DS_PutField(WorkingPath$, Delim$, 2, TrimmedDir$)
  74.         End If
  75.  
  76.         '-- Now we have to do it all again, but this time
  77.         '   we leave the first directory (now an ellipsis)
  78.         '   and handle the rest.
  79.         While Len(WorkingPath$) > MaxChars%
  80.             NumDelims% = DS_CountDlms(WorkingPath$, Delim$)
  81.             If NumDelims% > 2 Then
  82.                 '-- If there's more than 1 directory
  83.                 '   then just remove the directory.
  84.                 WorkingPath$ = DS_RemoveField(WorkingPath$, Delim$, 3)
  85.             Else
  86.                 '-- We're down to 1 directory again so
  87.                 '   remove the first ellipsis and trim
  88.                 '   the current directory, prepending
  89.                 '   an ellipsis to it.
  90.                 WorkingPath$ = DS_RemoveField(WorkingPath$, Delim$, 2)
  91.                 DirToTrim$ = DS_GetField(WorkingPath$, Delim$, 2)
  92.                 '-- The max length of the directory
  93.                 '   name has to allow for "C:\..."
  94.                 MaxDirLen% = MaxChars% - (Len("C:\..."))
  95.                 TrimmedDir$ = "..." & Right(DirToTrim$, MaxDirLen%)
  96.                 WorkingPath$ = DS_PutField(WorkingPath$, Delim$, 2, TrimmedDir$)
  97.             End If
  98.             
  99.             If Len(WorkingPath$) = MaxChars% + 1 Then
  100.                 '-- This is an exception case just to conform
  101.                 '   to the "Windows" guidelines of how the
  102.                 '   truncation should be done. It just removes
  103.                 '   the second delimiter.
  104.                 DelimPos% = fpSplitString(WorkingPath$, Delim$, 2, LeftSide$, RightSide$)
  105.                 WorkingPath$ = LeftSide$ & RightSide$
  106.             End If
  107.         
  108.         Wend
  109.     
  110.     End If
  111.  
  112.     fpCollapsePath$ = WorkingPath$
  113.  
  114. End Function
  115.  
  116. Function fpFileFromFileSpec$ (FileSpec$)
  117.     Dim Delim$
  118.     Dim NumDelims%
  119.     
  120.     If Len(FileSpec$) Then
  121.         Delim$ = "\"
  122.         NumDelims% = DS_CountDlms(FileSpec$, Delim$)
  123.         fpFileFromFileSpec$ = DS_GetField(FileSpec$, Delim$, NumDelims% + 1)
  124.     Else
  125.         '-- We're here because the String passed
  126.         '   was a null string.
  127.         fpFileFromFileSpec$ = ""
  128.     End If
  129.  
  130. End Function
  131.  
  132. Sub fpLoadListFromDlmStr (theList As Control, DlmStr$, Delim$)
  133.     Dim NumItems%
  134.     Dim i%
  135.     Dim Item$
  136.  
  137.     NumItems% = DlmStrNumFields(DlmStr$, Delim$)
  138.     For i% = 1 To NumItems%
  139.         Item$ = US_Trim(DS_GetField(DlmStr$, Delim$, i%))
  140.         If Len(Item$) Then
  141.             theList.AddItem Item$
  142.         End If
  143.     Next i%
  144.  
  145. End Sub
  146.  
  147. Function fpParsePathAndFilename% (FileSpec$, outPath$, outFilename$)
  148.     Dim Delim$
  149.     
  150.     Delim$ = "\"
  151.     fpParsePathAndFilename% = fpSplitString(FileSpec$, Delim$, FP_DELIM_LAST, outPath$, outFilename$)
  152.     
  153. End Function
  154.  
  155. Function fpParseString% (StringToParse$, Delimiter$, arrParsedItems$())
  156. '----------------------------------------------------------------------
  157. '-- Returns: Number of items parsed if successful
  158. '            FPERR_NULL_STRING if StringToParse was a null string ("")
  159. '            FPERR_NULL_DELIMITER if Delimiter was a null string ("")
  160. '----------------------------------------------------------------------
  161.     Dim NumItems%
  162.     Dim FieldNum%
  163.     Dim i%
  164.     
  165.     If Len(StringToParse$) Then
  166.         If Len(Delimiter$) Then
  167.             NumItems% = DS_CountDlms(StringToParse$, Delimiter$) + 1
  168.             If NumItems% > 0 Then
  169.                 '-- We use NumItems% - 1 here because
  170.                 '   our array is 0 based
  171.                 ReDim arrParsedItems$(NumItems% - 1)
  172.                 For i% = 0 To NumItems% - 1
  173.                     '-- We use i% + 1 to get the field number because
  174.                     '   DS_GetField is 1 based rather than 0 based
  175.                     FieldNum% = i% + 1
  176.                     arrParsedItems$(i%) = US_Trim(DS_GetField(StringToParse$, Delimiter$, FieldNum%))
  177.                 Next i%
  178.             End If
  179.             
  180.             fpParseString% = NumItems%
  181.         
  182.         Else
  183.             '-- We're here because the Delimiter passed
  184.             '   was a null string.
  185.             fpParseString% = FPERR_NULL_DELIMITER
  186.         End If
  187.     Else
  188.         '-- We're here because the String passed
  189.         '   was a null string.
  190.         fpParseString% = FPERR_NULL_STRING
  191.     End If
  192.  
  193. End Function
  194.  
  195. Function fpPathFromFileSpec$ (FileSpec$)
  196. '-------------------------------------------------
  197. '-- NOTE: You could easily use fpSplitString to
  198. '         accomplish this task but this shows you
  199. '         a simple way if you don't want all the
  200. '         extra overhead.
  201. '-------------------------------------------------
  202.     Dim Delim$
  203.     Dim NumDelims%
  204.     Dim LastDelimPos&
  205.  
  206.     If Len(FileSpec$) Then
  207.         Delim$ = "\"
  208.         NumDelims% = DS_CountDlms(FileSpec$, Delim$)
  209.         LastDelimPos& = DS_FindDlm(FileSpec$, Delim$, NumDelims%)
  210.         fpPathFromFileSpec$ = Left$(FileSpec$, LastDelimPos& - 1)
  211.     Else
  212.         '-- We're here because the String passed
  213.         '   was a null string.
  214.         fpPathFromFileSpec$ = ""
  215.     End If
  216.  
  217. End Function
  218.  
  219. Function fpSplitString% (StringToSplit$, Delimiter$, OccurrenceNumber%, outLeftHalf$, outRightHalf$)
  220. '----------------------------------------------------
  221. '-- Splits a string into two parts. The split occurs
  222. '   at the specified occurrence of the specified
  223. '   delimiter. outLeftHalf and outRightHalf will hold
  224. '   the two parts of the string upon return.
  225. '
  226. '-- You can specify an occurrence number for the
  227. '   delimiter if you know that you want to split
  228. '   the string at a specific occurrence or you can
  229. '   use FP_DELIM_FIRST or FP_DELIM_LAST to split
  230. '   the string at the first or last delimiter.
  231. '
  232. '-- Returns: Byte position where split occurred if
  233. '            successful. 0 inidicates no delimiter
  234. '            was found in which case outLeftHalf is
  235. '            filled with the original string and
  236. '            outRightHalf is a null string.
  237. '
  238. '            FPERR_NULL_STRING if StringToParse was a
  239. '            null string ("")
  240. '
  241. '            FPERR_NULL_DELIMITER if Delimiter was a
  242. '            null string ("")
  243. '----------------------------------------------------
  244.     Dim DelimOccurrence%
  245.     Dim SplitPos&
  246.     
  247.     If Len(StringToSplit$) Then
  248.         If Len(Delimiter$) Then
  249.             Select Case OccurrenceNumber%
  250.                 Case FP_DELIM_FIRST
  251.                     DelimOccurrence% = 1
  252.                 Case FP_DELIM_LAST
  253.                     DelimOccurrence% = DS_CountDlms(StringToSplit$, Delimiter$)
  254.                 Case Else
  255.                     DelimOccurrence% = OccurrenceNumber%
  256.             End Select
  257.             
  258.             SplitPos& = DS_FindDlm(StringToSplit$, Delimiter$, DelimOccurrence%)
  259.             
  260.             If SplitPos& <> 0 Then
  261.                 outLeftHalf$ = Left$(StringToSplit$, SplitPos& - 1)
  262.                 outRightHalf$ = Right$(StringToSplit$, Len(StringToSplit$) - SplitPos&)
  263.             Else
  264.                 '-- If no delimiters were found then the
  265.                 '   left half gets the whole shebang and
  266.                 '   the right half gets nothing.
  267.                 outLeftHalf$ = StringToSplit$
  268.                 outRightHalf$ = ""
  269.             End If
  270.             
  271.             fpSplitString% = CInt(SplitPos&)
  272.  
  273.         Else
  274.             '-- We're here because the Delimiter passed
  275.             '   was a null string.
  276.             fpSplitString% = FPERR_NULL_DELIMITER
  277.         End If
  278.     Else
  279.         '-- We're here because the String passed
  280.         '   was a null string.
  281.         fpSplitString% = FPERR_NULL_STRING
  282.     End If
  283.  
  284. End Function
  285.  
  286. Function fpWordCount& (StringToCount$)
  287. '--------------------------------------------------
  288. '-- Returns: Number of words if successful.
  289. '            FPERR_NULL_STRING if a null string
  290. '             was passed in as a parameter.
  291. '
  292. '-- NOTE! This is not a "real" word count function
  293. '         in that it only counts the number of
  294. '         spaces which separate words. There are
  295. '         certainly more accurate, less literal
  296. '         algorithms available but if you need a
  297. '         rough estimate then it doesn't get much
  298. '         simpler than this.
  299. '--------------------------------------------------
  300.     Dim Delim$
  301.  
  302.     If Len(StringToCount$) Then
  303.         Delim$ = " "
  304.         fpWordCount& = DS_CountDlms(StringToCount$, Delim$) + 1
  305.     Else
  306.         '-- We're here because the String passed
  307.         '   was a null string.
  308.         fpWordCount& = FPERR_NULL_STRING
  309.     End If
  310.  
  311. End Function
  312.  
  313.