At the Las Vegas Devcon last month I used a digital camera to take a picture, then I plugged the camera media into my Tablet PC which was running the Visual Foxpro code below.

 

The pictures on the media were automatically detected by the event handler and they were read into a table and displayed in a grid.

 

This feature was made possible by the new capabilities of the BINDEVENTS function (which was added to VFP9 after the public beta), so you won’t be able to run the code below until you get a later version).

 

The code below uses the SHChangeNotifyRegister WinAPI function to register an event handler with the Windows Shell.

 

As long as the public variable oDriveDetect contains the object for this class, the handler will exist to react to drive changes.

 

As you can see from the code, there are other shell events to which user code can respond like file/folder renaming.

 

There is more sample code in the Task Pane: Start the Task Pane, navigate to Solution Samples, New in Visual Foxpro 9, “Binding to Windows Message Events”

 

(blog about the Las Vegas Screen Saver demo: http://blogs.msdn.com/calvin_hsia/archive/2004/10/04/237723.aspx)

 

 

#define GWL_WNDPROC         (-4)

#define WM_USER                         0x0400

#define WM_USER_SHNOTIFY            WM_USER+10

#define SHCNE_RENAMEITEM          0x00000001

#define SHCNE_CREATE              0x00000002

#define SHCNE_DELETE              0x00000004

#define SHCNE_MKDIR               0x00000008

#define SHCNE_RMDIR               0x00000010

#define SHCNE_MEDIAINSERTED       0x00000020

#define SHCNE_MEDIAREMOVED        0x00000040

#define SHCNE_DRIVEREMOVED        0x00000080

#define SHCNE_DRIVEADD            0x00000100

#define SHCNE_NETSHARE            0x00000200

#define SHCNE_NETUNSHARE          0x00000400

#define SHCNE_ATTRIBUTES          0x00000800

#define SHCNE_UPDATEDIR           0x00001000

#define SHCNE_UPDATEITEM          0x00002000

#define SHCNE_SERVERDISCONNECT    0x00004000

#define SHCNE_UPDATEIMAGE         0x00008000

#define SHCNE_DRIVEADDGUI         0x00010000

#define SHCNE_RENAMEFOLDER        0x00020000

#define SHCNE_FREESPACE           0x00040000

 

#define SHCNE_DISKEVENTS          0x0002381F

#define SHCNE_GLOBALEVENTS        0x0C0581E0 // Events that dont match pidls first

#define SHCNE_ALLEVENTS           0x7FFFFFFF

#define SHCNE_INTERRUPT           0x80000000 // The presence of this flag indicates

 

#define CSIDL_DESKTOP                   0x0000        &&// <desktop>

#define CSIDL_INTERNET                  0x0001        &&// Internet Explorer (icon on desktop)

#define CSIDL_PROGRAMS                  0x0002        &&// Start Menu\Programs

#define CSIDL_CONTROLS                  0x0003        &&// My Computer\Control Panel

#define CSIDL_PRINTERS                  0x0004        &&// My Computer\Printers

#define CSIDL_PERSONAL                  0x0005        &&// My Documents

#define CSIDL_FAVORITES                 0x0006        &&// <user name>\Favorites

#define CSIDL_STARTUP                   0x0007        &&// Start Menu\Programs\Startup

#define CSIDL_RECENT                    0x0008        &&// <user name>\Recent

#define CSIDL_SENDTO                    0x0009        &&// <user name>\SendTo

#define CSIDL_BITBUCKET                 0x000a        &&// <desktop>\Recycle Bin

#define CSIDL_STARTMENU                 0x000b        &&// <user name>\Start Menu

#define CSIDL_MYDOCUMENTS               0x000c        &&// logical "My Documents" desktop icon

#define CSIDL_MYMUSIC                   0x000d        &&// "My Music" folder

#define CSIDL_MYVIDEO                   0x000e        &&// "My Videos" folder

 

PUBLIC oDriveDetect as DriveDetect

oDriveDetect=NEWOBJECT("DriveDetect")

 

DEFINE CLASS DriveDetect AS session

      dwOrigWindProc=0

      dwShNotify=0

      PROCEDURE init

            DECLARE integer GetWindowLong IN WIN32API ;

                  integer hWnd, ;

                  integer nIndex

            DECLARE integer CallWindowProc IN WIN32API ;

                  integer lpPrevWndFunc, ;

                  integer hWnd,integer Msg,;

                  integer wParam,;

                  integer lParam

            THIS.dwOrigWindProc =GetWindowLong(_VFP.HWnd,GWL_WNDPROC)

            DECLARE integer SHChangeNotifyRegister IN shell32 ;

                  integer hWnd, ;

                  integer fSources, ;

                  integer fEvents, ;

                  integer wMsg,;

                  integer cEntries, ;

                  string @ SEntry

            DECLARE integer SHChangeNotifyDeregister IN shell32 integer

            DECLARE integer SHGetSpecialFolderLocation  IN shell32 ;

                  integer hWnd,;

                  integer nFolder,;

                  string @ pItemList

            DECLARE integer SHGetPathFromIDList IN shell32 ;

                  integer nItemList,;

                  string @cPath

            cSEntry = REPLICATE(CHR(0),8)

            this.dwShNotify = SHChangeNotifyRegister(_vfp.hWnd, ;

                  2,;

                  SHCNE_ALLEVENTS,;

                  WM_USER_SHNOTIFY,1,;

                  @cSEntry)

*!*               this.dwShNotify = SHChangeNotifyRegister(_vfp.hWnd, ;

*!*                     2,;

*!*                     SHCNE_MEDIAINSERTED + SHCNE_MEDIAREMOVED + SHCNE_DRIVEADD + SHCNE_DRIVEREMOVED,;

*!*                     WM_USER_SHNOTIFY,1,;

*!*                     @cSEntry)

            BINDEVENT(_VFP.hWnd, WM_USER_SHNOTIFY,this,"HandleMsg")

            WAIT WINDOW "Monitoring drive changes" nowait

      PROCEDURE HandleMsg(hWnd as Integer, msg as Integer, wParam as Integer, lParam as Integer)

            LOCAL nRetvalue

            nRetvalue=0

            ?PROGRAM(),hwnd,"Media",TRANSFORM(wParam,"@0x"),TRANSFORM(lParam,"@0x")," "

            pidl1=CTOBIN(SYS(2600,wParam,4),"4rs")

            pidl2=CTOBIN(SYS(2600,wParam+4,4),"4rs")

            cPath=SPACE(270)

            SHGetPathFromIDList(pidl1,@cPath)

            cPath=LEFT(cPath,AT(CHR(0),cPath)-1)

            DO case

            CASE lParam=SHCNE_DRIVEADD

                  ??"Drive added "

                  ShowPix(cPath)

            CASE lParam=SHCNE_DRIVEREMOVED

                  ??"Drive removed"

            CASE lParam=SHCNE_MEDIAINSERTED

                  ??"Media inserted "

                  ShowPix(cPath)

            CASE lParam=SHCNE_MEDIAREMOVED

                  ??"Media removed "

            ENDCASE

            ??" path=",cPath,TRANSFORM(pidl2,"@0x")

            nRetvalue=CallWindowProc(this.dwOrigWindProc,hWnd,msg,wParam,lParam)

            RETURN nRetvalue

      PROCEDURE destroy

            IF this.dwShNotify != 0

                  IF SHChangeNotifyDeregister(this.dwShNotify) = 0

                        ?"Deregister ERRORd"

                  ENDIF

            ENDIF

ENDDEFINE

 

 

 

* in a file called SHOWPIX.PRG

LPARAMETERS cPath as String

PUBLIC oShowPix

oShowPix=0

IF PCOUNT()=0

      CLEAR

      cPath=SYS(5)+CURDIR()

ENDIF

oShowPix=CREATEOBJECT("ShowPix",cPath)

oShowPix.show

 

DEFINE CLASS ShowPix as Form

      left=100

      height=600

      width=900

      DataSession=2

      allowoutput=.f.

      PROCEDURE LoadPix(cPath as String,lRecursive as Boolean)

            LOCAL aFiles[1],n,i,fname

            n=ADIR(aFiles,cPath+"*.*","D")

            FOR i = 1 TO n

                  IF "D"$aFiles[i,5]

                        IF aFiles[i,1] != '.'

                              thisform.Loadpix(cPath+aFiles[i,1]+"\")

                        ENDIF

                  ELSE

                        fName=cPath+aFiles[i,1]

                        IF JUSTEXT(fName)$"JPG"

                              WAIT WINDOW NOWAIT fname

                              INSERT INTO pix VALUES (fname,FILETOSTR(fname),PicProps(fname))

                        ENDIF

                  ENDIF

            ENDFOR

            locate

      PROCEDURE init(cPath,lRecursive)

            CREATE CURSOR pix (name c(30),pic w, props m)

            IF VARTYPE(cPath)='L'

                  cPath=SYS(5)+CURDIR()

            ENDIF

            cPath=ADDBS(cPath)      && add a backslash if needed

            thisform.LoadPix(cPath,lRecursive)

            WAIT CLEAR

            this.AddObject("grd","grid")

            WITH this.grd as grid

                  .Visible=1

                  .ColumnCount=4

                  .Height=thisform.Height

                  .Width=thisform.Width

                  .RowHeight=200

                  .HeaderHeight=50

                  WITH this.grd.column1 as Column

                        .header1.caption="Filename"

                        .header1.fontsize=14

                        .Width=100

                        .AddObject("edtFname","editbox")

                        .CurrentControl="edtFname"

                        .Sparse=.f.

                        .edtFname.visible=1

                  ENDWITH

                  WITH this.grd.column2 as Column

                        .header1.caption="Picture"

                        .header1.fontsize=14

                        .Width=300

                        .AddObject("imgPic","MyImage")

                        .CurrentControl="imgPic"

                        .RemoveObject("text1")

                        .imgPic.pictureval="pix.pic"

                        .Sparse= .F.

                  ENDWITH

                  WITH this.grd.column3 as Column

                        .header1.caption="Pic Properties"

                        .header1.fontsize=14

                        .AddObject("edtProps","editbox")

                        .CurrentControl="EdtProps"

                        .RemoveObject("text1")

                        .Sparse= .F.

                        .Width=300

                        WITH .EdtProps as EditBox

                              .Visible=.t.

                        ENDWITH

                  ENDWITH

                  WITH this.grd.column4 as Column

                        .header1.caption="Button"

                        .header1.fontsize=14

                        .AddObject("btn","mybtn")

                        .CurrentControl="btn"

                        .Sparse= .F.

                        .Width=100

                        WITH .btn as commandbutton

                              .Visible=.t.

                        ENDWITH

                  ENDWITH

            ENDWITH

ENDDEFINE

DEFINE CLASS mybtn as commandbutton

      Caption="Click me!"

      PROCEDURE click

            oShowPic=CREATEOBJECT("form")

            WITH oShowpic as form

                  .Width=SYSMETRIC(1)

                  .Height=SYSMETRIC(2)

                  .Left=0

                  .Top=0

                  .AddObject("img","myimage")

                  WITH .img as image

                        .Stretch=2

                        .Width=thisform.width

                        .Height= thisform.height

                        .PictureVal =pix.pic

                        .Visible=1

                  ENDWITH

            ENDWITH

            oShowPic.show(1)

ENDDEFINE

DEFINE CLASS myimage as Image

      backstyle=0

      stretch=1

      PROCEDURE backstyle_access

            this.PictureVal=pix.pic

            RETURN this.backstyle

      PROCEDURE click

            this.RotateFlip=this.RotateFlip+1

      PROCEDURE dblclick

            ?PROGRAM()

ENDDEFINE

 

 

43302