Easy Webcam - uses dll

[Vendan]

This is a rather easy to implement webcam dll, pretty fast, and copys the data into a buffer for you.
http://sol.gfxile.net/code.html
download the escapi21.zip and pull out the escapi.dll

Code: Select all

#define PTC_WIN
#include "tinyptc.bi"


Dim escapi_dll As any ptr

Type SimpleCapParams
mTargetBuf As Integer Ptr
mWidth As Integer
mHeight As Integer
End Type

Dim Shared initCOM As Function stdcall () As Integer
Dim Shared countCaptureDevices As Function stdcall () As Integer
Dim Shared initCapture As Function stdcall (deviceno As Uinteger, aParams As SimpleCapParams Ptr) As Integer
Dim Shared deinitCapture As Function stdcall (deviceno As Uinteger) As Integer
Dim Shared doCapture As Function stdcall (deviceno As Uinteger) As Integer
Dim Shared isCaptureDone As Function stdcall (deviceno As Uinteger) As Integer
Dim Shared getCaptureDeviceName As Sub stdcall (deviceno As Uinteger, namebuffer As Zstring Ptr, bufferlength As Integer)
Dim Shared ESCAPIDLLVersion As Function stdcall () As Integer

escapi_dll = DYLIBLOAD("escapi")
initCOM = DYLIBSYMBOL(escapi_dll, "initCOM")
countCaptureDevices = DYLIBSYMBOL(escapi_dll, "countCaptureDevices")
initCapture = DYLIBSYMBOL(escapi_dll, "initCapture")
deinitCapture = DYLIBSYMBOL(escapi_dll, "deinitCapture")
doCapture = DYLIBSYMBOL(escapi_dll, "doCapture")
isCaptureDone = DYLIBSYMBOL(escapi_dll, "isCaptureDone")
getCaptureDeviceName = DYLIBSYMBOL(escapi_dll, "getCaptureDeviceName")
ESCAPIDLLVersion = DYLIBSYMBOL(escapi_dll, "ESCAPIDLLVersion")
 
initCOM()

dim camname as zstring*100
dim l1 as integer
dim capparams as SimpleCapParams
dim buffer(320,240) as integer

capparams.mTargetBuf=@buffer(0,0)
capparams.mWidth=320
capparams.mHeight=240

print initCapture(0, @capparams)
print doCapture(0)
while isCaptureDone(0) <> 1
sleep(10)
wend
print "Captured"
ptc_open("WebCam", 320, 240)
while inkey$=""
ptc_update(@buffer(0,0))
doCapture(0)
while isCaptureDone(0) <> 1
sleep(10)
wend
wend
ptc_close()
deInitCapture(0)
sleep

[BasicCoder2]

This is a rather easy to implement webcam dll, pretty fast, and copys the data into a buffer for you.
http://sol.gfxile.net/code.html
download the escapi21.zip and pull out the escapi.dll

Worked a treat. It didn't work however when I changed
the dimensions to 640,480? The webcam I used is built
into the laptop. Can you show an example of how to
make use of the pixel data? eg. A simple inversion of
the colors for example?

[Vendan]

Kinda working on a strange project so i had already coded a little bit of edge detection into this version, which shows pixel data access as well. Plus, includes defines for height and width, you may have missed the one of the values. This one does 640x480 for me, just a little slow, drop it to 320x240 to speed it up a bit. also gotta streamline the edge detector a bit, i think it's pretty inefficient right now.

Code: Select all

#define PTC_WIN
#include "tinyptc.bi"

#define SCRWIDTH 640
#define SCRHEIGHT 480

Dim escapi_dll As any ptr

Type SimpleCapParams
mTargetBuf As Integer Ptr
mWidth As Integer
mHeight As Integer
End Type

union tquadcolor
type
r as ubyte
g as ubyte
b as ubyte
a as ubyte
end type
value as uinteger
end union

Dim Shared initCOM As Function stdcall () As Integer
Dim Shared countCaptureDevices As Function stdcall () As Integer
Dim Shared initCapture As Function stdcall (deviceno As Uinteger, aParams As SimpleCapParams Ptr) As Integer
Dim Shared deinitCapture As Function stdcall (deviceno As Uinteger) As Integer
Dim Shared doCapture As Function stdcall (deviceno As Uinteger) As Integer
Dim Shared isCaptureDone As Function stdcall (deviceno As Uinteger) As Integer
Dim Shared getCaptureDeviceName As Sub stdcall (deviceno As Uinteger, namebuffer As Zstring Ptr, bufferlength As Integer)
Dim Shared ESCAPIDLLVersion As Function stdcall () As Integer

escapi_dll = DYLIBLOAD("escapi")
initCOM = DYLIBSYMBOL(escapi_dll, "initCOM")
countCaptureDevices = DYLIBSYMBOL(escapi_dll, "countCaptureDevices")
initCapture = DYLIBSYMBOL(escapi_dll, "initCapture")
deinitCapture = DYLIBSYMBOL(escapi_dll, "deinitCapture")
doCapture = DYLIBSYMBOL(escapi_dll, "doCapture")
isCaptureDone = DYLIBSYMBOL(escapi_dll, "isCaptureDone")
getCaptureDeviceName = DYLIBSYMBOL(escapi_dll, "getCaptureDeviceName")
ESCAPIDLLVersion = DYLIBSYMBOL(escapi_dll, "ESCAPIDLLVersion")
 
initCOM()

dim camname as zstring*100
dim as integer l1, l2, l3, l4
dim capparams as SimpleCapParams
dim buffer as uinteger ptr
dim screenbuffer as uinteger ptr
dim quadcolor as tquadcolor
dim tempcolor as tquadcolor
dim edge as uinteger
dim tempedge as uinteger

buffer = callocate(SCRWIDTH*SCRHEIGHT*4)
screenbuffer = callocate(SCRWIDTH*SCRHEIGHT*4)

capparams.mTargetBuf=buffer
capparams.mWidth=SCRWIDTH
capparams.mHeight=SCRHEIGHT

print initCapture(0, @capparams)
print doCapture(0)
while isCaptureDone(0) <> 1
sleep(10)
wend
print "Captured"
ptc_open("WebCam", SCRWIDTH, SCRHEIGHT)
while inkey$=""

for l1=5 to SCRHEIGHT - 5
for l2=5 to SCRWIDTH - 5
edge = 0

quadcolor.value = *(buffer+(l1*SCRWIDTH)+l2)

for l3=-1 to 1
for l4=-1 to 1
tempcolor.value = *(buffer+((l1+l3)*SCRWIDTH)+(l2+l4))
tempedge = cuint(abs(quadcolor.r-tempcolor.r))
tempedge += cuint(abs(quadcolor.g-tempcolor.g))
tempedge += cuint(abs(quadcolor.b-tempcolor.b))
edge += tempedge
'if tempedge>25 then
'edge+=25
'end if
next l4
next l3

edge = edge / 8

quadcolor.r=edge
quadcolor.g=edge
quadcolor.b=edge
*(screenbuffer+(l1*SCRWIDTH)+l2) = quadcolor.value
next l2
next l1
ptc_update(screenbuffer)
doCapture(0)
while isCaptureDone(0) <> 1
sleep(10)
wend
wend
ptc_close()
deInitCapture(0)

[BasicCoder2]

Kinda working on a strange project so i had already coded a little bit of edge detection into this version, which shows pixel data access as well. Plus, includes defines for height and width, you may have missed the one of the values. This one does 640x480 for me, just a little slow, drop it to 320x240 to speed it up a bit. also gotta streamline the edge detector a bit, i think it's pretty inefficient right now.

This is really great for me Vendan. I am not familiar
with PTC but otherwise I can follow the code ok. I had
started using DevCpp, framecap and the SDL library to
capture webcam images.

I hadn't worked out the best way to represent pixel
values but your tquadcolor seems to make sense. I had
thought of using the alpha byte to hold a gray version
of the image.

Below is a crude edge routine for 640x480x24 bitmap
images loaded from the HD. I used parallel arrays which
I admit isn't the best way to do it.

Code: Select all

screen 20,32

dim shared As Ubyte red1(640,480),blu1(640,480),grn1(640,480)
dim shared as ubyte gray(640,480)

dim as integer r1,r2,g1,g2,b1,b2,r,g,b
dim as integer v,d

Dim Shared buff1(4 * (640 * 480) + 4) As Integer
         
Bload "c:\FreeBasic\bitmaps\flowers.bmp", @buff1(0)

'display image
for y as integer = 1 to 478
    for x as integer = 1 to 639
        v = buff1(x+y*640+8)
        red1(x,y) = v shr 16 and 255
        grn1(x,y) = v shr 8 and 255
        blu1(x,y) = v and 255
        pset(x,y),rgb(red1(x,y),grn1(x,y),blu1(x,y))
    next x
next y
sleep
'compute horizontal distance between pixels
'save in gray array
for y as integer = 1 to 478
    for x as integer = 1 to 638
        r1 = red1(x,y)
        g1 = grn1(x,y)
        b1 = blu1(x,y)
        r2 = red1(x+1,y)
        g2 = grn1(x+1,y)
        b2 = blu1(x+1,y)
        r = abs(r1-r2)
        g = abs(g1-g2)
        b = abs(b1-b2)
        d = sqr(r*r+g*g+b*b)
        gray(x,y)=d
        pset(x,y),rgb(d,d,d)
    next x
next y
sleep
'compute vertical distance
for x as integer = 1 to 639
    for y as integer = 1 to 477
        r1 = red1(x,y)
        g1 = grn1(x,y)
        b1 = blu1(x,y)
        r2 = red1(x,y+1)
        g2 = grn1(x,y+1)
        b2 = blu1(x,y+1)
        r = abs(r1-r2)
        g = abs(g1-g2)
        b = abs(b1-b2)
        d = sqr(r*r+g*g+b*b)
        d = gray(x,y)+d
        gray(x,y)= d
        pset(x,y),rgb(d,d,d)
    next y
next x

sleep
end

Here is the color inversion example.

Code: Select all

...

Print "Captured"
ptc_open("WebCam", SCRWIDTH, SCRHEIGHT)
While Inkey$=""
  For y=0 To SCRHEIGHT - 1
    For x=0 To SCRWIDTH - 1

      quadcolor.value = *(buffer+(y*SCRWIDTH)+x)

      quadcolor.r = 255 - quadcolor.r
      quadcolor.g = 255 - quadcolor.g
      quadcolor.b = 255 - quadcolor.b
      
      *(screenbuffer+(y*SCRWIDTH)+x) = quadcolor.value
    Next x
  Next y

  ptc_update(screenbuffer)

  doCapture(0)

  While isCaptureDone(0) <> 1
    Sleep(10)
  Wend
wend

[D.J.Peters]

nice DLL i tested it with FB gfx image

NOTE: CDECL not STDCALL!!!

"escapi.bi"

Code: Select all

' Extremely Simple Capture API

type SimpleCapParams
  ' Target buffer. 
  ' Must be at least mWidth * mHeight * sizeof(int) of size! 
  as integer ptr mTargetBuf
  as integer  mWidth
  as integer  mHeight
end type


' Sets up the ESCAPI DLL and the function pointers below. Call this first!
' Returns number of capture devices found (same as countCaptureDevices, below)
declare function setupESCAPI() as integer

' return the number of capture devices found
type countCaptureDevicesProc as function cdecl as integer
dim shared as countCaptureDevicesProc countCaptureDevices

' initCapture tries to open the video capture device. 
' Returns 0 on failure, 1 on success. 
' Note: Capture parameter values must not change while capture device
'       is in use (i.e. between initCapture and deinitCapture).
'       Do *not* free the target buffer, or change its pointer!
type initCaptureProc as function cdecl (deviceno as integer,p as  SimpleCapParams ptr) as integer
dim shared as initCaptureProc initCapture

' deinitCapture closes the video capture device.
type deinitCaptureProc as sub cdecl(deviceno as integer)
dim shared as deinitCaptureProc deinitCapture

' doCapture requests video frame to be captured.
type doCaptureProc as sub cdecl(deviceno as integer)
dim shared as doCaptureProc doCapture

' isCaptureDone returns 1 when the requested frame has been captured.
type isCaptureDoneProc as function cdecl(deviceno as integer) as integer
dim shared as isCaptureDoneProc isCaptureDone

' Get the user-friendly name of a capture device.
type getCaptureDeviceNameProc as sub cdecl(deviceno as integer,namebuffer as zstring ptr,bufferlength as integer)
dim shared as getCaptureDeviceNameProc getCaptureDeviceName

' Returns the ESCAPI DLL version. 0x200 for 2.0
type ESCAPIDLLVersionProc as function() as integer
dim shared as ESCAPIDLLVersionProc ESCAPIDLLVersion

' Internal: initialize COM
type initCOMProc as sub cdecl
dim shared as initCOMProc initCOM

function setupESCAPI() as integer

  ' Load DLL dynamically
  dim as any ptr capdll = DyLibLoad("escapi.dll")
  if (capdll = 0) then
    print "can't load 'escapi.dll' !"
    beep:sleep:return 0
  end if
  ' Fetch function DyLibSymbol(escapi_dll,
  countCaptureDevices  = DyLibSymbol(capdll, "countCaptureDevices")
  initCapture          = DyLibSymbol(capdll, "initCapture")
  deinitCapture        = DyLibSymbol(capdll, "deinitCapture")
  doCapture            = DyLibSymbol(capdll, "doCapture")
  isCaptureDone        = DyLibSymbol(capdll, "isCaptureDone")
  initCOM              = DyLibSymbol(capdll, "initCOM")
  getCaptureDeviceName = DyLibSymbol(capdll, "getCaptureDeviceName")
  ESCAPIDLLVersion     = DyLibSymbol(capdll, "ESCAPIDLLVersion")

  if ESCAPIDLLVersion=0 then
    print "can't get proc address !"
    beep:sleep:return 0
  end if
  if (ESCAPIDLLVersion() <> &H200) then
        print "wrong dll version !"
    beep:sleep:return 0
  end if
  ' Initialize COM.
  initCOM()

  ' and return the number of capture devices found.
  return countCaptureDevices()
end function

"test01.bas"

Code: Select all

#include "escapi.bi"


const SCR_W = 320
const SCR_H = 240

dim as integer nDevices=setupESCAPI()
if nDevices<1 then
  print "No active capture device found!"
  beep:sleep:end
end if

ScreenRes SCR_W,SCR_H,32
dim as any ptr lpImage=ImageCreate(SCR_W,SCR_H)

dim as SimpleCapParams Params
with Params
  .mWidth  = SCR_W
  .mHeight = SCR_H
  .mTargetBuf=cptr(integer ptr,lpImage)
  .mTargetBuf+=8
end with

WindowTitle "initCapture=" & str(initCapture(0, @Params))

while inkey<>chr$(27)
  doCapture(0)
  While isCaptureDone(0)<>1:Sleep(10):Wend
  put (0,0),lpImage,pset
wend
end

[BasicCoder2]

> nice DLL i tested it with FB gfx image

Nice? I think it is great! You can even
capture images from four webcams. Glad to
see you are providing your expertise in
making use of the dll.

I hope to use it to duplicate some of the
things you can do with the RobotRealm
software plus a few of my own ideas.

With OpenCV there is apparently routines
to locate and track human faces using skin
colors and an eigenface implementation for
face recognition that maybe can be done
with FreeBasic code?


John

[duke4e]

Heres a faster edge detection algorithm:

Code: Select all

dim as integer greyL, greyR, greyU, greyD, greyLR, greyUD
For y As Integer = 1 To 478
    For x As Integer = 1 To 638
        greyL = (0.3f * red1(x-1,y)) + (0.59f * grn1(x-1,y)) + (0.11f * blu1(x-1,y))
        greyR = (0.3f * red1(x+1,y)) + (0.59f * grn1(x+1,y)) + (0.11f * blu1(x+1,y))
        greyU = (0.3f * red1(x,y-1)) + (0.59f * grn1(x,y-1)) + (0.11f * blu1(x,y-1))
        greyD = (0.3f * red1(x,y+1)) + (0.59f * grn1(x,y+1)) + (0.11f * blu1(x,y+1))
        greyLR = abs(greyL - greyR)
        greyUD = abs(greyU - greyD)
        gray(x,y) = abs(greyLR - greyUD)
    Next x
Next y

[BasicCoder2]

Heres a faster edge detection algorithm:

Firstly you have converted the data to grey values
before doing the differencing. Two different colors
may produce the same grey values and that is why I
was finding the difference in 3D color space. The
program below illustrates what I mean.

Code: Select all

screen 20,32

Dim shared As Ubyte red1(640,480),blu1(640,480),grn1(640,480)
dim shared as ubyte grey(640,480)

dim as integer r1,r2,g1,g2,b1,b2,r,g,b
dim as integer mx,my,btns,v,d,aa,bb,d1,d2
dim as integer max,min,rmax,gmax,bmax,rmin,gmin,bmin

Dim Shared buff1(4 * (640 * 480) + 4) As Integer
         
Bload "c:\FreeBasic\bitmaps\flowers.bmp", @buff1(0)

'display image
for y as integer = 1 to 478
    for x as integer = 1 to 639
        v = buff1(x+y*640+8)
        red1(x,y) = v shr 16 and 255
        grn1(x,y) = v shr 8 and 255
        blu1(x,y) = v and 255
        pset(x,y),rgb(red1(x,y),grn1(x,y),blu1(x,y))
    next x
next y
sleep

'edge image
for y as integer = 1 to 478
    for x as integer = 1 to 638
        r1 = red1(x,y)
        g1 = grn1(x,y)
        b1 = blu1(x,y)
        r2 = red1(x+1,y)
        g2 = grn1(x+1,y)
        b2 = blu1(x+1,y)
        r = abs(r1-r2)
        g = abs(g1-g2)
        b = abs(b1-b2)
        d1 = sqr(r*r+g*g+b*b)
        r2 = red1(x,y+1)
        g2 = grn1(x,y+1)
        b2 = blu1(x,y+1)
        r = abs(r1-r2)
        g = abs(g1-g2)
        b = abs(b1-b2)
        d2 = sqr(r*r+g*g+b*b)
        if d1>d2 then
            pset(x,y),rgb(255,d1,255)
        else
            pset(x,y),rgb(d2,255,255)
        end if
        'if not much change forget it
        if d1<16 and d2<16 then
            pset(x,y),rgb(0,0,0)
        end if
    next x
next y

sleep
end

Secondly what do we do with the edge data? One thing
we might want to do is know their slope. Thus is the
slope from pixel x,y going up or down and in which
direction is this change greatest?

In the previous edge code I was separating edges with
more vertical from those that were more horizontal.
I should have done it in the same nested loops as I
have done below where I display the two extractions
using different colors.

John

Code: Select all

dim as integer y,r,g,b,v,grey
dim as integer d1,d2,d
dim as integer r1,g1,b1,r2,g2,b2

screenres 640,480,32

'create blocks of color

for x as integer = 0 to 600 step 100
    read r,g,b
    line (x,0)-(x+100,80),rgb(r,g,b),bf
next x
line (630,0)-(639,80),rgb(255,255,255),bf
sleep

'edge change in grey level only

For y As Integer = 1 To 40
    For x As Integer = 1 To 637
        v = point(x,y)
        r = v shr 16 and 255
        g = v shr  8 and 255
        b = v and 255
        d1 = (0.3f * r) + (0.59f * g) + (0.11f * b)
        v = point(x+1,y)
        r = v shr 16 and 255
        g = v shr  8 and 255
        b = v and 255
        d2 = (0.3f * r) + (0.59f * g) + (0.11f * b)
        d = Abs(d1-d2)
        pset(x,y+100),rgb(d,d,d)
    Next x
Next y
sleep

'edge change in 3D color space

for y as integer = 41 to 80
    for x as integer = 0 to 637
        v = point(x,y)
        r1 = v shr 16 and 255
        g1 = v shr  8 and 255
        b1 = v and 255
        v = point(x+1,y)
        r2 = v shr 16 and 255
        g2 = v shr  8 and 255
        b2 = v and 255
        r = abs(r1-r2)
        g = abs(g1-g2)
        b = abs(b1-b2)
        d = sqr(r*r+g*g+b*b)
        pset(x,y+100),rgb(d,d,d)
    next x
next y
sleep

'grey the pixels to compare with color version

for y as integer = 0 to 80
    for x as integer = 0 to 639
        v = point(x,y)
        r = v shr 16 and 255
        g = v shr  8 and 255
        b = v and 255
        d = (0.3f * r) + (0.59f * g) + (0.11f * b)
        pset(x,y),rgb(d,d,d)
    next x
next y

sleep
end

    
'sample rgb values
data 18,170,6
data 121,86,105
data 247,24,156
data 90,16,106
data 128,111,3
data 237,39,111

sleep
end

[BasicCoder2]

Hi,

Can anyone show me how manipulate pixels in images
created with CreateImage() ?

In particular DJPeters' code in the thread where I tried
this method found with a google search which is much
too slow.

Thank you,

John

Code: Select all

While inkey<>chr$(27)
  doCapture(0)
  While isCaptureDone(0)<>1:Sleep(10):Wend
'  Put (0,0),lpImage,Pset
'display image
dim as integer v
for y as integer = 1 to 478
    for x as integer = 1 to 639
        v = point (x,y,lpImage)
        ' do stuff here to pixel
        pset(x,y),v
    next x
next y

Wend

[D.J.Peters]

Hi,

Can anyone show me how manipulate pixels in images
created with CreateImage() ?

first Point() and Pset() are slow in general
if you need it use ScreenLock and ScreenUnlock

Code: Select all

dim as uinteger Pixel
while inkey<>chr$(27)
  doCapture(0)
  While isCaptureDone(0)<>1:Sleep(10):Wend
  ScreenLock
  for y as integer=0 to Params.mWidth-1
    for x as integer=0 to Params.mHeight-1
      Pixel=Point(x,y,lpImage)
      ' do what you need
      Pset(x,y),Pixel
    next
  next
  ScreenUnlock
wend

or use the Image Buffer as array
(fastes way without assembler)

Code: Select all

dim as uinteger Pixel
dim as uinteger ptr lpScreen
while inkey<>chr$(27)
  doCapture(0)
  While isCaptureDone(0)<>1:Sleep(10):Wend
  ScreenLock
  lpScreen=ScreenPtr()
  for i as integer=0 to Params.mWidth*Params.mHeight-1
    Pixel=Params.mTargetBuf[i]
      ' do what you need
    lpScreen[i]=Pixel
  next
  ScreenUnlock
wend
end

[BasicCoder2]

Thank you Joshy, I am now manipulating those pixels.

[D.J.Peters]

hello John
while you manipulating pixels from one frame
you can capture a second (double) buffer parallel

you know?

Joshy

[BasicCoder2]

Joshy wrote:

> while you manipulating pixels from one frame
> you can capture a second (double) buffer parallel
> you know?

Would there be any speed advantage in that?

By the way does this line skip header info?

.mTargetBuf+=8

As you may have noticed I am not very up to
speed with the advanced programming techniques
that you use. With my old DOS C code I used
to store the images as 2D arrays which I have
done below. With color images I used to store
them as three parallel arrays.

I am also playing with the escapi dll with
DevCpp and the SDL library.

John

Code: Select all

#include "escapi.bi"
Const SCR_W = 640
Const SCR_H = 480

Dim As Integer nDevices=setupESCAPI()
If nDevices<1 Then
  Print "No active capture device found!"
  Beep:Sleep:End
end If

'ScreenRes SCR_W,SCR_H,32
ScreenRes 800,480,32

Dim As Any Ptr lpImage=ImageCreate(SCR_W,SCR_H)
Dim shared as UInteger image1(SCR_W,SCR_H)
Dim shared as UInteger image2(SCR_W,SCR_H)

Dim As SimpleCapParams Params
With Params
  .mWidth  = SCR_W
  .mHeight = SCR_H
  .mTargetBuf=cptr(Integer Ptr,lpImage)
  .mTargetBuf+=8
End With

WindowTitle "initCapture=" & Str(initCapture(0, @Params))

Dim As Uinteger Pixel
Dim As Uinteger Ptr lpScreen

Dim As integer r,g,b,r1,g1,b1,r2,g2,b2,v,d1,d2

'MAIN PROGRAM
While inkey<>chr$(27)

  'capture an image
  doCapture(0)
  While isCaptureDone(0)<>1:Sleep(10):Wend
      
  'copy to image1()
  dim as integer i=0
  for y as integer = 0 to SCR_H-1
      for x as integer = 0 to SCR_W-1
           image1(x,y) = Params.mTargetBuf[i]
          i = i + 1
      next x
  next y
  
  'image2 = Edge(image1)
  for x as integer = 1 to SCR_W-2
     for y as integer = 1 to SCR_H-2
        'get vertical show as red shade
        v = image1(x,y)
        r1 = v shr 16 and 255
        g1 = v shr  8 and 255
        b1 = v and 255
        v = image1(x,y+1)
        r2 = v shr 16 and 255
        g2 = v shr  8 and 255
        b2 = v and 255
        r = abs(r1-r2)
        g = abs(g1-g2)
        b = abs(b1-b2)
        d1 = sqr(r*r+g*g+b*b)
        'get horizontal show as green shade
        v = image1(x+1,y)
        r2 = v shr 16 and 255
        g2 = v shr  8 and 255
        b2 = v and 255
        r = abs(r1-r2)
        g = abs(g1-g2)
        b = abs(b1-b2)
        d2 = sqr(r*r+g*g+b*b)
        image2(x,y)=0
        if d1>d2 then
            image2(x,y) = (d1 shl 16) 'shade of red
        else
            image2(x,y) = (d2 shl 8)  'shade of green
        end if
        
     next y
  next x

  i=0
  'copy to capture and display buffer
  for y as integer = 0 to SCR_H-1
      for x as integer = 0 to SCR_W-1
          Params.mTargetBuf[i] = image2(x,y)
          i = i + 1
      next x
  next y
  
  Put (0,0), lpImage,Pset

Wend

End

[D.J.Peters]

hello John

you don't need all the RGB triples math and the slow SQR()

Joshy

Code: Select all

#include "escapi.bi"
Const SCR_W = 640
Const SCR_H = 480


sub RGB2BW(des as uinteger ptr,src as uinteger ptr,nPixels as integer)
  dim as integer value
  for i as integer=0 to nPixels-1
    Value =(src[i] and &H0000FF)
    Value+=(src[i] and &H00FF00) shr  8
    Value+=(src[i] and &HFF0000) shr 16
    Value\=3
    des[i]=Value
  next
end sub

Dim As Integer nDevices=setupESCAPI()
If nDevices<1 Then
  Print "No active capture device found!"
  Beep:Sleep:End
end If

ScreenRes SCR_W,SCR_H,32
'ScreenRes 800,480,32

Dim As uinteger Ptr lpImage=ImageCreate(SCR_W,SCR_H)

Dim As SimpleCapParams Params
With Params
  .mWidth  = SCR_W
  .mHeight = SCR_H
  .mTargetBuf=cptr(Integer Ptr,lpImage)
  .mTargetBuf+=8
End With

WindowTitle "initCapture=" & Str(initCapture(0, @Params))

Dim As Uinteger Pixel
Dim As Uinteger Ptr lpScreen

Dim As Integer i,v,vy,vx,dx,dy


'MAIN PROGRAM
While inkey<>chr$(27)

  'capture an image
  doCapture(0)
  While isCaptureDone(0)<>1:Sleep(10):Wend
      
  'convert RGB Frame to BW Frame
  RGB2BW(Params.mTargetBuf,Params.mTargetBuf,SCR_W*SCR_H)
  dim as integer x,y
  for i=0 to SCR_W*SCR_H-(SCR_W+1)
    v  = Params.mTargetBuf[i]
    vy = Params.mTargetBuf[i+SCR_W]
    vx = Params.mTargetBuf[i+1]
    dy=abs(vy-v):dy shl=1
    dx=abs(vx-v):dx shl=1
    If dy>dx Then
      Params.mTargetBuf[i] = (dy Shl 8) 'shade of red
    Else
      Params.mTargetBuf[i]=(dx Shl 16)  'shade of green
    End If
  next
  Put (0,0), lpImage,Pset
Wend

End

[BasicCoder2]

Joshy wrote:
> you don't need all the RGB triples math and
> the slow SQR()


As I mentioned and illustrated in a previous
post in this thread the difference between
color pixel values can be greater then the
distance between their gray equivalent values
thus making a brighter clearer edge.


If you have one color that lies within another
color with the same gray value it will vanish
completely when you convert the color image to
a monochrome image.

Also the conversion apparently is not a simple
adding of the rgb values and dividing by 3,
rather in the vision code examples they use,

gray = 0.299f * red + 0.587f * green + 0.114f * blue

maybe it has something to do with the human eye's
variable sensitivity to different wavelengths of
light.

Also you need more than one buffer for anything
but a point process such as inverting the pixel
values or some kind of simple thesholding. In
the examples given the result is shifted to the
top/left corner of a group of four pixels which
works ok in this case but isn't a general way
of doing it.

The reason I made the screen larger than the
image was to print analysis data.

However your coding suggestions are always
appreciated as I learn a lot from them.