Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/scrnsave/scrmbler.frm

Visual Basic Form | 1995-05-08 | 6.6 KB | 175 lines

VERSION 2.00
Begin Form SCRMBLER
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Screen Scrambler Settings"
   ClientHeight    =   3375
   ClientLeft      =   2580
   ClientTop       =   1065
   ClientWidth     =   4095
   Height          =   3780
   Icon            =   SCRMBLER.FRX:0000
   Left            =   2520
   LinkTopic       =   "ScreenScramble"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3375
   ScaleWidth      =   4095
   Top             =   720
   Width           =   4215
   Begin CommandButton Cancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2160
      TabIndex        =   7
      Top             =   2880
      Width           =   1695
   End
   Begin CommandButton OK
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   240
      TabIndex        =   6
      Top             =   2880
      Width           =   1695
   End
   Begin CommandButton Test
      Caption         =   "&Test"
      Height          =   375
      Left            =   2280
      TabIndex        =   5
      Top             =   2400
      Width           =   1455
   End
   Begin CommandButton Setting
      Caption         =   "&Settings..."
      Height          =   375
      Left            =   360
      TabIndex        =   4
      Top             =   2400
      Width           =   1455
   End
   Begin CommandButton Delete
      Caption         =   "&Delete"
      Height          =   375
      Left            =   1680
      TabIndex        =   3
      Top             =   1320
      Width           =   735
   End
   Begin CommandButton Add
      Caption         =   "&Add "
      Height          =   375
      Left            =   1680
      TabIndex        =   2
      Top             =   720
      Width           =   735
   End
   Begin FileListBox SCR_files
      Height          =   2175
      Left            =   120
      Pattern         =   "*.SCR"
      TabIndex        =   1
      Top             =   120
      Width           =   1455
   End
   Begin ListBox SCRtoUSE
      Height          =   2175
      Left            =   2520
      TabIndex        =   0
      Top             =   120
      Width           =   1455
   End
'Get Windows Directory API call. Used to Get path for file list box.
Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
'Windows API to see if program has terminated.
Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule%)
Sub Add_Click ()
If SCR_Files.FileName = "SCRMBLER.SCR" Or SCR_Files.FileName = "" Then Exit Sub'If selected screen saver is this one, or none, cancel procedure.
If SCRtoUSE.ListCount > 0 Then
    For Item% = 0 To SCRtoUSE.ListCount
        'If Item is already on list, cancel procedure.
        If SCRtoUSE.List(Item%) = SCR_Files.FileName Then Exit Sub
    Next
End If
SCRtoUSE.AddItem SCR_Files.FileName' Add File from File list to Screen Saver List.
End Sub
Sub Cancel_Click ()
End 'Close Settings Window
End Sub
Sub Delete_Click ()
If SCRtoUSE.ListIndex = -1 Then Exit Sub 'If no items selected cancel procedure
Li% = SCRtoUSE.ListIndex'Save list index
SCRtoUSE.RemoveItem SCRtoUSE.ListIndex' Remove Saver from list
SCRtoUSE.ListIndex = Li% - 1'Highlight Previous Item
End Sub
Sub Form_Load ()
On Error Resume Next'Enable Error Trapping
If App.PrevInstance = True Then End' If already loaded, cancel this copy.
If UCase$(Command$) = "/C" Then ' check for /C command line parameter to activate Settings window.
    Left = Screen.Width / 2'Align Window (It looks better on SVGA using this)
    Top = Screen.Height / 8'Align Window
    SCR_Files.Path = Getwindowsdir()' Set file list box path to windows directory.
    Open Getwindowsdir() + "SCRMBLER.DAT" For Input As #1'Open sequential data file
    If Err <> 0 Then Close #1: Exit Sub'If file error, Don't create list
    While Not EOF(1)'Loop until end of file
        Input #1, Text$'Get text from file
        SCRtoUSE.AddItem Text$'Add Text to list box.
    Wend
    Close #1'Close File
End If
If UCase$(Command$) = "/S" Then ' Check for /S to start screen Saver
    Visible = False'Make sure Window is visible at no times
    'for conveinince, savers are loaded into List box
    Open Getwindowsdir() + "SCRMBLER.DAT" For Input As #1'Open sequential data file
    If Err <> 0 Then Close #1: Exit Sub'If file error, Don't create list
    While Not EOF(1)'Loop until end of file
        Input #1, Text$'Get text from file
        SCRtoUSE.AddItem Text$'Add Text to list box.
    Wend
    Close #1'Close File
    Randomize'Initiate random number generator
    SCRtoUSE.ListIndex = Int(Rnd * SCRtoUSE.ListCount)'Randomly Chose Saver
    Test_Click'Show saver by seleting it in the list and clicking test button (done automaticly)
    End'Exit Program
End If
End Sub
Function Getwindowsdir () As String 'Borrowed from the example setup program that came with VB.
    temp$ = String$(145, 0)              ' Size Buffer
    x = GetWindowsDirectory(temp$, 145)  ' Make API Call
    temp$ = Left$(temp$, x)              ' Trim Buffer
    If Right$(temp$, 1) <> "\" Then      ' Add \ if necessary
        Getwindowsdir$ = temp$ + "\"
    Else
        Getwindowsdir$ = temp$
    End If
End Function
Sub OK_Click ()
Open Getwindowsdir() + "SCRMBLER.DAT" For Output As #1'Open List file
If SCRtoUSE.ListCount > 0 Then
    For Item% = 0 To SCRtoUSE.ListCount - 1
        'Save List in sequential file
        Print #1, SCRtoUSE.List(Item%)
    Next
End If
Close #1'Close File
End'Close Settings Window
End Sub
Sub Setting_Click ()
If SCRtoUSE.ListIndex = -1 Then Exit Sub'If No Item Selected, cancel procedure
FileCopy Getwindowsdir() + SCRtoUSE.Text, "~LZLWLS.exe"'Copy file to an EXE file which can be used from VB, I just made up the name, It has no significance.
x% = Shell("~LZLWLS.exe /c", 1)'Run Saver in settings window.
While GetModuleUsage(x%) > 0'Check to see if program has terminated
    DoEvents
Kill "~LZLWLS.exe"'Delete file
End Sub
Sub Test_Click ()
If SCRtoUSE.ListIndex = -1 Then Exit Sub'If No Item Selected, cancel procedure
FileCopy Getwindowsdir() + SCRtoUSE.Text, "~LZLWLS.exe"'Copy file to an EXE file which can be used from VB, I just made up the name, It has no significance.
x% = Shell("~LZLWLS.exe /s", 1)'Run Saver.
While GetModuleUsage(x%) > 0'Check to see if program has terminated
    DoEvents
Kill "~LZLWLS.exe"'Delete file
End Sub