(example compiled with pbwin 9)
hello :)
I wanted to make an experiment if it's possible to modified josé's "mdi webbrowser" example to a new "scintilla editor" example. I have tried to integrate an old "pbscite" example for "saving file" modus. But I cannot "save file" content of scintilla editor, so there's something incomplete. the saved text file is empty.
go: 1) "file"/"new tab"
a) type in some text in new mdi tab window
then
2) "file"/"save file as".. (give name for file) but unfortunately the scintilla editor doesn't get the text
the whole (crazy) project I add here. any help would be appreciated to solve the "save file as" problem very mucho :)
example: aeb-scintilla-savefile project
'------------> Tabbrowser example modified with pbwin 9 for aeb-scintilla-editor by frank brübach, 21.sept.2011
'-------------------------------------------------------------------------------------------------------------->
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ATL.INC" ' // ATL
#INCLUDE ONCE "EXDISP.INC" ' // WebBrowser Control
#INCLUDE ONCE "COMMCTRL.INC" ' // Common controls
#INCLUDE "COMDLG32.INC"
#INCLUDE ONCE "MDI32.INC" ' // MDI wrappers
#INCLUDE ONCE "SHOBJIDL.INC" ' // Shell objects
#INCLUDE "SCINTILLAX.INC"
#RESOURCE "TabbedBrowser.pbr" ' // Resource file
'$ATLCLASSNAME = "ATLAXWIN" ' ATL class name
$PBSCITE = "PBSCITE32"
%MAX_TABCAPTION_LEN = 40 ' Maximum length of the tab caption
TYPE WNDCLASSEX
cbSize AS DWORD
STYLE AS DWORD
lpfnWndProc AS LONG
cbClsExtra AS LONG
cbWndExtra AS LONG
hInstance AS DWORD
hIcon AS DWORD
hCursor AS DWORD
hbrBackground AS DWORD
lpszMenuName AS ASCIIZ PTR
lpszClassName AS ASCIIZ PTR
hIconSm AS DWORD
END TYPE
' ========================================================================================
' Identifiers
' ========================================================================================
%IDC_EDIT = 3001
%IDC_SCIEDIT = 3002
'---------------------------->
' FILE
%IDM_INSERTFILE = 3200 ' Insert file
%IDM_NEW = 3201 ' New file
%IDM_OPEN = 3202 ' Open file
%IDM_SAVE = 3203 ' Save
%IDM_SAVEAS = 3204 ' Save As
%IDM_PRINT = 3205 ' Print file
%IDM_CLOSEFILE = 3206 ' Close file
%IDM_CLOSEALL = 3207 ' Close all files
%IDM_DOS = 3208 ' Command prompt
%IDM_EXIT = 3209 ' Exit
' EDIT
%IDM_UNDO = 3301 ' Undo
%IDM_REDO = 3302 ' Redo
%IDM_CLEAR = 3303 ' Clear
%IDM_CLEARALL = 3304 ' Clear all
%IDM_CUT = 3305 ' Cut
%IDM_COPY = 3306 ' Copy
%IDM_PASTE = 3307 ' Paste
%IDM_SELECTALL = 3308 ' Select all
%IDM_FIND = 3309 ' Find
%IDM_FINDNEXT = 3310 ' Find next
%IDM_REPLACE = 3311 ' Replace
%IDM_GOTOLINE = 3312 ' Go to line...
%IDM_CODEFINDER = 3313 ' Go to line...
%IDM_SHOWLINENUM = 3314 ' Show Line numbers
%IDM_HIDELINENUM = 3315 ' Hide Line numbers
' TOGGLE
%IDM_TOGGLE = 3401 ' Toggle sub/function
%IDM_TOGGLEALL = 3402 ' Toggle sub/function and all the subs/functions below
%IDM_FOLDALL = 3403 ' Fold all subs/functions
%IDM_EXPANDALL = 3404 ' Expand all subs/functions
' WINDOW
%IDM_TILEH = 3451 ' Tile windows horizontally
%IDM_TILEV = 3452 ' Tile windows vertically
%IDM_CASCADE = 3453 ' Cascade windows
%IDM_ARRANGE = 3454 ' Arrange icons
%IDM_CLOSE = 3455 ' Close all
' HELP
%IDM_HELP = 3501 ' Help
%IDM_ABOUT = 3502 ' About box
'---------------------------------------------------->
%IDC_STATUSBAR = 101
%IDC_REBAR = 102
%IDC_IEWB = 103
%IDC_TOOLBAR = 104
%IDC_EDITURL = 105
%IDC_GOBTN = 106
%IDC_TABMDI = 107
' Rebar1
%IDS_STRING0 = 32770
%IDS_STRING1 = 32771
%IDS_STRING2 = 32772
' Command
%ID_GOBACK = 28000
%ID_FORWARD = 28001
%ID_NEW = 28002
%ID_FIND = 28003
%ID_PRINTPREVIEW = 28004
%ID_PRINT = 28005
%ID_PROPERTIES = 28006
%ID_FILE_SAVE = 28007
%ID_PAGESETUP = 28008
%ID_REFRESH = 28009
%ID_STOP = 28010
%ID_ZOOMIN = 28011
%ID_ZOOMOUT = 28012
%ID_EXIT = 28013
%ID_CASCADE = 28014
%ID_TILEH = 28015
%ID_TILEV = 28016
%ID_ARRANGE = 28017
' Combined equates for Tab control
%TCIF_ALL = %TCIF_TEXT OR _
%TCIF_IMAGE OR _
%TCIF_RTLREADING OR _
%TCIF_PARAM OR _
%TCIF_STATE OR _
%TCIS_BUTTONPRESSED OR _
%TCIS_HIGHLIGHTED
' Image list
%IDI_INTERNET32 = 100
%IDI_INTERNET = 101
%IDI_BACK = 102
%IDI_FORWARD = 103
%IDI_NEW = 104
%IDI_FIND = 105
%IDI_PRINTPREV = 106
%IDI_PAGESETUP = 107
%IDI_PRINT = 108
%IDI_PROPERTIES = 109
%IDI_SAVE = 110
%IDI_REFRESH = 111
%IDI_STOP = 112
%IDI_ZOOMIN = 113
%IDI_ZOOMOUT = 114
%IDI_EXIT = 115
' ========================================================================================
' Globals
' ========================================================================================
GLOBAL ghTabMdi AS DWORD ' handle to document tab control
GLOBAL ghWndClient AS DWORD ' MDI main window
GLOBAL fClosed AS LONG ' Flag
GLOBAL strPBKeyWords AS STRING ' // PowerBasic keywords
GLOBAL hWndClient AS DWORD
GLOBAL hWndMain AS DWORD
GLOBAL hInst AS DWORD
GLOBAL hStatusBar AS DWORD
' ========================================================================================
' Creates a new instance of the WebBrowser control
' ========================================================================================
FUNCTION CreateWebBrowser (BYVAL hParent AS DWORD) AS DWORD
LOCAL hWndChild AS DWORD, caption AS ASCIIZ*260
' Create the WebBrowser control
hWndChild = CreateWindowEx(%NULL, _ ' extended styles
$PBSCITE, _ ' class name
caption, _ '"Shell.Explorer", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR _ ' window styles
%WS_TABSTOP, _
0, 0, _ ' left, top
0, 0, _ ' width, height
hParent, %IDC_EDIT, _ '%IDC_IEWB, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
FUNCTION = hWndChild
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the handle of the MDI active window
' ========================================================================================
FUNCTION GetActiveWbWindow() AS DWORD
'FUNCTION = GetDlgItem(MdiGetActive(ghWndClient), %IDC_IEWB)
FUNCTION = GetDlgItem(MdiGetActive(ghWndClient), %IDC_EDIT)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Using the Mdi child caption find associated Tab index and activate the associated tab.
' ========================================================================================
FUNCTION EnumMdiTitleToTab (szMdiCaption AS ASCIIZ) AS LONG
LOCAL nTab AS LONG
LOCAL ttc_item AS TCITEM
LOCAL idx AS LONG
LOCAL szTabTxt AS ASCIIZ * 256
nTab = SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0)
FOR idx = 0 TO nTab - 1
' Get tab item text string
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = VARPTR(szTabTxt)
ttc_item.cchTextMax = SIZEOF(szTabTxt)
SendMessage ghTabMdi, %TCM_GETITEM, idx, BYVAL VARPTR(ttc_item)
IF szMdiCaption = szTabTxt THEN
SendMessage ghTabMdi, %TCM_SETCURSEL, idx, 0
FUNCTION = idx
EXIT FUNCTION
END IF
NEXT
END FUNCTION
' ========================================================================================
' ========================================================================================
' Using the Tab caption find the associated Mdi Child handle and making that window the
' active document view.
' ========================================================================================
FUNCTION EnumTabToMdiHandle (BYREF szTabCaption AS ASCIIZ) AS DWORD
LOCAL hMdi AS DWORD
LOCAL szText AS ASCIIZ * %MAX_PATH
' Get the first document view handle
hMdi = GetWindow(ghWndClient, %GW_CHILD)
' Cycle thru all the open DocView windows
WHILE hMdi
' Get the document view caption text
GetWindowText hMdi, szText, %MAX_PATH
IF szText = szTabCaption THEN
' Bring the document view to the front and make it the active window
IF IsIconic(hMdi) THEN
SendMessage ghWndClient, %WM_MDIRESTORE, hMdi, 0
ELSE
SendMessage ghWndClient, %WM_MDIACTIVATE, hMdi, 0
END IF
' return handle as success
FUNCTION = hMdi
EXIT FUNCTION
END IF
hMdi = GetWindow(hMdi, %GW_HWNDNEXT)
WEND
' else return false as failure
FUNCTION = %FALSE
END FUNCTION
' ========================================================================================
' ========================================================================================
' Inserts a new Tab item.
' ========================================================================================
FUNCTION InsertTabMdiItem(BYVAL hTab AS LONG, BYVAL ITEM AS LONG, szTabText AS ASCIIZ) AS LONG
LOCAL ttc_item AS TCITEM
IF SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0) = 0 THEN
ShowWindow ghTabMdi, %SW_SHOW
END IF
' Insert a tab...
ttc_item.mask = %TCIF_ALL
ttc_item.pszText = VARPTR(szTabText)
ttc_item.cchTextMax = LEN(szTabText)
ttc_item.iImage = 0
ttc_item.lParam = 0
FUNCTION = SendMessage(hTab, %TCM_INSERTITEM, ITEM, VARPTR(ttc_item))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Using the Mdi child caption find associated Tab index and delete it
' ========================================================================================
FUNCTION EnumMdiTitleToTabRemove (szMdiCaption AS ASCIIZ) AS LONG
LOCAL nTab AS LONG
LOCAL ttc_item AS TCITEM
LOCAL szTabTxt AS ASCIIZ * 256
LOCAL idx AS LONG
LOCAL itemNext AS LONG
LOCAL hMdi AS DWORD
nTab = SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0)
IF nTab = 0 THEN FUNCTION = 0 : EXIT FUNCTION
FOR idx = 0 TO nTab-1
' Get tab item text string
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = VARPTR(szTabTxt)
ttc_item.cchTextMax = SIZEOF(szTabTxt)
SendMessage ghTabMdi, %TCM_GETITEM, idx, VARPTR(ttc_item)
IF szMdiCaption = szTabTxt THEN
' Delete this tab
SendMessage ghTabMdi, %TCM_DELETEITEM, idx, 0
' Find next available MDI docview in hiarchy and activate it...
hMdi = SendMessage(ghWndClient, %WM_MDIGETACTIVE, 0, 0)
IF ISTRUE(hMdi) THEN
' Using handle, get associated tab via caption string...
LOCAL szText AS ASCIIZ*%MAX_PATH
' Get the DocView caption text
GetWindowText hMdi, szText, %MAX_PATH
' Find the associated tab and activate it
EnumMdiTitleToTab szText
END IF
' Get and activate associated Document view
itemNext = SendMessage(ghTabMdi,%TCM_GETCURSEL,0,0)
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = VARPTR(szTabTxt)
ttc_item.cchTextMax = SIZEOF(szTabTxt)
SendMessage ghTabMdi, %TCM_GETITEM, itemNext, VARPTR(ttc_item)
EnumTabToMdiHandle szTabTxt
IF SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0) = 0 THEN
ShowWindow ghTabMdi, %SW_HIDE
END IF
' Return item next...
FUNCTION = itemNext
EXIT FUNCTION
END IF
NEXT
END FUNCTION
' ========================================================================================
' ========================================================================================
' Changes the name of the tab
' ========================================================================================
SUB SetTabName (BYVAL nTab AS LONG, BYVAL strName AS STRING)
LOCAL ttc_item AS TCITEM
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = STRPTR(strName)
ttc_item.cchTextMax = 256
SendMessage ghTabMdi, %TCM_SETITEM, nTab, BYVAL VARPTR(ttc_item)
END SUB
' ========================================================================================
' ========================================================================================
' Creates a Tab control for the Mdi GUI interface.
' ========================================================================================
FUNCTION CreateTabMdiCtl (BYVAL hWnd AS LONG, BYVAL hFont AS DWORD) AS DWORD
LOCAL rc AS RECT
LOCAL hTabImageList AS DWORD
LOCAL hIcon AS DWORD
GetWindowRect hWnd, rc
ghTabMdi = CreateWindowEx(0, "SysTabControl32","",_
%WS_CHILD OR %TCS_FOCUSNEVER OR %WS_CLIPCHILDREN _
OR %TCS_BOTTOM OR %TCS_TABS OR %TCS_SINGLELINE, _
rc.nLeft, _
rc.nTop, _
rc.nRight, _
55, _ '22, _
hWnd, %IDC_TABMDI, GetModuleHandle(""), BYVAL %NULL)
IF hFont THEN SendMessage ghTabMdi, %WM_SETFONT, hFont, %TRUE
hTabImageList = ImageList_Create(16, 16, %ILC_MASK, 2, 1)
hIcon = LoadIcon(GetModuleHandle(""), BYVAL 101)
ImageList_AddIcon hTabImageList, hIcon
DestroyIcon hIcon
SendMessage(ghTabMdi, %TCM_SETIMAGELIST, 0, hTabImageList)
FUNCTION = ghTabMdi
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
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 wcex AS WNDCLASSEX ' class information
LOCAL ticc AS INIT_COMMON_CONTROLSEX ' specifies common control classes to register
LOCAL hWndMain AS DWORD
LOCAL cxIcon AS LONG ' width of a small icon in pixels
LOCAL cyIcon AS LONG ' height of a small icon in pixels
LOCAL rc AS RECT
' Initilize the COM library using OleInitialize to allow cut and paste
OleInitialize 0
' Required: Initialize ATL
' AtlAxWinInit
InitializePbKeywords
hInst = hInstance
' Register the main window
szClassName = "TabbedBrowser"
wcex.cbSize = SIZEOF(wcex) ' size of WNDCLASSEX structure
wcex.style = %CS_DBLCLKS ' class styles
wcex.lpfnWndProc = CODEPTR(WndProc) ' address of window procedure used by class
wcex.cbClsExtra = 0 ' extra class bytes
wcex.cbWndExtra = 0 ' extra window bytes
wcex.hInstance = hInstance ' instance of the process that is registering the window
wcex.hIcon = LoadIcon(hInstance, BYVAL %IDI_INTERNET32) ' handle of class icon
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) ' handle of class cursor
wcex.hbrBackground = %COLOR_BTNFACE + 1 ' brush used to fill background of window's client area
wcex.lpszMenuName = %NULL ' resource identifier of the class menu
wcex.lpszClassName = VARPTR(szClassName) ' class name
wcex.hIconSm = LoadIcon(hInstance, BYVAL %IDI_INTERNET) ' handle of small icon shown in caption/system Taskbar
IF ISFALSE RegisterClassEx(wcex) THEN EXIT FUNCTION
' Register the windows clas for MDI windows
szClassName = "WB"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_DBLCLKS
wcex.lpfnWndProc = CODEPTR(MdiWindowProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hIcon = LoadIcon(%NULL, BYVAL %IDI_INTERNET32)
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %COLOR_WINDOW + 1
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIconSm = LoadIcon(hInstance, BYVAL %IDI_INTERNET)
IF ISFALSE RegisterClassEx(wcex) THEN EXIT FUNCTION
'----------------------------------------------------->
' Register Code Window Class
szClassName = "PBSCITE32"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW OR %CS_DBLCLKS
wcex.lpfnWndProc = CODEPTR(CodeProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 4
wcex.hInstance = hInstance
wcex.hIcon = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_IBEAM)
wcex.hbrBackground = %COLOR_WINDOW + 1
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIconSm = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)
IF ISFALSE(RegisterClassEx(wcex)) THEN
RegisterClass BYVAL (VARPTR(wcex) + 4)
END IF
' Retrieve the size of the working area
SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0
'--------------------------------------------------------------------->
' 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
' Create the Form1 window
hWndMain = CreateWindowEx(%WS_EX_WINDOWEDGE, _ ' extended styles
"TabbedBrowser", _ ' class name
"AEB_Scintilla_Editor", _ ' caption
%WS_OVERLAPPEDWINDOW OR %WS_VISIBLE, _ ' window styles
60, 60, _ ' left, top
800, 568, _ ' width, height
%NULL, %NULL, _ ' handle of owner, menu handle
hInstance, BYVAL %NULL) ' handle of instance, creation parameters
IF ISFALSE hWndMain THEN EXIT FUNCTION
' Make the window visible; update its client area
ShowWindow hWndMain, nCmdShow
UpdateWindow hWndMain
' Message handler loop
LOCAL uMsg AS tagMsg
LOCAL hWndModeless AS DWORD
WHILE GetMessage(uMsg, %NULL, 0, 0)
IF ISFALSE AtlForwardMessage(hWndMain, uMsg) THEN
hWndModeless = phnxGetFormHandle(GetFocus())
IF (ISFALSE hWndModeless) OR (ISFALSE IsDialogMessage(hWndModeless, uMsg)) THEN
TranslateMessage uMsg
DispatchMessage uMsg
END IF
END IF
WEND
' Uninitialize the COM library
OleUninitialize
FUNCTION = uMsg.wParam
END FUNCTION
' ========================================================================================
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
' ========================================================================================
' ========================================================================================
' Forwards messages to ATL
' Returns TRUE if message was processed, FALSE if it was not.
' ========================================================================================
FUNCTION AtlForwardMessage ( _
BYVAL hWnd AS DWORD, _ ' handle of window
BYREF uMsg AS tagMSG _ ' message information
) AS LONG
LOCAL hr AS LONG
LOCAL hWindow AS DWORD
LOCAL hWndCtrl AS DWORD
LOCAL szClassName AS ASCIIZ * 256
' Default return value
FUNCTION = %FALSE
' Retrieve the handle of the window that hosts the WebBrowser control
hWindow = GetFocus()
DO
hr = GetClassName(hWindow, szClassName, SIZEOF(szClassName))
IF UCASE$(szClassName) = $PBSCITE THEN '$ATLCLASSNAME
hWndCtrl = hWindow
EXIT DO
END IF
hWindow = GetParent(hWindow)
IF ISFALSE hWindow THEN EXIT DO
LOOP
' Forward the message to the control
IF ISTRUE hWndCtrl THEN '
IF ISTRUE SendMessage(hWndCtrl, &H37F, 0, VARPTR(uMsg)) THEN FUNCTION = %TRUE '%IDC_EDIT
END IF
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main Window procedure
' ========================================================================================
end of code part one ..
best regards, frank
part two of example:
copy and paste after first part.
FUNCTION 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
) 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 hCtrl 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 hImage AS DWORD ' handle of the image
LOCAL hImageList AS DWORD ' handle of the toolbar image list
' MDI
LOCAL lpNmh AS NMHDR PTR
LOCAL ttc_item AS TC_ITEM
LOCAL hMdi AS DWORD
LOCAL sel AS LONG
LOCAL szTabTxt AS ASCIIZ * 2555
LOCAL cc AS CLIENTCREATESTRUCT
' Menu
LOCAL hMenu AS DWORD
LOCAL hSubmenu AS DWORD
LOCAL hWndFirst AS DWORD
LOCAL hWndPrev AS DWORD
LOCAL hWndActive AS DWORD
STATIC hMenuWindow AS DWORD
STATIC hMenuWindow2 AS DWORD
STATIC hMenuWindow3 AS DWORD
STATIC hMenuWindow4 AS DWORD
STATIC hMenuWindow5 AS DWORD
LOCAL pIWebBrowser2 AS IWebBrowser2
LOCAL vUrl AS VARIANT
LOCAL szUrl AS ASCIIZ * 2048 ' %INTERNET_MAX_PATH_LENGTH
LOCAL nScale AS LONG
LOCAL nRange AS LONG
LOCAL vScale AS VARIANT
LOCAL vRange AS VARIANT
SELECT CASE uMsg
CASE %WM_ACTIVATE
STATIC hWndSaveFocus AS DWORD
IF LO(WORD, wParam) = %WA_INACTIVE THEN
' Save the control with the keyboard focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Set the keyboard focus to the control with
' the focus when the window was deactivated
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
EXIT FUNCTION
CASE %WM_SYSCOMMAND
' Capture this message and send a WM_CLOSE message
IF (wParam AND &HFFF0) = %SC_CLOSE THEN
SendMessage hWnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDOK
' If we are in the URL edit control, load the web page
hCtrl = GetDlgItem(GetDlgItem(hWnd, %IDC_REBAR), %IDC_EDITURL)
IF GetFocus = hCtrl THEN
PostMessage hWnd, %WM_COMMAND, %IDC_GOBTN, MAK(DWORD, %BN_CLICKED, %IDC_GOBTN)
EXIT FUNCTION
END IF
'------------------SAVE FILE ---------->
'------------------------------------->
CASE %IDM_SAVE : SAVEFILE %FALSE
CASE %IDM_SAVEAS : SAVEFILE %TRUE
'----------------------------->
'------------------SAVE FILE ---------->
CASE %ID_EXIT
SendMessage hWnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
CASE %ID_CASCADE
MdiCascade ghWndClient
EXIT FUNCTION
CASE %ID_TILEH
SendMessage(ghWndClient, %WM_MDITILE, %MDITILE_HORIZONTAL, 0)
EXIT FUNCTION
CASE %ID_TILEV
SendMessage(ghWndClient, %WM_MDITILE, %MDITILE_VERTICAL, 0)
EXIT FUNCTION
CASE %ID_ARRANGE
MdiIconArrange ghWndClient
EXIT FUNCTION
CASE %ID_NEW
' Create an MDI child
hMdi = CreateMdiChild("WB", ghWndClient, "", %WS_MAXIMIZE)
' Get the handle of the window that hosts the webbrowser
'hCtrl = GetDlgItem(hMdi, %IDC_IEWB)
hCtrl = GetDlgItem(hMdi, %IDC_EDIT)
vUrl = "about:blank"
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.Navigate2 vUrl
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %IDC_GOBTN
IF HI(WORD, wParam) = %BN_CLICKED THEN
' Get the Url
hCtrl = GetDlgItem(GetDlgItem(hWnd, %IDC_REBAR), %IDC_EDITURL)
GetWindowText hCtrl, szUrl, SIZEOF(szUrl)
vUrl = szUrl
IF ISFALSE GetActiveWbWindow THEN
' Create an MDI child
hMdi = CreateMdiChild("WB", ghWndClient, "", %WS_MAXIMIZE)
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hMdi, %IDC_EDIT)
hCtrl = GetDlgItem(hMdi, %IDC_SCIEDIT)
ELSE
' Use the active window
hCtrl = GetActiveWbWindow
END IF
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.Navigate2 vUrl
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
END IF
CASE %ID_GOBACK
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.GoBack
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_FORWARD
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.GoForward
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_FIND
' 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 7. See http://support.microsoft.com/?kbid=311288
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
LOCAL CGID_WebBrowser AS GUID
LOCAL pDisp AS IDISPATCH
LOCAL pCmdTarget AS IOleCommandTarget
LOCAL vIn AS VARIANT
LOCAL vOut AS VARIANT
CGID_WebBrowser = GUID$("{ED016940-BD5B-11CF-BA4E-00C04FD70816}")
pDisp = pIWebBrowser2.Document
IF ISOBJECT(pDisp) THEN
pCmdTarget = pDisp
IF ISOBJECT(pCmdTarget) THEN
pCmdTarget.Exec(CGID_WebBrowser, 1, 0, vIn, vOut)
END IF
END IF
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_PRINTPREVIEW
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.ExecWB %OLECMDID_PRINTPREVIEW, %OLECMDEXECOPT_PROMPTUSER
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_PAGESETUP
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.ExecWB %OLECMDID_PAGESETUP, %OLECMDEXECOPT_PROMPTUSER
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_PRINT
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.ExecWB %OLECMDID_PRINT, %OLECMDEXECOPT_PROMPTUSER
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_PROPERTIES
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.ExecWB %OLECMDID_PROPERTIES, %OLECMDEXECOPT_PROMPTUSER
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_FILE_SAVE
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.ExecWB %OLECMDID_SAVEAS, %OLECMDEXECOPT_PROMPTUSER
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_REFRESH
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.ExecWB %OLECMDID_REFRESH, %OLECMDEXECOPT_DONTPROMPTUSER
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_STOP
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
pIWebBrowser2.ExecWB %OLECMDID_STOP, %OLECMDEXECOPT_DONTPROMPTUSER
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_ZOOMIN
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
' Call the ExecWB method to get the current font zoom scale
pIWebBrowser2.ExecWB %OLECMDID_ZOOM, %OLECMDEXECOPT_DONTPROMPTUSER, BYVAL %NULL, vScale
nScale = VARIANT#(vScale)
' Call the ExecWB method to get the upper limit of zoom range (0-4).
pIWebBrowser2.ExecWB %OLECMDID_GETZOOMRANGE, %OLECMDEXECOPT_DONTPROMPTUSER, BYVAL %NULL, vRange
nRange = VARIANT#(vRange)
IF nScale < nRange THEN nScale +=1 ELSE nScale = nRange
' Call the ExecWB method to set the new font zoom scale
vScale = nScale AS LONG ' The 'AS LONG' part is important!
pIWebBrowser2.ExecWB %OLECMDID_ZOOM, %OLECMDEXECOPT_DONTPROMPTUSER, vScale
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %ID_ZOOMOUT
hCtrl = GetActiveWbWindow
pIWebBrowser2 = AtlAxGetDispatch(hCtrl)
IF ISOBJECT(pIWebBrowser2) THEN
' Call the ExecWB method to get the current font zoom scale
pIWebBrowser2.ExecWB %OLECMDID_ZOOM, %OLECMDEXECOPT_DONTPROMPTUSER, BYVAL %NULL, vScale
nScale = VARIANT#(vScale)
IF nScale > 0 THEN nScale -=1 ELSE nScale = 0
' Call the ExecWB method to set the new font zoom scale
vScale = nScale AS LONG ' The 'AS LONG' part is important!
pIWebBrowser2.ExecWB %OLECMDID_ZOOM, %OLECMDEXECOPT_DONTPROMPTUSER, vScale
pIWebBrowser2 = NOTHING
END IF
EXIT FUNCTION
CASE %IDC_EDITURL
SELECT CASE HI(WORD, wParam)
CASE %EN_SETFOCUS
' Select all the text of the edit box
PostMessage lParam, %EM_SETSEL, 0, -1
EXIT FUNCTION
END SELECT
END SELECT
CASE %WM_NOTIFY
ptnmhdr = lParam
SELECT CASE @ptnmhdr.code
CASE %TTN_GETDISPINFO
ptttdi = lParam
@ptttdi.hinst = %NULL
SELECT CASE @ptttdi.hdr.hwndFrom
hCtrl = GetDlgItem(GetDlgItem(hWnd, %IDC_REBAR), %IDC_TOOLBAR)
CASE SendMessage(hCtrl, %TB_GETTOOLTIPS, 0, 0)
SELECT CASE @ptttdi.hdr.idFrom
CASE %ID_GOBACK
szItem = "Go Back"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_FORWARD
szItem = "Go Forward"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_NEW
szItem = "New tab"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_FIND
szItem = "Find"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_PRINTPREVIEW
szItem = "Print Preview"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_PAGESETUP
szItem = "Page Setup"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_PRINT
szItem = "Print"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_PROPERTIES
szItem = "Properties"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_FILE_SAVE
szItem = "Save As"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_REFRESH
szItem = "Refresh"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_STOP
szItem = "Stop"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_ZOOMIN
szItem = "Zoom in"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_ZOOMOUT
szItem = "Zoom out"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_EXIT
szItem = "Exit"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
END SELECT
END SELECT
END SELECT
' MDI
lpNmh = lParam
SELECT CASE @lpNmh.Code ' Examine .Code member
CASE %TCN_LAST TO %TCN_FIRST ' Tab control notifications
SELECT CASE @lpNmh.idFrom
CASE %IDC_TABMDI
SELECT CASE @lpNmh.Code
CASE %TCN_SELCHANGE ' identify which tab
sel = SendMessage(ghTabMdi, %TCM_GETCURSEL, 0, 0)
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = VARPTR(szTabTxt)
ttc_item.cchTextMax = SIZEOF(szTabTxt)
SendMessage ghTabMdi, %TCM_GETITEM, sel, BYVAL VARPTR(ttc_item)
' get and activate associated Document view
hMdi = EnumTabToMdiHandle(szTabTxt)
END SELECT
END SELECT
END SELECT
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_STATUSBAR), %WM_SYSCOLORCHANGE, wParam, lParam
hWndRebar = GetDlgItem(hWnd, %IDC_REBAR)
SendMessage hWndRebar, %WM_SYSCOLORCHANGE, wParam, lParam
SendMessage GetDlgItem(hWndRebar, %IDC_TOOLBAR), %WM_SYSCOLORCHANGE, wParam, lParam
CASE %WM_SETFOCUS
' Set the keyboard focus to the first control that is
' visible, not disabled, and has the WS_TABSTOP style
SetFocus GetNextDlgTabItem(hWnd, %NULL, %FALSE)
EXIT FUNCTION
CASE %WM_CLOSE
hWndFirst = MdiGetActive(ghWndClient)
hWndActive = hWndFirst
hWndPrev = 0
DO WHILE hWndActive
IF SendMessage(MdiGetActive(ghWndClient), %WM_CLOSE, 0, 0) THEN
EXIT DO
END IF
IF fClosed THEN
IF hWndFirst = hWndActive THEN
IF hWndFirst = hWndPrev THEN
hWndFirst = 0
hWndPrev = 0
ELSE
hWndFirst = hWndPrev
END IF
END IF
ELSE
IF hWndPrev = 0 THEN
hWndPrev = hWndActive
END IF
IF hWndFirst = 0 THEN
hWndFirst = hWndActive
END IF
END IF
MdiNext ghWndClient, hWndActive, 0&
hWndActive = MdiGetActive(ghWndClient)
LOOP UNTIL hWndActive = hWndFirst
IF hWndActive THEN EXIT FUNCTION
CASE %WM_DESTROY
' Destroy the image list used by the toolbar
hCtrl = GetDlgItem(GetDlgItem(hWnd, %IDC_REBAR), %IDC_TOOLBAR)
ImageList_Destroy(SendMessage(hCtrl, %TB_SETIMAGELIST, 0, %NULL))
' Destroy the image list used by the tab control
ImageList_Destroy(SendMessage(ghTabMdi, %TCM_SETIMAGELIST, 0, %NULL))
' Quit the application
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_SIZE
IF wParam <> %SIZE_MINIMIZED THEN
LOCAL rc AS RECT
LOCAL rbh AS LONG
LOCAL sbh AS LONG
LOCAL tch AS LONG
SendMessage GetDlgItem(hWnd, %IDC_STATUSBAR), %WM_SIZE, wParam, lParam
InvalidateRect GetDlgItem(hWnd, %IDC_STATUSBAR), BYVAL %NULL, %TRUE
SendMessage GetDlgItem(hWnd, %IDC_REBAR), %WM_SIZE, wParam, lParam
' Height of the rebar
GetClientRect GetDlgItem(hWnd, %IDC_REBAR), rc
rbh = rc.nBottom - rc.nTop
' Height of the statusbar
GetClientRect GetDlgItem(hWnd, %IDC_STATUSBAR), rc
sbh = rc.nBottom - rc.nTop
' Height of the tab control
GetClientRect ghTabMdi, rc
tch = rc.nBottom - rc.nTop
' Move the tab control
MoveWindow ghTabMdi, 0, rbh + 1, LO(WORD, lParam), tch, %TRUE
' Move the MDI main window
MoveWindow ghWndClient, 0, rbh + tch + 1, LO(WORD, lParam), HI(WORD, lParam) - rbh - sbh - tch, %TRUE
EXIT FUNCTION
END IF
CASE %WM_CREATE
' Create font used by container
hFont = GetStockObject(%DEFAULT_GUI_FONT)
' Create the menu
hMenu = CreateMenu
hSubMenu = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hSubMenu, "&File"
AppendMenu hSubMenu, %MF_ENABLED, %ID_NEW, "&New Tab"
AppendMenu hSubMenu, %MF_ENABLED, %IDM_INSERTFILE, "&Insert File"
AppendMenu hSubMenu, %MF_SEPARATOR, 0, ""
AppendMenu hSubMenu, %MF_ENABLED, %IDM_OPEN, "&Open" + $TAB + "Ctrl+O"
AppendMenu hSubMenu, %MF_ENABLED, %IDM_SAVE, "&Save" + $TAB + "Ctrl+S"
AppendMenu hSubMenu, %MF_ENABLED, %IDM_SAVEAS, "Save File &As..."
AppendMenu hSubMenu, %MF_ENABLED, %IDM_CLOSEFILE, "Close" + $TAB + "Ctrl+F4"
AppendMenu hSubMenu, %MF_ENABLED, %IDM_CLOSEALL, "Close A&ll Files"
AppendMenu hSubMenu, %MF_SEPARATOR, 0, ""
AppendMenu hSubMenu, %MF_ENABLED, %IDM_PRINT, "&Print File..." + $TAB + "Ctrl+P"
AppendMenu hSubMenu, %MF_SEPARATOR, 0, ""
AppendMenu hSubMenu, %MF_ENABLED, %IDM_DOS, "Comman&d Prompt"
AppendMenu hSubMenu, %MF_SEPARATOR, 0, ""
AppendMenu hSubMenu, %MF_ENABLED, %ID_EXIT, "E&xit" + $TAB + "Alt+F4"
SetMenu hWnd, hMenu
hMenuWindow = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuWindow, "&Window"
AppendMenu hMenuWindow, %MF_ENABLED, %ID_CASCADE, "&Cascade"
AppendMenu hMenuWindow, %MF_ENABLED, %ID_TILEH, "Tile &Horizontal"
AppendMenu hMenuWindow, %MF_ENABLED, %ID_TILEV, "Tile &Vertical"
AppendMenu hMenuWindow, %MF_ENABLED, %ID_ARRANGE, "&Arrange icons"
SetMenu hWnd, hMenu
hMenuWindow2 = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuWindow2, "&Edit"
' AppendMenu hMenuWindow2, %MF_ENABLED, %ID_CASCADE, "&Batman"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_UNDO, "&Undo" + $TAB + "Ctrl+Z"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_REDO, "Re&do" + $TAB + "Ctrl+Y"
AppendMenu hMenuWindow2, %MF_SEPARATOR, 0, ""
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_CLEAR, "Clea&r"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_CLEARALL, "Cl&ear all"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_CUT, "Cu&t" + $TAB + "Ctrl+X"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_COPY, "&Copy" + $TAB + "Ctrl+C"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_PASTE, "&Paste" + $TAB + "Ctrl+V"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_SELECTALL, "Select &All" + $TAB + "Ctrl+A"
AppendMenu hMenuWindow2, %MF_SEPARATOR, 0, ""
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_FIND, "&Find" + $TAB + "Ctrl+F"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_FINDNEXT, "Find &Next" + $TAB + "F3"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_REPLACE, "R&eplace..." + $TAB + "Ctrl+R"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_GOTOLINE, "&Go to line..." + $TAB + "Ctrl+G"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_CODEFINDER, "Code Finder..." + $TAB + "F2"
AppendMenu hMenuWindow2, %MF_SEPARATOR, 0, ""
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_SHOWLINENUM, "Show line numbers"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_HIDELINENUM, "Hide line numbers"
SetMenu hWnd, hMenu
hMenuWindow3 = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuWindow3, "&Toggle"
AppendMenu hMenuWindow3, %MF_ENABLED, %IDM_TOGGLE, "&Current Sub/Function" + $TAB + "F4"
AppendMenu hMenuWindow3, %MF_ENABLED, %IDM_TOGGLEALL, "Current and all &below" + $TAB + "F5"
AppendMenu hMenuWindow3, %MF_ENABLED, %IDM_FOLDALL, "&Fold all subs/functions" + $TAB + "F6"
AppendMenu hMenuWindow3, %MF_ENABLED, %IDM_EXPANDALL, "&Expand all subs/functions" + $TAB + "F7"
SetMenu hWnd, hMenu
hMenuWindow4 = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuWindow4, "&Help"
AppendMenu hMenuWindow4, %MF_ENABLED, %IDM_HELP, "&Help" + $TAB + "F1"
AppendMenu hMenuWindow4, %MF_SEPARATOR, 0, ""
AppendMenu hMenuWindow4, %MF_ENABLED, %IDM_ABOUT, "&About..."
SetMenu hWnd, hMenu
'---------------------------->
' Create the Statusbar statusbar control
hCtrl = 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_STATUSBAR, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hCtrl, %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] = -1
SendMessage hCtrl, %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 hCtrl, %WM_SIZE, 0, 0
' Create the Rebar rebar control
hCtrl = 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
690, 30, _ ' width, height
hWnd, %IDC_REBAR, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
' Save the handle of the rebar. It is used when embedding controls
hWndRebar = hCtrl
SendMessage hCtrl, %WM_SETFONT, hFont, %TRUE
' Create the Toolbar toolbar control
hCtrl = 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_TOOLBAR, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hCtrl, %WM_SETFONT, hFont, %TRUE
' Create and initialize the image list
hImageList = ImageList_Create(16, 16, %ILC_MASK OR %ILC_COLOR24, 14, 0)
IF ISTRUE hImageList THEN
' Set the background color to use for drawing images
ImageList_SetBkColor hImageList, %CLR_NONE
' Add the images to the imagelist
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_BACK, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_FORWARD, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_NEW, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_FIND, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_PRINTPREV, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_PAGESETUP, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_PRINT, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_PROPERTIES, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_SAVE, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_REFRESH, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_STOP, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_ZOOMIN, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_ZOOMOUT, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_EXIT, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
END IF
' Set the imagelist used with default images
SendMessage hCtrl, %TB_SETIMAGELIST, 0, hImageList
' Allocate memory for the button info array
pttbb = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, 14 * SIZEOF(ttbb))
IF ISTRUE pttbb THEN
' Send the TB_BUTTONSTRUCTSIZE message, for backward compatibility
SendMessage hCtrl, %TB_BUTTONSTRUCTSIZE, SIZEOF(ttbb), 0
' Set the size of the bitmaps
SendMessage hCtrl, %TB_SETBITMAPSIZE, 0, MAKLNG(16, 16)
' Add buttons to the toolbar
@pttbb[0].iBitmap = 0
@pttbb[0].idCommand = %ID_GOBACK
@pttbb[0].fsState = %TBSTATE_ENABLED
@pttbb[0].fsStyle = %BTNS_BUTTON
@pttbb[0].dwData = 0
@pttbb[0].iString = -1
@pttbb[1].iBitmap = 1
@pttbb[1].idCommand = %ID_FORWARD
@pttbb[1].fsState = %TBSTATE_ENABLED
@pttbb[1].fsStyle = %BTNS_BUTTON
@pttbb[1].dwData = 0
@pttbb[1].iString = -1
@pttbb[2].iBitmap = 2
@pttbb[2].idCommand = %ID_NEW
@pttbb[2].fsState = %TBSTATE_ENABLED
@pttbb[2].fsStyle = %BTNS_BUTTON
@pttbb[2].dwData = 0
@pttbb[2].iString = -1
@pttbb[3].iBitmap = 3
@pttbb[3].idCommand = %ID_FIND
@pttbb[3].fsState = %TBSTATE_ENABLED
@pttbb[3].fsStyle = %BTNS_BUTTON
@pttbb[3].dwData = 0
@pttbb[3].iString = -1
@pttbb[4].iBitmap = 4
@pttbb[4].idCommand = %ID_PRINTPREVIEW
@pttbb[4].fsState = %TBSTATE_ENABLED
@pttbb[4].fsStyle = %BTNS_BUTTON
@pttbb[4].dwData = 0
@pttbb[4].iString = -1
@pttbb[5].iBitmap = 5
@pttbb[5].idCommand = %ID_PAGESETUP
@pttbb[5].fsState = %TBSTATE_ENABLED
@pttbb[5].fsStyle = %BTNS_BUTTON
@pttbb[5].dwData = 0
@pttbb[5].iString = -1
@pttbb[6].iBitmap = 6
@pttbb[6].idCommand = %ID_PRINT
@pttbb[6].fsState = %TBSTATE_ENABLED
@pttbb[6].fsStyle = %BTNS_BUTTON
@pttbb[6].dwData = 0
@pttbb[6].iString = -1
part three:
@pttbb[7].iBitmap = 7
@pttbb[7].idCommand = %ID_PROPERTIES
@pttbb[7].fsState = %TBSTATE_ENABLED
@pttbb[7].fsStyle = %BTNS_BUTTON
@pttbb[7].dwData = 0
@pttbb[7].iString = -1
@pttbb[8].iBitmap = 8
@pttbb[8].idCommand = %ID_FILE_SAVE
@pttbb[8].fsState = %TBSTATE_ENABLED
@pttbb[8].fsStyle = %BTNS_BUTTON
@pttbb[8].dwData = 0
@pttbb[8].iString = -1
@pttbb[9].iBitmap = 9
@pttbb[9].idCommand = %ID_REFRESH
@pttbb[9].fsState = %TBSTATE_ENABLED
@pttbb[9].fsStyle = %BTNS_BUTTON
@pttbb[9].dwData = 0
@pttbb[9].iString = -1
@pttbb[10].iBitmap = 10
@pttbb[10].idCommand = %ID_STOP
@pttbb[10].fsState = %TBSTATE_ENABLED
@pttbb[10].fsStyle = %BTNS_BUTTON
@pttbb[10].dwData = 0
@pttbb[10].iString = -1
@pttbb[11].iBitmap = 11
@pttbb[11].idCommand = %ID_ZOOMIN
@pttbb[11].fsState = %TBSTATE_ENABLED
@pttbb[11].fsStyle = %BTNS_BUTTON
@pttbb[11].dwData = 0
@pttbb[11].iString = -1
@pttbb[12].iBitmap = 12
@pttbb[12].idCommand = %ID_ZOOMOUT
@pttbb[12].fsState = %TBSTATE_ENABLED
@pttbb[12].fsStyle = %BTNS_BUTTON
@pttbb[12].dwData = 0
@pttbb[12].iString = -1
@pttbb[13].iBitmap = 13
@pttbb[13].idCommand = %ID_EXIT
@pttbb[13].fsState = %TBSTATE_ENABLED
@pttbb[13].fsStyle = %BTNS_BUTTON
@pttbb[13].dwData = 0
@pttbb[13].iString = -1
SendMessage hCtrl, %TB_ADDBUTTONS, 14, BYVAL pttbb
' Free memory that was allocated for the button info
HeapFree GetProcessHeap(), 0, BYVAL pttbb
' Update the size of the toolbar
SendMessage hCtrl, %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 = hCtrl
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
hCtrl = 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
251, 4, _ ' left, top
300, 21, _ ' width, height
hWnd, %IDC_EDITURL, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hCtrl, %WM_SETFONT, hFont, %TRUE
SetWindowText hCtrl, "http://www.jose.it-berater.org/index.html"
' 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 = hCtrl
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
hCtrl = CreateWindowEx(%NULL, _ ' extended styles
"Button", _ ' class name
"Go_SCI", _ ' 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, _
593, 2, _ ' left, top
50, 24, _ ' width, height
hWnd, %IDC_GOBTN, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hCtrl, %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 = hCtrl
trbbi.cxMinChild = 34
trbbi.cyMinChild = 24
trbbi.cx = 34
trbbi.wID = %IDS_STRING2
trbbi.cxIdeal = 34
SendMessage hWndRebar, %RB_INSERTBAND, -1, BYVAL VARPTR(trbbi)
' Create the tab control
ghTabMdi = CreateTabMdiCtl(hWnd, hFont)
' Create MDI Client window
cc.idFirstChild = 1
cc.hWindowMenu = hMenuWindow ' For file list in Window menu
ghWndClient = CreateWindowEx(%WS_EX_CLIENTEDGE, "MDICLIENT", BYVAL %NULL, _
%WS_CHILD OR %WS_CLIPCHILDREN OR %WS_VISIBLE OR %WS_VSCROLL OR %WS_HSCROLL, _
0, 0, 0, 0, hWnd, &H0CAC, GetModuleHandle(""), cc)
END SELECT
FUNCTION = DefFrameProc(hWnd, ghWndClient, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' MDI window callback
' ========================================================================================
FUNCTION MdiWindowProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL hr AS LONG
LOCAL nTab AS LONG
LOCAL rc AS RECT
LOCAL szText AS ASCIIZ * 255
LOCAL hWB AS DWORD
LOCAL pIWebBrowser2 AS IWebBrowser2
LOCAL pWBEvents AS DWebBrowserEvents2Impl
LOCAL dwCookie AS DWORD
SELECT CASE wMsg
CASE %WM_CREATE
GetClientRect hWnd, rc
' Create an instance of the WebBrowser control
hWB = CreateWebBrowser(hWnd)
' Get the IDispatch of the control
pIWebBrowser2 = AtlAxGetDispatch(hWB)
IF ISOBJECT(pIWebBrowser2) THEN
' Connect to the events fired by the control
pWBEvents = CLASS "CDWebBrowserEvents2"
IF ISOBJECT(pWBEvents) THEN
EVENTS FROM pIWebBrowser2 CALL pWBEvents
' Store the cookie in the control properties
pWBEvents.AddRef ' Increment the reference count
dwCookie = OBJPTR(pWBEvents)
SetProp hWB, "COOKIE", dwCookie
pWBEvents = NOTHING
END IF
' Release the interface
pIWebBrowser2 = NOTHING
END IF
' Increase the tab number and set the caption
' Insert new tab
nTab = SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0)
'szText = FORMAT$(nTab + 1, "000")
'SetWindowText(hWnd, szText)
InsertTabMdiItem(ghTabMdi, nTab + 1, szText)
' Set it as the current selection on the tab control
SendMessage(ghTabMdi, %TCM_SETCURSEL, nTab, 0)
CASE %WM_SIZE
MoveWindow GetDlgItem(hWnd, %IDC_EDIT), 0, 0, LOWRD(lParam), HIWRD(lParam), %TRUE
MoveWindow GetDlgItem(hWnd, %IDC_SCIEDIT), 0, 0, LOWRD(lParam), HIWRD(lParam), %TRUE
CASE %WM_SETFOCUS
SetFocus GetActiveWbWindow
CASE %WM_MDIACTIVATE
' Using handle, get associated tab via caption string
' Get the caption text of the window
GetWindowText(lParam, szText, %MAX_PATH)
' Find the associated tab and activate it
EnumMdiTitleToTab(szText)
SetFocus GetActiveWbWindow
CASE %WM_DESTROY
' Get the handle of the window that hosts the control
hWB = GetDlgItem(hWnd, %IDC_EDIT)
' Disconnect events and remove property
IF ISTRUE hWB THEN
' Get the IDispatch of the control
pIWebBrowser2 = AtlAxGetDispatch(hWB)
IF ISOBJECT(pIWebBrowser2) THEN
' Retrieve the events cookie
dwCookie = GetProp(hWB, "COOKIE")
IF dwCookie THEN
POKE DWORD, VARPTR(pWBEvents), dwCookie
' Disconnect events
IF ISOBJECT(pWBEvents) THEN
EVENTS END pWBEvents
pWBEvents = NOTHING
END IF
END IF
' Remove the cookie from the control
RemoveProp hWB, "COOKIE"
END IF
END IF
' Remove Tab associated with this window
GetWindowText(hWnd, szText, SIZEOF(szText))
nTab = EnumMdiTitleToTabRemove(szText)
END SELECT
FUNCTION = DefMDIChildProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
part four (end):
' =====================================================================================
METHOD SetPhishingFilterStatus <282> ( _
BYVAL PhishingFilterStatus AS LONG _ ' [0] [in] PhishingFilterStatus /* VT_I4 <Long> */
) ' VOID
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD WindowStateChanged <283> ( _
BYVAL dwWindowStateFlags AS DWORD _ ' [0] [in] dwWindowStateFlags /* VT_UI4 <Dword> */
, BYVAL dwValidFlagsMask AS DWORD _ ' [0] [in] dwValidFlagsMask /* VT_UI4 <Dword> */
) ' VOID
' *** Insert your code here ***
END METHOD
' =====================================================================================
END INTERFACE
END CLASS
' ========================================================================================
' *********************************************************************************************
' Set Scintilla Edit Control's options
' *********************************************************************************************
SUB Scintilla_SetOptions (BYVAL pSciWndData AS DWORD)
LOCAL i AS LONG
LOCAL strDemoCode AS STRING
LOCAL szFont AS ASCIIZ * 33
LOCAL szKey AS ASCIIZ * 255
LOCAL szValue AS ASCIIZ * 255
' Set the default style
szFont = "FixedSys"
SciMsg pSciWndData, %SCI_STYLESETFONT, %STYLE_DEFAULT, VARPTR(szFont)
SciMsg pSciWndData, %SCI_STYLESETSIZE, %STYLE_DEFAULT, 9
SciMsg pSciWndData, %SCI_STYLESETCASE, %STYLE_DEFAULT, %SC_CASE_MIXED
' Set indentation guides
SciMsg pSciWndData, %SCI_SETINDENTATIONGUIDES, %TRUE, 0
SciMsg pSciWndData, %SCI_SETTABWIDTH, 3, 0
SciMsg pSciWndData, %SCI_SETINDENT, 3, 0
' Set all the other styles to the default
SciMsg pSciWndData, %SCI_STYLECLEARALL, 0, 0
' Set the font for the line numbers
szFont = "Arial"
SciMsg pSciWndData, %SCI_STYLESETFONT, %STYLE_LINENUMBER, VARPTR(szFont)
' Enable folding of the procedures and functions
szKey = "fold" : szValue = "1"
SciMsg pSciWndData, %SCI_SETPROPERTY, VARPTR(szKey), VARPTR(szValue)
' Set default color to black
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_DEFAULT, RGB(0, 0, 0)
' Set comments style (1) to Verdana an italic (size: 10 points) and green color
' szFont = "Verdana"
' SciMsg pSciWndData, %SCI_STYLESETFONT, %SCE_B_COMMENT, VARPTR(szFont)
' SciMsg pSciWndData, %SCI_STYLESETSIZE, %SCE_B_COMMENT, 10
' SciMsg pSciWndData, %SCI_STYLESETITALIC, %SCE_B_COMMENT, %TRUE
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_COMMENT, RGB(0, 128, 0)
' Set style 3 (keywords) to upper case and blue color
SciMsg pSciWndData, %SCI_STYLESETCASE, %SCE_B_KEYWORD, %TRUE
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_KEYWORD, RGB(0, 0, 255)
' Set color for strings to violet
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_STRING, RGB(255, 0, 255)
' Set color for identifiers to black
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_IDENTIFIER, RGB(0, 0, 0)
' Set color for numbers to brown
SciMsg pSciWndData,%SCI_STYLESETFORE,%SCE_B_NUMBER,RGB(192,100,0) 'brown
' Set color for oprators
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_OPERATOR, RGB(0, 128, 128)
' Set edge column and mode
SciMsg pSciWndData, %SCI_SETEDGECOLUMN, 255, 0
SciMsg pSciWndData, %SCI_SETEDGEMODE, %EDGE_LINE, 0
' Margin 0 for numbers
SciMsg pSciWndData, %SCI_SETMARGINTYPEN, 0, %SC_MARGIN_NUMBER
SciMsg pSciWndData, %SCI_SETMARGINWIDTHN, 0, 50
' Margin 1 for symbols
SciMsg pSciWndData, %SCI_SETMARGINMASKN, 1, %SC_MASK_FOLDERS
'Margin 1: Send WM_NOTIFY after mouse clicks
SciMsg pSciWndData, %SCI_SETMARGINSENSITIVEN, 1, 1
' Set PowerBasic lexer
SciMsg pSciWndData, %SCI_SETLEXER, %SCLEX_PB, 0
' Set PB Keywords
SciMsg pSciWndData, %SCI_SETKEYWORDS, 0, BYVAL STRPTR(strPbKeyWords)
END SUB
' *********************************************************************************************
' *********************************************************************************************
' Save file procedure
' *********************************************************************************************
SUB SAVEFILE (BYVAL Ask AS LONG)
LOCAL PATH AS STRING
LOCAL f AS STRING
LOCAL STYLE AS DWORD
LOCAL nFile AS DWORD
LOCAL Buffer AS STRING
LOCAL szText AS ASCIIZ * 255
LOCAL nLen AS LONG
GetWindowText MdiGetActive(hWndClient), szText, SIZEOF(szText)
IF INSTR(szText, ANY ":\/") = 0 THEN ' if no path, it's a new doc
PATH = CURDIR$
IF RIGHT$(PATH, 1) <> "\" THEN PATH = PATH + "\"
IF LEFT$(UCASE$(szText), 8) = "UNTITLED" AND INSTR(szText, ".") = 0 THEN
f = szText & ".BAS"
ELSE
f = szText
END IF
Ask = %TRUE ' we need the dialog for new docs
ELSE
PATH = PATHNAME$(PATH, szText)
f = PATHNAME$(NAMEX, szText)
'PATH = GetFilePath(szText)
'f = GetFileName(szText)
END IF
STYLE = %OFN_HIDEREADONLY OR %OFN_LONGNAMES
IF ISTRUE(Ask) THEN
IF ISFALSE(SaveFileDialog(hWndMain, "Save File", f, PATH, _
"Text Files|*.txt|All Files|*.*", "txt", STYLE)) THEN
EXIT SUB
END IF
END IF
nFile = FREEFILE
OPEN f FOR BINARY AS nFile
Buffer = SPACE$(GetWindowTextLength(GetEdit) + 1)
GetWindowText GetEdit, BYVAL STRPTR(Buffer), LEN(Buffer)
PUT$ nFile, LEFT$(Buffer, LEN(Buffer) - 1) 'UCODE$
SETEOF nFile
CLOSE nFile
SetWindowText MdiGetActive(hWndClient), BYVAL STRPTR(f)
MSGBOX buffer
' Tell to Scintilla that the current state of the document is unmodified.
SendMessage GetEdit, %SCI_SETSAVEPOINT, 0, 0
END SUB
' *********************************************************************************************
FUNCTION CodeProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
' This handles messages for the MDI child windows.
LOCAL hEdit AS DWORD
LOCAL nFile AS LONG
LOCAL Buffer AS STRING
LOCAL RetVal AS LONG
LOCAL pSciData AS DWORD
LOCAL pNmh AS NMHDR PTR ' // Address of a NMHDR structure
LOCAL pNSC AS SCNotification PTR ' // Scintilla notification messages structure
LOCAL LineNumber AS LONG ' // Line number
LOCAL curPos AS LONG ' // Current position
LOCAL LineLen AS LONG ' // Line length
LOCAL IndentSize AS LONG ' // Size of the indent
LOCAL TabSize AS LONG ' // Tab size
LOCAL nSpaces AS LONG
LOCAL strFill AS STRING
LOCAL i AS LONG
STATIC rc AS RECT
STATIC szText AS ASCIIZ * %MAX_PATH
SELECT CASE wMsg
CASE %WM_CREATE
GetClientRect hWnd, rc
hEdit = CreateWindowEx(%WS_EX_CLIENTEDGE, "Scintilla", BYVAL %NULL, %WS_CHILD OR %WS_VISIBLE OR _
%ES_MULTILINE OR %WS_VSCROLL OR %WS_HSCROLL OR _
%ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR %ES_NOHIDESEL, _
0, 0, 0, 0, hWnd, %IDC_EDIT, hInst, BYVAL %NULL)
pSciData = SendMessage(hEdit, %SCI_GETDIRECTPOINTER, 0, 0)
IF pSciData THEN Scintilla_SetOptions pSciData
GetWindowText hWnd, szText, SIZEOF(szText)
IF LEN(szText) THEN
nFile = FREEFILE
OPEN szText FOR BINARY AS nFile
GET$ nFile, LOF(nFile), Buffer
CLOSE nFile
' Put the text in the edit control
SendMessage hEdit, %SCI_INSERTTEXT, 0, BYVAL STRPTR(Buffer)
' Tell to Scintilla that the current state of the document is unmodified.
SendMessage hEdit, %SCI_SETSAVEPOINT, 0, 0
ELSE
SetWindowText hWnd, "Untitled"
END IF
CASE %WM_SIZE
MoveWindow GetDlgItem(hWnd, %IDC_EDIT), 0, 0, LOWRD(lParam), HIWRD(lParam), %TRUE
CASE %WM_SETFOCUS
SetFocus GetEdit
ShowLinCol ' Show line and column
CASE %WM_CLOSE
IF ISTRUE SendMessage(GetEdit, %SCI_GETMODIFY, 0, 0) THEN
GetWindowText hWnd, szText, SIZEOF(szText)
RetVal = MessageBox(BYVAL hWnd, " Save current changes? " & GetFileName(szText), _
" PBSCITE", %MB_YESNO OR %MB_ICONEXCLAMATION OR %MB_APPLMODAL)
IF RetVal = %IDCANCEL THEN
fClosed = %FALSE
EXIT FUNCTION
ELSE
fClosed = %TRUE
IF RetVal = %IDYES THEN
SAVEFILE %FALSE
END IF
END IF
ELSE
fClosed = %TRUE
END IF
CASE %WM_NOTIFY
' Process the Scintilla Edit Control notification messges
IF LOWRD(wParam) = %IDC_EDIT THEN
pNSC = lParam
SELECT CASE @pNSC.hdr.code
CASE %SCN_UPDATEUI : ShowLinCol ' Show line and column
CASE %SCN_MARGINCLICK ' Margin mouse click
IF @pNSC.margin = 2 THEN ' Folder margin
LineNumber = SendMessage(GetEdit, %SCI_LINEFROMPOSITION, @pNSC.position, 0)
ToggleFolding LineNumber
END IF
CASE %SCN_CHARADDED
' Auto indentation - since SCN_KEY isn't send in the Windows version,
' we detect the new line if the charadded is a carriage return
IF @pNSC.ch = 13 THEN ' carriage return
curPos = SendMessage(GetEdit, %SCI_GETCURRENTPOS, 0, 0) ' current position
LineNumber = SendMessage(GetEdit, %SCI_LINEFROMPOSITION, curPos, 0) ' line number
LineLen = SendMessage(GetEdit, %SCI_LINELENGTH, LineNumber - 1, 0) ' length of the line
buffer = SPACE$(LineLen) ' size the buffer
SendMessage(GetEdit, %SCI_GETLINE, LineNumber - 1, STRPTR(buffer)) ' get the text of the line
TabSize = SendMessage(GetEdit, %SCI_GETTABWIDTH, 0, 0) ' size of the tab
nSpaces = 0 ' number of spaces on the left
FOR i = 1 TO LEN(buffer)
IF MID$(buffer, i, 1) <> " " THEN
IF MID$(buffer, i, 1) = $TAB THEN
nSpaces = nSpaces + TabSize
ELSE
EXIT FOR
END IF
ELSE
nSpaces = nSpaces + 1
END IF
NEXT
buffer = REMOVE$(buffer, ANY CHR$(13, 10)) ' removes $CRLF
buffer = TRIM$(UCASE$(buffer), ANY CHR$(32, 9)) ' removes spaces and tabs and converts to uppercase
IF (LEFT$(buffer, 3) = "IF " AND RIGHT$(buffer, 5) = " THEN") OR _
LEFT$(buffer, 4) = "ELSE" OR _
LEFT$(buffer, 7) = "SELECT " OR _
LEFT$(buffer, 5) = "CASE " OR _
LEFT$(buffer, 4) = "FOR " OR _
LEFT$(buffer, 3) = "DO " OR _
buffer = "DO" OR _
LEFT$(buffer, 6) = "WHILE " OR _
buffer = "WHILE" THEN
IndentSize = SendMessage(GetEdit, %SCI_GETINDENT, 0, 0) ' size of the indent
strFill = SPACE$(nSpaces + IndentSize) ' add spaces to indent the line
ELSE
strFill = SPACE$(nSpaces) ' add the same spaces on the left that the line above
END IF
SendMessage(GetEdit, %SCI_ADDTEXT, LEN(strFill), STRPTR(strFill)) ' indents the line
END IF
END SELECT
END IF
END SELECT
FUNCTION = DefMDIChildProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
FUNCTION GetEdit() AS LONG
FUNCTION = GetDlgItem(MdiGetActive(hWndClient), %IDC_EDIT)
END FUNCTION
FUNCTION GetFileName (BYVAL Src AS STRING) AS STRING
LOCAL x AS LONG
x = INSTR(-1, Src, ANY ":/\")
IF x THEN
FUNCTION = MID$(Src, x + 1)
ELSE
FUNCTION = Src
END IF
END FUNCTION
FUNCTION GetFilePath (BYVAL Src AS STRING) AS STRING
LOCAL x AS LONG
x = INSTR(-1, Src, ANY ":\/")
IF x THEN
FUNCTION = LEFT$(Src, x)
END IF
END FUNCTION
SUB ShowLinCol
LOCAL curPos AS LONG
LOCAL nLine AS LONG
LOCAL nCol AS LONG
LOCAL nLines AS LONG
LOCAL nTextLen AS LONG
LOCAL szText AS ASCIIZ * 255
curPos = SendMessage(GetEdit, %SCI_GETCURRENTPOS, 0, 0)
nLine = SendMessage(GetEdit, %SCI_LINEFROMPOSITION, curPos, 0) + 1
nCol = SendMEssage(GetEdit, %SCI_GETCOLUMN, curPos, 0) + 1
szText = " " & FORMAT$(nLine) & ":" & FORMAT$(nCol)
SendMessage hStatusbar, %SB_SETTEXT, 1, VARPTR(szText)
nLines = SendMessage(GetEdit, %SCI_GETLINECOUNT, 0, 0)
nTextLen = SendMessage(GetEdit, %SCI_GETTEXTLENGTH, 0, 0)
szText = " " & FORMAT$(nLines) & " lines, " & FORMAT$(nTextLen) & " characters"
SendMessage hStatusbar, %SB_SETTEXT, 2, VARPTR(szText)
END SUB
FUNCTION ToggleFolding (BYVAL LineNumber AS LONG) AS LONG
LOCAL hEdit AS DWORD
LOCAL pSciWndData AS DWORD
hEdit = GetEdit
' Get direct pointer for faster access
pSciWndData = SendMessage(hEdit, %SCI_GETDIRECTPOINTER, 0, 0)
IF ISFALSE pSciWndData THEN EXIT FUNCTION
IF (SciMsg(pSciWndData, %SCI_GETFOLDLEVEL, LineNumber, 0) AND %SC_FOLDLEVELHEADERFLAG) = 0 THEN ' If is not the head line...
LineNumber = SciMsg(pSciWndData, %SCI_GETFOLDPARENT, LineNumber, 0) ' Get the number of the head line of the procedure or function
END IF
SciMsg pSciWndData, %SCI_TOGGLEFOLD, LineNumber, 0 ' Toggle the sub or function
SciMsg pSciWndData, %SCI_GOTOLINE, LineNumber, 0 ' Set the caret position
FUNCTION = LineNumber ' Return the current line
END FUNCTION
SUB InitializePbKeywords
strPBKeyWords = "def bloat compile debug dim if include option pbforms register resource stack tools " & _
"abs accel accept access acode acode$ add addr alias all and any append array " & _
"arrayattr as asc ascend asciz asciiz asm at atn attach attrib bar base baud bdecl beep bin bin$ " & _
"binary bit bits break button bycmd bycopy byref byte byval calc call callback callstk callstk$ " & _
"callstkcount case catch cbctl cbctlmsg cbhndl cblparam cbmsg cbwparam cbyt ccur ccux " & _
"cd cdbl cdecl cdwd ceil cext chdir chdrive check check3state checkbox choose chr chr$ cint " & _
"client clng close cls clsid clsid$ codeptr collate color combobox comm command con connect const " & _
"control cos cqud create cset cset$ csng ctsflow cur curdir curdir$ currency currencyx cux cvbyt cvcur " & _
"cvcux cvd cvdwd cve cvi cvl cvq cvs cvwrd cwrd data datacount date date$ declare decr default " & _
"defbyt decur defcux defdbl defdwd defext defint deflng defqud defsng defstr defwrd delete " & _
"descend dialog dir dir$ disable diskfree disksize dispatch dll dllmain descend dllmain " & _
"do doevents double down draw dsrflow dsrsens strflow dtrline dword empty enable end environ environ$ " & _
"eof eqv erase err errapi errclear error error$ exe exit exp exp10 exp2 explicit export ext " & _
"extended extract extract$ fileattr filecopy GetFileNamee GetFileNamee$ filescan fill finally fix flow flush focus " & _
"font for format format$ formfeed frac frame freefile from function funcname funcname$ get get$ getattr global " & _
"gosub goto guid guid$ guidtxt guidtxt$ handle hex hex$ hibyt hiint hiwrd host icase icon idn iface iif iif$ " & _
"image imagex imgbutton imgbuttonx imp in incr inp inout input input# inputbox inputbox$ insert instr int " & _
"interface integer inv isfalse isnothing isobject istrue iterate join join$ kill label lbound " & _
"lcase lcase$ left left$ len let lib libmain line listbox lobyt loc local lock lof log log10 log2 loint " & _
"long loop lowrd lprint lset lset$ ltrim ltrim$ macro macrotemp main makdwd makint maklng makptr " & _
"makwrd mat max mcase mcase$ member menu mid mid$ min mkbyt mkbyt$ mkcur mkcur$ mkcux mkcux$ " & _
"mkd mkd$ mkdir mkdwd mkdwd$ mke mke$ mki mki$ mkl mkl$ mkq mkq$ mks mks$ mkwrd mkwrd$ mod modal " & _
"modeless mouseptr msgbox name new next none not nothing notify null objactive object objptr objresult " & _
"oct oct$ of off ob open opt option optional or out output page parity paritychar parityrepl paritytype " & _
"parse parse$ parsecount pbd pbmain peek peek$ pixels pointer poke poke$ popup port post preserve " & _
"print print# private profile progid progid$ ptr put put$ quad qword random randomize read read$ " & _
"receiver records recv redim redraw regexpr regrepl remain remain$ remove remove$ repeat repeat$ " & _
"replace reset resume ret16 ret32 ret87 retain$ retp16 retp32 retprn return rgb right right$ ring " & _
"rlsd rmdir rnd rotate round rset rtrim rtrim$ rtsflow rxbuffer rxque scan scrollbar sdecl seek " & _
"select send server set setattr seteof sgn shared shell shift show signed sin single size sizeof " & _
"sleep sort soace space$ spc sqr state static status stdcall step stop str str$ strdelete strdelete$ " & _
"string string$ strinsert strinsert$ strptr strreverse strreverse$ sub suspend swap switch " & _
"tab tab$ tagarray tally tan tcp text textbox then thread threadcount threadid time time$ timeout " & _
"timer to toggle trace trim trim$ trn try txbuffer txque type ubound ucase ucase$ ucode ucode$ udp union " & _
"units unlock until up user using using$ val variant variant# variant$ variantvt varptr verify version3 " & _
"version4 version5 wend while width winmain width width# word write write# xor xinpflow xoutflow zer " & _
"dispparams iunknown idispatch"
END SUB
To begin with, you should clean the code and remove anything related with the web browser control and ATL. It only adds confusion.
yes, I agree :) I will clean for next time the whole code and erase everything concerning ATL. thanks!
here's a
reduced example one :)
zip file you can find below.
in my eyes the
problem zones are directed in this way (but I am not sure):
Quote'-----------------> problem zone ------------------------------------>
GetWindowText MdiGetActive(hWndClient), szText, SIZEOF(szText)
'-----------------> problem zone ------------------------------------>
...
FUNCTION GetEdit() AS LONG
FUNCTION = GetDlgItem(MdiGetActive(hWndClient), %IDC_SCIEDIT) '%IDC_EDIT
END FUNCTION
reduced example code:
'------------> Tabbrowser example modified with pbwin 9 for aeb-scintilla-editor by frank brübach, 21.sept.2011
'------------> reduced code example :) ------------------->
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "EXDISP.INC" ' // WebBrowser Control
#INCLUDE ONCE "COMMCTRL.INC" ' // Common controls
#INCLUDE "COMDLG32.INC"
#INCLUDE ONCE "MDI32.INC" ' // MDI wrappers
#INCLUDE ONCE "SHOBJIDL.INC" ' // Shell objects
#INCLUDE "SCINTILLAX.INC"
#RESOURCE "TabbedBrowser.pbr" ' // Resource file
$PBSCITE = "PBSCITE32"
%MAX_TABCAPTION_LEN = 40 ' Maximum length of the tab caption
TYPE WNDCLASSEX
cbSize AS DWORD
STYLE AS DWORD
lpfnWndProc AS LONG
cbClsExtra AS LONG
cbWndExtra AS LONG
hInstance AS DWORD
hIcon AS DWORD
hCursor AS DWORD
hbrBackground AS DWORD
lpszMenuName AS ASCIIZ PTR
lpszClassName AS ASCIIZ PTR
hIconSm AS DWORD
END TYPE
' ========================================================================================
' Identifiers
' ========================================================================================
%IDC_EDIT = 3001
%IDC_SCIEDIT = 3002
'---------------------------->
' FILE
%IDM_INSERTFILE = 3200 ' Insert file
%IDM_NEW = 3201 ' New file
%IDM_OPEN = 3202 ' Open file
%IDM_SAVE = 3203 ' Save
%IDM_SAVEAS = 3204 ' Save As
%IDM_PRINT = 3205 ' Print file
%IDM_CLOSEFILE = 3206 ' Close file
%IDM_CLOSEALL = 3207 ' Close all files
%IDM_DOS = 3208 ' Command prompt
%IDM_EXIT = 3209 ' Exit
' EDIT
%IDM_UNDO = 3301 ' Undo
%IDM_REDO = 3302 ' Redo
%IDM_CLEAR = 3303 ' Clear
%IDM_CLEARALL = 3304 ' Clear all
%IDM_CUT = 3305 ' Cut
%IDM_COPY = 3306 ' Copy
%IDM_PASTE = 3307 ' Paste
%IDM_SELECTALL = 3308 ' Select all
%IDM_FIND = 3309 ' Find
%IDM_FINDNEXT = 3310 ' Find next
%IDM_REPLACE = 3311 ' Replace
%IDM_GOTOLINE = 3312 ' Go to line...
%IDM_CODEFINDER = 3313 ' Go to line...
%IDM_SHOWLINENUM = 3314 ' Show Line numbers
%IDM_HIDELINENUM = 3315 ' Hide Line numbers
' TOGGLE
%IDM_TOGGLE = 3401 ' Toggle sub/function
%IDM_TOGGLEALL = 3402 ' Toggle sub/function and all the subs/functions below
%IDM_FOLDALL = 3403 ' Fold all subs/functions
%IDM_EXPANDALL = 3404 ' Expand all subs/functions
' WINDOW
%IDM_TILEH = 3451 ' Tile windows horizontally
%IDM_TILEV = 3452 ' Tile windows vertically
%IDM_CASCADE = 3453 ' Cascade windows
%IDM_ARRANGE = 3454 ' Arrange icons
%IDM_CLOSE = 3455 ' Close all
' HELP
%IDM_HELP = 3501 ' Help
%IDM_ABOUT = 3502 ' About box
'---------------------------------------------------->
%IDC_STATUSBAR = 101
%IDC_REBAR = 102
%IDC_IEWB = 103
%IDC_TOOLBAR = 104
%IDC_EDITURL = 105
%IDC_GOBTN = 106
%IDC_TABMDI = 107
' Rebar1
%IDS_STRING0 = 32770
%IDS_STRING1 = 32771
%IDS_STRING2 = 32772
' Command
%ID_GOBACK = 28000
%ID_FORWARD = 28001
%ID_NEW = 28002
%ID_FIND = 28003
%ID_PRINTPREVIEW = 28004
%ID_PRINT = 28005
%ID_PROPERTIES = 28006
%ID_FILE_SAVE = 28007
%ID_PAGESETUP = 28008
%ID_REFRESH = 28009
%ID_STOP = 28010
%ID_ZOOMIN = 28011
%ID_ZOOMOUT = 28012
%ID_EXIT = 28013
%ID_CASCADE = 28014
%ID_TILEH = 28015
%ID_TILEV = 28016
%ID_ARRANGE = 28017
' Combined equates for Tab control
%TCIF_ALL = %TCIF_TEXT OR _
%TCIF_IMAGE OR _
%TCIF_RTLREADING OR _
%TCIF_PARAM OR _
%TCIF_STATE OR _
%TCIS_BUTTONPRESSED OR _
%TCIS_HIGHLIGHTED
' Image list
%IDI_INTERNET32 = 100
%IDI_INTERNET = 101
%IDI_BACK = 102
%IDI_FORWARD = 103
%IDI_NEW = 104
%IDI_FIND = 105
%IDI_PRINTPREV = 106
%IDI_PAGESETUP = 107
%IDI_PRINT = 108
%IDI_PROPERTIES = 109
%IDI_SAVE = 110
%IDI_REFRESH = 111
%IDI_STOP = 112
%IDI_ZOOMIN = 113
%IDI_ZOOMOUT = 114
%IDI_EXIT = 115
' ========================================================================================
' Globals
' ========================================================================================
GLOBAL ghTabMdi AS DWORD ' handle to document tab control
GLOBAL ghWndClient AS DWORD ' MDI main window
GLOBAL fClosed AS LONG ' Flag
GLOBAL strPBKeyWords AS STRING ' // PowerBasic keywords
GLOBAL hWndClient AS DWORD
GLOBAL hWndMain AS DWORD
GLOBAL hInst AS DWORD
GLOBAL hStatusBar AS DWORD
' ========================================================================================
' Creates a new instance of the WebBrowser control
' ========================================================================================
FUNCTION CreateWebBrowser (BYVAL hParent AS DWORD) AS DWORD
LOCAL hWndChild AS DWORD, caption AS ASCIIZ*260
' Create the WebBrowser control
hWndChild = CreateWindowEx(%NULL, _ ' extended styles
$PBSCITE, _ ' class name
caption, _ ' caption
%WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR _ ' window styles
%WS_TABSTOP, _
0, 0, _ ' left, top
0, 0, _ ' width, height
hParent, %IDC_EDIT, _ '%IDC_IEWB, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
FUNCTION = hWndChild
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the handle of the MDI active window
' ========================================================================================
FUNCTION GetActiveWbWindow() AS DWORD
FUNCTION = GetDlgItem(MdiGetActive(ghWndClient), %IDC_EDIT)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Using the Mdi child caption find associated Tab index and activate the associated tab.
' ========================================================================================
FUNCTION EnumMdiTitleToTab (szMdiCaption AS ASCIIZ) AS LONG
LOCAL nTab AS LONG
LOCAL ttc_item AS TCITEM
LOCAL idx AS LONG
LOCAL szTabTxt AS ASCIIZ * 256
nTab = SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0)
FOR idx = 0 TO nTab - 1
' Get tab item text string
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = VARPTR(szTabTxt)
ttc_item.cchTextMax = SIZEOF(szTabTxt)
SendMessage ghTabMdi, %TCM_GETITEM, idx, BYVAL VARPTR(ttc_item)
IF szMdiCaption = szTabTxt THEN
SendMessage ghTabMdi, %TCM_SETCURSEL, idx, 0
FUNCTION = idx
EXIT FUNCTION
END IF
NEXT
END FUNCTION
' ========================================================================================
' ========================================================================================
' Using the Tab caption find the associated Mdi Child handle and making that window the
' active document view.
' ========================================================================================
FUNCTION EnumTabToMdiHandle (BYREF szTabCaption AS ASCIIZ) AS DWORD
LOCAL hMdi AS DWORD
LOCAL szText AS ASCIIZ * %MAX_PATH
' Get the first document view handle
hMdi = GetWindow(ghWndClient, %GW_CHILD)
' Cycle thru all the open DocView windows
WHILE hMdi
' Get the document view caption text
GetWindowText hMdi, szText, %MAX_PATH
IF szText = szTabCaption THEN
' Bring the document view to the front and make it the active window
IF IsIconic(hMdi) THEN
SendMessage ghWndClient, %WM_MDIRESTORE, hMdi, 0
ELSE
SendMessage ghWndClient, %WM_MDIACTIVATE, hMdi, 0
END IF
' return handle as success
FUNCTION = hMdi
EXIT FUNCTION
END IF
hMdi = GetWindow(hMdi, %GW_HWNDNEXT)
WEND
' else return false as failure
FUNCTION = %FALSE
END FUNCTION
' ========================================================================================
' ========================================================================================
' Inserts a new Tab item.
' ========================================================================================
FUNCTION InsertTabMdiItem(BYVAL hTab AS LONG, BYVAL ITEM AS LONG, szTabText AS ASCIIZ) AS LONG
LOCAL ttc_item AS TCITEM
IF SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0) = 0 THEN
ShowWindow ghTabMdi, %SW_SHOW
END IF
' Insert a tab...
ttc_item.mask = %TCIF_ALL
ttc_item.pszText = VARPTR(szTabText)
ttc_item.cchTextMax = LEN(szTabText)
ttc_item.iImage = 0
ttc_item.lParam = 0
FUNCTION = SendMessage(hTab, %TCM_INSERTITEM, ITEM, VARPTR(ttc_item))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Using the Mdi child caption find associated Tab index and delete it
' ========================================================================================
FUNCTION EnumMdiTitleToTabRemove (szMdiCaption AS ASCIIZ) AS LONG
LOCAL nTab AS LONG
LOCAL ttc_item AS TCITEM
LOCAL szTabTxt AS ASCIIZ * 256
LOCAL idx AS LONG
LOCAL itemNext AS LONG
LOCAL hMdi AS DWORD
nTab = SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0)
IF nTab = 0 THEN FUNCTION = 0 : EXIT FUNCTION
FOR idx = 0 TO nTab-1
' Get tab item text string
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = VARPTR(szTabTxt)
ttc_item.cchTextMax = SIZEOF(szTabTxt)
SendMessage ghTabMdi, %TCM_GETITEM, idx, VARPTR(ttc_item)
IF szMdiCaption = szTabTxt THEN
' Delete this tab
SendMessage ghTabMdi, %TCM_DELETEITEM, idx, 0
' Find next available MDI docview in hiarchy and activate it...
hMdi = SendMessage(ghWndClient, %WM_MDIGETACTIVE, 0, 0)
IF ISTRUE(hMdi) THEN
' Using handle, get associated tab via caption string...
LOCAL szText AS ASCIIZ*%MAX_PATH
' Get the DocView caption text
GetWindowText hMdi, szText, %MAX_PATH
' Find the associated tab and activate it
EnumMdiTitleToTab szText
END IF
' Get and activate associated Document view
itemNext = SendMessage(ghTabMdi,%TCM_GETCURSEL,0,0)
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = VARPTR(szTabTxt)
ttc_item.cchTextMax = SIZEOF(szTabTxt)
SendMessage ghTabMdi, %TCM_GETITEM, itemNext, VARPTR(ttc_item)
EnumTabToMdiHandle szTabTxt
IF SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0) = 0 THEN
ShowWindow ghTabMdi, %SW_HIDE
END IF
' Return item next...
FUNCTION = itemNext
EXIT FUNCTION
END IF
NEXT
END FUNCTION
' ========================================================================================
' ========================================================================================
' Changes the name of the tab
' ========================================================================================
SUB SetTabName (BYVAL nTab AS LONG, BYVAL strName AS STRING)
LOCAL ttc_item AS TCITEM
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = STRPTR(strName)
ttc_item.cchTextMax = 256
SendMessage ghTabMdi, %TCM_SETITEM, nTab, BYVAL VARPTR(ttc_item)
END SUB
' ========================================================================================
' ========================================================================================
' Creates a Tab control for the Mdi GUI interface.
' ========================================================================================
FUNCTION CreateTabMdiCtl (BYVAL hWnd AS LONG, BYVAL hFont AS DWORD) AS DWORD
LOCAL rc AS RECT
LOCAL hTabImageList AS DWORD
LOCAL hIcon AS DWORD
GetWindowRect hWnd, rc
ghTabMdi = CreateWindowEx(0, "SysTabControl32","",_
%WS_CHILD OR %TCS_FOCUSNEVER OR %WS_CLIPCHILDREN _
OR %TCS_BOTTOM OR %TCS_TABS OR %TCS_SINGLELINE, _
rc.nLeft, _
rc.nTop, _
rc.nRight, _
55, _ '22, _
hWnd, %IDC_TABMDI, GetModuleHandle(""), BYVAL %NULL)
IF hFont THEN SendMessage ghTabMdi, %WM_SETFONT, hFont, %TRUE
hTabImageList = ImageList_Create(16, 16, %ILC_MASK, 2, 1)
hIcon = LoadIcon(GetModuleHandle(""), BYVAL 101)
ImageList_AddIcon hTabImageList, hIcon
DestroyIcon hIcon
SendMessage(ghTabMdi, %TCM_SETIMAGELIST, 0, hTabImageList)
FUNCTION = ghTabMdi
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
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 wcex AS WNDCLASSEX ' class information
LOCAL ticc AS INIT_COMMON_CONTROLSEX ' specifies common control classes to register
LOCAL hWndMain AS DWORD
LOCAL cxIcon AS LONG ' width of a small icon in pixels
LOCAL cyIcon AS LONG ' height of a small icon in pixels
LOCAL rc AS RECT
' Initilize the COM library using OleInitialize to allow cut and paste
OleInitialize 0
InitializePbKeywords
hInst = hInstance
' Register the main window
szClassName = "TabbedBrowser"
wcex.cbSize = SIZEOF(wcex) ' size of WNDCLASSEX structure
wcex.style = %CS_DBLCLKS ' class styles
wcex.lpfnWndProc = CODEPTR(WndProc) ' address of window procedure used by class
wcex.cbClsExtra = 0 ' extra class bytes
wcex.cbWndExtra = 0 ' extra window bytes
wcex.hInstance = hInstance ' instance of the process that is registering the window
wcex.hIcon = LoadIcon(hInstance, BYVAL %IDI_INTERNET32) ' handle of class icon
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) ' handle of class cursor
wcex.hbrBackground = %COLOR_BTNFACE + 1 ' brush used to fill background of window's client area
wcex.lpszMenuName = %NULL ' resource identifier of the class menu
wcex.lpszClassName = VARPTR(szClassName) ' class name
wcex.hIconSm = LoadIcon(hInstance, BYVAL %IDI_INTERNET) ' handle of small icon shown in caption/system Taskbar
IF ISFALSE RegisterClassEx(wcex) THEN EXIT FUNCTION
' Register the windows clas for MDI windows
szClassName = "WB"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_DBLCLKS
wcex.lpfnWndProc = CODEPTR(MdiWindowProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hIcon = LoadIcon(%NULL, BYVAL %IDI_INTERNET32)
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %COLOR_WINDOW + 1
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIconSm = LoadIcon(hInstance, BYVAL %IDI_INTERNET)
IF ISFALSE RegisterClassEx(wcex) THEN EXIT FUNCTION
'----------------------------------------------------->
' Register Code Window Class
szClassName = "PBSCITE32"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW OR %CS_DBLCLKS
wcex.lpfnWndProc = CODEPTR(CodeProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 4
wcex.hInstance = hInstance
wcex.hIcon = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_IBEAM)
wcex.hbrBackground = %COLOR_WINDOW + 1
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIconSm = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)
IF ISFALSE(RegisterClassEx(wcex)) THEN
RegisterClass BYVAL (VARPTR(wcex) + 4)
END IF
' Retrieve the size of the working area
SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0
'--------------------------------------------------------------------->
' 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
' Create the Form1 window
hWndMain = CreateWindowEx(%WS_EX_WINDOWEDGE, _ ' extended styles
"TabbedBrowser", _ ' class name
"AEB_Scintilla_Editor reduced_one", _ ' caption
%WS_OVERLAPPEDWINDOW OR %WS_VISIBLE, _ ' window styles
60, 60, _ ' left, top
800, 568, _ ' width, height
%NULL, %NULL, _ ' handle of owner, menu handle
hInstance, BYVAL %NULL) ' handle of instance, creation parameters
IF ISFALSE hWndMain THEN EXIT FUNCTION
' Make the window visible; update its client area
ShowWindow hWndMain, nCmdShow
UpdateWindow hWndMain
' Message handler loop
LOCAL uMsg AS tagMsg
LOCAL hWndModeless AS DWORD
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage uMsg
DispatchMessage uMsg
WEND
' Uninitialize the COM library
OleUninitialize
FUNCTION = uMsg.wParam
END FUNCTION
' ========================================================================================
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
' ========================================================================================
' ========================================================================================
' Main Window procedure
' ========================================================================================
FUNCTION 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
) 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 hCtrl 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 hImage AS DWORD ' handle of the image
LOCAL hImageList AS DWORD ' handle of the toolbar image list
' MDI
LOCAL lpNmh AS NMHDR PTR
LOCAL ttc_item AS TC_ITEM
LOCAL hMdi AS DWORD
LOCAL sel AS LONG
LOCAL szTabTxt AS ASCIIZ * 2555
LOCAL cc AS CLIENTCREATESTRUCT
' Menu
LOCAL hMenu AS DWORD
LOCAL hSubmenu AS DWORD
LOCAL hWndFirst AS DWORD
LOCAL hWndPrev AS DWORD
LOCAL hWndActive AS DWORD
STATIC hMenuWindow AS DWORD
STATIC hMenuWindow2 AS DWORD
STATIC hMenuWindow3 AS DWORD
STATIC hMenuWindow4 AS DWORD
STATIC hMenuWindow5 AS DWORD
LOCAL pIWebBrowser2 AS IWebBrowser2
LOCAL vUrl AS VARIANT
LOCAL szUrl AS ASCIIZ * 2048 ' %INTERNET_MAX_PATH_LENGTH
LOCAL nScale AS LONG
LOCAL nRange AS LONG
LOCAL vScale AS VARIANT
LOCAL vRange AS VARIANT
SELECT CASE uMsg
CASE %WM_ACTIVATE
STATIC hWndSaveFocus AS DWORD
IF LO(WORD, wParam) = %WA_INACTIVE THEN
' Save the control with the keyboard focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Set the keyboard focus to the control with
' the focus when the window was deactivated
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
EXIT FUNCTION
CASE %WM_SYSCOMMAND
' Capture this message and send a WM_CLOSE message
IF (wParam AND &HFFF0) = %SC_CLOSE THEN
SendMessage hWnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDOK
' If we are in the URL edit control, load the web page
hCtrl = GetDlgItem(GetDlgItem(hWnd, %IDC_REBAR), %IDC_EDITURL)
IF GetFocus = hCtrl THEN
PostMessage hWnd, %WM_COMMAND, %IDC_GOBTN, MAK(DWORD, %BN_CLICKED, %IDC_GOBTN)
EXIT FUNCTION
END IF
'------------------SAVE FILE ---------->
'------------------------------------->
CASE %IDM_SAVE : SAVEFILE %FALSE
CASE %IDM_SAVEAS : SAVEFILE %TRUE
'----------------------------->
'------------------SAVE FILE ---------->
CASE %ID_EXIT
SendMessage hWnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
CASE %ID_CASCADE
MdiCascade ghWndClient
EXIT FUNCTION
CASE %ID_TILEH
SendMessage(ghWndClient, %WM_MDITILE, %MDITILE_HORIZONTAL, 0)
EXIT FUNCTION
CASE %ID_TILEV
SendMessage(ghWndClient, %WM_MDITILE, %MDITILE_VERTICAL, 0)
EXIT FUNCTION
CASE %ID_ARRANGE
MdiIconArrange ghWndClient
EXIT FUNCTION
CASE %ID_NEW
' Create an MDI child
hMdi = CreateMdiChild("WB", ghWndClient, "", %WS_MAXIMIZE)
' Get the handle of the window that hosts the webbrowser
'hCtrl = GetDlgItem(hMdi, %IDC_IEWB)
hCtrl = GetDlgItem(hMdi, %IDC_EDIT)
EXIT FUNCTION
CASE %IDC_GOBTN
IF HI(WORD, wParam) = %BN_CLICKED THEN
' Get the Url
' hCtrl = GetDlgItem(GetDlgItem(hWnd, %IDC_REBAR), %IDC_EDITURL)
GetWindowText hCtrl, szUrl, SIZEOF(szUrl)
vUrl = szUrl
IF ISFALSE GetActiveWbWindow THEN
' Create an MDI child
hMdi = CreateMdiChild("WB", ghWndClient, "", %WS_MAXIMIZE)
' Get the handle of the window that hosts the webbrowser
hCtrl = GetDlgItem(hMdi, %IDC_EDIT)
hCtrl = GetDlgItem(hMdi, %IDC_SCIEDIT)
ELSE
' Use the active window
hCtrl = GetActiveWbWindow
END IF
EXIT FUNCTION
END IF
CASE %ID_GOBACK
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_FORWARD
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_FIND
' 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 7. See http://support.microsoft.com/?kbid=311288
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_PRINTPREVIEW
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_PAGESETUP
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_PRINT
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_PROPERTIES
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_FILE_SAVE
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_REFRESH
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_STOP
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_ZOOMIN
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %ID_ZOOMOUT
hCtrl = GetActiveWbWindow
EXIT FUNCTION
CASE %IDC_EDITURL
SELECT CASE HI(WORD, wParam)
CASE %EN_SETFOCUS
' Select all the text of the edit box
PostMessage lParam, %EM_SETSEL, 0, -1
EXIT FUNCTION
END SELECT
END SELECT
CASE %WM_NOTIFY
ptnmhdr = lParam
SELECT CASE @ptnmhdr.code
CASE %TTN_GETDISPINFO
ptttdi = lParam
@ptttdi.hinst = %NULL
SELECT CASE @ptttdi.hdr.hwndFrom
hCtrl = GetDlgItem(GetDlgItem(hWnd, %IDC_REBAR), %IDC_TOOLBAR)
CASE SendMessage(hCtrl, %TB_GETTOOLTIPS, 0, 0)
SELECT CASE @ptttdi.hdr.idFrom
CASE %ID_GOBACK
szItem = "Go Back"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_FORWARD
szItem = "Go Forward"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_NEW
szItem = "New tab"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_FIND
szItem = "Find"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_PRINTPREVIEW
szItem = "Print Preview"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_PAGESETUP
szItem = "Page Setup"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_PRINT
szItem = "Print"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_PROPERTIES
szItem = "Properties"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_FILE_SAVE
szItem = "Save As"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_REFRESH
szItem = "Refresh"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_STOP
szItem = "Stop"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_ZOOMIN
szItem = "Zoom in"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_ZOOMOUT
szItem = "Zoom out"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
CASE %ID_EXIT
szItem = "Exit"
@ptttdi.lpszText = VARPTR(szItem)
EXIT FUNCTION
END SELECT
END SELECT
END SELECT
' MDI
lpNmh = lParam
SELECT CASE @lpNmh.Code ' Examine .Code member
CASE %TCN_LAST TO %TCN_FIRST ' Tab control notifications
SELECT CASE @lpNmh.idFrom
CASE %IDC_TABMDI
SELECT CASE @lpNmh.Code
CASE %TCN_SELCHANGE ' identify which tab
sel = SendMessage(ghTabMdi, %TCM_GETCURSEL, 0, 0)
ttc_item.mask = %TCIF_TEXT
ttc_item.pszText = VARPTR(szTabTxt)
ttc_item.cchTextMax = SIZEOF(szTabTxt)
SendMessage ghTabMdi, %TCM_GETITEM, sel, BYVAL VARPTR(ttc_item)
' get and activate associated Document view
hMdi = EnumTabToMdiHandle(szTabTxt)
END SELECT
END SELECT
END SELECT
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_STATUSBAR), %WM_SYSCOLORCHANGE, wParam, lParam
hWndRebar = GetDlgItem(hWnd, %IDC_REBAR)
SendMessage hWndRebar, %WM_SYSCOLORCHANGE, wParam, lParam
SendMessage GetDlgItem(hWndRebar, %IDC_TOOLBAR), %WM_SYSCOLORCHANGE, wParam, lParam
CASE %WM_SETFOCUS
' Set the keyboard focus to the first control that is
' visible, not disabled, and has the WS_TABSTOP style
SetFocus GetNextDlgTabItem(hWnd, %NULL, %FALSE)
EXIT FUNCTION
CASE %WM_CLOSE
hWndFirst = MdiGetActive(ghWndClient)
hWndActive = hWndFirst
hWndPrev = 0
DO WHILE hWndActive
IF SendMessage(MdiGetActive(ghWndClient), %WM_CLOSE, 0, 0) THEN
EXIT DO
END IF
IF fClosed THEN
IF hWndFirst = hWndActive THEN
IF hWndFirst = hWndPrev THEN
hWndFirst = 0
hWndPrev = 0
ELSE
hWndFirst = hWndPrev
END IF
END IF
ELSE
IF hWndPrev = 0 THEN
hWndPrev = hWndActive
END IF
IF hWndFirst = 0 THEN
hWndFirst = hWndActive
END IF
END IF
MdiNext ghWndClient, hWndActive, 0&
hWndActive = MdiGetActive(ghWndClient)
LOOP UNTIL hWndActive = hWndFirst
IF hWndActive THEN EXIT FUNCTION
CASE %WM_DESTROY
' Destroy the image list used by the toolbar
hCtrl = GetDlgItem(GetDlgItem(hWnd, %IDC_REBAR), %IDC_TOOLBAR)
ImageList_Destroy(SendMessage(hCtrl, %TB_SETIMAGELIST, 0, %NULL))
' Destroy the image list used by the tab control
ImageList_Destroy(SendMessage(ghTabMdi, %TCM_SETIMAGELIST, 0, %NULL))
' Quit the application
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_SIZE
IF wParam <> %SIZE_MINIMIZED THEN
LOCAL rc AS RECT
LOCAL rbh AS LONG
LOCAL sbh AS LONG
LOCAL tch AS LONG
SendMessage GetDlgItem(hWnd, %IDC_STATUSBAR), %WM_SIZE, wParam, lParam
InvalidateRect GetDlgItem(hWnd, %IDC_STATUSBAR), BYVAL %NULL, %TRUE
SendMessage GetDlgItem(hWnd, %IDC_REBAR), %WM_SIZE, wParam, lParam
' Height of the rebar
GetClientRect GetDlgItem(hWnd, %IDC_REBAR), rc
rbh = rc.nBottom - rc.nTop
' Height of the statusbar
GetClientRect GetDlgItem(hWnd, %IDC_STATUSBAR), rc
sbh = rc.nBottom - rc.nTop
' Height of the tab control
GetClientRect ghTabMdi, rc
tch = rc.nBottom - rc.nTop
' Move the tab control
MoveWindow ghTabMdi, 0, rbh + 1, LO(WORD, lParam), tch, %TRUE
' Move the MDI main window
MoveWindow ghWndClient, 0, rbh + tch + 1, LO(WORD, lParam), HI(WORD, lParam) - rbh - sbh - tch, %TRUE
EXIT FUNCTION
END IF
end of part one ..
part two as followed:
CASE %WM_CREATE
' Create font used by container
hFont = GetStockObject(%DEFAULT_GUI_FONT)
' Create the menu
hMenu = CreateMenu
hSubMenu = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hSubMenu, "&File"
AppendMenu hSubMenu, %MF_ENABLED, %ID_NEW, "&New Tab"
AppendMenu hSubMenu, %MF_ENABLED, %IDM_INSERTFILE, "&Insert File"
AppendMenu hSubMenu, %MF_SEPARATOR, 0, ""
AppendMenu hSubMenu, %MF_ENABLED, %IDM_OPEN, "&Open" + $TAB + "Ctrl+O"
AppendMenu hSubMenu, %MF_ENABLED, %IDM_SAVE, "&Save" + $TAB + "Ctrl+S"
AppendMenu hSubMenu, %MF_ENABLED, %IDM_SAVEAS, "Save File &As..."
AppendMenu hSubMenu, %MF_ENABLED, %IDM_CLOSEFILE, "Close" + $TAB + "Ctrl+F4"
AppendMenu hSubMenu, %MF_ENABLED, %IDM_CLOSEALL, "Close A&ll Files"
AppendMenu hSubMenu, %MF_SEPARATOR, 0, ""
AppendMenu hSubMenu, %MF_ENABLED, %IDM_PRINT, "&Print File..." + $TAB + "Ctrl+P"
AppendMenu hSubMenu, %MF_SEPARATOR, 0, ""
AppendMenu hSubMenu, %MF_ENABLED, %IDM_DOS, "Comman&d Prompt"
AppendMenu hSubMenu, %MF_SEPARATOR, 0, ""
AppendMenu hSubMenu, %MF_ENABLED, %ID_EXIT, "E&xit" + $TAB + "Alt+F4"
SetMenu hWnd, hMenu
hMenuWindow = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuWindow, "&Window"
AppendMenu hMenuWindow, %MF_ENABLED, %ID_CASCADE, "&Cascade"
AppendMenu hMenuWindow, %MF_ENABLED, %ID_TILEH, "Tile &Horizontal"
AppendMenu hMenuWindow, %MF_ENABLED, %ID_TILEV, "Tile &Vertical"
AppendMenu hMenuWindow, %MF_ENABLED, %ID_ARRANGE, "&Arrange icons"
SetMenu hWnd, hMenu
hMenuWindow2 = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuWindow2, "&Edit"
' AppendMenu hMenuWindow2, %MF_ENABLED, %ID_CASCADE, "&Batman"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_UNDO, "&Undo" + $TAB + "Ctrl+Z"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_REDO, "Re&do" + $TAB + "Ctrl+Y"
AppendMenu hMenuWindow2, %MF_SEPARATOR, 0, ""
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_CLEAR, "Clea&r"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_CLEARALL, "Cl&ear all"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_CUT, "Cu&t" + $TAB + "Ctrl+X"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_COPY, "&Copy" + $TAB + "Ctrl+C"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_PASTE, "&Paste" + $TAB + "Ctrl+V"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_SELECTALL, "Select &All" + $TAB + "Ctrl+A"
AppendMenu hMenuWindow2, %MF_SEPARATOR, 0, ""
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_FIND, "&Find" + $TAB + "Ctrl+F"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_FINDNEXT, "Find &Next" + $TAB + "F3"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_REPLACE, "R&eplace..." + $TAB + "Ctrl+R"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_GOTOLINE, "&Go to line..." + $TAB + "Ctrl+G"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_CODEFINDER, "Code Finder..." + $TAB + "F2"
AppendMenu hMenuWindow2, %MF_SEPARATOR, 0, ""
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_SHOWLINENUM, "Show line numbers"
AppendMenu hMenuWindow2, %MF_ENABLED, %IDM_HIDELINENUM, "Hide line numbers"
SetMenu hWnd, hMenu
hMenuWindow3 = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuWindow3, "&Toggle"
AppendMenu hMenuWindow3, %MF_ENABLED, %IDM_TOGGLE, "&Current Sub/Function" + $TAB + "F4"
AppendMenu hMenuWindow3, %MF_ENABLED, %IDM_TOGGLEALL, "Current and all &below" + $TAB + "F5"
AppendMenu hMenuWindow3, %MF_ENABLED, %IDM_FOLDALL, "&Fold all subs/functions" + $TAB + "F6"
AppendMenu hMenuWindow3, %MF_ENABLED, %IDM_EXPANDALL, "&Expand all subs/functions" + $TAB + "F7"
SetMenu hWnd, hMenu
hMenuWindow4 = CreatePopUpMenu
AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuWindow4, "&Help"
AppendMenu hMenuWindow4, %MF_ENABLED, %IDM_HELP, "&Help" + $TAB + "F1"
AppendMenu hMenuWindow4, %MF_SEPARATOR, 0, ""
AppendMenu hMenuWindow4, %MF_ENABLED, %IDM_ABOUT, "&About..."
SetMenu hWnd, hMenu
'---------------------------->
' Create the Statusbar statusbar control
hCtrl = 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_STATUSBAR, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hCtrl, %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] = -1
SendMessage hCtrl, %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 hCtrl, %WM_SIZE, 0, 0
' Create the Rebar rebar control
hCtrl = 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
690, 30, _ ' width, height
hWnd, %IDC_REBAR, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
' Save the handle of the rebar. It is used when embedding controls
hWndRebar = hCtrl
SendMessage hCtrl, %WM_SETFONT, hFont, %TRUE
' Create the Toolbar toolbar control
hCtrl = 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_TOOLBAR, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hCtrl, %WM_SETFONT, hFont, %TRUE
' Create and initialize the image list
hImageList = ImageList_Create(16, 16, %ILC_MASK OR %ILC_COLOR24, 14, 0)
IF ISTRUE hImageList THEN
' Set the background color to use for drawing images
ImageList_SetBkColor hImageList, %CLR_NONE
' Add the images to the imagelist
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_BACK, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_FORWARD, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_NEW, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_FIND, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_PRINTPREV, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_PAGESETUP, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_PRINT, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_PROPERTIES, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_SAVE, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_REFRESH, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_STOP, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_ZOOMIN, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_ZOOMOUT, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
hImage = LoadImage(GetModuleHandle(""), BYVAL %IDI_EXIT, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
ImageList_ReplaceIcon hImageList, -1, hImage
DeleteObject hImage
END IF
' Set the imagelist used with default images
SendMessage hCtrl, %TB_SETIMAGELIST, 0, hImageList
' Allocate memory for the button info array
pttbb = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, 14 * SIZEOF(ttbb))
IF ISTRUE pttbb THEN
' Send the TB_BUTTONSTRUCTSIZE message, for backward compatibility
SendMessage hCtrl, %TB_BUTTONSTRUCTSIZE, SIZEOF(ttbb), 0
' Set the size of the bitmaps
SendMessage hCtrl, %TB_SETBITMAPSIZE, 0, MAKLNG(16, 16)
' Add buttons to the toolbar
@pttbb[0].iBitmap = 0
@pttbb[0].idCommand = %ID_GOBACK
@pttbb[0].fsState = %TBSTATE_ENABLED
@pttbb[0].fsStyle = %BTNS_BUTTON
@pttbb[0].dwData = 0
@pttbb[0].iString = -1
@pttbb[1].iBitmap = 1
@pttbb[1].idCommand = %ID_FORWARD
@pttbb[1].fsState = %TBSTATE_ENABLED
@pttbb[1].fsStyle = %BTNS_BUTTON
@pttbb[1].dwData = 0
@pttbb[1].iString = -1
@pttbb[2].iBitmap = 2
@pttbb[2].idCommand = %ID_NEW
@pttbb[2].fsState = %TBSTATE_ENABLED
@pttbb[2].fsStyle = %BTNS_BUTTON
@pttbb[2].dwData = 0
@pttbb[2].iString = -1
@pttbb[3].iBitmap = 3
@pttbb[3].idCommand = %ID_FIND
@pttbb[3].fsState = %TBSTATE_ENABLED
@pttbb[3].fsStyle = %BTNS_BUTTON
@pttbb[3].dwData = 0
@pttbb[3].iString = -1
@pttbb[4].iBitmap = 4
@pttbb[4].idCommand = %ID_PRINTPREVIEW
@pttbb[4].fsState = %TBSTATE_ENABLED
@pttbb[4].fsStyle = %BTNS_BUTTON
@pttbb[4].dwData = 0
@pttbb[4].iString = -1
@pttbb[5].iBitmap = 5
@pttbb[5].idCommand = %ID_PAGESETUP
@pttbb[5].fsState = %TBSTATE_ENABLED
@pttbb[5].fsStyle = %BTNS_BUTTON
@pttbb[5].dwData = 0
@pttbb[5].iString = -1
@pttbb[6].iBitmap = 6
@pttbb[6].idCommand = %ID_PRINT
@pttbb[6].fsState = %TBSTATE_ENABLED
@pttbb[6].fsStyle = %BTNS_BUTTON
@pttbb[6].dwData = 0
@pttbb[6].iString = -1
@pttbb[7].iBitmap = 7
@pttbb[7].idCommand = %ID_PROPERTIES
@pttbb[7].fsState = %TBSTATE_ENABLED
@pttbb[7].fsStyle = %BTNS_BUTTON
@pttbb[7].dwData = 0
@pttbb[7].iString = -1
@pttbb[8].iBitmap = 8
@pttbb[8].idCommand = %ID_FILE_SAVE
@pttbb[8].fsState = %TBSTATE_ENABLED
@pttbb[8].fsStyle = %BTNS_BUTTON
@pttbb[8].dwData = 0
@pttbb[8].iString = -1
@pttbb[9].iBitmap = 9
@pttbb[9].idCommand = %ID_REFRESH
@pttbb[9].fsState = %TBSTATE_ENABLED
@pttbb[9].fsStyle = %BTNS_BUTTON
@pttbb[9].dwData = 0
@pttbb[9].iString = -1
@pttbb[10].iBitmap = 10
@pttbb[10].idCommand = %ID_STOP
@pttbb[10].fsState = %TBSTATE_ENABLED
@pttbb[10].fsStyle = %BTNS_BUTTON
@pttbb[10].dwData = 0
@pttbb[10].iString = -1
@pttbb[11].iBitmap = 11
@pttbb[11].idCommand = %ID_ZOOMIN
@pttbb[11].fsState = %TBSTATE_ENABLED
@pttbb[11].fsStyle = %BTNS_BUTTON
@pttbb[11].dwData = 0
@pttbb[11].iString = -1
@pttbb[12].iBitmap = 12
@pttbb[12].idCommand = %ID_ZOOMOUT
@pttbb[12].fsState = %TBSTATE_ENABLED
@pttbb[12].fsStyle = %BTNS_BUTTON
@pttbb[12].dwData = 0
@pttbb[12].iString = -1
@pttbb[13].iBitmap = 13
@pttbb[13].idCommand = %ID_EXIT
@pttbb[13].fsState = %TBSTATE_ENABLED
@pttbb[13].fsStyle = %BTNS_BUTTON
@pttbb[13].dwData = 0
@pttbb[13].iString = -1
SendMessage hCtrl, %TB_ADDBUTTONS, 14, BYVAL pttbb
' Free memory that was allocated for the button info
HeapFree GetProcessHeap(), 0, BYVAL pttbb
' Update the size of the toolbar
SendMessage hCtrl, %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 = hCtrl
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
hCtrl = 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
251, 4, _ ' left, top
300, 21, _ ' width, height
hWnd, %IDC_EDITURL, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hCtrl, %WM_SETFONT, hFont, %TRUE
'SetWindowText hCtrl, "http://www.jose.it-berater.org/index.html"
' Create the GoBtn text button
hCtrl = CreateWindowEx(%NULL, _ ' extended styles
"Button", _ ' class name
"Go_SCI", _ ' 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, _
593, 2, _ ' left, top
50, 24, _ ' width, height
hWnd, %IDC_GOBTN, _ ' handle of parent, control ID
GetModuleHandle(""), BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hCtrl, %WM_SETFONT, hFont, %TRUE
' Create the tab control
ghTabMdi = CreateTabMdiCtl(hWnd, hFont)
' Create MDI Client window
cc.idFirstChild = 1
cc.hWindowMenu = hMenuWindow ' For file list in Window menu
ghWndClient = CreateWindowEx(%WS_EX_CLIENTEDGE, "MDICLIENT", BYVAL %NULL, _
%WS_CHILD OR %WS_CLIPCHILDREN OR %WS_VISIBLE OR %WS_VSCROLL OR %WS_HSCROLL, _
0, 0, 0, 0, hWnd, &H0CAC, GetModuleHandle(""), cc) '&H0CAC ? => what's that?
END SELECT
FUNCTION = DefFrameProc(hWnd, ghWndClient, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' MDI window callback
' ========================================================================================
FUNCTION MdiWindowProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL hr AS LONG
LOCAL nTab AS LONG
LOCAL rc AS RECT
LOCAL szText AS ASCIIZ * 255
LOCAL hWB AS DWORD
LOCAL pIWebBrowser2 AS IWebBrowser2
' LOCAL pWBEvents AS DWebBrowserEvents2Impl
LOCAL dwCookie AS DWORD
SELECT CASE wMsg
CASE %WM_CREATE
GetClientRect hWnd, rc
' Increase the tab number and set the caption
hWB = CreateWebBrowser(hWnd) 'creates new window with tabs
' Insert new tab
nTab = SendMessage(ghTabMdi, %TCM_GETITEMCOUNT, 0, 0)
szText = FORMAT$(nTab + 1, "000")
SetWindowText(hWnd, szText)
InsertTabMdiItem(ghTabMdi, nTab + 1, szText)
' Set it as the current selection on the tab control
SendMessage(ghTabMdi, %TCM_SETCURSEL, nTab, 0)
CASE %WM_SIZE
MoveWindow GetDlgItem(hWnd, %IDC_EDIT), 0, 0, LOWRD(lParam), HIWRD(lParam), %TRUE
MoveWindow GetDlgItem(hWnd, %IDC_SCIEDIT), 0, 0, LOWRD(lParam), HIWRD(lParam), %TRUE
CASE %WM_SETFOCUS
SetFocus GetActiveWbWindow
CASE %WM_MDIACTIVATE
' Using handle, get associated tab via caption string
' Get the caption text of the window
GetWindowText(lParam, szText, %MAX_PATH)
' Find the associated tab and activate it
EnumMdiTitleToTab(szText)
SetFocus GetActiveWbWindow
CASE %WM_DESTROY
' Get the handle of the window that hosts the control
hWB = GetDlgItem(hWnd, %IDC_EDIT)
' Disconnect events and remove property
' Remove Tab associated with this window
GetWindowText(hWnd, szText, SIZEOF(szText))
nTab = EnumMdiTitleToTabRemove(szText)
END SELECT
FUNCTION = DefMDIChildProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' *********************************************************************************************
' Set Scintilla Edit Control's options
' *********************************************************************************************
SUB Scintilla_SetOptions (BYVAL pSciWndData AS DWORD)
LOCAL i AS LONG
LOCAL strDemoCode AS STRING
LOCAL szFont AS ASCIIZ * 33
LOCAL szKey AS ASCIIZ * 255
LOCAL szValue AS ASCIIZ * 255
' Set the default style
szFont = "FixedSys"
SciMsg pSciWndData, %SCI_STYLESETFONT, %STYLE_DEFAULT, VARPTR(szFont)
SciMsg pSciWndData, %SCI_STYLESETSIZE, %STYLE_DEFAULT, 9
SciMsg pSciWndData, %SCI_STYLESETCASE, %STYLE_DEFAULT, %SC_CASE_MIXED
' Set indentation guides
SciMsg pSciWndData, %SCI_SETINDENTATIONGUIDES, %TRUE, 0
SciMsg pSciWndData, %SCI_SETTABWIDTH, 3, 0
SciMsg pSciWndData, %SCI_SETINDENT, 3, 0
' Set all the other styles to the default
SciMsg pSciWndData, %SCI_STYLECLEARALL, 0, 0
' Set the font for the line numbers
szFont = "Arial"
SciMsg pSciWndData, %SCI_STYLESETFONT, %STYLE_LINENUMBER, VARPTR(szFont)
' Enable folding of the procedures and functions
szKey = "fold" : szValue = "1"
SciMsg pSciWndData, %SCI_SETPROPERTY, VARPTR(szKey), VARPTR(szValue)
' Set default color to black
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_DEFAULT, RGB(0, 0, 0)
' Set comments style (1) to Verdana an italic (size: 10 points) and green color
' szFont = "Verdana"
' SciMsg pSciWndData, %SCI_STYLESETFONT, %SCE_B_COMMENT, VARPTR(szFont)
' SciMsg pSciWndData, %SCI_STYLESETSIZE, %SCE_B_COMMENT, 10
' SciMsg pSciWndData, %SCI_STYLESETITALIC, %SCE_B_COMMENT, %TRUE
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_COMMENT, RGB(0, 128, 0)
' Set style 3 (keywords) to upper case and blue color
SciMsg pSciWndData, %SCI_STYLESETCASE, %SCE_B_KEYWORD, %TRUE
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_KEYWORD, RGB(0, 0, 255)
' Set color for strings to violet
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_STRING, RGB(255, 0, 255)
' Set color for identifiers to black
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_IDENTIFIER, RGB(0, 0, 0)
' Set color for numbers to brown
SciMsg pSciWndData,%SCI_STYLESETFORE,%SCE_B_NUMBER,RGB(192,100,0) 'brown
' Set color for oprators
SciMsg pSciWndData, %SCI_STYLESETFORE, %SCE_B_OPERATOR, RGB(0, 128, 128)
' Set edge column and mode
SciMsg pSciWndData, %SCI_SETEDGECOLUMN, 255, 0
SciMsg pSciWndData, %SCI_SETEDGEMODE, %EDGE_LINE, 0
' Margin 0 for numbers
SciMsg pSciWndData, %SCI_SETMARGINTYPEN, 0, %SC_MARGIN_NUMBER
SciMsg pSciWndData, %SCI_SETMARGINWIDTHN, 0, 50
' Margin 1 for symbols
SciMsg pSciWndData, %SCI_SETMARGINMASKN, 1, %SC_MASK_FOLDERS
'Margin 1: Send WM_NOTIFY after mouse clicks
SciMsg pSciWndData, %SCI_SETMARGINSENSITIVEN, 1, 1
' Set PowerBasic lexer
SciMsg pSciWndData, %SCI_SETLEXER, %SCLEX_PB, 0
' Set PB Keywords
SciMsg pSciWndData, %SCI_SETKEYWORDS, 0, BYVAL STRPTR(strPbKeyWords)
END SUB
' *********************************************************************************************
' *********************************************************************************************
' Save file procedure
' *********************************************************************************************
SUB SAVEFILE (BYVAL Ask AS LONG)
LOCAL PATH AS STRING
LOCAL f AS STRING
LOCAL STYLE AS DWORD
LOCAL nFile AS DWORD
LOCAL Buffer AS STRING
LOCAL szText AS ASCIIZ * 255
LOCAL nLen AS LONG
'-----------------> problem zone ------------------------------------>
GetWindowText MdiGetActive(hWndClient), szText, SIZEOF(szText)
'-----------------> problem zone ------------------------------------>
IF INSTR(szText, ANY ":\/") = 0 THEN ' if no path, it's a new doc
PATH = CURDIR$
IF RIGHT$(PATH, 1) <> "\" THEN PATH = PATH + "\"
IF LEFT$(UCASE$(szText), 8) = "UNTITLED" AND INSTR(szText, ".") = 0 THEN
f = szText & ".BAS"
ELSE
f = szText
END IF
Ask = %TRUE ' we need the dialog for new docs
ELSE
PATH = PATHNAME$(PATH, szText)
f = PATHNAME$(NAMEX, szText)
'PATH = GetFilePath(szText)
'f = GetFileName(szText)
END IF
STYLE = %OFN_HIDEREADONLY OR %OFN_LONGNAMES
IF ISTRUE(Ask) THEN
IF ISFALSE(SaveFileDialog(hWndMain, "Save File", f, PATH, _
"Text Files|*.txt|All Files|*.*", "txt", STYLE)) THEN
EXIT SUB
END IF
END IF
nFile = FREEFILE
OPEN f FOR BINARY AS nFile
Buffer = SPACE$(GetWindowTextLength(GetEdit) + 1)
GetWindowText GetEdit, BYVAL STRPTR(Buffer), LEN(Buffer)
PUT$ nFile, LEFT$(Buffer, LEN(Buffer) - 1) 'UCODE$
SETEOF nFile
CLOSE nFile
SetWindowText MdiGetActive(hWndClient), BYVAL STRPTR(f)
MSGBOX buffer
' Tell to Scintilla that the current state of the document is unmodified.
SendMessage GetEdit, %SCI_SETSAVEPOINT, 0, 0
END SUB
' *********************************************************************************************
FUNCTION CodeProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
' This handles messages for the MDI child windows.
LOCAL hEdit AS DWORD
LOCAL nFile AS LONG
LOCAL Buffer AS STRING
LOCAL RetVal AS LONG
LOCAL pSciData AS DWORD
LOCAL pNmh AS NMHDR PTR ' // Address of a NMHDR structure
LOCAL pNSC AS SCNotification PTR ' // Scintilla notification messages structure
LOCAL LineNumber AS LONG ' // Line number
LOCAL curPos AS LONG ' // Current position
LOCAL LineLen AS LONG ' // Line length
LOCAL IndentSize AS LONG ' // Size of the indent
LOCAL TabSize AS LONG ' // Tab size
LOCAL nSpaces AS LONG
LOCAL strFill AS STRING
LOCAL i AS LONG
STATIC rc AS RECT
STATIC szText AS ASCIIZ * %MAX_PATH
SELECT CASE wMsg
CASE %WM_CREATE
GetClientRect hWnd, rc
hEdit = CreateWindowEx(%WS_EX_CLIENTEDGE, "Scintilla", BYVAL %NULL, %WS_CHILD OR %WS_VISIBLE OR _
%ES_MULTILINE OR %WS_VSCROLL OR %WS_HSCROLL OR _
%ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR %ES_NOHIDESEL, _
0, 0, 0, 0, hWnd, %IDC_EDIT, hInst, BYVAL %NULL) '%IDC_SCIEDIT
pSciData = SendMessage(hEdit, %SCI_GETDIRECTPOINTER, 0, 0)
IF pSciData THEN Scintilla_SetOptions pSciData
GetWindowText hWnd, szText, SIZEOF(szText)
IF LEN(szText) THEN
nFile = FREEFILE
OPEN szText FOR BINARY AS nFile
GET$ nFile, LOF(nFile), Buffer
CLOSE nFile
' Put the text in the edit control
SendMessage hEdit, %SCI_INSERTTEXT, 0, BYVAL STRPTR(Buffer)
' Tell to Scintilla that the current state of the document is unmodified.
SendMessage hEdit, %SCI_SETSAVEPOINT, 0, 0
ELSE
SetWindowText hWnd, "Untitled"
END IF
CASE %WM_SIZE
MoveWindow GetDlgItem(hWnd, %IDC_EDIT), 0, 0, LOWRD(lParam), HIWRD(lParam), %TRUE
CASE %WM_SETFOCUS
SetFocus GetEdit
ShowLinCol ' Show line and column
CASE %WM_CLOSE
IF ISTRUE SendMessage(GetEdit, %SCI_GETMODIFY, 0, 0) THEN
GetWindowText hWnd, szText, SIZEOF(szText)
RetVal = MessageBox(BYVAL hWnd, " Save current changes? " & GetFileName(szText), _
" PBSCITE", %MB_YESNO OR %MB_ICONEXCLAMATION OR %MB_APPLMODAL)
IF RetVal = %IDCANCEL THEN
fClosed = %FALSE
EXIT FUNCTION
ELSE
fClosed = %TRUE
IF RetVal = %IDYES THEN
SAVEFILE %FALSE
END IF
END IF
ELSE
fClosed = %TRUE
END IF
CASE %WM_NOTIFY
' Process the Scintilla Edit Control notification messges
IF LOWRD(wParam) = %IDC_EDIT THEN
pNSC = lParam
SELECT CASE @pNSC.hdr.code
CASE %SCN_UPDATEUI : ShowLinCol ' Show line and column
CASE %SCN_MARGINCLICK ' Margin mouse click
IF @pNSC.margin = 2 THEN ' Folder margin
LineNumber = SendMessage(GetEdit, %SCI_LINEFROMPOSITION, @pNSC.position, 0)
ToggleFolding LineNumber
END IF
CASE %SCN_CHARADDED
' Auto indentation - since SCN_KEY isn't send in the Windows version,
' we detect the new line if the charadded is a carriage return
IF @pNSC.ch = 13 THEN ' carriage return
curPos = SendMessage(GetEdit, %SCI_GETCURRENTPOS, 0, 0) ' current position
LineNumber = SendMessage(GetEdit, %SCI_LINEFROMPOSITION, curPos, 0) ' line number
LineLen = SendMessage(GetEdit, %SCI_LINELENGTH, LineNumber - 1, 0) ' length of the line
buffer = SPACE$(LineLen) ' size the buffer
SendMessage(GetEdit, %SCI_GETLINE, LineNumber - 1, STRPTR(buffer)) ' get the text of the line
TabSize = SendMessage(GetEdit, %SCI_GETTABWIDTH, 0, 0) ' size of the tab
nSpaces = 0 ' number of spaces on the left
FOR i = 1 TO LEN(buffer)
IF MID$(buffer, i, 1) <> " " THEN
IF MID$(buffer, i, 1) = $TAB THEN
nSpaces = nSpaces + TabSize
ELSE
EXIT FOR
END IF
ELSE
nSpaces = nSpaces + 1
END IF
NEXT
buffer = REMOVE$(buffer, ANY CHR$(13, 10)) ' removes $CRLF
buffer = TRIM$(UCASE$(buffer), ANY CHR$(32, 9)) ' removes spaces and tabs and converts to uppercase
IF (LEFT$(buffer, 3) = "IF " AND RIGHT$(buffer, 5) = " THEN") OR _
LEFT$(buffer, 4) = "ELSE" OR _
LEFT$(buffer, 7) = "SELECT " OR _
LEFT$(buffer, 5) = "CASE " OR _
LEFT$(buffer, 4) = "FOR " OR _
LEFT$(buffer, 3) = "DO " OR _
buffer = "DO" OR _
LEFT$(buffer, 6) = "WHILE " OR _
buffer = "WHILE" THEN
IndentSize = SendMessage(GetEdit, %SCI_GETINDENT, 0, 0) ' size of the indent
strFill = SPACE$(nSpaces + IndentSize) ' add spaces to indent the line
ELSE
strFill = SPACE$(nSpaces) ' add the same spaces on the left that the line above
END IF
SendMessage(GetEdit, %SCI_ADDTEXT, LEN(strFill), STRPTR(strFill)) ' indents the line
END IF
END SELECT
END IF
END SELECT
FUNCTION = DefMDIChildProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
' *********************************************************************************************
FUNCTION GetEdit() AS LONG
FUNCTION = GetDlgItem(MdiGetActive(hWndClient), %IDC_SCIEDIT) '%IDC_EDIT
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' Retieves the file name
' *********************************************************************************************
FUNCTION GetFileName (BYVAL Src AS STRING) AS STRING
LOCAL x AS LONG
x = INSTR(-1, Src, ANY ":/\")
IF x THEN
FUNCTION = MID$(Src, x + 1)
ELSE
FUNCTION = Src
END IF
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' Retrieves the path
' *********************************************************************************************
FUNCTION GetFilePath (BYVAL Src AS STRING) AS STRING
LOCAL x AS LONG
x = INSTR(-1, Src, ANY ":\/")
IF x THEN
FUNCTION = LEFT$(Src, x)
END IF
END FUNCTION
' *********************************************************************************************
SUB ShowLinCol
LOCAL curPos AS LONG
LOCAL nLine AS LONG
LOCAL nCol AS LONG
LOCAL nLines AS LONG
LOCAL nTextLen AS LONG
LOCAL szText AS ASCIIZ * 255
curPos = SendMessage(GetEdit, %SCI_GETCURRENTPOS, 0, 0)
nLine = SendMessage(GetEdit, %SCI_LINEFROMPOSITION, curPos, 0) + 1
nCol = SendMEssage(GetEdit, %SCI_GETCOLUMN, curPos, 0) + 1
szText = " " & FORMAT$(nLine) & ":" & FORMAT$(nCol)
SendMessage hStatusbar, %SB_SETTEXT, 1, VARPTR(szText)
nLines = SendMessage(GetEdit, %SCI_GETLINECOUNT, 0, 0)
nTextLen = SendMessage(GetEdit, %SCI_GETTEXTLENGTH, 0, 0)
szText = " " & FORMAT$(nLines) & " lines, " & FORMAT$(nTextLen) & " characters"
SendMessage hStatusbar, %SB_SETTEXT, 2, VARPTR(szText)
END SUB
part three and end :)
FUNCTION ToggleFolding (BYVAL LineNumber AS LONG) AS LONG
LOCAL hEdit AS DWORD
LOCAL pSciWndData AS DWORD
hEdit = GetEdit
' Get direct pointer for faster access
pSciWndData = SendMessage(hEdit, %SCI_GETDIRECTPOINTER, 0, 0)
IF ISFALSE pSciWndData THEN EXIT FUNCTION
IF (SciMsg(pSciWndData, %SCI_GETFOLDLEVEL, LineNumber, 0) AND %SC_FOLDLEVELHEADERFLAG) = 0 THEN ' If is not the head line...
LineNumber = SciMsg(pSciWndData, %SCI_GETFOLDPARENT, LineNumber, 0) ' Get the number of the head line of the procedure or function
END IF
SciMsg pSciWndData, %SCI_TOGGLEFOLD, LineNumber, 0 ' Toggle the sub or function
SciMsg pSciWndData, %SCI_GOTOLINE, LineNumber, 0 ' Set the caret position
FUNCTION = LineNumber ' Return the current line
END FUNCTION
' *********************************************************************************************
SUB InitializePbKeywords
strPBKeyWords = "def bloat compile debug dim if include option pbforms register resource stack tools " & _
"abs accel accept access acode acode$ add addr alias all and any append array " & _
"arrayattr as asc ascend asciz asciiz asm at atn attach attrib bar base baud bdecl beep bin bin$ " & _
"binary bit bits break button bycmd bycopy byref byte byval calc call callback callstk callstk$ " & _
"callstkcount case catch cbctl cbctlmsg cbhndl cblparam cbmsg cbwparam cbyt ccur ccux " & _
"cd cdbl cdecl cdwd ceil cext chdir chdrive check check3state checkbox choose chr chr$ cint " & _
"client clng close cls clsid clsid$ codeptr collate color combobox comm command con connect const " & _
"control cos cqud create cset cset$ csng ctsflow cur curdir curdir$ currency currencyx cux cvbyt cvcur " & _
"cvcux cvd cvdwd cve cvi cvl cvq cvs cvwrd cwrd data datacount date date$ declare decr default " & _
"defbyt decur defcux defdbl defdwd defext defint deflng defqud defsng defstr defwrd delete " & _
"descend dialog dir dir$ disable diskfree disksize dispatch dll dllmain descend dllmain " & _
"do doevents double down draw dsrflow dsrsens strflow dtrline dword empty enable end environ environ$ " & _
"eof eqv erase err errapi errclear error error$ exe exit exp exp10 exp2 explicit export ext " & _
"extended extract extract$ fileattr filecopy GetFileNamee GetFileNamee$ filescan fill finally fix flow flush focus " & _
"font for format format$ formfeed frac frame freefile from function funcname funcname$ get get$ getattr global " & _
"gosub goto guid guid$ guidtxt guidtxt$ handle hex hex$ hibyt hiint hiwrd host icase icon idn iface iif iif$ " & _
"image imagex imgbutton imgbuttonx imp in incr inp inout input input# inputbox inputbox$ insert instr int " & _
"interface integer inv isfalse isnothing isobject istrue iterate join join$ kill label lbound " & _
"lcase lcase$ left left$ len let lib libmain line listbox lobyt loc local lock lof log log10 log2 loint " & _
"long loop lowrd lprint lset lset$ ltrim ltrim$ macro macrotemp main makdwd makint maklng makptr " & _
"makwrd mat max mcase mcase$ member menu mid mid$ min mkbyt mkbyt$ mkcur mkcur$ mkcux mkcux$ " & _
"mkd mkd$ mkdir mkdwd mkdwd$ mke mke$ mki mki$ mkl mkl$ mkq mkq$ mks mks$ mkwrd mkwrd$ mod modal " & _
"modeless mouseptr msgbox name new next none not nothing notify null objactive object objptr objresult " & _
"oct oct$ of off ob open opt option optional or out output page parity paritychar parityrepl paritytype " & _
"parse parse$ parsecount pbd pbmain peek peek$ pixels pointer poke poke$ popup port post preserve " & _
"print print# private profile progid progid$ ptr put put$ quad qword random randomize read read$ " & _
"receiver records recv redim redraw regexpr regrepl remain remain$ remove remove$ repeat repeat$ " & _
"replace reset resume ret16 ret32 ret87 retain$ retp16 retp32 retprn return rgb right right$ ring " & _
"rlsd rmdir rnd rotate round rset rtrim rtrim$ rtsflow rxbuffer rxque scan scrollbar sdecl seek " & _
"select send server set setattr seteof sgn shared shell shift show signed sin single size sizeof " & _
"sleep sort soace space$ spc sqr state static status stdcall step stop str str$ strdelete strdelete$ " & _
"string string$ strinsert strinsert$ strptr strreverse strreverse$ sub suspend swap switch " & _
"tab tab$ tagarray tally tan tcp text textbox then thread threadcount threadid time time$ timeout " & _
"timer to toggle trace trim trim$ trn try txbuffer txque type ubound ucase ucase$ ucode ucode$ udp union " & _
"units unlock until up user using using$ val variant variant# variant$ variantvt varptr verify version3 " & _
"version4 version5 wend while width winmain width width# word write write# xor xinpflow xoutflow zer " & _
"dispparams iunknown idispatch"
END SUB
best regards, frank
You're using sometimes hwndClient, which is 0, instead of ghwndClient. Also GetWindowtext to retrieve the text, instead of %SCI_GETTEXT, and other confusing things.
Why you don't look at the code in the SED editor instead of an unrelated Web Browser example?
BTW I no longer work with PB9.
that's not quite correct josé, you're using with "sed" editor some parts of codeproc() and using GetwindowText statement too, but to be truly I have to correct some parts of scintilla envolvement.
QuoteWhy you don't look at the code in the SED editor instead of an unrelated Web Browser example?
I've chosen your mdi webbrowser example for testing, because there was no other example for toolbar and mdi handling for using. I didn't want to use cWindow class. Yes, I have to check the code, but's not easy. my personal opinion is that sed is "overboarding" for a clear and simple way of "saving a file" (there are thousand ways to do that!) with "scintilla". So I tried to find another way. If I have time at week-end I will check this way. thanks at all for some hints. I am staying for working with pbwin 9. there's no reason for me for updating to issue 10.
best regards, frank
Here you have the webbrowser example modified to create instances of Scintilla instead of the Web Browser control, and a save file procedure that works.
Add wathever you wish to it.
Quote
I am staying for working with pbwin 9. there's no reason for me for updating to issue 10.
I think that you are doing a mistake, but this is your business.
QuoteHere you have the webbrowser example modified to create instances of Scintilla instead of the Web Browser control, and a save file procedure that works.
Add wathever you wish to it.
1) Many thanks for help, josé! "Scintilla + SaveFile" menu option do all work here for me now. And I have checked your scintilla setup it's few different from my first attempt and I have checked "SCI_SaveFile" function what was missing at my examples. I like scintilla and wanted to create such a little editor example with toolbar and scintilla features. I add in zip file my fixed and expanded version as *.bas file. thanks.
2) perhaps I will check closer all new features of pbwin 10 next year. I have a lot to work at my new job so there's unfortunately only a limited time for programming at the moment.
best regards and good night, frank