Native regions (updated July 2/2011)

Share your advanced PureBasic knowledge/code with the community.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Native regions (updated July 2/2011)

Post 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
Last edited by netmaestro on Tue Aug 30, 2016 10:55 pm, edited 11 times in total.
BERESHEIT
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: Native regions

Post by ts-soft »

:D very, very usefull, thanks

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

Greetings - Thomas
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Native regions

Post 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!
BERESHEIT
User avatar
idle
Always Here
Always Here
Posts: 5839
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Native regions

Post by idle »

Nice addition thanks
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
luis
Addict
Addict
Posts: 3893
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: Native regions

Post by luis »

Very nice idea, thank you !
"Have you tried turning it off and on again ?"
A little PureBasic review
Little John
Addict
Addict
Posts: 4778
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: Native regions (updated June 25/2011)

Post by Little John »

Great, thank you!
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Native regions (updated July 2/2011)

Post 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.
BERESHEIT
User avatar
Demivec
Addict
Addict
Posts: 4260
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Native regions (updated July 2/2011)

Post 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
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Native regions (updated July 2/2011)

Post 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.
BERESHEIT
User avatar
Demivec
Addict
Addict
Posts: 4260
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Native regions (updated July 2/2011)

Post 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:
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Native regions (updated July 2/2011)

Post 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.
BERESHEIT
WilliamL
Addict
Addict
Posts: 1252
Joined: Mon Aug 04, 2008 10:56 pm
Location: Seattle, USA

Re: Native regions (updated July 2/2011)

Post 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
Last edited by WilliamL on Sun Jul 03, 2011 11:58 pm, edited 3 times in total.
MacBook Pro-M1 (2021), Sequoia 15.4, PB 6.20
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Native regions (updated July 2/2011)

Post by netmaestro »

'point' structure not defined on the Mac platform.
Ok, thanks. Posted code modified to create point structure if it doesn't exist.
BERESHEIT
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Native regions (updated July 2/2011)

Post by netmaestro »

Updated 2016-8-30 to conform to current CreateImage syntax (...32, #PB_Image_Transparent instead of ...32|#PB_Image_Transparent)
BERESHEIT
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Native regions (updated July 2/2011)

Post 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?
Post Reply