Page 1 of 1

Native regions (updated July 2/2011)

Posted: Sat Jun 25, 2011 7:10 pm
by netmaestro
Update July 2: Added CreatePolyRegion()

Update June 25: Added CreateRectRegion() and CreateEllipticRegion()

Code: Select all

;======================================================================
; Library:         CustomRegions.pbi
; Author:          Lloyd Gallant (netmaestro)
; Contributors:    Demivec, WilliamL
; Date:            June 25, 2011
; Target Compiler: PureBasic 4.5+
; Target OS:       Windows, Linux, MacOS
; License:         Free, unrestricted, no warranty whatsoever
;                  Use at your own risk
;
; Why I made this: The PureBasic CanvasGadget is a terrific 
;                  crossplatform tool for creating all kinds
;                  of custom controls. However, to use it 
;                  effectively some form of region testing is
;                  a must. It seems a shame to have to dip into
;                  APIs for this, and that is why I created this
;                  library: To provide cross-platform creation 
;                  and testing of regions from bitmaps, thereby
;                  allowing for the creation of powerful Canvas-
;                  based controls while staying 100% native PB.
; 
; Usage:           myregion = CreateBitmapRegion(image#, [transcolor]) 
;                    -creates a region from your bitmap
;
;                  myregion = CreateRectRegion(left,top,right,bottom)
;                    -Creates a rectangular region with these coordinates
;
;                  myregion = CreateEllipticRegion(width,height,x,y,radiusx,radiusy)
;                    -Creates an elliptic region with these coordinates
;                    To offset the ellipse in the region, make the
;                    width and/or height larger
;
;                  myregion = CreatePolyRegion( List vin.point(), x, y ) ; x,y is any point inside the polygon ( used for FillArea() )
;                    -Creates a polygon region created from the list of points received (must be at least 3)
;
;                  PtInRegion(myregion, x, y)
;                    -Returns 1 if the given point is inside the
;                    defined region, 0 if not
;===============================================================

CompilerIf Defined(POINT, #PB_Structure) = 0
  Structure POINT
    x.l
    y.l
  EndStructure
CompilerEndIf

Structure REGIONDATA
  width.l
  height.l
  Array dbits.b(0)
EndStructure

Procedure CreateBitmapRegion(image, transcolor=$FF00FF)
  Protected *thisregion.REGIONDATA, width, height
  width = ImageWidth(image) : height = ImageHeight(image)
  *thisregion = AllocateMemory(SizeOf(REGIONDATA))
  InitializeStructure(*thisregion, REGIONDATA)
  With *thisregion
    \height = height
    \width = width
    ReDim \dbits(width*height)
  EndWith
  StartDrawing(ImageOutput(image))
    If ImageDepth(image)=32
      DrawingMode(#PB_2DDrawing_AlphaChannel)
      For j=0 To height-1
        For i=0 To width-1
          cursor=width*j+i
          If Alpha(Point(i,j))
            *thisregion\dbits(cursor)=1
          Else
            *thisregion\dbits(cursor)=0
          EndIf
        Next
      Next
    Else
      DrawingMode(#PB_2DDrawing_Default)
      For j=0 To height-1
        For i=0 To width-1
          cursor=width*j+i
          If (Point(i,j)) = transcolor
            *thisregion\dbits(cursor)=0
          Else
            *thisregion\dbits(cursor)=1
          EndIf
        Next
      Next
    EndIf
  StopDrawing()
  ProcedureReturn *thisregion
EndProcedure

Procedure CreateRectRegion(left,top,right,bottom)
  Protected tmp
  tmp = CreateImage(#PB_Any,right,bottom,32, #PB_Image_Transparent)
  If StartDrawing(ImageOutput(tmp))
      DrawingMode(#PB_2DDrawing_AllChannels)
      Box(left,top,right-left,bottom-top, -1)
    StopDrawing()
  Else
    ProcedureReturn 0
  EndIf
  *thisregion = CreateBitmapRegion(tmp)
  FreeImage(tmp)
  ProcedureReturn *thisregion
EndProcedure

Procedure CreateEllipticRegion(width,height,x,y,radiusx,radiusy)
  Protected tmp
  tmp = CreateImage(#PB_Any,width,height,32, #PB_Image_Transparent)
  If StartDrawing(ImageOutput(tmp))
      DrawingMode(#PB_2DDrawing_AllChannels)
      Ellipse(x,y,radiusx,radiusy, -1)
    StopDrawing()
  Else
    ProcedureReturn 0
  EndIf
  *thisregion = CreateBitmapRegion(tmp)
  FreeImage(tmp)
  ProcedureReturn *thisregion
EndProcedure

Procedure CreatePolyRegion( List vin.POINT(), x, y ) ; x,y is any point inside the polygon ( used for FillArea() )
  If ListSize(vin()) < 3
    ProcedureReturn 0
  EndIf
  Protected max.POINT 
  ForEach vin()
    If vin()\x > max\x
      max\x = vin()\x
    EndIf
    If vin()\y > max\y
      max\y = vin()\y
    EndIf    
  Next
  Protected lastPoint.POINT = vin(), tmp, *thisregion
  tmp = CreateImage(#PB_Any, max\x + 1, max\y + 1) 
  StartDrawing(ImageOutput(tmp)) 
    Box(0, 0, max\x + 1, max\y + 1, RGB(255, 0, 255))
    ForEach vin()
      LineXY(lastPoint\x, lastPoint\y, vin()\x, vin()\y)
      lastPoint = vin()
    Next
    FillArea(x, y, RGB(255,255,255), RGB(255,255,255))
  StopDrawing() 
  *thisregion = CreateBitmapRegion(tmp)
  FreeImage(tmp)
  ProcedureReturn *thisregion  
EndProcedure

Procedure PtinRegion(*region.REGIONDATA, x, y)
  Protected width  = *region\width
  Protected height = *region\height
  If x<0 Or x >= width Or y<0 Or y>=height
    ProcedureReturn 0
  EndIf
  If *region\dbits(width*y+x)
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure FreeRegion(*region.REGIONDATA)
  FreeArray(*region\dbits())
  FreeMemory(*region)
EndProcedure

;======================================================
;               End of Library Code
;======================================================

Test prog:

Code: Select all


;Test code for CustomRegions.pbi

XIncludeFile "CustomRegions.pbi"

UsePNGImageDecoder()
img0 = CatchImage(#PB_Any, ?PicPak, 278)

DataSection
  PicPak:
  Data.b $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$51
  Data.b $00,$00,$00,$47,$08,$06,$00,$00,$00,$7F,$00,$AB,$B0,$00,$00,$00,$DD,$49,$44,$41
  Data.b $54,$78,$DA,$ED,$DC,$81,$09,$C0,$20,$0C,$45,$41,$F7,$5F,$3A,$1D,$22,$A1,$7E,$F5
  Data.b $DE,$06,$1E,$88,$56,$B4,$6B,$0D,$57,$07,$B4,$92,$AB,$83,$82,$78,$2B,$62,$1D,$18
  Data.b $C4,$DB,$10,$EB,$E0,$20,$DE,$82,$58,$17,$04,$F0,$74,$48,$88,$00,$F7,$43,$42,$04
  Data.b $B8,$1F,$12,$22,$C0,$BD,$90,$F5,$50,$10,$53,$11,$EB,$C1,$20,$A6,$21,$D6,$C3,$41
  Data.b $4C,$41,$2C,$15,$C0,$DD,$90,$E8,$9A,$88,$D8,$06,$20,$91,$35,$11,$71,$0D,$40,$A2
  Data.b $6A,$22,$62,$6A,$42,$E2,$19,$80,$44,$D3,$44,$C4,$32,$00,$89,$A4,$89,$88,$63,$00
  Data.b $12,$45,$13,$11,$03,$48,$D3,$D9,$E2,$22,$5B,$1C,$1B,$6E,$9F,$7D,$0E,$21,$54,$8E
  Data.b $C3,$FE,$01,$84,$38,$84,$08,$72,$00,$10,$E2,$10,$22,$C8,$01,$40,$88,$43,$88,$20
  Data.b $07,$00,$41,$BA,$5A,$97,$85,$E8,$A6,$2C,$C4,$1C,$44,$AF,$07,$20,$E6,$20,$7A,$51
  Data.b $05,$32,$07,$10,$22,$C8,$1C,$40,$88,$20,$73,$00,$21,$82,$CC,$01,$F4,$87,$26,$88
  Data.b $59,$88,$A7,$42,$AE,$B4,$20,$3E,$08,$B9,$52,$83,$F8,$10,$E4,$F4,$98,$3F,$96,$7D
  Data.b $1C,$92,$BE,$FC,$F1,$53,$00,$00,$00,$00,$49,$45,$4E,$44,$AE,$42,$60,$82
  PicPakend:
EndDataSection

CreateImage(0, 256,256,32, #PB_Image_Transparent)
StartDrawing(ImageOutput(0))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Circle(127,127,90,RGBA(0,0,255,255))
StopDrawing()

Procedure PlotDot( x, y, dist.i, angle.d, *pt.POINT ) 
  *pt\x = x+dist*Cos(Radian(angle)) 
  *pt\y = y+dist*Sin(Radian(angle)) 
EndProcedure 

NewList vectors.POINT()
For i=60 To 360 Step 60
  thisangle.d = i
  plotDot(40,35 , 40, thisangle, @thispoint.POINT)
  AddElement(vectors())
  vectors() = thispoint
Next

; Create Regions...
myregion         = CreateBitmapRegion(0)
myrectregion     = CreateRectRegion(500,400,640,480)
myellipticregion = CreateEllipticRegion(640,480,400,200,90,70)
mypolyregion     = CreatePolyRegion(vectors(),30,26)

OpenWindow(0,0,0, 640,480,"CustomRegion Demo",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)

CanvasGadget(0,0,0,640,480)
StartDrawing(CanvasOutput(0))
  Box(0,0,640,480,0)
  DrawAlphaImage(ImageID(0), 50,50)
  Ellipse(400,200,90,70,RGB(255,255,0))
  DrawAlphaImage(ImageID(img0),250,280)
  Box(500,400,140,80,RGB(255,0,0))
StopDrawing()

Repeat
  ev=WaitWindowEvent()
  Select ev
    Case #PB_Event_Gadget
      If EventGadget()=0
        mx = GetGadgetAttribute(0,#PB_Canvas_MouseX)
        my = GetGadgetAttribute(0,#PB_Canvas_MouseY)
        If PtinRegion(myregion, mx-50, my-50) ; subtract x/y locations of your image from mouse x/y here
          SetGadgetAttribute(0, #PB_Canvas_Cursor,#PB_Cursor_Hand)
        ElseIf PtinRegion(myrectregion, mx, my) ; no subtraction here because the region fits the canvas
          SetGadgetAttribute(0, #PB_Canvas_Cursor,#PB_Cursor_Hand)
        ElseIf PtinRegion(myellipticregion, mx, my) ; no subtraction here because the region fits the canvas
          SetGadgetAttribute(0, #PB_Canvas_Cursor,#PB_Cursor_Hand)
        ElseIf PtinRegion(mypolyregion, mx-250, my-280); subtract x/y locations of your image from mouse x/y here
          SetGadgetAttribute(0, #PB_Canvas_Cursor,#PB_Cursor_Hand)
        Else
          SetGadgetAttribute(0, #PB_Canvas_Cursor,#PB_Cursor_Default)
        EndIf
      EndIf
  EndSelect   
Until ev=#PB_Event_CloseWindow

Re: Native regions

Posted: Sat Jun 25, 2011 7:41 pm
by ts-soft
:D very, very usefull, thanks

PS: #BLUE is not avalaible on other os than windows :wink:

Greetings - Thomas

Re: Native regions

Posted: Sat Jun 25, 2011 7:45 pm
by netmaestro
PS: #BLUE is not avalaible on other os than windows
Darn! Figures I'd bugger something up. OK, edited sample. Thanks for the tip!

Re: Native regions

Posted: Sat Jun 25, 2011 10:46 pm
by idle
Nice addition thanks

Re: Native regions

Posted: Sat Jun 25, 2011 11:36 pm
by luis
Very nice idea, thank you !

Re: Native regions (updated June 25/2011)

Posted: Sun Jun 26, 2011 5:30 am
by Little John
Great, thank you!

Re: Native regions (updated July 2/2011)

Posted: Sun Jul 03, 2011 2:29 am
by netmaestro
July 2, 2011 added CreatePolyRegion() and demo code for it. Also compiled the library with Tailbite for Windows, no problems encountered except you have to employ the Tailbite method for optional parameters. Compiles to a 3kb lib and works fine.

CreatePolyRegion() is designed also to utilize the 24bit capability of CreateBitmapRegion(). All the other commands use the 32bit version. No problems found.

Re: Native regions (updated July 2/2011)

Posted: Sun Jul 03, 2011 5:56 am
by Demivec
netmaestro wrote:July 2, 2011 added CreatePolyRegion() and demo code for it. Also compiled the library with Tailbite for Windows, no problems encountered except you have to employ the Tailbite method for optional parameters. Compiles to a 3kb lib and works fine.

CreatePolyRegion() is designed also to utilize the 24bit capability of CreateBitmapRegion(). All the other commands use the 32bit version. No problems found.
Here's a version of CreatePolyRegion that uses a more simplified loop for rendering the polygon's outline.

Code: Select all

Procedure CreatePolyRegion( List vin.POINT(), x, y ) ; x,y is any point inside the polygon ( used for FillArea() )
  If ListSize(vin()) < 3
    ProcedureReturn 0
  EndIf

  Protected max.POINT 
  ForEach vin()
    If vin()\x > max\x
      max\x = vin()\x
    EndIf
    If vin()\y > max\y
      max\y = vin()\y
    EndIf    
  Next
  
  ;LastElement(vin()) ;should already be on last element
  Protected lastPoint.POINT = vin(), tmp, *thisregion
  tmp = CreateImage(#PB_Any, max\x + 1, max\y + 1) 
  StartDrawing(ImageOutput(tmp)) 
    Box(0, 0, max\x + 1, max\y + 1, RGB(255, 0, 255))
    ForEach vin()
      LineXY(lastPoint\x, lastPoint\y, vin()\x, vin()\y)
      lastPoint = vin()
    Next
    FillArea(x, y, #White, #White)
  StopDrawing() 
  *thisregion = CreateBitmapRegion(tmp)
  FreeImage(tmp)
  ProcedureReturn *thisregion  
EndProcedure

Re: Native regions (updated July 2/2011)

Posted: Sun Jul 03, 2011 11:53 am
by netmaestro
Thanks Demivec! That is definitely more efficient than my clumsy approach. I've updated the posted code with your procedure and thanks again, It's appreciated.

Re: Native regions (updated July 2/2011)

Posted: Sun Jul 03, 2011 5:55 pm
by Demivec
Your welcome.

I have some ideas for a few other things but I'm going to try and work out the code first to see if they're practical.

One of these include eliminating the need for adjusting the mouse location for PtinRegion(), such as having each region keep track of it's own minimum offset. Another would be to group the regions collectively for a given CanvasGadget so they can be processed with a single statement and allowing for cursor's and functioning to be specified for each of them. Two others involves polygon regions, allowing a polygon to be clipped (easy) and to have its image filled without having to specify an inner point (Trond did some polygon-fill routines for this).

I appreciate the groundwork you've laid. Lot's of things to tinker with. :wink:

Re: Native regions (updated July 2/2011)

Posted: Sun Jul 03, 2011 6:53 pm
by netmaestro
One of these include eliminating the need for adjusting the mouse location for PtinRegion(), such as having each region keep track of it's own minimum offset.
This is an interesting idea, however I wonder if it might cause more problems than it solves? Not sure at the moment as I haven't thought long about it but a possible implementation might see the REGIONDATA structure change from:

Code: Select all

Structure REGIONDATA
  width.l
  height.l
  Array dbits.b(0)
EndStructure
to:

Code: Select all

Structure REGIONDATA
  x.l
  y.l
  width.l
  height.l
  Array dbits.b(0)
EndStructure
and the x and y would be read and adjusted for by the PtInRegion() procedure. This seems a simpler way to go for regions that don't move but a great many regions have to move around within the canvas. For example, in my TrackSelection project, as the user moves the thumbs back and forth their new position is automatically accounted for because of mx-<current position of thumb>,my-<current position of thumb>. To implement this idea, a new command would be necessary, MoveRegion() and this would need to be called whenever the thumb moves. Is this more trouble than mx-, my- etc. or less trouble? The more I think about it, it might be less trouble. It would certainly be easier for coders to understand than having to deal with "...now I have to add something to something here, what the heck was that? Or was it subtract?...". Definite food for thought here, excellent idea.

Re: Native regions (updated July 2/2011)

Posted: Sun Jul 03, 2011 10:29 pm
by WilliamL
'point' structure not defined on the Mac platform.

[edit] new point structure code works fine. I didn't know this was possible... (but it is in the manual :wink: )

Code: Select all

CompilerIf Defined(POINT, #PB_Structure) = 0
  Structure POINT
    x.l
    y.l
  EndStructure
CompilerEndIf

Re: Native regions (updated July 2/2011)

Posted: Sun Jul 03, 2011 10:39 pm
by netmaestro
'point' structure not defined on the Mac platform.
Ok, thanks. Posted code modified to create point structure if it doesn't exist.

Re: Native regions (updated July 2/2011)

Posted: Tue Aug 30, 2016 11:28 pm
by netmaestro
Updated 2016-8-30 to conform to current CreateImage syntax (...32, #PB_Image_Transparent instead of ...32|#PB_Image_Transparent)

Re: Native regions (updated July 2/2011)

Posted: Wed Aug 31, 2016 5:00 am
by mestnyi
netmaestro

Code: Select all

If ImageDepth(image)=32
      DrawingMode(#PB_2DDrawing_AlphaChannel)
      For j=0 To height-1
        For i=0 To width-1
          cursor=width*j+i
          If Alpha(Point(i,j))
            *thisregion\dbits(cursor)=1
          Else
            *thisregion\dbits(cursor)=0
          EndIf
        Next
      Next
    Else
      DrawingMode(#PB_2DDrawing_Default)
      For j=0 To height-1
        For i=0 To width-1
          cursor=width*j+i
          If (Point(i,j)) = transcolor
            *thisregion\dbits(cursor)=0
          Else
            *thisregion\dbits(cursor)=1
          EndIf
        Next
      Next
    EndIf

Code: Select all

For j=0 To Height-1
    For i=0 To Width-1
      Cursor=Width*j+i
      
      If (Point(i,j) = 0) Or (Point(i,j) = transcolor)
        *thisregion\dbits(Cursor)=0
      Else
        *thisregion\dbits(Cursor)=1
      EndIf
      
    Next
  Next
So, as defined by the current cursor position is correct. Do you think whether there's the catch?