by Muhammad Aqeel Khan (1 Submission)
Category: Graphics
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 2nd January 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This Code describes how to Make Color Full Circle on your Form.
API Declarations
Note: No Refrance
Copy the Code in form's Genreal Declaration Section
VBcoders
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Const PS_SOLID = 0
Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hdc As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32" _
(ByVal nPenStyle As Long, _
ByVal nWidth As Long, _
ByVal crColor As Long) As Long
Private Declare Function LineTo Lib "gdi32" _
(ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" _
(ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal lpPoint As Long) As Long
Private Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Const pWidth = 250 ' Width of picture box in pixels.
Private Const pHeight = 150 ' Height of picture box in pixels.
Private Const pGrid = 25 ' Distance between grid lines.
Private Const tInterval = 100 ' Interval between timer samplings
' in milliseconds.
Private Const pHeightHalf = pHeight \ 2
Dim counter As Long ' Number of data points logged so far. Used to
' sync grid.
Dim oldY As Long ' Contains the previous y coordinate.
Dim hDCh As Long, hPenB As Long, hPenC As Long
Private Sub Form_Load()
Dim hBmp As Long
Dim i As Integer
Me.Show
Picture1.ScaleMode = 3
Picture1.Left = 0
Picture1.Top = 0
Form1.ScaleMode = 3
Picture1.Height = 155
Picture1.Width = 255
counter = 0
hDCh = CreateCompatibleDC(Picture1.hdc)
hBmp = CreateCompatibleBitmap(Picture1.hdc, _
pWidth, _
pHeight)
Call SelectObject(hDCh, hBmp)
hPenB = CreatePen(PS_SOLID, 0, vbBlack)
hPenC = CreatePen(PS_SOLID, 0, vbRed)
Call SelectObject(hDCh, hPenB)
' Plot horizontal grid lines.
For i = pGrid To pHeight - 1 Step pGrid
Picture1.Line (0, i)-(pWidth, i)
Next
' Plot vertical grid lines.
For i = pGrid - (counter Mod pGrid) To _
pWidth - 1 Step pGrid
Picture1.Line (i, 0)-(i, pHeight)
Next
Call BitBlt(hDCh, _
0, _
0, _
pWidth, _
pHeight, _
Picture1.hdc, _
0, _
0, _
SRCCOPY)
Timer1.Interval = 100
Timer1.Enabled = True
oldY = pHeightHalf
End Sub
Private Sub Timer1_Timer()
Dim i As Integer
Call BitBlt(hDCh, _
0, _
0, _
pWidth - 1, _
pHeight, _
hDCh, _
1, _
0, _
SRCCOPY)
If counter Mod pGrid = 0 Then
Call MoveToEx(hDCh, pWidth - 2, 0, 0)
Call LineTo(hDCh, pWidth - 2, pHeight)
End If
i = Sin(0.1 * counter) * _
(pHeightHalf - 1) + _
pHeightHalf
Call SelectObject(hDCh, hPenC)
Call MoveToEx(hDCh, pWidth - 3, oldY, 0)
Call LineTo(hDCh, pWidth - 2, i)
Call SelectObject(hDCh, hPenB)
Call BitBlt(Picture1.hdc, _
0, _
0, _
pWidth, _
pHeight, _
hDCh, _
0, _
0, _
SRCCOPY)
counter = counter + 1
oldY = i
End Sub
No comments have been posted about This Code describes how to Make Color Full Circle on your Form.. Why not be the first to post a comment about This Code describes how to Make Color Full Circle on your Form..