怎么在屏幕上畫線,幫忙看那里錯了


Option Explicit
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y 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 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 GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 Const PS_SOLID = 0


Private Sub Command1_Click()
    Dim old As Long '存儲舊畫筆
    Dim p As Long '存儲新畫筆
    
    Dim a As Long '桌面句柄
    Dim b As Long '桌面設備環境
    a = GetDesktopWindow() '獲得桌面句柄
    b = GetDC(a) '獲得桌面設備環境
    
    p = CreatePen(PS_SOLID, 3, vbRed) '創建畫筆
    old = SelectObject(b, p) '選擇畫筆
    
    MoveToEx b, 0, 0, 0 '設置起點坐標
    LineTo b, 50, 50 '划線
    
    SelectObject b, old '恢復畫筆
    DeleteObject p '刪除創建的畫筆
End Sub

2 个解决方案

#1


把GETDC換成GETWINDOWDC就可以了。

#2


終於可以在桌面畫畫了,謝謝!

注意!

本站转载的文章为个人学习借鉴使用,本站对版权不负任何法律责任。如果侵犯了您的隐私权益,请联系我们删除。



 
  © 2014-2022 ITdaan.com 联系我们: