09-25-2024, 07:24 PM
(This post was last modified: 09-25-2024, 07:25 PM by TerryRitchie.)
Here's some quick code I hacked together over the past few hours showing how I would do this.
The GetPolygon subroutine I added just so you would have something to select. The ClipImage subroutine is really all that is needed, along with a populated Poly() list to clip an image.
Use the left mouse button to select your points. Use the right mouse button (or cross any two lines) to close the polygon and have the image clipped.
The ZIP file below contains the code and image I used. Again, this was a quick hack, it will probably have unforseen error conditions that need to be taken into account.
The GetPolygon subroutine I added just so you would have something to select. The ClipImage subroutine is really all that is needed, along with a populated Poly() list to clip an image.
Use the left mouse button to select your points. Use the right mouse button (or cross any two lines) to close the polygon and have the image clipped.
The ZIP file below contains the code and image I used. Again, this was a quick hack, it will probably have unforseen error conditions that need to be taken into account.
Code: (Select All)
' Quick hack to show how to clip a polygon area from an image
OPTION _EXPLICIT
TYPE TYPE_IPOINT
x AS INTEGER
y AS INTEGER
END TYPE
TYPE TYPE_LINE ' line segment definition
Start AS TYPE_IPOINT ' x,y start of line segment (defined in LIB_TYPE_SPOINT.BI)
Finish AS TYPE_IPOINT ' x,y end of line segment (defined in LIB_TYPE_SPOINT.BI)
END TYPE
REDIM Poly(0) AS TYPE_IPOINT
DIM Image AS LONG
DIM Clip AS LONG
DIM sWidth AS INTEGER
DIM sHeight AS INTEGER
Image = _LOADIMAGE("canyon.png", 32)
sWidth = _WIDTH(Image)
sHeight = _HEIGHT(Image)
SCREEN _NEWIMAGE(sWidth, sHeight, 32)
_PUTIMAGE (0, 0), Image
GetPolygon Image, Poly()
ClipImage Image, Poly(), Clip
CLS
_PUTIMAGE (0, 0), Clip ' the final polygon clipped from the image
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB MakeMask (i AS LONG)
' -----------------------------------------------------------------------------------------
'| This subroutine assumes the image passed in has already had an outer mask color applied |
' -----------------------------------------------------------------------------------------
CONST OUTER~& = _RGBA32(255, 0, 255, 255) ' outside the polygon (bright magenta)
CONST INNER~& = _RGBA32(0, 0, 0, 0) ' inside the ploygon (transparent black)
DIM m AS _MEM ' memory block holding image data
DIM e AS _OFFSET ' end of memory block
DIM o AS _OFFSET ' 4 byte pixel location within memory block
DIM p AS _UNSIGNED LONG ' individual pixel
IF i < -1 THEN
IF _PIXELSIZE(i) = 4 THEN
$CHECKING:OFF
m = _MEMIMAGE(i)
o = m.OFFSET
e = o + m.SIZE
DO
_MEMGET m, o, p
IF p <> OUTER THEN _MEMPUT m, o, INNER AS _UNSIGNED LONG
o = o + 4
LOOP UNTIL o = e
_MEMFREE m
$CHECKING:ON
END IF
END IF
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB ClipImage (Image AS LONG, Poly() AS TYPE_IPOINT, Clip AS LONG)
' -----------------------------------------
'| Clip the image contained in the polygon |
' -----------------------------------------
CONST TRACE~& = _RGB32(0, 0, 1)
CONST OUTER~& = _RGB32(255, 0, 255)
DIM ImageCopy AS LONG
DIM Mask AS LONG
DIM Minx AS INTEGER
DIM Miny AS INTEGER
DIM MaxX AS INTEGER
DIM MaxY AS INTEGER
DIM c AS INTEGER
DIM oDest AS LONG
oDest = _DEST
PolyMinMax Poly(), Minx, Miny, MaxX, MaxY
ImageCopy = _NEWIMAGE(_WIDTH(Image) + 2, _HEIGHT(Image) + 2, 32)
_PUTIMAGE (1, 1), Image, ImageCopy
_DEST ImageCopy
' --------------------------------------------------------------
'| Trace the outer edges of the polygon and paint outside of it |
' --------------------------------------------------------------
PSET (Poly(0).x + 1, Poly(0).y + 1), TRACE
FOR c = 1 TO UBOUND(Poly)
LINE -(Poly(c).x + 1, Poly(c).y + 1), TRACE
NEXT c
LINE -(Poly(0).x + 1, Poly(0).y + 1), TRACE
PAINT (0, 0), OUTER, TRACE
' -------------------------------------
'| Create an image mask of the polygon |
' -------------------------------------
Mask = _NEWIMAGE(MaxX - Minx, MaxY - Miny, 32)
_PUTIMAGE (0, 0), ImageCopy, Mask, (Minx + 1, Miny + 1)-(MaxX + 1, MaxY + 1)
MakeMask Mask
' -----------------------------------
'| Apply the mask and clip the image |
' -----------------------------------
_PUTIMAGE (1, 1), Image, ImageCopy
_PUTIMAGE (Minx + 1, Miny + 1), Mask, ImageCopy
Clip = _NEWIMAGE(MaxX - Minx, MaxY - Miny, 32)
_PUTIMAGE (0, 0), ImageCopy, Clip, (Minx + 1, Miny + 1)-(MaxX + 1, MaxY + 1)
_CLEARCOLOR OUTER, Clip
_FREEIMAGE ImageCopy
_FREEIMAGE Mask
_DEST oDest
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB PolyMinMax (Poly() AS TYPE_IPOINT, MinX AS INTEGER, MinY AS INTEGER, MaxX AS INTEGER, MaxY AS INTEGER)
' ------------------------------
'| Get the polygon bounding box |
' ------------------------------
DIM c AS INTEGER
MinX = Poly(0).x
MinY = Poly(0).y
MaxX = Poly(0).x
MaxY = Poly(0).y
FOR c = 0 TO UBOUND(Poly)
IF Poly(c).x < MinX THEN MinX = Poly(c).x
IF Poly(c).y < MinY THEN MinY = Poly(c).y
IF Poly(c).x > MaxX THEN MaxX = Poly(c).x
IF Poly(c).y > MaxY THEN MaxY = Poly(c).y
NEXT c
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB GetPolygon (Image AS LONG, Poly() AS TYPE_IPOINT)
' ---------------------------------------
'| Allow user to select a polygon region |
' ---------------------------------------
REDIM Poly(0) AS TYPE_IPOINT
DIM lStyle(1) AS _UNSIGNED INTEGER
DIM Style AS _BYTE
DIM c AS INTEGER
DIM Frame AS INTEGER
DIM NewLine AS TYPE_LINE
DIM PolyLine AS TYPE_LINE
DIM Intersection AS TYPE_IPOINT
lStyle(0) = &B1111000011110000 ' moving selection line styles
lStyle(1) = &B0000111100001111
' --------------------------------
'| wait for first point selection |
' --------------------------------
DO
_LIMIT 60
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN
Poly(0).x = _MOUSEX
Poly(0).y = _MOUSEY
EXIT DO
END IF
LOOP
' ---------------------------------
'| Get subsequent point selections |
' ---------------------------------
DO
_LIMIT 60
_PUTIMAGE (0, 0), Image
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN
' -------------------------------------------------------------------------
'| User clicked left mouse button. Add x,y location to polygon point list. |
' -------------------------------------------------------------------------
REDIM _PRESERVE Poly(UBOUND(Poly) + 1) AS TYPE_IPOINT
Poly(UBOUND(Poly)).x = _MOUSEX
Poly(UBOUND(Poly)).y = _MOUSEY
' -------------------------------------------------
'| Get the line that creates this new polygon side |
' -------------------------------------------------
NewLine.Start.x = Poly(UBOUND(Poly) - 1).x
NewLine.Start.y = Poly(UBOUND(Poly) - 1).y
NewLine.Finish.x = _MOUSEX
NewLine.Finish.y = _MOUSEY
' ---------------------------------------------------------------
'| Check if polygon side collides with any existing polygon side |
' ---------------------------------------------------------------
FOR c = 1 TO UBOUND(Poly) - 1
IF c > 1 THEN
PolyLine.Start.x = Poly(c - 1).x
PolyLine.Start.y = Poly(c - 1).y
PolyLine.Finish.x = Poly(c).x
PolyLine.Finish.y = Poly(c).y
IF LineCollide(NewLine, PolyLine, Intersection) THEN
IF Intersection.x <> PolyLine.Finish.x AND Intersection.y <> PolyLine.Finish.y THEN
Poly(UBOUND(Poly)) = Poly(0)
EXIT SUB
END IF
END IF
END IF
NEXT c
ELSEIF _MOUSEBUTTON(2) THEN
' -----------------------------------------------------
'| User clicked right mouse button. Close the polygon. |
' -----------------------------------------------------
REDIM _PRESERVE Poly(UBOUND(Poly) + 1) AS TYPE_IPOINT
Poly(UBOUND(Poly)).x = _MOUSEX
Poly(UBOUND(Poly)).y = _MOUSEY
EXIT DO
END IF
' -----------------------------------------
'| Draw the polygon selected to this point |
' -----------------------------------------
Frame = Frame + 1
IF Frame = 61 THEN Frame = 1
IF Frame MOD 15 = 0 THEN Style = 1 - Style
PSET (Poly(0).x, Poly(0).y)
FOR c = 1 TO UBOUND(Poly)
LINE -(Poly(c).x, Poly(c).y), , , lStyle(Style)
NEXT c
LINE -(_MOUSEX, _MOUSEY), , , lStyle(Style)
_DISPLAY
LOOP
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------
FUNCTION LineCollide% (L1 AS TYPE_LINE, L2 AS TYPE_LINE, Collide AS TYPE_IPOINT)
'https://www.jeffreythompson.org/collision-detection/line-line.php
DIM uA AS SINGLE
DIM uB AS SINGLE
LineCollide% = 0 ' assume no collision (FALSE)
Collide.x = -32767
Collide.y = -32767
' calculate the distance to intersection point
uA = ((L2.Finish.x - L2.Start.x) * (L1.Start.y - L2.Start.y) - (L2.Finish.y - L2.Start.y) * (L1.Start.x - L2.Start.x)) / _
((L2.Finish.y - L2.Start.y) * (L1.Finish.x - L1.Start.x) - (L2.Finish.x - L2.Start.x) * (L1.Finish.y - L1.Start.y))
uB = ((L1.Finish.x - L1.Start.x) * (L1.Start.y - L2.Start.y) - (L1.Finish.y - L1.Start.y) * (L1.Start.x - L2.Start.x)) / _
((L2.Finish.y - L2.Start.y) * (L1.Finish.x - L1.Start.x) - (L2.Finish.x - L2.Start.x) * (L1.Finish.y - L1.Start.y))
IF (uA >= 0) AND (uA <= 1) AND (uB >= 0) AND (uB <= 1) THEN ' are uA and uB both between 0 and 1?
LineCollide% = -1 ' yes, a collision occurred (TRUE)
Collide.x = L1.Start.x + (uA * (L1.Finish.x - L1.Start.x)) ' record collision point
Collide.y = L1.Start.y + (uA * (L1.Finish.y - L1.Start.y))
END IF
END FUNCTION