Monday 31 August 2015

WaitThroughCaptureBitmap

Function WaitThroughCaptureBitmap(objRef, intWait)
    WaitThroughCaptureBitmap = false
    Dim strOldScreenshot, strNewScreenshot, blnFlag, intWaits
    blnFlag = False
    intWaits = 0

    Do While Not blnFlag = True
    ''@Define file names
    strOldScreenshot = Environment.Value("SystemTempDir") & Replace(Date,"/","") & Replace(Time,":","") & ".bmp"
    iWait (1)
    strNewScreenshot = Environment.Value("SystemTempDir") & Replace(Date,"/","") & Replace(Time,":","") & ".bmp"
    ''@Take a screenshot
        objRef.CaptureBitmap strOldScreenshot,True
        iWait (2)
        objRef.CaptureBitmap strNewScreenshot,True

        Set objFcomapre = CreateObject("Mercury.FileCompare")

        If objFcomapre.isequalbin(strOldScreenshot, strNewScreenshot, 0, 1) Then
            blnFlag = True
        End If

        If Cint(intWaits) = Cint(intWait) Then
            Exit Do
        End If
        intWaits = intWaits + 1
    Loop
    If blnFlag Then
        WaitThroughCaptureBitmap = true
    Else
        WaitThroughCaptureBitmap = false
    End If
    DeleteFilesFromDirectory Split(Environment.Value("SystemTempDir"), "\Temp") (0), "bmp"
End Function


Function DeleteFilesFromDirectory(strDirectory,strExtensionsToDelete)
    Dim objFolder, objSubFolder, objFile, strExt
    Set objFSO = createobject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strDirectory)

    For each objFile in objFolder.Files
        For each strExt in SPLIT(UCASE(strExtensionsToDelete),",")
            If RIGHT(UCASE(objFile.Path),LEN(strExt)+1) = "." & strExt Then
                objFile.Delete
                Exit For
            End If
        Next
    Next
    Set objFSO = Nothing
    Set objFolder = Nothing
End Function

No comments:

Post a Comment