Keskustelu: Ohjelmointikysymykset: [VB6] Formi ei pysy oikeassa koossa

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long

Private mCapHwnd As Long

Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054
Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

Dim P() As Long
Dim POn() As Boolean

Dim inten As Integer
Private Const VK_ESCAPE = &H1B
Private Const VK_RBUTTON = &H2

Dim i As Integer, j As Integer

Dim Ri As Long, Wo As Long
Dim RealRi As Long

Dim c As Long, c2 As Long

Dim R As Integer, G As Integer, B As Integer
Dim R2 As Integer, G2 As Integer, B2 As Integer

Dim Tppx As Single, Tppy As Single
Dim Tolerance As Integer

Dim RealMov As Integer

Dim Counter As Integer

Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim LastTime As Long

Option Explicit

Private Sub Form_Load()
Me.Left = Screen.Width - Me.Width
Picture1.Width = 640 * Screen.TwipsPerPixelX
Picture1.Height = 480 * Screen.TwipsPerPixelY
inten = 15
Tolerance = 20
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
Tppx = Screen.TwipsPerPixelX
Tppy = Screen.TwipsPerPixelY

ReDim POn(640 / inten, 480 / inten)
ReDim P(640 / inten, 480 / inten)

STARTCAM
End Sub


Private Sub Label3_Click()
If App.TaskVisible = True Then
App.TaskVisible = False
Else
App.TaskVisible = True
End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
STARTCAM
ElseIf Button = 2 Then
STOPCAM
End If
End Sub

Private Sub Timer1_Timer()
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
Clipboard.Clear

Ri = 0
Wo = 0

LastTime = GetTickCount

For i = 0 To 640 / inten - 1
    For j = 0 To 480 / inten - 1
    c = Picture1.Point(i * inten * Tppx, j * inten * Tppy)
        R = c Mod 256
        G = (c \ 256) Mod 256
        B = (c \ 256 \ 256) Mod 256

    c2 = P(i, j)
        'analyze it
        R2 = c2 Mod 256
        G2 = (c2 \ 256) Mod 256
        B2 = (c2 \ 256 \ 256) Mod 256

    If Abs(R - R2) < Tolerance And Abs(G - G2) < Tolerance And Abs(B - B2) < Tolerance Then
    Ri = Ri + 1
    POn(i, j) = True

    Else
    Wo = Wo + 1
    P(i, j) = Picture1.Point(i * inten * Tppx, j * inten * Tppy)
    Picture1.PSet (i * inten * Tppx, j * inten * Tppy), vbBlack
    POn(i, j) = False
    End If

    Next j

Next i

RealRi = 0

For i = 1 To 640 / inten - 2
    For j = 1 To 480 / inten - 2
    If POn(i, j) = False Then
        If POn(i, j + 1) = False Then
            If POn(i, j - 1) = False Then
                If POn(i + 1, j) = False Then
                    RealRi = RealRi + 1
                    Timer4.Enabled = False
                       Timer4.Enabled = True
                    Picture1.PSet (i * inten * Tppx, j * inten * Tppy), vbBlue
                End If
            End If
        End If

    End If


    Next j
Next i

Label1.Caption = Int(Wo / (Ri + Wo) * 100) & " % movement" & vbCrLf & "Real Movement: " & RealRi & vbCrLf _
& "Completed in: " & GetTickCount - LastTime

End Sub

Sub STOPCAM()
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Timer1.Enabled = False
End Sub

Sub STARTCAM()
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 640, 480, Me.hwnd, 0)
DoEvents
SendMessage mCapHwnd, CONNECT, 0, 0
Timer1.Enabled = True
End Sub

Private Sub Timer2_Timer()
Label1.Left = 100
Label1.Top = Picture1.Height - Label1.Height
Label3.Left = 100
Label3.Top = Picture1.Height - Label3.Height - Label1.Height - 50
Picture1.AutoSize = False
Picture1.AutoSize = True
Timer3.Enabled = True
Timer2.Enabled = False
End Sub

Private Sub Timer3_Timer()
Label2.Left = Picture1.Width - Label2.Width - 70
Label2.Top = Picture1.Height - Label2.Height - 70
Picture1.Left = 0
Timer3.Enabled = False
Timer5.Enabled = True
End Sub

Private Sub Timer4_Timer()
SavePicture Picture1.Image, "C:\" & "MotionDetect" & Counter & ".bmp"
Counter = Counter + 1
Timer4.Enabled = False
End Sub

Private Sub Timer5_Timer()
Picture1.Top = 0
'TÄSSÄ MUUTETAAN FORMIN KOKOA
Me.Width = Picture1.Width + 70
Me.Height = Picture1.Height + 450
Timer5.Enabled = False
Me.Left = Screen.Width - Me.Width
Me.Top = Screen.Height - Me.Height - 400
Label2.Left = Picture1.Width - Label2.Width - 70
Label2.Top = Picture1.Height - Label2.Height - 70
Label1.Left = 100
Label1.Top = Picture1.Height - Label1.Height
Label3.Left = 100
Label3.Top = Picture1.Height - Label3.Height - Label1.Height - 50

End Sub

Private Sub Timer6_Timer()
If Label3.Visible = True And Label2.Visible = True Then
Label3.Visible = False
Label2.Visible = False
Else
If Label2.Visible = False And Label2.Visible = False Then
Label3.Visible = True
Label2.Visible = True
End If
End If
End Sub