Option Explicit Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, _ ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 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 Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As LongPrivate hbrush As Long, hdc5 As LongPrivate Sub Form_Load() Dim dx As Long, dy As Long Dim rx1 As Long, rx2 As Long, ry1 As Long, ry2 As Long Dim i As Long, j As Long, bcolor As Long Dim DispCnt As Long
DispCnt = 60 '一共Display多少次矩形後才显示Form hdc5 = GetDC(0) bcolor = GetBkColor(Me.hdc) '取得form的背景色 '注:之所以不使用me.BackColor的原因是:这个属性不一定使用调色盘, ' 如果使用系统配色,那结果会不对 hbrush = CreateSolidBrush(bcolor) '设定笔刷颜色 Call SelectObject(hdc5, hbrush) dx = Me.Width \ (DispCnt * 2) dy = Me.Height \ (DispCnt * 2) j = 1 For i = DispCnt To 1 Step -1 rx1 = (Me.Left + dx * (i - 1)) \ Screen.TwipsPerPixelX ry1 = (Me.Top + dy * (i - 1)) \ Screen.TwipsPerPixelY rx2 = rx1 + dx * 2 * j \ Screen.TwipsPerPixelX ry2 = rx1 + dy * 2 * j \ Screen.TwipsPerPixelY j = j + 1 Call Rectangle(hdc5, rx1, ry1, rx2, ry2) Sleep (1) Next i Call ReleaseDC(0, hdc5) Call DeleteObject(hbrush) End Sub
GetDC, ReleaseDC
用GDI函数对hDC绘制
ReleaseDC 0, hDC
在Windows系统下,应用程序处于Ring 3,无法直接对显存操作,即无法实现“直接写屏”
Option Explicit
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
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 Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As LongPrivate hbrush As Long, hdc5 As LongPrivate Sub Form_Load()
Dim dx As Long, dy As Long
Dim rx1 As Long, rx2 As Long, ry1 As Long, ry2 As Long
Dim i As Long, j As Long, bcolor As Long
Dim DispCnt As Long
DispCnt = 60 '一共Display多少次矩形後才显示Form
hdc5 = GetDC(0)
bcolor = GetBkColor(Me.hdc) '取得form的背景色
'注:之所以不使用me.BackColor的原因是:这个属性不一定使用调色盘,
' 如果使用系统配色,那结果会不对
hbrush = CreateSolidBrush(bcolor) '设定笔刷颜色
Call SelectObject(hdc5, hbrush)
dx = Me.Width \ (DispCnt * 2)
dy = Me.Height \ (DispCnt * 2)
j = 1
For i = DispCnt To 1 Step -1
rx1 = (Me.Left + dx * (i - 1)) \ Screen.TwipsPerPixelX
ry1 = (Me.Top + dy * (i - 1)) \ Screen.TwipsPerPixelY
rx2 = rx1 + dx * 2 * j \ Screen.TwipsPerPixelX
ry2 = rx1 + dy * 2 * j \ Screen.TwipsPerPixelY
j = j + 1
Call Rectangle(hdc5, rx1, ry1, rx2, ry2)
Sleep (1)
Next i
Call ReleaseDC(0, hdc5)
Call DeleteObject(hbrush)
End Sub
超级高手,在下佩服.
你那个功能“可我想问的是怎么在屏幕上画图,鼠标就是笔。想画什么画什么。”实现了吗?