FreeBasic Help.bas
Code: Select all
#Include Once "windows.bi"
#Include Once "vbcompat.bi"
#Include "FreeBasic Help.bi"
Declare Function DlgProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
Declare Sub Go4It '
Declare Sub DoHtmlTop(As String,As String)
Declare Sub DoHtmlBottom(As String)
Declare Sub Link(As String, As String)
Declare Sub ParseIt(As String,As String,As String)
Dim Shared As String MainPath,WritePath
Dim Shared As HWND hPath,hEhelp
Const AddDir = "FreeBasic Help"
'' Create the Dialog
''
DialogBoxParam(GetModuleHandle(NULL), Cast(ZString Ptr,IDD_DLG1), NULL, @DlgProc, NULL)
ExitProcess(0)
End
Function DlgProc(ByVal hWin As HWND,ByVal uMsg As UINT,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As Integer
Dim As Long id, Ev
Dim As String T
Dim As ZString * MAX_PATH GetZ
Static As Boolean NotReady
Static As HWND hBtnGo,hBBtn,hBHelp
Select Case uMsg
Case WM_INITDIALOG
hPath = GetDlgItem(hWin,IDC_EDTPath)
hBBtn = GetDlgItem(hWin,IDC_BTNBrowse)
hEhelp = GetDlgItem(hWin,IDC_EDTHlpPath)
hBHelp = GetDlgItem(hWin,IDC_BTNBrHelp)
hBtnGo = GetDlgItem(hWin,IDC_BTNGo)
NotReady = TRUE
MessageBox hWin,"Will create a new folder at the path specified.","Help folder hint.",0
Case WM_CLOSE
EndDialog(hWin, 0)
'
Case WM_COMMAND
id=LoWord(wParam)
Ev=HiWord(wParam)
Select Case id
Case IDC_BTNGo
'disable all items
EnableWindow hPath,FALSE
EnableWindow hBBtn,FALSE
EnableWindow hEhelp,FALSE
EnableWindow hBHelp,FALSE
EnableWindow hBtnGo,FALSE
Go4It
'after exit sub close program .... open default browser to html?????
MessageBox hWin,"Open "+WritePath+"index.html in your favorite browser.","Success!!!!",0
EndDialog(hWin, 0) 'end prg
Case IDC_BTNBrowse
Do
MainPath = FileOpen(hWin, "Freebasic Compiler|fbc.exe","fbc.exe","C:\Program Files")
Loop Until Right(MainPath,7) = "fbc.exe"
MainPath = Left(MainPath,Len(MainPath)-7)
SetWindowText hPath,MainPath
Case IDC_BTNBrHelp
Do 'better way to do this???
WritePath = BrowseForFolder( hWin, "Location of help files", BIF_RETURNONLYFSDIRS Or BIF_USENEWUI, "c:\" )'FileOpen(hWin,"Any Folder|*.*","","") 'do not care where or what to point to
Loop Until Mid(WritePath,2,2) = ":\"
'Do
' WritePath = Left(WritePath,Len(WritePath)-1)
'Loop Until Right(WritePath,1) = "\"
WritePath += AddDir+"\"
SetWindowText hEhelp,WritePath
End Select
Case Else
If NotReady Then
GetWindowText hPath,@GetZ,MAX_PATH
T = GetZ
GetWindowText hEhelp,@GetZ,MAX_PATH
If Mid(T,2,2) = ":\" And Mid(GetZ,2,2) = ":\" And FileExists(T+"fbc.exe") Then
EnableWindow hBtnGo,TRUE
NotReady = FALSE
EndIf
EndIf
Return FALSE
'
End Select
Return TRUE
End Function
Sub Go4It
Dim As UByte fh,tfh
Dim As String T,LookPath,PutPath
fh = FreeFile
Open MainPath+"changelog.txt" For Input As #fh
Line Input #fh, T 'recent version
Close #fh
T = "FreeBasic "+Left(T,Len(T)-1)+ " Includes"
MainPath += "inc\"
'don't change MainPath and WritePath
LookPath = MainPath
PutPath = WritePath
Do ' scan folders and files
MkDir PutPath
SetWindowText hPath,LookPath
DoHtmlTop PutPath+"index.html", T
'find dir and write to temp file
T = Dir(LookPath+"*",16)
While T <> ""
If Left(T,1) <> "." Then 'ignore parent markers
fh = FreeFile
Open "NextLook.txt" For Append As #fh
Print #fh, LookPath+T+"\"
Link T, PutPath
Close #fh
EndIf
T = Dir()
Wend
fh = FreeFile
Open PutPath+"index.html" For Append As #fh
If PutPath <> WritePath Then 'make back link
Link "Back",PutPath
EndIf
Print #fh, "</td><td valign='top'>"
Close #fh
'find any files
T = Dir(LookPath+"*.bi",32)
While T <> ""
Link T, PutPath
'Notify user of progress?????
SetWindowText hEhelp,"Parsing "+T
ParseIt T,PutPath,LookPath
T = Dir()
Wend
DoHtmlBottom PutPath+"index.html"
'get next lookdir if any
If FileExists("NextLook.txt") Then
fh = FreeFile
Open "NextLook.txt" For Input As #fh
Input #fh, LookPath
If Eof(fh) Then 'no more
Close #fh
Kill "NextLook.txt"
Else
tfh = FreeFile
Open "t.txt" For Output As #tfh
Do
Input #fh, T
Print #tfh, T
Loop Until Eof(fh)
Close #fh, #tfh
Kill "NextLook.txt"
Name "t.txt", "NextLook.txt"
EndIf
fh = InStr(LookPath,"inc\")+4
PutPath = WritePath+Mid(LookPath,fh)
T = "Folder "+Mid(LookPath,fh,Len(LookPath)-fh)
Else
Exit Do
EndIf
Loop
Close 'any remaining
'return to main prg and end
End Sub
Sub DoHtmlTop(FName As String,Title As String)
Dim As UByte Th
Th = FreeFile
Open FName For Output As #Th
Print #Th, "<!DOCTYPE HTML PUBLIC "+Chr(34)+"-//W3C//DTD HTML 4.01 Transitional//EN"+Chr(34)+">"
Print #Th, ""
Print #Th, "<html>"
Print #Th, "<head>"
Print #Th, "<title>"+Title+"</title>"
Print #Th, "<style>"
Print #Th, "body{"
Print #Th, " font: 10pt Tahoma, Arial, Helvetica, sans-serif;"
Print #Th, " background: #FFFFFF;"
Print #Th, "}"
Print #Th, "A {text-decoration: none; color: black; font-size: 12px}"
Print #Th, "A:visited {text-decoration: none; color: black; font-size: 12px}"
Print #Th, "A:hover {text-decoration: underline; color: #FF3300; font-size: 12px}"
'Print #Th, "A:active {text-decoration: underline; color: #FF0000; font-size: 12px}"
Print #Th, "</style>"
Print #Th, "</head>"
Print #Th, "<body>"
If Right(FName,10) = "index.html" Then 'html and change to 10
Print #Th, "<table>" 'add more later
Print #Th, "<tr><th width='50%'>Folders</th>"
Print #Th, "<th width='50%'>Files</th></tr>"
Print #Th, "<tr><td valign='top'>" 'start for folder listings
EndIf
Close #Th
End Sub
Sub DoHtmlBottom(File As String)
Dim As UByte f
f = FreeFile
Open File For Append As #f
If Right(File,10) = "index.html" Then 'html and change to 10
Print #f, "</td></tr></table>"
EndIf
Print #f, "</body>"
Print #f, "</html>"
Close #f
End Sub
Sub Link(N As String,Go2 As String)
Dim As UByte t
t = FreeFile
Open Go2+"index.html" For Append As #t
Print #t, "<a href='";
If Right(N,3) = ".bi" Then 'link to parsed file
Print #t, Left(N,Len(N)-3);
Else
If N = "Back" Then 'back one folder link
Print #t, "..";
Else
Print #t, N;
EndIf
Print #t, "\index";
EndIf
Print #t, ".html'>"+N+"</a><br>"
Close #t
End Sub
Sub ParseIt(BiFile As String,P As String,L As String)
Dim As UByte BiW,BiR
Dim As String LineR
DoHtmlTop P+ Left(BiFile,Len(BiFile)-3)+".html","Contents of "+BiFile
BiW = FreeFile
Open P+ Left(BiFile,Len(BiFile)-3)+".html" For Append As #BiW
Print #BiW, "<a href='index.html'>****Back****</a><br>"
BiR = FreeFile
Open L + BiFile For Input As #BiR
Do
Line Input #BiR, LineR
'do checks
Print #BiW, LineR+"<br>"
Loop Until Eof(BiR)
Print #BiW, "<a href='index.html'>****Back****</a><br>"
Close #BiR,#BiW
DoHtmlBottom P+ Left(BiFile,Len(BiFile)-3)+".html"
End Sub
'Code: Select all
#Include Once "win\commdlg.bi"
#Include Once "crt.bi"
#Include Once "win/shlobj.bi"
Function BrowseCallbackProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal lParam As LPARAM, ByVal lpData As LPARAM) As Integer
Select Case uMsg
Case BFFM_INITIALIZED
SendMessage( hWnd, BFFM_SETSELECTION, -1, lpData )
Case BFFM_SELCHANGED
Dim As ZString * MAX_PATH sPath
If SHGetPathFromIDList( Cast( LPCITEMIDLIST, lParam ), sPath) = 0 Then
sPath = "Unknown"
Else
sPath = "PATH: " + sPath
EndIf
SendMessage( hWnd, BFFM_SETSTATUSTEXT, 0, CUInt( @sPath ) )
End Select
Function = 0
End Function
Function BrowseForFolder(ByVal hWnd As HWND, ByVal Prompt As String, ByVal Flags As Integer, ByVal DefaultFolder As String) As String
Dim bi As BROWSEINFO
Dim pidlReturn As LPITEMIDLIST
Dim pidlStart As LPITEMIDLIST
Static sFolder As String
CoInitialize( NULL )
SHGetSpecialFolderLocation( NULL, CSIDL_DRIVES, @pidlStart )
sFolder = DefaultFolder
With bi
.pidlRoot = pidlStart
.hwndOwner = hWnd
.lpszTitle = @Prompt
.ulFlags = Flags
.lpfn = @BrowseCallbackProc
.lParam = CUInt( StrPtr( sFolder ) )
End With
pidlReturn = SHBrowseForFolder( @bi )
CoTaskMemFree( pidlStart )
If ( pidlReturn <> NULL ) Then
Dim As ZString * MAX_PATH path
SHGetPathFromIDList( pidlReturn, path )
CoTaskMemFree( pidlReturn )
Function = path
Else
Function = ""
EndIf
CoUninitialize( )
End Function
Function FileOpen(hWnd As HWND, FTypes As String="Any File (*.*)|*.*",FSuggest As String="",DefaultPath As ZString Ptr) As String
Dim ofn As OPENFILENAME
Dim filename As ZString * MAX_PATH+1
Dim strFilter As ZString Ptr
Dim As UInteger strPos,lenFilter
' remember filter arguments length
lenFilter = Len(FTypes)
' copy from Filter argument into allocated strFilter
strFilter = malloc(lenFilter + 2)
StrCpy(strFilter, FTypes)
' needs to be double null terminated
strFilter[lenFilter + 1] = 0
' swap '|' for '\0'
For strPos = 0 To lenFilter - 1
If strFilter[strPos] = Asc("|") Then
strFilter[strPos] = 0
EndIf
Next strPos
If Len(FSuggest) Then
filename = FSuggest
EndIf
With ofn
.lStructSize = SizeOf( OPENFILENAME )
.hwndOwner = hWnd
.hInstance = GetModuleHandle( NULL )
.lpstrFilter = strFilter
.lpstrCustomFilter = NULL
.nMaxCustFilter = 0
.nFilterIndex = 1
.lpstrFile = @filename
.nMaxFile = SizeOf( filename )
.lpstrFileTitle = NULL
.nMaxFileTitle = 0
.lpstrInitialDir = DefaultPath
.lpstrTitle = @"Open File"
.Flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = NULL
.lCustData = 0
.lpfnHook = NULL
.lpTemplateName = NULL
End With
If GetOpenFileName( @ofn ) = FALSE Then
filename = ""
EndIf
' free memory from our derived filter
free(strFilter)
Return filename
End Function
Code: Select all
#define IDD_DLG1 1000
#define IDC_BTNGo 1001
#define IDC_EDTPath 1002
#define IDC_BTNBrowse 1003
#define IDC_BTNBrHelp 1013
#define IDC_EDTHlpPath 1014
IDD_DLG1 DIALOGEX 6,5,258,51
CAPTION "FreeBasic"
FONT 8,"MS Sans Serif",400,0
STYLE 0x10CA0800
BEGIN
CONTROL "Do It!",IDC_BTNGo,"Button",0x58010000,198,16,50,17
CONTROL "Path to fbc.exe",IDC_EDTPath,"Edit",0x50010000,6,9,166,13,0x00000200
CONTROL "...",IDC_BTNBrowse,"Button",0x50010000,176,11,18,11
CONTROL "...",IDC_BTNBrHelp,"Button",0x50010000,176,27,18,11
CONTROL "Path for help files",IDC_EDTHlpPath,"Edit",0x50010000,6,25,166,13,0x00000200
END
Click the top "..." button to navigate to the fbc.exe{compiler} file.
Click second "..." button to select a folder on hard drive. Program will create a new folder at that location. When done click the "Go" button. In a few seconds it will create a set of web pages to navigate and view all the .bi files in the inc folder.