- Home
·
- Graphics
·
- This Code describes how to Make Color Full Circle on your Form.
This Code describes how to Make Color Full Circle on your Form.
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
Rate This Code describes how to Make Color Full Circle on your Form.
(1(1 Vote))
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
This Code describes how to Make Color Full Circle on your Form. Comments
No comments yet — be the first to post one!
Post a Comment