Older Version Newer Version

JanetTerra 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.