2009-07-25 17:30

' ##########################################################################
' Components
' ##########################################################################
     WITH frmKamerka
      .CAPTION = "KAMERKA"
      .borderstyle = 1
      .windowstate = 2
      .font = fntScreen
      .onshow = frmKamerka_OnShow
      .onclose = frmKamerka_OnClose
      .onResize = frmKamerka_onResize
      SetWindowLong .HANDLE, -8, 0
      SetWindowLong application.HANDLE, -8, .HANDLE
     END WITH

     WITH pnlScreen
      .PARENT = frmKamerka
      .align = 5
      .bevelouter = 1
      .hint = CURDIR$
     END WITH

' ##########################################################################
' SUBs
' ##########################################################################
     SUB frmKamerka_OnShow
      IF FILEEXISTS (pnlScreen.hint + "\kamerka.ini") THEN
       frmSet_OnShow
      ELSE
       btnSetOK.CAPTION = "START"
       IF frmSet.SHOWMODAL <> 1 THEN Application.Terminate
       btnSetOK.CAPTION = "OK"
      END IF


      DEFINT iDevice = 0			' 0 to 9
      DEFINT iFramesSpacedMS = 1	' Duration between two frames in Milliseconds
      DIM wSize AS INTEGER, s AS LONG
      wSize = 0
      s = 0
      DIM tempKamera AS BYTE, lpProc AS INTEGER

      hCamWnd = capCreateCaptureWindow("CapWindow", WS_CHILD OR WS_VISIBLE, 0, 0, _
       pnlScreen.ClientWidth, pnlScreen.ClientHeight, pnlScreen.Handle, 0)
      IF hCamWnd <> 0 THEN
       tempKamera = SendMessageX (hCamWnd, WM_CAP_DRIVER_CONNECT, iDevice, 0)
       IF tempKamera <> 0 THEN
	    		' settings full screen video
        SendMessageX (hCamWnd, WM_CAP_SET_SCALE, 1, 0)
				' settings preview rate (v ms)
        SendMessageX (hCamWnd, WM_CAP_SET_PREVIEWRATE, iFramesSpacedMS, 0)
				' run video
        SendMessageX (hCamWnd, WM_CAP_SET_PREVIEW, 1, 0)
				' get size video
        GetVideoSize
       ELSE
        SELECT CASE cbxLang.Item(cbxLang.ItemIndex)
        CASE "English"
         SHOWMESSAGE "Connection with camera failured." + crlf + _
          "Make sure, if your camera driver is correctly installed..."
        CASE "Slovensky"
         SHOWMESSAGE "Spojenie s kamerou zlyhalo." + crlf + _
          "Skontrolujte, èi je ovládaè kamery správne nainštalovaný..."
        END SELECT
        Application.Terminate
       END IF
      END IF
     END SUB

' ------------------------------------------------------------------------------
     SUB frmKamerka_OnClose
      DIM temp AS BYTE
      temp = MESSAGEBOX ("Ukonèi program?", Application.Title, 1)
      IF temp <> 1 THEN
       Action = 0
      ELSE
       SendMessageX (hCamWnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
       MyPort.CLOSE
      END IF
     END SUB

' ------------------------------------------------------------------------------
     SUB frmKamerka_OnResize
      IF frmKamerka.windowstate = 0 THEN
       SendMessage (hCamWnd, WM_CAP_SET_SCALE, 0, 0)
       GetVideoSize
      ELSEIF frmKamerka.windowstate = 2 THEN
       SendMessageX (hCamWnd, WM_CAP_SET_SCALE, 1, 0)
      END IF
     END SUB

' ------------------------------------------------------------------------------
     SUB GetVideoSize
      DEFINT BI_RGB = 0&
      DEFINT BI_RLE8 = 1&
      DEFINT BI_RLE4 = 2&
      DEFINT BI_BITFIELDS = 3&
      DEFINT BI_PLANES = 1

      DIM SizeLen AS LONG
      SizeLen = 40
      DIM bi AS BITMAPINFOHEADER

      WITH bi
       .biSize = SizeLen
       .biWidth = pnlScreen.ClientWidth
       .biHeight = pnlScreen.ClientHeight
       .biBitCount = 16 '
       .biPlanes = BI_PLANES
       .biCompression = BI_RGB
       .biSizeImage = 0 '***
      END WITH

      SendMessage(hCamWnd, WM_CAP_GET_VIDEOFORMAT, SizeLen, bi)
      frmKamerka.clientwidth = bi.biWidth
      frmKamerka.clientheight = bi.biHeight
      frmKamerka.left = (Screen.width - frmKamerka.clientWidth) / 2
      frmKamerka.top = (Screen.height - frmKamerka.clientHeight) / 2
      lblFormatSize2.CAPTION = STR$(bi.biWidth) + " x " + STR$(bi.biHeight)
     END SUB

2009-07-25 17:30