by Bhaskar Ganapathe (2 Submissions)
Category: Graphics
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 5th June 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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