PureBasic Forums - English

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