GordonR
May 15, 2011
' LB Help Search oefening8b.bas
' Author: Gordon Rahman
' Date: 10.04.11
'
' This code is free for personal use.
' You may not republish this code in its current form.
' You may modify this code for your personal use.
' You may publish a modified version of this code under these conditions:
' 1. You have made major changes to the code.
' 2. You give credit to the original author
' This a partial solution.
' Look out for next editions
' This code works with Vista when both files are placed in the
' Program Files directory.
nomainwin
'constants for tabControl:
TCIF.TEXT = 1
TCIF.IMAGE =2
TCS.MULTILINE = 512
TCM.INSERTITEMA = 4871
TCM.GETCURSEL = 4875
TCM.SETCURSEL = 4876
tabID = 1 'current tab
oldTab = 0 'previously selected tab
struct TCITEM,_
mask as ulong,_
dwState as ulong,_
dwStateMask as ulong,_
pszText$ as ptr,_
txtMax as long,_
iImage as long,_
lParam as long
'constants for SendmessageA
msg1 = _LB_GETSEL
msg2 = _LB_SETTOPINDEX
msg3 = _LB_SETSEL
'internet$="C:\Program files\Internet Explorer\IEXPLORE.EXE"
'helpDir$ = DefaultDir$+"\lb4help\LibertyBASIC_4_web\HTML\"
helpDir$ =DefaultDir$+"\lb4help\LibertyBASIC_4_web\HTML\"StartupDir$+"\lb4help\LibertyBASIC_4_web\HTML\"
dim info$(10,10)
files helpDir$, "*.htm", info$()
numFiles = val(info$(0,0)) 'print numFiles '(271)
dim a$(numFiles,1)
dim helpItem$(numFiles), helpItemFile$(numFiles), dispHelpFile$(500)
for i = 1 to numFiles
open helpDir$+info$(i,0) for input as #f
html$ = input$(#f, LOF(#f))
tagpos1 = instr(html$,"<TITLE>")
tagpos2 = instr(html$,"</TITLE>")
Title$ = mid$(html$,tagpos1+7,(tagpos2-tagpos1-7))
a$(i,0) = Title$
a$(i,1) = info$(i,0)
close #f
next
sort a$(),1,numFiles,0
for t = 1 to numFiles
'print a$(t,0);:print tab(45);a$(t,1)
helpItem$(t) = a$(t,0)
helpItemFile$(t) = a$(t,1)
'print helpItem$(t);:print tab(45);helpItemFile$(t)+ "3"
next t
'helpItem$(0) = " ": helpItemFile$(0) = " "
openDefaultDir$+"\oefBB.txt"StartupDir$+"\oefBB.txt" for input as #f
i= 0
while not(eof(#f))
txt$ = INPUTTO$(#f, chr$(13)) 'use an enter as delimiter
i = i + 1
wend
dim oefBB$(i)
itemsOefBB = i
close #f
openDefaultDir$+"\oefBB.txt"StartupDir$+"\oefBB.txt" for input as #f
i= 0
while not(eof(#f))
txt$ = INPUTTO$(#f, chr$(13))
i = i + 1
oefBB$(i) = txt$
wend
close #f
'initialize DLL
calldll #comctl32, "InitCommonControls", ret as void
'first page
WindowWidth=435:WindowHeight=455
UpperLeftX = 300 : UpperLeftY = 200
'stylebits #tab1.listbox1, _LBS_SORT,0,0,0
listbox #tab1.listbox1, helpItem$(, [listbox1DoubleClick], 20, 145, 390, 225
button #tab1.button2,"Display Item",[button2Click], UL, 100, 377, 95, 25
button #tab1.button3,"Print",[button3Click], UL, 210, 377, 85, 25
button #tab1.button4,"Annulate",[button4Click], UL, 310, 377, 95, 25
statictext #tab1.statictext5, "2. Select Item and press Display button ", 20, 112, 250, 20
textbox #tab1.textbox6, 20, 62, 390, 35
statictext #tab1.statictext7, "1. Type first letter of search item", 15, 37, 250, 20
Stylebits #tab1, 0, 0, _WS_EX_CLIENTEDGE, 0 'Stylebits #tab1, _WS_DLGFRAME,0,0,0
open "" for window as #tab1
'second page
stylebits #tab2.sttxt2,_WS_DLGFRAME, 0, 0, 0
stylebits #tab2.sttxt1,0, 0, _WS_EX_STATICEDGE, 0
Stylebits #tab2, 0, 0, _WS_EX_CLIENTEDGE, 0
Stylebits #tab2.listbox2, _LBS_MULTIPLESEL,0, 0, 0
statictext #tab2.sttxt2, "", 220, 340, 200, 30
statictext #tab2.sttxt1, "", 10, 340, 200, 30
combobox #tab2.combobox1, array$(, [combobox1DoubleClick], 10, 30, 280, 77
listbox #tab2.listbox2, oefBB$(, [listbox2DoubleClick], 10, 095, 280, 110
listbox #tab2.listbox3, dispHelpFile$(, [listbox3DoubleClick], 10, 235, 410, 100
button #tab2.button4," Wissen ",[button4Click], UL, 300, 60, 122, 25
button #tab2.button5," Opties... ",[button5Click], UL, 300, 90, 122, 25
button #tab2.button6,"Vergelijkbare ",[button6Click], UL, 300, 120, 122, 25
button #tab2.button7," SEARCH NOW ",[button7Click], UL, 300, 150, 121, 25
button #tab2.button8,"Opnieuw zoeken",[button8Click], UL, 300, 180, 121, 26
button #tab2.button9," Weergeven ",[button9Click], UL, 10, 375, 130, 25
button #tab2.button10,"Afdrukken....",[button10Click], UL, 155, 375, 120, 25
button #tab2.button11," Annuleren ",[button11Click], UL, 290, 375, 130, 25
open "" for window_popup as #tab2
#tab2.listbox2 "singleclickselect"
'main program window
WindowWidth = 475:WindowHeight = 500
open "Help-subject: Liberty BASIC for Windows v4.04" for window as #1
#1 "trapclose [quit]"
#1 "font ms_sans_serif 10"
#tab1.listbox1 "singleclickselect"
#tab1.listbox1,"reload"
'#tab1.button3 "!disable"
hwndListbox1 = hwnd(#tab1.listbox1)
hwndListbox2 = hwnd(#tab2.listbox2)
hwndParent = hwnd(#1) 'retrieve window handle
hTab1=hwnd(#tab1):hTab2=hwnd(#tab2) ':hTab3=hwnd(#tab3)
dim winTab(2) 'hold tab window handles in array
winTab(0)=hTab1:winTab(1)=hTab2
'set popups to be children of main program window
for i = 0 to 1
call SetParent hwndParent,winTab(i)
next
'move child windows (init)
gosub [clear]
call MoveWindow hTab1, 20,40,430,410
' Get window instance handle
CallDLL #user32, "GetWindowLongA",_
hwndParent As ulong,_ 'parent window handle
_GWL_HINSTANCE As long,_'flag to retrieve instance handle
hInstance As ulong 'instance handle
' Create control
style = _WS_CHILD or _WS_CLIPSIBLINGS or _WS_VISIBLE _
or TCS.MULTILINE
calldll #user32, "CreateWindowExA",_
0 As long,_ ' extended style
"SysTabControl32" as ptr,_ ' class name
"" as ptr,_
style as long,_ ' style
20 as long,_ ' left x was 10 (no stylebits)
16 as long,_ ' top y was 10
430 as long,_ ' width was 450
430 as long,_ ' height was 450
hwndParent as ulong,_ ' parent hWnd
0 as long,_
hInstance as ulong,_ ' hInstance
"" as ptr,_
hwndTab as ulong ' tab control handle
'set mask and fill struct members:
TCITEM.mask.struct = TCIF.TEXT or TCIF.IMAGE
TCITEM.iImage.struct = -1 'no image
TCITEM.pszText$.struct = "Index "
'add first tab:
calldll #user32, "SendMessageA",_
hwndTab as ulong,_
TCM.INSERTITEMA as long,_
0 as long,_ 'zero-based, so 0=first tab
TCITEM as struct,_
ret as long
'add second tab:
TCITEM.pszText$.struct = "Search"
calldll #user32, "SendMessageA",_
hwndTab as ulong,_
TCM.INSERTITEMA as long,_
1 as long,_ 'zero-based, so 1=second tab
TCITEM as struct,_
ret as long
calldll #gdi32, "GetStockObject",_
0 as long, hFont as ulong 'was _DEFAULT_GUI_FONT
'set the font to the control:
CallDLL #user32, "SendMessageA",_
hwndTab As ulong,_ 'tab control handle
_WM_SETFONT As long,_ 'message
hFont As ulong,_ 'handle of font
1 As long,_ 'repaint flag
ret As long
timer 400, [checkForTab]
calldll #user32, "SetFocus",hwndParent as ulong,re as ulong
wait
[quit]
timer 0
close #1:close #tab1:close #tab2 :end
[checkForTab] 'see if selected tab is the same
'as previously selected tab and
'change controls if tab has changed
'get the current tab ID
calldll #user32, "SendMessageA",_
hwndTab as ulong,_ 'tab control handle
TCM.GETCURSEL as long,_ 'message to get current selection
0 as long, 0 as long,_ 'always 0's
tabID as long 'returns selected tab ID
if tabID <> oldTab then 'change page displayed
oldTab = tabID 'for next check of selected tab
gosub [clear]
call MoveWindow winTab(tabID), 20,40,430,410
end if
if tabID = 0 then [txtb6]
if tabID = 1 then
kg = 0 :redim dispHelpFile$(500)
goto [combb2]
end if
wait
'-------------------------------------------------------------------
[txtb6]
#tab1.textbox6 "!setfocus"
#tab1.textbox6 "!contents? a$"
if a$ = "" then wait
a$ = Upper$(a$)
'a$ = Upper$(left$(a$,1))+right$(a$,len(a$)-1)
for index = 1 to numFiles
'if instr(upper$(helpItem$(index)),a$) >0 then
if left$(Upper$(helpItem$(index)),len(a$)) = a$ then
#tab1.listbox1 "selectindex ";index
call SendM hwndListbox1,msg2,index-1,0
'sTT = settop(hwndListbox1,index-1)
'#tab1.listbox1 "select ";helpItem$(index)
exit for
end if
next
wait
[listbox1DoubleClick]
#tab1.listbox1 "selection? sel$"
#tab1.textbox6 sel$
[button2Click]
#tab1.listbox1 "selectionindex? selIndex"
#tab1.listbox1 "selection? sel$"
#tab1.textbox6 sel$
'print helpItemFile$(selIndex)
'run internet$ + " " + DefaultDir$ + "\lb4help\LibertyBASIC_4_web\html\"+helpItemFile$(selIndex)
displayItem$ = helpDir$+helpItemFile$(selIndex)
run "rundll32.exe url.dll,FileProtocolHandler " + displayItem$
wait
'------------------------------------------------------------------
[combb2]
#tab2.combobox1 "setfocus"
#tab2.combobox1 "contents? a$"
if a$ = "" then wait
'a$ = Upper$(left$(a$,1))+right$(a$,len(a$)-1)
for index = 1 to 898
if left$(oefBB$(index),len(a$)) = a$ then
call SendM hwndListbox2,msg2,index-1,0
'sTT = settop(hwndListbox2,index)
'#tab2.listbox2 "select ";oefBB$(index)
exit for
end if
next
wait
[listbox2DoubleClick]
#tab2.listbox2 "selection? sel$"
#tab2.combobox1 "!" ';left$(sel$,1)
for i = 1 to numFiles
'open helpDir$ + info$(i,0) for input as #file
open helpDir$ + helpItemFile$(i) for input as #file
txt$ = INPUT$(#file, lof(#file))
if instr(txt$,sel$)>0 then
kg = kg + 1
dispHelpFile$(kg) = sel$ + " found in file:";helpItem$(i)
'print dispHelpFile$(kg)
end if
close #file
#tab2.listbox3 "reload"
next
wait
[listbox3DoubleClick]
'rem
[button9Click]
#tab2.listbox3 "selection? sel$"
sel$ = mid$(sel$,instr(sel$,":")+ 1)
print sel$
for t = 1 to numFiles
if helpItem$(t) = sel$ then
selIndex = t
print helpItemFile$(t)
end if
next t
displayItem$ = helpDir$+helpItemFile$(selIndex)
run "rundll32.exe url.dll,FileProtocolHandler " + displayItem$
wait
[button7Click]
wait
[clear] 'hide all windows
for i = 0 to 1 '2
call MoveWindow winTab(i), 3000,3000 ,450,450
next
return
Function GetParent(hWnd)
calldll #user32, "GetParent",hWnd as ulong,_
GetParent as ulong
End Function
Sub SetParent hWnd,hWndChild
CallDLL #user32, "SetParent", hWndChild As uLong,_
hWnd As uLong, result As uLong
style = _WS_CHILD or _WS_VISIBLE
CallDLL #user32, "SetWindowLongA",_
hWndChild As ulong, _GWL_STYLE As long,_
style As Long, r As long
End Sub
Sub MoveWindow hWnd,x,y,w,h
CallDLL #user32, "MoveWindow",hWnd As uLong,_
x As Long, y As Long,w As Long, h As Long,_
1 As long, r As long
End Sub
Sub SendM handl,msg,Wp,Lp
calldll #user32, "SendMessageA",_
handl as ulong,_
msg as long,_
Wp as long,_
Lp as long,_
retSendM as long
End Sub
function settop(hwndListbox,index)
calldll #user32, "SendMessageA",_
hwndListbox as ulong,_
_LB_SETTOPINDEX as long,_
index as long,_
ret as long
end function