home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_tools / manythng / manythng.bas < prev    next >
BASIC Source File  |  1994-09-28  |  23KB  |  608 lines
  1. ' ManyThng.BAS -- This is my attempt at a variable screen saver
  2. '   It is based on an example in "Learn Programming and Visual Basic 2.0"
  3. '   by John Socha and Sybex Inc., (highly recommended)
  4.  
  5. ' first written 4-15-93 Bruce McLean
  6. '
  7. Option Explicit
  8.  
  9. '
  10. ' These variables support saving the maximum number of lines
  11. ' in the CONTROL.INI file, which is where the Windows 3.1
  12. ' screen savers save setup information.
  13. '
  14. Global MaxLines As Integer      ' Lines to show before CLS
  15. Global RepeatCount As Integer   ' # of lines the same color
  16. Global MaxChangeMinutes As Single   ' minutes to go before changing color
  17. Global MaxCums As Integer      ' total number of lines before clearing screen
  18. Global BitmapsDir As String ' place to look for bitmaps
  19. Global CycleBitmapsDir As String ' place to look for bitmaps for palette cycling
  20. Global BmpSeconds As Integer ' seconds between bitmaps on slide show
  21. Global RandomFlag As Integer ' non-zero means pick saver at random, else go in sequence
  22. Global StartSaver As Integer ' zero means pick 1st saver at random, else start with saver the corresponds to value
  23. Global ErrorTrace As Integer ' flag to log data for error tracing
  24. Global LowMemoryFlag As Integer 'set this to run special low memory mode
  25. Global TestMode As Integer 'this mode is for debugging code
  26. Global Passwd As String 'where master password is stored
  27. Global Const Scramble = "soDSM" 'to scramble password
  28. Global PasswdScram As String 'scrambled password
  29. Global TotalNumColors As Long 'place to store number of colors display can handle
  30. Global PaletteHandle As Integer
  31. Global FastPaletteCycleFlag As Integer
  32.  
  33. Global Const iniName = "CONTROL.INI"
  34. Global Const secName = "Screen Saver.Many Things"
  35. Global Const keyName = "MaxLines"
  36. Global Const RepeatName = "RepeatCount"
  37. Global Const ChangeMinutesName = "MaxChangeMinutes"
  38. Global Const MaxCumsName = "MaxCumLines"
  39. Global Const BmpsDirName = "BitmapsDir"
  40. Global Const CycleBmpsDirName = "CycleBitmapsDir"
  41. Global Const BmpSecondsName = "BmpSeconds"
  42. Global Const RandomFlagName = "RandomFlag"
  43. Global Const LowMemoryFlagName = "LowMemoryFlag"
  44. Global Const StartSaverName = "StartSaver"
  45. Global Const ErrorTraceName = "ErrorTrace"
  46. Global Const PasswordName = "Password"
  47. Global Const PriorityBaseName = "Priority"
  48. Global Const FastPaletteCycleName = "FastPaletteCycle"
  49.  
  50. Global Const NUMCHARS = 25
  51.     
  52. ' windows defines
  53. Type RECT
  54.     left As Integer
  55.     top As Integer
  56.     right As Integer
  57.     bottom As Integer
  58. End Type
  59.  
  60. 'Polygon routine that draws any arbitray polygon using fill, etc.
  61. Type POINTAPI
  62.     X As Integer
  63.     Y As Integer
  64. End Type
  65.  
  66. ' paint type
  67. Type PAINTSTRUCT     '32 Bytes
  68.     hDC As Integer
  69.     fErase As Integer
  70.     rcPaint As RECT
  71.     fRestore As Integer
  72.     fIncUpdate As Integer
  73.     rgbReserved As String * 16
  74. End Type
  75.  
  76. Global Const PALENTRIES = 256
  77.  
  78. '   This is similar to the LOGPALLETTE defined in
  79. '   APIDECS.BAS, however instead of using a buffer, we
  80. '   create a 64 entry palette for our use.
  81.  
  82. Type PALETTEENTRY    '4 Bytes
  83.     peRed As String * 1
  84.     peGreen As String * 1
  85.     peBlue As String * 1
  86.     peFlags As String * 1
  87. End Type
  88.  
  89. Type LOGPALETTE
  90.     palVersion As Integer
  91.     palNumEntries As Integer
  92.     palPalEntry(PALENTRIES) As PALETTEENTRY
  93. End Type
  94.  
  95. Global Pal As LOGPALETTE
  96.  
  97. 'Many things DLL routines used:
  98. Declare Function ManyDibAlloc Lib "mnythdll.dll" (ByVal Wdth As Integer, ByVal Hght As Integer) As Long
  99. Declare Function ManyDibFree Lib "mnythdll.dll" () As Integer
  100. Declare Function ManyDibGet Lib "mnythdll.dll" () As Long
  101. Declare Function ManyDibGetData Lib "mnythdll.dll" () As Long
  102. Declare Function ManyDibLoad Lib "mnythdll.dll" (ByVal FileName As String, Wdth As Integer, Hght As Integer) As Long
  103. Declare Function ManyGifLoad Lib "mnythdll.dll" (ByVal FileName As String, Wdth As Integer, Hght As Integer) As Long
  104. Declare Function ManyDibInit Lib "mnythdll.dll" () As Long
  105. Declare Sub ManyDibModPalette Lib "mnythdll.dll" (ByVal red As Integer, ByVal green As Integer, ByVal blue As Integer)
  106. Declare Sub ManyDibCyclePalette Lib "mnythdll.dll" (ByVal StepSize As Integer, ByVal LowValue As Integer, ByVal HighValue As Integer)
  107. Declare Sub ManyLoadLogPal Lib "mnythdll.dll" (Pal As LOGPALETTE, ByVal Start As Integer, ByVal size As Integer, ByVal Flags As Integer)
  108. Declare Function ManyDIBWrite Lib "mnythdll.dll" (ByVal FileName As String) As Integer
  109.  
  110.  
  111. ' Windows API Routines used:
  112. Declare Function ShowCursor Lib "USER" (ByVal fShow As Integer) As Integer
  113. Declare Sub BitBlt Lib "GDI" (ByVal DestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal BWidth As Integer, ByVal BHeight As Integer, ByVal SourceDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal Constant As Long)
  114. Declare Function StretchBlt Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal nSrcWidth As Integer, ByVal nSrcHeight As Integer, ByVal dwRop As Long) As Integer
  115. Declare Function CopyRect Lib "User" (lpDestRect As RECT, lpSourceRect As RECT) As Integer
  116. Declare Function CreateDC Lib "GDI" (ByVal Driver As Any, ByVal Dev As Any, ByVal O As Any, ByVal Init As Any) As Integer
  117. Declare Sub DrawIcon Lib "User" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal hIcon As Integer)
  118. Declare Function GetCursor Lib "User" () As Integer
  119. Declare Sub GetCursorPos Lib "User" (lpPNT As Integer)
  120. Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  121. Declare Function LockResource Lib "Kernel" (ByVal hRes As Integer) As Long
  122. Declare Sub UnlockResource Lib "Kernel" Alias "GlobalUnlock" (ByVal hRes As Integer)
  123. Declare Sub FloodFill Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal color As Long)
  124. Declare Function Polygon Lib "GDI" (ByVal hDC As Integer, lpPoints As POINTAPI, ByVal nCount As Integer) As Integer
  125. Declare Function SetPolyFillMode Lib "GDI" (ByVal hDC As Integer, ByVal nPolyFillMode As Integer) As Integer
  126. Declare Function GetNearestColor Lib "GDI" (ByVal hDC As Integer, ByVal crColor As Long) As Long
  127. Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  128. Declare Function SetSysModalWindow Lib "User" (ByVal hWnd As Integer) As Integer
  129. Declare Function SystemParametersInfo Lib "User" (ByVal uAction%, ByVal uParam%, lpvParam As Any, ByVal fuWinIni%) As Integer
  130. Declare Function SelectObject Lib "GDI" (ByVal hDC%, ByVal hObject%) As Integer
  131. Declare Function CreateCompatibleDC Lib "GDI" (ByVal hDC%) As Integer
  132. Declare Function DeleteDC Lib "GDI" (ByVal hDC%) As Integer
  133. Declare Function StretchDIBits% Lib "GDI" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal dX%, ByVal dY%, ByVal SrcX%, ByVal SrcY%, ByVal wSrcWidth%, ByVal wSrcHeight%, ByVal lpBits As Long, ByVal lpBitsInfo As Long, ByVal wUsage%, ByVal dwRop&)
  134. Declare Function SetStretchBltMode% Lib "GDI" (ByVal hDC%, ByVal nStretchMode%)
  135. Declare Function BeginPaint% Lib "User" (ByVal hWnd%, lpPaint As PAINTSTRUCT)
  136. Declare Sub EndPaint Lib "User" (ByVal hWnd%, lpPaint As PAINTSTRUCT)
  137. Declare Function SetDIBitsToDevice% Lib "GDI" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal dX%, ByVal dY%, ByVal SrcX%, ByVal SrcY%, ByVal Scan%, ByVal NumScans%, ByVal Bits As Long, ByVal BitsInfo As Long, ByVal wUsage%)
  138. Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  139. Declare Function SendMessageByNum& Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam&)
  140. Declare Function OpenClipboard% Lib "User" (ByVal hWnd%)
  141. Declare Function SetClipboardData% Lib "User" (ByVal wFormat%, ByVal hMem%)
  142. Declare Function CloseClipboard% Lib "User" ()
  143. Declare Sub AnimatePalette Lib "GDI" (ByVal hPalette%, ByVal wStartIndex%, ByVal wNumEntries%, lpPaletteColors As PALETTEENTRY)
  144. Declare Function CreatePalette% Lib "GDI" (lpLogPalette As LOGPALETTE)
  145. Declare Function SelectPalette% Lib "User" (ByVal hDC%, ByVal hPalette%, ByVal bForceBackground%)
  146. Declare Function RealizePalette% Lib "User" (ByVal hDC%)
  147. Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  148. Declare Function SetSystemPaletteUse% Lib "GDI" (ByVal hDC%, ByVal wUsage%)
  149. Declare Function GetFreeSystemResources% Lib "User" (ByVal fuSysResource%)
  150. Declare Function GetFreeSpace& Lib "Kernel" (ByVal wFlags%)
  151. Declare Function SetPaletteEntries% Lib "GDI" (ByVal hPalette%, ByVal wStartIndex%, ByVal wNumEntries%, lpPaletteEntries As PALETTEENTRY)
  152. Declare Sub GetKeyboardStateBystring Lib "User" Alias "GetKeyboardState" (ByVal lpKeyState$)
  153. Declare Function ToAsciiBystring Lib "Keyboard" Alias "ToAscii" (ByVal wVirtKey%, ByVal wScanCode%, ByVal lpKeyState$, lpChar&, ByVal wFlags%) As Integer
  154. Declare Function MapVirtualKey Lib "Keyboard" (ByVal wCode%, ByVal wMapType%) As Integer
  155. Declare Function VkKeyScan Lib "Keyboard" (ByVal cChar%) As Integer
  156.  
  157. 'routines for reading profile data in 'CONTROL.INI'
  158. Declare Function GetPrivateProfileInt Lib "KERNEL" (ByVal lpszSectionName As String, ByVal lpszKeyName As String, ByVal nDefault As Integer, ByVal lpszFileName As String) As Integer
  159. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  160. Declare Function WritePrivateProfileString Lib "KERNEL" (ByVal lpszSectionName As String, ByVal lpszKeyName As String, ByVal nString As String, ByVal lpszFileName As String) As Integer
  161.  
  162.  
  163. ' variables and constants to be used for screen capture
  164. Global ScrnWidth As Integer, ScrnHeight As Integer
  165. Dim RECT(3) As Integer
  166.  
  167. Global Const PI = 3.141592654
  168.  
  169. 'Device Parameters for GetDeviceCaps()
  170. Global Const DRIVERVERSION = 0  '  Device driver version
  171. Global Const TECHNOLOGY = 2 '  Device classification
  172. Global Const HORZSIZE = 4   '  Horizontal size in millimeters
  173. Global Const VERTSIZE = 6   '  Vertical size in millimeters
  174. Global Const HORZRES = 8    '  Horizontal width in pixels
  175. Global Const VERTRES = 10   '  Vertical width in pixels
  176. Global Const BITSPIXEL = 12 '  Number of bits per pixel
  177. Global Const PLANES = 14    '  Number of planes
  178. Global Const NUMBRUSHES = 16    '  Number of brushes the device has
  179. Global Const NUMPENS = 18   '  Number of pens the device has
  180. Global Const NUMMARKERS = 20    '  Number of markers the device has
  181. Global Const NUMFONTS = 22  '  Number of fonts the device has
  182. Global Const NumColors = 24 '  Number of colors the device supports
  183. Global Const PDEVICESIZE = 26   '  Size required for device descriptor
  184. Global Const CURVECAPS = 28 '  Curve capabilities
  185. Global Const LINECAPS = 30  '  Line capabilities
  186. Global Const POLYGONALCAPS = 32 '  Polygonal capabilities
  187. Global Const TEXTCAPS = 34  '  Text capabilities
  188. Global Const CLIPCAPS = 36  '  Clipping capabilities
  189. Global Const RASTERCAPS = 38    '  Bitblt capabilities
  190. Global Const ASPECTX = 40   '  Length of the X leg
  191. Global Const ASPECTY = 42   '  Length of the Y leg
  192. Global Const ASPECTXY = 44  '  Length of the hypotenuse
  193.  
  194. Global Const LOGPIXELSX = 88    '  Logical pixels/inch in X
  195. Global Const LOGPIXELSY = 90    '  Logical pixels/inch in Y
  196.  
  197. Global Const SIZEPALETTE = 104  '  Number of entries in physical palette
  198. Global Const NUMRESERVED = 106  '  Number of reserved entries in palette
  199. Global Const COLORRES = 108 '  Actual color resolution
  200.  
  201. Global Const SPI_SETSCREENSAVEACTIVE = 17
  202.  
  203. Global Const PC_RESERVED = &H1
  204. Global Const PC_EXPLICIT = &H2
  205. Global Const PC_NOCOLLAPSE = &H4
  206. Global Const DIB_RGB_COLORS = 0
  207. Global Const DIB_PAL_COLORS = 1
  208. Global Const SYSPAL_STATIC = 1
  209. Global Const SYSPAL_NOSTATIC = 2
  210. Global Const CF_TEXT = 1
  211. Global Const CF_BITMAP = 2
  212. Global Const CF_METAFILEPICT = 3
  213. Global Const CF_SYLK = 4
  214. Global Const CF_DIF = 5
  215. Global Const CF_TIFF = 6
  216. Global Const CF_OEMTEXT = 7
  217. Global Const CF_DIB = 8
  218. Global Const CF_PALETTE = 9
  219. Global Const CF_OWNERDISPLAY = &H80
  220. Global Const CF_DSPTEXT = &H81
  221. Global Const CF_DSPBITMAP = &H82
  222. Global Const CF_DSPMETAFILEPICT = &H83
  223. Global Const CF_PRIVATEFIRST = &H200
  224. Global Const CF_PRIVATELAST = &H2FF
  225.  
  226. ' This is a message used within Visual Basic to retrieve
  227. ' the handle of a palette
  228. Global Const VBM_GETPALETTE% = &H101C
  229.  
  230. '' GetFreeSystemResources constants
  231. Global Const GFSR_SYSTEMRESOURCES = 0
  232. Global Const GFSR_GDIRESOURCES = 1
  233. Global Const GFSR_USERRESOURCES = 2
  234.  
  235. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  236. ' Key Codes for keyup and keydown
  237. Global Const KEY_LBUTTON = &H1
  238. Global Const KEY_RBUTTON = &H2
  239. Global Const KEY_CANCEL = &H3
  240. Global Const KEY_MBUTTON = &H4    ' NOT contiguous with L & RBUTTON
  241. Global Const KEY_BACK = &H8
  242. Global Const KEY_TAB = &H9
  243. Global Const KEY_CLEAR = &HC
  244. Global Const KEY_RETURN = &HD
  245. Global Const KEY_SHIFT = &H10
  246. Global Const KEY_CONTROL = &H11
  247. Global Const KEY_MENU = &H12
  248. Global Const KEY_PAUSE = &H13
  249. Global Const KEY_CAPITAL = &H14
  250. Global Const KEY_ESCAPE = &H1B
  251. Global Const KEY_SPACE = &H20
  252. Global Const KEY_PRIOR = &H21
  253. Global Const KEY_NEXT = &H22
  254. Global Const KEY_END = &H23
  255. Global Const KEY_HOME = &H24
  256. Global Const KEY_LEFT = &H25
  257. Global Const KEY_UP = &H26
  258. Global Const KEY_RIGHT = &H27
  259. Global Const KEY_DOWN = &H28
  260. Global Const KEY_SELECT = &H29
  261. Global Const KEY_PRINT = &H2A
  262. Global Const KEY_EXECUTE = &H2B
  263. Global Const KEY_SNAPSHOT = &H2C
  264. Global Const KEY_INSERT = &H2D
  265. Global Const KEY_DELETE = &H2E
  266. Global Const KEY_HELP = &H2F
  267.  
  268. ' KEY_A thru KEY_Z are the same as their ASCII equivalents: 'A' thru 'Z'
  269. ' KEY_0 thru KEY_9 are the same as their ASCII equivalents: '0' thru '9'
  270.  
  271. Global Const KEY_NUMPAD0 = &H60
  272. Global Const KEY_NUMPAD1 = &H61
  273. Global Const KEY_NUMPAD2 = &H62
  274. Global Const KEY_NUMPAD3 = &H63
  275. Global Const KEY_NUMPAD4 = &H64
  276. Global Const KEY_NUMPAD5 = &H65
  277. Global Const KEY_NUMPAD6 = &H66
  278. Global Const KEY_NUMPAD7 = &H67
  279. Global Const KEY_NUMPAD8 = &H68
  280. Global Const KEY_NUMPAD9 = &H69
  281. Global Const KEY_MULTIPLY = &H6A
  282. Global Const KEY_ADD = &H6B
  283. Global Const KEY_SEPARATOR = &H6C
  284. Global Const KEY_SUBTRACT = &H6D
  285. Global Const KEY_DECIMAL = &H6E
  286. Global Const KEY_DIVIDE = &H6F
  287. Global Const KEY_F1 = &H70
  288. Global Const KEY_F2 = &H71
  289. Global Const KEY_F3 = &H72
  290. Global Const KEY_F4 = &H73
  291. Global Const KEY_F5 = &H74
  292. Global Const KEY_F6 = &H75
  293. Global Const KEY_F7 = &H76
  294. Global Const KEY_F8 = &H77
  295. Global Const KEY_F9 = &H78
  296. Global Const KEY_F10 = &H79
  297. Global Const KEY_F11 = &H7A
  298. Global Const KEY_F12 = &H7B
  299. Global Const KEY_F13 = &H7C
  300. Global Const KEY_F14 = &H7D
  301. Global Const KEY_F15 = &H7E
  302. Global Const KEY_F16 = &H7F
  303.  
  304. Sub decode ()
  305.   
  306.   Dim i As Integer
  307.   Dim code As Integer
  308.   Dim code2 As Integer
  309.   Dim j As Integer
  310.  
  311.   Passwd = ""
  312.  
  313.   If PasswdScram = "" Then 'if no password, then done
  314.     Exit Sub
  315.   End If
  316.  
  317.   j = Len(Scramble)
  318.  
  319.   For i = 1 To Len(PasswdScram) Step 2
  320.  
  321.     code = (Asc("z") - Asc(Mid$(PasswdScram, i, 1))) * 16 + (Asc(Mid$(PasswdScram, i + 1, 1)) - Asc("a"))
  322.     code2 = Asc(Mid$(Scramble, (((i + 1) / 2) Mod j) + 1, 1))
  323.     code = code Xor code2
  324.     Passwd = Passwd + Chr$(code)
  325.  
  326.   Next i
  327.     
  328.   
  329.  
  330. End Sub
  331.  
  332. Sub Delay (t As Long)
  333. ' wait for t seconds before returning
  334.  
  335.   Dim CurrentTime As Long, LastTime As Long, EndTime As Long
  336.  
  337.   LastTime = Timer
  338.   EndTime = LastTime + t
  339.  
  340.   Do
  341.     DoEvents
  342.     CurrentTime = Timer
  343.     If (CurrentTime > EndTime) Or (LastTime > CurrentTime) Then Exit Sub
  344.   Loop
  345.  
  346. End Sub
  347.  
  348. Sub encode ()
  349.  
  350.   Dim i As Integer
  351.   Dim code As Integer
  352.   Dim code2 As Integer
  353.   Dim j As Integer
  354.  
  355.   PasswdScram = ""
  356.  
  357.   If Passwd = "" Then 'if no password, then no scramble
  358.     Exit Sub
  359.   End If
  360.  
  361.   j = Len(Scramble)
  362.  
  363.   For i = 1 To Len(Passwd)
  364.  
  365.     code = Asc(Mid$(Passwd, i, 1))
  366.     code2 = Asc(Mid$(Scramble, (i Mod j) + 1, 1))
  367.     code = code Xor code2
  368.  
  369.     PasswdScram = PasswdScram + Chr$(Asc("z") - (code \ 16)) + Chr$(Asc("a") + (code Mod 16))
  370.  
  371.   Next i
  372.     
  373.  
  374. End Sub
  375.  
  376. Sub EndScrnSave ()
  377.     Dim i As Integer
  378.  
  379.     ShowMouse                   ' Make mouse pointer visible again
  380.     LogFile ("ManyThng done"), 1  ' make log
  381.  
  382.     'tell windows to enable screen savers
  383.     i = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, True, 0, 0)
  384.     End                         ' And exit
  385. End Sub
  386.  
  387. Function GetNextExtension (BitmapsDir As String, Ext1 As String, Ext2 As String, Ext3 As String) As String
  388.  
  389.   Dim i As Integer, File As String, StartSpec As String, temp As String
  390.  
  391.   i = 0 'count number of attempts
  392.   Do
  393.     StartSpec = Ext1
  394.     i = i + 1' count attempts
  395.  
  396.     If StartSpec = "" Then
  397.       File = ""
  398.     Else
  399.       On Error GoTo GNE_Error
  400.       File = Dir$(RTrim$(BitmapsDir) + "\*." + StartSpec)
  401.       On Error GoTo 0
  402.     End If
  403.  
  404.     'now rotate extension for next time
  405.     temp = Ext1: Ext1 = Ext2: Ext2 = Ext3: Ext3 = temp
  406.  
  407.   Loop While File = "" And i < 3
  408.  
  409.   GetNextExtension = File
  410.   Exit Function
  411.  
  412. GNE_Error:
  413.   'directory path does not exist
  414.   On Error GoTo 0
  415.   File = ""
  416.   Resume Next
  417.  
  418. End Function
  419.  
  420. Function GetNextFile (BitmapsDir As String, NewSequence As Integer, Ext1 As String, Ext2 As String, Ext3 As String) As String
  421.   'get next file using file extensions Ext1 to 3
  422.   Static Ex1 As String, Ex2 As String, Ex3 As String
  423.   Dim File As String
  424.  
  425.   'start new series
  426.   If NewSequence Then
  427.     Ex1 = Ext1
  428.     Ex2 = Ext2
  429.     Ex3 = Ext3
  430.  
  431.     File = GetNextExtension(BitmapsDir, Ex1, Ex2, Ex3)
  432.   Else
  433.     On Error GoTo GNF_Error
  434.     File = Dir$ 'get next in series
  435.     On Error GoTo 0
  436.     If File = "" Then ' if none available, get next
  437.       File = GetNextExtension(BitmapsDir, Ex1, Ex2, Ex3)
  438.     End If
  439.   End If
  440.  
  441.   If File <> "" Then
  442.     File = RTrim$(BitmapsDir) + "\" + File
  443.   End If
  444.  
  445.   GetNextFile = File
  446.  
  447.   Exit Function
  448.  
  449. GNF_Error: 'directory path does not exist
  450.   On Error GoTo 0
  451.   File = ""
  452.   Resume Next
  453.  
  454. End Function
  455.  
  456. Sub HideMouse ()
  457.     While ShowCursor(False) >= 0
  458.     Wend
  459. End Sub
  460.  
  461. Function Int2Str (i As Integer) As String
  462.  
  463.   Int2Str = RTrim$(LTrim$(Str$(i)))
  464.  
  465. End Function
  466.  
  467. Sub LogFile (A As String, StoreResources As Integer)
  468.  
  469.   Dim i As Integer, l As Long
  470.  
  471.   'to enable logging comment out next line
  472.   If Not ErrorTrace Then
  473.     Exit Sub
  474.   End If
  475.  
  476.   Open "c:\manythng.log" For Append Access Write As #1
  477.   Print #1, Date; "  "; Time; " "; A;
  478.  
  479.   'see if we want to save resources
  480.   If StoreResources Then
  481.  
  482.     i = GetFreeSystemResources(GFSR_SYSTEMRESOURCES)
  483.     Print #1, "; System="; i;
  484.     i = GetFreeSystemResources(GFSR_GDIRESOURCES)
  485.     Print #1, "%; GDI="; i;
  486.     i = GetFreeSystemResources(GFSR_USERRESOURCES)
  487.     Print #1, "%; User="; i;
  488.     l = GetFreeSpace(0)
  489.     Print #1, "%; Free="; l
  490.   Else
  491.     Print #1,
  492.   End If
  493.  
  494.   Close #1
  495.  
  496. End Sub
  497.  
  498. Sub main ()
  499.     
  500.     Dim i As Integer
  501.     Dim DC As Integer
  502.     Dim temp As String
  503.     Dim temp2 As String * 128
  504.  
  505.     'see if error tracing is enabled
  506.     ' to enable, edit "control.ini" in windows directory
  507.     ' in section "[Screen Saver.Many Things]"
  508.     ' add line:  "ErrorTrace=ON"
  509.     ' to disable delete line
  510.     i = GetPrivateProfileString(secName, ErrorTraceName, "OFF", temp2, 125, iniName)
  511.     ErrorTrace = False ' default state
  512.     If UCase$(Left$(temp2, 2)) = "ON" Then
  513.       ErrorTrace = True ' default state
  514.     End If
  515.  
  516.     LogFile (Chr$(13) + Chr$(10) + "-----------------" + Chr$(13) + Chr$(10) + "Starting ManyThng"), 1
  517.  
  518.     ' check if first instance of program so we can be sure that only one is running
  519.     If App.PrevInstance Then
  520.       LogFile ("Previous Instance of ManyThng"), 0
  521.       EndScrnSave
  522.     End If
  523.  
  524.     ' first capture screen into Form 'Original' for later use
  525.     DC = CreateDC("DISPLAY", 0&, 0&, 0&)
  526.     ScrnWidth = GetDeviceCaps(DC, HORZRES)
  527.     ScrnHeight = GetDeviceCaps(DC, VERTRES)
  528.     BitBlt Original.hDC, 0, 0, ScrnWidth, ScrnHeight, DC, 0, 0, &HCC0020
  529.     i = DeleteDC(DC)
  530.  
  531.     '
  532.     ' This next lines of code get numbers from the CONTROL.INI
  533.     ' file in your Windows directory.
  534.     '
  535.     MaxLines = GetPrivateProfileInt(secName, keyName, 80, iniName)
  536.     RepeatCount = GetPrivateProfileInt(secName, RepeatName, 15, iniName)
  537.     i = GetPrivateProfileString(secName, ChangeMinutesName, "1", temp2, 125, iniName)
  538.     MaxChangeMinutes = Val(temp2)
  539.     MaxCums = GetPrivateProfileInt(secName, MaxCumsName, 400, iniName)
  540.     BmpSeconds = GetPrivateProfileInt(secName, BmpSecondsName, 5, iniName)
  541.     RandomFlag = GetPrivateProfileInt(secName, RandomFlagName, 1, iniName)
  542.     FastPaletteCycleFlag = GetPrivateProfileInt(secName, FastPaletteCycleName, 1, iniName)
  543.     StartSaver = GetPrivateProfileInt(secName, StartSaverName, 0, iniName)
  544.     LowMemoryFlag = GetPrivateProfileInt(secName, LowMemoryFlagName, 0, iniName)
  545.     i = GetPrivateProfileString(secName, PasswordName, "", temp2, 125, iniName)
  546.     i = InStr(temp2, Chr$(0))
  547.     PasswdScram = Left$(temp2, i - 1)
  548.     Call decode
  549.  
  550.     ' get bitmaps directory
  551.     i = GetPrivateProfileString(secName, BmpsDirName, "c:\windows", temp2, 125, iniName)
  552.     BitmapsDir = ""
  553.     For i = 1 To Len(temp2)' remove trailing whatevers from dir
  554.       temp = Mid$(temp2, i, 1)
  555.       If Asc(temp) <= 32 Or Asc(temp) > 126 Then GoTo Main_Done
  556.       BitmapsDir = BitmapsDir + temp
  557.     Next i
  558. Main_Done:
  559.  
  560.     ' get palette cycling bitmaps directory
  561.     i = GetPrivateProfileString(secName, CycleBmpsDirName, "c:\windows\cycle", temp2, 125, iniName)
  562.     CycleBitmapsDir = ""
  563.     For i = 1 To Len(temp2)' remove trailing whatevers from dir
  564.       temp = Mid$(temp2, i, 1)
  565.       If Asc(temp) <= 32 Or Asc(temp) > 126 Then GoTo Main_Done2
  566.       CycleBitmapsDir = CycleBitmapsDir + temp
  567.     Next i
  568. Main_Done2:
  569.     
  570.       
  571.     'look for test mode, used when debugging in VisBasic
  572.     If InStr(Command$, "/t") Then
  573.       TestMode = 1
  574.     Else
  575.       TestMode = 0
  576.     End If
  577.  
  578.     'see if starting saver selected
  579.     i = InStr(Command$, "/i=")
  580.     If i <> 0 Then
  581.       StartSaver = Val(Mid$(Command$, i + 3, 2))
  582.     End If
  583.  
  584.     ' Check to see if we should blank the screen, or display
  585.     ' the Setup dialog box.
  586.     '
  587.     If InStr(Command$, "/c") Then
  588.     LogFile ("Configuring ManyThng"), 0
  589.     SetupForm.Show 1
  590.     ElseIf InStr(Command$, "/s") Then
  591.     LogFile ("Running ManyThng"), 0
  592.     ManyThings.Show
  593.     End If
  594.  
  595.     '
  596.     ' Wait until there are no forms visible, then quit.
  597.     '
  598.     While DoEvents() > 0        ' Loop until no forms visible
  599.     Wend
  600.     
  601. End Sub
  602.  
  603. Sub ShowMouse ()
  604.     While ShowCursor(True) < 0
  605.     Wend
  606. End Sub
  607.  
  608.