Foro de elhacker.net

Private Declare Function IntersectRect Lib "user32.dll" (ByRef lpDestRect As RECT, ByRef lpSrc1Rect As RECT, ByRef lpSrc2Rect As RECT) As Long
 

Option Explicit
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function IntersectRect Lib "user32.dll" (ByRef lpDestRect As RECT, ByRef lpSrc1Rect As RECT, ByRef lpSrc2Rect As RECT) As Long
Dim RectR As RECT
Dim CursorR As RECT
Dim PicR As RECT
 
Private Sub Form_Load()
    AutoRedraw = True
    Me.ScaleMode = 3 ' escala en pixeles
    With PicR
        .Top = 100
        .Left = 100
        .Bottom = .Top + 20
        .Right = .Left + 20
    End With
    DrawSquallInObject Me, True, PicR, vbRed
End Sub
 
Public Function CursorMove(ByVal X As Single, ByVal Y As Single)
    With CursorR
        .Top = Y
        .Left = X
        .Bottom = .Top + 1
        .Right = .Left + 1
    End With
    Caption = IntersectRect(RectR, CursorR, PicR)
End Function
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    CursorMove X, Y
End Sub
 
Private Function DrawSquallInObject(obj As Object, clear As Boolean, RectSource As RECT, ColorLines As Long) As Long
On Error GoTo errores
    Dim linea As Long
    linea = ColorLines
    If clear Then obj.Cls
    obj.Line (RectSource.Left, RectSource.Top)-(RectSource.Left, RectSource.Bottom), linea '(0) 'RGB(Rnd(1) * 255, Rnd(1) * 255, Rnd(1) * 255)
    obj.Line (RectSource.Left, RectSource.Top)-(RectSource.Right, RectSource.Top), linea '(1) 'RGB(Rnd(1) * 255, Rnd(1) * 255, Rnd(1) * 255)
    obj.Line (RectSource.Right, RectSource.Bottom)-(RectSource.Right, RectSource.Top), linea '(2) 'RGB(Rnd(1) * 255, Rnd(1) * 255, Rnd(1) * 255)
    obj.Line (RectSource.Right, RectSource.Bottom)-(RectSource.Left, RectSource.Bottom), linea '(3) 'RGB(Rnd(1) * 255, Rnd(1) * 255, Rnd(1) * 255)
    DrawSquallInObject = True
    Exit Function
errores:
    DrawSquallInObject = False
    Err.clear
End Function