vb中那为什么用getcursorpos函数取得屏幕坐标值后用movetoex和lineto函数不能画直线出来呢？如何改？
本帖最后由 bcrun 于 2013-08-19 10:36:16 编辑
Option ExplicitVB gdi 函数 X
Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Const PS_DASH = 1 ' -------
Private Const PS_DASHDOT = 3 ' _._._._
Private Const PS_DASHDOTDOT = 4 ' _.._.._
Private Const PS_DOT = 2 ' .......
Private Const PS_NULL = 5
Private Const PS_SOLID = 0
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) 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 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 Type POINTAPI
x As Long
y As Long
End Type
Dim p As POINTAPI
Public xa As Integer
Public ya As Integer
Public xb As Integer
Public yb As Integer
Private Sub Form_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = "a" Then
GetCursorPos p
xa = p.x
ya = p.y
MoveToEx Me.hdc, xa, ya, p
ElseIf Chr(KeyAscii) = b" Then
GetCursorPos p
xb = p.x
yb = p.y
LineTo Me.hdc, xb, yb
End If
End Sub
Private Sub Form_Load()
Timer1.Interval = 20
'初始化画笔
hPen = CreatePen(PS_SOLID, 1, vbRed)
Me.AutoRedraw = True
hPenPrev = SelectObject(Me.hdc, hPen)
SelectObject Me.hdc, hPenPrev
End Sub
Private Sub Timer1_Timer()
GetCursorPos p
End Sub
