Programming Tool Box/SIMS_2.iso/vb_tools/manythng/setup.frm

Text File | 1994-09-28 | 14KB | 463 lines

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