2009-07-25 17:30

' ##########################################################################
' Program: Kamerka (version 0.1, freeware), start on May 29. 2005
' Note: you need "jpeg.dll" and "nviewlib.dll" for showing/saving JPG files
	'  todo list:
	'  using other video commands and settings (like errors capturing)
	'  popUpMenu - does not work on WS_CHILD windows - how to workarround it?
' ##########################################################################

     $TYPECHECK ON
     $OPTION icon "logo_kamerka.ico"
     application.title = "KAMERKA"
     $INCLUDE "QCOM_PORT.INC"
     $INCLUDE "QLVALIGNMENT.INC"

     $RESOURCE bmp_ok AS "bmp_ok.bmp"

     TYPE BITMAPINFOHEADER
      biSize          AS LONG     'Specifies the number of bytes required by the structure
      biWidth         AS LONG     'Specifies the width of the bitmap, in pixels
      biHeight        AS LONG     'Specifies the height of the bitmap, in pixels. If biHeight
	    '                           is positive, the bitmap is a bottom-up DIB and its origin is the
	    '                           lower left corner. If biHeight is negative, the bitmap is a
	    '                           top-down DIB and its origin is the upper left corner
      biPlanes        AS INTEGER  'Specifies the number of planes for the target device.
	    '                           This value must be set to 1
      biBitCount      AS INTEGER  'Specifies the number of bits per pixel.
	    '                           This value must be 1, 4, 8, 16, 24, or 32
      biCompression   AS LONG     'Specifies the type of compression for a compressed bottom-up
	    '                           bitmap (top-down DIBs cannot be compressed).
	    '                           It can be one of the following values:
	    'Value          Description
	    'BI_RGB         An uncompressed format.
	    'BI_RLE8        A run-length encoded (RLE) format for bitmaps with 8 bits per pixel.
	    '               The compression format is a two-byte format consisting of a count byte
	    '               followed by a byte containing a color index. For more information,
	    '               see the following Remarks section.
	    'BI_RLE4        An RLE format for bitmaps with 4 bits per pixel. The compression format
	    '               is a two-byte format consisting of a count byte followed by two word-length
	    '               color indices. For more information, see the following Remarks section.
	    'BI_BITFIELDS   Specifies that the bitmap is not compressed and that the color table
	    '               consists of three doubleword color masks that specify the red, green,
	    '               and blue components, respectively, of each pixel. This is valid when used
	    '               with 16- and 32-bits-per-pixel bitmaps.
      biSizeImage     AS LONG     'Specifies the size, in bytes, of the image.
	    '                           This may be set to 0 for BI_RGB bitmaps
      biXPelsPerMeter AS LONG     'Specifies the horizontal resolution, in pixels per meter, of the
	    '                           target device for the bitmap. An application can use this value
	    '                           to select a bitmap from a resource group that best matches the
	    '                           characteristics of the current device
      biYPelsPerMeter AS LONG     'Specifies the vertical resolution, in pixels per meter,
	    '                           of the target device for the bitmap
      biClrUsed       AS LONG     'Specifies the number of color indices in the color table that
	    '                           are actually used by the bitmap. If this value is zero, the bitmap
	    '                           uses the maximum number of colors corresponding to the value of
	    '                           the biBitCount member for the compression mode specified by
	    '                           biCompression.
	    '                           If biClrUsed is nonzero and the biBitCount member is less than 16,
	    '                           the biClrUsed member specifies the actual number of colors the
	    '                           graphics engine or device driver accesses.
	    '                           If biBitCount is 16 or greater, then biClrUsed member specifies
	    '                           the size of the color table used to optimize performance of
	    '                           Windows color palettes. If biBitCount equals 16 or 32, the optimal
	    '                           color palette starts immediately following the three doubleword masks.
	    '                           If the bitmap is a packed bitmap (a bitmap in which the bitmap
	    '                           array immediately follows the BITMAPINFO header and which is
	    '                           referenced by a single pointer), the biClrUsed member must be
	    '                           either 0 or the actual size of the color table
      biClrImportant  AS LONG     'Specifies the number of color indices that are considered important for displaying the bitmap.
	    '                           If this value is zero, all colors are important
     END TYPE

' ##########################################################################
' Contantes and variables
' ##########################################################################
     CONST crlf = CHR$(13)
     CONST WS_VISIBLE =  &H10000000
     CONST WS_CHILD =    &H40000000
     CONST WS_MAXIMIZE = &H1000000
     CONST WM_USER = 	&H400

	'// Defines start of the message range - here are only used constants
     CONST WM_CAP_START = 				WM_USER
     CONST WM_CAP_SET_CALLBACK_ERROR = 	WM_CAP_START + 2
     CONST WM_CAP_DRIVER_CONNECT = 		WM_CAP_START + 10
     CONST WM_CAP_DRIVER_DISCONNECT = 	WM_CAP_START + 11
     CONST WM_CAP_FILE_SET_CAPTURE_FILE =WM_CAP_START + 20
     CONST WM_CAP_FILE_SAVEAS = 			WM_CAP_START + 23
     CONST WM_CAP_FILE_SAVEDIB = 		WM_CAP_START + 25
     CONST WM_CAP_EDIT_COPY = 			WM_CAP_START + 30
     CONST WM_CAP_DLG_VIDEOFORMAT = 		WM_CAP_START + 41
     CONST WM_CAP_DLG_VIDEOSOURCE = 		WM_CAP_START + 42
     CONST WM_CAP_DLG_VIDEODISPLAY = 	WM_CAP_START + 43
     CONST WM_CAP_GET_VIDEOFORMAT = 		WM_CAP_START + 44
     CONST WM_CAP_DLG_VIDEOCOMPRESSION =	WM_CAP_START + 46
     CONST WM_CAP_SET_PREVIEW = 			WM_CAP_START + 50
     CONST WM_CAP_SET_PREVIEWRATE = 		WM_CAP_START + 52
     CONST WM_CAP_SET_SCALE = 			WM_CAP_START + 53
     CONST WM_CAP_GRAB_FRAME = 			WM_CAP_START + 60
     CONST WM_CAP_SEQUENCE =				WM_CAP_START + 62

     DIM hCamWnd AS INTEGER ' handle number of video capturing window

' ##########################################################################
' Components
' ##########################################################################
	' Serialport
     DIM MyPort AS QComport
     DIM TimerPort AS QTIMER

	' frm_kam
     DIM fntScreen AS QFONT
     fntScreen.Name = "Arial"
     fntScreen.COLOR = RGB(&H00, &H00, &H99)
     DIM frmKamerka AS QFORM
     DIM pnlScreen AS QPANEL

	' mnu_kam
     DIM mnuKamerka AS QMAINMENU
     DIM mnuFile AS QMENUITEM
     DIM mnuOptions AS QMENUITEM
     DIM mnuPause1a AS QMENUITEM
     DIM mnuHelp AS QMENUITEM
     DIM mnuAbout AS QMENUITEM
     DIM mnuPause1b AS QMENUITEM
     DIM mnuExit AS QMENUITEM
     DIM mnuVideo AS QMENUITEM
     DIM mnuRecord AS QMENUITEM
     DIM mnuStop AS QMENUITEM
     DIM mnuPause2a AS QMENUITEM
     DIM mnuFormat AS QMENUITEM
     DIM mnuSource AS QMENUITEM
     DIM mnuCompression AS QMENUITEM
     DIM mnuDisplay AS QMENUITEM
     DIM mnuImage AS QMENUITEM
     DIM mnuSave AS QMENUITEM
     DIM mnuCopy AS QMENUITEM
     DIM mnuCompare AS QMENUITEM

	'frm_set
     DIM frmSet AS QFORM
     DIM btnSetOK AS QBUTTON
     DIM btnSetCancel AS QBUTTON
     DIM tabSet AS QTABCONTROL
     DIM pnlSet0 AS QPANEL	' Global settings
     DIM lblLang AS QLABEL
     DIM cbxLang AS QCOMBOBOX
     DIM lblPort AS QLABEL
     DIM cbxPort AS QCOMBOBOX
     DIM lblFormatSize1 AS QLABEL
     DIM lblFormatSize2 AS QLABEL
     DIM pnlSet1 AS QPANEL	' Video settings
     DIM pnlSet2 AS QPANEL	' Image settings
     DIM lblSetSaveAs AS QLABEL
     DIM cbxSetSaveAs AS QCOMBOBOX
     DIM lblSetQuality AS QLABEL
     DIM cbxSetQuality AS QCOMBOBOX
     DIM chbConfirmDelete AS QCHECKBOX
     DIM lblSetPath AS QLABEL
     DIM btnSetPath AS QCOOLBTN
     DIM ediSetPath AS QEDIT

	' frm_com
     DIM frmCompare AS QFORM
     DIM btnCancel AS QBUTTON
     DIM gbxCompare1 AS QGROUPBOX, gbxCompare2 AS QGROUPBOX
     DIM lviCompare1 AS QLISTVIEW, lviCompare2 AS QLISTVIEW
     DIM pnlCompare1 AS QPANEL, pnlCompare2 AS QPANEL
     DIM pnlCompare1a AS QPANEL, pnlCompare2a AS QPANEL
     DIM dtrCompare1 AS QDIRTREE, dtrCompare2 AS QDIRTREE
     DIM pnlCompare1b AS QPANEL, pnlCompare2b AS QPANEL
     DIM imgCompare1 AS QIMAGE, imgCompare2 AS QIMAGE

     DIM popCompare AS QPOPUPMENU
     DIM popDelete AS QMENUITEM
     DIM popRename AS QMENUITEM

	' dirTree
     DIM frmDirectory AS QFORM
     DIM dirTree AS QDIRTREE
     DIM pnlDirectory AS QPANEL
     DIM btnDirectoryOK AS QBUTTON
     DIM btnDirectoryCancel AS QBUTTON

	' frmRename
     DIM frmRename AS QFORM
     DIM lblRename AS QLABEL
     DIM ediRename AS QEDIT
     DIM btnRenameOK AS QBUTTON
     DIM btnRenameCancel AS QBUTTON

' ##########################################################################
' Declarations
' ##########################################################################
	' ----- global declarations
     DECLARE FUNCTION SetWindowLong LIB "User32" ALIAS "SetWindowLongA" (hwnd AS _
      LONG, nIndex AS LONG, dwNewLong AS LONG) AS LONG ' minimalize correction
     DECLARE FUNCTION SetFocus LIB "user32" ALIAS "SetFocus" (hwnd AS LONG) AS LONG

     DECLARE SUB GetVideoSize

	' frm_kam
     DECLARE SUB frmKamerka_OnShow
     DECLARE SUB frmKamerka_OnClose (Action AS INTEGER)
     DECLARE SUB frmKamerka_OnResize

	' mnu_kam
     DECLARE SUB mnuHelp_OnClick
     DECLARE SUB mnuAbout_OnClick
     DECLARE SUB mnuExit_OnClick
     DECLARE SUB mnuRecord_onClick
     DECLARE SUB mnuStop_OnClick
     DECLARE SUB mnuSource_OnClick
     DECLARE SUB mnuFormat_OnClick
     DECLARE SUB mnuCompression_OnClick
     DECLARE SUB mnuDisplay_OnClick
     DECLARE SUB mnuSetup_OnClick
     DECLARE SUB mnuOptions_OnClick
     DECLARE SUB mnuSave_OnClick
     DECLARE SUB mnuCopy_OnClick
     DECLARE SUB mnuCompare_onClick

	' frm_set
     DECLARE SUB btnSetOK_onClick
     DECLARE SUB tabSet_OnChange
     DECLARE SUB TimerPort_OnTimer
     DECLARE SUB cbxLang_OnChange
     DECLARE SUB cbxPort_OnChange
     DECLARE SUB cbxSetSaveAs_onchange
     DECLARE SUB frmSet_OnShow
     DECLARE SUB btnSetPath_OnClick

	' frm_com
     DECLARE SUB frmCompare_onShow
     DECLARE SUB dtrCompare1_OnChange
     DECLARE SUB dtrCompare2_OnChange
     DECLARE SUB lviCompare1_OnChange
     DECLARE SUB lviCompare2_OnChange

	' popup
     DECLARE SUB popDelete_OnClick
     DECLARE SUB popRename_OnClick
	'declare sub popPrint_OnClick

	' frm_ren
     DECLARE SUB ediRename_onKeyUp (Key AS WORD)
     DECLARE SUB btnRenameOK_OnClick

	' functions for saving as JPG (NVieLib.dll is needing for it)
     IF FILEEXISTS (pnlScreen.Hint + "\NViewLib.dll") = 0 THEN
      DECLARE FUNCTION NViewSaveAsJPG LIB "NViewLib.dll" ALIAS "NViewLibSaveAsJPG" _
       (Quality AS INTEGER, FileName AS STRING) AS INTEGER
      DECLARE FUNCTION NViewLoad LIB "NViewLib.dll" ALIAS "NViewLibLoad" _
       (FileName AS STRING, Progress AS INTEGER) AS LONG
     END IF

     IF FILEEXISTS (pnlScreen.Hint + "\jpeg.dll") = 0 THEN
      DECLARE FUNCTION LoadImageFile LIB "jpeg.dll" ALIAS "LoadImageFile" _
       (hWnd AS LONG, file$ AS STRING) AS INTEGER
     END IF

     DECLARE FUNCTION DeleteObject LIB "gdi32" ALIAS "DeleteObject" (hObject AS LONG) AS LONG

	' two camera functions
     DECLARE FUNCTION sendmessagex LIB "user32" ALIAS "SendMessageA" (BYVAL _
      hwnd AS LONG, BYVAL wmsg AS LONG, BYVAL wparam AS LONG, BYVAL lparam _
      AS LONG) AS LONG

     DECLARE FUNCTION capCreateCaptureWindow LIB "avicap32.dll" ALIAS "capCreateCaptureWindowA" _
      (BYVAL lpszwindowname AS STRING, _
      BYVAL dwstyle AS LONG, _
      BYVAL left AS LONG, _
      BYVAL top AS LONG, _
      BYVAL nwidth AS LONG, _
      BYVAL nheight AS LONG, _
      BYVAL hwndparent AS LONG, _
      BYVAL nid AS LONG) AS LONG

	' Serial port functions
     DECLARE SUB MyPort_OnOpen
     DECLARE SUB MyPort_OnReadString

' ##########################################################################
' Includes
' ##########################################################################
     $INCLUDE "frm_kam.bas" ' Main form
     $INCLUDE "mnu_kam.bas" ' Menu on main form and PopUp menu on form Compare
     $INCLUDE "frm_set.bas" ' Settings form
     $INCLUDE "frm_com.bas" ' Compare form
     $INCLUDE "frm_dir.bas" ' Directory form
     $INCLUDE "frm_ren.bas" ' Rename form

' ##########################################################################
' Other
' ##########################################################################

     frmKamerka.SHOWMODAL

2009-07-25 17:30