• Home
 · 
• Graphics
 · 
• Simple ScreenSaver

Simple ScreenSaver

Simple ScreenSaver

API Declarations


Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
' lfFaceName(LF_FACESIZE) As Byte 'THIS WAS DEFINED IN API-CHANGES MY OWN
lfFacename As String * 33
End Type
Dim X As Integer




Rate Simple ScreenSaver

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Unload Me
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then
   Unload Me
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseMoveCount = MouseMoveCount + 1
If MouseMoveCount > 3 Then
  MouseMoveCount = 0
  'password.Show
  'password.Text1.SetFocus
  Unload Me
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If IsPasswordEnabled = 1 Then
  
  Call ShowCursor(True)
  
  If VerifyScreenSavePwd(Me.hwnd) = False Then
  
    Cancel = True
  
    Call ShowCursor(False)
    Exit Sub
  End If
End If
Call enablectrlaltdel(True)
Call ShowCursor(True)
End Sub


Private Sub Timer1_Timer()
FontStuff
End Sub

Private Sub FontStuff()
  On Error GoTo GetOut
  Dim i As Integer, j As Integer, k As Integer
  Dim F As LOGFONT, hPrevFont As Long, hFont As Long, FontName As String
  Dim FONTSIZE As Integer
  FONTSIZE = Val(50)

  For i = 10 To 270 Step 10
  F.lfEscapement = 10 * i 'rotation angle, in tenths
  'FontName = "Arial Black" + Chr$(0) 'null terminated
  'F.lfFacename = FontName
  F.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
  'F.lfCharSet = GREEK_CHARSET
  F.lfPitchAndFamily = FF_DECORATIVE
  F.lfWeight = FW_SEMIBOLD
  hFont = CreateFontIndirect(F)
  hPrevFont = SelectObject(Me.hdc, hFont)
  CurrentX = 5530
  CurrentY = 3860
  Print "Bhaskar"

'  Clean up, restore original font
  hFont = SelectObject(Me.hdc, hPrevFont)
  DeleteObject hFont
  For j = 0 To 1000
    For k = 0 To 1000
    Next
  Next
  Me.Cls
Next

  Exit Sub
GetOut:
  Exit Sub

End Sub