VB icon

A Few Function's For You To Play With And Enhance.

Email
Submitted on: 1/2/2015 7:03:00 PM
By: Lance Lang (from psc cd)  
Level: Not Given
User Rating: By 4 Users
Compatibility: VB 5.0, VB 6.0
Views: 985
 
     A Few function's For You To Play With.. Trap Mouse In A Form, Random Object/Form Color's, A Wacked Screen Closing Special Effect, And Download File's Via The Internet..
 

Windows API/Global Declarations:

Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
'**************************************
'Windows API/Global Declarations for :A Few Function's For You To Play With And Enhance.
'**************************************
' Mouse Trap Declaration's, Toss These Into A Module
Option Explicit
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function ClipCursor Lib "user32" _
(lpRect As Any) As Long
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: A Few Function's For You To Play With And Enhance.
' Description:A Few function's For You To Play With.. Trap Mouse In A Form, Random Object/Form Color's, A Wacked Screen Closing Special Effect, And Download File's Via The Internet..
' By: Lance Lang (from psc cd)
'
' Assumes:These Are Just Basic Function's For All That Don't Know The Basic's.. Nothing Special...
'**************************************

' Trapping And Releaseing Mouse Routine's -----Start
Public Function LetMouseGo(Frm2LetMouseGo As Object)
Dim erg As Long
Dim NewRect As RECT
With NewRect
.Left = 0&
.Top = 0&
.Right = Screen.Width / Screen.TwipsPerPixelX
.Bottom = Screen.Height / Screen.TwipsPerPixelY
End With
erg& = ClipCursor(NewRect)
'Be Sure To Add
'
' Private Sub Form_Unload(Cancel As Integer)
' LetMouseGo Me
' End Sub
'
'To The Form That You Trap Incase They Ctrl-alt-Del Or X
'Out Of The Program, Otherwise, There Mouse Will Still Be
'Trapped In The Form Square!!
End Function
Public Function TrapMouse(Frm2MouseTrap As Object)
Dim x As Long, y As Long, erg As Long
Dim NewRect As RECT
x& = Screen.TwipsPerPixelX
y& = Screen.TwipsPerPixelY
With NewRect
.Left = Frm2MouseTrap.Left / x&
.Top = Frm2MouseTrap.Top / y&
.Right = .Left + Frm2MouseTrap.Width / x&
.Bottom = .Top + Frm2MouseTrap.Height / y&
End With
erg& = ClipCursor(NewRect)
End Function
' Trapping And Releaseing Mouse Routine's -----End
' Random ForeColor Or BackColor Or FillColor On Form Or Object's ---Start
Public Function RandColor(ObjectToFlash As Object, ForeColorBackColorOrFillColor As Object)
Dim c(2) As Byte
For x = 0 To 2
Randomize
c(x) = Int((255 - 0 + 1) * Rnd + 0)
Next x
ObjectToFlash.ForeColorBackColorOrFillColor = RGB(c(0), c(1), c(2))
End Function
' Random ForeColor Or BackColor Or FillColor On Form Or Object's ---End
'Special Closing Affect ---Start
Public Function WickedFormClose(Form2Close As Object)
GotoVal = (Form2Close.Height / 12)
For Gointo = 1 To GotoVal
DoEvents
Form2Close.Height = Form2Close.Height - 50
Form2Close.Top = (Screen.Height - Form2Close.Height) \ 2
Form2Close.Width = Form2Close.Width - 50
Form2Close.Left = (Screen.Width - Form2Close.Width) \ 2
If Form2Close.Width <= 50 Then Unload Form2Close
If Form2Close.Height <= 50 Then Unload Form2Close
Next Gointo
Unload Form2Close
End Function
'Special Closing Affect ---End
'Retrieve File Off A WebPage Internet ---Start
' Usage Example
' GetInterNetFile "http://somewhere.com/ifsomething/", "test.zip", "c:"
' Note: You Have To Put A Microsoft Internet Transfer Control On The Form!
Public Function GetInterNetFile(Location As String, Filename As String, DirToSaveAt As String)
Dim mocha As String
mocha = Location & Filename
Dim bData() As Byte
Dim intFile As Integer
intFile = FreeFile()
bData() = Inet1.OpenURL(mocha, icByteArray)
Open DirToSaveAt & "\" & Filename For Binary Access Write _
As #intFile
Put #intFile, , bData()
Close #intFile
End Function
'Retrieve File Off The Internet ---End
' Yea, I know These Are Probably Crapily Coded But I'm Just Trying
' To Show The New People To VB Some Little Need (pointless)
' Thing's To Play Around With!!


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Not Given category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.