FreeBasic Help

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

FreeBasic Help

Postby bcohio2001 » Nov 01, 2008 2:20

In reply to my own comment 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 ""
#Include Once ""
#Include "FreeBasic"

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)

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
         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
         Select Case id
            Case IDC_BTNGo
               'disable all items
               EnableWindow hPath,FALSE
               EnableWindow hBBtn,FALSE
               EnableWindow hEhelp,FALSE
               EnableWindow hBHelp,FALSE
               EnableWindow hBtnGo,FALSE
               '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
                  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) = ":\"
               '   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
         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
         T = Dir()
      fh = FreeFile
      Open PutPath+"index.html" For Append As #fh
      If PutPath <> WritePath Then 'make back link
         Link "Back",PutPath
      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()
      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"
            tfh = FreeFile
            Open "t.txt" For Output As #tfh
               Input #fh, T
               Print #tfh, T
            Loop Until Eof(fh)
            Close #fh, #tfh
            Kill "NextLook.txt"
            Name "t.txt", "NextLook.txt"
         fh = InStr(LookPath,"inc\")+4
         PutPath = WritePath+Mid(LookPath,fh)
         T = "Folder "+Mid(LookPath,fh,Len(LookPath)-fh)
         Exit Do
   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
   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>"
   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);
      If N = "Back" Then 'back one folder link
         Print #t, "..";
         Print #t, N;
      Print #t, "\index";
   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
      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\"
#Include Once ""
#Include Once "win/"

Function BrowseCallbackProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal lParam As LPARAM, ByVal lpData As LPARAM) As Integer
   Select Case uMsg
         SendMessage( hWnd, BFFM_SETSELECTION, -1, lpData )
         Dim As ZString * MAX_PATH sPath
         If SHGetPathFromIDList( Cast( LPCITEMIDLIST, lParam ), sPath) = 0 Then
            sPath = "Unknown"
            sPath = "PATH: " + sPath
         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
      Function = ""

   CoUninitialize( )

End Function

Function FileOpen(hWnd As HWND, FTypes As String="Any File (*.*)|*.*",FSuggest As String="",DefaultPath As ZString Ptr) As String
   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
   Next strPos
   If Len(FSuggest) Then
      filename = FSuggest
   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"
      .nFileOffset         = 0
      .nFileExtension      = 0
      .lpstrDefExt         = NULL
      .lCustData            = 0
      .lpfnHook            = NULL
      .lpTemplateName      = NULL
   End With

   If GetOpenFileName( @ofn ) = FALSE Then
      filename = ""
   ' free memory from our derived filter
   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
  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

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.
Posts: 376
Joined: Feb 08, 2006 16:58

Postby TheMG » Nov 01, 2008 3:36

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

Postby vdecampo » Nov 01, 2008 14:43

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

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 13 guests