#DIM ALL
#COMPILE EXE
#OPTION VERSION4
#INCLUDE "WIN32API.INC"
#INCLUDE "COMMCTRL.INC"
#INCLUDE "IEWB2.INC"' ========================================================================================
' Identifiers
' ========================================================================================
' Form1
%IDD_FORM1 = 100
%IDC_FORM1_STATUSBAR1 = 101
%IDC_FORM1_REBAR1 = 102
%IDC_FORM1_WEBBROWSER1 = 103
%IDC_FORM1_TOOLBAR1 = 104
%IDC_FORM1_EDITURL = 105
%IDC_FORM1_GOBTN = 106
' Rebar1
%IDS_STRING0 = 32770
%IDS_STRING1 = 32771
%IDS_STRING2 = 32772
' Command
%IDM_GOBACK = 28000
%IDM_GOFORWARD = 28001
%IDM_FIND = 28002
%IDM_PRINTPREVIEW = 28003
%IDM_PRINT = 28004
%IDM_PROPERTIES = 28005
%IDM_FILE_SAVE = 28006
%IDM_PAGESETUP = 28007
' ========================================================================================
' Globals
' ========================================================================================
GLOBAL ghInstance AS DWORD ' handle of the application instance
GLOBAL gdwADM_ALIGNCONTROLS AS DWORD ' identifier of registered message
' Purpose: sent to a form or panel to reposition controls with alignment
' styles after the form or panel has been resized or scrolled.
' wParam: N/A
' lParam: the low-order word is the width, and the high-order word the height of the client area
' Return: N/A
GLOBAL gdwADM_REALIGNPARTS AS DWORD ' identifier of registered message
' Purpose: posted by the parent of a status bar control to realign
' the status bar panels.
' wParam: handle of parent of statusbar
' lParam: handle of statusbar
' Return: N/A
GLOBAL gdwCookie AS DWORD ' events cookie
' ========================================================================================
' ========================================================================================
' PROCEDURE: phnxAdjustWindowRect
' PURPOSE: Adjusts the bounding rectangle of a nonresizeable window, based
' on the desired size of the client area, when a system parameter
' changes.
' ========================================================================================
FUNCTION phnxAdjustWindowRect _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL cxClient AS LONG, _ ' desired width of client area in pixels
BYVAL cyClient AS LONG _ ' desired height of client area in pixels
) AS LONG
LOCAL trc AS RECT
LOCAL trcTemp AS RECT
LOCAL hMenu AS DWORD
LOCAL dwStyle AS DWORD
LOCAL cx AS LONG
LOCAL cy AS LONG
' Calculate the height of the window taking menu wrap into account
trc.nLeft = 0
trc.nTop = 0
trc.nRight = cxClient
trc.nBottom = cyClient
hMenu = GetMenu(hWnd)
dwStyle = GetWindowLong(hWnd, %GWL_STYLE)
AdjustWindowRectEx trc, dwStyle, (hMenu <> %NULL), GetWindowLong(hWnd, %GWL_EXSTYLE)
' If there is a menu, check how much wrapping occurs when we set the window
' to the width specified by AdjustWindowRect and an infinite amount of height.
' An infinite height allows us to see every single menu wrap.
IF ISTRUE hMenu THEN
trcTemp = trc
trcTemp.nBottom = &H7FFF ' "Infinite" height
SendMessage hWnd, %WM_NCCALCSIZE, %FALSE, BYVAL VARPTR(trcTemp)
' Adjust our previous calculation to compensate for menu wrapping.
trc.nBottom = trc.nBottom + trcTemp.nTop
END IF
' AdjustWindowRectEx does not take the standard scrollbars into account
IF (dwStyle AND %WS_HSCROLL) = %WS_HSCROLL THEN
trc.nBottom = trc.nBottom + GetSystemMetrics(%SM_CYHSCROLL)
END IF
IF (dwStyle AND %WS_VSCROLL) = %WS_VSCROLL THEN
trc.nRight = trc.nRight + GetSystemMetrics(%SM_CXVSCROLL)
END IF
cx = trc.nRight - trc.nLeft
cy = trc.nBottom - trc.nTop
SetWindowPos hWnd, %NULL, 0, 0, cx, cy, %SWP_NOZORDER OR %SWP_NOMOVE OR %SWP_NOACTIVATE
END FUNCTION
' ========================================================================================
' PROCEDURE: phnxCenterWindow
' PURPOSE: Centers one window over another. It also ensures that the
' placement is within the 'working area', meaning that it is
' both within the display limits of the screen, -and- not
' obscured by the tray or other frameing elements of the
' desktop.
' ========================================================================================
FUNCTION phnxCenterWindow _
( _
BYVAL hWndChild AS DWORD, _ ' handle of window to center
BYVAL hWndParent AS DWORD _ ' handle of reference window or NULL if window is the screen
) AS LONG
LOCAL trcChild AS RECT ' Child window dimensions
LOCAL trcParent AS RECT ' Parent window dimensions
LOCAL trcWorkArea AS RECT ' Work area dimensions
LOCAL tpt AS POINTAPI ' x and y coordinate of centered window
LOCAL cxChild AS LONG ' Width of child window
LOCAL cyChild AS LONG ' Height of child window
LOCAL cxParent AS LONG ' Width of parent window
LOCAL cyParent AS LONG ' Height of parent window
LOCAL fResult AS LONG ' Return flag for SystemParametersInfo()
' Get the Height and Width of the child window
GetWindowRect hWndChild, trcChild
cxChild = trcChild.nRight - trcChild.nLeft
cyChild = trcChild.nBottom - trcChild.nTop
' Get the limits of the 'workarea'
fResult = SystemParametersInfo(%SPI_GETWORKAREA, SIZEOF(trcWorkArea), BYVAL VARPTR(trcWorkArea), 0)
IF ISFALSE(fResult) THEN
trcWorkArea.nLeft = 0
trcWorkArea.nTop = 0
trcWorkArea.nRight = GetSystemMetrics(%SM_CXSCREEN)
trcWorkArea.nBottom = GetSystemMetrics(%SM_CYSCREEN)
END IF
' Get the Height and Width of the parent window
IF ISTRUE hWndParent THEN
GetWindowRect hWndParent, trcParent
ELSE
trcParent.nLeft = trcWorkArea.nLeft
trcParent.nTop = trcWorkArea.nTop
trcParent.nRight = trcWorkArea.nRight
trcParent.nBottom = trcWorkArea.nBottom
END IF
cxParent = trcParent.nRight - trcParent.nLeft
cyParent = trcParent.nBottom - trcParent.nTop
' Calculate new X position, then adjust for workarea
tpt.x = trcParent.nLeft + ((cxParent - cxChild) \ 2)
IF (tpt.x < trcWorkArea.nLeft) THEN
tpt.x = trcWorkArea.nLeft
ELSEIF ((tpt.x + cxChild) > trcWorkArea.nRight) THEN
tpt.x = trcWorkArea.nRight - cxChild
END IF
' Calculate new Y position, then adjust for workarea
tpt.y = trcParent.nTop + ((cyParent - cyChild) \ 2)
IF (tpt.y < trcWorkArea.nTop) THEN
tpt.y = trcWorkArea.nTop
ELSEIF ((tpt.y + cyChild) > trcWorkArea.nBottom) THEN
tpt.y = trcWorkArea.nBottom - cyChild
END IF
IF (GetWindowLong(hWndChild, %GWL_STYLE) AND %WS_CHILD) = %WS_CHILD THEN
ScreenToClient hWndParent, tpt
END IF
' Reposition the window
FUNCTION = SetWindowPos(hWndChild, %NULL, tpt.x, tpt.y, 0, 0, %SWP_NOSIZE OR %SWP_NOZORDER)
END FUNCTION
' ========================================================================================
' FUNCTION: phnxGetFormHandle
' PURPOSE: Finds the handle of the top-level window or MDI child
' window that is the ancestor of the specified window. The
' reference handle is the handle of any control on the form.
' RETURNS: The handle of the form.
' ========================================================================================
FUNCTION phnxGetFormHandle _
( _
BYVAL hWnd AS DWORD _ ' reference handle
) AS DWORD
WHILE ISTRUE (GetWindowLong(hWnd, %GWL_STYLE) AND %WS_CHILD)
IF ISTRUE (GetWindowLong(hWnd, %GWL_EXSTYLE) AND %WS_EX_MDICHILD) THEN EXIT LOOP
hWnd = GetParent(hWnd)
WEND
FUNCTION = hWnd
END FUNCTION
' ========================================================================================
' PROCEDURE: RealignStatusPanels
' PURPOSE: Realigns the panels and embedded controls of the specified
' statusbar when the control is resized.
' ========================================================================================
FUNCTION RealignStatusPanels _
( _
BYVAL hWndParent AS DWORD, _ ' handle of original parent
BYVAL hWndStatus AS DWORD, _ ' handle of statusbar
BYVAL lOffsetPart AS LONG _ ' TRUE = offset last panel from size grip
) AS LONG
LOCAL trc AS RECT
LOCAL plEdge AS LONG PTR ' address of array of right edges
LOCAL plInfo AS LONG PTR
LOCAL hWndChild AS DWORD ' handle of child window
LOCAL lNumParts AS LONG
LOCAL lPartIdx AS LONG
LOCAL dx AS LONG
DIM cxBorder(2) AS LONG
' Allocate memory for the coordinate of the right edge of each panel
plEdge = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, 256 * 4)
IF ISTRUE plEdge THEN
lNumParts = SendMessage(hWndStatus, %SB_GETPARTS, 0, BYVAL 0)
IF lNumParts > 0 THEN
' Get the right edge of each panel
SendMessage hWndStatus, %SB_GETPARTS, lNumParts, BYVAL plEdge
' Get the spacing between panel
' The inter-panel spacing is in cxBorder(2)
SendMessage hWndStatus, %SB_GETBORDERS, 0, BYVAL VARPTR(cxBorder(0))
' Calculate the change in the position of the right edges
GetClientRect hWndStatus, trc
dx = trc.nRight - cxBorder(2) - @plEdge[lNumParts - 1]
IF ISTRUE lOffsetPart THEN
IF (GetWindowLong(hWndStatus, %GWL_STYLE) AND %SBARS_SIZEGRIP) = %SBARS_SIZEGRIP THEN
IF ISFALSE IsZoomed(hWndParent) THEN dx = dx - GetSystemMetrics(%SM_CXVSCROLL)
END IF
END IF
lPartIdx = 0
DO UNTIL lPartIdx >= lNumParts
@plEdge[lPartIdx] = @plEdge[lPartIdx] + dx
INCR lPartIdx
LOOP
SendMessage hWndStatus, %SB_SETPARTS, lNumParts, BYVAL plEdge
' Realign embedded controls
@plEdge[0] = hWndStatus
@plEdge[1] = dx
EnumChildWindows hWndStatus, CODEPTR(RealignStatus_ChildEnumProc), plEdge
END IF
' Free memory that was allocated for the edge info
HeapFree GetProcessHeap(), 0, BYVAL plEdge
END IF
END FUNCTION
' ========================================================================================
' TITLE: StatusBar_SetText
' DESC: Sets the text in the specified part of a status window.
' SYNTAX: StatusBar_SetText hStatus, iPart, sText
' Parameters:
' hStatus - The handle of the Status Bar control.
' iPart - Zero-based index of the part to set. If this value is 255,
' the status window is assumed to be a simple window having
' only one part.
' sText - String that specifies the text to set.
' uType - Type of drawing operation. This parameter can be one of the
' following:
'
' Value Meaning
' -------------- ----------------------------------------------------------
' 0 The text is drawn with a border to appear lower than the plane of the window.
' SBT_NOBORDERS The text is drawn without borders.
' SBT_POPOUT The text is drawn with a border to appear higher than the plane of the window.
' SBT_RTLREADING Displays text using right-to-left reading order on Hebrew or Arabic systems.
'
' Return Values:
' If the operation succeeds, the return value is TRUE.
' If the operation fails, the return value is FALSE.
'
' Remarks:
' The message invalidates the portion of the window that has changed, causing
' it to display the new text when the window next receives the WM_PAINT message.
' ========================================================================================
FUNCTION StatusBar_SetText (BYVAL hStatus AS DWORD, BYVAL iPart AS DWORD, BYVAL strText AS STRING, OPT BYVAL uType AS DWORD) AS LONG
FUNCTION = SendMessage (hStatus, %SB_SETTEXT, iPart OR uType, BYVAL STRPTR(strText))
END FUNCTION
' ========================================================================================
' IOleCommandTarget_Exec method
' Executes a specified command or displays help for a command.
' ========================================================================================
FUNCTION IOleCommandTarget_Exec (BYVAL pthis AS DWORD PTR, BYREF pguidCmdGroup AS GUID, BYVAL nCmdID AS DWORD, BYVAL nCmdexecopt AS DWORD, BYREF pvaIn AS VARIANT, BYREF pvaOut AS VARIANT) AS LONG
LOCAL HRESULT AS LONG
IF pthis = 0 THEN FUNCTION = %E_POINTER : EXIT FUNCTION
CALL DWORD @@pthis[4] USING IOleCommandTarget_Exec(pthis, pguidCmdGroup, nCmdID, nCmdexecopt, pvaIn, pvaOut) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' ========================================================================================
' ========================================================================================
' Events code iclude file
' ========================================================================================
#INCLUDE "IEWBEVT2.INC" ' WebBrowser events
' ========================================================================================
' ========================================================================================
' FUNCTION: RealignStatus_ChildEnumProc
' PURPOSE: Enumerates all embedded controls in a statusbar.
' ========================================================================================
FUNCTION RealignStatus_ChildEnumProc _
( _
BYVAL hWnd AS DWORD, _ ' handle of child window
BYVAL lParam AS LONG _ ' address of realignment info
) AS LONG
LOCAL trc AS RECT
LOCAL plEdge AS LONG PTR
LOCAL hWndStatus AS DWORD
LOCAL dx AS LONG
LOCAL x AS LONG
LOCAL y AS LONG
LOCAL cy AS LONG
plEdge = lParam
hWndStatus = @plEdge[0]
dx = @plEdge[1]
IF GetParent(hWnd) = hWndStatus THEN
' Get the bounding rectangle of the embedded control
GetWindowRect hWnd, trc
MapWindowPoints %NULL, hWndStatus, BYVAL VARPTR(trc), 2
x = trc.nLeft + dx
cy = trc.nBottom - trc.nTop
' Get the bounding rectangle of any panel
SendMessage hWndStatus, %SB_GETRECT, 0, BYVAL VARPTR(trc)
y = (trc.nTop + trc.nBottom - cy) \ 2
SetWindowPos hWnd, %NULL, x, y, 0, 0, %SWP_NOZORDER OR %SWP_NOSIZE OR %SWP_DRAWFRAME
END IF
FUNCTION = %TRUE
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_InitWindow
' PURPOSE: Initializes main window of this application instance.
' RETURN: FALSE if initialization was successful, TRUE to close the window on
' failure.
' ========================================================================================
FUNCTION Form1_InitWindow _
( _
BYVAL hWnd AS DWORD, _ ' handle of main window
BYVAL lParam AS LONG _ ' address of command line
) AS LONG
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_TranslateMessage
' PURPOSE: Preprocesses messages.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_TranslateMessage _
( _
BYVAL hWnd AS DWORD, _ ' handle of window
tmsg AS tagMsg _ ' message information
) AS LONG
' Retrieve the handle of the window that hosts the WebBrowser control
LOCAL hCtrl AS DWORD
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
' Retrieve the ancestor of the control that has the focus
LOCAL hWndCtrl AS DWORD
hWndCtrl = GetFocus
DO
IF ISFALSE GetParent(hWndCtrl) OR GetParent(hWndCtrl) = hWnd THEN EXIT DO
hWndCtrl = GetParent(hWndCtrl)
LOOP
' %WM_FORWARDMSG = &H37F
' If the focus is in the WebBrowser, forward the message to it
' IF hCtrl = GetParent(GetParent(GetParent(GetFocus))) THEN
IF hCtrl = hWndCtrl THEN
IF ISTRUE SendMessage(hCtrl, &H37F, 0, VARPTR(tmsg)) THEN FUNCTION = %TRUE
END IF
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnClose
' PURPOSE: Form1 WM_CLOSE message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnClose _
( _
BYVAL hWnd AS DWORD _ ' window handle
) AS LONG
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnCreate
' PURPOSE: Form1 WM_CREATE message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnCreate _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL lptcs AS DWORD, _ ' address of CREATESTRUCT structure
lMsgResult AS LONG _ ' value returned to message
) AS LONG
LOCAL hr AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
LOCAL dwCookie AS DWORD
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Connect to the events fired by the control
hr = DWebBrowserEvents2_ConnectEvents(ppvObj, dwCookie)
' Store the cookie in the control properties
SetProp hCtrl, "COOKIE", dwCookie
' Call the GoHome method
IWebBrowser2_GoHome ppvObj
' Release the interface
WbRelease ppvObj
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnDestroy
' PURPOSE: Form1 WM_DESTROY message handler.
' ========================================================================================
SUB Form1_OnDestroy _
( _
BYVAL hWnd AS DWORD, _ ' window handle
lMsgResult AS LONG _ ' value returned to message
)
LOCAL hr AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
LOCAL dwCookie AS DWORD
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT SUB
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT SUB
' Retrieve the events cookie
dwCookie = GetProp(hCtrl, "COOKIE")
' Disconnect events
IF dwCookie THEN hr = DWebBrowserEvents2_DisconnectEvents(ppvObj, dwCookie)
' Remove the cookie from the control
RemoveProp hCtrl, "COOKIE"
' Release the interface
WbRelease ppvObj
END SUB
' ========================================================================================
' PROCEDURE: Form1_OnQueryEndSession
' PURPOSE: Form1 WM_QUERYENDSESSION message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnQueryEndSession _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL lSource AS LONG, _ ' source of end-session request
BYVAL fLogOff AS LONG, _ ' logoff flag
lMsgResult AS LONG _ ' value returned to message
) AS LONG
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnSize
' PURPOSE: Form1 WM_SIZE message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnSize _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL lState AS LONG, _ ' resizing state
BYVAL cxClient AS LONG, _ ' width of client area
BYVAL cyClient AS LONG _ ' height of client area
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL rc AS RECT
LOCAL rbh AS LONG
LOCAL sbh AS LONG
' Height of the rebar
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_REBAR1)
GetClientRect hCtrl, rc
rbh = rc.nBottom - rc.nTop
' Height of the statusbar
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_STATUSBAR1)
GetClientRect hCtrl, rc
sbh = rc.nBottom - rc.nTop
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
MoveWindow hCtrl, 0, rbh + 1, cxClient, cyClient - rbh - sbh, %TRUE
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnPaint
' PURPOSE: Form1 WM_PAINT message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnPaint _
( _
BYVAL hWnd AS DWORD _ ' window handle
) AS LONG
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_GoBtn_Clicked
' PURPOSE: GoBtn BN_CLICKED notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_GoBtn_Clicked _
( _
BYVAL hWndParent AS DWORD, _ ' handle of parent window
BYVAL hWndCtrl AS DWORD _ ' handle of control
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL szUrl AS ASCIIZ * %INTERNET_MAX_PATH_LENGTH
LOCAL vUrl AS VARIANT
LOCAL ppvObj AS DWORD
' Get the Url
hCtrl = GetDlgItem(GetDlgItem(hWndParent, %IDC_FORM1_REBAR1), %IDC_FORM1_EDITURL)
GetWindowText hCtrl, szUrl, SIZEOF(szUrl)
vUrl = szUrl
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWndParent, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Call the Navigate2 method
IWebBrowser2_Navigate2 ppvObj, vUrl
' Release the interface
WbRelease ppvObj
FUNCTIOn = %TRUE
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnCommand
' PURPOSE: Form1 WM_COMMAND message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnCommand _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL lCtrlId AS LONG, _ ' identifier of menu item, control, or accelerator
BYVAL hWndCtrl AS DWORD, _ ' handle of control
BYVAL lNotifyCode AS LONG _ ' notification code
) AS LONG
SELECT CASE lCtrlId
' CASE %IDCANCEL
' ' Send a message to close the application
' SendMessage hWnd, %WM_CLOSE, 0, 0
' FUNCTION = %TRUE
CASE %IDOK
' If we are in the URL window, load the web page
IF GetFocus = GetDlgItem(GetDlgItem(hWnd, %IDC_FORM1_REBAR1), %IDC_FORM1_EDITURL) THEN
FUNCTION = Form1_GoBtn_Clicked(hWnd, hWndCtrl)
END IF
END SELECT
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnNotify
' PURPOSE: Form1 WM_NOTIFY message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnNotify _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL lCtrlId AS LONG, _ ' control identifier
BYVAL lptnmhdr AS DWORD, _ ' address of NMHDR structure
lMsgResult AS LONG _ ' value returned to message
) AS LONG
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnKillFocus
' PURPOSE: Form1 WM_KILLFOCUS message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnKillFocus _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL hWndNewFocus AS DWORD _ ' handle of window receiving focus
) AS LONG
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnSetFocus
' PURPOSE: Form1 WM_SETFOCUS message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnSetFocus _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL hWndOldFocus AS DWORD _ ' handle of window losing focus
) AS LONG
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_Toolbar1_GoBack
' PURPOSE: Toolbar1 IDM_GOBACK notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_Toolbar1_GoBack _
( _
BYVAL hWnd AS DWORD _ ' handle of window that owns the menu
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Call the GoBack method
IWebBrowser2_GoBack ppvObj
' Release the interface
WbRelease ppvObj
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_Toolbar1_GoForward
' PURPOSE: Toolbar1 IDM_GOFORWARD notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_Toolbar1_GoForward _
( _
BYVAL hWnd AS DWORD _ ' handle of window that owns the menu
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Call the GoForward method
IWebBrowser2_GoForward ppvObj
' Release the interface
WbRelease ppvObj
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_Toolbar1_Find
' PURPOSE: Toolbar1 IDM_FIND notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_Toolbar1_Find _
( _
BYVAL hWnd AS DWORD _ ' handle of window that owns the menu
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
LOCAL hr AS DWORD
LOCAL CGID_WebBrowser AS GUID
LOCAL ppDisp AS DWORD
LOCAL ppCmdTarget AS DWORD
LOCAL IID_IOleCommandTarget AS GUID
LOCAL pvaIn AS VARIANT
LOCAL pvaOut AS VARIANT
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Warning: This code uses an undocumented command-group GUID that is
' subject to change in the future. Currently it works in all versions of
' Internet Explorer up to 6. See http://support.microsoft.com/?kbid=311288
CGID_WebBrowser = GUID$("{ED016940-BD5B-11cf-BA4E-00C04FD70816}")
IID_IOleCommandTarget = GUID$("{b722bccb-4e68-101b-a2bc-00aa00404770}")
ppDisp = IWebBrowser2_GetDocument(ppvObj)
IF ISTRUE ppDisp THEN
ppCmdTarget = WbQueryInterface(ppDisp, IID_IOleCommandTarget)
IF ISTRUE ppCmdTarget THEN
hr = IOleCommandTarget_Exec(ppCmdTarget, CGID_WebBrowser, 1, 0, pvaIn, pvaOut)
END IF
END IF
' Release the interfaces
IF ppDisp THEN WbRelease ppDisp
IF ppCmdTarget THEN WbRelease ppCmdTarget
IF ppvObj THEN WbRelease ppvObj
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_Toolbar1_PrintPreview
' PURPOSE: Toolbar1 IDM_PRINT_PREVIEW notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_Toolbar1_PrintPreview _
( _
BYVAL hWnd AS DWORD _ ' handle of window that owns the menu
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Call the ExecWb method
IWebBrowser2_ExecWB ppvObj, %OLECMDID_PRINTPREVIEW, %OLECMDEXECOPT_PROMPTUSER
' Release the interface
WbRelease ppvObj
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_Toolbar1_PageSetup
' PURPOSE: Toolbar1 IDM_PAGESETUP notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_Toolbar1_PageSetup _
( _
BYVAL hWnd AS DWORD _ ' handle of window that owns the menu
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Call the ExecWb method
IWebBrowser2_ExecWB ppvObj, %OLECMDID_PAGESETUP, %OLECMDEXECOPT_PROMPTUSER
' Release the interface
WbRelease ppvObj
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_Toolbar1_Print
' PURPOSE: Toolbar1 IDM_PAGESETUP notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_Toolbar1_Print _
( _
BYVAL hWnd AS DWORD _ ' handle of window that owns the menu
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Call the ExecWb method
IWebBrowser2_ExecWB ppvObj, %OLECMDID_PRINT, %OLECMDEXECOPT_PROMPTUSER
' Release the interface
WbRelease ppvObj
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_Toolbar1_Properties
' PURPOSE: Toolbar1 IDM_PROPERTIES notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_Toolbar1_Properties _
( _
BYVAL hWnd AS DWORD _ ' handle of window that owns the menu
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Call the ExecWb method
IWebBrowser2_ExecWB ppvObj, %OLECMDID_PROPERTIES, %OLECMDEXECOPT_PROMPTUSER
' Release the interface
WbRelease ppvObj
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_Toolbar1_FileSave
' PURPOSE: Toolbar1 IDM_FILE_SAVE notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_Toolbar1_FileSave _
( _
BYVAL hWnd AS DWORD _ ' handle of window that owns the menu
) AS LONG
LOCAL hCtrl AS DWORD
LOCAL ppvObj AS DWORD
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hWnd, %IDC_FORM1_WEBBROWSER1)
IF ISFALSE hCtrl THEN EXIT FUNCTION
' Get the IDispatch of the control
ppvObj = WbGetInterfacePointer(hCtrl)
IF ISFALSE ppvObj THEN EXIT FUNCTION
' Call the ExecWb method
IWebBrowser2_ExecWB ppvObj, %OLECMDID_SAVEAS, %OLECMDEXECOPT_PROMPTUSER
' Release the interface
WbRelease ppvObj
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnActivate
' PURPOSE: Form1 WM_ACTIVATE message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnActivate _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL lState AS LONG, _ ' activation state
BYVAL hWndActDeact AS DWORD, _ ' handle of window being activated/deactivated
BYVAL fMinimized AS LONG _ ' minimized flag
) AS LONG
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_OnSysCommand
' PURPOSE: Form1 WM_SYSCOMMAND message handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_OnSysCommand _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL lCmdType AS LONG, _ ' type of system command requested
BYVAL x AS LONG, _ ' horizontal postion of cursor
BYVAL y AS LONG _ ' vertical position of cursor
) AS LONG
' If user has clicked the x button, send a WM_CLOSE message
IF (lCmdType AND &HFFF0) = %SC_CLOSE THEN
SendMessage hWnd, %WM_CLOSE, 0, 0
FUNCTION = %TRUE
END IF
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_EditUrl_Change
' PURPOSE: EditUrl EN_CHANGE notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_EditUrl_Change _
( _
BYVAL hWndParent AS DWORD, _ ' handle of parent window
BYVAL hWndCtrl AS DWORD _ ' handle of control
) AS LONG
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_EditUrl_SetFocus
' PURPOSE: EditUrl EN_SETFOCUS notification handler.
' RETURN: TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION Form1_EditUrl_SetFocus _
( _
BYVAL hWndParent AS DWORD, _ ' handle of parent window
BYVAL hWndCtrl AS DWORD _ ' handle of control
) AS LONG
' Select all the text of the edit box
PostMessage hWndCtrl, %EM_SETSEL, 0, -1
FUNCTION = %TRUE
END FUNCTION
' ========================================================================================
' PROCEDURE: Project1_InitApplication
' PURPOSE: Registers window classes and loads dynamic link libraries.
' RETURN: FALSE if initialization was successful, TRUE if it was not.
' ========================================================================================
FUNCTION Project1_InitApplication _
( _
BYVAL hInstance AS DWORD, _ ' handle of current instance
BYVAL pszCmdLine AS ASCIIZ PTR _ ' address of command line
) AS LONG
' Initializes ATL
AtlAxWinInit
END FUNCTION
' ========================================================================================
' PROCEDURE: Project1_UnloadInstance
' PURPOSE: Unloads dynamic link libraries and frees memory associated with
' this instance.
' ========================================================================================
SUB Project1_UnloadInstance _
( _
BYVAL hInstance AS DWORD _ ' handle of current instance
)
END SUB
' ========================================================================================
' PROCEDURE: WinMain
' PURPOSE: Program entry point, calls initialization function, processes
' message loop.
' ========================================================================================
FUNCTION WinMain _
( _
BYVAL hInstance AS DWORD, _ ' handle of current instance
BYVAL hPrevInstance AS DWORD, _ ' handle of previous instance(not used in Win32)
BYVAL pszCmdLine AS ASCIIZ PTR, _ ' address of command line
BYVAL nCmdShow AS LONG _ ' show state of window
) AS LONG
LOCAL szClassName AS ASCIIZ * %MAX_PATH ' class name
LOCAL twcx AS WNDCLASSEX ' class information
LOCAL tmsg AS tagMsg ' message information
LOCAL ticc AS INIT_COMMON_CONTROLSEX ' specifies common control classes to register
LOCAL hWnd AS DWORD ' handle of main window
LOCAL hWndModeless AS DWORD ' handle of the current active window
' Save the handle of the application instance
ghInstance = hInstance
' Register the Form1 window
szClassName = "Form1_Class"
twcx.cbSize = SIZEOF(twcx) ' size of WNDCLASSEX structure
twcx.style = %CS_DBLCLKS ' class styles
twcx.lpfnWndProc = CODEPTR(Form1_WndProc) ' address of window procedure used by class
twcx.cbClsExtra = 0 ' extra class bytes
twcx.cbWndExtra = 0 ' extra window bytes
twcx.hInstance = ghInstance ' instance of the process that is registering the window
twcx.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION) ' handle of class icon
twcx.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) ' handle of class cursor
twcx.hbrBackground = %COLOR_BTNFACE + 1 ' brush used to fill background of window's client area
twcx.lpszMenuName = %NULL ' resource identifier of the class menu
twcx.lpszClassName = VARPTR(szClassName) ' class name
twcx.hIconSm = %NULL ' handle of small icon shown in caption/system Taskbar
IF ISFALSE RegisterClassEx(twcx) THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
' Load the common controls library and
' specify the classes to register.
ticc.dwSize = SIZEOF(ticc)
ticc.dwICC = %ICC_BAR_CLASSES OR %ICC_COOL_CLASSES
InitCommonControlsEx ticc
' Register custom messages
gdwADM_ALIGNCONTROLS = RegisterWindowMessage("ADM_ALIGNCONTROLS")
gdwADM_REALIGNPARTS = RegisterWindowMessage("ADM_REALIGNPARTS")
' Perform extra application initialization
IF ISTRUE Project1_InitApplication(hInstance, BYVAL pszCmdLine) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
' Create the Form1 window
hWnd = CreateWindowEx(%WS_EX_WINDOWEDGE, _ ' extended styles
"Form1_Class", _ ' class name
"WebBrowser example", _ ' caption
%WS_OVERLAPPEDWINDOW OR %WS_VISIBLE, _ ' window styles
1, 100, _ ' left, top
700, 450, _ ' width, height
%NULL, %NULL, _ ' handle of owner, menu handle
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
' If window could not be created, return "failure"
IF ISFALSE hWnd THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
' Adjust the size of the window so that it conforms
' to the specified size of the client area
phnxAdjustWindowRect hWnd, 700, 450
' Initialize this instance of the window
IF ISTRUE Form1_InitWindow(hWnd, BYVAL pszCmdLine) THEN
SendMessage hWnd, %WM_CLOSE, 0, 0
FUNCTION = %FALSE
EXIT FUNCTION
END IF
' Center the window relative to the screen
phnxCenterWindow hWnd, %NULL
' Make the window visible; update its client area
ShowWindow hWnd, nCmdShow
UpdateWindow hWnd
' Main message loop of program.
' Acquire and dispatch messages until a WM_QUIT message is received.
WHILE ISTRUE GetMessage(tmsg, BYVAL %NULL, 0, 0)
IF ISFALSE Form1_TranslateMessage(hWnd, tmsg) THEN
hWndModeless = phnxGetFormHandle(GetFocus())
IF (ISFALSE hWndModeless) OR (ISFALSE IsDialogMessage(hWndModeless, tmsg)) THEN
TranslateMessage tmsg
DispatchMessage tmsg
END IF
END IF
WEND
' Free memory and unload dlls associated with this instance
Project1_UnloadInstance hInstance
FUNCTION = tmsg.wParam
END FUNCTION
' ========================================================================================
' PROCEDURE: Form1_WndProc
' PURPOSE: Processes messages for the Form1 window.
' ========================================================================================
FUNCTION Form1_WndProc _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL uMsg AS DWORD, _ ' type of message
BYVAL wParam AS DWORD, _ ' first message parameter
BYVAL lParam AS LONG _ ' second message parameter
) EXPORT AS LONG
LOCAL szItem AS ASCIIZ * %MAX_PATH ' working variable
LOCAL trbi AS REBARINFO ' specifies attributes(imagelist) of the rebar control
LOCAL trbbi AS REBARBANDINFO ' specifies or receives the attributes of a rebar band
LOCAL ttbb AS TBBUTTON ' specifies or receives the attributes of a toolbar button
LOCAL ttbab AS TBADDBITMAP ' specifies the images to add to a toolbar
LOCAL ptnmhdr AS NMHDR PTR ' information about a notification message
LOCAL ptttdi AS NMTTDISPINFO PTR ' tooltip notification message information
LOCAL pttbb AS TBBUTTON PTR ' address of array of toolbar button info
LOCAL plEdge AS LONG PTR ' address of array of right edges
LOCAL hWndChild AS DWORD ' handle of child window
LOCAL hWndRebar AS DWORD ' handle of rebar control
LOCAL hFont AS DWORD ' handle of font used by form
LOCAL lMsgResult AS LONG ' value returned to message after message is processed
SELECT CASE uMsg
CASE %WM_COMMAND
SELECT CASE LOWRD(wParam)
CASE %IDM_GOBACK
' If the message was processed
IF ISTRUE Form1_Toolbar1_GoBack(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %IDM_GOFORWARD
' If the message was processed
IF ISTRUE Form1_Toolbar1_GoForward(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %IDM_FIND
' If the message was processed
IF ISTRUE Form1_Toolbar1_Find(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %IDM_PRINTPREVIEW
' If the message was processed
IF ISTRUE Form1_Toolbar1_PrintPreview(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %IDM_PAGESETUP
' If the message was processed
IF ISTRUE Form1_Toolbar1_PageSetup(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %IDM_PRINT
' If the message was processed
IF ISTRUE Form1_Toolbar1_Print(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %IDM_PROPERTIES
' If the message was processed
IF ISTRUE Form1_Toolbar1_Properties(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %IDM_FILE_SAVE
' If the message was processed
IF ISTRUE Form1_Toolbar1_FileSave(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %IDC_FORM1_EDITURL
SELECT CASE HIWRD(wParam)
CASE %EN_CHANGE
' If the notification was processed
IF ISTRUE Form1_EditUrl_Change(hWnd, lParam) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %EN_SETFOCUS
' If the notification was processed
IF ISTRUE Form1_EditUrl_SetFocus(hWnd, lParam) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
END SELECT
CASE %IDC_FORM1_GOBTN
IF HIWRD(wParam) = %BN_CLICKED THEN
' If the notification was processed
IF ISTRUE Form1_GoBtn_Clicked(hWnd, lParam) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
END IF
CASE ELSE
' If the message was processed
IF ISTRUE Form1_OnCommand(hWnd, LOWRD(wParam), lParam, HIWRD(wParam)) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
END SELECT
CASE %WM_NOTIFY
ptnmhdr = lParam
SELECT CASE @ptnmhdr.code
CASE %TTN_GETDISPINFO
ptttdi = lParam
@ptttdi.hinst = %NULL
SELECT CASE @ptttdi.hdr.hwndFrom
CASE SendMessage(GetDlgItem(GetDlgItem(hWnd, %IDC_FORM1_REBAR1), %IDC_FORM1_TOOLBAR1), %TB_GETTOOLTIPS, 0, 0)
SELECT CASE @ptttdi.hdr.idFrom
CASE %IDM_GOBACK
szItem = "Go Back"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %IDM_GOFORWARD
szItem = "Go Forward"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %IDM_FIND
szItem = "Find"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %IDM_PRINTPREVIEW
szItem = "Print Preview"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %IDM_PAGESETUP
szItem = "Page Setup"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %IDM_PRINT
szItem = "Print"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %IDM_FILE_SAVE
szItem = "Save As"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %IDM_PROPERTIES
szItem = "Properties"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
END SELECT
END SELECT
END SELECT
' If the message was processed
IF ISTRUE Form1_OnNotify(hWnd, wParam, lParam, lMsgResult) THEN
FUNCTION = lMsgResult
EXIT FUNCTION
END IF
CASE %WM_SYSCOLORCHANGE
' Forward this message to common controls so that they will
' be properly updated when the user changes the color settings.
SendMessage GetDlgItem(hWnd, %IDC_FORM1_STATUSBAR1), %WM_SYSCOLORCHANGE, wParam, lParam
hWndRebar = GetDlgItem(hWnd, %IDC_FORM1_REBAR1)
SendMessage hWndRebar, %WM_SYSCOLORCHANGE, wParam, lParam
SendMessage GetDlgItem(hWndRebar, %IDC_FORM1_TOOLBAR1), %WM_SYSCOLORCHANGE, wParam, lParam
CASE %WM_ACTIVATE
' If the message was processed
IF ISTRUE Form1_OnActivate(hWnd, LOWRD(wParam), lParam, HIWRD(wParam)) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
FUNCTION = %FALSE
EXIT FUNCTION
CASE %WM_SETFOCUS
' If the message was processed
IF ISTRUE Form1_OnSetFocus(hWnd, wParam) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
' Set the keyboard focus to the first control that is
' visible, not disabled, and has the WS_TABSTOP style
SetFocus GetNextDlgTabItem(hWnd, %NULL, %FALSE)
CASE %WM_KILLFOCUS
' If the message was processed
IF ISTRUE Form1_OnKillFocus(hWnd, wParam) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %WM_CLOSE
' If the message was processed
IF ISTRUE Form1_OnClose(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %WM_QUERYENDSESSION
' If the message was processed
IF ISTRUE Form1_OnQueryEndSession(hWnd, wParam, lParam, lMsgResult) THEN
FUNCTION = lMsgResult
EXIT FUNCTION
END IF
CASE %WM_DESTROY
Form1_OnDestroy hWnd, lMsgResult
PostQuitMessage lMsgResult
FUNCTION = %FALSE
EXIT FUNCTION
CASE %WM_SIZE
IF wParam <> %SIZE_MINIMIZED THEN
' Update the size and position of aligned controls
SendMessage hWnd, gdwADM_ALIGNCONTROLS, wParam, lParam
' Realign statusbar panels
PostMessage hWnd, gdwADM_REALIGNPARTS, hWnd, GetDlgItem(hWnd, %IDC_FORM1_STATUSBAR1)
' If the message was processed
IF ISTRUE Form1_OnSize(hWnd, wParam, LOWRD(lParam), HIWRD(lParam)) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE gdwADM_ALIGNCONTROLS
' Update the size and position of aligned controls
hWndChild = GetDlgItem(hWnd, %IDC_FORM1_STATUSBAR1)
SendMessage hWndChild, %WM_SIZE, wParam, lParam
InvalidateRect hWndChild, BYVAL %NULL, %TRUE
SendMessage GetDlgItem(hWnd, %IDC_FORM1_REBAR1), %WM_SIZE, wParam, lParam
FUNCTION = %FALSE
EXIT FUNCTION
CASE gdwADM_REALIGNPARTS
' Realign the panels of statusbars
RealignStatusPanels wParam, lParam, %TRUE
InvalidateRect lParam, BYVAL %NULL, %TRUE
FUNCTION = %FALSE
EXIT FUNCTION
CASE %WM_PAINT
' If the message was processed
IF ISTRUE Form1_OnPaint(hWnd) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %WM_SYSCOMMAND
' If the message was processed
IF ISTRUE Form1_OnSysCommand(hWnd, wParam, LOINT(lParam), HIINT(lParam)) THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
CASE %WM_CREATE
' Create font used by container
hFont = GetStockObject(%DEFAULT_GUI_FONT)
' Create the Statusbar1 statusbar control
hWndChild = CreateWindowEx(%NULL, _ ' extended styles
"msctls_statusbar32", _ ' class name
"", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR _ ' window styles
%CCS_BOTTOM OR %SBARS_SIZEGRIP, _ ' class styles
0, 347, _ ' left, top
535, 23, _ ' width, height
hWnd, %IDC_FORM1_STATUSBAR1, _ ' handle of parent, control ID
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
' Allocate memory for the coordinate of the right edge of each part
plEdge = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, 1 * 4)
IF ISTRUE plEdge THEN
@plEdge[0] = 96
SendMessage hWndChild, %SB_SETPARTS, 1, BYVAL plEdge
' Free memory that was allocated for the edge info
HeapFree GetProcessHeap(), 0, BYVAL plEdge
END IF
' Update the size of the statusbar
SendMessage hWndChild, %WM_SIZE, 0, 0
' Create the WebBrowser control
hWndChild = CreateWindowEx(%NULL, _ ' extended styles
"AtlAxWin", _ ' class name
"Shell.Explorer", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR _ ' window styles
%WS_TABSTOP, _
0, 0, _ ' left, top
0, 0, _ ' width, height
hWnd, %IDC_FORM1_WEBBROWSER1, _ ' handle of parent, control ID
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
' Create the Rebar1 rebar control
hWndChild = CreateWindowEx(%NULL, _ ' extended styles
"ReBarWindow32", _ ' class name
"", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR %WS_BORDER OR _ ' window styles
%WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS OR _
%CCS_NOPARENTALIGN OR %CCS_NODIVIDER OR _ ' class styles
%RBS_VARHEIGHT OR %RBS_BANDBORDERS, _
0, 0, _ ' left, top
650, 30, _ ' width, height
hWnd, %IDC_FORM1_REBAR1, _ ' handle of parent, control ID
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
' Save the handle of the rebar. It is used when embedding controls
hWndRebar = hWndChild
SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
' Create the Toolbar1 toolbar control
hWndChild = CreateWindowEx(%NULL, _ ' extended styles
"ToolbarWindow32", _ ' class name
"", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR _ ' window styles
%CCS_NORESIZE OR %CCS_NODIVIDER OR _ ' class styles
%TBSTYLE_TOOLTIPS OR %TBSTYLE_FLAT, _
0, 4, _ ' left, top
204, 21, _ ' width, height
hWnd, %IDC_FORM1_TOOLBAR1, _ ' handle of parent, control ID
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
' Allocate memory for the button info array
pttbb = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, 8 * SIZEOF(ttbb))
IF ISTRUE pttbb THEN
' Send the TB_BUTTONSTRUCTSIZE message, for backward compatibility
SendMessage hWndChild, %TB_BUTTONSTRUCTSIZE, SIZEOF(ttbb), 0
' Add bitmaps to the internal image list
ttbab.hInst = %HINST_COMMCTRL
ttbab.nId = %IDB_STD_SMALL_COLOR
SendMessage hWndChild, %TB_ADDBITMAP, 15, BYVAL VARPTR(ttbab)
' Add buttons to the toolbar
@pttbb[0].iBitmap = %STD_UNDO
@pttbb[0].idCommand = %IDM_GOBACK
@pttbb[0].fsState = %TBSTATE_ENABLED
@pttbb[0].fsStyle = %BTNS_BUTTON
@pttbb[0].dwData = 0
@pttbb[0].iString = -1
@pttbb[1].iBitmap = %STD_REDOW
@pttbb[1].idCommand = %IDM_GOFORWARD
@pttbb[1].fsState = %TBSTATE_ENABLED
@pttbb[1].fsStyle = %BTNS_BUTTON
@pttbb[1].dwData = 0
@pttbb[1].iString = -1
@pttbb[2].iBitmap = %STD_FIND
@pttbb[2].idCommand = %IDM_FIND
@pttbb[2].fsState = %TBSTATE_ENABLED
@pttbb[2].fsStyle = %BTNS_BUTTON
@pttbb[2].dwData = 0
@pttbb[2].iString = -1
@pttbb[3].iBitmap = %STD_PRINTPRE
@pttbb[3].idCommand = %IDM_PRINTPREVIEW
@pttbb[3].fsState = %TBSTATE_ENABLED
@pttbb[3].fsStyle = %BTNS_BUTTON
@pttbb[3].dwData = 0
@pttbb[3].iString = -1
@pttbb[4].iBitmap = %STD_FILENEW
@pttbb[4].idCommand = %IDM_PAGESETUP
@pttbb[4].fsState = %TBSTATE_ENABLED
@pttbb[4].fsStyle = %BTNS_BUTTON
@pttbb[4].dwData = 0
@pttbb[4].iString = -1
@pttbb[5].iBitmap = %STD_PRINT
@pttbb[5].idCommand = %IDM_PRINT
@pttbb[5].fsState = %TBSTATE_ENABLED
@pttbb[5].fsStyle = %BTNS_BUTTON
@pttbb[5].dwData = 0
@pttbb[5].iString = -1
@pttbb[6].iBitmap = %STD_PROPERTIES
@pttbb[6].idCommand = %IDM_PROPERTIES
@pttbb[6].fsState = %TBSTATE_ENABLED
@pttbb[6].fsStyle = %BTNS_BUTTON
@pttbb[6].dwData = 0
@pttbb[6].iString = -1
@pttbb[7].iBitmap = %STD_FILESAVE
@pttbb[7].idCommand = %IDM_FILE_SAVE
@pttbb[7].fsState = %TBSTATE_ENABLED
@pttbb[7].fsStyle = %BTNS_BUTTON
@pttbb[7].dwData = 0
@pttbb[7].iString = -1
SendMessage hWndChild, %TB_ADDBUTTONS, 8, BYVAL pttbb
' Free memory that was allocated for the button info
HeapFree GetProcessHeap(), 0, BYVAL pttbb
' Update the size of the toolbar
SendMessage hWndChild, %TB_AUTOSIZE, 0, 0
END IF
' Add the band containing the Toolbar1 toolbar control to the rebar
trbbi.cbSize = SIZEOF(trbbi)
trbbi.fMask = %RBBIM_STYLE OR %RBBIM_CHILD OR %RBBIM_CHILDSIZE OR _
%RBBIM_SIZE OR %RBBIM_ID OR %RBBIM_IDEALSIZE
trbbi.fStyle = %RBBS_FIXEDSIZE OR %RBBS_CHILDEDGE
trbbi.hwndChild = hWndChild
trbbi.cxMinChild = 110
trbbi.cyMinChild = 21
trbbi.cx = 110
trbbi.wID = %IDS_STRING0
trbbi.cxIdeal = 110
SendMessage hWndRebar, %RB_INSERTBAND, -1, BYVAL VARPTR(trbbi)
' Create the EditUrl edit control
hWndChild = CreateWindowEx(%WS_EX_CLIENTEDGE, _ ' extended styles
"Edit", _ ' class name
"", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _ ' window styles
%ES_LEFT OR %ES_AUTOHSCROLL, _ ' class styles
151, 4, _ ' left, top
350, 21, _ ' width, height
hWnd, %IDC_FORM1_EDITURL, _ ' handle of parent, control ID
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
' Add the band containing the EditUrl edit control to the rebar
szItem = "URL"
trbbi.cbSize = SIZEOF(trbbi)
trbbi.fMask = %RBBIM_STYLE OR %RBBIM_TEXT OR %RBBIM_CHILD OR _
%RBBIM_CHILDSIZE OR %RBBIM_SIZE OR %RBBIM_ID OR _
%RBBIM_IDEALSIZE
trbbi.fStyle = %RBBS_FIXEDSIZE OR %RBBS_CHILDEDGE
trbbi.lpText = VARPTR(szItem)
trbbi.hwndChild = hWndChild
trbbi.cxMinChild = 350
trbbi.cyMinChild = 21
trbbi.cx = 350
trbbi.wID = %IDS_STRING1
trbbi.cxIdeal = 350
SendMessage hWndRebar, %RB_INSERTBAND, -1, BYVAL VARPTR(trbbi)
' Create the GoBtn text button
hWndChild = CreateWindowEx(%NULL, _ ' extended styles
"Button", _ ' class name
"Go", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _ ' window styles
%BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER OR _ ' class styles
%BS_FLAT, _
493, 2, _ ' left, top
34, 26, _ ' width, height
hWnd, %IDC_FORM1_GOBTN, _ ' handle of parent, control ID
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
' Add the band containing the GoBtn text button to the rebar
trbbi.cbSize = SIZEOF(trbbi)
trbbi.fMask = %RBBIM_STYLE OR %RBBIM_CHILD OR %RBBIM_CHILDSIZE OR _
%RBBIM_SIZE OR %RBBIM_ID OR %RBBIM_IDEALSIZE
trbbi.fStyle = %RBBS_FIXEDSIZE OR %RBBS_CHILDEDGE
trbbi.hwndChild = hWndChild
trbbi.cxMinChild = 34
trbbi.cyMinChild = 26
trbbi.cx = 34
trbbi.wID = %IDS_STRING2
trbbi.cxIdeal = 34
SendMessage hWndRebar, %RB_INSERTBAND, -1, BYVAL VARPTR(trbbi)
' If the message was processed
IF ISTRUE Form1_OnCreate(hWnd, lParam, lMsgResult) THEN
FUNCTION = lMsgResult
EXIT FUNCTION
END IF
FUNCTION = %FALSE
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
PowerBASIC Forums
UBBFriend: Email This Page to Someone! 
posted March 30, 2005 11:23 AM
