home *** CD-ROM | disk | FTP | other *** search
/ TopWare 18: Liquid / Image.iso / liquid / top2124 / gepackt.exe / ALARM.ZIP / ALARM2.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-02-02  |  5.7 KB  |  176 lines
  1.  
  2. Sub alarmend ()
  3.   
  4.   'say that were ending it all, disable timer
  5.   alarm.status.Text = "Ending"
  6.   alarm.alarmtimer.Enabled = False
  7.   
  8.   'free allocated memory
  9.   freememory
  10.  
  11.   'switch the framegrabber off
  12.   q% = pcv_disablevideo()
  13.  
  14.   'all done
  15.   End
  16.  
  17. End Sub
  18.  
  19. Sub info ()
  20.   
  21.   'copyright notice and info/help
  22.   lf$ = Chr$(10)
  23.   message$ = lf$
  24.   message$ = message$ & "Alarm Version 1.0" + lf$
  25.   message$ = message$ & "Framegrabber DLL Copyright (C) P.J. Scholtz 1994" + lf$ + lf$
  26.   message$ = message$ & "Status : Initialize, video on, scanning, ending" + lf$
  27.   message$ = message$ & "Scan Delay : Seconds of live video before scanning" + lf$
  28.   message$ = message$ & "Pixel Step : Smaller value takes longer but is more accurate" + lf$
  29.   message$ = message$ & "What is Bad : If result is >= then set alarm on" + lf$
  30.   message$ = message$ & "Scan Result : Luma difference of previous and current frame" + lf$
  31.   message$ = message$ & "Alarm Alert : Is the alarm on or not" + lf$
  32.   message$ = message$ & "Save to Disk : Save frame to disk in .MMP format" + lf$
  33.   message$ = message$ & "Exit : Switch framegrabber off and free memory" + lf$
  34.   alarm.Label7.Caption = message$
  35.   alarm.Label7.Visible = True
  36.   MsgBox "Please support shareware !", 0, "Information"
  37.   alarm.Label7.Visible = False
  38.  
  39. End Sub
  40.  
  41. Sub initializealarm ()
  42.   
  43.   'called when form is loaded
  44.   
  45.   'maximize window, display window
  46.   alarm.WindowState = 2
  47.   alarm.Show
  48.   alarm.Refresh
  49.   
  50.   'standard PC-Video DLL initialization for full-screen video
  51.   q% = pcv_loadconfiguration()
  52.   q% = pcv_initialize()
  53.   If q% = 0 Then
  54.     q% = MsgBox("The video capture adaptor was NOT found.", 48, "I have a problem !")
  55.     End
  56.   End If
  57.   q% = pcv_setcolorkey(2) 'green
  58.   q% = pcv_createwindow(0, 0, 640, 480, 1)
  59.   q% = pcv_setwindowsize(640, 480, 0)
  60.   q% = pcv_setwindowposition(0, 0)
  61.   q% = pcv_setvideosource(0)
  62.   q% = pcv_enablevideo()
  63.   q% = pcv_unfreezevideo()
  64.   
  65.   'ask user which framegrabber is installed
  66.   'the call to INITDLL needs to be told which card is installed
  67.   message$ = "Select YES for" + Chr$(10) + Chr$(10)
  68.   message$ = message$ + "PE-Von PV100" + Chr$(10)
  69.   message$ = message$ + "Adda Aver 2000" + Chr$(10)
  70.   message$ = message$ + "Aitech Pro PC-Video" + Chr$(10) + Chr$(10) + Chr$(10)
  71.   message$ = message$ + "Select NO for" + Chr$(10) + Chr$(10)
  72.   message$ = message$ + "Creative Labs VideoBlaster"
  73.   card% = MsgBox(message$, 3, "Which framegrabber do you have installed ?")
  74.   If card% <> 6 And card% <> 7 Then
  75.     q% = MsgBox("You cancelled - ending program.", 0, "The End")
  76.     End
  77.   End If
  78.   
  79.   'set cursor to hourglass
  80.   alarm.MousePointer = 11
  81.  
  82.   'initialize framegrabber DLL with one extra page (768KB each)
  83.   'page 0 is the visible framegrabber memory, page 1 is the extra page -
  84.   'to store the previous frame
  85.   '2nd parameter indicates card type: 0 = PE-Von PV100, Adda Aver 2000, Aitech Pro PC-Video
  86.   '                                   1 = Creative Labs VideoBlaster
  87.   'a minimum of one additional page must be initialized
  88.   Call initdll(1, card% - 6)
  89.   
  90.   'set framegrabber memory as the default active page
  91.   Call setactivepage(0)
  92.   
  93.   'store a frame to page 1
  94.   q% = pcv_freezevideo()
  95.   Call copyblock(0, 0, 640, 480, 0, 1)
  96.   q% = pcv_unfreezevideo()
  97.   
  98.   'say that video is on/initialization complete, start timer, set cursor normal
  99.   alarm.status.Text = "Video On"
  100.   alarm.alarmtimer.Enabled = True
  101.   alarm.MousePointer = 0
  102.  
  103. End Sub
  104.  
  105. Sub scancaptures ()
  106.   
  107.   'Disable timer and say that we are busy scanning
  108.   alarm.alarmtimer.Enabled = False
  109.   alarm.status.Text = "Scanning"
  110.   
  111.   'freeze video
  112.   q% = pcv_freezevideo()
  113.   
  114.   'step according to user changable control: alarm.pixelstep.Text
  115.   'scan top to bottom, left to right
  116.   For y% = 0 To 479 Step Val(alarm.pixelstep.Text)
  117.     For x% = 0 To 639 Step Val(alarm.pixelstep.Text)
  118.       
  119.       'read from framegrabber memory (page 0)
  120.       setactivepage (0)
  121.       Call yuvgetpixel(x%, y%, luma0%, chroma1%, chroma2%)
  122.       
  123.       'read from previously stored frame (page 1)
  124.       setactivepage (1)
  125.       Call yuvgetpixel(x%, y%, luma1%, chroma1%, chroma2%)
  126.       
  127.       'check difference in black & white intensity (the luma)
  128.       'we are ignoring the colour (the chroma)
  129.       'if colour is important rather use RGBGETPIXEL
  130.       diff& = diff& + Abs(luma0% - luma1%)
  131.  
  132.     Next x%
  133.   Next y%
  134.   
  135.   'store current frame (page 0) to page 1
  136.   Call copyblock(0, 0, 640, 480, 0, 1)
  137.   
  138.   'switch video back on
  139.   q% = pcv_unfreezevideo()
  140.   
  141.   'display result of scan
  142.   'total luma difference divided by total number of pixels checked
  143.   alarm.scanresult.Text = LTrim$(Str$(diff& \ (307200 / (Val(alarm.pixelstep.Text) * Val(alarm.pixelstep.Text)))))
  144.  
  145.   'check if the alarm should be switched on
  146.   If Val(alarm.scanresult.Text) >= Val(alarm.whatisbad.Text) Then
  147.     'say that the alarm has been sounded
  148.     alarm.alarmalert.Text = "Alarm !"
  149.     Beep
  150.     'alarm is on, must the frame be stored to disk?
  151.     If alarm.saveornot(0).Value Then
  152.       alarm.status.Text = "Saving"
  153.       'filename = mmddhhmm.ss
  154.       filename$ = Left$(Date$, 2) + Mid$(Date$, 4, 2) + Left$(Time$, 2) + Mid$(Time$, 4, 2) + "." + Right$(Time$, 2)
  155.       q% = savemmp(filename$, 0, 0, 640, 480)
  156.     End If
  157.   Else
  158.     'say that all is ok/alarm is off
  159.     alarm.alarmalert.Text = "All Ok"
  160.   End If
  161.   
  162.   'Say that video is live, switch on the timer
  163.   alarm.status.Text = "Video On"
  164.   alarm.alarmtimer.Enabled = True
  165.  
  166. End Sub
  167.  
  168. Sub setinterval ()
  169.   
  170.   'visual basic timer delays in milliseconds so multiply by 1000
  171.   'a value of zero for timer.interval disables timer, so add one
  172.   alarm.alarmtimer.Interval = Val(alarm.scandelay.Text) * 1000 + 1
  173.  
  174. End Sub
  175.  
  176.