Code: Select all
;Masking irregular shaped regions
;by einander
;PB 4.00 - june 27-2006
Global _MX,_MY,_MK
Global _Drawing,_Pen,_PenRGB,_PenStyle
Global _Canvas, _Img,_ImGad
Macro MOU ;-MOU
_MX=WindowMouseX(0)
_MY=WindowMouseY(0)
_MK=Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000
EndMacro
Macro StopDraw ;- StopDraw
If _Drawing:StopDrawing():_Drawing=0:EndIf
EndMacro
Macro DelPen ;- DelPen
If _Pen: DeleteObject_(_Pen) :EndIf
_Pen=0: _PenRGB=0
EndMacro
Macro Pen(Rim=1, PenRGB=0,style=#PS_SOLID) ;- Pen(Rim=1, PenRGB=0,style=0)
DelPen
_Pen=CreatePen_(style,Rim,PenRGB)
SelectObject_(_Drawing,_Pen)
_PenRGB=PenRGB
_PenStyle=style
EndMacro
Macro DrawWIN(Win=0)
StopDraw : _Drawing=StartDrawing(WindowOutput(Win))
EndMacro
Macro DrawIMG(ImgNum=0)
StopDraw: _Drawing=StartDrawing(ImageOutput(ImgNum))
EndMacro
Procedure GetRGN(*R.RECT)
Dim LP.POINT(0)
CopyMemory(*R,@P.POINT,8)
ClientToScreen_(WindowID(EventWindow()), P ) ; Upper Left from rect to screen coords
SetRect_(Clip.RECT,P\x,P\y,P\x+ImageWidth(_Img),P\y+ImageHeight(_Img))
ClipCursor_(Clip)
LP(0)\x=_MX:LP(0)\y=_MY
While _MK=1
WaitWindowEvent()
MOU
If #WM_MOUSEMOVE
DrawIMG(_Canvas)
Count+1
Redim LP.POINT(Count)
LP(Count)\x=_MX : LP(Count)\y=_MY
LineXY(LP(Count-1)\x,LP(Count-1)\y,LP(Count)\x,LP(Count)\y,$FFFFFF-Point(_MX,_MY))
EndIf
DrawWIN()
SetGadgetState(_ImGad,ImageID(_Canvas))
Wend
DrawIMG(_Canvas)
InnerRGN= CreatePolygonRgn_(@LP(0),Count,#WINDING) ; try #ALTERNATE <<<<<<<<
GetRgnBox_(InnerRGN,*R)
Pen(1,#Red,#PS_DOT)
DrawingMode(4) ; 1 = filled ;2 xor ; 3 xor+outlined ; 4= outlined
Polygon_(_Drawing,@LP(),Count)
DrawWIN(EventWindow())
SetGadgetState(_ImGad,ImageID(_Canvas))
DelPen
*R\right+1:*R\bottom+1
ClipCursor_(0)
ProcedureReturn InnerRGN
EndProcedure
Macro ProcessRegion
If _MK=1
If InnerRGN ; if exist InnerRGN
If PtInRegion_(InnerRGN,_MX,_MY)
InvertRgn_(_Drawing,InnerRGN) ; test: process inner region
Else
InvertRgn_(_Drawing,OuterRGN) ; test: process outer region
EndIf
Else ; if InnerRGN don't exist, try to create it
OuterRGN=CreateRectRgn_(Outer\left,Outer\top,Outer\right,Outer\bottom)
CopyMemory(@Outer,@R.RECT,16)
InnerRGN=GetRGN(@R)
SetWindowTitle(0,"Region at "+Str(R\left)+" "+Str(R\top)+" "+Str(R\right)+" "+Str(R\bottom)+" - Left MouseButton to select - Right MouseButton To clean")
CombineRgn_(OuterRGN,OuterRGN,InnerRGN,#RGN_XOR) ;create outer region
EndIf
Repeat : MOU: Until _MK=0 ; wait for released button
ElseIf _MK=2 ; clean all to start again
SetWindowTitle(0,"Define region" )
DeleteObject_( InnerRGN )
DeleteObject_(OuterRGN)
InnerRGN=0
DrawIMG(_Canvas)
DrawImage(ImageID(_Img),Outer\left,Outer\top)
DrawWIN(EventWindow())
SetGadgetState(_ImGad,ImageID(_Canvas))
EndIf
EndMacro
;<<<<<<<<<<<<<<<<<<
If CreateGadgetList(OpenWindow(0,0,0,800,600 ,"Define region",$C80001))
Wi=WindowWidth(0):He=WindowHeight(0)
_Canvas=CreateImage(-1,Wi,He,32) ; full window image
_Img=LoadImage(-1,"c:\test2.bmp") ; your image here <<<<<<<<<<<<<<<<
ResizeImage(_Img,300,300) ; comment to keep original size
Outer.RECT\left=100 : Outer\top=100 ; image bounding rect
Outer\right=Outer\left+ImageWidth(_Img)
Outer\bottom=Outer\top+ImageHeight(_Img)
_ImGad=ImageGadget(-1,0,0,Wi,He,0)
DrawIMG(_Canvas) : Box(0,0,Wi,He,$223344) ; full background - comment to black
DrawImage(ImageID(_Img),Outer\left,Outer\top)
DrawWIN()
SetGadgetState(_ImGad,ImageID(_Canvas))
Repeat : MOU: Until _MK=0 ; wait for released button
Repeat
MOU
EV=WaitWindowEvent()
If EV= #WM_KEYDOWN And EventwParam()=27:End:EndIf
If PtInRect_(@Outer,_MX,_MY)
ProcessRegion
EndIf
Until EV= #PB_Event_CloseWindow
EndIf
End
