Option Explicit

Type POINTAPI
  x As Long
  y As Long
End Type

Type RECT
  left As Long
  top As Long
  right As Long
  bottom As Long
End Type

Declare Function GetCursorPos Lib "user32" (Pt As POINTAPI) As Long

Declare Function SetCursorPos Lib "user32" (ByVal x As Long, _
      ByVal y As Long) As Long

Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, _
      lPoint As POINTAPI) As Long

Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, _
      lpRect As RECT) As Long

Private Function GetScreenRect(Obj As Object) As RECT
  Dim Pt As POINTAPI, Rct As RECT

  Call GetClientRect(Obj.hWnd, Rct)

  Pt.x = Rct.left
  Pt.y = Rct.top
  Res = ClientToScreen(Obj.hWnd, Pt)
  GetScreenRect.left = Pt.x
  GetScreenRect.top = Pt.y

  Pt.x = Rct.right
  Pt.y = Rct.bottom
  Res = ClientToScreen(Obj.hWnd, Pt)
  GetScreenRect.right = Pt.x
  GetScreenRect.bottom = Pt.y
End Function

Sub CursorBewegen(Ctrl As Object, KeyCode, Shift, Optional Schritt)
  Dim Pt As POINTAPI, Rct As RECT

  On Error Resume Next
  Ctrl.ScaleMode = vbPixels
  If Err > 0 Then
    On Error GoTo 0
    Exit Sub
  End If

  If IsMissing(Schritt) Then Schritt = 1

  Rct = GetScreenRect(Ctrl)

  MinX = Rct.left
  MinY = Rct.top
  MaxX = Rct.right
  MaxY = Rct.bottom

  If Schritt <= 0 Then Schritt = 1

  GetCursorPos Pt
  XX = Pt.x
  YY = Pt.y

  Select Case KeyCode
  Case 12
    If Shift = 2 Then
      XX = MinX + (MaxX - MinX) \ 2
      YY = MinY + (MaxY - MinY) \ 2
    End If

  Case 33
    If Shift = 0 Then
      If XX = MaxX Or YY = MinY Then Exit Sub
      If XX + Schritt > MaxX Or YY - Schritt < MinY Then Schritt = 1
      XX = XX + Schritt
      YY = YY - Schritt
    ElseIf Shift = 2 Then
      XX = MaxX
      YY = MinY
    End If
    If YY < MinY Then YY = MinY
    If XX > MaxX Then XX = MaxX

  Case 34
    If Shift = 0 Then
      If XX = MaxX Or YY = MaxY Then Exit Sub
      If XX + Schritt > MaxX Or YY + Schritt > MaxY Then Schritt = 1
      XX = XX + Schritt
      YY = YY + Schritt
    ElseIf Shift = 2 Then
      XX = MaxX
      YY = MaxY
    End If
    If YY > MaxY Then YY = MaxY
    If XX > MaxX Then XX = MaxX

  Case 35
    If Shift = 0 Then
      If XX = MinX Or YY = MaxY Then Exit Sub
      If XX - Schritt < MinX Or YY + Schritt > MaxY Then Schritt = 1
      XX = XX - Schritt
      YY = YY + Schritt
    ElseIf Shift = 2 Then
      XX = MinX
      YY = MaxY
    End If
    If XX < MinX Then XX = MinX
    If YY > MaxY Then YY = MaxY

  Case 36
    If Shift = 0 Then
      If XX = MinX Or YY = MinY Then Exit Sub
      If XX - Schritt < MinX Or YY - Schritt < MinY Then Schritt = 1
      XX = XX - Schritt
      YY = YY - Schritt
    ElseIf Shift = 2 Then
      XX = MinX
      YY = MinY
    End If
    If XX < MinX Then XX = MinX
    If YY < MinY Then YY = MinY

  Case 37
    If Shift = 0 Then
      XX = XX - Schritt
      If XX < MinX Then XX = MinX
    ElseIf Shift = 2 Then
      XX = MinX
    End If
    
  Case 38
    If Shift = 0 Then
      YY = YY - Schritt
      If YY < MinY Then YY = MinY
    ElseIf Shift = 2 Then
      YY = MinY
    End If

  Case 39
    If Shift = 0 Then
      XX = XX + Schritt
      If XX > MaxX Then XX = MaxX
    ElseIf Shift = 2 Then
      XX = MaxX
    End If

  Case 40
    If Shift = 0 Then
      YY = YY + Schritt
      If YY > MaxY Then YY = MaxY
    ElseIf Shift = 2 Then
      YY = MaxY
    End If
  End Select

  SetCursorPos XX, YY
  Schritt = Schritt + 1
End Sub

Option Explicit
Private malen As Boolean

Private Sub Picture1_DblClick()
  Picture1.Cls
End Sub

Private Sub Picture1_KeyDown(KeyCode As Integer, _
      Shift As Integer)
  CursorBewegen Picture1, KeyCode, Shift, 10
End Sub

Private Sub Picture1_MouseDown(Button As Integer, _
      Shift As Integer, x As Single, y As Single)
  malen = True

  If IsNumeric(Text1.Text) = True Then
     Picture1.DrawWidth = Val(Text1.Text)
  Else
     Picture1.DrawWidth = 3
  End If

  Picture1.PSet (x, y)
  Select Case Button
  Case 1
    Picture1.ForeColor = QBColor(12)
  Case 2
    Picture1.ForeColor = QBColor(9)
  End Select
End Sub

Private Sub Picture1_MouseMove(Button As Integer, _
      Shift As Integer, x As Single, y As Single)
  If malen Then
    Picture1.Line -(x, y)
  End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, _
      Shift As Integer, x As Single, y As Single)
  malen = False
End Sub

Private Sub Command1_Click()
  MsgBox "Linke Maustaste = Rot" & vbCrLf & _
       "Rechte Maustaste = Blau" & vbCrLf & _
       "Doppelklick löscht die Zeichnung" & _
       vbCrLf & vbCrLf & "Geraden zeichnen:" & vbCrLf & _
       "Linke oder rechte Maustaste gedrückt halten" & _
       vbCrLf & "und mit den Cursortasten zeichnen.", _
       vbOKOnly, Form1.Caption
End Sub