Ok in its raw form this is really quite useless but it contains several interesting parts that can be put to greater use
With this code you can create a round, color changing form that can be moved freely.
Thank you SamOscarBrown for your circle code and Microsoft for helping me get the form movable
you will need a form with a text box and a timer. I named the form frmRound
seeing it work really blew my mind! :eek2:
With this code you can create a round, color changing form that can be moved freely.
Thank you SamOscarBrown for your circle code and Microsoft for helping me get the form movable
you will need a form with a text box and a timer. I named the form frmRound
seeing it work really blew my mind! :eek2:
Code:
Private Declare Function SendMessage Lib "User32" _
Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "User32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Option Explicit
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "User32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim lngReturnValue As Long
If Button = 1 Then
Call ReleaseCapture
lngReturnValue = SendMessage(frmRound.hWnd, WM_NCLBUTTONDOWN, _
HTCAPTION, 0&)
End If
End Sub
Private Sub Form_DblClick()
Unload Me
End Sub
Private Sub Form_Load()
Dim lngRegion As Long
Dim lngReturn As Long
Dim lngFormWidth As Long
Dim lngFormHeight As Long
Me.Width = Me.Height
lngFormWidth = Me.Width / Screen.TwipsPerPixelX
lngFormHeight = Me.Height / Screen.TwipsPerPixelY
lngRegion = CreateEllipticRgn(0, 0, lngFormWidth, lngFormHeight)
lngReturn = SetWindowRgn(Me.hWnd, lngRegion, True)
Label1.Left = (Me.Width / 2) - (Label1.Width / 2)
Label1.Top = (Me.Height / 2) - (Label1.Height / 2)
End Sub
Private Sub Label1_Click()
Unload frmRound
End Sub
Private Sub Timer1_Timer()
Static iColor As Integer
Select Case iColor
Case 0: Me.BackColor = RGB(255, 0, 0) ' Red
Case 1: Me.BackColor = RGB(255, 165, 0) ' Orange
Case 2: Me.BackColor = RGB(255, 255, 0) ' Yellow
Case 3: Me.BackColor = RGB(0, 128, 0) ' Green
Case 4: Me.BackColor = RGB(0, 0, 255) ' Blue
Case 5: Me.BackColor = RGB(128, 0, 128) ' Purple
End Select
iColor = iColor + 1
If iColor > 5 Then iColor = 0
End Sub