Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd 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 GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function CreatePenIndirect Lib "gdi32" (lpLogPen As LOGPEN) 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 Private Type LOGPEN lopnStyle As Long lopnWidth As POINTAPI lopnColor As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Dim hDesktopWnd As Long Dim hDesktopDC As Long Dim rDesktop As RECT '########################## '## Command1のクリック ## '########################## Private Sub Command1_Click() Dim hNewPen As Long Dim hOldPen As Long Dim NewPen As LOGPEN hDesktopWnd = GetDesktopWindow() 'デスクトップのハンドルを取得 hDesktopDC = GetWindowDC(hDesktopWnd) 'デスクトップのデバイスコンテキストを取得 Call GetWindowRect(hDesktopWnd, rDesktop) 'デスクトップの大きさを取得 'ペンの作成 NewPen.lopnColor = vbRed NewPen.lopnWidth.x = Form1.Text1 hNewPen = CreatePenIndirect(NewPen) 'ペンを持ち替える hOldPen = SelectObject(hDesktopDC, hNewPen) Call MoveToEx(hDesktopDC, rDesktop.Right / 2, rDesktop.Bottom / 2, 0) 'カレントポジションを中央 Call LineTo(hDesktopDC, rDesktop.Right / 2, rDesktop.Bottom / 2) '線を引く '元のペンに戻す hNewPen = SelectObject(hDesktopDC, hOldPen) Call DeleteObject(hNewPen) '不要になったペンを開放する Call ReleaseDC(hDesktopWnd, hDesktopDC) 'デバイスコンテキストを開放する End Sub '########################## '## Command2のクリック ## '########################## Private Sub Command2_Click() End Sub