Easy Webcam - uses dll

[D.J.Peters]

hello John
i won't teach you in image processing
but you can take a look to this very usefullpage

Scroll down to finding edges

happy coding

Joshy

by the way here are the FreeBASIC version ported by "cha0s"

Code: Select all

#include "fbgfx.bi"

#define min(x,y) (iif(x<y,x,y))
#define max(x,y) (iif(x>y,x,y))

Sub apply_filter( Byval res As fb.IMAGE Ptr, Byval img As fb.IMAGE Ptr, mat() As Double, Byval factor As Double = 1.0, Byval bias As Double = 0.0 )
        Dim As Double fw = Ubound(mat, 1)+1, fh = Ubound(mat, 2)+1, fw2 = fw/2, fh2 = fh/2
        Dim As Integer w = img->width, h = img->height
        Dim As Integer Ptr pix
        
        For y As Integer = 0 To h-1
                For x As Integer = 0 To w-1
                        Dim As Double r, g, b
                        Dim As Integer ix=Any, iy=Any
                        For fy As Integer = 0 To fh-1
                                For fx As Integer = 0 To fw-1
                                        ix = (x - fw2 + fx + w) Mod w
                                        iy = (y - fh2 + fy + h) Mod h
                                        pix = @cast(Integer Ptr, img+1)[iy * (img->pitch\4) + ix]
                                        r += cast(Ubyte Ptr, pix)[2] * mat(fx, fy)
                                        g += cast(Ubyte Ptr, pix)[1] * mat(fx, fy)
                                        b += cast(Ubyte Ptr, pix)[0] * mat(fx, fy)
                                Next
                        Next
                        pix = @cast(Integer Ptr, res+1)[y * (img->pitch\4) + x]
                        cast(Ubyte Ptr, pix)[0] = min(max(Int(factor * b + bias), 0#), 255#)
                        cast(Ubyte Ptr, pix)[1] = min(max(Int(factor * g + bias), 0#), 255#)
                        cast(Ubyte Ptr, pix)[2] = min(max(Int(factor * r + bias), 0#), 255#)
                Next
        Next
End Sub


#define imageWidth 320 
#define imageHeight 240

screenres 320, 240, 32


Dim As fb.IMAGE Ptr image  = imagecreate( imageWidth, imageHeight ), result = imagecreate( imageWidth, imageHeight )

Bload "photo3.bmp", image

Put(0,0), image
Sleep
Cls

Dim As Double small_blur(3-1,3-1) = _
{ _
     {0, 1, 0}, _
     {1, 1, 1}, _
     {0, 1, 0} _
} 
apply_filter( result, image, small_blur(), 1/5 )

Put(0,0), result, trans
Sleep    
Cls

Dim As Double big_blur(5-1,5-1) = _
{ _
     {0, 0, 1, 0, 0}, _
     {0, 1, 1, 1, 0}, _
     {1, 1, 1, 1, 1}, _
     {0, 1, 1, 1, 0}, _
     {0, 0, 1, 0, 0} _
} 
apply_filter( result, image, big_blur(), 1/13 )

Put(0,0), result, trans
Sleep    
Cls

Dim As Double motion_blur(9-1,9-1) = _
{ _
     {1, 0, 0, 0, 0, 0, 0, 0, 0}, _
     {0, 1, 0, 0, 0, 0, 0, 0, 0}, _
     {0, 0, 1, 0, 0, 0, 0, 0, 0}, _
     {0, 0, 0, 1, 0, 0, 0, 0, 0}, _
     {0, 0, 0, 0, 1, 0, 0, 0, 0}, _
     {0, 0, 0, 0, 0, 1, 0, 0, 0}, _
     {0, 0, 0, 0, 0, 0, 1, 0, 0}, _
     {0, 0, 0, 0, 0, 0, 0, 1, 0}, _
     {0, 0, 0, 0, 0, 0, 0, 0, 1} _
} 
apply_filter( result, image, motion_blur(), 1/9 )

Put(0,0), result, trans
Sleep    
Cls


Dim As Double find_edges_h(5-1,5-1) = _
{ _
     {0, 0, 0, 0, 0}, _
     {0, 0, 0, 0, 0}, _
     {-1, -1, 2, 0, 0}, _
     {0, 0, 0, 0, 0}, _
     {0, 0, 0, 0, 0} _
} 
apply_filter( result, image, find_edges_h() )

Put(0,0), result, trans
Sleep    
Cls


Dim As Double find_edges_v(5-1,5-1) = _
{ _
     {0, 0, -1, 0, 0}, _
     {0, 0, -1, 0, 0}, _
     {0, 0, 4, 0, 0}, _
     {0, 0, -1, 0, 0}, _
     {0, 0, -1, 0, 0} _
} 
apply_filter( result, image, find_edges_v() )

Put(0,0), result, trans
Sleep    
Cls


Dim As Double find_edges_angle(5-1,5-1) = _
{ _
     {-1, 0, 0, 0, 0}, _
     {0, -2, 0, 0, 0}, _
     {0, 0, 6, 0, 0}, _
     {0, 0, 0, -2, 0}, _
     {0, 0, 0, 0, -1} _
} 
apply_filter( result, image, find_edges_angle() )

Put(0,0), result, trans
Sleep    
Cls


Dim As Double find_edges_all(3-1,3-1) = _
{ _
     {-1, -1, -1}, _
     {-1, 8, -1}, _
     {-1, -1, -1} _
} 
apply_filter( result, image, find_edges_all() )

Put(0,0), result, trans
Sleep    
Cls


Dim As Double sharpen(3-1,3-1) = _
{ _
     {-1, -1, -1}, _
     {-1, 9, -1}, _
     {-1, -1, -1} _
} 
apply_filter( result, image, sharpen() )

Put(0,0), result, trans
Sleep    
Cls


Dim As Double sharpen_subtle(5-1,5-1) = _
{ _
     {-1, -1, -1, -1, -1}, _
     {-1, 2, 2, 2, -1}, _
     {-1, 2, 8, 2, -1}, _
     {-1, 2, 2, 2, -1}, _
     {-1, -1, -1, -1, -1} _
} 
apply_filter( result, image, sharpen_subtle(), 1/8 )

Put(0,0), result, trans
Sleep    
Cls


Dim As Double find_edges_extReme(3-1,3-1) = _
{ _
     {1, 1, 1}, _
     {1, -7, 1}, _
     {1, 1, 1} _
} 
apply_filter( result, image, find_edges_extReme() )

Put(0,0), result, trans
Sleep    
Cls


Dim As Double emboss(3-1,3-1) = _
{ _
     {-1, -1, 0}, _
     {-1, 0, 1}, _
     {0, 1, 1} _
} 
apply_filter( result, image, emboss(), 1, 128 )

Put(0,0), result, trans
Sleep    
Cls

[adx]

Hi people - just "revitalising" this thread. Well not really, I found the ESCAPI lib a few months ago and it instantly ended a lot of frustration. Should have known to try FB first.

One thing though - I never got it working in 640*480. I can get it scaled to that size, but the data always appears to be 320*240 scaled up. I've tried various cameras. Can anyone confirm they have been able to get actual 640*480 out?. That would rule out me doing something sillly. Its under Windows 2000. ESCAPI21. Other capture programs get the full res no problem.

320*240 is fine really, but it would be nice to have access to all the pixels on a 640*480 camera. In fact that reminds me of something I saw recently that webcams can be modified to output RAW RGB Bayer data from the sensor (which looks like a patterned 640*480 monochrome image), and to decode that I'd presumably need all the pixels.

Thanks!

[BasicCoder2]

Hi people - just "revitalising" this thread. Well not really, I found the ESCAPI lib a few months ago and it instantly ended a lot of frustration. Should have known to try FB first.

One thing though - I never got it working in 640*480. I can get it scaled to that size, but the data always appears to be 320*240 scaled up. I've tried various cameras. Can anyone confirm they have been able to get actual 640*480 out?. That would rule out me doing something sillly. Its under Windows 2000. ESCAPI21. Other capture programs get the full res no problem.

320*240 is fine really, but it would be nice to have access to all the pixels on a 640*480 camera. In fact that reminds me of something I saw recently that webcams can be modified to output RAW RGB Bayer data from the sensor (which looks like a patterned 640*480 monochrome image), and to decode that I'd presumably need all the pixels.

Thanks!

I get 640 x 480. My only problem was the plug in
webcams produced blurred movements even when using
the software that came with them for reasons I
haven't figured out. However the built in webcam
of my Toshiba laptop works great.

The C version also works and in C I use the SDL
library to display images.

I don't know what version of escapi I am using it is just called escapi.dll

John

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

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


'MAIN PROGRAM
dim as integer v,mx,my,btns
dim as integer r1,g1,b1
dim as double mult,r,g,b
While inkey<>chr$(27)
  'capture an image
  doCapture(0)
  While isCaptureDone(0)<>1:Sleep(10):Wend
  Put (0,0), lpImage,Pset
Wend

End

[adx]

Thanks - that has helped me narrow it down to one particular camera after all. It turns out the Philips SPC900NC that I used only returns images at 320*240 to ESCAPI when set to 640*480. The camera works at the full resolution in everything else.

What led to the confusion was that another much newer (and cheaper) camera looks like it is doing only 640*240. But it's the same in all applications, also it has one of those "frame effect" features which can be turned on revealing definite 640*480 output from its driver.

Well, that has answered a tough question. Also thanks for your sample code - nice and clear.

[BasicCoder2]

Also thanks for your sample code - nice and clear.

You can thank D.J.Peters for the code it isn't mine.

[opicard]

Vendan, Basicoder2,

A very interresting post !


My goal is to load a string (921600 logn ) or an array(640,480) containing pixel values of a videocapture, and pass it to an other program for some analysis of it.


I tryed several solutions with your samples, but didn't find the way so get that array available... (sory i'm beginner in FB)

May I ask some questions:

- Why an "input r" not possible inside the loop?
- Why my "imagecam" string is not availlable?
- So, where or when could I save such datas in your code

my different trying are inside ' ' in the following code

Thanks in advance

#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 imagecam As string

Dim camname As Zstring*100
Dim As Integer x, y, z, p
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
Dim r As String


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$=""


p = 0
For y=0 To SCRHEIGHT - 1
For x=0 To SCRWIDTH - 1

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

'p=p+1:Mid$(imagecam,p,1)=chr$(quadcolor.r)
'p=p+1:Mid$(imagecam,p,1)=chr$(quadcolor.g)
'p=p+1:Mid$(imagecam,p,1)=chr$(quadcolor.b)

'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)

'open "edgedetec.txt" For Output As #1 Len = 921600
'print #1, imagecam;
'Close #1
'end

'Print imagecam
'Input r



doCapture(0)

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

wend






ptc_close()
deInitCapture(0)

[opicard]

Well I made a mistake, sorry

Mr. Moderator, my post should be in beginers forum

[BasicCoder2]

I can only show how I do it as I am not familiar with tinyptc.

I think the INPUT command would conflict with INKEY$

Code: Select all

#include "escapi.bi"
Const iWIDTH = 640
Const iHEIGHT = 480
'Const iWIDTH = 320
'Const iHEIGHT = 240
Dim As Integer nDevices=setupESCAPI()
If nDevices<1 Then
  Print "No active capture device found!"
  Beep:Sleep:End
end If


ScreenRes 800,480,32

Dim As Any Ptr lpImage=ImageCreate(iWIDTH,iHEIGHT)

'global variables
Dim Shared As Uinteger image1(iWIDTH,iHEIGHT)
Dim Shared As Uinteger image2(iWIDTH,iHEIGHT)

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

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

Dim As Uinteger Pixel
Dim As Uinteger Ptr lpScreen

Sub getImage(image1() As Uinteger)
    Dim As Integer i
    doCapture(0)
    While isCaptureDone(0)<>1:Sleep(10):Wend
    i=0
    For y As Integer = 0 To iHEIGHT-1
        For x As Integer = 0 To iWIDTH-1
            image1(x,y) = Params.mTargetBuf[i]
            i = i + 1
        Next x
    Next y
End Sub

Sub displayImage(image1() As Uinteger,lpImage as any ptr)
    Dim As Integer i

    i=0
    'copy to capture and display pseudo color buffer
    For y As Integer = 0 To iHEIGHT-1
        For x As Integer = 0 To iWIDTH-1
            Params.mTargetBuf[i] = image1(x,y)
            i = i + 1
        Next x
    Next y
    Put (0,0), lpImage,Pset
End Sub

Sub invertImage(image1() as uinteger)
    dim as integer v,r,g,b
    for y as integer = 0 to iHEIGHT-1
        for x as integer = 0 to iWIDTH-1
            v = image1(x,y)  'get pixel
            r = v shr 16 and 255  'get red value
            g = v shr  8 and 255  'get green value
            b = v and 255         'get blue value
            'invert colors
            r = 255 - r
            g = 255 - g
            b = 255 - b
            v = r shl 16 + g shl 8 + b
            image1(x,y)=v
        next x
    next y
end sub

'MAIN PROGRAM
dim as integer invertFlag
DO
   'capture an image
   getImage(image1())
   'invert image if space bar is being pressed
   if multikey(&H39) then
      invertImage(image1())
   end if

   displayImage(image1(),lpImage)

LOOP WHILE NOT MULTIKEY(&h1)

imageDestroy(lpImage)


End

[opicard]

BasicCoder2 You'r the best, It' exactly what I was looking for, for a long time.
Now I can work!

(Hope so)

Many thanks

[opicard]

Well BasicCoder2,

Please,

I built à program which analysises the picture and I need to underline some edges with different colored lines.

Could you provide me a sample where you draw for instance a line (from x1, y1 to x2, y2, with à choiced color) in your subdisplayImage(image1())

I don't know if I must use Draw, or Pset...

[BasicCoder2]

Well BasicCoder2,

Please,

I built à program which analysises the picture and I need to underline some edges with different colored lines.

Could you provide me a sample where you draw for instance a line (from x1, y1 to x2, y2, with à choiced color) in your subdisplayImage(image1())

I don't know if I must use Draw, or Pset...

First I don't know what you mean by "underline some
edges"? What edges?


I actually use unsigned integer arrays to hold and
manipulate images. The images however are captured
to an allocated memory which are copied to an array
after capture and array data can be copied back to
the allocated memory to be displayed using PUT.

The graphic commands can be used on these allocated
blocks of memory as you can see in the example where
I draw a filled circle on the image before displaying
it in the code example below.

If you wanted you could do all your processing using
the graphic commands, pset, point, line and so on
using the allocated memory as your target and then
using PUT to display the results.

The image buffer was created with,

Dim As Any Ptr lpImage=ImageCreate(iWIDTH,iHEIGHT)

where lpImage is a pointer to the buffer.

The FreeBasic graphic commands use the screen by
default but you can direct it to an image buffer
by using the pointer name as the target.

PSET lpImage,(x,y),rgb(255,0,0) 'set a red dot at x,y

And after doing your graphic stuff you can display it,

PUT (0,0),lpImage,pset

I suggest you read up on this in the FreeBasic docs.

Code: Select all

Sub displayImage(image1() As Uinteger,lpImage as any ptr)
    Dim As Integer i

    i=0
    'copy captured image data from buffer to unsigned integer array
    For y As Integer = 0 To iHEIGHT-1
        For x As Integer = 0 To iWIDTH-1
            Params.mTargetBuf[i] = image1(x,y)
            i = i + 1
        Next x
    Next y
    
    'draw red circle into image buffer
    CIRCLE lpImage, ( 32, 32 ), 28, RGBA( 255, 0, 0, 128 ),,,,F
    'display contents in image buffer pointed to by lpImage
    Put (0,0), lpImage,Pset

End Sub

[opicard]

Welcom Japan with your red circle!

And thanks for the lecture, it helps me improving my FB

Underline i.e. draw lines along some straight edges, and compute some axis. Reason why your samples make sense for me.

I hope not have to appeal to you further. But FreeBASIC docs arn't always clear for me especially about ptr(s) and samples like yours are much better!

Anyway thanks a lot

[BasicCoder2]

> Welcome Japan with your red circle!

It was taken from the HELP in FIDE.

> Underline i.e. draw lines along some straight edges,
> and compute some axis. Reason why your samples make
> sense for me.

Still don't understand what straight edges you are
referring to.

> I hope not have to appeal to you further.

I was curious as to what your projects were as most FB
users seem to be mostly interested in writing computer
games.

> But FreeBASIC docs aren't always clear for me especially
> about ptr(s) and samples like yours are much better!

I used pointers as standard in assembler but often get
confused as to the way they are represented in HLLs.

> Anyway thanks a lot

Anytime.

John

[opicard]

John,

My project is the oposite of computer games: detect, (and not create) an object in a picture. we call it "reconnaissance d'image" in French. I'm trainning with lines , and numbers or letters for the moment...

Isn't what you'vo done ?

[BasicCoder2]

John,

My project is the opposite of computer games: detect, (and not create) an object in a picture. we call it "reconnaissance d'image" in French. I'm training with lines , and numbers or letters for the moment...

Isn't what you've done ?

Not so much what I have done, rather one of the things
I would like to do. However I had better leave it there
as I am making it a discussion rather than a beginner
question/answer format.

John