home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Example_of1799241012004.psc / modFunctionDefinitions.bas < prev    next >
Encoding:
BASIC Source File  |  2004-10-02  |  13.6 KB  |  317 lines
  1. Attribute VB_Name = "modFunctionDefinitions"
  2. Option Base 1
  3. Option Explicit
  4.  
  5. 'Type used for AutoComplete
  6. Type ObjectDescription
  7.     strMembers() As String
  8.     intMemberType() As MemberTypes
  9. End Type
  10.  
  11. 'The different member types of an object -
  12. 'Const, Enum, Function and Property (variable)
  13. Enum MemberTypes
  14.     memConst
  15.     memEnum
  16.     memFunction
  17.     memProperty
  18. End Enum
  19.  
  20. 'Type used to hold function definitions (the little
  21. 'tooltip that pops up)
  22. Type FunctionDescription
  23.     strDef() As String
  24. End Type
  25.  
  26. 'Function List and Function Description variables
  27. 'Function list holds key numbers for descriptions (a lookup table),
  28. 'eg. if colFuncList("MsgBox") = 4, then
  29. ' udtFuncDesc(4).strDef(1) is the first definition
  30. 'for MsgBox(key no. 4). Understand?
  31. Global colFuncList As New Collection
  32. Global udtFuncDesc() As FunctionDescription
  33.  
  34. 'Object List and Object info vars
  35. Global colObjList As New Collection
  36. Global udtObjInfo() As ObjectDescription
  37.  
  38. Dim intOldCount
  39.  
  40. 'InitializeFuncs ---
  41. ' Purpose: Initialize variables and add in functions
  42. Sub InitializeFuncs()
  43.  
  44. 'make ObjectInfo array have 3 items
  45. ReDim udtObjInfo(2)
  46. 'object #1 is always where standard autocomplete
  47. 'functions go (that don't have definitions listed
  48. ' below)
  49. AddObject "<default>", "CvbBlack", "CvbRed", "CvbGreen", "CvbYellow", "CvbBlue", "CvbMagenta", "CvbCyan", "CvbWhite", _
  50.           "CvbBinaryCompare", "CvbTextCompare", _
  51.           "CvbSunday", "CvbMonday", "CvbTuesday", "CvbWednesday", "CvbThursday", "CvbFriday", "CvbUseSystem", "CvbUseSystemDayOfWeek", "CvbFirstJan1", "CvbFirstFourDays", "CvbFirstFullWeek", _
  52.           "CvbGeneralDate", "CvbLongDate", "CvbShortDate", "CvbLongTime", "CvbShortTime", _
  53.           "CvbObjectError", _
  54.           "CvbOKOnly", "CvbOKCancel", "CvbAbortRetryIgnore", "CvbYesNoCancel", "CvbYesNo", "CvbRetryCancel", "CvbCritical", "CvbQuestion", "CvbInformation", "CvbExclamation", "CvbDefaultButton1", "CvbDefaultButton2", "CvbDefaultButton3", "CvbDefaultButton4", "CvbApplicationModal", "CvbSystemModal", "CvbOK", "CvbCancel", "CvbAbort", "CvbRetry", "CvbIgnore", "CvbYes", "CvbNo", _
  55.           "CvbCr", "CvbCrLf", "CvbFormFeed", "CvbLf", "CvbNewLine", "CvbNullChar", "CvbNullString", "CvbTab", "CvbVerticalTab", _
  56.           "CvbUseDefault", "CvbTrue", "CvbFalse", _
  57.           "CvbNull", "CvbEmpty", "CvbInteger", "CvbLong", "CvbSingle", "CvbDouble", "CvbCurrency", "CvbDate", "CvbString", "CvbObject", "CvbError", "CvbBoolean", "CvbVariant", "CvbDataObject", "CvbDecimal", "CvbByte", "CvbArray", _
  58.           "Cof_Input", "Cof_Output", "Cof_Append", "CTextBox", "CRadioBox", "CCheckBox", "COKButton", "CCancelButton", "CPicture", "CLabel"
  59.  
  60. 'AddObject "DanProg", "FOpenFile", "FReadFromFile", "FWriteToFile", "FEOF", "FCloseFile"
  61. AddObject "dpDialog", "FaddControl", "Pcancelled", "Pcaption", "FfreeResources", "FgetCheckInput", "FgetOptionInput", "FgetTextInput", "PHeight", "PLength", "PX", "PY"
  62.  
  63. 'add a test object
  64. 'AddObject "testobj", "Ptestprop", "Ctestconst", "Ftestfunction", "Otestother", "Etestenum", "FAAAAAAAAA"
  65.  
  66. 'size function description array to have 104 items
  67. ReDim udtFuncDesc(114)
  68. 'get old count of autocomplete array
  69. intOldCount = UBound(udtObjInfo(1).strMembers)
  70. 'ReDim Preserve udtObjInfo(1).strMembers(intOldCount + UBound(udtFuncDesc))
  71. 'ReDim Preserve udtObjInfo(1).intMemberType(intOldCount + UBound(udtFuncDesc))
  72.  
  73. 'add standard vbscript functions
  74. AddFunc "Abs", True, "Number"
  75. AddFunc "Array", True, "Arglist"
  76. AddFunc "Asc", True, "String"
  77. AddFunc "Atn", True, "Number"
  78. AddFunc "CBool", True, "Expression"
  79. AddFunc "CByte", True, "Expression"
  80. AddFunc "CCur", True, "Expression"
  81. AddFunc "CDate", True, "Date"
  82. AddFunc "CDbl", True, "Expression"
  83. AddFunc "Chr", True, "CharCode"
  84. AddFunc "CInt", True, "Expression"
  85. AddFunc "CLng", True, "Expression"
  86. AddFunc "Cos", True, "number"
  87. AddFunc "CreateObject", True, "servername.typename, [location]"
  88. AddFunc "CSng", True, "expression"
  89. AddFunc "CStr", True, "expression"
  90. AddFunc "Date", True, ""
  91. AddFunc "DateAdd", True, "interval, number, date"
  92. AddFunc "DateDiff", True, "interval, date1, date2, [firstdayofweek], [firstdayofyear]"
  93. AddFunc "DatePart", True, "interval, date, [firstdayofweek], [firstdayofyear]"
  94. AddFunc "DateSerial", True, "year, month, day"
  95. AddFunc "DateValue", True, "date"
  96. AddFunc "Day", True, "date"
  97. AddFunc "Eval", True, "expression"
  98. AddFunc "Exp", True, "number"
  99. AddFunc "Filter", True, "InputStrings, Value, [include], [compare]"
  100. AddFunc "FormatCurrency", True, "Expression, [NumDigitsAfterDecimal], [IncludeLeadingDigit], [UseParansForNegativeNumbers], [GroupDigits]"
  101. AddFunc "FormatDateTime", True, "Date, [NamedFormat]"
  102. AddFunc "FormatNumber", True, "Expression, [NumDigitsAfterDecimal], [IncludeLeadingDigit], [UseParansForNegativeNumbers], [GroupDigits]"
  103. AddFunc "FormatPercent", True, "Expression, [NumDigitsAfterDecimal], [IncludeLeadingDigit], [UseParansForNegativeNumbers], [GroupDigits]"
  104. AddFunc "GetLocale", True, ""
  105. AddFunc "GetObject", True, "[pathname], [class]"
  106. AddFunc "GetRef", True, "procname"
  107. AddFunc "Hex", True, "number"
  108. AddFunc "Hour", True, "time"
  109. AddFunc "InputBox", True, "prompt, [title], [default], [xpos], [ypos], [helpfile], [context]"
  110. AddFunc "InStr", True, "string1, string2, [compare]", "start, string1, string2, [compare]"
  111. AddFunc "InStrRev", True, "string1, string2, [start], [compare]"
  112. AddFunc "Int", True, "number"
  113. AddFunc "Fix", True, "number"
  114. AddFunc "IsArray", True, "varname"
  115. AddFunc "IsDate", True, "expression"
  116. AddFunc "IsEmpty", True, "expression"
  117. AddFunc "IsNull", True, "expression"
  118. AddFunc "IsNumeric", True, "expression"
  119. AddFunc "IsObject", True, "expression"
  120. AddFunc "Join", True, "list, [delimiter]"
  121. AddFunc "LBound", True, "arrayname, [dimension]"
  122. AddFunc "LCase", True, "string"
  123. AddFunc "Left", True, "string, length"
  124. AddFunc "Len", True, "string/varname"
  125. AddFunc "LoadPicture", True, "picturename"
  126. AddFunc "Log", True, "number"
  127. AddFunc "LTrim", True, "string"
  128. AddFunc "RTrim", True, "string"
  129. AddFunc "Trim", True, "string"
  130. AddFunc "Mid", True, "string, start, [length]"
  131. AddFunc "Minute", True, "time"
  132. AddFunc "Month", True, "date"
  133. AddFunc "MonthName", True, "month, [abbreviate]"
  134. AddFunc "MsgBox", True, "prompt, [buttons], [title], [helpfile], [context]"
  135. AddFunc "Now", True, ""
  136. AddFunc "Oct", True, "number"
  137. AddFunc "Replace", True, "expression, find, replacewith, [start], [count], [compare]"
  138. AddFunc "RGB", True, "red, green, blue"
  139. AddFunc "Right", True, "string, length"
  140. AddFunc "Rnd", True, "[number]"
  141. AddFunc "Round", True, "expression, [numdecimalplaces]"
  142. AddFunc "ScriptEngine", True, ""
  143. AddFunc "ScriptEngineBuildVersion", True, ""
  144. AddFunc "ScriptEngineMajorVersion", True, ""
  145. AddFunc "ScriptEngineMinorVersion", True, ""
  146. AddFunc "Second", True, "time"
  147. AddFunc "SetLocale", True, "lcid"
  148. AddFunc "Sgn", True, "number"
  149. AddFunc "Sin", True, "number"
  150. AddFunc "Space", True, "number"
  151. AddFunc "Split", True, "expression, [delimiter], [count], [compare]"
  152. AddFunc "Sqr", True, "number"
  153. AddFunc "StrComp", True, "string1, string2, [compare]"
  154. AddFunc "String", True, "number, character"
  155. AddFunc "StrReverse", True, "string"
  156. AddFunc "Tan", True, "number"
  157. AddFunc "Time", True, ""
  158. AddFunc "Timer", True, ""
  159. AddFunc "TimeSerial", True, "hour, minute, second"
  160. AddFunc "TimeValue", True, "time"
  161. AddFunc "TypeName", True, "varname"
  162. AddFunc "UBound", True, "arrayname. [dimension]"
  163. AddFunc "UCase", True, "string"
  164. AddFunc "VarType", True, "varname"
  165. AddFunc "Weekday", True, "date, [firstdayofweek]"
  166. AddFunc "WeekdayName", True, "weekday, [abbreviate], [firstdayofweek]"
  167. AddFunc "Year", True, "date"
  168.  
  169. 'add in our custom commands
  170. AddFunc "OpenFile", True, "path, OpenType [of_Input/of_Output/of_Append], [FileNum]"
  171. AddFunc "ReadFromFile", True, "filenum"
  172. AddFunc "WriteToFile", True, "filenum, WhatToWrite"
  173. AddFunc "EOF", True, "filenum"
  174. AddFunc "CloseFile", True, "[filenum]"
  175.  
  176. AddFunc "addControl", False, "controlName, controlType, X, Y, Height, Length, [controlCaption], [controlPicture]"
  177. AddFunc "freeResources", False, ""
  178. AddFunc "getCheckInput", False, "controlName"
  179. AddFunc "getTextInput", False, "controlName"
  180. AddFunc "getOptionInput", False, ""
  181.  
  182.  
  183.  
  184. 'add test function
  185. 'AddFunc "TestFunction", "TestFunction(test1 as String, test2 as Integer, [test3]) as Test", "TestFunction(bla, [blo])", "TestFunction(blar, [blor])"
  186. End Sub
  187.  
  188. 'AddFunc ---
  189. ' PURPOSE: Add a function into definition array
  190. ' INPUTS:
  191. '  strFuncName - Function Name
  192. '  ParamArray strFuncDefs - Function parameters
  193. ' RETURNS: New index number
  194. ' EXAMPLE: AddFunc("test", "test1", "foo, bar")
  195. Function AddFunc(strFuncName As String, bolAddToAutoComplete As Boolean, ParamArray strFuncDefs()) As Integer
  196. Dim intNewCount As Integer
  197. Dim intTemp As Integer
  198.  
  199. 'find new id
  200. intNewCount = colFuncList.Count + 1
  201. 'add function to lookup table
  202. colFuncList.Add intNewCount, strFuncName
  203.  
  204. 'if we have to add to autocomplete list
  205. If bolAddToAutoComplete = True Then
  206.     intTemp = UBound(udtObjInfo(1).strMembers) + 1
  207.     ReDim Preserve udtObjInfo(1).strMembers(intTemp)
  208.     ReDim Preserve udtObjInfo(1).intMemberType(intTemp)
  209.     udtObjInfo(1).strMembers(intOldCount + intNewCount) = strFuncName
  210.     udtObjInfo(1).intMemberType(intOldCount + intNewCount) = memFunction
  211. End If
  212.  
  213. 'resize definition array to hold the number of
  214. 'definitions passed in
  215. ReDim udtFuncDesc(intNewCount).strDef(UBound(strFuncDefs) - LBound(strFuncDefs) + 1)
  216. 'loop through all defs...
  217. For intTemp = LBound(strFuncDefs) To UBound(strFuncDefs)
  218.     '...and add them to def array
  219.     udtFuncDesc(intNewCount).strDef(intTemp - LBound(strFuncDefs) + 1) = strFuncName & "(" & strFuncDefs(intTemp) & ")"
  220. Next intTemp
  221.  
  222. 'return new index
  223. AddFunc = intNewCount
  224. End Function
  225.  
  226. 'FuncDefined ---
  227. ' PURPOSE: Find out if a function is defined
  228. ' INPUTS:
  229. '  strFunc - The Function name
  230. ' RETURNS: Boolean stating whether function is defined
  231. ' EXAMPLE: bolTemp = FuncDefined("MsgBox")
  232. '
  233. ' I won't comment this as anyone should understand
  234. ' how it works ;)
  235. Function FuncDefined(strFunc As String) As Boolean
  236. Dim intTemp As Integer
  237. On Error GoTo nofunc
  238. intTemp = colFuncList(strFunc)
  239. FuncDefined = True
  240. Exit Function
  241.  
  242. nofunc:
  243. FuncDefined = False
  244. End Function
  245.  
  246. 'AddObject (similar to AddFunc)---
  247. ' PURPOSE: Add Object into AutoComplete array
  248. ' INPUTS:
  249. '  strObjName - Name of object
  250. '  ParamArray strObjMembers - Members of this object,
  251. '   prefixed by P(roperty), F(unction), C(onst), or E(num)
  252. ' RETURNS: New index number
  253. ' EXAMPLE: AddObject("testobj", "Ftestfunction", "Etestenum")
  254. Function AddObject(strObjName As String, ParamArray strObjMembers()) As Integer
  255. Dim intNewCount As Integer
  256. Dim intTemp As Integer
  257.  
  258. 'Find new index
  259. intNewCount = colObjList.Count + 1
  260. 'Add object to lookup table
  261. colObjList.Add intNewCount, strObjName
  262.  
  263. 'resize array of members
  264. ReDim udtObjInfo(intNewCount).strMembers(UBound(strObjMembers) - LBound(strObjMembers) + 1)
  265. 'resize array of members' type
  266. ReDim udtObjInfo(intNewCount).intMemberType(UBound(strObjMembers) - LBound(strObjMembers) + 1)
  267. 'loop through all the members passed in...
  268. For intTemp = LBound(strObjMembers) To UBound(strObjMembers)
  269.     '...find the member type...
  270.     Select Case Left(strObjMembers(intTemp), 1)
  271.         Case "P": udtObjInfo(intNewCount).intMemberType(intTemp - LBound(strObjMembers) + 1) = memProperty
  272.         Case "F": udtObjInfo(intNewCount).intMemberType(intTemp - LBound(strObjMembers) + 1) = memFunction
  273.         Case "C": udtObjInfo(intNewCount).intMemberType(intTemp - LBound(strObjMembers) + 1) = memConst
  274.         Case "E": udtObjInfo(intNewCount).intMemberType(intTemp - LBound(strObjMembers) + 1) = memEnum
  275.         Case Else: udtObjInfo(intNewCount).intMemberType(intTemp - LBound(strObjMembers) + 1) = memFunction
  276.     End Select
  277.     '...and add member to array
  278.     udtObjInfo(intNewCount).strMembers(intTemp - LBound(strObjMembers) + 1) = Mid$(strObjMembers(intTemp), 2)
  279. 'continue loop
  280. Next intTemp
  281.  
  282. 'return new index
  283. AddObject = intNewCount
  284. End Function
  285.  
  286. 'ObjDefined (similar to FuncDefined)---
  287. ' PURPOSE: Find out if object defined
  288. ' INPUTS:
  289. '  strObject - Object to check
  290. ' RETURNS: True if object is defined
  291. ' EXAMPLE: bolTemp = ObjDefined("testobj")
  292. 'As with FuncDefined, i won't comment this.
  293. Function ObjDefined(strObject As String) As Boolean
  294. Dim strTemp As String
  295. On Error GoTo noobj
  296. strTemp = colObjList(strObject)
  297. ObjDefined = True
  298. Exit Function
  299.  
  300. noobj:
  301. ObjDefined = False
  302. End Function
  303. 'FuncString ---
  304. ' returns a string with all the functions in it,
  305. ' seperated by a VbLf (linefeed)
  306. Function FuncString() As String
  307. Dim strTemp As String
  308. Dim intTemp As Integer
  309. For intTemp = 1 To UBound(udtObjInfo(1).strMembers)
  310.     If udtObjInfo(1).intMemberType(intTemp) = memFunction Then
  311.         strTemp = strTemp & udtObjInfo(1).strMembers(intTemp) & vbLf
  312.     End If
  313. Next intTemp
  314. strTemp = strTemp & "Call" & vbLf & "Class" & vbLf & "Dim" & vbLf & "Do" & vbLf & "Loop" & vbLf & "While" & vbLf & "Until" & vbLf & "Erase" & vbLf & "ExecuteGlobal" & vbLf & "Exit" & vbLf & "Next" & vbLf & "If" & vbLf & "Then" & vbLf & "Else" & vbLf & "On Error" & vbLf & "Option Explicit" & vbLf & "Private" & vbLf & "Property" & vbLf & "Get" & vbLf & "Let" & vbLf & "Set" & vbLf & "Public" & vbLf & "Randomize" & vbLf & "ReDim" & vbLf & "Select" & vbLf & "Wend" & vbLf & "With" & vbLf & "Case" & vbLf & "DoEvents" & vbLf & "Const" & vbLf & "Erach" & vbLf & "ElseIf" & vbLf & "Each" & vbLf & "ElseIf" & vbLf & "Format" & vbLf & "GoSub" & vbLf & "GoTo" & vbLf & "In" & vbLf & "Input" & vbLf & "Module" & vbLf & "New" & vbLf & "Open" & vbLf & "Preserve" & vbLf & "Print" & vbLf & "Put" & vbLf & "Read" & vbLf & "Resume" & vbLf & "Select" & vbLf & "Shared" & vbLf & "Static" & vbLf & "Stop" & vbLf & "To" & vbLf & "True"
  315. FuncString = strTemp
  316. End Function
  317.