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
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
