"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** Routine to limit the number of characters allowed in a text box\r\n\\par '**************************************************************************************************************\r\n\\par 'Declares for ComboTextLimit\r\n\\par #if Win32 then\r\n\\par Declare Function SendMessage Lib \"user32\" Alias \"SendMessageA\" (ByVal hwnd As Long, \r\n\\par ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long\r\n\\par Declare Function GetFocus Lib \"user32\" Alias \"GetFocus\" () As Long\r\n\\par #else\r\n\\par Declare Function SendMessage% Lib \"user\" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, \r\n\\par ByVal lParam&)\r\n\\par Declare Function GetFocus Lib \"user\" () As Integer\r\n\\par #end if\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Const WM_USER = &H400\r\n\\par Const EM_LIMITTEXT = WM_USER + 21\r\n\\par \r\n\\par Formname.Show\r\n\\par Combo1.SetFocus\r\n\\par cbhWnd& = GetFocus()\r\n\\par 'set the max number of characters to this variable\r\n\\par TextLimit& = 15 \r\n\\par retval& = SendMessage(cbhWnd&,EM_LIMITTEXT,TextLimit&,0)\r\n\\par \r\n\\par \r\n\\par }\r\n"
},
{
"ID": 14,
"name": "FileExists",
"type": 4,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** Exists%\r\n\\par '*** Function returns a value of True if the specified file exists, or False if it does not exist\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Function \\plain\\f0\\fs17\\cf1\\b Exists\\plain\\f0\\fs17\\cf0 % \\plain\\f0\\fs17 (Filename$)\r\n\\par Dim X&\r\n\\par \r\n\\par X& = FileLen(Filename$)\r\n\\par If X& Then Exists% = True\r\n\\par \r\n\\par End Function\r\n\\par }\r\n"
},
{
"ID": 23,
"name": "RewriteConfigSys",
"type": 6,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** RewriteConfigSys\r\n\\par '*** This function backs up the current CONFIG.SYS file and adds a line to load\r\n\\par '*** a printer driver, then reboots for the changes to take effect.\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function ExitWindows Lib \"user32\" Alias \"ExitWindows\" (ByVal dwReserved As Long, _\r\n\\par ByVal uReturnCode As Long) As Long\\\n\r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Sub \\plain\\f0\\fs17\\cf1\\b RewriteConfigSys\\plain\\f0\\fs17 ()\r\n\\par Dim strin$\r\n\\par Dim varout As Variant\r\n\\par Dim rc%& Dim XS$\r\n\\par Dim setpos&, Response as long\r\n\\par \\plain\\f4\\fs16 Const EW_REBOOTSYSTEM = &H43\r\n\\par \\plain\\f0\\fs17 \r\n\\par 'Backup the current config.sys file\r\n\\par XS$ = Dir(\"c:\\\\config.bak\")\r\n\\par If XS$ = \"\" Then\r\n\\par 'if does not exist - create it\r\n\\par Name \"C:\\\\config.sys\" As \"C:\\\\config.bak\"\r\n\\par Else\r\n\\par 'if does exist, delete it and recreate it\r\n\\par Kill \"C:\\\\config.bak\"\r\n\\par Name \"C:\\\\config.sys\" As \"C:\\\\config.bak\"\r\n\\par End If\r\n\\par \r\n\\par 'open the old config.sys (renamed as config.bak)\r\n\\par Open \"C:\\\\config.bak\" For Input As #1\r\n\\par 'create new config.sys\r\n\\par Open \"C:\\\\config.sys\" For Output As #2\r\n\\par 'copy the entire contents of config.bak to config.sys\r\n\\par Do Until (EOF(1))\r\n\\par Line Input #1, strin$\r\n\\par 'if there are no more lines, exit the loop\r\n\\par If strin$ = \" \" Then\r\n\\par setpos% = Loc(1)\r\n\\par Exit Do\r\n\\par Else\r\n\\par 'if the device statement is already there, don't write again\r\n\\par If Trim$(strin$) = \"DEVICE=C:\\\\WINDOWS\\\\PRINTDRV.SYS\" Then\r\n\\par Else\r\n\\par varout = strin$\r\n\\par Print #2, varout\r\n\\par End If\r\n\\par End If\r\n\\par Loop\r\n\\par \r\n\\par 'write the device statement\r\n\\par If setpos% > 0 Then\r\n\\par Seek 1, setpos%\r\n\\par End If\r\n\\par \r\n\\par varout = \"DEVICE=C:\\\\WINDOWS\\\\PRINTDRV.SYS\"\r\n\\par Print #2, varout\r\n\\par \r\n\\par Close #1\r\n\\par Close #2\r\n\\par \r\n\\par 'Auto Restart Windows\r\n\\par Title = \"Reboot Now?\"\r\n\\par ' Put together a sample message box with all the proper components.\r\n\\par Msg = \"For the required changes to take effect, you will need to reboot your PC. Do you want to reboot now?\"\r\n\\par DgDef = MB_YESNO + MB_ICONSTOP + MB_DEFBUTTON2 ' Describe dialog.\r\n\\par \r\n\\par Response = MsgBox(Msg, DgDef, Title) ' Get user response.\r\n\\par If Response = IDYES Then\r\n\\par 'Reboot the system\r\n\\par rc& = ExitWindows(EW_REBOOTSYSTEM, 0)\r\n\\par End If\r\n\\par \r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 24,
"name": "ReStartWin",
"type": 27,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}{\\f5\\froman\\fprq2 Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** ReStartWin\r\n\\par '*** This routine will display a message box asking if the user wants to reboot the system. If YES \r\n\\par '*** is selected, the system is rebooted.\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function ExitWindows Lib \"user32\" Alias \"ExitWindows\" (ByVal dwReserved As Long, \r\n\\par ByVal uReturnCode As Long) As Long\\\n\r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}{\\f5\\froman\\fprq2 Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Sub \\plain\\f0\\fs17\\cf1\\b ReStartWin\\plain\\f0\\fs17 ()\r\n\\par Dim rc&\r\n\\par Dim Response as Long\r\n\\par Dim Title as string, Msg as string\r\n\\par Dim DgDef as Integer\r\n\\par 'Declares for ReStart Win\r\n\\par Const EW_REBOOTSYSTEM = &H43\r\n\\par \r\n\\par 'Auto Restart Windows\r\n\\par Title = \"Reboot Now?\"\r\n\\par ' Put together a sample message box with all the proper components.\r\n\\par Msg = \"For the required changes to take effect, you will need to reboot your PC. Do you want to reboot now?\"\r\n\\par DgDef = vbYesNo +vbStop + vbDefaultButton2 ' Describe dialog.\r\n\\par \r\n\\par Response = MsgBox(Msg, DgDef, Title) ' Get user response.\r\n\\par If Response = vbYes Then\r\n\\par 'Reboot the system\r\n\\par rc& = ExitWindows(EW_REBOOTSYSTEM, 0)\r\n\\par End If\r\n\\par \r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 25,
"name": "VerifyNumerics",
"type": 28,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Desdemona;}{\\f5\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** VerifyNumerics\r\n\\par '*** Call this routine in keypress event to prevent user from entering anything other than numeric \r\n\\par '*** data\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Desdemona;}{\\f5\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b VerifyNumerics\\plain\\f0\\fs17 ()\r\n\\par If Keyascii < Asc(\"0\") Or Keyascii > Asc(\"9\") Then\r\n\\par Beep\r\n\\par Keyascii = 0 'cancels the keystroke\r\n\\par End If\r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 27,
"name": "FormatDisk",
"type": 6,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** FormatDisk\r\n\\par '*** Function to allow the user to format a disk in drive A\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Private Sub \\plain\\f0\\fs17\\cf1\\b FormatDisk\\plain\\f0\\fs17 ()\r\n\\par Dim X&\r\n\\par X& = SHELL Format A: \r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 30,
"name": "SetTextToReadOnly",
"type": 18,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** SetTextToReadOnly\r\n\\par '*** Setting the text box state to read-only allows the user to scroll and highlight the text in the text \r\n\\par '*** box, but does not allow them to edit it. The program can still modify the text by changing the \r\n\\par '*** text property. To create a read-only text box, call the Windows API SendMessage function,\r\n\\par '**** using the EM_SETREADONLY message constant as the second parameter. \r\n\\par '***************************************************************************************************************\r\n\\par Declare Function SendMessage Lib \"user32\" Alias \"SendMessageA\" (ByVal hwnd As Long, _\r\n\\par ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b SetTextToReadOnly\\plain\\f0\\fs17 (Text1 as Textbox)\r\n\\par Const WM_USER = &H400\r\n\\par Const EM_SETREADONLY = (WM_USER + 31)\r\n\\par Dim ret as Long\r\n\\par ret = SendMessage(Text1.hWnd, EM_SETREADONLY, True, 0&)\r\n\\par \r\n\\par ' Check the return value for error\r\n\\par If ret = 0 Then \r\n\\par MsgBox \"Could Not Set Text Box to Read-Only.\"\r\n\\par End If\r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 32,
"name": "HighlightText",
"type": 18,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** HighlightText\r\n\\par '**** Call this routine to highlight text in a field that will be overlaid when the users presses a key.\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b HighlightText\\plain\\f0\\fs17 (Ctl as Control)\r\n\\par Ctl.SelStart = 0\r\n\\par Ctl.SelLength = Len(Ctl.Text)\r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 34,
"name": "GetSpecificLine",
"type": 18,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** GetSpecificLine\r\n\\par '**** Use this routine to retreive a specific line from a multi-line text box.\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function SendMessage Lib \"user32\" Alias \"SendMessageA\" (ByVal hwnd As Long, _\r\n\\par ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b GetSpecificLine\\plain\\f0\\fs17 (Text1 as Textbox) \r\n\\par \r\n\\par Dim RC As Long\r\n\\par Dim numlines As Long\r\n\\par Dim buffer As String\r\n\\par Dim DataStr as string\r\n\\par \r\n\\par 'get the number of lines in the text box\r\n\\par numlines = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0, 0&)\r\n\\par \r\n\\par 'retreive each line - beginning with line 2\r\n\\par For i = 2 To numlines\r\n\\par buffer = Space(100)\r\n\\par RC = SendMessage(Text1.hWnd, 1044, i, ByVal buffer)\r\n\\par buffer = Left$(buffer, RC)\r\n\\par 'places each line retreived into a string field with line feed and carriage control\r\n\\par Datastr = Datastr & Trim$(buffer) & Chr$(10) & Chr$(13)\r\n\\par Next i\r\n\\par End If\r\n\\par End Sub\r\n\\par \r\n\\par }\r\n"
},
{
"ID": 36,
"name": "ExecutePgm",
"type": 27,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** ExecutePgm\r\n\\par '*** Call this routine to shell to an application outside your own.\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function ShellExecute Lib \"shell32.dll\" Alias \"ShellExecuteA\" (ByVal hwnd As Long, _\r\n\\par ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _\r\n\\par ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long \r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b ExecutePgm\\plain\\f0\\fs17 (frmhandle as Long, pgm as string, path as string) \r\n\\par Dim rc&\r\n\\par rc& = ShellExecute(frmhandle , \"Open\", pgm, \"\", path, 6) \r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 38,
"name": "GenerateRandomNumber",
"type": 6,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** GenerateRandomNumber\r\n\\par '**** Call this routine to generate a 7-digit random number - pass it a 7 digit number.\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Function \\plain\\f0\\fs17\\cf1\\b GenerateNum\\plain\\f0\\fs17 (X) as Long\r\n\\par Dim num As Long\r\n\\par Randomize\r\n\\par num = Int(X*Rnd) + 1\r\n\\par GenerateNum = num\r\n\\par End Function\r\n\\par \r\n\\par }\r\n"
},
{
"ID": 40,
"name": "SpecifyNumberOfCopies",
"type": 22,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** PrintCopies \r\n\\par '*** Uses the Escape API to tell Windows the number of copies to print.\r\n\\par '***\r\n\\par '*** (r& = Escape(hDC, SETCOPYCOUNT, Len(Long), lpNumCopies, lpActualCopies))\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function Escape Lib \"GDI32\" alias \"Escape\" (ByVal hDC as Long, _ \r\n\\par ByVal nEscape as Long, ByVal nCount as Integer, lplnData as Any, _\r\n\\par ByVal lpOutData as Any) As Integer\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b PrintCopies \\plain\\f0\\fs17 (numcopies as integer) \r\n\\par Const SETCOPYCOUNT = 17\r\n\\par Printer.Print \"\"\r\n\\par x& = Escape(Printer.hDC, SETCOPYCOUNT, Len(I&), numcopies, actual&)\r\n\\par if x& = 1 then\r\n\\par Printer.Print \" Printing \" & numcopies & \" copies of this.\"\r\n\\par Printer.EndDoc\r\n\\par end if\r\n\\par End Sub\r\n\\par \r\n\\par }\r\n"
},
{
"ID": 41,
"name": "ChangeOrientation",
"type": 22,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** ChangeOrientation\r\n\\par '*** Call this routine to change the print page orientation to either Landscape or Portrait - pass\r\n\\par '*** PORTRAIT or LANDSCAPE\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function Escape Lib \"GDI32\" alias \"Escape\" (ByVal hDC as Long, _\r\n\\par ByVal nEscape as Long, ByVal nCount as Integer, lplnData as Any, _\r\n\\par ByVal lpOutData as Any) As Integer\\\n\r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b ChangeOrientation\\plain\\f0\\fs17 (Orientation as integer)\r\n\\par Const GETSETPAPERORIENT = 30\r\n\\par Dim x%& Dim Orient as OrientStructure\r\n\\par Const PORTRAIT = 1\r\n\\par Const LANDSCAPE = 2\r\n\\par Type OrientStructure\r\n\\par Orientation as Long\r\n\\par Pad as String * 16\r\n\\par End Type\r\n\\par Printer.Print \"\"\r\n\\par Orient.Orientation = Orientation\r\n\\par x& = Escape(Printer.hDC,GETSETPAPERORIENT,Len(Orient),Orient,vbNull)\r\n\\par Printer.EndDoc\r\n\\par ' **Print Your Report Here**\r\n\\par End Sub\r\n\\par \r\n\\par \r\n\\par \r\n\\par }\r\n"
},
{
"ID": 45,
"name": "SetHelpPath",
"type": 26,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\\\n'*** SetHelpPath\r\n\\par '*** Call this routine to set the path to your application's help file - pass it the help file name (without\r\n\\par '*** the .hlp extension).\r\n\\par '**************************************************************************************************************\\\n\r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b SetHelpPath\\plain\\f0\\fs17 (helpfilename as string) as string\r\n\\par Dim hlpfile$\r\n\\par hlpfile$ = App.Path & \"\\\\\" & helpfilename & \".hlp\"\r\n\\par App.HelpFile = hlpfile$\r\n\\par SetHelpPath = hlpfile$\r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 47,
"name": "CloseWindowFromVB",
"type": 27,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** CloseWindowFromVB\r\n\\par '*** Visual Basic for Windows can use the Windows API SendMessage function to close any \r\n\\par '*** active window that has a system menu (referred to as control box within Visual Basic for \r\n\\par '*** Windows) with the Close option.\r\n\\par '*** (Test using: CloseWindow (\"SciCalc\", \"Calculator\")\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function SendMessage Lib \"user32\" Alias \"SendMessageA\" (ByVal hwnd As Long, _\r\n\\par ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long\r\n\\par \\plain\\f4\\fs16 Declare Function FindWindow Lib \"user32\" Alias \"FindWindowA\" (ByVal lpClassName As String, _\r\n\\par ByVal lpWindowName As String) As Long\\plain\\f0\\fs17 \r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b CloseWindow\\plain\\f0\\fs17 (classname$,caption$)\r\n\\par Const WM_SYSCOMMAND = &H112\r\n\\par Const SC_CLOSE = &HF060\r\n\\par Dim Handle as Long, X&\r\n\\par \r\n\\par 'Get the handle to the Calculator window.\r\n\\par Handle = FindWindow(lpClassName$, lpCaption$)\r\n\\par 'Post a message to Calc to end it's existence.\r\n\\par X& = SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, vbNull)\r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 50,
"name": "RestoreInstance",
"type": 15,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** RestoreInstance\r\n\\par '*** Returns the focus to the first instance of a VB application when you attempt to invoke a \r\n\\par '*** second instance of the same application. This feature prevents multiple copies (instances)\r\n\\par '*** of the same program from running in memory.\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b RestoreInstance\\plain\\f0\\fs17 ()\r\n\\par 'Determine if there is another instance of the program\r\n\\par 'running and if so, maximize it\r\n\\par If App.PrevInstance Then\r\n\\par SaveTitle$ = App.Title\r\n\\par App.Title = \"... duplicate instance.\"\r\n\\par Form1.Caption = \"... duplicate instance.\"\r\n\\par AppActivate SaveTitle$\r\n\\par SendKeys \"\\{ENTER\\}\", True\r\n\\par End\r\n\\par eND sUB\r\n\\par }\r\n"
},
{
"ID": 54,
"name": "EnableControlsOn",
"type": 21,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** EnableControlsOn\r\n\\par '*** Use the Controls Collection to enable all currently loaded controls on a form.\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Sub \\plain\\f0\\fs17\\cf1\\b EnableControlsOn\\plain\\f0\\fs17 (Frm as Form, State as Integer)\r\n\\par Dim I\r\n\\par For I = 0 to Frm.Controls.Count - 1\r\n\\par If TypeOf Frm.Controls(I) is not Menu then\r\n\\par frm.Controls(I).Enabled = State\r\n\\par End If\r\n\\par Next I\r\n\\par End sub\r\n\\par }\r\n"
},
{
"ID": 56,
"name": "UnloadAllForms",
"type": 5,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\\\n'*** UnloadAllForms\r\n\\par '*** Iterates through all forms in a project and unloads them.\\\n'**************************************************************************************************************\\\n\r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b UnloadAllForms\\plain\\f0\\fs17 ()\r\n\\par Dim i as integer\r\n\\par For i = 0 to Forms.count - 1\r\n\\par unload Forms(0)\r\n\\par Next i\r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 57,
"name": "DoYouWantToSaveDialog",
"type": 3,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Copperplate Gothic Light;}{\\f5\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** DoYouWantToSaveDialog\r\n\\par '*** Displays a dialog prompting the user to save changes.\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Copperplate Gothic Light;}{\\f5\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b DoYouWantToSaveDialog\\plain\\f0\\fs17 ()\r\n\\par Dim DgDef%, Response%, MsgStr$\r\n\\par If flsave = False Then\r\n\\par MsgStr$ = \"Changes have not been saved. Do you want to save now?\"\r\n\\par DgDef% = vbYesNo + vbExclamation + vbDefaultButton2\r\n\\par Response% = MsgBox(MsgStr$, DgDef%, \"Save?\")\r\n\\par If Response% = vbYes Then \\plain\\f5\\fs16 mnuFileSave_Click\\plain\\f0\\fs17 \r\n\\par End If\r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 58,
"name": "GetINIValue",
"type": 7,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** GetINIValue\r\n\\par '*** Routine to retreive a specific value in a private INI file.\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function GetPrivateProfileString Lib \"kernel32\" Alias \"GetPrivateProfileStringA\" _ \r\n\\par (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _\r\n\\par ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Function \\plain\\f0\\fs17\\cf1\\b GetINIValue\\plain\\f0\\fs17 (AppName as String, KeyName As String, Filename As String) As String\r\n\\par Dim retstr As String\r\n\\par On Error Resume Next\r\n\\par \r\n\\par retstr = String(255, Chr(0))\r\n\\par \r\n\\par GetINIValue = Left(retstr , GetPrivateProfileString(AppName, KeyName, \"\", retstr , Len(retstr ), Filename))\r\n\\par \r\n\\par End Function\r\n\\par }\r\n"
},
{
"ID": 59,
"name": "WriteINIValue",
"type": 7,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** WriteINIValue\r\n\\par '*** Writes a specified value to a private INI file.\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function WritePrivateProfileString Lib \"kernel32\" Alias \"WritePrivateProfileStringA\" _ (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _\r\n\\par ByVal lpFileName As String) As Long\\\n\r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Sub \\plain\\f0\\fs17\\cf1\\b WriteINIValue\\plain\\f0\\fs17 (Appname, KeyName As String, NewValue As String, FileName As String)\r\n\\par Dim rc As Long\r\n\\par rc = WritePrivateProfileString(Appname, KeyName, NewValue, FileName)\r\n\\par End Sub\r\n\\par \r\n\\par \r\n\\par }\r\n"
},
{
"ID": 60,
"name": "ExpandTree",
"type": 19,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\froman\\fprq2 Arial;}{\\f5\\froman\\fprq2 Times New Roman;}{\\f6\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** ExpandTreeView\r\n\\par '*** Use this routine to expand all the parent nodes of your treeview - to display the child nodes.\r\n\\par '*** Pass it the name of your treeview and the total number of members in the list (parents and \r\n\\par '*** children).\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\froman\\fprq2 Arial;}{\\f5\\froman\\fprq2 Times New Roman;}{\\f6\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b ExpandTree\\plain\\f0\\fs17 (Tree1 as TreeView)\r\n\\par Dim I&\r\n\\par Dim NodCount as Long\r\n\\par NodCount = Tree1.Nodes.Count\r\n\\par For I& = NodCount To 1 Step -1\r\n\\par Tree1.Nodes(I&).EnsureVisible\r\n\\par Next I&\r\n\\par Exit Sub\r\n\\par }\r\n"
},
{
"ID": 61,
"name": "CollapseTree",
"type": 19,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\froman\\fprq2 Arial;}{\\f5\\froman\\fprq2 Times New Roman;}{\\f6\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** CollapseTree\r\n\\par '*** Use this routine to collapse all the parent nodes of your treeview - to display only the \r\n\\par '*** parent nodes.\r\n\\par '*** Pass it the name of your treeview and the total number of members in the list (parents and \r\n\\par '*** children).\r\n\\par '**************************************************************************************************************\r\n\\par \r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\froman\\fprq2 Arial;}{\\f5\\froman\\fprq2 Times New Roman;}{\\f6\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Public Sub \\plain\\f0\\fs17\\cf1\\b CollapseTree\\plain\\f0\\fs17 (Tree1 as Treeview)\r\n\\par Dim I&\r\n\\par Dim NodCount\r\n\\par NodCount = Tree1.Nodes.Count\r\n\\par For I& = NodCount To 1 Step -1\r\n\\par Set Nod = Tree1.Nodes(I&)\r\n\\par Nod.Expanded = False\r\n\\par Next I&\r\n\\par Exit Sub\r\n\\par }\r\n"
},
{
"ID": 80,
"name": "SetTabs",
"type": 9,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\r\n\\par '*** SetTab\r\n\\par '*** Use this routine to set up tab positions in specific places.\r\n\\par '**************************************************************************************************************\r\n\\par Declare Function SendMessage Lib \"user32\" Alias \"SendMessageA\" (ByVal hwnd As Long, _\r\n\\par ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long\\\n\r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Sub \\plain\\f0\\fs17\\cf1\\b SetTab \\plain\\f0\\fs17 ()\r\n\\par Dim temp As Long\r\n\\par Dim NumOftabs As Integer\r\n\\par ReDim Tabs(3) As Long\r\n\\par Const WM_USER = &H400\r\n\\par Const LB_SETTABSTOPS = (WM_USER + 19)\r\n\\par \r\n\\par list1.addItem \"One\" & vbTab & \"Two\" & vbTab & \"Three\" & vbTab & \"Four\"\r\n\\par \r\n\\par NumOftabs = 4\r\n\\par Tabs(0) = 50\r\n\\par Tabs(1) = 90\r\n\\par Tabs(2) = 110\r\n\\par Tabs(3) = 140\r\n\\par \r\n\\par temp = SendMessage(list1.hWnd, \r\n\\par LB_SETTABSTOPS, NumOftabs, Tabs(0))\r\n\\par \r\n\\par list1.refresh\r\n\\par End Sub\r\n\\par }\r\n"
},
{
"ID": 81,
"name": "DateDiff",
"type": 2,
"desc": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 '**************************************************************************************************************\\\n'*** Gives the difference between two dates (in days)\r\n\\par '*** (from VB help file)\\\n'**************************************************************************************************************\\\n\r\n\\par }\r\n",
"code": "{\\rtf1\\ansi\\deff0\\deftab720{\\fonttbl{\\f0\\fnil MS Sans Serif;}{\\f1\\fnil\\fcharset2 Symbol;}{\\f2\\fswiss\\fprq2 System;}{\\f3\\fnil\\fprq2 MS Sans Serif;}{\\f4\\fnil Arial;}}\r\n{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;}\r\n\\deflang1033\\pard\\plain\\f0\\fs17 Dim TheDate As Date\\tab ' Declare variables.\r\n\\par Dim Msg\r\n\\par TheDate = InputBox(\"Enter a date\")\r\n\\par Msg = \"Days from today: \" & DateDiff(\"d\", Now, TheDate)\r\n\\par MsgBox Msg\r\n\\par }\r\n"
