Older Version
Newer Version
JackBurman
May 16, 2011
- "Standard version submitted"
This is the standard version of LB Help Search. This version incorporates an index listbox. A bitmap is used for the help button, but program will substitute a text button if the bitmap is not found in the default directory. You can d/l the bmp file if I did the link thingy correctly. [[file:help1.bmp]] Here's the listing: [[code format="lb"]] ' LB Help Search entry ' Author: jaba ' Date: May 5, 2011 ' ' History: ' v1.0 May 6, 2011 Submitted ' v1.01 May 6, 2011 Added browser control ' v1.02 May 9, 2011 Added GetModuleFileName$() routine ' v1.03 May 12, 2011 Additional pages added to quick viewer ' Some names made more purpose-descriptive ' ' v1.03b May 13, 2011 Final Lite version ' v1.03d May 14, 2011 in progress...added 200px to width for index listbox (not using) ' v1.03e May 14, 2011 Alpha version with index listbox (not using) ' v1.03f May 15, 2011 rebuilt banner; added Help ' Submitted May 16, 2011 ' ' -- be sure to update ABOUT before Final submission -- ' ' This code is free for personal use. ' To protect the rights of others whose code is included, please note following: ' 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 ' ' Based on a framework provided by Alyce on LB forum. ' ' Some parts taken from entries by others, including ' Alyce, Janet, Stefan, and Gordon. ' ' Thanks to them and others. ' ' This version uses a built-in ATL.DLL browser control ' in addition to the user's default browser. ' ' ' Thanks to Stefan Pendl for API function method to obtain location of ' LB installation directory. This method is more reliable with systems ' running Vista/Win7 than is the StartupDir$ or DefaultDir$ method. InstallDir$ = GetFolder$(GetModuleFileName$()) HelpDir$ = InstallDir$ + "lb4help\LibertyBASIC_4_web\HTML\" HelpFileIndex$ = InstallDir$; "lb4help\LibertyBASIC_4.html" WdoTitle$ = "LB HTML SEARCH" 'List of Quick View pages: 'Quick Start Guide = "libe3mnn.htm" 'amber_menu.htm 'Command Reference = "libe2co3.htm" 'Reserved Word List = "libe6ldg.htm" Open "atl" For DLL As #atl CallDLL #atl, "AtlAxWinInit", Ret As long nomainwin WindowWidth = 602 WindowHeight = 720 UpperLeftX = DisplayWidth - WindowWidth UpperLeftY = 40 stylebits #s.head, 0, _WS_BORDER, 0, 0 graphicbox #s.head 1, 1, 594, 33 'is there a bmp file for help? if fileExists(DefaultDir$, "Help1.bmp") then bmpbutton #s.hlp "Help1.bmp", [help], UL, 550, 10 else button #s.hlp "?", [help], UL, 550, 10 end if textbox #s.term 10, 40, 320, 25 button #s.content "Contents / Open Browser", [openContentsPage], UL, 421, 40, 160, 25 button #s.default "Find", [findPages], UL, 337, 40, 77, 25 listbox #s.pages, found$(), [displaySelectedPage], 10, 70, 410, 160 checkbox #s.qv, "Check to open in Quick Viewer", [setChk], [resetChk], 10, 235, 200, 20 ListboxColor$ = "buttonface" stylebits #s.index, _WS_HSCROLL, 0, 0, 0 listbox #s.index, index$(), [pickBox], 421, 70, 160, 592 statictext #s.heading "Quick Viewer", 10, 269, 90, 20 button #s.quick "Quick Start Guide", [quickButton], UL, 100, 260, 98, 25 'points to libe3mnn.htm button #s.commands "Command Reference", [commandsButton], UL, 205, 260, 115, 25 'points to libe2co3.htm button #s.reserve "Reserved Words", [reservedButton], UL, 325, 260, 95, 25 'points to libe6ldg.htm stylebits #s.resource, 0, _WS_BORDER, 0, 0 graphicbox #s.resource 10, 290, 410, 370 'container for browser control statictext #s.status, "Right-click browser window for BACK/FORWARD.", 10, 668, 410, 20 open WdoTitle$ for dialog_nf as #s #s "trapclose [quit]" #s.index "singleclickselect" #s.pages "singleclickselect" #s.qv "set" :chkSet = 1 #s "font ms_sans_serif 9" #s.content "!font ms_sans_serif 9" #s.heading "!font ms_sans_serif 9 bold" #s.status "!font arial 7" #s.qv "font arial 7" 'color the banner #s.head "fill "; "buttonface" #s.head "down; place 0 27; color 88 66 55; backcolor buttonface" #s.head "\ LB Help Search Challenge" #s.head "flush" #s.term " Type search term... " 'display Quick Start Guide in browse control QuickViewPage$ = "libe3mnn.htm" call createBrowseControl HelpDir$, QuickViewPage$, hFlag #s.term "!setfocus" #s.term "!selectall" dim info$(10,10) files HelpDir$, "*.htm", info$() numFiles = val(info$(0,0)) 'load index array dim index$(numFiles) scan for i = 1 to numFiles open HelpDir$ + info$(i,0) for input as #file txt$ = INPUT$(#file, lof(#file)) index$(i) = GetTitle$(txt$); chr$(0); info$(i,0) close #file next i sort index$(), 1, numFiles #s.index "reload" gosub [hint] '<--- Comment out when no longer needed. wait [dummy] wait [setChk] #s.qv "set" chkSet = 1 wait [resetChk] #s.qv "reset" chkSet = 0 wait [quickButton] QuickViewPage$ = "libe3mnn.htm" call createBrowseControl HelpDir$, QuickViewPage$, hFlag wait [commandsButton] QuickViewPage$ = "libe2co3.htm" call createBrowseControl HelpDir$, QuickViewPage$, hFlag wait [reservedButton] QuickViewPage$ = "libe6ldg.htm" call createBrowseControl HelpDir$, QuickViewPage$, hFlag wait [findPages] #s.term "!contents? term$" if term$ = "" then redim found$(1) #s.pages "reload" wait end if dim found$(numFiles) for i = 1 to numFiles open HelpDir$ + info$(i,0) for input as #file txt$ = INPUT$(#file, lof(#file)) if instr(txt$, term$) >0 then found$(i) = GetTitle$(txt$); chr$(0); info$(i,0) #s.pages "reload" end if close #file next wait [openContentsPage] 'open user's default browser run "rundll32.exe url.dll,FileProtocolHandler "; chr$(34); HelpFileIndex$; chr$(34) #s.term "!setfocus" wait [displaySelectedPage] #s.pages "selection? FileName$" FileName$ = word$(FileName$, 2, chr$(0)) if chkSet = 0 then 'open in user's default browser or new tab run "rundll32.exe url.dll,FileProtocolHandler "; chr$(34); HelpDir$; FileName$; chr$(34) else call createBrowseControl HelpDir$, FileName$, hFlag end if wait [pickBox] #s.index "selection? qvp$" qvp$ = word$(qvp$, 2, chr$(0)) call createBrowseControl HelpDir$, qvp$, hFlag wait [help] WindowWidth = 400 WindowHeight = 270 statictext #h.hlp "", 10, 10, 390, 250 open "How to use" for window as #h #h "trapclose [noMoreh]" hlpWdoOpen = 1 gosub [printHlp] wait [noMoreh] close #h hlpWdoOpen = 0 wait [quit] close #s close #atl if hlpWdoOpen = 1 then close #h :hlpWdoOpen = 0 end 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXSUBS AND FUNCTIONS 'credit: Alyce's entry. 'extract title from html text function GetTitle$(s$) marker1=instr(upper$(s$), "<A NAME=") marker1=instr(upper$(s$), "<B>",marker1)+3 marker2=instr(upper$(s$), "</B>", marker1) lenTitle=marker2-marker1 GetTitle$=mid$(s$,marker1,lenTitle) end function 'borrowed from Stefan Pendl 'added 5/9/11 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 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 sub createBrowseControl D$, F$, byref hATL if hATL then CallDLL #user32, "DestroyWindow", _ hATL As ulong, _ result As long hATL = 0 end if hWndContainer = hWnd(#s.resource) 'graphicbox handle callDLL #user32, "GetWindowLongA", _ hWndContainer as ulong, _ _GWL_HINSTANCE as long, _ hInst as ulong ResName$ = D$ + F$ style = _WS_CHILD or _WS_VISIBLE or _WS_VSCROLL CallDLL #user32, "CreateWindowExA", _ _WS_EX_STATICEDGE As long, _ 'extended type "AtlAxWin" As ptr, _ 'class name ResName$ As ptr, _ 'resource file name & path style As long, _ 'window style 0 As long, _ 'left x pos 0 As long, _ 'top y pos 408 As long, _ 'width 368 As long, _ 'height hWndContainer As ulong, _ 'handle of container 100 As long, _ 'handle to menu or child window ID hInst As ulong, _ 'parent instance handle 0 As long, _ 'window creation data hATL As ulong 'handle of active template library control end sub [printHlp] ' Help window contents hlp$ = "Find button -";chr$(13);_ " Type search term into textbox. Results are shown in listbox below.";chr$(13);_ " Single-click a result to display the page in your default browser.";chr$(13);_ " Check the box to display results in the Quick Viewer window.";chr$(13);chr$(13);_ "Contents / Open Browser button -";chr$(13);_ " Click button to open your default browser to Table of Contents.";chr$(13);_ " Single-click an Indexed item in listbox to view it in the Quick Viewer.";chr$(13);chr$(13);_ "Quick Viewer -";chr$(13);_ " Select from the 3 buttons to view a pre-selected help topic.";chr$(13);chr$(13);_ " ABOUT LB HELP SEARCH";chr$(13);_ " Version 1.03f";chr$(13);_ " May 15, 2011";chr$(13);_ " By: jaba" print #h.hlp, hlp$ return [hint] notice "A handy way to browse the results pages...";chr$(13);_ "Enter search term. Check the box to open in Quick Viewer.";chr$(13);_ "Use the arrow keys to advance to the first or next page";chr$(13);_ "in the listbox. Each highlighted page will display in the";chr$(13);_ "Quick Viewer.";chr$(13);chr$(13);_ "With the checkbox cleared, doing the same thing will open";chr$(13);_ "in a new tab in your browser. A ctrl-w will usually close the tab." return function fileExists(path$, filename$) files path$, filename$, info$() fileExists = val(info$(0, 0)) end function [[code]]