GordonR
May 22, 2011
' LB Help Search oefening8b.bas
' Author: Gordon Rahman
' Date:10.05.1120.05.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
nomainwin
' check for valid LB version
if Version$ <> "4.04" then
notice "Wrong LB Version!"; chr$(13);_
"This add-on is only valid for LB v4.04!"; chr$(13);_
"Exiting ... (StartupDir$ function missing)"
end
end if
' initialize variables
'LbInstallDir$ = GetFolder$(GetModuleFileName$())
'print StartupDir$
'print LbInstallDir$
' HelpFileRoot$ = LbInstallDir$; "lb4help\LibertyBASIC_4_web\html\"
' HelpFileIndex$ = LbInstallDir$; "lb4help\LibertyBASIC_4.html"
' HelpFilePattern$ = "*.htm"
' InitialTitle$ = "Index"
' InitialPage$ = HelpFileIndex$
'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$ = 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
helpItem$(t) = a$(t,0)
helpItemFile$(t) = a$(t,1)
next t
open DefaultDir$+"\oefBB.txt" for input as #f
i= 0
while not(eof(#f))
txt$ = INPUTTO$(#f, chr$(13)) 'use an enter as delimiter
itemsInOef = itemsInOef + 1
wend
dim oefBB$(itemsInOef)
close #f
open DefaultDir$+"\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,"Cancel",[quit], 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.sttxt1,0, 0, _WS_EX_STATICEDGE, 0
'stylebits #tab2.sttxt2,0, 0, _WS_EX_STATICEDGE, 0
stylebits #tab2.sttxt1,_WS_DLGFRAME, 0, 0, 0
stylebits #tab2.sttxt2,_WS_DLGFRAME, 0, 0, 0
Stylebits #tab2, 0, 0, _WS_EX_CLIENTEDGE, 0
Stylebits #tab2.listbox2, _LBS_MULTIPLESEL,0, 0, 0
statictext #tab2.txt0, "1. Typ words you are looking for", 10, 10, 200, 20
statictext #tab2.txt1, "2. Do some <Fine Tuning> when needed", 10, 75, 200, 20
statictext #tab2.txt2, "3. Doubleclick/Singleclick select/de-select and Display Helpfile", 10, 215, 300, 20
statictext #tab2.sttxt2, "Options: ", 220, 340, 200, 30
statictext #tab2.sttxt1, "", 10, 340, 200, 30
combobox #tab2.combobox1, oefBB$(, [combobox1DoubleClick], 10, 30, 280, 70
listbox #tab2.listbox2, oefBB$(, [listbox2DoubleClick], 10, 095, 280, 100
listbox #tab2.listbox3, dispHelpFile$(, [listbox3DoubleClick], 10, 235, 410, 100
button #tab2.button4," Clear ",[button4Click], UL, 300, 30, 122, 25
button #tab2.button5," Options... ",[button5Click], UL, 300, 60, 122, 25
button #tab2.button6,"Fine Tuning ",[button4Click], UL, 300, 100, 122, 25
button #tab2.button7," Search now ",[button7Click], UL, 300, 130, 121, 25
button #tab2.button8,"Rebuild dbase ",[button8Click], UL, 300, 170, 121, 26
button #tab2.button9,"Display Helpfile",[button9Click], UL, 10, 375, 130, 25
button #tab2.button10,"Print....",[button10Click], UL, 155, 375, 120, 25
button #tab2.button11," Cancel ",[quit], UL, 290, 375, 130, 25
open "" for window_popup as #tab2
'#tab2.listbox2 "singleclickselect"
'#tab2.button6 "!disable"
'#tab2.button7 "!disable"
#tab2.button10 "!disable"
'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 #tab2.combobox1 "setfocus" :wait
'a$ = Upper$(left$(a$,1))+right$(a$,len(a$)-1)
for index = 1 to itemsInOef
if left$(oefBB$(index),len(a$)) = a$ then
#tab2.listbox2 "selectindex ";index
call SendM hwndListbox2,msg2,index-1,0
'sTT = settop(hwndListbox2,index)
'#tab2.listbox2 "select ";oefBB$(index)
exit for
end if
next
wait
[button7Click]
#tab2.combobox1 "contents? sel$"
#tab2.listbox2 "select sel$"
goto[frombutton7Click]
[listbox2DoubleClick]
#tab2.listbox2 "selection? sel$"
#tab2.combobox1 "!" ';left$(sel$,1)
'sel$ = sel$+" "
[frombutton7Click]
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
#tab2.sttxt1 str$(kg) + " objects found"
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
[button5Click] 'search options
WindowWidth = 320
WindowHeight = 410
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
groupbox #dlgmain.groupbox2, "Search for words with", 10, 7, 295, 130
groupbox #dlgmain.groupbox1, "Start searching with", 10, 212, 295, 125
groupbox #dlgmain.groupbox6, "Display all words that starts with", 10, 142, 295, 65
button #dlgmain.button3,"OK",[okbutton], UL, 10, 347, 96, 25
button #dlgmain.button4,"Cancel",[dlg.quit], UL, 110, 347, 96, 25
button #dlgmain.button5,"File...",[filesbutton], UL, 210, 347, 96, 25
radiobutton #dlgmain.radiobutton7, "All words in random order", [r7Set], [r7Reset], 20, 27, 176, 25
radiobutton #dlgmain.radiobutton8, "At least one word found in doc", [r8Set], [r8Reset], 20, 47, 199, 25
radiobutton #dlgmain.radiobutton9, "All words in exact order", [r9Set], [r9Reset], 20, 67, 162, 25
checkbox #dlgmain.checkbox10, "Display matching word groups", [checkbox10Set], [checkbox10Reset], 60, 87, 205, 25
combobox #dlgmain.combobox11, array$(, [combobox11DoubleClick], 25, 167, 260, 100
radiobutton #dlgmain.radiobutton12, "RadioButton Caption", [r12Set], [r12Reset], 20, 242, 148, 25
radiobutton #dlgmain.radiobutton13, "RadioButton Caption", [r13Set], [r13Reset], 20, 262, 148, 25
checkbox #dlgmain.checkbox14, "CheckBox Caption", [checkbox14Set], [checkbox14Reset], 70, 287, 135, 25
open "Search Options:" for dialog_modal as #dlgmain
print #dlgmain, "font ms_sans_serif 11"
print #dlgmain, "trapclose [dlg.quit]"
'wait here for input event
wait
[checkbox10Set] 'Perform action for the groupbox named 'groupbox6'
'Insert your own code here
wait
[checkbox10Reset] 'Perform action for the groupbox named 'groupbox6'
'Insert your own code here
wait
[okbutton] 'Perform action for the button named 'button3'
'Insert your own code here
wait
'[cancelbutton] 'Perform action for the button named 'button4'
'Insert your own code here
' wait
[filesbutton] 'Perform action for the button named 'button5'
'Insert your own code here
wait
[r7Set] 'Perform action for the radiobutton named 'radiobutton7'
'Insert your own code here
wait
[r7Reset] 'Perform action for the radiobutton named 'radiobutton7'
'Insert your own code here
wait
[r8Set] 'Perform action for the radiobutton named 'radiobutton8'
'Insert your own code here
wait
[r8Reset] 'Perform action for the radiobutton named 'radiobutton8'
'Insert your own code here
wait
[r9Set] 'Perform action for the radiobutton named 'radiobutton9'
'Insert your own code here
wait
[r9Reset] 'Perform action for the radiobutton named 'radiobutton9'
'Insert your own code here
wait
[combobox11DoubleClick] 'Perform action for the combobox named 'combobox11'
'Insert your own code here
wait
[r12Set] 'Perform action for the radiobutton named 'radiobutton12'
'Insert your own code here
wait
[r12Reset] 'Perform action for the radiobutton named 'radiobutton12'
'Insert your own code here
wait
[r13Set] 'Perform action for the radiobutton named 'radiobutton13'
'Insert your own code here
wait
[r13Reset] 'Perform action for the radiobutton named 'radiobutton13'
'Insert your own code here
wait
[checkbox14Set] 'Perform action for the checkbox named 'checkbox14'
'Insert your own code here
wait
[checkbox14Reset] 'Perform action for the checkbox named 'checkbox14'
'Insert your own code here
wait
[dlg.quit] 'End the program
close #dlgmain
wait
[button4Click]
#tab2.combobox1 "!"
wait
'[button6Click]
' #tab2.combobox1 "!"
'wait
[button8Click]
notice "rebuilding OEF.txt ... again coming soon!"
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
function GetFolder$(Path$)
pos = 1
GetFolder$ = Path$
while pos > 0
pos = instr(Path$, "\", pos)
if pos > 0 then
GetFolder$ = left$(Path$, pos)
pos = pos + 1
end if
wend
end function
function GetModuleFileName$()
nSize = _MAX_PATH + 1
lpFilename$ = space$(nSize); CHR$(0)
calldll #kernel32, "GetModuleFileNameA",_
hModule as uLong,_
lpFilename$ as ptr,_
nSize as uLong,_
result as uLong
if result > 0 then GetModuleFileName$ = trim$(lpFilename$)
end function
[combobox1DoubleClick]
print "some for me not understandable error found"
wait