Re: webBrowser control

Tech-Archive recommends: Fix windows errors by optimizing your registry

For got to pase my code:
Option Explicit

'------------------------------------------------------------------------------
' This program serves as a front end to all PC Functions on the register
'------------------------------------------------------------------------------


Dim WithEvents Win As HTMLWindow2


'This is a flag to determine if we are still printing
Dim DoNotExitWeArePrinting As Boolean


'flag to indicate if the last key was a shift key
Dim LastKeyWasShift As Boolean

'flag to indicate if we are in loading a server web page for the first time
Dim bFirstTime As Boolean

'point structure for POINT
Private Type POINTAPI
x As Long
y As Long
End Type


'------------------------------------------------------------------------------
' A bunch of WIN32 constants
'------------------------------------------------------------------------------
Const SM_CXSCREEN = 0 'X Size of screen
Const SM_CYSCREEN = 1 'Y Size of Screen

Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10


'---------------------------------------------------------------------------------
' WIN32 APIS
'---------------------------------------------------------------------------------
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal
dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As
Long)
Private Declare Function GetMessageExtraInfo Lib "user32" () As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As
Long) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long)
As Long
'Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As
Long



Private Sub QuitApp()
Unload waitForm
Unload Me
End Sub
'mouse co-ordinates are from 0 to to 65,535
Private Sub ScreenToAbsolute(lpPoint As POINTAPI)
lpPoint.x = lpPoint.x * (&HFFFF& / GetSystemMetrics(SM_CXSCREEN))
lpPoint.y = lpPoint.y * (&HFFFF& / GetSystemMetrics(SM_CYSCREEN))
End Sub

Private Sub Click(p As POINTAPI)
'p.X and p.Y in absolute coordinates
'Put the mouse on the point

mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, p.x, p.y, 0,
GetMessageExtraInfo()
'Mouse Down
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, GetMessageExtraInfo()
'Mouse Up
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, GetMessageExtraInfo()


End Sub


Private Sub BringToFrontTimer_Timer()

On Error Resume Next

'kill the timer
BringToFrontTimer.Enabled = False



'-----------------------------------------------------------------------------
' Why do we need to simulate a mouse click
'
' On pressing PC function keys multiple times, this window will not be
' active
'
' The only way to give it focus is simulating a mouse click
'
' When it is simulating this click, this window MUST be the only window
' visible on the screen, if not we will run into focus problem.
' It may be clicking on the wrong window
'-----------------------------------------------------------------------------

Dim p As POINTAPI
p.x = GetSystemMetrics(SM_CXSCREEN) - 5
p.y = GetSystemMetrics(SM_CYSCREEN) - 5

'convert to mouse co-ordinates
ScreenToAbsolute p

'make this window visible - this window is initially hidden
Me.Show

'make sure message is received
DoEvents

Me.Enabled = True
DoEvents

Dim lRet As Long
lRet = BringWindowToTop(Me.hwnd)
DoEvents


'unload the wait form
Unload waitForm

'make sure this window is repainted
DoEvents

'after the click happens, we should be the active window

Click p
DoEvents



'refresh the page to get back to the original state (before the
simulated click)
'commented out, on slower machines, the refresh of the page is obvious
'MyBrowser.Refresh

SendKeys "{DOWN}{UP}", True
DoEvents

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

On Error Resume Next

'listen for Alt-F10 which is error connecting to printer
If (KeyCode = vbKeyF10) And (Shift = vbAltMask) Then
MsgBox "Error Connecting to Printer. You will not be able to print
any documents. This application will close when you click on the OK
button.", vbOKOnly
QuitApp
End If


'on a 2nd controller, we do not want to respond to Escape key
If Environ("POSWrkComputerName") <> "" Then
If (KeyCode = vbKeyEscape) Then
Exit Sub
End If

If (KeyCode = vbKeyF4) And Shift = vbAltMask Then
QuitApp
End If

End If



' Listen to the "PC Functions" key or the ESCAPE key and exit the
browser.



If (KeyCode = vbKeyEscape) Or ((KeyCode = vbKeyF10) And ((Shift And
vbShiftMask) > 0)) Then
QuitApp
End If


End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

On Error Resume Next
' Clear key on the dynakey. Clear out the current field.
If ((KeyCode = vbKeyF1) And LastKeyWasShift) Then

SendKeys ("{END}")
SendKeys ("+{HOME}")
SendKeys ("{DELETE}")

' Send a TAB event.
ElseIf ((KeyCode = vbKeyF7) And LastKeyWasShift) Then
SendKeys ("{TAB}")
End If

If (KeyCode = vbKeyShift) Then
LastKeyWasShift = True
Else
LastKeyWasShift = False
End If
End Sub

'-----------------------------------------------------------------------------
' Do initializations here
'-----------------------------------------------------------------------------
Private Sub Form_Load()

On Error GoTo ErrHandler


Me.Enabled = False


'Dim contComputerName As String

'this is the environment variable for the Controller
'contComputerName = "POSCONTCOMPUTERNAME"


'indicate that we are loading a page for the first time
bFirstTime = True


KeyPreview = True

'we are not in printing mode now
DoNotExitWeArePrinting = False


LastKeyWasShift = False


MyBrowser.Navigate2 ("http://www.google.com";)
'MyBrowser.Navigate2 ("http://172.16.135.194/backoffice/menu/menu.jsp";)


Exit Sub

ErrHandler:

'here we navigate to a a cannot find server page
MyBrowser.Navigate2 ("file://c:/custom/html/CannotFindServer.html")
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next

' if we are still printing, we display a message box telling them that
we are printing
' and blocks them from unloading by setting Cancel = true
If DoNotExitWeArePrinting Then
MsgBox "Cannot Exit, Printing In Progress!"
Cancel = True
End If
End Sub

Private Sub Form_Resize()
On Error Resume Next

' Full Screen!
MyBrowser.Width = BrowserParentWindow.Width
MyBrowser.Height = BrowserParentWindow.Height
End Sub

Private Sub MyBrowser_DocumentComplete(ByVal pDisp As Object, URL As
Variant)
On Error Resume Next
If pDisp Is MyBrowser.object Then
Set Win = pDisp.Document.parentWindow

Dim Check As String
Check = Win.Document.body.innerHTML

If InStr(1, Check, "The page cannot be displayed") Or InStr(1, Check,
"Action canceled") Then
MyBrowser.Navigate2 ("file://c:/custom/html/CannotFindServer.html")
End If

End If

If (bFirstTime) Then

bFirstTime = False
BringToFrontTimer.Enabled = True

Else
Set Win = Nothing
End If

End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
On Error Resume Next
DoNotExitWeArePrinting = False
End Sub

Private Sub Win_onafterprint()
Timer1.Enabled = True
End Sub

Private Sub Win_onbeforeprint()
On Error Resume Next
DoNotExitWeArePrinting = True
End Sub






"Big D" <BigDaddy@xxxxxxxxxxxxxxxx> wrote in message
news:OLrztlKWFHA.2700@xxxxxxxxxxxxxxxxxxxxxxx
> We run our home grown application is kiosk mode, which has back,forward,
> print buttons on required pages. We are integrating a vendors application
> that uses IE but like any typlical app use IE for the back, forward, and
> print functionality.
>
> So while trying to keep the integrity of our aplication we decided launch
> vendors application from our menu. The issue is I want to keep our
> application in kiosk and launch them in Full screen mode. Is this possible
> to change to do in IE? Second I decided to build a vb app that would
> launch address and try to use
> vb properties using the browser control. I can't seem to get the
> FullScreen mode to work. The website launches but is maximzed. i have
> played around with setting on theFull scrren but no luck.
>
>
> Any ideas how to go between screen using kiosk and Full screen.
>
>
>


.

Quantcast