FreeBasic Help

User projects written in or related to FreeBASIC.
bcohio2001
Posts: 509
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

FreeBasic Help

Postby bcohio2001 » Nov 01, 2008 2:20

In reply to my own comment http://www.freebasic.net/forum/viewtopic.php?t=10140 Posted: Dec 17, 2007 21:01. I have took it upon myself to do something about it. Other than Wiki.

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
'


FreeBasic Help.bi

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


FreeBasic Help.rc

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


You are provided with a "small window" with 2 textboxes, 2 ... buttons and a "Go" button.
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.
TheMG
Posts: 376
Joined: Feb 08, 2006 16:58

Postby TheMG » Nov 01, 2008 3:36

What exactly does it... do?
vdecampo
Posts: 2982
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:

Postby vdecampo » Nov 01, 2008 14:43

I'm not sure what it does either. The FreeBASIC Help (.chm) file works for me.
bcohio2001
Posts: 509
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Postby bcohio2001 » Nov 01, 2008 15:56

TheMG wrote:What exactly does it... do?


Creates a series of web pages at the location specified.

index.html contains links to all the folders and files in the 'inc' folder of the FreeBasic compiler.

On the left of the "page" is links to all the subfolders. and on the right is a link to each .bi file.

If you click on the link it will display the file. That way you can look for any #include, #define, or Function to be able to be put to use.

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 7 guests