it can be used to identify objects scale and rotation invariant shape parameters to which you can template match for instance.
or simply to segment an image and track blobs and particles
web cam face tracker example.
uses hue to locate skin tones usually ~150 to 180 degrees, it should be fairly robust in most lighting conditions, though will suffer a bit under very low light.
Code: Select all
;
;idle blob analysis
;
;still need to fix autothreshold isn't to good at the moment uses triangle method. in HSV
;
;GetHSVRange(image number, *region of interest.RECT , *HSV.HSVREF , backGround #light Or #dark)
;uses triangle auto threshold which requires you to specify if the background is light or dark.
;
;
;findBlobs(image number,mincol.b,maxcol.b,GridSize,stride,draw,*roi.rect,*HSV.HSVREF,flag.i,color.i,minblobarea,maxblobarea)
;
;
; mincol maxcol uses red component thresholds 0 to 255 assumes *hsv is #null for this
;
; Grid size depends on the scale of what your looking for, divide image up into n x n grid to check for blobs
;
; stride steps through blob scan by value (no need to resize image) approximates blobs
;
; Draw output results on image
;
; Region of interest useful For tracking region like a face. (not fully tested yet)
;
; HSV theshold values in HSV get them from get GetHSVRange (hsv color space is better for testing for things like skin tones)
; though you realy need to specify a range manually for that purpose.
; You can determine the hue manually by calling the DrawHSV on an image and then scaling the pixel value by 1.411
;
; flags which thresholds you want To use #hue #sat #lum Or combined by Or's #hue | #lum
;
;
EnableExplicit
#hue = 1
#sat = 2
#lum = 4
#light = 0
#dark = 1
Structure HSV
H.i
S.i
V.i
EndStructure
Structure GREYREF
min.i
max.i
EndStructure
Structure HSVREF
HueMin.f ;0
HueMax.f ;360
SatMin.i ;0
SatMax.i ;100
lightMin.i ;0
lightMax.i ;255
EndStructure
Structure blobs
cx.f
cy.f
area.f
perim.f
minx.i
maxx.i
miny.i
maxy.i
mmx.i
mmy.i
orient.f
shape.f
majoraxis.f
minoraxis.f
sumX.f
sumXX.f
sumY.f
sumYY.f
sumXY.f
EndStructure
#StackSize =1024*1024*16
Global Dim stack(#stackSize);
Global stackPointer.i
Global stackheight
Global sumcol, avgcol,colcount
Procedure pop(*x.long,*y.long)
Protected p
If stackPointer > 0
p = stack(stackPointer);
*x\l = p / stackheight;
*y\l = p % stackheight
stackPointer-1;
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure push(x,y)
If stackPointer < #stackSize - 1
stackPointer+1;
stack(stackPointer) = stackheight * x + y
ProcedureReturn 1
Else
ProcedureReturn 0;
EndIf
EndProcedure
Procedure emptyStack()
StackPointer=0
EndProcedure
Global NewList blobs.blobs()
Global Dim arBlobs.blobs(1)
Declare FindBlobs(Img,mincol.i,maxcol.i,GridSize,stride,draw,*roi.rect,*HSV.HSVREF,flag.i,color.i,minarea,maxarea)
Declare CopyMemoryToImage(Memory, ImageNumber)
Declare CopyImageToMemory(ImageNumber, Memory)
Declare DrawBlobs(img,color.i)
Declare CheckHSV(*RefColor.LONG,HueMin,HueMax,satMin,satMax,lightMin,lightMax,flag)
Declare RGBHSV(*RefColor.LONG,*Hsv.HSV)
Declare GetHSVRange(img,*roi.RECT,*HSV.HSVREF,backGround.i)
Declare GetRangeGray(img,*roi.Rect,*grey.GreyRef,background.i)
Procedure BlobCount()
ProcedureReturn ListSize(blobs())
EndProcedure
Procedure GetAvgerageColor()
ProcedureReturn avgCol
EndProcedure
Procedure CopyBlobs()
Protected ct,asz,sz
sz = SizeOf(blobs)
asz = ListSize(blobs())
ReDim ArBlobs(asz)
ForEach blobs()
CopyMemory(blobs(),@arblobs()+ct*sz,sz)
ct+1
Next
EndProcedure
Procedure DrawBlobs(img,color.i)
Protected hdc,cx.f,cy.f,majoraxis.f,minoraxis.f,orient.f,dx.f,dy.f,ndx,ndy,r1.rect,da
hdc = StartDrawing(ImageOutput(img))
If ListSize(blobs()) > 0
ForEach blobs()
cx = blobs()\cx
cy = blobs()\cy
majoraxis = blobs()\majoraxis
minoraxis = blobs()\minoraxis
orient = blobs()\orient
r1\left = blobs()\minx
r1\right = blobs()\maxx
r1\top = blobs()\miny
r1\bottom = blobs()\maxy
LineXY(r1\left, r1\top,r1\right, r1\top ,color)
LineXY(r1\left, r1\top,r1\left, r1\bottom ,color)
LineXY(r1\right, r1\top,r1\right, r1\bottom ,color)
LineXY(r1\left, r1\bottom,r1\right, r1\bottom ,color)
Protected theta.f,dx1,dy1,cosOrient.f,SinOrient.f
cosOrient = Cos(-orient)
sinOrient = Sin(-orient)
;draw elipse
For da = 1 To 500
theta = da
dx = cx + (Sin(theta) * majoraxis)
dy = cy + (Cos(theta) * minoraxis)
dx1 = dx - cx
dy1 = dy - cy
ndx = cx + (dx1 * sinOrient - dy1 * cosorient) ;rotate elipse
ndy = cy + (dx1 * cosOrient + dy1 * sinorient)
SetPixel_(hdc, ndx, ndy,~color & $FFFF)
Next
SetPixel_(hdc, Int(cx), Int(cy), color)
Next
EndIf
StopDrawing()
EndProcedure
Procedure check(*mem,*px.long,x,y,width,*hsv.hsvref,mincol,maxcol,flag)
Protected rescheck ,px
*px = *mem + ((x + (y * width)) << 2 )
If *HSV
ResCheck = CheckHsv(*px,*hsv\HueMin,*hsv\HueMax,*hsv\SatMin,*hsv\SatMax,*hsv\lightMin,*hsv\lightMax,flag)
Else
px = *px\l & $FF
sumcol + px
colcount+1
If px >= mincol And px <= maxcol;
resCheck = 1
EndIf
EndIf
ProcedureReturn rescheck
EndProcedure
Procedure DrawHSV(img,flag)
Protected x,y,*px.long,hsv.hsv,width,height,*tmem,col
width = ImageWidth(img)
height = ImageHeight(img)
*tmem = AllocateMemory((width * height) << 2 )
copyimagetomemory(img,*tmem)
For x = 0 To width -1
For y = 0 To height -1
*px = *tmem + ((x + (y * width)) * 4)
RGBHSV(*px,@Hsv)
Select flag
Case #hue
col = hsv\h * 0.7083333
Case #sat
col = hsv\s * 2.55
Case #lum
col = hsv\V
EndSelect
*px\l = RGB(col,col,col)
Next
Next
CopyMemoryToImage(*tmem,img)
FreeMemory(*tmem)
EndProcedure
Procedure Scanblob(x,y,*mem,*roi.rect,*hsv.HSVREF,*blob.blobs,width,height,st2,mincol.i,maxcol.i,flag)
Protected px,check,*px.long,fleft,fright,fabove,flow,hit
stackheight = height
If x > *roi\left And x < *roi\right And y > *roi\top And y < *roi\bottom
emptyStack();
If check(*mem,*px,x,y,width,*hsv,mincol,maxcol,flag)
*px = *mem + ((x + (y * width)) << 2 )
*px\l = $FFFFFFFF
If push(x, y) = 0
ProcedureReturn;
EndIf
While pop(@x,@y)
If check(*mem,*px,x,y,width,*hsv,mincol,maxcol,flag)
*blob\sumXX + ((x*x) * st2)
*blob\sumYY + ((y*y) * st2)
*blob\sumXY + ((x*y) * st2)
*blob\sumX + (x * st2)
*blob\sumY + (y * st2)
*blob\Area + st2
If x < *blob\minX
*blob\minx = x
EndIf
If x > *blob\MaxX
*blob\MaxX = x
EndIf
If y < *blob\miny
*blob\MinY = y
EndIf
If y > *blob\maxY
*blob\maxY = y
EndIf
hit = 1
*px = *mem + ((x + (y * width)) << 2 )
*px\l = $FFFFFFFF
EndIf
If x+st2 < *roi\right-st2 And check(*mem,*px,x+st2,y,width,*hsv,mincol,maxcol,flag)
If push(x+st2, y) = 0
Break;
EndIf
ElseIf hit > 0
*px = *mem + (((x+st2) + (y * width)) << 2 )
If *px\l <> -1
*blob\perim + 1
hit -1
EndIf
EndIf
If x-st2 > *roi\left+st2 And check(*mem,*px,x-st2,y,width,*hsv,mincol,maxcol,flag)
If push(x-st2, y) = 0
Break;
EndIf
ElseIf hit > 0
*px = *mem + (((x-st2) + (y * width)) << 2 )
If *px\l <> -1
*blob\perim + 1
hit -1
EndIf
EndIf
If y+st2 < *roi\bottom-st2 And check(*mem,*px,x,y+st2,width,*hsv,mincol,maxcol,flag)
If push(x, y+st2) = 0
Break
EndIf
ElseIf hit > 0
*px = *mem + ((x + ((y+st2) * width)) << 2 )
If *px\l <> -1
*blob\perim + 1
hit -1
EndIf
EndIf
If y-st2 > *roi\top+st2 And check(*mem,*px,x,y-st2,width,*hsv,mincol,maxcol,flag)
If push(x, y-st2) = 0
Break
EndIf
ElseIf hit > 0
*px = *mem + ((x + ((y-st2) * width)) << 2 )
If *px\l <> -1
*blob\perim + 1
hit - 1
EndIf
EndIf
Wend
EndIf
EndIf
EndProcedure
Procedure FindBlobs(Img,mincol.i,maxcol.i,GridSize,stride,draw,*roi.rect,*HSV.HSVREF,flag.i,color.i,minarea,maxarea)
Protected width,height,rc.rect,dontfree,grid,garea,a,b,x,y,cx.f,cy.f,Ix.f,Iy.f,Ixy.f,mmx.f,mmy.f,ta.f,ra.f,rb.f,shape.f,orient.f
Protected majoraxis.f,minoraxis.f,blob.blobs,*mem
ClearList(blobs())
sumcol=0
colcount=1
If img
width = ImageWidth(img)
height = ImageHeight(img)
If *roi
rc\left = *roi\left
rc\right = *roi\right
rc\top = *roi\top
rc\bottom = *roi\bottom
Else
rc\left = 0
rc\right = width
rc\top = 0
rc\bottom = height
EndIf
*Mem = AllocateMemory((width * height << 2))
copyImageToMemory(img,*mem)
If *mem
grid = GridSize ;40
gArea = (width/grid * height/grid)
width = ImageWidth(img)
height = ImageHeight(img)
For a = 0 To grid-1
For b = 0 To grid-1
blob\Area =0
blob\perim = 0
blob\cx = 0
blob\cy = 0
blob\shape = 0
blob\minx = width
blob\maxx = 0
blob\miny = height
blob\maxy = 0
blob\orient = 0
blob\majoraxis = 0
blob\minoraxis = 0
blob\mmx = 0
blob\mmy = 0
blob\sumX = 0
blob\sumY = 0
blob\sumXX = 0
blob\sumYY = 0
blob\sumXY = 0
x = a * width/grid + (width/grid * 0.5)
y = b * height/grid + (height/grid * 0.5)
Scanblob(x,y,*mem,@rc,*HSV,@blob,width,height,stride,mincol,maxcol,flag)
If colcount
avgcol = sumcol / colcount
EndIf
If blob\area > minarea And blob\area < maxarea
;1st moments cx = centerX cy=centerY
cx = blob\sumx / blob\Area
cy = blob\sumy / blob\Area
blob\cx = cx
blob\cy = cy
;2nd moments Ix Iy Ixy
Ix = blob\SumXX - (blob\Area * (cx * cx))
Iy = blob\SumYY - (blob\Area * (cy * cy))
Ixy = blob\sumxy - (blob\Area * (cx * cy))
;3rd moment shape parameter invarent to scale and rotation
;line = 100: Symetric objects like circle square hexagon will = 583
ta= Sqr((2*IX*IY) - (4*(Ixy*Ixy))/2)
Ra = (Ix + Iy) + ta
Rb = (Ix + Iy) - ta
Shape = (Ra / Rb) * 100
mmx = (blob\maxX - blob\minX)
mmy = (blob\maxY - blob\minY)
blob\shape = Shape
Protected cmx.f,cmy.f,dmx.f, dmy.f
;orientation is only really valid for 180 degrees
;but by using the offset from the centeroid to the center of its bounding rect 360 degree range can be determined
;by looking at the larger positive delta.
;There are still tweeks needed to deal with exact alignments better 0 45 90 135 180 225 270 315
;though much of thisis due to axial symetry
cmx = (blob\maxX + blob\minX) /2
cmy = (blob\maxY + blob\minY) /2
dmx = cx - cmx
dmy = cy - cmy
If ix = iy
orient = 45
ElseIf mmx >= mmy
orient = (0.5 * (ATan(2 * (Ixy / (Iy - Ix))))) / (#PI / 180)
majoraxis = (mmx / Cos(Abs(orient) / (180 / #PI))) * 0.5
minoraxis = (blob\Area) / (#PI * majoraxis)
Else
orient = (0.5 * (ATan(2 * Ixy / (Ix - Iy)))) / (#PI / 180)
majoraxis = (mmy / Cos(Abs(orient) / (180 / #PI))) * 0.5
minoraxis = (blob\Area) / (#PI * majoraxis)
EndIf
If mmx = mmy And Abs(ix-iy) < 1000
orient = 0
EndIf
If ixy > 0
If iy > ix
If dmx > dmy
orient = (360 + orient) / (180/#PI)
Else
orient = (180 + orient) / (180/#PI)
EndIf
Else
If dmx > dmy
orient = (90 - orient) / (180/#PI)
Else
orient = (270 - orient) / (180/#PI)
EndIf
EndIf
Else
If iy > ix
If dmy > dmx
orient = (180 + orient) /(180/#PI)
Else
orient = orient /(180/#PI)
EndIf
Else
If dmx > dmy
orient = (90 - orient) / (180/#PI)
Else
orient = (270 - orient) / (180/#PI)
EndIf
EndIf
EndIf
If orient < 0
orient = 0
EndIf
blob\orient = orient
blob\majoraxis = majoraxis
blob\minoraxis = minorAxis
blob\mmx = mmx
blob\mmy = mmy
Debug "area " + StrF(blob\area,2)
Debug "shape " + StrF(shape,0)
Debug "orient " + StrF(blob\orient/(#PI/180),2)
Debug "perimeter " + StrF(blob\perim,2)
Debug "=================="
;note perimeter isn't accurate
AddElement(blobs())
CopyMemory(@blob,@blobs(),SizeOf(blobs))
EndIf
Next
Next
If draw
DrawBlobs(img,color)
EndIf
Else
MessageRequester("blobs","failed To allocate memory")
EndIf
If *mem
FreeMemory(*mem)
EndIf
ProcedureReturn ListSize(blobs())
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure CopyMemoryToImage(Memory, ImageNumber)
Protected TemporaryDC, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
TemporaryBitmapInfo\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
TemporaryBitmapInfo\bmiHeader\biWidth = TemporaryBitmap\bmWidth
TemporaryBitmapInfo\bmiHeader\biHeight = -TemporaryBitmap\bmHeight
TemporaryBitmapInfo\bmiHeader\biPlanes = 1
TemporaryBitmapInfo\bmiHeader\biBitCount = 32
TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
SetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
DeleteDC_(TemporaryDC)
EndProcedure
Procedure CopyImageToMemory(ImageNumber, Memory)
Protected TemporaryDC, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
TemporaryBitmapInfo\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
TemporaryBitmapInfo\bmiHeader\biWidth = TemporaryBitmap\bmWidth
TemporaryBitmapInfo\bmiHeader\biHeight = -TemporaryBitmap\bmHeight
TemporaryBitmapInfo\bmiHeader\biPlanes = 1
TemporaryBitmapInfo\bmiHeader\biBitCount = 32
TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
GetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
DeleteDC_(TemporaryDC)
EndProcedure
Procedure GetRangeGray(img,*roi.Rect,*grey.GreyRef,background.i)
Protected min.i,max.i,width,height,rc.rect,*mem,*px.LONG ,x,y,a,b,i,xc,yc,ct
Protected vmin.i, vmax.i,nx.f,ny.f,d.f,dx.f,sd.f,split.i ,mini,maxi
Dim gray(256)
If img
width = ImageWidth(img)
height = ImageHeight(img)
If *roi
rc\left = *roi\left
rc\right = *roi\right
rc\top = *roi\top
rc\bottom = *roi\bottom
Else
rc\left = 0
rc\right = width
rc\top = 0
rc\bottom = height
EndIf
*Mem = AllocateMemory((width * height << 2))
If *mem
copyImageToMemory(img,*mem)
For x = rc\left To rc\right-3
For y = rc\top To rc\bottom-3
*px = *mem + ((x + (y * width)) * 4)
gray((*px\l & $FF)) +1
Next
Next
gray(256) = width * height
min = 256
max=0
For a =0 To 255
If gray(a) <> 0 And gray(a) < gray(min)
min = a
EndIf
If gray(a) > gray(max)
max = a
EndIf
Next
nx = gray(max) - gray(min)
ny = min - max;
d = Sqr(nx * nx + ny * ny);
nx / d;
ny / d;
d = nx * min + ny * gray(min)
split = min
sd = 0
If min > max
mini = max
maxi = min
Else
mini = min
maxi = max
EndIf
For i = mini + 1 To maxi
dx = nx * i + ny * gray(i) - d
If dx > sd
split = i
sd = dx;
EndIf
Next
If backGround
vmin = split
vmax = max;
Else
vmin = min
vmax = split;
EndIf
If vmin < vmax
*grey\min = vmin
*grey\max = vmax
Else
*grey\min = vmax
*grey\max = vmin
EndIf
EndIf
EndIf
EndProcedure
Procedure GetHSVRange(img,*roi.RECT,*HSV.HSVREF,backGround.i)
Protected min.i,max.i,mini.i,maxi.i,width,height,rc.rect,*mem,*px.LONG ,x,y,a,b,i,xc,yc,ct,mediancut.i
Protected vmin.i, vmax.i, vsmin.i, vsmax.i, vlmin.i, vlmax.i ,nx.f,ny.f,d.f,dx.f,sd.f,split.i
Dim Hue.i(361)
Dim Sat.i(101)
Dim Lum.i(256)
Dim arH.i(9)
Dim arS.i(9)
Dim arV.i(9)
Protected hsv.HSV
If img
width = ImageWidth(img)
height = ImageHeight(img)
If *roi
rc\left = *roi\left
rc\right = *roi\right
rc\top = *roi\top
rc\bottom = *roi\bottom
Else
rc\left = 0
rc\right = width
rc\top = 0
rc\bottom = height
EndIf
*Mem = AllocateMemory((width * height << 2))
If *mem
copyImageToMemory(img,*mem)
If mediancut = 0
For x = rc\left To rc\right-3
For y = rc\top To rc\bottom-3
*px = *mem + ((x + (y * width)) * 4)
RGBHSV(*px,@Hsv)
Hue(hsv\h)+1
Sat(hsv\s)+1
Lum(hsv\v)+1
Next
Next
Else
For x = rc\left To rc\right-3
For y = rc\top To rc\bottom-3
ct=0
For xc = x To x + 2
For yc = y To y + 2
*px = *mem + ((xc + (yc * width)) * 4)
RGBHSV(*px,@Hsv)
arH(ct) = Hsv\H
arS(ct) = Hsv\S
arV(ct) = Hsv\V
ct+1
Next
Next
SortArray(arh(),#PB_Sort_Descending)
SortArray(arS(),#PB_Sort_Descending)
SortArray(arV(),#PB_Sort_Descending)
Hue(arh(4))+1
Sat(arS(4))+1
Lum(arV(4))+1
Next
Next
EndIf
hue(361) = width * height*360
min = 361
max = 0
For a = 0 To 360
If hue(a) <> 0 And hue(a) < hue(min)
min = a
EndIf
If hue(a) > hue(max)
max = a
EndIf
Next
nx = hue(max) - hue(min)
ny = min - max;
d = Sqr(nx * nx + ny * ny);
nx / d;
ny / d;
d = nx * min + ny * hue(min)
split = min
sd = 0
If min > max
mini = max
maxi = min
Else
mini = min
maxi = max
EndIf
For i = mini + 1 To maxi
dx = nx * i + ny * hue(i) - d
If dx > sd
split = i
sd = dx;
EndIf
Next
If backGround
vmin = split
vmax = max;
Else
vmin = min
vmax = split;
EndIf
sat(101) = width * height
min = 101
max=0
For a=0 To 100
If sat(a) <> 0 And sat(a) < sat(min)
min = a
EndIf
If sat(a) >= sat(max)
max = a
EndIf
Next
nx = sat(max) - sat(min)
ny = min - max;
d = Sqr(nx * nx + ny * ny);
nx / d;
ny / d;
d = nx * min + ny * sat(min)
split = min
sd = 0
If min > max
mini = max
maxi = min
Else
mini = min
maxi = max
EndIf
For i = mini + 1 To maxi
dx = nx * i + ny * sat(i) - d
If dx > sd
split = i
sd = dx;
EndIf
Next
If backGround
vsmin = split
vsmax = max;
Else
vsmin = min ;split
vsmax = split ;max;
EndIf
lum(256) = width * height
min = 256
max=0
For a =0 To 255
If lum(a) <> 0 And lum(a) < lum(min)
min = a
EndIf
If lum(a) > lum(max)
max = a
EndIf
Next
nx = lum(max) - lum(min)
ny = min - max;
d = Sqr(nx * nx + ny * ny);
nx / d;
ny / d;
d = nx * min + ny * lum(min)
split = min
sd = 0
If min > max
mini = max
maxi = min
Else
mini = min
maxi = max
EndIf
For i = mini + 1 To maxi
dx = nx * i + ny * lum(i) - d
If dx > sd
split = i
sd = dx;
EndIf
Next
If backGround
vlmin = split
vlmax = max;
Else
vlmin = min
vlmax = split
EndIf
If vmin < vmax
*hsv\huemin = vmin
*hsv\huemax = vmax
Else
*hsv\huemin = vmax
*hsv\huemax = vmin
EndIf
If vsmin < vsmax
*hsv\satmin = vsmin
*hsv\satmax = vsmax
Else
*hsv\satmin = vsmax
*hsv\satmax = vsmin
EndIf
If vlmin < vlmax
*hsv\lightmin = vlmin
*hsv\lightmax = vlmax
Else
*hsv\lightmin = vlmax
*hsv\lightmax = vlmin
EndIf
FreeMemory(*mem)
EndIf
EndIf
EndProcedure
Procedure RGBHSV(*RefColor.LONG,*Hsv.HSV)
Protected Hf.f,Sf.f,Vf.f,dt.f,R.i,G.i,B.i,c1.i,c2.i,st.i
R=*RefColor\l & $FF
G=*RefColor\l >> 8 & $FF
B=*RefColor\l >> 16 & $FF
If B > G And B > R
c1=R : c2=G : st=4 : Vf=B
ElseIf G > R
c1=R : c2=B : st=2 : vf=G
Else
c1=G : c2=B : st=1 : vf=R
EndIf
If Vf <> 0
If c1 > c2
dt = Vf - c2
Else
dt = Vf - c1
EndIf
If dt <> 0
Sf = (dt/Vf)
Hf = (st +(c1 - c2) / dt) *60
Else
Sf = 0
Hf = (st +(c1 - c2)) *60
EndIf
If Hf < 0
Hf + 360
EndIf
Sf*100
Else
Hf=0
Sf=0
EndIf
*hsv\H = Int(hf)
*hsv\S = Int(Sf)
*hsv\V = Int(vf)
EndProcedure
Procedure CheckHSV(*RefColor.LONG,HueMin,HueMax,satMin,satMax,lightMin,lightMax,flag)
Protected Hf.f,Sf.f,Vf.f,dt.f,R.i,G.i,B.i,c1.f,c2.f,st.f,inrange.i,test.i
R=*RefColor\l & $FF
G=*RefColor\l >> 8 & $FF
B=*RefColor\l >> 16 & $FF
If B > G And B > R
c1=R : c2=G : st=4 : Vf=B
ElseIf G > R
c1=R : c2=B : st=2 : vf=G
Else
c1=G : c2=B : st=1 : vf=R
EndIf
If Vf <> 0
If c1 > c2
dt = Vf - c2
Else
dt = Vf - c1
EndIf
If dt <> 0
Sf = (dt/Vf)
Hf = (st +(c1 - c2) / dt) *60
Else
Sf = 0
Hf = (st +(c1 - c2)) *60
EndIf
If Hf < 0
Hf + 360
EndIf
Sf*100
Else
Hf=0
Sf=0
EndIf
; #hue 1
; #sat 2
; #hue | #sat 3
; #lum 4
; #hue | #lum 5
; #sat | #lum 6
; #hue | #sat | #lum 7
;
Select flag
Case 1
If hf >= HueMin And hf <= HueMax
inrange + 1
EndIf
test = 1
Case 2
If sf >= SatMin And sf <= SatMax
inrange + 1
EndIf
test=1
Case 3
If sf > Satmin And sf <= satmax
inrange +1
EndIf
If hf >= HueMin And hf <= HueMax
inrange + 1
EndIf
test = 2
Case 4
If vf >= lightMin And vf <= lightMax
inrange + 1
EndIf
test = 1
Case 5
If hf >= HueMin And hf <= HueMax
inrange + 1
EndIf
If vf >= lightMin And vf <= lightMax
inrange + 1
EndIf
test = 2
Case 6
If sf >= SatMin And sf <= SatMax
inrange + 1
EndIf
If vf >= lightMin And vf <= lightMax
inrange + 1
EndIf
test = 2
Case 7
If hf >= HueMin And hf <= HueMax
inrange + 1
EndIf
If sf >= SatMin And sf <= SatMax
inrange + 1
EndIf
If vf >= lightMin And vf <= lightMax
inrange + 1
EndIf
test = 3
EndSelect
If inrange = test
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Code: Select all
#WM_CAP_START = #WM_USER
#WM_CAP_SET_CALLBACK_ERROR = #WM_CAP_START + 2
#WM_CAP_SET_CALLBACK_STATUS = #WM_CAP_START + 3
#WM_CAP_SET_CALLBACK_YIELD = #WM_CAP_START + 4
#WM_CAP_SET_CALLBACK_FRAME = #WM_CAP_START + 5
#WM_CAP_SET_CALLBACK_VIDEOSTREAM = #WM_CAP_START + 6
#WM_CAP_SET_CALLBACK_WAVESTREAM = #WM_CAP_START + 7
#WM_CAP_DRIVER_CONNECT = #WM_USER + 10
#WM_CAP_DRIVER_DISCONNECT = #WM_USER + 11
#WM_CAP_DRIVER_GET_CAPS = #WM_CAP_START + 14
#WM_CAP_DLG_VIDEOFORMAT = #WM_CAP_START + 41
#WM_CAP_DLG_VIDEOSOURCE = #WM_CAP_START + 42
#WM_CAP_DLG_VIDEODISPLAY = #WM_CAP_START + 43
#WM_CAP_SET_PREVIEW = #WM_CAP_START + 50
#WM_CAP_SET_PREVIEWRATE = #WM_CAP_START + 52
#WM_CAP_GET_STATUS = #WM_CAP_START + 54
#WM_CAP_FILE_SAVEDIB = #WM_USER + 25
#WM_CAP_SET_SCALE = #WM_USER + 53
#WM_CAP_SET_CALLBACK_CAPCONTROL = #WM_CAP_START + 85
Structure VIDEOHDR
lpData.l
dwBufferLength.l
dwBytesUsed.l
dwTimeCaptured.l
dwUser.l
dwFlags.l
dwReserved.l[3]
EndStructure
define *cp
OpenLibrary(1,"avicap32.dll"):*cp=GetFunction(1,"capCreateCaptureWindowW")
XIncludeFile "blobs.pbi"
ExamineDesktops()
Structure SBGR
b.b
g.b
r.b
EndStructure
Global *mem,img1,img2,hwnd ,hWebcam,gLow,gHigh
img1 = CreateImage(#PB_Any, 320, 240)
img2 = CreateImage(#PB_Any, 320, 240)
*mem = AllocateMemory(320*240*4)
Procedure FrameCallback(hWnd.l, *lpVHdr.VIDEOHDR)
Protected *VideoMemoryAdress1.SBGR = *lpVHdr\lpData
Protected y,x, hsv.HSV,hsvR.HSVREF,rc.rect,ma,cx,cy,tc,mhigh
StartDrawing(ImageOutput(img1))
For y = 240 - 1 To 0 Step -1
For x = 0 To 320 - 1
Plot(x, y, RGB(*VideoMemoryAdress1\r & $FF, *VideoMemoryAdress1\g & $FF, *VideoMemoryAdress1\b & $FF))
*VideoMemoryAdress1 + 3
Next
Next
StopDrawing()
drawhsv(img1,#hue)
FindBlobs(img1,glow,ghigh,200,1,#True,#Null,#Null,#Null,RGB(255,0,0),1000,20000)
;find skin tone blobs usually 150 to 180 in hue
StartDrawing(ImageOutput(img1))
ForEach blobs()
If blobs()\area > ma
ma = blobs()\area
rc\left = blobs()\minX
rc\right = blobs()\maxX
rc\top = blobs()\minY
rc\bottom = blobs()\maxY
cx = blobs()\cx
cy = blobs()\cy
ma = blobs()\minoraxis
Circle(blobs()\cx,blobs()\cy,5,(RGB(255,0,0)))
EndIf
Next
StopDrawing()
;could call again to find the eyes assuming the face is the largest region
;so could find them in hue, or lum
;mhigh = glow * 0.5
;FindBlobs(img1,0,mhigh,200,1,#False,@rc,#Null,#Null,RGB(255,0,0),5,300)
; Protected a,b,n,x1,y1,dx,dy,dz,bct
; n = blobCount()
; Dim aBlobs.blobs(n)
;
; ForEach blobs()
; x1 = blobs()\cx
; y1 = blobs()\cy
; dx = cx-x1
; dy = cy-y1
; dz = Sqr(dx*dx+dy*dy)
;
; If dz < ma
; CopyMemory(blobs(),@ablobs(bct),SizeOf(blobs))
; bct+1
; EndIf
; Next
; StartDrawing(ImageOutput(img1))
; dx=0:dy=0
; If bct
; For b = 0 To bct-1
; dx + ablobs(b)\cx
; dy + ablobs(b)\cy
; Circle(ablobs(b)\cx,ablobs(b)\cy,5,(RGB(255,0,0)))
; Next
; dx/(bct)
; dy/(bct)
;
; ;SetCursorPos_(WindowX(0)+dx,WindowY(0)+dy)
; EndIf
; StopDrawing()
SetGadgetState(1,ImageID(img1))
EndProcedure
hWnd = OpenWindow(0, 0, 0, 640, 320, "Blob Tracker", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
ImageGadget(1, 320, 0, 320, 240,ImageID(img1))
TextGadget(2, 5, 245, 30, 20, "Low")
TrackBarGadget(3, 50, 245, 255, 30, 0, 254)
TextGadget(4, 5, 270, 30, 20, "High")
TrackBarGadget(5, 50, 270, 255, 30, 0, 254)
SetGadgetState(3,150)
SetGadgetState(5,180)
gLow = 150
gHigh = 180
Global ev,GadgetID,EventType
hWebcam= CallFunctionFast(*cp,@"cam track",$50000000,0,0,320,240,hWnd,0)
SendMessage_(hWebcam, #WM_CAP_DRIVER_CONNECT , 0, 0)
SendMessage_(hWebcam, #WM_CAP_SET_SCALE , 1, 0)
SendMessage_(hWebcam, #WM_CAP_SET_PREVIEWRATE , 10, 0)
SendMessage_(hWebcam, #WM_CAP_SET_PREVIEW , 1, 0)
SendMessage_(hWebcam, #WM_CAP_SET_CALLBACK_FRAME , 0, @FrameCallback())
;If your camera isn't set at 320 x 240 uncomment
;SendMessage_(hWebcam, #WM_CAP_DLG_VIDEOFORMAT, 0, 0)
Repeat
ev = WaitWindowEvent(3)
GadgetID = EventGadget()
EventType = EventType()
If Ev = #PB_Event_Gadget
Select GadgetID
Case 3
gLow = GetGadgetState(3)
Case 5
gHigh = GetGadgetState(5)
EndSelect
EndIf
Until ev = #PB_Event_CloseWindow Or GetAsyncKeyState_(#VK_ESCAPE) & $1
End
