Older Version
Newer Version
JanetTerra
May 1, 2011
My submission
[[code format="lb"]]
' LB Help File Searcher
' Janet Terra
' May 1, 2011
'
' 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 authors
'
' Credit for this program goes to members of the Liberty BASIC
' community, most especially Alyce Watson and Stefan Pendl.
' Snippets absorbed and regurgitated by Janet Terra
' Note re: page navigators (previous and next)
' Only pages selected by the listbox are stored
' The navigation buttons have no effect on redisplaying
' pages hyperlinked to within the html pages themselves
'
' Get the path to the Html Help Files and Images - Thanks to Stefan Pendl
LBModulePath$ = GetModuleFileName$() ' Path to liberty44.exe
LBHelpPath$ = GetLBPath$(LBModulePath$);"lb4help\LibertyBASIC_4_web\html\" ' Path to Html Help Files
LBHelpIndex$ = LBHelpPath$;"libe3mnn.htm" ' The LB Index file
LBBmpPath$ = GetLBPath$(LBModulePath$);"bmp\"
bttnSearch$ = LBBmpPath$;"SEARCH.BMP"
' Fill an array with command references
dim cmd$(8)
cmd$(1) = "Commands A - C";chr$(0);LBHelpPath$;"LIBE2CO3.HTM"
cmd$(2) = "Commands D - F";chr$(0);LBHelpPath$;"LIBE2M5I.HTM"
cmd$(3) = "Commands G - K";chr$(0);LBHelpPath$;"LIBE2VMZ.HTM"
cmd$(4) = "Commands L - M";chr$(0);LBHelpPath$;"LIBE3BFX.HTM"
cmd$(5) = "Commands N - P";chr$(0);LBHelpPath$;"LIBE3HRK.HTM"
cmd$(6) = "Commands R - S";chr$(0);LBHelpPath$;"LIBE3UER.HTM"
cmd$(7) = "Commands T - Z";chr$(0);LBHelpPath$;"LIBE40QF.HTM"
cmd$(8) = "Index";chr$(0);LBHelpPath$;"libe3mnn.HTM"
' Define a struct to hold window dimensions - Thanks to Bill Beasley
struct rcClient, _
xLeft as long, _
yUpper as long, _
xRight as long, _
yLower as long
' Define a string to hold the viewed pages
pageIndex$ = ""
viewPage = 1
bttnPrev$ = LBBmpPath$;"LBTTN.BMP"
bttnNext$ = LBBmpPath$;"RBTTN.BMP"
' The GUI
WindowWidth = 800
WindowHeight = 600
UpperLeftX = int((DisplayWidth - WindowWidth) / 2)
UpperLeftY = int((DisplayHeight - WindowHeight) / 2)
stylebits #main.cmd, 0, _WS_BORDER, 0, 0
graphicbox #main.cmd, 590, 40, 180, 100
bmpbutton #main.prev, bttnPrev$, [prevPage], UL, 650, 144
bmpbutton #main.next, bttnNext$, [nextPage], UL, 690, 144
textbox #main.srch, 600, 180, 150, 30
stylebits #main.go, _BS_DEFPUSHBUTTON or _BS_BITMAP, 0, 0, 0
button #main.go, "", [search], UL, 750, 180, 30, 30
listbox #main.mtch, matchFiles$(), [DisplayHtml], 600, 220, 180, 330
graphicbox #main.atl, 20, 20, 565, 530
open "Search LB Help HTML Files" for window_nf as #main
' Load the button images
loadbmp "bttnPrev", bttnPrev$
hButton1 = hwnd(#main.prev)
hBitmap1 = hbmp("bttnPrev")
call SendMessageA hButton1, _BM_SETIMAGE, _IMAGE_BITMAP, hBitmap1
loadbmp "bttnNext", bttnNext$
hButton2 = hwnd(#main.next)
hBitmap2 = hbmp("bttnNext")
call SendMessageA hButton2, _BM_SETIMAGE, _IMAGE_BITMAP, hBitmap2
loadbmp "bttnSearch", bttnSearch$
hButton3 = hwnd(#main.go)
hBitmap3 = hbmp("bttnSearch")
call SendMessageA hButton3, _BM_SETIMAGE, _IMAGE_BITMAP, hBitmap3
' Relocate controls
call GetClientRect hwnd(#main)
xMain = rcClient.xLeft.struct
wMain = rcClient.xRight.struct
yMain = rcClient.yUpper.struct
tMain = rcClient.yLower.struct
#main.atl "locate 10 10 565 ";tMain - 30
#main.cmd "locate ";wMain - 210;" 40 190 100"
#main.cmd "down; backcolor buttonface"
call CommandReferences
#main.cmd "flush"
#main.prev "locate ";wMain - 150;" 140 30 30"
#main.next "locate ";wMain - 110;" 140 30 30"
#main.srch "!locate ";wMain - 210;" 180 160 30"
#main.go "!locate ";wMain - 50;" 180 30 30"
#main.mtch "locate ";wMain - 210;" 220 190 ";tMain - 240
#main "font verdana 10"
#main "refresh"
#main.mtch "singleclickselect"
#main "trapclose [quit]"
#main.cmd "when mouseMove [htmlCursor]"
#main.cmd "when leftButtonUp [DisplayAlphCommands]"
#main.prev "disable"
#main.next "disable"
' Convert graphicbox to browser display using ATL dll - Thanks to Alyce Watson and Stefan Pendl
hMain = hwnd(#main)
hBrowserContainer = hwnd(#main.atl)
open "atl" for dll as #atl
calldll #atl, "AtlAxWinInit", _
ATLinitialized as long
styleATL = _WS_CHILD or _WS_VISIBLE or _WS_VSCROLL or _WS_HSCROLL
calldll #user32, "GetWindowLongA", _
hMain as ulong, _
_GWL_HINSTANCE as long, _
hInst as ulong
hATL = CreateWindowExA(LBHelpIndex$, styleATL, hBrowserContainer, hInst)
htmlFile$ = LBHelpIndex$
' pageIndex$ holds the first displayed page
pageIndex$ = LBHelpIndex$
' Disable search textbox while html files being read
#main.srch "!Disable"
' Use files() command to find number of Html Help Files
dim info$(10, 10)
files LBHelpPath$, info$()
nHtmlFiles = val(info$(0, 0)) ' Total number of LB Html Help Files
' Searchbox phrases
lp$ = "Loading . . . "
LoadingPhrase$ = ""
for i = 1 to nHtmlFiles / 15
LoadingPhrase$ = LoadingPhrase$;lp$
next i
sp$ = "Searching . . . "
SearchingPhrase$ = ""
for i = 1 to nHtmlFiles / 15
SearchingPhrase$ = SearchingPhrase$;sp$
next i
' Store the file names in an array
dim htmlFiles$(nHtmlFiles)
for i = 1 to nHtmlFiles
htmlFiles$(i) = info$(i, 0)
next i
' Store contents of each file in htmlFiles$()
for i = 1 to nHtmlFiles
html$ = LBHelpPath$;htmlFiles$(i)
open html$ for input as #1
contents$ = input$(#1, LOF(#1))
htmlFiles$(i) = htmlFiles$(i);chr$(0);contents$
close #1
next i
' Store the title of each file in htmlFiles$()
n = 0
for i = 1 to nHtmlFiles
n = n + 1
if n mod 25 = 0 then
#main.srch right$(LoadingPhrase$, n)
end if
htmlTitle$ = ExtractHtmlTitle$(htmlFiles$(i))
htmlFiles$(i) = htmlTitle$;chr$(0);htmlFiles$(i)
next i
' htmlFiles$() format
' htmlTitle$;chr$(0);htmlFilePath$;chr$(0);htmlContents$
' Alphabetize by title
sort htmlFiles$(), 1, nHtmlFiles
' Define an array to hold html files containing search item
dim matchFiles$(nHtmlFiles)
for i = 1 to nHtmlFiles
matchFiles$(i) = htmlFiles$(i)
next i
' Load the match listbox
#main.mtch "reload"
' Enable search textbox
#main.srch "Search for ..."
#main.srch "!enable"
' Load pointing hand cursor - Thanks to Gordon Sweet
hCmd = hwnd(#main.cmd)
call SetClass hCmd
nCursor = 32649
hCursor = LoadCursor(nCursor)
wait
[DisplayAlphCommands]
if cmd <> 0 then
if word$(cmd$(cmd), 2, chr$(0)) <> htmlFile$ then
pageIndex$ = pageIndex$;chr$(0);word$(cmd$(cmd), 2, chr$(0))
viewPage = vPages(pageIndex$)
if viewPage > 1 then
#main.prev "enable"
end if
#main.next "disable"
end if
htmlFile$ = word$(cmd$(cmd), 2, chr$(0))
call DestroyWindow hATL
hATL = CreateWindowExA(htmlFile$, styleATL, hBrowserContainer, hInst)
end if
wait
[DisplayHtml]
#main.mtch "selectionindex? nPage"
p$ = LBHelpPath$;word$(matchFiles$(nPage), 2, chr$(0))
if htmlFile$ <> p$ then
pageIndex$ = pageIndex$;chr$(0);p$
viewPage = vPages(pageIndex$)
if viewPage > 1 then
#main.prev "enable"
end if
end if
#main.next "disable"
htmlFile$ = LBHelpPath$;word$(matchFiles$(nPage), 2, chr$(0))
call DestroyWindow hATL
hATL = CreateWindowExA(htmlFile$, styleATL, hBrowserContainer, hInst)
wait
[search]
#main.srch "!contents? search$"
nSearchFiles = FindMatch(nHtmlFiles, search$)
#main.mtch "reload"
wait
[prevPage]
viewPage = max(viewPage - 1, 1)
if viewPage = 1 then
#main.prev "disable"
else
#main.prev "enable"
end if
if viewPage = nPages then
#main.next "disable"
else
#main.next "enable"
end if
htmlFile$ = word$(pageIndex$, viewPage, chr$(0))
call DestroyWindow hATL
hATL = CreateWindowExA(htmlFile$, styleATL, hBrowserContainer, hInst)
wait
[nextPage]
viewPage = min(viewPage + 1, vPages(pageIndex$))
if viewPage = 1 then
#main.prev "disable"
else
#main.prev "enable"
end if
if viewPage = vPages(pageIndex$) then
#main.next "disable"
else
#main.next "enable"
end if
htmlFile$ = word$(pageIndex$, viewPage, chr$(0))
call DestroyWindow hATL
hATL = CreateWindowExA(htmlFile$, styleATL, hBrowserContainer, hInst)
wait
[htmlCursor]
xVar = MouseX
yVar = MouseY
cmd = 0
select case
case yVar > 28 and yVar < 42
select case
case xVar > 37 and xVar < 63
cmd = 1
case xVar > 77 and xVar < 103
cmd = 2
case xVar > 117 and xVar < 143
cmd = 3
end select
case yVar > 50 and yVar < 64
select case
case xVar > 10 and xVar < 36
cmd = 4
case xVar > 55 and xVar < 83
cmd = 5
case xVar > 100 and xVar < 126
cmd = 6
case xVar > 144 and xVar < 170
cmd = 7
end select
case yVar > 72 and yVar < 86
if xVar > 30 then
if xVar < 150 then
cmd = 8
end if
end if
end select
if cmd = 0 then
nCursor = 0
cursor normal
else
nCursor = 32649
call SetCursor hCursor
end if
wait
[quit]
call DestroyWindow hATL
close #atl
close #main
end
function FindMatch(nFiles, search$)
ct = 0
redim matchFiles$(nFiles)
for ii = 1 to nFiles
contents$ = word$(htmlFiles$(ii), 1, chr$(0));word$(htmlFiles$(ii), 3, chr$(0))
if instr(upper$(contents$), upper$(search$)) > 0 then
ct = ct + 1
matchFiles$(ct) = htmlFiles$(ii)
end if
next ii
FindMatch = ct
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 if
end function
function GetLBPath$(LBModulePath$)
pos = 0
for ii = len(LBModulePath$) to 1 step -1
if mid$(LBModulePath$, ii, 1) = "\" then
pos = ii
exit for
end if
next ii
GetLBPath$ = left$(LBModulePath$, pos)
end function
function ExtractHtmlTitle$(contents$)
c1a$ = ""
c1b$ = ""
c2$ = ""
tag1a$ = "<A NAME=";chr$(34)
tag1b$ = chr$(34);"></A><B>"
tag2$ = "</B></P>"
pos1a = 0
pos1b = 0
pos2 = 0
if instr(upper$(contents$), tag1a$) > 0 then
pos1a = instr(upper$(contents$), tag1a$) + len(tag1a$) + 1
c1a$ = mid$(contents$, pos1a)
end if
if instr(upper$(c1a$), tag1b$) > 0 then
pos1b = instr(upper$(c1a$), tag1b$) + len(tag1b$)
c1b$ = mid$(c1a$, pos1b)
end if
if instr(upper$(c1b$), tag2$) > 0 then
pos2 = instr(upper$(c1b$), tag2$) - 1
ExtractHtmlTitle$ = trim$(left$(c1b$, pos2))
end if
if ExtractHtmlTitle$ <> "" then
exit function
end if
tag1$ = "<P><B>"
tag2$ = "</B></P>"
pos1 = instr(upper$(contents$), tag1$) + len(tag1$)
c1$ = mid$(contents$, pos1)
pos2 = instr(upper$(c1$), tag2$)
ExtractHtmlTitle$ = left$(c1$, pos2 - 1)
end function
sub SendMessageA hControl, param1, param2, param3
calldll #user32, "SendMessageA", _
hControl as ulong, _
param1 as long, _
param2 as long, _
param3 as long, _
result as long
end sub
sub GetClientRect hControl
calldll #user32, "GetClientRect", _
hControl as ulong, _
rcClient as struct, _
result as long
end sub
function CreateWindowExA(page$, style, hParent, hInst)
call GetClientRect hwnd(#main)
wATL = rcClient.xRight.struct - 230
tMain = rcClient.yLower.struct - 30
calldll #user32, "CreateWindowExA", _
_WS_EX_CLIENTEDGE as ulong, _
"ATLAxWin" as ptr, _
page$ as ptr, _
style as ulong, _
0 as long, _
0 as long, _
wATL as long, _
tMain as long, _
hParent as ulong, _
_NULL as ulong, _
hInst as ulong, _
_NULL as ulong, _
CreateWindowExA as ulong
end function
sub SetClass hControl
index = _GCL_HCURSOR or 0
calldll #user32, "SetClassLongA", _
hControl as ulong, _
index as long, _
0 as long, _
result as long
end sub
sub SetCursor hCursor
calldll #user32, "SetCursor", _
hCursor as ulong, _
result as long
end sub
function LoadCursor(nCursor)
flags = hexdec("8000") or _LR_DEFAULTSIZE
calldll #user32, "LoadImageA", _
0 as long, _
nCursor as long, _
_IMAGE_CURSOR as long, _
0 as long, _
0 as long, _
flags as long, _
hCursor as uLong
call SetCursor hCursor
LoadCursor = hCursor
end function
sub DestroyWindow hATL
calldll #user32, "DestroyWindow", _
hATL as ulong, _
result as long
end sub
sub CommandReferences
#main.cmd "place -10 -10; boxfilled 210 110"
#main.cmd "font verdana 10 bold; color black"
t$ = "LB Command References"
#main.cmd "stringwidth? t$ wdth"
#main.cmd "place ";int(90 - wdth / 2);" 16"
#main.cmd "\";t$
#main.cmd "font verdana 10 underscore; color blue"
t$ = "A-C"
#main.cmd "stringwidth? t$ wdth"
#main.cmd "place ";int(50 - wdth / 2);" 40"
#main.cmd "\";t$
t$ = "D-F"
#main.cmd "stringwidth? t$ wdth"
#main.cmd "place ";int(90 - wdth / 2);" 40"
#main.cmd "\";t$
t$ = "G-K"
#main.cmd "stringwidth? t$ wdth"
#main.cmd "place ";int(130 - wdth / 2);" 40"
#main.cmd "\";t$
t$ = "L-M"
#main.cmd "stringwidth? t$ wdth"
#main.cmd "place ";int(23 - wdth / 2);" 62"
#main.cmd "\";t$
t$ = "N-P"
#main.cmd "stringwidth? t$ wdth"
#main.cmd "place ";int(68 - wdth / 2);" 62"
#main.cmd "\";t$
t$ = "R-S"
#main.cmd "stringwidth? t$ wdth"
#main.cmd "place ";int(113 - wdth / 2);" 62"
#main.cmd "\";t$
t$ = "T-Z"
#main.cmd "stringwidth? t$ wdth"
#main.cmd "place ";int(157 - wdth / 2);" 62"
#main.cmd "\";t$
t$ = "Quick Start Guide"
#main.cmd "stringwidth? t$ wdth"
#main.cmd "place ";int(90 - wdth / 2);" 86"
#main.cmd "\";t$
#main.cmd "flush"
end sub
function vPages(pageIndex$)
vPages = 1
pageIndex$ = trim$(pageIndex$)
while instr(pageIndex$, chr$(0)) > 0
vPages = vPages + 1
if instr(pageIndex$, chr$(0)) > 0 then
pos = instr(pageIndex$, chr$(0)) + 1
pageIndex$ = mid$(pageIndex$, pos)
end if
wend
end function
[[code]]
It is likely that improvements will be made to this code before the contest deadline.