home *** CD-ROM | disk | FTP | other *** search
- VERSION 2.00
- Begin Form SetupForm
- BorderStyle = 3 'Fixed Double
- Caption = "Many Things"
- ClientHeight = 6165
- ClientLeft = 2310
- ClientTop = 1560
- ClientWidth = 5505
- Height = 6570
- Left = 2250
- LinkTopic = "Form2"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 6165
- ScaleWidth = 5505
- Top = 1215
- Width = 5625
- Begin CheckBox FastPaletteCycleCheck
- Caption = "Fast Palette Cycling"
- Height = 240
- Left = 2775
- TabIndex = 24
- Top = 4725
- Width = 2040
- End
- Begin TextBox txtCycleBmpsDir
- Height = 360
- Left = 3150
- TabIndex = 22
- Text = "c:\windows\cycle"
- Top = 4230
- Width = 2265
- End
- Begin CommandButton Password_Button
- Caption = "Password"
- Height = 375
- Left = 3600
- TabIndex = 11
- Top = 5490
- Width = 1185
- End
- Begin CheckBox LowMemoryCheck
- Caption = "Low Memory Mode"
- Height = 240
- Left = 300
- TabIndex = 7
- Top = 4725
- Width = 2115
- End
- Begin CheckBox RandomFlagCheck
- Caption = "Random Sequence"
- Height = 240
- Left = 300
- TabIndex = 8
- Top = 5100
- Width = 2130
- End
- Begin TextBox TxtStartSaver
- Height = 315
- Left = 4815
- TabIndex = 5
- Text = "0"
- Top = 3465
- Width = 615
- End
- Begin TextBox txtBmpSeconds
- Height = 315
- Left = 4815
- TabIndex = 4
- Text = "5"
- Top = 3105
- Width = 615
- End
- Begin TextBox txtBmpsDir
- Height = 315
- Left = 3150
- TabIndex = 6
- Text = "c:\windows"
- Top = 3825
- Width = 2280
- End
- Begin TextBox txtMaxCums
- Height = 315
- Left = 4815
- TabIndex = 2
- Text = "1000"
- Top = 2385
- Width = 615
- End
- Begin TextBox txtChangeMin
- Height = 315
- Left = 4815
- TabIndex = 3
- Text = "5"
- Top = 2745
- Width = 615
- End
- Begin TextBox txtRepeatCount
- Height = 315
- Left = 4815
- TabIndex = 1
- Text = "10"
- Top = 2025
- Width = 615
- End
- Begin TextBox txtMaxLines
- Height = 315
- Left = 4815
- TabIndex = 0
- Text = "100"
- Top = 1665
- Width = 615
- End
- Begin CommandButton cmdCancel
- Cancel = -1 'True
- Caption = "Cancel"
- Height = 375
- Left = 2160
- TabIndex = 10
- Top = 5490
- Width = 1095
- End
- Begin CommandButton cmdOK
- Caption = "OK"
- Default = -1 'True
- Height = 375
- Left = 675
- TabIndex = 9
- Top = 5490
- Width = 1140
- End
- Begin Label Label12
- Caption = "Dir. of GIFs for Palette Cyling:"
- Height = 240
- Left = 450
- TabIndex = 23
- Top = 4275
- Width = 2565
- End
- Begin Label Label11
- Caption = "Starting Saver (0=random):"
- Height = 225
- Left = 2430
- TabIndex = 21
- Top = 3510
- Width = 2325
- End
- Begin Label Label9
- Caption = "Seconds before changing pictures in slide show:"
- Height = 255
- Left = 690
- TabIndex = 20
- Top = 3150
- Width = 4170
- End
- Begin Label Label8
- Caption = "Dir. of BMPs + GIFs for slide show:"
- Height = 255
- Left = 75
- TabIndex = 19
- Top = 3870
- Width = 3015
- End
- Begin Label Label7
- Caption = "Maximum number of objects before clearing screen:"
- Height = 255
- Left = 300
- TabIndex = 18
- Top = 2430
- Width = 4485
- End
- Begin Label Label6
- Caption = "Minutes before changing to new saver:"
- Height = 255
- Left = 1350
- TabIndex = 17
- Top = 2775
- Width = 3375
- End
- Begin Label Label5
- Caption = "Number of new objects before changing colors:"
- Height = 255
- Left = 720
- TabIndex = 16
- Top = 2040
- Width = 4035
- End
- Begin Label Label4
- Caption = "Maximum number of objects before erasing old objects:"
- Height = 255
- Left = 90
- TabIndex = 15
- Top = 1710
- Width = 4740
- End
- Begin Image Image1
- Height = 480
- Left = 180
- Picture = SETUP.FRX:0000
- Top = 405
- Width = 480
- End
- Begin Label Label3
- Alignment = 2 'Center
- Caption = "Version 3.1"
- FontBold = 0 'False
- FontItalic = 0 'False
- FontName = "Arial"
- FontSize = 8.25
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 240
- Left = 2100
- TabIndex = 14
- Top = 585
- Width = 1260
- End
- Begin Label Label2
- Caption = "Multiple Screen Savers by Bruce McLean"
- Height = 255
- Left = 900
- TabIndex = 13
- Top = 225
- Width = 3765
- End
- Begin Label Label1
- Alignment = 2 'Center
- Caption = "This is a collection of screen savers that switch at regular intervals to add a bit of variety to the screen."
- FontBold = 0 'False
- FontItalic = 0 'False
- FontName = "Arial"
- FontSize = 8.25
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 495
- Left = 780
- TabIndex = 12
- Top = 1005
- Width = 3855
- End
- Option Explicit
- Sub cmdCancel_Click ()
- End ' end program
- End Sub
- Sub cmdOK_Click ()
- Dim i As Integer
- Dim File As Integer
- If FastPaletteCycleCheck.Value = 1 Then
- FastPaletteCycleFlag = 1
- Else
- FastPaletteCycleFlag = 0
- End If
- If RandomFlagCheck.Value = 1 Then
- RandomFlag = 1
- Else
- RandomFlag = 0
- End If
- If LowMemoryCheck.Value = 1 Then
- LowMemoryFlag = 1
- Else
- LowMemoryFlag = 0
- End If
- 'remove trailing \ from directory
- If Right$(txtBmpsDir, 1) = "\" Then
- txtBmpsDir = Left$(txtBmpsDir, Len(txtBmpsDir) - 1)
- End If
- 'remove trailing \ from directory
- If Right$(txtCycleBmpsDir, 1) = "\" Then
- txtCycleBmpsDir = Left$(txtCycleBmpsDir, Len(txtCycleBmpsDir) - 1)
- End If
- ' store setup data in control.ini
- i = WritePrivateProfileString(secName, keyName, txtMaxLines, iniName)
- i = WritePrivateProfileString(secName, RepeatName, txtRepeatCount, iniName)
- i = WritePrivateProfileString(secName, ChangeMinutesName, txtChangeMin, iniName)
- i = WritePrivateProfileString(secName, MaxCumsName, txtMaxCums, iniName)
- i = WritePrivateProfileString(secName, BmpsDirName, txtBmpsDir, iniName)
- i = WritePrivateProfileString(secName, CycleBmpsDirName, txtCycleBmpsDir, iniName)
- i = WritePrivateProfileString(secName, BmpSecondsName, txtBmpSeconds, iniName)
- i = WritePrivateProfileString(secName, RandomFlagName, Str$(RandomFlag), iniName)
- i = WritePrivateProfileString(secName, FastPaletteCycleName, Str$(FastPaletteCycleFlag), iniName)
- i = WritePrivateProfileString(secName, LowMemoryFlagName, Str$(LowMemoryFlag), iniName)
- i = WritePrivateProfileString(secName, StartSaverName, txtStartSaver, iniName)
- Call encode
- i = WritePrivateProfileString(secName, PasswordName, PasswdScram, iniName)
- Dim FileName As String
- ' look for bmps
- i = 0'set to non-zero on error
- On Error GoTo CmdOK_Error
- FileName = Dir$(txtBmpsDir & "\*.bmp")
- On Error GoTo 0
- If FileName = "" Then
- i = 1
- End If
- If i <> 0 Then 'if bmp not found look for gifs
- i = 0
- On Error GoTo CmdOK_Error
- FileName = Dir$(txtBmpsDir & "\*.gif")
- On Error GoTo 0
- If FileName = "" Then
- i = 1
- End If
- End If
- If i <> 0 Then 'if gif not found look for dibs
- i = 0
- On Error GoTo CmdOK_Error
- FileName = Dir$(txtBmpsDir & "\*.dib")
- On Error GoTo 0
- If FileName = "" Then
- i = 1
- End If
- End If
- If i = 1 Then
- MsgBox "BMPs, GIFs, nor DIBs found in:" + Chr$(10) + txtBmpsDir + Chr$(10) + "Need to change location" + Chr$(10) + "of graphics for slide show", 48, "Many Things"
- ElseIf i = 2 Then
- MsgBox "Directory not found at:" + Chr$(10) + txtBmpsDir + Chr$(10) + "Need to change location" + Chr$(10) + "of graphics for slide show", 48, "Many Things"
- End If
- 'look for gifs
- i = 0'set to non-zero on error
- On Error GoTo CmdOK_Error
- FileName = Dir$(txtCycleBmpsDir & "\*.gif")
- On Error GoTo 0
- If FileName = "" Then
- i = 1
- End If
- If i = 1 Then
- MsgBox "GIFs not found in:" + Chr$(10) + txtCycleBmpsDir + Chr$(10) + "Need to change location" + Chr$(10) + "of graphics for palette cycling", 48, "Many Things"
- ElseIf i = 2 Then
- MsgBox "Directory not found at:" + Chr$(10) + txtCycleBmpsDir + Chr$(10) + "Need to change location" + Chr$(10) + "of graphics for palette cycling", 48, "Many Things"
- End If
- End ' end program
- CmdOK_Error:
- ' could not find path
- On Error GoTo 0
- i = 2: FileName = "X"
- Resume Next
- '1001 MsgBox "Directory not found" + Chr$(10) + "for location of bitmaps:" + Chr$(10) + txtBmpsDir + "\", 48, "Many Things"
- End
- End Sub
- Sub Form_Load ()
- txtMaxLines = maxLines ' Set to current max lines
- txtRepeatCount = RepeatCount
- txtChangeMin = MaxChangeMinutes
- txtMaxCums = MaxCums
- txtMaxLines.SelLength = 3 ' Select the current value
- txtBmpsDir = BitmapsDir
- txtCycleBmpsDir = CycleBitmapsDir
- txtBmpSeconds = BmpSeconds
- If RandomFlag <> 0 Then
- RandomFlagCheck.Value = 1
- Else
- RandomFlagCheck.Value = 0
- End If
- If LowMemoryFlag <> 0 Then
- LowMemoryCheck.Value = 1
- Else
- LowMemoryCheck.Value = 0
- End If
- If FastPaletteCycleFlag <> 0 Then
- FastPaletteCycleCheck.Value = 1
- Else
- FastPaletteCycleCheck.Value = 0
- End If
- txtStartSaver = StartSaver
- End Sub
- Sub Password_Button_Click ()
- Password.Show 1
- End Sub
- Sub Password_Click ()
- Password.Show
- End Sub
- Sub txtBmpSeconds_KeyPress (KeyAscii As Integer)
- If KeyAscii < 32 Then
- ' ' Let Ctrl keys pass through
- ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
- KeyAscii = 0 ' Discard chars other than digits
- End If
- End Sub
- Sub txtChangeMin_KeyPress (KeyAscii As Integer)
- If KeyAscii < 32 Then
- ' ' Let Ctrl keys pass through
- ElseIf KeyAscii = Asc(".") Then ' only 1 decimal
- If InStr(txtChangeMin, ".") > 0 Then
- KeyAscii = 0 ' Discard extra decimals
- End If
- ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
- KeyAscii = 0 ' Discard chars other than digits
- End If
- End Sub
- Sub txtMaxCums_KeyPress (KeyAscii As Integer)
- If KeyAscii < 32 Then
- ' ' Let Ctrl keys pass through
- ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
- KeyAscii = 0 ' Discard chars other than digits
- End If
- End Sub
- Sub txtMaxLines_KeyPress (KeyAscii As Integer)
- If KeyAscii < 32 Then
- ' ' Let Ctrl keys pass through
- ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
- KeyAscii = 0 ' Discard chars other than digits
- End If
- End Sub
- Sub txtRepeatCount_KeyPress (KeyAscii As Integer)
- If KeyAscii < 32 Then
- ' ' Let Ctrl keys pass through
- ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
- KeyAscii = 0 ' Discard chars other than digits
- End If
- End Sub
- Sub TxtStartSaver_KeyPress (KeyAscii As Integer)
- If KeyAscii < 32 Then
- ' ' Let Ctrl keys pass through
- ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
- KeyAscii = 0 ' Discard chars other than digits
- End If
- End Sub
-