Older Version
Newer Version
StPendl
May 31, 2011
[[user:StPendl|1304289299]] [[file:LB Help SearchAdd-on_project.bas|DownloadAdd-on_project.zip|Download entire LB Pro project (use save target as)]] A small screen shot [[file:HelpSearch_Pendl_ATL_Context_Menu.png]] [[code format="lb"]] ' LB Help Search Add-on.bas ' Author: Stefan Pendl ' Date: 24.04.11 ' ' Copyright 2011 by Stefan Pendl ' ' 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 ' ' The ATL control code is based on code at http://lbpe.wikispaces.com/ATL+Tutorial ' ' ' Credits: ' Thanks to Alyce, Janet, Chris, Rod, Jack for inspiring me. ' Thanks to the LB community for giving me the opportunity to learn and exchange code. ' ' ' History: ' ' v1.0.0 ... April 24th, 2011 ... Initial release ' v1.0.1 ... April 25th, 2011 ... moved index initialization after opening the window ' v1.0.2 ... -"- ... added static text control, if ATL failed to initialize ' v1.0.3 ... April 26th, 2011 ... added selection of "exact phrase", "all words" or "any word" ' v1.0.4 ... -"- ... added function to build search pattern, source restructured ' v1.0.5 ... -"- ... added selection of "index only", "page contents" or "source code" ' v1.0.6 ... April 28th, 2011 ... added custom resize handler, since native one is only for type window ' v1.0.7 ... April 30th, 2011 ... added Index button to display initial page and index of all pages ' added Usage button to display general usage of this application ' resizer and ATL control are now DPI aware ' v1.0.8 ... -"- ... current settings and window layout are saved on close ' v1.0.9 ... May 1st, 2011 ... making sure the ini file destination folder exists ' save window layout without scaling ' v1.0.10 ... May 2nd, 2011 ... now using a text box instead of the static text control to allow scroll bars ' added more comments in preparation of the final release ' v1.0.11 ... May 7th, 2011 ... added credits ' update list box for each found page during the search ' v1.0.12 ... May 8th, 2011 ... reverted back to Quick Start page as initial page ' v1.0.13 ... -"- ... added hint about ATL context menu for printing ' v1.0.14 ... May 15th, 2011 ... reverted back to index page as initial page ' ' Todo: ' # nothing left to do ;-) ' ################################ ' ################################ ' ## ## ' ## section for initialization ## ' ## ## ' ################################ ' ################################ ' check for valid LB version if val(Version$) < 4.04 then notice "Wrong LB Version!"; chr$(13);_ "This add-on is only valid for LB v4.04 and above!"; chr$(13);_ "Exiting ..." end end if [InitVars] ' initialize variables LbInstallDir$ = GetFolder$(GetModuleFileName$()) HelpFileRoot$ = LbInstallDir$; "lb4help\LibertyBASIC_4_web\html\" HelpFileIndex$ = LbInstallDir$; "lb4help\LibertyBASIC_4.html" HelpFilePattern$ = "*.htm" InitialTitle$ = "Index" InitialPage$ = HelpFileIndex$ ' variables for the ini file AppDataFolder$ = GetEnvironmentVariable$("APPDATA") LbAppDataFolder$ = GetPathTail$(LbInstallDir$) IniFileName$ = "LB Help Search Add-on.ini" ResizerDelay = 250 dim FilesInfo$(1,1), PageIndex$(1,2), FoundPages$(1) ' initialize ATL control Open "atl" For DLL As #atl CallDLL #atl, "AtlAxWinInit", ATLinitialized As long ' ###################################### ' ###################################### ' ## ## ' ## section for user interface setup ## ' ## ## ' ###################################### ' ###################################### [GUI] ' setup GUI nomainwin WindowWidth = 800 WindowHeight = 600 UpperLeftX = DisplayWidth - WindowWidth UpperLeftY = 1 ' minimum window size MinWindowWidth = int(500 * GetScreenScaleForDialog()) MinWindowHeight = int(400 * GetScreenScaleForDialog()) ' default size for ATL/text box control DefaultAtlPosX = 210 DefaultAtlPosY = 10 DefaultAtlWidth = 575 DefaultAtlHeight = 550 ' default settings of the radio buttons AsPhrase$ = "set" AllWords$ = "reset" AnyWord$ = "reset" IndexOnly$ = "set" PageContents$ = "reset" SourceCode$ = "reset" ' get the saved layout and settings from the ini file gosub [ReadDefaults] ' define the GUI WindowTitle$ = "LB Help Search" groupbox #m.search, "Search Text", 5, 5, 200, 95 textbox #m.phrase, 15, 20, 180, 25 radiobutton #m.AsPhrase, "As Phrase", [nothing], [nothing], 15, 50, 90, 20 radiobutton #m.AllWords, "All Words", [nothing], [nothing], 105, 50, 90, 20 radiobutton #m.AnyWord, "Any Word", [nothing], [nothing], 15, 70, 90, 20 groupbox #m.source, "Search Source", 5, 105, 200, 65 radiobutton #m.IndexOnly, "Index Only", [nothing], [nothing], 15, 120, 90, 20 radiobutton #m.PageContents, "Page Contents", [nothing], [nothing], 105, 120, 90, 20 radiobutton #m.SourceCode, "Source Code", [nothing], [nothing], 15, 140, 90, 20 button #m.default, "Search", [DoSearch], ul, 5, 175, 60, 25 button #m.index, "Index", [Index], ul, 75, 175, 60, 25 button #m.usage, "Usage", [Usage], ul, 145, 175, 60, 25 groupbox #m.result, "Search Results", 5, 205, 200, 355 stylebits #m.pages, _WS_HSCROLL, 0, 0, 0 listbox #m.pages, FoundPages$(), [DisplayPage], 15, 222, 180, 325 ' create the ATL or a text box control if ATLinitialized then AtlPosX = int(DefaultAtlPosX * GetScreenScaleForDialog()) AtlPosY = int(DefaultAtlPosY * GetScreenScaleForDialog()) AtlWidth = int(DefaultAtlWidth * GetScreenScaleForDialog()) AtlHeight = int(DefaultAtlHeight * GetScreenScaleForDialog()) else AtlPosX = DefaultAtlPosX AtlPosY = DefaultAtlPosY AtlWidth = DefaultAtlWidth AtlHeight = DefaultAtlHeight ' the text box will be read-only and include scroll bars stylebits #m.info, _ES_READONLY or _WS_VSCROLL or _WS_HSCROLL, _ES_AUTOHSCROLL or _ES_AUTOVSCROLL, 0, 0 textbox #m.info, AtlPosX, AtlPosY, AtlWidth, AtlHeight end if ' create a dilog with a sizing frame and a minimize box stylebits #m, _WS_THICKFRAME or _WS_MINIMIZEBOX, 0, 0, 0 open WindowTitle$; " - "; InitialTitle$ for dialog as #m #m "trapclose [quit]" cursor hourglass if ATLinitialized then Message$ = "MSHTML:<html><head></head><body><center><h1>Initializing index!";_ "<br/>Please wait ...</h1></center></body></html>" hATL = DisplayATL("#m", Message$, hATL, AtlPosX, AtlPosY, AtlWidth, AtlHeight) else #m.info "!font 20 bold" #m.info "Initializing index!"; chr$(13); "Please wait ..." end if ' create page index gosub [CreateIndex] ' preset controls #m.phrase " Enter Search Text " #m.pages "singleclickselect" #m.AsPhrase AsPhrase$ #m.AllWords AllWords$ #m.AnyWord AnyWord$ #m.IndexOnly IndexOnly$ #m.PageContents PageContents$ #m.SourceCode SourceCode$ #m.pages "reload" #m.default "!setfocus" #m.phrase "!setfocus" ' select entire text in the search box Handle = hwnd(#m.phrase) calldll #user32, "SendMessageA",_ Handle as ulong,_ _EM_SETSEL as ulong,_ 0 as long,_ -1 as ulong,_ result as long cursor normal OldWidth = -1 OldHeight = -1 timer ResizerDelay, [resizer] ' invoke initial resizing goto [resizer] ' ################################ ' ################################ ' ## ## ' ## section for event handlers ## ' ## ## ' ################################ ' ################################ [nothing] ' dummy event handler for the radio buttons wait [Index] ' event handler for the index button OverridePhrase = 1 [DoSearch] ' event handler for the search and index buttons cursor hourglass timer 0 ' clear the list box array redim FoundPages$(FoundFiles) #m.phrase "!contents? Phrase$" if Phrase$ = "" or OverridePhrase = 1 then for i = 1 to FoundFiles FoundPages$(i) = PageIndex$(i,1); chr$(0); PageIndex$(i,2) next else #m.AsPhrase "value? AsPhrase$" #m.AllWords "value? AllWords$" #m.AnyWord "value? AnyWord$" #m.IndexOnly "value? IndexOnly$" #m.PageContents "value? PageContents$" #m.SourceCode "value? SourceCode$" ' build the dynamic search condition select case case AnyWord$ = "set" SearchPattern$ = BuildSearchPattern$(Phrase$, "contents$", "OR", 0) case AllWords$ = "set" SearchPattern$ = BuildSearchPattern$(Phrase$, "contents$", "AND", 0) case else SearchPattern$ = "instr(upper$(contents$), upper$(Phrase$)) > 0" end select ' cycle through the pages j = 1 for i = 1 to FoundFiles select case case SourceCode$ = "set" contents$ = CollectSourceCode$(PageIndex$(i,2)) case PageContents$ = "set" open PageIndex$(i,2) for input as #f contents$ = input$(#f, lof(#f)) close #f case else contents$ = PageIndex$(i,1) end select if eval(SearchPattern$) then FoundPages$(j) = PageIndex$(i,1); chr$(0); PageIndex$(i,2) j = j + 1 #m.pages "reload" end if next end if #m.pages "reload" #m.pages "selectindex 0" #m.phrase "!setfocus" #m.default "!setfocus" cursor normal timer ResizerDelay, [resizer] ' wait here if the search button was hit, continue for the index button if OverridePhrase = 0 then wait [DisplayPage] ' event handler for the selected list box item and the index button if OverridePhrase = 1 then Page$ = InitialTitle$; chr$(0); InitialPage$ else #m.pages "selection? Page$" end if FileName$ = word$(Page$, 2, chr$(0)) if ATLinitialized then hATL = DisplayATL("#m", FileName$, hATL, AtlPosX, AtlPosY, AtlWidth, AtlHeight) else #m.info "!font 20 bold" #m.info "Displaying Pages in your Browser!" run "rundll32.exe url.dll,FileProtocolHandler "; chr$(34); FileName$; chr$(34) end if call SetWindowText "#m", WindowTitle$; " - "; word$(Page$, 1, chr$(0)); chr$(0) OverridePhrase = 0 wait [resizer] ' resize handler for the dialog window ' get window size call GetWindowRect "#m", UpperLeftX, UpperLeftY, WindowWidth, WindowHeight ' check if we match the minimum size if WindowWidth < MinWindowWidth then WindowWidth = MinWindowWidth if WindowHeight < MinWindowHeight then WindowHeight = MinWindowHeight ' get desktop size if GetDesktopRect(DesktopPosX, DesktopPosY, DesktopWidth, DesktopHeight) = 1 then ' check if we are out of bounds if (UpperLeftX + WindowWidth) > (DesktopPosX + DesktopWidth) then UpperLeftX = DesktopPosX + DesktopWidth - WindowWidth end if if UpperLeftX < DesktopPosX then UpperLeftX = DesktopPosX if (UpperLeftY + WindowHeight) > (DesktopPosY + DesktopHeight) then UpperLeftY = DesktopPosY + DesktopHeight - WindowHeight end if if UpperLeftY < DesktopPosY then UpperLeftY = DesktopPosY ' check if we exceed the desktop size if WindowWidth > DesktopWidth then WindowWidth = DesktopWidth if WindowHeight > DesktopHeight then WindowHeight = DesktopHeight end if call SetWindowPos hwnd(#m), UpperLeftX, UpperLeftY, WindowWidth, WindowHeight ' get client area size if GetClientRect("#m", NewWidth, NewHeight) = 0 then wait ' check if size has changed if NewWidth = OldWidth and NewHeight = OldHeight then wait ' resize controls call SetWindowPos hwnd(#m.pages), -1, -1, int(180 * GetScreenScaleForDialog()),_ NewHeight - int((222 + 20) * GetScreenScaleForDialog()) call SetWindowPos hwnd(#m.result), -1, -1, int(200 * GetScreenScaleForDialog()),_ NewHeight - int((205 + 10) * GetScreenScaleForDialog()) if ATLinitialized then hBrowse = hATL AtlWidth = NewWidth - AtlPosX - int(10 * GetScreenScaleForDialog()) else hBrowse = hwnd(#m.info) #m.info "!contents? hBrowseCaption$" AtlWidth = NewWidth - int((AtlPosX + 10) * GetScreenScaleForDialog()) end if AtlHeight = NewHeight - AtlPosY - int(10 * GetScreenScaleForDialog()) call SetWindowPos hBrowse, -1, -1, AtlWidth, AtlHeight ' refresh text box contents if not(ATLinitialized) then #m.info "" #m.info hBrowseCaption$ end if ' remember current size to avoid running the entire handler, if nothing changed OldWidth = NewWidth OldHeight = NewHeight wait [Usage] ' event handler for the usage button if UsageMessage$ = "" then restore [UsageMessage] ' use an infinite loop to read the usage message while 1 read String$ ' break the loop, if we have reached the end of the message definition if String$ = "@END" then exit while ' filter strings valid only for the ATL control if left$(String$, 4) = "ATL:" then if ATLinitialized then UsageMessage$ = UsageMessage$ + mid$(String$, 5) else String$ = "" end if else ' replace "\n" by the new-line characters or tag if instr(String$, "\n") > 0 then if ATLinitialized then ' filter strings valid only for the static text control if left$(String$, 7) = "STATIC:" then String$ = "" else String$ = "<br/>" end if else String$ = chr$(13); chr$(10) end if end if ' concatenate the message into one long string for easier display UsageMessage$ = UsageMessage$ + String$ end if wend end if if ATLinitialized then hATL = DisplayATL("#m", UsageMessage$, hATL, AtlPosX, AtlPosY, AtlWidth, AtlHeight) else #m.info "!font courier_new 10" #m.info UsageMessage$ end if #m.default "!setfocus" wait [quit] ' event handler for closing the dialog gosub [SaveDefaults] close #m Close #atl end ' ################################# ' ################################# ' ## ## ' ## section for DATA definition ## ' ## ## ' ################################# ' ################################# [UsageMessage] ' definition of the usage message ' ' strings starting with "ATL:" are only valid for the ATL control ' strings starting with "STATIC:" are only valid for the static text control ' strings containing "\n" are replaced by new line characters or tags data "ATL:MSHTML:<html><head><title>Usage</title></head><body>" data "ATL:<center><h3>", "LB Help Search Add-On - Usage", "ATL:</h3></center>", "STATIC:\n", "STATIC:\n" data "ATL:<h4>", "Search Text:", "ATL:</h4>", "STATIC:\n", "STATIC:\n" data "ATL:<pre>" data "Text field ... enter text to search for", "\n" data "As Phrase .... results containing the entered words as is", "\n" data "All Words .... results containing all entered words", "\n" data "Any Word ..... results containing at least one of the entered words", "\n" data "ATL:</pre>" data "STATIC:\n" data "ATL:<h4>", "Search Source:", "ATL:</h4>", "STATIC:\n", "STATIC:\n" data "ATL:<pre>" data "Index Only ...... search only the title of the pages", "\n" data "Page Contents ... search the entire page content", "\n" data "Source Code ..... search only example code contained on the pages", "\n" data "ATL:</pre>" data "STATIC:\n" data "ATL:<h4>", "Buttons:", "ATL:</h4>", "STATIC:\n", "STATIC:\n" data "ATL:<pre>" data "Search ... start the search according to the above settings", "\n" data "Index .... display the initial page and load the list of all pages", "\n" data "Usage .... display this message", "\n" data "ATL:</pre>" data "STATIC:\n" data "ATL:<h4>", "Search Results:", "ATL:</h4>", "STATIC:\n", "STATIC:\n" data "ATL:<pre>" data "Initially ........ contains the list of all pages", "\n" data "After a Search ... contains the list of matching pages", "\n" data "ATL:</pre>" data "ATL:<h4>", "ATL:Printing can be done through the context menu of this control.", "ATL:</h4>" data "STATIC:\n" data "ATL:<h4>", "Settings and window layout are saved on close.", "ATL:</h4>" data "ATL:</body></html>" data "@END" ' ############################ ' ############################ ' ## ## ' ## section for procedures ## ' ## ## ' ############################ ' ############################ ' ########## ' # # ' # GOSUBs # ' # # ' ########## [SaveDefaults] ' save dialog layout and current settings to the ini file #m.AsPhrase "value? AsPhrase$" #m.AllWords "value? AllWords$" #m.AnyWord "value? AnyWord$" #m.IndexOnly "value? IndexOnly$" #m.PageContents "value? PageContents$" #m.SourceCode "value? SourceCode$" ' make sure the destination folder exists result = mkdir(AppDataFolder$; "\"; LbAppDataFolder$) ' save the settings only if the folder was created or already exists if result = 0 or result = 183 then call GetWindowRect "#m", UpperLeftX, UpperLeftY, WindowWidth, WindowHeight if UpperLeftX = 0 then UpperLeftX = 1 if UpperLeftY = 0 then UpperLeftY = 1 open AppDataFolder$; "\"; LbAppDataFolder$; "\"; IniFileName$ for output as #ini #ini "WindowWidth = "; int(WindowWidth / GetScreenScaleForDialog()) #ini "WindowHeight = "; int(WindowHeight / GetScreenScaleForDialog()) #ini "UpperLeftX = "; UpperLeftX #ini "UpperLeftY = "; UpperLeftY #ini "AsPhrase = "; AsPhrase$ #ini "AllWords = "; AllWords$ #ini "AnyWord = "; AnyWord$ #ini "IndexOnly = "; IndexOnly$ #ini "PageContents = "; PageContents$ #ini "SourceCode = "; SourceCode$ close #ini else notice "Path does not exist"; chr$(13); "Unable to save settings!" end if return [ReadDefaults] ' read dialog layout and last settings from the ini file files AppDataFolder$; "\"; LbAppDataFolder$, IniFileName$, FilesInfo$() ' only read if file exists if val(FilesInfo$(0,0)) > 0 then open AppDataFolder$; "\"; LbAppDataFolder$; "\"; IniFileName$ for input as #ini while not(eof(#ini)) line input #ini, setting$ Option$ = trim$(word$(setting$, 1, "=")) Value$ = trim$(word$(setting$, 2, "=")) select case Option$ case "WindowWidth" WindowWidth = val(Value$) case "WindowHeight" WindowHeight = val(Value$) case "UpperLeftX" UpperLeftX = val(Value$) case "UpperLeftY" UpperLeftY = val(Value$) case "AsPhrase" AsPhrase$ = Value$ case "AllWords" AllWords$ = Value$ case "AnyWord" AnyWord$ = Value$ case "IndexOnly" IndexOnly$ = Value$ case "PageContents" PageContents$ = Value$ case "SourceCode" SourceCode$ = Value$ end select wend close #ini end if return [CreateIndex] ' fill page index files HelpFileRoot$, HelpFilePattern$, FilesInfo$() FoundFiles = val(FilesInfo$(0,0)) if FoundFiles = 0 then if ATLinitialized then Message$ = "MSHTML:<html><head></head><body><center><h1>Unable to locate Help Files!";_ "</h1></center></body></html>" hATL = DisplayATL("#m", Message$, hATL, AtlPosX, AtlPosY, AtlWidth, AtlHeight) else #m.info "Unable to locate Help Files!" end if else redim PageIndex$(FoundFiles,2) redim FoundPages$(FoundFiles) for i = 1 to FoundFiles FileName$ = HelpFileRoot$; FilesInfo$(i,0) open FileName$ for input as #f contents$ = input$(#f, min(512, lof(#f))) close #f ' parsing the tilte tag does not return unique results ' StartPos = instr(upper$(contents$), "<TITLE>") + 7 ' EndPos = instr(upper$(contents$), "</TITLE>, StartPos") ' parsing the first bold text does return unique results ' this returns the headline StartPos = instr(upper$(contents$), "<B>") + 3 EndPos = instr(upper$(contents$), "</B>", StartPos) PageTitle$ = mid$(contents$, StartPos, EndPos - StartPos) PageIndex$(i,1) = PageTitle$ PageIndex$(i,2) = FileName$ next ' sort page index sort PageIndex$(, 1, FoundFiles, 1 ' fill list box array with page information for i = 1 to FoundFiles FoundPages$(i) = PageIndex$(i,1); chr$(0); PageIndex$(i,2) next if ATLinitialized then hATL = DisplayATL("#m", InitialPage$, hATL, AtlPosX, AtlPosY, AtlWidth, AtlHeight) else #m.info "Displaying Pages in your Browser!" end if call SetWindowText "#m", WindowTitle$; " - "; InitialTitle$; chr$(0) end if return ' ######## ' # # ' # SUBs # ' # # ' ######## sub SetWindowPos hWndParent, PosX, PosY, Width, Height ' set window position and size with the ability to ignore one or the other ' ' hWndParent ... handle of the control to position/resize ' PosX ......... horizontal position of the top left corner ' PosX ......... vertical position of the top left corner ' Width ........ new width of the control or window ' Height ....... new height of the control or window ' do not change the z-order and do not activate the window/control uFlags = _SWP_NOZORDER or _SWP_NOACTIVATE ' ignore the positional arguments, if both are -1 if PosX = -1 and PosY = -1 then uFlags = uFlags or _SWP_NOMOVE ' ignore the size arguments, if both are -1 if Width = -1 and Height = -1 then uFlags = uFlags or _SWP_NOSIZE calldll #user32, "SetWindowPos",_ hWndParent as ulong,_ _NULL as ulong,_ PosX as long,_ PosY as long,_ Width as long,_ Height as long,_ uFlags as ulong,_ result as long end sub sub GetWindowRect Parent$, ByRef PosX, ByRef PosY, ByRef Width, ByRef Height ' get the size of the window or control ' ' Parent$ ... LB handle of the control or window, for instance "#m" or "#m.cb" ' ' on success fills the remaining 4 arguments with the ' size and position of the control/window hWndParent = hWnd(#Parent$) struct RECT,_ left as LONG,_ top as LONG,_ right as LONG,_ bottom as LONG calldll #user32, "GetWindowRect",_ hWndParent as ulong,_ RECT as struct,_ result as long if result <> 0 then PosX = RECT.left.struct PosY = RECT.top.struct Width = RECT.right.struct - RECT.left.struct Height = RECT.bottom.struct - RECT.top.struct end if end sub sub SetWindowText Parent$, Caption$ ' change the caption of a control or window ' ' Parent$ .... LB handle of the control or window, for instance "#m" or "#m.cb" ' Caption$ ... text for the new caption hWndParent = hWnd(#Parent$) calldll #user32, "SetWindowTextA",_ hWndParent as ulong,_ Caption$ as ptr,_ result as long end sub ' ############# ' # # ' # FUNCTIONs # ' # # ' ############# function GetClientRect(Parent$, ByRef Width, ByRef Height) ' get the size of a window ' ' Parent$ .... LB handle of the window, for instance "#m" ' ' on success 1 is returned and the arguments are filled with the values ' on failure 0 is returned hWndParent = hWnd(#Parent$) struct RECT,_ left as LONG,_ top as LONG,_ right as LONG,_ bottom as LONG calldll #user32, "GetClientRect",_ hWndParent as ulong,_ RECT as struct,_ result as long if result <> 0 then Width = RECT.right.struct Height = RECT.bottom.struct GetClientRect = 1 else GetClientRect = 0 end if end function function GetDesktopRect(ByRef PosX, ByRef PosY, ByRef Width, ByRef Height) ' get the size and position of the desktop area not covered by any tool bars ' ' on success 1 is returned and the arguments are filled with the values ' on failure 0 is returned struct RECT,_ left as LONG,_ top as LONG,_ right as LONG,_ bottom as LONG uiAction = _SPI_GETWORKAREA calldll #user32, "SystemParametersInfoA",_ uiAction as ulong,_ uiParam as ulong,_ RECT as struct,_ fWinIni as ulong,_ result as long if result <> 0 then PosX = RECT.left.struct PosY = RECT.top.struct Width = RECT.right.struct - RECT.left.struct Height = RECT.bottom.struct - RECT.top.struct GetDesktopRect = 1 else GetDesktopRect = 0 end if end function function CollectSourceCode$(FileName$) ' this function parses HTML pages for source code sections ' and returns a concatenated string of them ' source code in LBs help file is defined by the font "Courier New" StartCode$ = "<FONT FACE="; chr$(34); "COURIER NEW"; chr$(34); " SIZE="; chr$(34); "2"; chr$(34); ">" open FileName$ for input as #f contents$ = input$(#f, lof(#f)) close #f StartPos = 0 EndPos = 1 ' use an infinite loop for parsing while 1 StartPos = instr(upper$(contents$), StartCode$, EndPos) ' break out of the loop, if there is nothing found if StartPos = 0 then exit while StartPos = StartPos + len(StartCode$) EndPos = instr(upper$(contents$), "</FONT>", StartPos) CollectSourceCode$ = CollectSourceCode$; "<br/>"; mid$(contents$, StartPos, EndPos - StartPos) wend end function function BuildSearchPattern$(SearchString$, ContainerVar$, Operator$, CaseSensitive) ' return a string containing a conditional statement to be executed by the EVAL() function ' ' SearchString$ ... string containing the search term ' ContainerVar$ ... variable containing the string to be searched ' Condition$ ...... boolean operator to concatenate multiple conditions (AND/OR/XOR) ' CaseSensitive ... flag to create a case sensitive contition or not ' 1 ... case sensitive ' 0 ... case insensitive count = 1 ' build condition for first word of the search term if CaseSensitive then BuildSearchPattern$ = "instr("; ContainerVar$; ", ";_ chr$(34); word$(SearchString$, count); chr$(34); ") > 0" else BuildSearchPattern$ = "instr(upper$("; ContainerVar$; "), ";_ chr$(34); upper$(word$(SearchString$, count)); chr$(34); ") > 0" end if count = count + 1 ' add remaining conditions separated by the operator while word$(SearchString$, count) <> "" if CaseSensitive then BuildSearchPattern$ = BuildSearchPattern$; " "; Operator$; " instr("; ContainerVar$; ", ";_ chr$(34); word$(SearchString$, count); chr$(34); ") > 0" else BuildSearchPattern$ = BuildSearchPattern$; " "; Operator$; " instr(upper$("; ContainerVar$; "), ";_ chr$(34); upper$(word$(SearchString$, count)); chr$(34); ") > 0" end if count = count + 1 wend end function function DisplayATL(Parent$, File$, Handle, PosX, PosY, Width, Height) ' create an ATL control ' ' Parent$ ... LB handle of the parent window, for instance "#m" ' File$ ..... Path of a file, HTML code as a string or an URL ' see http://lbpe.wikispaces.com/ATL+Tutorial for more ' Handle .... Windows handle of the last created ATL control ' usually the handle returned by the last call of this function ' ' on success returns the handle of the created control if Handle then CallDLL #user32, "DestroyWindow", _ Handle As ulong, _ result As long end if hWndParent = hWnd(#Parent$) CallDLL #user32, "GetWindowLongA", _ hWndParent As ulong, _ _GWL_HINSTANCE As long, _ hInst As ulong style = _WS_CHILD or _WS_VISIBLE or _WS_VSCROLL or _WS_HSCROLL or _WS_BORDER exStyle = _WS_EX_CLIENTEDGE or _WS_EX_TOPMOST CallDLL #user32, "CreateWindowExA", _ exStyle As ulong, _ "AtlAxWin" As ptr, _ File$ As ptr, _ style As ulong, _ PosX As long, _ PosY As long, _ Width As long, _ Height As long, _ hWndParent As ulong, _ _NULL As ulong, _ hInst As ulong, _ _NULL As ulong, _ DisplayATL As ulong end function function GetFolder$(Path$) ' strip off the part after the last backslash of a file or folder 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 GetPathTail$(Path$) ' get the part after the last backslash of a file or folder path if right$(Path$, 1) = "\" then GetPathTail$ = left$(Path$, len(Path$)-1) else GetPathTail$ = Path$ end if for pos = len(GetPathTail$) to 1 step -1 if mid$(GetPathTail$, pos, 1) = "\" then exit for next if pos > 1 then GetPathTail$ = mid$(GetPathTail$, pos + 1) end function function GetModuleFileName$() ' return the full path of the executable of the current process 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 GetScreenScaleForDialog() ' get the scale to size controls inside a dialog type window ' ' controls of dialog type windows are automatically scaled ' to match the users screen DPI settings ' ' LB does not use all scales, only 100% and 125% calldll #user32, "GetDC",_ 0 as ulong,_ ' entire screen hDC as ulong nIndex = _LOGPIXELSX calldll #gdi32, "GetDeviceCaps",_ hDC as ulong,_ nIndex as ulong,_ dpi as ulong calldll #user32, "ReleaseDC",_ 0 as ulong,_ ' entire screen hDC as ulong,_ result as ulong ' 1 = success ScreenScale = dpi / 96 ScreenScaleTmp = max(1, ScreenScale) GetScreenScaleForDialog = min(1.25, ScreenScaleTmp) end function function GetEnvironmentVariable$(lpName$) 'get the value of an environment variable nSize = 1024 [Retry] lpBuffer$ = space$(nSize) calldll #kernel32, "GetEnvironmentVariableA", _ lpName$ as ptr, _ lpBuffer$ as ptr, _ nSize as ulong, _ result as ulong select case ' buffer too small case result > nSize nSize = result goto [Retry] ' variable found case result > 0 GetEnvironmentVariable$ = trim$(lpBuffer$) end select end function [[code]]