CodeItBetter Programming Another VB Programming Blog

How to create a screen saver.

Posted on August 9, 2011
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
'System & API - How to create a screen saver.
Option Explicit
 
'API call to hide mouse cursor/pointer
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'The quit flag
Dim Quit As Boolean
Dim X As Long
 
Private Sub Form_Click()
    'If click then stop saver
    Quit = True
End Sub
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    'If keypress then stop saver
    Quit = True
End Sub
 
Private Sub Form_Load()
    'Hide mouse pointer
    X = ShowCursor(False)
    'Do Not Load More than one occurance
    If App.PrevInstance = True Then
        X = ShowCursor(True)
        Unload Me
        Exit Sub
    End If
    'Start the screen saver
    Select Case UCase$(Left$(Command$, 2))
    Case "/S"
        Show
        Randomize
        Scale (0, 0)-(1, 1)
        BackColor = vbBlack
        'Graphics Loop
        Do
            If Rnd < 0.03 Then
                ForeColor = QBColor(Int(Rnd * 16))
                DrawWidth = Int(Rnd * 9 + 1)
            End If
            'Dots all over the screen
            PSet (Rnd, Rnd), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
            'This checks to see if mouse click, keypress, etc.
            DoEvents
        Loop Until Quit = True
        Timer1.Enabled = True
    Case Else
        Unload Me
        X = ShowCursor(True)
        Exit Sub
    End Select
End Sub
 
Private Sub Timer1_Timer()
    X = ShowCursor(True)
    Unload Me
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Routine to check for mouse movement
    Static Xlast, Ylast
    Dim Xnow As Single
    Dim Ynow As Single
    Xnow = X
    Ynow = Y
    If Xlast = 0 And Ylast = 0 Then
        Xlast = Xnow
        Ylast = Ynow
        Exit Sub
    End If
    If Xnow <> Xlast Or Ynow <> Ylast Then
        Quit = True
    End If
End Sub
Comments (0) Trackbacks (0)

No comments yet.


Leave a comment


 

No trackbacks yet.