home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / sc4_1002 / scwl32.bas < prev    next >
Encoding:
BASIC Source File  |  1996-11-14  |  43.1 KB  |  1,188 lines
  1. Attribute VB_Name = "SimonCarter_WindowsLibraryAll"
  2. Option Explicit
  3.  
  4. Public Const ID_YES = 6
  5. Public Const ID_Cancel = 2
  6. Public Const ID_No = 7
  7.  
  8.  
  9. Public Const DBFilter = "Database Files (*.MDB)|*.mdb"
  10. Public Const AllFilter = "All Files (*.*)|*.*"
  11. Public Const ExeFilter = "Executable Files (*.EXE)|*.exe"
  12. Public Win95RegBase As String
  13. #If Win32 Then
  14.     'SCWL Functions
  15.     
  16.     'Under Construction
  17.     Declare Function KeyStat Lib "scwl32.dll" (ByVal KeyToCheck As Integer) As Integer
  18.     Global Const KeyStatErr = -10 'could not map keyboard
  19.     Global Const KeyStatIsOn = 2 'key is currently on
  20.     Global Const KeyStatIsOff = 1 'Key is currently Off
  21.     Global Const KeyStatNumLock = 90
  22.     Global Const KeyStatCapsLock = 14
  23.     Global Const KeyStatScrollLock = 91
  24.     
  25.     
  26.     Declare Function Battery Lib "scwl32.dll" (ByVal BatteryType As Long) As Long
  27.     
  28.     'Battery Type Consts
  29.     Public Const BatteryPowerStatus = 1
  30.     Public Const BatteryChargeStatus = 2
  31.     Public Const BatteryLifePercent = 3
  32.     Public Const BatteryLifeTime = 4
  33.     Public Const BatteryFullLifeTime = 5
  34.     
  35.     'Result Type Consts
  36.     Public Const BatteryNoInformation = -1
  37.     Public Const BatteryInvalidBatteryType = -2
  38.     Public Const BatteryErrorInDLL = -3
  39.    
  40.     
  41.     
  42.     Declare Function AscWP Lib "scwl32.dll" (ByVal Str As String, Pos As Integer) As Long
  43.     'End Under Construction
  44.     
  45.     Declare Function LoggedOn Lib "scwl32.dll" (ByRef Name As String) As Integer
  46.     
  47.     
  48.     Declare Function SCFont Lib "scwl32.dll" (ByRef ThisFont As SCFontStruct) As Integer
  49.     Declare Function ProperString Lib "scwl32.dll" (ByRef S As String) As Integer
  50.     Declare Function GetDirStruct Lib "scwl32.dll" (ByVal Dir As Integer, ListBoxHandle As Integer) As Integer
  51.     Declare Function Soundalike Lib "scwl32.dll" Alias "SoundAlikeA" (ByVal S1 As String, ByVal S2 As String) As Boolean
  52.     Declare Function PentiumBug Lib "scwl32.dll" Alias "PentiumBugA" () As Boolean
  53.     'Return Comm Ports Available
  54.     'Declare Function CommPorts Lib "scwl32.dll" () As Integer 'not available 32 Bit (Yet)
  55.         'CommPorts will be combination of following
  56.     'Comm 1 = 1
  57.     'Comm 2 = 2
  58.     'Comm 3 = 4
  59.     'Comm 4 = 8
  60.     'No comm Ports = 0
  61.     
  62.     'GetHiB & GetLoB Gets The hi and lo bytes from a word
  63.     'Word    0  ..  65535    Unsigned 16-bit (Type of Long Integer)
  64.     Declare Function GetHiB Lib "scwl32.dll" Alias "GetHiBA" (ByVal GetFrom As Integer) As Byte
  65.     Declare Function GetLoB Lib "scwl32.dll" Alias "GetLoBA" (ByVal GetFrom As Integer) As Byte
  66.     
  67.     'GetHiW & GetLoW Gets The hi and lo Words from an Integer
  68.     Declare Function GetHiW Lib "scwl32.dll" Alias "GetHiWA" (ByVal GetFrom As Long) As Integer
  69.     Declare Function GetLoW Lib "scwl32.dll" Alias "GetLoWA" (ByVal GetFrom As Long) As Integer
  70.     
  71.     Declare Function CursorN Lib "scwl32.dll" Alias "CursorNA" () As Integer
  72.     Declare Function CursorH Lib "scwl32.dll" Alias "CursorHA" () As Integer
  73.     'No Longer Supported Declare Sub DispMsg Lib "scwl32.dll" Alias "DispMsgA" (ByVal Title As String, ByVal filename As String)
  74.     Declare Function ShowTips Lib "scwl32.dll" Alias "ShowTipsA" (ByVal Title As String, ByVal TipTitle As String, ByVal StringFile As String, ByVal ShowAtStart As Integer) As Integer
  75.     Declare Sub OpenCD Lib "scwl32.dll" Alias "OpenCDA" ()
  76.     Declare Function EditOption Lib "scwl32.dll" Alias "EditOptionA" () As Integer
  77.     Declare Function GetTime Lib "scwl32.dll" Alias "GetTimeA" (RtnTime As String) As Integer
  78.     Declare Function GetPath Lib "scwl32.dll" Alias "GetPathA" (rtnpath As String) As Integer
  79.     Declare Function ShowAbout Lib "scwl32.dll" Alias "showaboutA" (ByVal IcoFile As String, ByVal Title As String, ByVal Version As String) As Boolean
  80.     Declare Function ShowOpen Lib "scwl32.dll" Alias "FOpen" (ByVal Title As String, ByVal Filter As String, ByVal DefaultDir As String, ReturnFile As String) As Integer
  81.     Declare Function ShowSave Lib "scwl32.dll" Alias "FSave" (ByVal Title As String, ByVal Filter As String, ByVal DefaultDir As String, ReturnFile As String) As Integer
  82.     
  83.     Declare Function GetSymbol Lib "scwl32.dll" Alias "GetSymbolA" () As Boolean
  84.     Declare Function GetColor Lib "scwl32.dll" Alias "GetColorA" () As Long
  85.     Declare Sub ShowDisk Lib "scwl32.dll" Alias "ShowDiskA" ()
  86.     Declare Function GetDate Lib "scwl32.dll" Alias "GetDateA" (ByRef rtndate As String) As Integer
  87.     'No Longer Supported Declare Function GetDateI Lib "scwl32.dll" Alias "GetDateIA" () As Long
  88.     Declare Function GetHwnd Lib "scwl32.dll" Alias "GetHwndA" (ByVal MHwnd As Integer, ByVal WindowTitle As String) As Integer
  89.     Declare Function MemTotal Lib "scwl32.dll" Alias "MemTotalA" () As Long
  90.     Declare Function MemFree Lib "scwl32.dll" Alias "MemFreeA" () As Long
  91.     Declare Sub WrapCursor Lib "scwl32.dll" Alias "WrapCursorA" ()
  92.     Declare Function Percent Lib "scwl32.dll" Alias "PercentA" (ByVal Num As Double, ByVal Total As Double) As Integer
  93.     Declare Sub Today Lib "scwl32.dll" Alias "TodayA" (RtnDay As String)
  94.     Declare Function ChangeTitle Lib "scwl32.dll" Alias "ChangeTitleA" (ByVal MHwnd As Integer, ByVal ExistTitle As String, ByVal newtitle As String) As Integer
  95.     Declare Function ActiveTitle Lib "scwl32.dll" Alias "ActiveTitleA" (returntitle As String) As Integer
  96.     Declare Sub SetActiveTitle Lib "scwl32.dll" Alias "SetActiveTitleA" (ByVal returntitle As String)
  97.     Declare Sub CloseWindows Lib "scwl32.dll" Alias "ExitWinA" (ByVal ExitStyle As Integer)
  98.     Declare Function Logon Lib "scwl32.dll" Alias "LogonA" (ByVal Title As String, ByRef RtnValue As String) As Integer
  99.     Declare Function getini Lib "scwl32.dll" Alias "GetIniA" (ByVal Section As String, ByVal key As String, ByVal IniFile As String, default As String) As Integer
  100.     Declare Function writeini Lib "scwl32.dll" Alias "WriteIniA" (ByVal Section As String, ByVal key As String, ByVal Setting As String, ByVal IniFile As String) As Integer
  101.     Declare Sub OnTop Lib "scwl32.dll" Alias "OnTopA" (ByVal Hwnd As Long)
  102.     Declare Sub NotTop Lib "scwl32.dll" Alias "NotTopA" (ByVal Hwnd As Integer)
  103.     Declare Function Fileexist Lib "scwl32.dll" Alias "FileExistA" (ByVal filename As String) As Integer
  104.     Declare Function ShowHelp Lib "scwl32.dll" Alias "ShowHelpA" (ByVal MHwnd As Integer, ByVal TheHelpFile As String, ByVal TopicNo As Long) As Boolean
  105.     Declare Function Showsearch Lib "scwl32.dll" Alias "ShowSearchA" (ByVal MHwnd As Integer, ByVal TheHelpFile As String) As Boolean
  106.     Declare Function HDFree Lib "scwl32.dll" Alias "HDFreeA" (ByVal DiskNum As Integer) As Long
  107.     Declare Function HDUsed Lib "scwl32.dll" Alias "HDUsedA" (ByVal DiskNum As Integer) As Long
  108.     Declare Function HDTotal Lib "scwl32.dll" Alias "HDTotalA" (ByVal DiskNum As Integer) As Long
  109.     Declare Function CLBFind Lib "scwl32.dll" Alias "CLBFindA" (ByVal CL As Integer, ByVal Handle As Long, ByVal TextSearch As String) As Integer
  110.  
  111.     'Windows Functions
  112.     Declare Function GetActiveWindow Lib "user32" () As Integer
  113.     Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  114.     Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  115.     Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, lpFileName As String) As Long
  116.     Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  117.     Declare Function ShowWindow Lib "user32" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long
  118.     Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  119.     Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  120.     Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  121.     Declare Function sndPlaySound Lib "WINMM.DLL" Alias "sndPlaySoundA" (ByVal lpszSoundName As Any, ByVal uFlags As Long) As Long
  122.     Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  123.     Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long
  124.     Declare Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, ByVal hdc As Long) As Long
  125.     Declare Function GetDesktopWindow Lib "user32" () As Long
  126.  
  127.    Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  128.    Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
  129.    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  130.    Private Const NORMAL_PRIORITY_CLASS = &H20&
  131.    Private Const INFINITE = -1&
  132.    Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  133.    Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  134.     Type POINTAPI       ' Stores location of cursor
  135.         X As Long
  136.         Y As Long
  137.     End Type
  138.     Public Const CB_FINDSTRING = &H14C
  139.     Public Const LB_FINDSTRING = &H18F
  140.  
  141. #Else
  142.     Declare Function ProperString Lib "scwl.dll" (ByRef S As String) As Integer
  143.     Declare Function GetDirStruct Lib "scwl.dll" (ByVal Dir As Integer, ListBoxHandle As Integer) As Integer
  144.     Declare Function Soundalike Lib "scwl.dll" (ByVal S1 As String, ByVal S2 As String) As Boolean
  145.     Declare Function IsShareLoaded Lib "scwl.dll" () As Boolean
  146.     Declare Function PentiumBug Lib "scwl.dll" () As Boolean
  147.     'Return Comm Ports Available
  148.     Declare Function CommPorts Lib "scwl.dll" () As Integer
  149.         'CommPorts will be combination of following
  150.     'Comm 1 = 1
  151.     'Comm 2 = 2
  152.     'Comm 3 = 4
  153.     'Comm 4 = 8
  154.     'No comm Ports = 0
  155.     
  156.     'GetHiB & GetLoB Gets The hi and lo bytes from a word
  157.     'Word    0  ..  65535    Unsigned 16-bit (Type of Long Integer)
  158.     Declare Function GetHiB Lib "scwl.dll" (ByVal GetFrom As Integer) As Byte
  159.     Declare Function GetLoB Lib "scwl.dll" (ByVal GetFrom As Integer) As Byte
  160.     
  161.     'GetHiW & GetLoW Gets The hi and lo Words from an Integer
  162.     Declare Function GetHiW Lib "scwl.dll" (ByVal GetFrom As Long) As Integer
  163.     Declare Function GetLoW Lib "scwl.dll" (ByVal GetFrom As Long) As Integer
  164.     
  165.     Declare Function CursorN Lib "scwl.dll" () As Integer
  166.     Declare Function CursorH Lib "scwl.dll" () As Integer
  167.     Declare Sub DispMsg Lib "scwl.dll" (ByVal Title As String, ByVal filename As String)
  168.     Declare Function ShowTips Lib "scwl.dll" Alias "Showtips" (ByVal Title As String, ByVal TipTitle As String, ByVal StringFile As String, ByVal ShowAtStart As Integer) As Integer
  169.     Declare Sub OpenCD Lib "scwl.dll" ()
  170.     Declare Function EditOption Lib "scwl.dll" () As Integer
  171.     Declare Function GetTime Lib "scwl.dll" (RtnTime As String) As Integer
  172.     Declare Function GetPath Lib "scwl.dll" (rtnpath As String) As Integer
  173.     Declare Function ShowAbout Lib "scwl.dll" (ByVal IcoFile As String, ByVal Title As String, ByVal Version As String) As Boolean
  174.     Declare Function ShowOpen Lib "scwl.dll" (ByVal Title As String, ByVal Filter As String, ByVal DefaultDir As String, ReturnFile As String) As Integer
  175.     Declare Function ShowSave Lib "scwl.dll" (ByVal Title As String, ByVal Filter As String, ByVal DefaultDir As String, ReturnFile As String) As Integer
  176.     Declare Sub ShowTip Lib "scwl.dll" (ByVal tiptext As String)
  177.     
  178.     Declare Function GetSymbol Lib "scwl.dll" () As Boolean
  179.     Declare Function GetColor Lib "scwl.dll" () As Long
  180.     Declare Sub ShowStart Lib "scwl.dll" (ByVal PictureFile As String)
  181.     Declare Sub ClearStart Lib "scwl.dll" ()
  182.     Declare Sub ShowRes Lib "scwl.dll" ()
  183.     Declare Sub ShowDisk Lib "scwl.dll" ()
  184.     Declare Function GetDate Lib "scwl.dll" (ByRef rtndate As String) As Integer
  185.     Declare Function GetDateI Lib "scwl.dll" () As Long
  186.     Declare Function GetHwnd Lib "scwl.dll" (ByVal MHwnd As Integer, ByVal WindowTitle As String) As Integer
  187.     Declare Function MemTotal Lib "scwl.dll" () As Long
  188.     Declare Function MemFree Lib "scwl.dll" () As Long
  189.     Declare Sub WrapCursor Lib "scwl.dll" ()
  190.     Declare Function Percent Lib "scwl.dll" (ByVal Num As Double, ByVal Total As Double) As Integer
  191.     Declare Sub Today Lib "scwl.dll" (RtnDay As String)
  192.     Declare Function ChangeTitle Lib "scwl.dll" Alias "changetitle" (ByVal MHwnd As Integer, ByVal ExistTitle As String, ByVal newtitle As String) As Integer
  193.     Declare Function ActiveTitle Lib "scwl.dll" (returntitle As String) As Integer
  194.     Declare Sub SetActiveTitle Lib "scwl.dll" (ByVal returntitle As String)
  195.     Declare Sub CloseWindows Lib "scwl.dll" Alias "ExitWin" (ByVal ExitStyle As Integer)
  196.     Declare Function Logon Lib "scwl.dll" (ByVal Title As String, RtnValue As String) As Integer
  197.     Declare Function getini Lib "scwl.dll" (ByVal Section As String, ByVal key As String, ByVal IniFile As String, default As String) As Integer
  198.     Declare Function writeini Lib "scwl.dll" (ByVal Section As String, ByVal key As String, ByVal Setting As String, ByVal IniFile As String) As Integer
  199.     Declare Sub OnTop Lib "scwl.dll" (ByVal Hwnd As Integer)
  200.     Declare Sub NotTop Lib "scwl.dll" (ByVal Hwnd As Integer)
  201.     Declare Function Fileexist Lib "scwl.dll" (ByVal filename As String) As Integer
  202.     Declare Function ShowHelp Lib "scwl.dll" (ByVal MHwnd As Integer, ByVal TheHelpFile As String, ByVal TopicNo As Long) As Boolean
  203.     Declare Function Showsearch Lib "scwl.dll" (ByVal MHwnd As Integer, ByVal TheHelpFile As String) As Boolean
  204.     Declare Function GetRes Lib "scwl.dll" (ByVal restype As Integer) As Integer
  205.     Declare Function HDFree Lib "scwl.dll" (ByVal DiskNum As Integer) As Long
  206.     Declare Function HDUsed Lib "scwl.dll" (ByVal DiskNum As Integer) As Long
  207.     Declare Function HDTotal Lib "scwl.dll" (ByVal DiskNum As Integer) As Long
  208.     Declare Function CLBFind Lib "scwl.dll" (ByVal CL As Integer, ByVal Handle As Integer, ByVal TextSearch As String) As Integer
  209.     
  210.     Declare Function TotLines Lib "cdl36sc.dll" (ByVal MLEHwnd As Integer) As Long
  211.     Declare Sub TextPos Lib "cdl36sc.dll" (ByVal editwnd As Integer, LPPopint As POINTAPI)
  212.     Declare Sub DrawRulerX Lib "cdl36sc.dll" (ByVal picwnd As Integer)
  213.     Declare Sub DrawRulerXT Lib "cdl36sc.dll" (ByVal picwnd As Integer, ByVal LeftMargin As Double, ByVal RightMargin As Double, ByVal RulerWidth As Double, ByVal FromNumber As Integer, ByVal ToNumber As Integer)
  214.     Declare Sub TabStop Lib "cdl36sc.dll" (ByVal picwnd As Integer, ByVal Position As Integer, ByVal TabChar As Integer)
  215.     Declare Sub Paintpic Lib "cdl36sc.dll" (ByVal DHDC As Integer)
  216.     Declare Function ScrollPos Lib "cdl36sc.dll" (ByVal SCrollHwnd As Integer) As Integer
  217.  
  218.     Declare Function GetWindowsDirectory Lib "Kernel" Alias "getwindowsdirectory" (ByVal p$, ByVal S%) As Integer
  219.     Declare Function GetSystemDirectory Lib "Kernel" (ByVal p$, ByVal S%) As Integer
  220.     Declare Function GetVersion Lib "Kernel" () As Long
  221.     Declare Function sndPlaySound Lib "MMSYSTEM" (ByVal lpszSoundName As String, ByVal uFlags As Integer) As Integer
  222.     Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer) As Integer
  223.     Declare Sub Yield Lib "Kernel" ()
  224.     Declare Function GetPrivateProfileString Lib "Kernel" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal ReturnString$, ByVal NumBytes As Integer, ByVal filename$) As Integer
  225.     Declare Function WritePrivateProfileString Lib "Kernel" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal filename$) As Integer
  226.     Declare Function ShowWindow% Lib "User" (ByVal Handle As Integer, ByVal Cmd As Integer)
  227.     'Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
  228.     Declare Function GetActiveWindow Lib "User" () As Integer
  229.     Declare Function WindowFromPoint Lib "User" (ByVal lpPointY As Integer, ByVal lpPointX As Integer) As Integer
  230.     'Declare Function ShowWindow Lib "User" (ByVal hWnd As Integer, ByVal nCmdShow As Integer) As Integer
  231.     Public Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
  232.     Declare Function SendMessage Lib "User" (ByVal Hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Any) As Long
  233.         Declare Function BitBlt Lib "GDI" (ByVal destDC%, ByVal X%, ByVal Y%, ByVal w%, ByVal h%, ByVal srchDC%, ByVal srcX%, ByVal srcY%, ByVal rop&) As Integer
  234.     Declare Function GetDesktopWindow Lib "User" Alias "GetDeskTopWindow" () As Integer
  235.     Declare Function GetDC Lib "User" (ByVal Hwnd%) As Integer
  236.     Declare Sub ReleaseDC Lib "User" (ByVal Hwnd%, ByVal hdc%)
  237.     Declare Function StretchBlt% Lib "GDI" (ByVal hdc%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal xSrc%, ByVal ySrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&)
  238.     
  239.     Type POINTAPI       ' Stores location of cursor
  240.         X As Integer
  241.         Y As Integer
  242.     End Type
  243.     Public Const CB_FINDSTRING = (WM_USER + 12)
  244.     Public Const LB_FINDSTRING = (WM_USER + 16)
  245.  
  246. #End If
  247.  
  248.    Type ConvertPOINTAPI  ' Used by WM_SYSCOMMAND - converts mouse location.
  249.       xy As Long
  250.    End Type
  251.  
  252.  
  253. Global Const WM_LBUTTONUP = &H202
  254. Global Const WM_SYSCOMMAND = &H112
  255. Global Const MOUSE_MOVE = &HF012
  256.  
  257. Global Const SND_SYNC = &H0                 '  play synchronously (default)
  258. Global Const SND_ASYNC = &H1                '  play asynchronously
  259. Global Const SND_NODEFAULT = &H2            '  don't use default sound
  260. Global Const SND_MEMORY = &H4               '  lpszSoundName points to a memory file
  261. Global Const SND_LOOP = &H8                 '  loop the sound until next sndPlaySound
  262. Global Const SND_NOSTOP = &H10              '  don't stop any currently playing sound
  263.  
  264. Global Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
  265.  
  266.  
  267. Type RulerXT
  268.     LM As Integer
  269.     RM As Integer
  270.     Width As Integer
  271. End Type
  272. Global Const ExitWin_Normal = &H1
  273. Global Const ExitWin_Restart = &H2
  274. Global Const ExitWin_Reboot = &H3
  275. Global Const SW_SHOWNOACTIVATE = 4
  276.  
  277. Type SCFontStruct
  278.     Name As String * 40
  279.     len As Integer
  280.     Size As Integer
  281.     Bold As Boolean
  282.     Italic As Boolean
  283.     Color As Long
  284.     Underline As Boolean
  285.     StrikeOut As Boolean
  286. End Type
  287.  
  288.  
  289.  
  290. Public ShowingTip As Boolean
  291. Type ODI
  292.       Filter As String
  293.       Title As String
  294.       HelpFile As String
  295.       TopicNo As Long
  296. End Type
  297.  
  298. Type LogonType
  299.     Name As String * 40
  300.     Password As String * 40
  301.     Result As Integer
  302. End Type
  303.  
  304. Global Const FileDoesExist = 0
  305. Global Const FileDoesNotExist = 1
  306.  
  307. ' Key Codes
  308. Global Const KEY_SHIFT = &H10
  309. Global Const KEY_CONTROL = &H11
  310.  
  311. Global Const KEY_F1 = &H70
  312. Global Const KEY_F2 = &H71
  313. Global Const KEY_F3 = &H72
  314. Global Const KEY_F4 = &H73
  315. Global Const KEY_F5 = &H74
  316. Global Const KEY_F6 = &H75
  317. Global Const KEY_F7 = &H76
  318. Global Const KEY_F8 = &H77
  319. Global Const KEY_F9 = &H78
  320. Global Const KEY_F10 = &H79
  321. Global Const KEY_F11 = &H7A
  322. Global Const KEY_F12 = &H7B
  323.  
  324.  
  325.    Private Type STARTUPINFO
  326.       cb As Long
  327.       lpReserved As String
  328.  
  329.       lpDesktop As String
  330.       lpTitle As String
  331.       dwX As Long
  332.       dwY As Long
  333.       dwXSize As Long
  334.       dwYSize As Long
  335.       dwXCountChars As Long
  336.       dwYCountChars As Long
  337.       dwFillAttribute As Long
  338.       dwFlags As Long
  339.       wShowWindow As Integer
  340.       cbReserved2 As Integer
  341.       lpReserved2 As Long
  342.       hStdInput As Long
  343.       hStdOutput As Long
  344.       hStdError As Long
  345.    End Type
  346.  
  347.    Private Type PROCESS_INFORMATION
  348.       hProcess As Long
  349.  
  350.       hThread As Long
  351.       dwProcessID As Long
  352.       dwThreadID As Long
  353.    End Type
  354.  
  355. Function DOSPathName(Current As String) As String
  356. Const LenShortPath = 500
  357. Dim Result As Long, ShortPath As String * LenShortPath
  358. #If Win32 Then
  359.     If Not Current = "" Then
  360.         Result = GetShortPathName(Current, ShortPath, LenShortPath)
  361.         DOSPathName = Left$(ShortPath, Result)
  362.     Else
  363.         DOSPathName = ""
  364.     End If
  365. #Else
  366.     DOSPathName = Current
  367. #End If
  368. End Function
  369.  
  370.  
  371. Sub RunTillFinished(ToRun As String, Optional CommandLine As Variant)
  372. 'Runs a program till it is finished for win 95 / NT
  373. Dim CmdLine$
  374.  
  375. If Not IsMissing(CommandLine) Then
  376.     CmdLine$ = ToRun & " " & CommandLine
  377. Else
  378.     CmdLine$ = ToRun
  379. End If
  380.  
  381. #If Win32 Then
  382.     Dim proc As PROCESS_INFORMATION
  383.     Dim start As STARTUPINFO
  384.     Dim Ret&
  385.     ' Initialize the STARTUPINFO structure:
  386.     start.cb = Len(start)
  387.  
  388.     ' Start the shelled application:
  389.     Ret& = CreateProcessA(0&, CmdLine$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
  390.  
  391.     ' Wait for the shelled application to finish:
  392.     Ret& = WaitForSingleObject(proc.hProcess, INFINITE)
  393.     Ret& = CloseHandle(proc.hProcess)
  394. #Else
  395.     Dim rt As Integer
  396.     rt = Shell(CmdLine$, 1)
  397.     Do While GetModuleUsage(rt) > 0
  398.         DoEvents
  399.     Loop
  400. #End If
  401. End Sub
  402.  
  403.  
  404.  
  405.  
  406. Function PlayResSound(ResID As Integer, Play As Integer) As Integer
  407. Attribute PlayResSound.VB_Description = "Plays A Wav File From A Resource Script"
  408.     Dim Ret As Variant, Play_Type As Integer, SoundBuffer As String
  409. Select Case Play
  410. Case 1
  411.     Play_Type = &H0
  412. Case 2
  413.     Play_Type = &H1
  414. Case 3
  415.     Play_Type = &H2
  416. Case 4
  417.     Play_Type = &H8
  418. Case 5
  419.     Play_Type = &H10
  420. Case Else
  421.     MsgBox "Invalid Play Type", 64, "SC Play Res Sound"
  422.     PlayResSound = 1
  423.     Exit Function
  424. End Select
  425.     On Error Resume Next
  426.     #If Win32 Then
  427.         ' Important: The returned string is converted to Unicode
  428.         SoundBuffer = StrConv(LoadResData(ResID, "ATM_SOUND"), vbUnicode)
  429.     #Else
  430.         SoundBuffer = LoadResData(ResID, "ATM_SOUND")
  431.     #End If
  432.     If Err <> 0 Then
  433.         MsgBox "Problem With Reousrce File." & Chr$(13) & "Please Recompile."
  434.     Else
  435.         Ret = sndPlaySound(SoundBuffer, Play_Type Or SND_NODEFAULT Or SND_MEMORY)
  436.     End If
  437.     ' Important: This function is neccessary for playing sound asynchronously
  438.     DoEvents
  439. End Function
  440.  
  441. Function PlaySound(filename As String, Play As Integer)
  442. Dim rt As Integer, Play_Type
  443. rt = Fileexist(filename)
  444. If rt <> 0 Then 'File does not exist so exit function
  445.     PlaySound = -1
  446.     Exit Function
  447. End If
  448. Select Case Play
  449. Case 1
  450.     Play_Type = &H0
  451. Case 2
  452.     Play_Type = &H1
  453. Case 3
  454.     Play_Type = &H2
  455. Case 4
  456.     Play_Type = &H8
  457. Case 5
  458.     Play_Type = &H10
  459. Case Else
  460.     MsgBox "Invalid Play Type", 64, "SC Play Sound"
  461.     PlaySound = 1
  462.     Exit Function
  463. End Select
  464.     rt = sndPlaySound(filename, Play_Type)
  465. End Function
  466.  
  467.  
  468. Function SystemDirectory() As String
  469. Dim WinPath As String
  470.     WinPath = String(145, Chr(0))
  471.     SystemDirectory = Left(WinPath, GetSystemDirectory(WinPath, Len(WinPath)))
  472.  
  473. End Function
  474.  
  475.  
  476. Function WindowsDirectory() As String
  477. Dim WinPath As String
  478.     WinPath = String(145, Chr(0))
  479.     WindowsDirectory = Left(WinPath, GetWindowsDirectory(WinPath, Len(WinPath)))
  480. End Function
  481.  
  482.  
  483. Function WindowsVersion() As String
  484. #If Win32 Then
  485.  
  486. #Else
  487.     Dim ver As Long, winver As Long
  488.     ver = GetVersion()
  489.     winver = ver And &HFFFF&
  490.     WindowsVersion = Format((winver Mod 256) + ((winver \ 256) / 100), "Fixed")
  491. #End If
  492. End Function
  493.  
  494.  
  495. #If Win16 Then
  496. Function DosVersion() As String
  497. Dim ver As Long, dosver As Long
  498.     ver = GetVersion()
  499.     dosver = ver \ &H10000
  500.     DosVersion = Format((dosver \ 256) + ((dosver Mod 256) / 100), "Fixed")
  501. End Function
  502.  
  503. #End If
  504. Sub CenterForm(NameOfForm As Form)
  505.     Dim FormLeft As Integer
  506.     Dim FormTop As Integer
  507.     FormLeft = (Screen.Width - NameOfForm.Width) / 2
  508.     FormTop = (Screen.Height - NameOfForm.Height) / 2
  509.     NameOfForm.Move FormLeft, FormTop
  510. End Sub
  511.  
  512. Public Function ShortenPath(LenOfPath As Integer, Path As String) As String
  513. Dim I As Integer, rt, NewPath As String, OldPath As String, UsePath As String
  514. NewPath = Left$(Path, 3) & "..."
  515. OldPath = Mid$(Path, 4)
  516. StartShortenPath:
  517. If Len(OldPath) > (LenOfPath - 6) Then
  518.     OldPath = Mid$(OldPath, 4)
  519.     Do While Not Left$(OldPath, 1) = "\"
  520.         OldPath = Mid$(OldPath, 2)
  521.     Loop
  522.     UsePath = NewPath & OldPath
  523. Else
  524.     UsePath = Path
  525. End If
  526. If Len(UsePath) > LenOfPath Then GoTo StartShortenPath
  527. ShortenPath = UsePath
  528. End Function
  529.  
  530.  
  531. Function GetWinIni(Section As String, key As String, Optional DefaultReturn As Variant) As String
  532. Dim RetVal As String, AppName As String, worked As Integer
  533.     RetVal = String$(255, 0)
  534.     worked = GetPrivateProfileString(Section, key, "", RetVal, Len(RetVal), "Win.ini")
  535.     If worked = 0 Then
  536.         If IsMissing(DefaultReturn) Then GetWinIni = "" Else GetWinIni = CStr(DefaultReturn)
  537.     Else
  538.         GetWinIni = Left(RetVal, worked)
  539.     End If
  540. End Function
  541.  
  542.  
  543.  
  544. Public Function MyPath() As String
  545. Dim Path As String
  546. Path = App.Path
  547. If Not Right$(Path, 1) = "\" Then Path = Path & "\"
  548. MyPath = Path
  549. End Function
  550.  
  551.  
  552. Public Function StripU(TextToStrip As String)
  553. Dim rt, ToReturn As String, ThisChar As String, I As Integer
  554. For I = 1 To Len(TextToStrip)
  555.     ThisChar = Mid$(TextToStrip, I, 1)
  556.     If ThisChar = "&" Then
  557.     
  558.     Else
  559.         ToReturn = ToReturn & ThisChar
  560.     End If
  561. Next I
  562. StripU = ToReturn
  563. End Function
  564.  
  565.  
  566. Public Function WriteMyIni(Section As String, key As String, Setting As String, Optional FileIni As Variant) As Integer
  567. Dim rt, TheInifile As String
  568. 'which inifile to use
  569. If IsMissing(FileIni) Then
  570.     TheInifile = IniFile
  571. Else
  572.     TheInifile = CStr(FileIni)
  573. End If
  574.  
  575. rt = WritePrivateProfileString(Section, key, Setting, TheInifile)
  576. WriteMyIni = rt
  577. End Function
  578.  
  579.  
  580.  
  581. Public Function gs(StringNo As Integer, Optional ToInsert As Variant) As String
  582. Dim ReturnStr As String, ThisString As String, I As Integer, Insert As Boolean
  583. On Error GoTo GSErr
  584. If IsMissing(ToInsert) Then Insert = False Else Insert = True
  585. ThisString = LoadResString(StringNo)
  586. I = InStr(1, ThisString, "%1")
  587. If I > 0 And Insert = True Then
  588.     ReturnStr = Left$(ThisString, I - 1) & ToInsert & Mid$(ThisString, I + 2)
  589. Else
  590.     ReturnStr = ThisString
  591. End If
  592. gs = ReturnStr
  593. GSEP: 'exit point
  594. If ReturnStr = "" Then ReturnStr = "Could Not Load Text"
  595. Exit Function
  596.  
  597. GSErr:
  598. MsgBox Error$ & Chr$(13) & Chr$(13) & Err, 16, Title$
  599. GoTo GSEP
  600. End Function
  601.  
  602.  
  603. Public Function JustPath(ToChange As String) As String
  604. Dim Rtn As String
  605. Rtn = ToChange
  606. If InStr(1, ToChange, "\") > 0 Then
  607.     Do While Not Right$(Rtn, 1) = "\"
  608.         Rtn = Left$(Rtn, Len(Rtn) - 1)
  609.     Loop
  610. Else
  611.     Rtn = ""
  612. End If
  613. JustPath = Rtn
  614.  
  615. End Function
  616.  
  617.  
  618. Function GetBluff(blufflen As Integer) As String
  619. Dim I, bluff_string, this_asc, this_char
  620. bluff_string = ""
  621. For I = 1 To blufflen
  622.     this_asc = Int((200 * Rnd) + 1)
  623.     this_char = Chr$(this_asc)
  624.     bluff_string = bluff_string & this_char
  625. Next I
  626. GetBluff = bluff_string
  627. End Function
  628.  
  629.  
  630.  
  631.  
  632. Public Sub showtt(Help$)
  633.     Dim lpPoint As POINTAPI ' Cursor Point variable
  634.     Dim Ret As Integer
  635.     If Len(Help$) <> 0 Then
  636.         ' Make sure help form is invisible:
  637.         'tooltips.Hide
  638.         ' Change caption of label:
  639.         'tooltips.Label1.Caption = Help$
  640.         ' Get the cursor position
  641.         Call GetCursorPos(lpPoint)
  642.         ' Offset the form from the cursor
  643.         If Screen.ActiveForm.Top <= Screen.Height - 700 Then
  644.             'tooltips.Top = (lpPoint.Y + 18) * Screen.TwipsPerPixelY
  645.             'tooltips.Left = (lpPoint.X - 2) * Screen.TwipsPerPixelY
  646.         Else
  647.             'tooltips.Top = (lpPoint.Y - 18) * Screen.TwipsPerPixelY
  648.             'tooltips.Left = (lpPoint.X - 2) * Screen.TwipsPerPixelY
  649.         End If
  650.         ' Adjust width and height of form to label
  651.         'tooltips.Width = tooltips.Label1.Width + (4 * Screen.TwipsPerPixelX)
  652.         'tooltips.Height = tooltips.Label1.Height + 4 * Screen.TwipsPerPixelY
  653.         ' Make sure form is on top:
  654.         'tooltips.ZOrder
  655.         ' Show form without the focus:
  656.         'ret = ShowWindow(tooltips.hwnd, SW_SHOWNOACTIVATE)
  657.     Else
  658.         ' Hide the form:
  659.         'tooltips.Hide
  660.     End If
  661. End Sub
  662.  
  663.  
  664.  
  665. Function DiskSpace(Disk As String, diskoption As Integer, ReturnStyle As Integer) As Variant
  666. 'This Function deals with Diskspace Free/Used/Total
  667. 'within scwl.dll
  668. Dim DiskNo As Integer, Bytes As Long, BytesConversion As Double
  669.  
  670. 'calculate diskno 1 = A, 2 = B and so on
  671. DiskNo = Asc(UCase$(Disk)): DiskNo = DiskNo - 64
  672. If DiskNo < 1 Or DiskNo > 26 Then
  673.     'optional you could put code here to make
  674.     'default drive the C drive
  675.     
  676.     'else exit because invalid drive letter
  677.     'rem following if making default drive
  678.     DiskSpace = -10000
  679.     Exit Function
  680. End If
  681.  
  682. 'bytes will receive the total bytes for the diskoption selected
  683. Select Case diskoption 'this option will be used/free/total
  684. Case 2 'Total Disk Space
  685.     Bytes = HDTotal(DiskNo)
  686. Case 1 'Free Disk Space
  687.     Bytes = HDFree(DiskNo)
  688. Case Else 'used disk space
  689.     Bytes = HDUsed(DiskNo)
  690. End Select
  691.  
  692. 'check to see if drive number exists
  693. If Bytes = -1 Then 'drive is invalid
  694.     DiskSpace = -1
  695.     Exit Function
  696. End If
  697.  
  698. 'returnstyle = bytes,kbytes,mbytes
  699. Select Case ReturnStyle
  700. Case 2 'bytes
  701.     DiskSpace = Bytes 'return bytes as is
  702. Case 1 'mbytes convert bytes to mega bytes
  703.     BytesConversion = Bytes / 1024
  704.     BytesConversion = BytesConversion / 1024
  705.     'place code here to convert bytesconversion to so many decimal places
  706.     DiskSpace = BytesConversion
  707. Case Else 'kbytes convert bytes to kilobytes
  708.     BytesConversion = Bytes / 1024
  709.     'place code here to convert bytesconversion to so many decimal places
  710.     DiskSpace = BytesConversion
  711. End Select
  712. End Function
  713.  
  714. Function GetMyIni(Section As String, key As String, Optional DefaultReturn As Variant, Optional FileIni As Variant) As String
  715. Dim ReturnString As String, Result As String, TheInifile As String, RetVal As Integer
  716.     
  717. 'buffer up return string
  718. ReturnString = String(1000, 0)
  719.  
  720. 'which inifile to use
  721. If IsMissing(FileIni) Then
  722.     TheInifile = IniFile
  723. Else
  724.     TheInifile = CStr(FileIni)
  725. End If
  726.  
  727. 'make call to dll
  728. RetVal = GetPrivateProfileString(Section, key, "", ReturnString, Len(ReturnString), TheInifile)
  729.     
  730. 'calculate result and send back
  731. If RetVal <> 0 And Not Left$(ReturnString, RetVal) = "" Then 'worked
  732.     GetMyIni = Left$(ReturnString, RetVal)
  733. Else
  734.     If IsMissing(DefaultReturn) Then GetMyIni = "" Else GetMyIni = DefaultReturn
  735. End If
  736.  
  737. End Function
  738.  
  739. Function HelpProc(FormName As Form, Optional TopicNo As Variant) As Boolean
  740. 'shows help topic or search box in winhelp
  741. 'declare a global declaration for Filehelp in declarations section
  742. Dim Result As Boolean, ThisTopic As Long
  743. 'if topicno is not sent assume search
  744. If IsMissing(TopicNo) Then
  745.     Result = Showsearch(FormName.Hwnd, FileHelp)
  746. Else
  747.     ThisTopic = CLng(TopicNo)
  748.     Result = ShowHelp(FormName.Hwnd, FileHelp, ThisTopic)
  749. End If
  750. HelpProc = Result
  751. End Function
  752. Function DecP(ToChange As String, DecPlaces As Integer) As String
  753. 'Truncates Decimal Places to Maximum of 4 Decimal Places
  754. Select Case DecPlaces
  755. Case 1
  756.     DecP = Format(ToChange, "#.#0.0")
  757. Case 2
  758.     DecP = Format(ToChange, "#.##0.00")
  759. Case 3
  760.     DecP = Format(ToChange, "#.###0.000")
  761. Case Else
  762.     DecP = Format(ToChange, "#.####0.0000")
  763. End Select
  764. End Function
  765.  
  766. Public Function OpenProc(Optional Title As Variant, Optional Filter As Variant) As String
  767. 'This Procedure Can Be Used To Get A FileName From The
  768. 'Open Dialog Box Within scwl.DLL and scwl32.dll
  769. Dim Result As Integer, TheTitle As String, ThePath As String, TheFilter As String, ReturnFile As String
  770.  
  771. 'Set Title
  772. If IsMissing(Title) Then
  773.     TheTitle = "Open..." 'default title
  774. Else
  775.     'if blank String Sent Then A GPF Fault will occur
  776.     If Title = "" Then Title = "Open..."
  777.     TheTitle = Title 'Set Title
  778. End If
  779.  
  780. 'Set Filter
  781. If IsMissing(Filter) Then
  782.     TheFilter = "All Files (*.*)|*.*" 'default filter
  783. Else
  784.     'If TheFilter = "" then a GPF Will Occur
  785.     If Filter = "" Then Filter = "All Files (*.*)|*.*"
  786.     TheFilter = Filter 'Set filter
  787. End If
  788.  
  789. 'Set Up Default Path for Open
  790. ThePath = CurDir 'could be app.path
  791.  
  792. 'Buffer out string to receive filename
  793. ReturnFile = String(255, 0)
  794.  
  795. 'Make call to dll
  796. Result = ShowOpen(TheTitle, TheFilter, ThePath, ReturnFile)
  797. If Result = -1 Then 'user cancelled
  798.     OpenProc = ""
  799. Else ' Then 'user selected a file
  800.     OpenProc = UCase$(Left$(Trim$(ReturnFile), Result)) 'return filename to caller of function
  801. End If
  802.     
  803. End Function
  804.  
  805. Public Function SaveProc(Optional Title As Variant, Optional Filter As Variant) As String
  806. 'This Procedur eCan Be Used To Get A FileName From The
  807. 'Open Dialog Box Within scwl.DLL
  808. Dim Result As Integer, TheTitle As String, ThePath As String, TheFilter As String, ReturnFile As String
  809.  
  810. 'Set Title
  811. If IsMissing(Title) Then
  812.     TheTitle = "Save As..." 'default title
  813. Else
  814.     'if blank String Sent Then A GPF Fault will occur
  815.     If Title = "" Then Title = "Save As..."
  816.     TheTitle = Title 'Set Title
  817. End If
  818.  
  819. 'Set Filter
  820. If IsMissing(Filter) Then
  821.     TheFilter = "All Files (*.*)|*.*" 'default filter
  822. Else
  823.     'If TheFilter = "" then a GPF Will Occur
  824.     If Filter = "" Then Filter = "All Files (*.*)|*.*"
  825.     TheFilter = Filter 'Set filter
  826. End If
  827.  
  828. 'Set Up Default Path for Open
  829. ThePath = CurDir 'could be app.path
  830.  
  831. 'Buffer out string to receive filename
  832. ReturnFile = String(255, 0)
  833.  
  834. 'Make call to dll
  835. Result = ShowSave(TheTitle, TheFilter, ThePath, ReturnFile)
  836. If Result = -1 Then 'user selected a file
  837.     SaveProc = "" 'user cancelled or error
  838. Else
  839.     SaveProc = Left$(ReturnFile, Result) 'return filename to caller of function
  840. End If
  841.     
  842.  
  843. End Function
  844.  
  845. Public Sub AboutBox(Title As String, Optional Version As Variant, Optional Icon As Variant)
  846. 'this sub routine will display an about box from
  847. 'scwl.dll
  848. Dim TheIcon As String, TheVersion As String
  849.  
  850. 'about box has default icon so it doesnot need one
  851. 'icon is a base ico file
  852. If Not IsMissing(Icon) Then
  853.     If Fileexist(Icon) = True Then
  854.         TheIcon = Icon
  855.     Else
  856.         'if no icon exists must send something in the string else
  857.         'will cause a GPF
  858.         TheIcon = "NoIcon"
  859.     End If
  860. Else
  861.     TheIcon = "NoIcon"
  862. End If
  863. If IsMissing(Version) Then
  864.     TheVersion = CStr(App.Major & "." & App.Minor & "." & App.Revision)
  865. Else
  866.     If Version = "" Then
  867.         TheVersion = CStr(App.Major & "." & App.Minor & "." & App.Revision)
  868.     End If
  869.     TheVersion = Version
  870. End If
  871. 'display the about box
  872.     Call ShowAbout(TheIcon, Title, TheVersion)
  873.  
  874. End Sub
  875.  
  876. Public Function GetWinHwnd(NameOfForm As Form, TitleOfProg As String) As Long
  877. 'this function will get the handle of a window by giving the title
  878. 'of the window
  879. Dim Result As Integer
  880. 'if blank title (i.e. "" is sent a GPF will occur
  881. If TitleOfProg = "" Then
  882.     GetWinHwnd = -1
  883.     Exit Function
  884. End If
  885.  
  886. 'send call
  887. Result = GetHwnd(NameOfForm.Hwnd, TitleOfProg)
  888.  
  889. 'any number less than 1 indicates it could not find the title
  890. 'send result back
  891. GetWinHwnd = Result
  892.  
  893. End Function
  894.  
  895. Public Function GetPerc(Number As Double, Optional Total As Variant) As Integer
  896. 'this function will calculate a percentage
  897. 'both parameters must be sent as double and returns integer
  898.  
  899. Dim TheTotal As Double, Result As Integer
  900.  
  901. If IsMissing(Total) Then 'check total is a number
  902.     'default to work out percent is 100
  903.     TheTotal = 100
  904. Else 'convert total to a double
  905.     TheTotal = CDbl(Total)
  906. End If
  907.  
  908. If Not IsNumeric(Total) Then
  909.     TheTotal = 100
  910. End If
  911.  
  912. Result = Percent(Number, TheTotal)
  913.  
  914. End Function
  915. Function UserLogon(Optional Title As Variant) As LogonType
  916. 'this function will display a default logon screen
  917. 'in scwl.dll.  When a programmer makes this call
  918. 'you should process userlogon.result first.  if result = 0
  919. 'then the user pressed ok else user pressed cancel
  920.  
  921. Dim ThisLogon As LogonType, TheTitle As String, ReturnString As String, Result As Integer
  922.  
  923. 'buffer out returnstring
  924. ReturnString = String(255, 0)
  925.  
  926. 'check title
  927. If IsMissing(Title) Then
  928.     TheTitle = "Logon..."
  929. Else
  930.     'cant send blank string (i.e. "" ) else GPF will occur
  931.     If Title = "" Then TheTitle = "Logon..."
  932.     TheTitle = Title
  933. End If
  934.  
  935. 'make call to logon
  936. Result = Logon(TheTitle, ReturnString)
  937. If Result = -1 Then ''user cancelled
  938.     ThisLogon.Result = -1
  939.     UserLogon = ThisLogon
  940. Else
  941.     ThisLogon.Name = Left$(ReturnString, InStr(1, ReturnString, "#") - 1)
  942.     ThisLogon.Password = Mid$(ReturnString, (InStr(1, ReturnString, "#") + 1), Result - (InStr(1, ReturnString, "#")))
  943.     ThisLogon.Result = 0
  944.     UserLogon = ThisLogon
  945. End If
  946.  
  947. End Function
  948.  
  949.  
  950.  
  951.  
  952. Public Function LastPath(ExtractFrom As String)
  953. Dim ThisChar As String, RetStr As String, strStore As String
  954. Dim I As Integer
  955. 'Returns the last folder/dir from a path statement from ExtractFrom
  956. strStore = ExtractFrom
  957. Do While Len(ExtractFrom) > 1
  958.     ThisChar = Right$(strStore, 1)
  959.     If Not ThisChar = "\" Then
  960.         RetStr = ThisChar & RetStr
  961.         strStore = Left$(strStore, Len(strStore) - 1)
  962.     Else
  963.         Exit Do
  964.     End If
  965. Loop
  966. LastPath = RetStr
  967.  
  968.  
  969. End Function
  970.  
  971. Function AddBack(PathToAddto As String) As String
  972. 'adds a backslash '\' to the string passed
  973. Dim rtnstr As String
  974. rtnstr = PathToAddto
  975. If Not Right$(rtnstr, 1) = "\" Then rtnstr = rtnstr & "\"
  976. AddBack = rtnstr
  977. End Function
  978.  
  979. Public Sub mp(NewMousePointer As Integer)
  980. DoEvents
  981. Select Case NewMousePointer
  982. Case 0 To 15
  983.     Screen.MousePointer = NewMousePointer
  984. Case 99
  985.     Screen.MousePointer = NewMousePointer
  986. Case Else
  987.     Screen.MousePointer = 0
  988. End Select
  989. End Sub
  990.  
  991. Public Function JustExtension(GetExtFrom As String) As String
  992. Dim RetStr As String, I As Integer, ThisChar As String, ExtensionText As String
  993. ExtensionText = GetExtFrom
  994. If InStr(1, GetExtFrom, ".") > 0 Then
  995.     For I = 1 To Len(GetExtFrom)
  996.         ThisChar = Right$(ExtensionText, 1)
  997.         ExtensionText = Left$(ExtensionText, Len(ExtensionText) - 1)
  998.         If ThisChar = "." Then
  999.             Exit For
  1000.         Else
  1001.             RetStr = ThisChar & RetStr
  1002.         End If
  1003.     Next I
  1004.     JustExtension = RetStr
  1005. Else
  1006.     JustExtension = ""
  1007. End If
  1008.  
  1009. End Function
  1010.  
  1011.  
  1012. Public Function JustFileName(FName As String) As String
  1013. Dim I As Integer, ThisFile As String
  1014. On Local Error Resume Next
  1015. ThisFile = FName
  1016. Do While InStr(1, ThisFile, "\") > 0
  1017.     ThisFile = Mid$(ThisFile, 2)
  1018. Loop
  1019. JustFileName = ThisFile
  1020. End Function
  1021.  
  1022. Public Function GetMyReg(Section, key, Optional DefaultReturn As Variant, Optional FileIni As Variant) As Variant
  1023. 'buffer up return string
  1024. Dim ReturnString As String, TheInifile As String
  1025.  
  1026. 'which inifile to use
  1027. If IsMissing(FileIni) Then
  1028.     TheInifile = IniFile
  1029. Else
  1030.     TheInifile = CStr(FileIni)
  1031. End If
  1032.  
  1033. If Win95RegBase = "" Then 'use VB call to reg location "[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\"
  1034.     If IsMissing(DefaultReturn) Then
  1035.         ReturnString = GetSetting(Left$(TheInifile, (InStr(1, TheInifile, ".") - 1)), Section, key)
  1036.     Else
  1037.         ReturnString = GetSetting(Left$(TheInifile, (InStr(1, TheInifile, ".") - 1)), Section, key)
  1038.         If ReturnString = "" Then ReturnString = CStr(DefaultReturn)
  1039.     End If
  1040. Else 'use win api calls to proper location
  1041.     
  1042. End If
  1043. 'calculate result and send back
  1044. GetMyReg = ReturnString
  1045.     
  1046. End Function
  1047.  
  1048. Public Function WriteMyReg(Section As String, key As String, Setting As String, Optional FileIni As Variant) As Integer
  1049. Dim TheInifile As String
  1050.  
  1051. 'which inifile to use
  1052. If IsMissing(FileIni) Then
  1053.     TheInifile = IniFile
  1054. Else
  1055.     TheInifile = CStr(FileIni)
  1056. End If
  1057.  
  1058. On Error Resume Next
  1059. Call SaveSetting(Left$(TheInifile, (InStr(1, TheInifile, ".") - 1)), Section, key, Setting)
  1060. If Err <> 0 Then
  1061.     WriteMyReg = 0
  1062.     MsgBox "Error Writing to System Registry", 64, Title$
  1063.     Exit Function
  1064. End If
  1065. WriteMyReg = Len(Setting)
  1066. End Function
  1067.  
  1068. Public Function IsDrive(Drive As String) As Boolean
  1069. 'Purpose - See If Drive is a valid Drive
  1070.  
  1071. 'Returns - True if Drive Exists
  1072. '        - False if Drive Does Not Exist
  1073.  
  1074. 'caution if floppy or cd then returns false if no disk in drive
  1075.  
  1076.  
  1077. Dim TempDrive As String, DriveNum As Integer, Result As Long
  1078.  
  1079. 'Strip Drive To First Character Using JustDrive
  1080. TempDrive = Left$(JustDrive(Drive), 1)
  1081.  
  1082. 'Set DriveNum for Call To DLL
  1083. DriveNum = Asc(TempDrive)
  1084. If DriveNum < 65 Or DriveNum > 90 Then
  1085.     DriveNum = 68
  1086. End If
  1087. DriveNum = DriveNum - 64 '(with HDCalls A = 1; B = 2; C = 3; etc)
  1088.  
  1089. 'make call
  1090. Result = HDFree(DriveNum)
  1091.  
  1092. 'process result
  1093. If Result = -1 Then
  1094.     IsDrive = False 'drive does not exist
  1095. Else
  1096.     IsDrive = True 'drive does exist
  1097. End If
  1098. End Function
  1099.  
  1100. Public Function JustDrive(Path As String) As String
  1101. Dim Num As Integer, TempDrive As String
  1102. TempDrive = Left$(UCase$(Path), 1)
  1103. Num = Asc(TempDrive)
  1104. If Num < 65 Or Num > 90 Then
  1105.     Num = 68 'default c for C:
  1106. End If
  1107. JustDrive = Chr$(Num) & ":" 'send back result
  1108.  
  1109. End Function
  1110.  
  1111.  
  1112. Public Function StripSpaces(ByVal ToStripFrom As String) As String
  1113. Do While InStr(1, ToStripFrom, " ") > 0
  1114.     ToStripFrom = Left$(ToStripFrom, InStr(1, ToStripFrom, " ") - 1) & Mid$(ToStripFrom, InStr(1, ToStripFrom, " ") + 1)
  1115. Loop
  1116. StripSpaces = ToStripFrom
  1117. End Function
  1118.  
  1119. Public Function NotBack(Path As String) As String
  1120. If Right$(Path, 1) = "\" Then
  1121.     Path = Left$(Path, Len(Path) - 1)
  1122. End If
  1123. NotBack = Path
  1124. End Function
  1125.  
  1126. Public Function Inc(X As Integer) As Integer
  1127. On Error GoTo IncErr
  1128. X = X + 1
  1129.  
  1130. IncEP: 'exit point
  1131. Inc = X
  1132. Exit Function
  1133.  
  1134. IncErr:
  1135. X = 0
  1136. GoTo IncEP
  1137. End Function
  1138. Public Function Dec(X As Integer) As Integer
  1139. On Error GoTo DecErr
  1140. X = X - 1
  1141.  
  1142. DecEP: 'exit point
  1143. Dec = X
  1144. Exit Function
  1145.  
  1146. DecErr:
  1147. X = 0
  1148. GoTo DecEP
  1149. End Function
  1150.  
  1151.  
  1152. Public Function ReverseText(TextToReverse As String) As String
  1153. Dim I As Long, RetStr As String, ThisChar As String
  1154. For I = 0 To Len(TextToReverse)
  1155.     ThisChar = Left$(TextToReverse, 1)
  1156.     TextToReverse = Mid$(TextToReverse, 2)
  1157.     RetStr = ThisChar & RetStr
  1158. Next I
  1159. ReverseText = RetStr
  1160. End Function
  1161.  
  1162. Public Function FindInList(Hwnd As Long, Text As String) As Long
  1163. On Error GoTo FindInListErr
  1164. If Text = "" Then
  1165.     FindInList = -1
  1166.     Exit Function
  1167. End If
  1168. FindInList = SendMessage(Hwnd, LB_FINDSTRING, -1, ByVal CStr(Text))
  1169. FindInListEP: 'Exit Point
  1170. Exit Function
  1171. FindInListErr: 'err handler
  1172. FindInList = -1
  1173. GoTo FindInListErr
  1174. End Function
  1175. Public Function FindInCombo(Hwnd As Long, Text As String) As Long
  1176. On Error GoTo FindInComboErr
  1177. If Text = "" Then
  1178.     FindInCombo = -1
  1179.     Exit Function
  1180. End If
  1181. FindInCombo = SendMessage(Hwnd, CB_FINDSTRING, -1, ByVal CStr(Text))
  1182. FindInComboEP: 'Exit Point
  1183. Exit Function
  1184. FindInComboErr: 'err handler
  1185. FindInCombo = -1
  1186. GoTo FindInComboErr
  1187. End Function
  1188.