Page 2 of 2 FirstFirst 12
Results 41 to 58 of 58

Thread: How to take a picture from the back of the form while the form is being displayed to?

  1. #41
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,721

    Re: How to take a picture from the back of the form while the form is being displayed

    u know. u could actually create 2 executable.
    1 is the "transparent" rectangle.
    and 1 is the form itself.
    using sendmessage u can communicate with each other.
    so, the transparent form, will just do the blur-copying and nothing else.
    and since its just a small area it should be fast.
    subclassing it and it will follow the main-form smoothly.

    u will create a dual-thread-program this way.
    I already do that with my game, 1 external program for screenshot, music loading/playback and wordchecker.
    and the game is running smoother and without freezing when loading a new mp3.

  2. #42
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: How to take a picture from the back of the form while the form is being displayed

    Here I applied some blur in the center (I put a LabelPlus control that blurs the background) I had to capture it with my mobile phone because screen recorders can't record it.

    leandroascierto.com Visual Basic 6 projects

  3. #43
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,721

    Re: How to take a picture from the back of the form while the form is being displayed

    the problem with the delay could be fixed if we have a "sync" solution.
    when paint-event we do it. the same with my game. I need to follow the monitor sync to make it smooth.
    the VB.Timer will never work here.

  4. #44
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,987

    Re: How to take a picture from the back of the form while the form is being displayed

    I modified Leandro's code to update the capture in the WM_WINDOWPOSCHANGING message, it more or less works (at least on my PC).

    Now what it is left is to implement the blur filter.
    Attached Files Attached Files

  5. #45
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,987

    Re: How to take a picture from the back of the form while the form is being displayed

    Here is a attempt with blurr, it more or less work, but it is far from perfect.
    Attached Files Attached Files

  6. #46

  7. #47

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    575

    Re: How to take a picture from the back of the form while the form is being displayed

    hi , about attachments in :

    Quote Originally Posted by Eduardo- View Post
    I modified Leandro's code to update the capture in the WM_WINDOWPOSCHANGING message, it more or less works (at least on my PC).
    Now what it is left is to implement the blur filter.
    and

    Quote Originally Posted by Eduardo- View Post
    Here is a attempt with blurr, it more or less work, but it is far from perfect.
    i downloaded two attachments and result after test was been like as these on my windows 8 64 bit , i had to record of screen with phone to can send result here : ( work not good )



    animated gif:



    Last edited by Black_Storm; Jan 30th, 2023 at 06:12 AM.
    [ ... active on skype and discord ... ] ,[always strive to achieve your dreams] , [always try,dont stop,never say never]

  8. #48

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    575

    Re: How to take a picture from the back of the form while the form is being displayed

    Quote Originally Posted by The trick View Post
    Code:
    ' //
    ' // modGlass.bas - apply glass effect
    ' // by The trick 2023
    ' //
    
    Option Explicit
    
    Private Enum PTR
        NULL_PTR
    End Enum
    
    Private Const DIB_RGB_COLORS          As Long = 0
    Private Const GWL_EXSTYLE             As Long = (-20)
    Private Const WS_EX_LAYERED           As Long = &H80000
    Private Const FADF_AUTO               As Long = 1
    Private Const HTCAPTION               As Long = 2
    Private Const WM_NCHITTEST            As Long = &H84
    Private Const WM_PAINT                As Long = &HF
    Private Const WM_WINDOWPOSCHANGING    As Long = &H46
    Private Const WM_MOUSEWHEEL           As Long = &H20A&
    Private Const DC_PEN                  As Long = 19
    Private Const NULL_BRUSH              As Long = 5
    Private Const ULW_OPAQUE              As Long = 4
    
    Private Type POINTAPI
        lX                  As Long
        lY                  As Long
    End Type
    Private Type SIZE
        cx                  As Long
        cy                  As Long
    End Type
    Private Type SAFEARRAYBOUND
        cCount              As Long
        lBound              As Long
    End Type
    Private Type SAFEARRAY1D
        cDims               As Integer
        fFeatures           As Integer
        cbElements          As Long
        cLocks              As Long
        pvData              As PTR
        Bounds              As SAFEARRAYBOUND
    End Type
    Private Type RECT
        lLeft               As Long
        lTop                As Long
        lRight              As Long
        lBottom             As Long
    End Type
    Private Type PAINTSTRUCT
        hDC                 As OLE_HANDLE
        fErase              As Long
        rcPaint             As RECT
        fRestore            As Long
        fIncUpdate          As Long
        rgbReserved(32)     As Byte
    End Type
    Private Type WINDOWPOS
        hwnd                As OLE_HANDLE
        hWndInsertAfter     As OLE_HANDLE
        x                   As Long
        y                   As Long
        cx                  As Long
        cy                  As Long
        flags               As Long
    End Type
    Private Type RGBQUAD
        rgbBlue             As Byte
        rgbGreen            As Byte
        rgbRed              As Byte
        rgbReserved         As Byte
    End Type
    Private Type BITMAPINFOHEADER
        biSize              As Long
        biWidth             As Long
        biHeight            As Long
        biPlanes            As Integer
        biBitCount          As Integer
        biCompression       As Long
        biSizeImage         As Long
        biXPelsPerMeter     As Long
        biYPelsPerMeter     As Long
        biClrUsed           As Long
        biClrImportant      As Long
    End Type
    Private Type BITMAPINFO
        bmiHeader           As BITMAPINFOHEADER
        bmiColors           As RGBQUAD
    End Type
    Private Type GLASS_WINDOW_ENTRY
        hwnd                As OLE_HANDLE
        lWidth              As Long
        lHeight             As Long
        hBitmap             As OLE_HANDLE
        hDC                 As OLE_HANDLE
        bPixels()           As Byte
        lBlurLevel          As Long
        tSADesc             As SAFEARRAY1D
    End Type
    
    
    Private Declare Sub PutMemPtr Lib "msvbvm60" _
                        Alias "PutMem4" ( _
                        ByRef pAddr As Any, _
                        ByVal pVal As PTR)
    Private Declare Function ArrPtr Lib "msvbvm60" _
                             Alias "VarPtr" ( _
                             ByRef ppSA() As Any) As PTR
    Private Declare Function SetWindowLongPtr Lib "user32" _
                             Alias "SetWindowLongW" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal nIndex As Long, _
                             ByVal dwNewLong As PTR) As PTR
    Private Declare Function GetWindowLongPtr Lib "user32" _
                             Alias "GetWindowLongW" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal nIndex As Long) As PTR
    Private Declare Function SetTimer Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal nIDEvent As PTR, _
                             ByVal uElapse As Long, _
                             ByVal lpTimerFunc As PTR) As PTR
    Private Declare Function GetWindowRect Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByRef lpRect As RECT) As Long
    Private Declare Function CreateDIBSection Lib "gdi32" ( _
                             ByVal hDC As OLE_HANDLE, _
                             ByRef pBitmapInfo As BITMAPINFO, _
                             ByVal dwUsage As Long, _
                             ByRef ppvBits As Any, _
                             ByVal hSection As OLE_HANDLE, _
                             ByVal dwOffset As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" ( _
                             ByVal hObject As OLE_HANDLE) As Long
    Private Declare Function GetDC Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE) As Long
    Private Declare Function ReleaseDC Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal hDC As OLE_HANDLE) As Long
    Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
                             ByVal hDC As OLE_HANDLE) As Long
    Private Declare Function SelectObject Lib "gdi32" ( _
                             ByVal hDC As OLE_HANDLE, _
                             ByVal hObject As OLE_HANDLE) As OLE_HANDLE
    Private Declare Function SaveDC Lib "gdi32" ( _
                             ByVal hDC As OLE_HANDLE) As Long
    Private Declare Function RestoreDC Lib "gdi32" ( _
                             ByVal hDC As OLE_HANDLE, _
                             ByVal nSavedDC As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" ( _
                             ByVal hDC As OLE_HANDLE) As Long
    Private Declare Function InvalidateRect Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByRef lpRect As Any, _
                             ByVal bErase As Long) As Long
    Private Declare Function SetWindowSubclass Lib "Comctl32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal pfnSubclass As PTR, _
                             ByVal uIdSubclass As PTR, _
                             ByRef dwRefData As Any) As Long
    Private Declare Function RemoveWindowSubclass Lib "Comctl32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal pfnSubclass As PTR, _
                             ByVal uIdSubclass As PTR) As Long
    Private Declare Function DefSubclassProc Lib "Comctl32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal uMsg As Long, _
                             ByVal wParam As PTR, _
                             ByVal lParam As PTR) As PTR
    Private Declare Function BeginPaint Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByRef lpPaint As PAINTSTRUCT) As Long
    Private Declare Function EndPaint Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByRef lpPaint As PAINTSTRUCT) As Long
    Private Declare Function GetStockObject Lib "gdi32" ( _
                             ByVal nIndex As Long) As OLE_HANDLE
    Private Declare Function SetDCPenColor Lib "gdi32" ( _
                             ByVal hDC As OLE_HANDLE, _
                             ByVal colorref As Long) As Long
    Private Declare Function RoundRect Lib "gdi32" ( _
                             ByVal hDC As OLE_HANDLE, _
                             ByVal X1 As Long, _
                             ByVal Y1 As Long, _
                             ByVal X2 As Long, _
                             ByVal Y2 As Long, _
                             ByVal X3 As Long, _
                             ByVal Y3 As Long) As Long
    Private Declare Function BitBlt Lib "gdi32" ( _
                             ByVal hDestDC As OLE_HANDLE, _
                             ByVal x As Long, _
                             ByVal y As Long, _
                             ByVal nWidth As Long, _
                             ByVal nHeight As Long, _
                             ByVal hSrcDC As OLE_HANDLE, _
                             ByVal xSrc As Long, _
                             ByVal ySrc As Long, _
                             ByVal dwRop As Long) As Long
    Private Declare Function KillTimer Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal nIDEvent As PTR) As Long
    Private Declare Function UpdateLayeredWindow Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal hdcDst As Long, _
                             ByRef pptDst As Any, _
                             ByRef psize As SIZE, _
                             ByVal hdcSrc As OLE_HANDLE, _
                             ByRef pptSrc As POINTAPI, _
                             ByVal crKey As Long, _
                             ByRef pblend As Long, _
                             ByVal dwFlags As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" ( _
                             ByVal hwnd As OLE_HANDLE, _
                             ByVal hRgn As OLE_HANDLE, _
                             ByVal bRedraw As Boolean) As Long
    Private Declare Function CreateRoundRectRgn Lib "gdi32" ( _
                             ByVal X1 As Long, _
                             ByVal Y1 As Long, _
                             ByVal X2 As Long, _
                             ByVal Y2 As Long, _
                             ByVal X3 As Long, _
                             ByVal Y3 As Long) As OLE_HANDLE
    
    Private m_tWindows()    As GLASS_WINDOW_ENTRY
    Private m_lWindowsCount As Long
    Private m_uTimerID      As PTR
    
    Public Function ApplyGlass( _
                    ByVal hwnd As OLE_HANDLE) As Boolean
        Dim tRC     As RECT
        Dim tBI     As BITMAPINFO
        Dim lWidth  As Long
        Dim lHeight As Long
        Dim hBitmap As OLE_HANDLE
        Dim hDC     As OLE_HANDLE
        Dim hMemDC  As OLE_HANDLE
        Dim pBits   As PTR
        Dim bStyle  As Boolean
        Dim bRet    As Boolean
        Dim lIndex  As Long
        Dim bAdded  As Boolean
        Dim bHook   As Boolean
        Dim hRgn    As OLE_HANDLE
        Dim bRgnSet As Boolean
        
        If GetWindowRect(hwnd, tRC) = 0 Then
            Exit Function
        End If
        
        lWidth = tRC.lRight - tRC.lLeft
        lHeight = tRC.lBottom - tRC.lTop
        
        With tBI.bmiHeader
            .biSize = LenB(tBI.bmiHeader)
            .biBitCount = 32
            .biHeight = -lHeight * 2
            .biWidth = lWidth
            .biPlanes = 1
        End With
        
        hDC = GetDC(hwnd)
        
        If hDC = 0 Then
            Exit Function
        End If
        
        hMemDC = CreateCompatibleDC(hDC)
        
        If hMemDC = 0 Then
            GoTo CleanUp
        End If
        
        hBitmap = CreateDIBSection(hDC, tBI, DIB_RGB_COLORS, pBits, NULL_PTR, 0)
        
        If hBitmap = 0 Then
            GoTo CleanUp
        End If
        
        If SaveDC(hMemDC) = 0 Then
            GoTo CleanUp
        End If
        
        If SelectObject(hMemDC, hBitmap) = 0 Then
            GoTo CleanUp
        End If
        
        If SelectObject(hMemDC, GetStockObject(DC_PEN)) = 0 Then
            GoTo CleanUp
        End If
        
        If SelectObject(hMemDC, GetStockObject(NULL_BRUSH)) = 0 Then
            GoTo CleanUp
        End If
        
        hRgn = CreateRoundRectRgn(0, 0, lWidth + 1, lHeight + 1, 17, 17)
        
        If hRgn = NULL_PTR Then
            GoTo CleanUp
        End If
        
        If SetWindowRgn(hwnd, hRgn, False) = 0 Then
            GoTo CleanUp
        End If
        
        bRgnSet = True
        
        SetDCPenColor hMemDC, &HE0E080
        
        If SetWindowLongPtr(hwnd, GWL_EXSTYLE, GetWindowLongPtr(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED) = 0 Then
            GoTo CleanUp
        End If
        
        bStyle = True
        
        lIndex = AddWindowEntry(hwnd, hBitmap, pBits, hMemDC, lWidth, lHeight, 7)
        
        bAdded = True
        
        If SetWindowSubclass(hwnd, AddressOf GlassWndProc, NULL_PTR, ByVal lIndex) = 0 Then
            GoTo CleanUp
        End If
        
        bHook = True
        
        If m_uTimerID = NULL_PTR Then
            
            m_uTimerID = SetTimer(NULL_PTR, NULL_PTR, 200, AddressOf TimerProc)
            
            If m_uTimerID = NULL_PTR Then
                GoTo CleanUp
            End If
            
        End If
        
        bRet = True
        
    CleanUp:
        
        If Not bRet Then
            
            If bHook Then
                RemoveWindowSubclass hwnd, AddressOf GlassWndProc, NULL_PTR
            End If
            
            If bStyle Then
                SetWindowLongPtr hwnd, GWL_EXSTYLE, GetWindowLongPtr(hwnd, GWL_EXSTYLE) And (Not WS_EX_LAYERED)
            End If
                    
            If bAdded Then
                RemoveWindowEntry hwnd
            End If
                    
            If hMemDC Then
                RestoreDC hMemDC, -1
                DeleteDC hMemDC
            End If
            
            If hBitmap Then
                DeleteObject hBitmap
            End If
            
        End If
        
        If Not bRgnSet And hRgn <> 0 Then
            DeleteObject hRgn
        End If
        
        If hDC Then
            ReleaseDC hwnd, hDC
        End If
        
    End Function
    
    Public Function DisableGlass( _
                    ByVal hwnd As OLE_HANDLE) As Boolean
        DisableGlass = RemoveWindowEntry(hwnd)
    End Function
    
    Private Function AddWindowEntry( _
                     ByVal hwnd As OLE_HANDLE, _
                     ByVal hBitmap As OLE_HANDLE, _
                     ByVal pBits As PTR, _
                     ByVal hDC As OLE_HANDLE, _
                     ByVal lWidth As Long, _
                     ByVal lHeight As Long, _
                     ByVal lBlurLevel As Long) As Long
        Dim lIndex  As Long
        
        For lIndex = 0 To m_lWindowsCount - 1
            If m_tWindows(lIndex).hwnd = NULL_PTR Then
                Exit For
            End If
        Next
        
        If lIndex = m_lWindowsCount Then
            If lIndex Then
                If lIndex > UBound(m_tWindows) Then
                    ReDim Preserve m_tWindows(m_lWindowsCount + 10)
                End If
            Else
                ReDim m_tWindows(9)
            End If
        End If
        
        With m_tWindows(lIndex)
            
            .hwnd = hwnd
            .lBlurLevel = lBlurLevel
            .hBitmap = hBitmap
            .hDC = hDC
            .lHeight = lHeight
            .lWidth = lWidth
            
            With .tSADesc
                
                .Bounds.cCount = lWidth * lHeight * 2 * 4
                .cbElements = 1
                .cDims = 1
                .fFeatures = FADF_AUTO
                .pvData = pBits
    
            End With
            
            PutMemPtr ByVal ArrPtr(.bPixels), VarPtr(.tSADesc)
            
            m_lWindowsCount = m_lWindowsCount + 1
            
        End With
        
        AddWindowEntry = lIndex
        
    End Function
    
    Private Function RemoveWindowEntry( _
                     ByVal hwnd As OLE_HANDLE) As Boolean
        Dim lIndex  As Long
        
        For lIndex = 0 To m_lWindowsCount - 1
            
            With m_tWindows(lIndex)
            
                If .hwnd = hwnd Then
                    
                    RemoveWindowSubclass hwnd, AddressOf GlassWndProc, NULL_PTR
                    PutMemPtr ByVal ArrPtr(.bPixels), NULL_PTR
                    RestoreDC .hDC, -1
                    DeleteObject .hBitmap
                    DeleteDC .hDC
                    SetWindowLongPtr hwnd, GWL_EXSTYLE, GetWindowLongPtr(hwnd, GWL_EXSTYLE) And (Not WS_EX_LAYERED)
                    .hwnd = NULL_PTR
                    
                    m_lWindowsCount = m_lWindowsCount - 1
                    
                    If m_lWindowsCount = 0 Then
                        KillTimer NULL_PTR, m_uTimerID
                        m_uTimerID = NULL_PTR
                    End If
                    
                    RemoveWindowEntry = True
                    
                    Exit For
                    
                End If
            
            End With
            
        Next
                    
    End Function
    
    Private Function GlassWndProc( _
                     ByVal hwnd As OLE_HANDLE, _
                     ByVal lMsg As Long, _
                     ByVal wParam As Long, _
                     ByVal lParam As Long, _
                     ByVal uId As PTR, _
                     ByVal dwRefData As PTR) As PTR
    
        Select Case lMsg
        Case WM_WINDOWPOSCHANGING
            UpdateGlassWindow hwnd
        Case WM_NCHITTEST
            GlassWndProc = HTCAPTION
        Case WM_MOUSEWHEEL
            GlassWndProc = OnWheel(hwnd, wParam)
        Case Else
            GlassWndProc = DefSubclassProc(hwnd, lMsg, wParam, lParam)
        End Select
        
    End Function
    
    Private Sub TimerProc( _
                ByVal hwnd As OLE_HANDLE, _
                ByVal uMsg As Long, _
                ByVal idEvent As PTR, _
                ByVal dwTime As Long)
        Dim lIndex  As Long
        
        For lIndex = 0 To m_lWindowsCount - 1
            If m_tWindows(lIndex).hwnd Then
                UpdateGlass m_tWindows(lIndex)
            End If
        Next
        
    End Sub
    
    Private Function OnWheel( _
                     ByVal hwnd As OLE_HANDLE, _
                     ByVal lValue As Long) As PTR
        Dim lIndex  As Long
        
        For lIndex = 0 To m_lWindowsCount - 1
        
            With m_tWindows(lIndex)
                
                If .hwnd = hwnd Then
                    
                    .lBlurLevel = .lBlurLevel + Sgn(lValue)
                    
                    If .lBlurLevel < 2 Then
                        .lBlurLevel = 2
                    ElseIf .lBlurLevel > 21 Then
                        .lBlurLevel = 21
                    End If
                    
                    Exit For
                    
                End If
                
            End With
            
        Next
        
    End Function
    
    Private Sub UpdateGlassWindow( _
                ByVal hwnd As OLE_HANDLE)
        Dim lIndex  As Long
        
        For lIndex = 0 To m_lWindowsCount - 1
            If m_tWindows(lIndex).hwnd = hwnd Then
                UpdateGlass m_tWindows(lIndex)
                Exit For
            End If
        Next
        
    End Sub
    
    Private Sub UpdateGlass( _
                ByRef tEntry As GLASS_WINDOW_ENTRY)
        Dim hDC     As OLE_HANDLE
        Dim tRC     As RECT
        Dim tPT     As POINTAPI
        Dim tSize   As SIZE
        
        hDC = GetDC(NULL_PTR)
        
        If hDC = NULL_PTR Then
            Exit Sub
        End If
        
        GetWindowRect tEntry.hwnd, tRC
        
        BitBlt tEntry.hDC, 0, 0, tEntry.lWidth, tEntry.lHeight, hDC, tRC.lLeft, tRC.lTop, vbSrcCopy
        ApplyBlur tEntry.bPixels, tEntry.lWidth, tEntry.lHeight, tEntry.lBlurLevel, &HFFE060
        RoundRect tEntry.hDC, 0, 0, tEntry.lWidth, tEntry.lHeight, 16, 16
        
        tSize.cx = tRC.lRight - tRC.lLeft
        tSize.cy = tRC.lBottom - tRC.lTop
        
        UpdateLayeredWindow tEntry.hwnd, NULL_PTR, ByVal NULL_PTR, tSize, tEntry.hDC, tPT, 0, 0, ULW_OPAQUE
         
    CleanUp:
        
        ReleaseDC NULL_PTR, hDC
                          
    End Sub
    
    Private Sub ApplyBlur( _
                ByRef bPix() As Byte, _
                ByVal lWidth As Long, _
                ByVal lHeight As Long, _
                ByVal lSize As Long, _
                Optional ByVal lRGBFactor As Long = &HFFFFFF)
        Dim lX  As Long:    Dim lY  As Long:    Dim lS  As Long
        Dim lE  As Long:    Dim lZ  As Long:    Dim lR  As Long
        Dim lG  As Long:    Dim lB  As Long:    Dim lI  As Long
        Dim lD  As Long:    Dim lA  As Long:    Dim lQ  As Long
        Dim lK  As Long:    Dim lFR As Long:    Dim lFG As Long
        Dim lFB As Long
        
        If lSize <= 1 Then
            Exit Sub
        End If
        
        lFR = (lRGBFactor And &HFF0000) \ &H10000
        lFG = (lRGBFactor And &HFF00&) \ &H100
        lFB = (lRGBFactor And &HFF)
        
        lS = lSize \ 2
        lE = (lSize - 1) \ 2
        lZ = lWidth - lE - 1
        lQ = lHeight * lWidth * 4
        lK = lWidth * 4
        
        For lY = 0 To lHeight - 1
    
            ' // Calc for -1 pix
    
            If lE Then
                lR = bPix(lI)
                lG = bPix(lI + 1)
                lB = bPix(lI + 2)
            Else
                lR = 0
                lG = 0
                lB = 0
            End If
    
            lI = lI + 4
    
            For lX = 0 To lS
    
                If lX <= lE - 2 Then
                    lR = lR + bPix(lI) * 2&
                    lG = lG + bPix(lI + 1) * 2&
                    lB = lB + bPix(lI + 2) * 2&
                Else
                    lR = lR + bPix(lI)
                    lG = lG + bPix(lI + 1)
                    lB = lB + bPix(lI + 2)
                End If
    
                lI = lI + 4
    
            Next
    
            lI = lI - (lS + 2) * 4
            lA = lI + lE * 4
            lD = lI + (lS + 1) * 4
    
            For lX = 0 To lWidth - 1
    
                lR = lR + bPix(lA) - bPix(lD)
                lG = lG + bPix(lA + 1) - bPix(lD + 1)
                lB = lB + bPix(lA + 2) - bPix(lD + 2)
    
                bPix(lQ) = lR \ lSize
                bPix(lQ + 1) = lG \ lSize
                bPix(lQ + 2) = lB \ lSize
    
                lQ = lQ + 4
    
                If lX <= lS Then
                    lD = lD - 4
                    lA = lA + 4
                ElseIf lX >= lZ Then
                    lA = lA - 4
                    lD = lD + 4
                Else
                    lD = lD + 4
                    lA = lA + 4
                End If
    
            Next
    
            lI = lI + lK
    
        Next
    
        lZ = lHeight - lE - 1
        lQ = 0
        
        For lX = 0 To lWidth - 1
            
            ' // Calc for -1 pix
            
            If lE Then
                lR = bPix(lI)
                lG = bPix(lI + 1)
                lB = bPix(lI + 2)
            Else
                lR = 0
                lG = 0
                lB = 0
            End If
            
            lI = lI + lK
            
            For lY = 0 To lS
    
                If lY <= lE - 2 Then
                    lR = lR + bPix(lI) * 2&
                    lG = lG + bPix(lI + 1) * 2&
                    lB = lB + bPix(lI + 2) * 2&
                Else
                    lR = lR + bPix(lI)
                    lG = lG + bPix(lI + 1)
                    lB = lB + bPix(lI + 2)
                End If
                
                lI = lI + lK
    
            Next
            
            lI = lI - (lS + 2) * lK
            lA = lI + lE * lK
            lD = lI + (lS + 1) * lK
            
            For lY = 0 To lHeight - 1
    
                lR = lR + bPix(lA) - bPix(lD)
                lG = lG + bPix(lA + 1) - bPix(lD + 1)
                lB = lB + bPix(lA + 2) - bPix(lD + 2)
                
                bPix(lQ) = ((lR \ lSize) * lFR) \ &H100
                bPix(lQ + 1) = ((lG \ lSize) * lFG) \ &H100
                bPix(lQ + 2) = ((lB \ lSize) * lFB) \ &H100
                
                lQ = lQ + lK
                
                If lY <= lS Then
                    lD = lD - lK
                    lA = lA + lK
                ElseIf lY >= lZ Then
                    lA = lA - lK
                    lD = lD + lK
                Else
                    lD = lD + lK
                    lA = lA + lK
                End If
                
            Next
            
            lI = lI + 4
            lQ = lQ + 4 - lK * lHeight
            
        Next
        
    End Sub

    ?!!!!!
    what is this ?

    [ ... active on skype and discord ... ] ,[always strive to achieve your dreams] , [always try,dont stop,never say never]

  9. #49

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    575

    Re: How to take a picture from the back of the form while the form is being displayed

    i did try more and result like as this, i created this some days ago :

    but not worked good again (not applied blurred effect bcs same old problems to we talked about it before).
    Last edited by Black_Storm; Jan 30th, 2023 at 06:12 AM.
    [ ... active on skype and discord ... ] ,[always strive to achieve your dreams] , [always try,dont stop,never say never]

  10. #50

  11. #51

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    575

    Re: How to take a picture from the back of the form while the form is being displayed

    how can fix flicker poblem about use this sample with magnifierapi.most times its work with delay display and its need run smoother :



    Two points should be considered


    - So two versions should be combined so that both the version under Windows 8 version and the version higher than 8 can be used?


    - An important question about DirectComposition for win 8 (or higher than win8) I couldn't find an example of it in VB6 by searching, can you prepare an example, of course, it seems that there are examples in other languages, but I didn't find anything like that in VB6.
    [ ... active on skype and discord ... ] ,[always strive to achieve your dreams] , [always try,dont stop,never say never]

  12. #52

  13. #53

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    575

    Re: How to take a picture from the back of the form while the form is being displayed

    its better now , thanks , possible to combine both sources in one source to suppoer from xp till more than win 8 ?
    about DirectComposition can prepare an example?
    [ ... active on skype and discord ... ] ,[always strive to achieve your dreams] , [always try,dont stop,never say never]

  14. #54
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,987

    Re: How to take a picture from the back of the form while the form is being displayed

    Quote Originally Posted by Eduardo- View Post
    Here is a attempt with blurr, it more or less works, but it is far from perfect.
    I forgot to update the background permanently (in what I've posted it just is updated when the forms is moved).
    Here it is the project updated.
    Attached Files Attached Files

  15. #55

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    575

    Re: How to take a picture from the back of the form while the form is being displayed

    i can resolve this thread but maybe we can have another chance for work with DirectComposition in vb too so i had to create new thread about using DirectComposition in vb :
    Thread: DirectComposition in vb?

    i hope to can find a sample and maybe we can use the DirectComposition about this thread too.
    [ ... active on skype and discord ... ] ,[always strive to achieve your dreams] , [always try,dont stop,never say never]

  16. #56
    New Member
    Join Date
    Jan 2023
    Posts
    2

    Re: How to take a picture from the back of the form while the form is being displayed

    If I want to hide or minimize or change the position of the form, the user will see a flashing form. Is it possible to do this without any delay in user view?

  17. #57
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,854

    Re: How to take a picture from the back of the form while the form is being displayed

    @Antonio, how is your question related to this topic?

  18. #58

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    575

    Re: How to take a picture from the back of the form while the form is being displayed

    I combined two different versions of the trick in one project to automatically call the corresponding functions after detecting the Windows version, so now it should be supported from Windows XP to Windows 10 and above, but now the problem is that if If I want to combine this project in other projects, it will be a bit more complicated. Of course, I also asked a question about this, which remained unanswered:

    Here, for example, I have asked about whether we want to use several controls or classes, each of which can have its own windowprocs.


    Thread: 2 forms moving together


    Is it possible to make a version similar to a user control or a more compact version that makes it easier to use, for example, if we have a form and want to combine the controls on it with this project, or the like, if it can be in the form of a user control which can be set on the form.
    [ ... active on skype and discord ... ] ,[always strive to achieve your dreams] , [always try,dont stop,never say never]

Page 2 of 2 FirstFirst 12

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width