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 |