Older Version
Newer Version
StPendl
May 31, 2011
- 
StPendl May 1, 2011
File Not Found Download entire LB Pro project (use save target as)
A small screen shot
StPendl May 1, 2011 A small screen shot
' 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