Hi
I wanted to replicate google Screencapture app that you can get for the Chrome browser
Idea was to have 3 buttons on the webbrowsers frm
1. Copy & Save Visible area in Webbrowser
2. Copy & Save Highlighted area in Webbrowser
3. Copy & Save Full page in Webbrowser
Unfortunately practical the entire websites visited in the frms webbrowser control will feature dynamic content.
I got as far as getting the area of the control to the memory/clipboard
Next on the list
Convert to .jpg
Name & Save file from memory/clipboard
Import saved file/path to db
Any thoughts on Highlighted & FullPage capture?
Ta
Stewart
Quick sample attached (after capture open paint and Ctrl&V to see result)
Also code
I wanted to replicate google Screencapture app that you can get for the Chrome browser
Idea was to have 3 buttons on the webbrowsers frm
1. Copy & Save Visible area in Webbrowser
2. Copy & Save Highlighted area in Webbrowser
3. Copy & Save Full page in Webbrowser
Unfortunately practical the entire websites visited in the frms webbrowser control will feature dynamic content.
I got as far as getting the area of the control to the memory/clipboard
Next on the list
Convert to .jpg
Name & Save file from memory/clipboard
Import saved file/path to db
Any thoughts on Highlighted & FullPage capture?
Ta
Stewart
Quick sample attached (after capture open paint and Ctrl&V to see result)
Also code
PHP:
Option Compare Database
Option Explicit
'some declarations and comments for constants are from http://mvps.org/access/api/api0042.htm
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
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) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal aint As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function apiGetFocus Lib "user32" Alias "GetFocus" () As Long
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const CF_BITMAP = 2 'A handle to a bitmap (HBITMAP)
Const CF_OEMTEXT = 7 'A handle to a text
Const SRCCOPY = &HCC0020 'Copies the source rectangle directly to the destination rectangle.
Const HWND_DESKTOP As Long = 0
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90
'constants for GetSystemMetrics are from http://support.microsoft.com/kb/210603/en
Const SM_CYCAPTION = 4 ' Height of caption or title
Const SM_CXBORDER = 5 ' Width of window frame that cannot be sized
Const SM_CYBORDER = 6 ' Height of window frame that cannot be sized
Const SM_CXFRAME = 32 ' Width of window frame
Const SM_CYFRAME = 33 ' Height of window frame
Const SM_CXDLGFRAME = 7 ' Width of dialog frame window
Const SM_CYDLGFRAME = 8 ' Height of dialog frame window
Const RDW_ALLCHILDREN = &H80
Const RDW_UPDATENOW = &H100
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV = 3
Const GW_CHILD = 5
Const MAXLEN = 255
'conversion functions are from http://support.microsoft.com/kb/94927/en
Private Function TwipsPerPixelX() As Single
Dim DC As Long
DC = GetDC(HWND_DESKTOP)
TwipsPerPixelX = 1440& / GetDeviceCaps(DC, LOGPIXELSX)
ReleaseDC HWND_DESKTOP, DC
End Function
Private Function TwipsPerPixelY() As Single
Dim DC As Long
DC = GetDC(HWND_DESKTOP)
TwipsPerPixelY = 1440& / GetDeviceCaps(DC, LOGPIXELSY)
ReleaseDC HWND_DESKTOP, DC
End Function
'BitBlt understanding is from http://support.microsoft.com/kb/147810
Public Function Img2Clp(oName$, oType$) As Boolean
Dim DC As Long, CompDC As Long, BMP As Long, _
h As Long, Wdth As Long, Hght As Long, tp As Long, _
lft As Long, o As Object, isRS As Boolean, h_new As Long, h_original As Long, i%, tmp_var As Variant
If oType <> "control" Then
If oType = "form" Then
Set o = Forms(oName)
isRS = o.RecordSelectors
If isRS Then o.RecordSelectors = False
Else
Set o = Reports(oName)
End If
Wdth = o.WindowWidth / TwipsPerPixelX
Hght = o.WindowHeight / TwipsPerPixelY
Select Case o.BorderStyle
Case 1 ' thin
lft = -GetSystemMetrics(SM_CXBORDER) * 2
Wdth = Wdth - GetSystemMetrics(SM_CXBORDER)
Hght = Hght - GetSystemMetrics(SM_CYBORDER)
tp = -GetSystemMetrics(SM_CYBORDER) * 2 - GetSystemMetrics(SM_CYCAPTION)
Case 2 ' sizeable
lft = -GetSystemMetrics(SM_CXFRAME) * 1.5
Wdth = Wdth '- GetSystemMetrics(SM_CXFRAME)
Hght = Hght '- GetSystemMetrics(SM_CYFRAME)
tp = -GetSystemMetrics(SM_CYFRAME) * 1.5 - GetSystemMetrics(SM_CYCAPTION)
Case 3 ' dialog
lft = -GetSystemMetrics(SM_CXDLGFRAME)
Wdth = Wdth '- GetSystemMetrics(SM_CXDLGFRAME)
Hght = Hght '- GetSystemMetrics(SM_CYDLGFRAME)
tp = -GetSystemMetrics(SM_CYDLGFRAME) - GetSystemMetrics(SM_CYCAPTION)
End Select
If oType = "form" Then o.RecordSelectors = isRS
h = o.hwnd
Else
Set o = Screen.ActiveForm.Controls(oName)
Wdth = o.Width / TwipsPerPixelX
Hght = o.Height / TwipsPerPixelY
h = fhWnd(o)
End If
tmp_var = ListMDIWindows
For i = 0 To UBound(tmp_var)
If tmp_var(i) = h Then
h_new = tmp_var(0)
If i = UBound(tmp_var) Then
h_original = tmp_var(UBound(tmp_var))
Else
h_original = tmp_var(i - 1)
End If
End If
Next i
SetWindowPos h, h_new, lft, tp, Wdth, Hght, SWP_NOMOVE Or SWP_NOSIZE
UpdateWindow Application.hWndAccessApp
DC = GetDC(h)
CompDC = CreateCompatibleDC(DC)
BMP = CreateCompatibleBitmap(DC, Wdth, Hght)
SelectObject CompDC, BMP
BitBlt CompDC, 0&, 0&, Wdth, Hght, DC, lft, tp, SRCCOPY
OpenClipboard h
EmptyClipboard
SetClipboardData CF_BITMAP, BMP
CloseClipboard
DeleteObject BMP
DeleteDC CompDC
ReleaseDC h, DC
SetWindowPos h, h_original, lft, tp, Wdth, Hght, SWP_NOMOVE Or SWP_NOSIZE
UpdateWindow Application.hWndAccessApp
End Function
'Access main window children searching is from http://social.msdn.microsoft.com/Forums/en-US/accessdev/thread/d7492ca6-b8f7-450e-862c-b1c847fee613 by Dirk Goldgar
Private Function fGetNextWindow(ByVal hwnd As Long) As Long
fGetNextWindow = GetWindow(hwnd, GW_HWNDNEXT)
End Function
Private Function fGetClassName(hwnd As Long) As String
Dim strBuffer$, intCount%
strBuffer = String$(MAXLEN - 1, 0)
intCount = GetClassName(hwnd, strBuffer, MAXLEN)
If intCount > 0 Then
fGetClassName = Left$(strBuffer, intCount)
End If
End Function
Private Function fGetCaption(hwnd As Long) As String
Dim strBuffer$, intCount$
strBuffer = String$(MAXLEN - 1, 0)
intCount = GetWindowText(hwnd, strBuffer, MAXLEN)
If intCount > 0 Then
fGetCaption = Left$(strBuffer, intCount)
End If
End Function
Private Function ListMDIWindows() As Variant
Dim hWndAccess As Long, hWndWindow As Long, tmp_var As Variant, i%
tmp_var = Array(0)
i = 0
' Get Access application window.
hWndAccess = hWndAccessApp
' Get that window's first child.
hWndWindow = GetWindow(hWndAccess, GW_CHILD)
' Cycle through the direct children to find the MDI Client window.
Do While hWndWindow <> 0
If fGetClassName(hWndWindow) = "MDIClient" Then Exit Do
hWndWindow = fGetNextWindow(hWndWindow)
Loop
If hWndWindow = 0 Then
Debug.Print "Didn't find MDI Client!"
Else
' Get the MDI Client window's first child.
hWndWindow = GetWindow(hWndWindow, GW_CHILD)
' List this window and its children.
Do While hWndWindow <> 0
'Debug.Print hWndWindow, "Class = " & fGetClassName(hWndWindow), _
"Caption = '" & fGetCaption(hWndWindow) & "'"
tmp_var(i) = hWndWindow
i = i + 1
ReDim Preserve tmp_var(i)
hWndWindow = fGetNextWindow(hWndWindow)
Loop
End If
ListMDIWindows = tmp_var
End Function
Function fhWnd(ctl As Control) As Long
'This code sample was originally here http://access.mvps.org/access/api/api0027.htm
On Error Resume Next
ctl.SetFocus
If Err Then
fhWnd = 0
Else
fhWnd = apiGetFocus
End If
On Error GoTo 0
End Function