Quick run tool - Windows

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Quick run tool - Windows

Postby dodicat » Sep 29, 2019 13:07

Use this to run code previously written or copied code from the forum.
Keep this file in it's own folder, there are three .txt files written.
I see many users have a stash of fb compilers.
Add some of your favourites and choose one from your list (An idea from member deltarho).
Mainly quick compile then quick run, but compile and run is available.
Your chosen code is shown in notepad, it can be edited and saved and re compiled.
You can use the build options, e.g. -Wc -O3, to quickly test out your code.
Might be handy for fbide users.

Code: Select all


 #define WIN_INCLUDEALL
#Include Once "windows.bi"
#Include once "/win/commctrl.bi"
#include "file.bi"
#define nul chr(0)
Dim Shared As String req,comp
req="Basic (.bas) files"+NUL+"*.BAS"+NUL+"Include (.bi,.inc) files"+NUL+"*.INC;*.BI"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
comp="Choose (fbc) "+nul+"*.*"+nul+nul
Shell "title Compiler output"
Shell "color 4f"
Dim Shared As String fbpath,s1,cd,cpy,L,original,content,ld
Dim Shared As Long filechanged,cleanend,destroyed,washandled,useclipboard
Redim Shared As zstring * 1000 s(0 To 14) 'the compiler list
Dim Shared As HINSTANCE Hinst:hinst=GetModuleHandle(0)
ld=Curdir
destroyed=1

'procedures outwith winmain and winproc
Declare Sub string_split(Byval s As String,chars As String,result() As String)
Declare Function pre_pend(filename As String,txt As String) As String
Declare Function ap_pend(filename As String,txt As String) As String
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Declare Function getfiles(filetypes As String) As String
Declare Sub CreateMessageWindow
Declare Sub CreatecomboWindow(As wparam,As lparam)
Declare Function loadfile(file As String,flag As Long=1) As String
Declare Sub savefile(filename As String,p As String)
Declare Function getclipboard() As String
Declare Function CreateToolTip(X As hwnd,msg As String="") As hwnd
Declare Function remove(Byval txt As String,Char As String,start As Long=0,Byref dups As String="") As String

Dim Shared As zString * 500 textMessage=""  'switches e.g. -gen gas
textmessage=loadfile(ld+"\Buildoptions.txt") 'created if doesn't yet exist
Dim As String tmp
savefile(ld+"\Clipboard.txt","")
If Fileexists(ld+"\list.txt")=0 Then savefile(ld+"\list.txt","1000"+Chr(10))'created if doesn't yet exist
If Len(loadfile(ld+"\list.txt",3))<=5 Then savefile(ld+"\list.txt","1000"+Chr(10))'renew if required
Redim Shared As String t(Lbound(s) To Ubound(s))'string then to zstring
Var g=loadfile(ld+"\list.txt",3)
string_split(g,Chr(10),t())
Redim Preserve t(0 To Ubound(t)-1)
For n As Long=Lbound(t) To Ubound(t)
    s(n)=t(n) 'load list.txt into a zstring array for winapi
Next
fbpath=loadfile(ld+"\CompilerPath.txt",0)'created if doesn't yet exist
'global for winprocs
Dim Shared As hwnd  MainWindow, MessageWindow,btn,btn2,runbut,compiler
Dim Shared As hwnd EditBox, Button,msgon,label,minilabel,clabel,file,clipboard,OK
Dim Shared As hwnd fullcompile,fullrun,listcompilers ,combobox,deleter,listwindow
Dim Shared SomeFile As String'OpenFileName
Dim Shared As MSG uMsg

'Note files:
'files buildoptions.txt compilerpath.txt and list.txt and clipboard.txt are located in the
'same folder as this executable.
'clipboard.txt only exists while the program is running.

'The other temporary files for quick compile/run are located in the same folder as the source code to compile/run
'these other files are buildoptionsTEMP.bas and buildoptionsTEMP.exe.
'I have kept the silly names so they are easily spotted in case they don't delete properly (e.g. a power cut)


Function WndProc(hWnd As hwnd, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case hWnd
    Case MainWindow
        Select Case msg
       
        Case WM_PAINT 'hatch the mainwindow blue
            Dim As PAINTSTRUCT ps
            BeginPaint(hWnd, @ps)
            FillRect(ps.hdc, @ps.rcPaint,CreatehatchBrush(HS_DIAGCROSS,BGR(0,100,255)))
            EndPaint(hWnd, @ps)
           
        Case WM_CLOSE
            Kill   cd+"/buildoptionsTEMP.exe"
            Kill   cd+"/BuildoptionsTEMP.bas"
            Kill   ld+"/Clipboard.txt"
            If filechanged Then
                Var answer=messagebox(0,"Save all changes?",cpy,MB_YESNO Or MB_TOPMOST)
                If answer=IDYES Then:End If
                If answer=IDNO Then
                    savefile(original,content)
                End If
            End If
            cleanend=1
            PostQuitMessage(NULL)
           
        Case WM_COMMAND
            Select Case lParam
            Case msgon 'Build options
                If destroyed=1 Then
                    CreateMessageWindow
                    destroyed=0
                End If
               
            Case clipboard
                Kill   cd+"/buildoptionsTEMP.exe"
                Kill   cd+"/BuildoptionsTEMP.bas"
                useclipboard=1
                L=getclipboard
                savefile(ld+"\Clipboard.txt",L)
                cpy=ld+"\clipboard.txt"
                setwindowtext(file,"File" +Chr(13,10)+cpy)
                cd=Curdir
                Goto label
               
            Case btn 'open
                Kill   cd+"/buildoptionsTEMP.exe"
                Kill   cd+"/BuildoptionsTEMP.bas"
                'shell "start taskkill /F /IM notepad.exe"' > T.txt" '' no, self close notepad
                useclipboard=0
                filechanged=0
                somefile=getfiles(req)
                s1=SomeFile
                cpy=s1
                original=s1
                cd= Mid(somefile,1,Instrrev(somefile,"\")-1)
                setwindowtext(file,"File" +Chr(13,10)+cpy)
                L=loadfile(s1,3)
                content=L
                label:
                savefile(cd +"/BuildoptionsTEMP.bas",L)
                s1=cd+"/BuildoptionsTEMP.bas"
                ShellExecute (0,"","notepad.exe ",cpy,"",SW_SHOWNORMAL)
               
            Case btn2'quick compile
                If Len(s1) Then
                    textmessage=loadfile(ld+"\Buildoptions.txt",3)
                    s1=cd+"/BuildoptionsTEMP.bas"
                    Var tst1=loadfile(cpy,3)
                    Var tst2=loadfile(cd +"\BuildoptionsTEMP.bas",3)
                   
                    If tst1<>tst2 And useclipboard=0 Then
                        filechanged=1
                        savefile(cd+"/BuildoptionsTEMP.bas",tst1)
                    End If
                    Dim As String tm="Command "+Chr(13,10)+fbpath+Chr(13,10)+s1+" "+textmessage
                    setwindowtext(clabel,tm)
                    Print
                    Print "compiling . . ."
                    fbpath=remove(fbpath,Chr(34))
                    Err= Exec (fbpath,Chr(32,34)+s1+Chr(34,32)+textmessage)
                    If Err<>0 Then Print "ERROR": Kill   cd+"/buildoptionsTEMP.exe"
                    Print
                    Exec(fbpath," -version")
                    Print loadfile(ld+"\Buildoptions.txt",3)
                Else
                    messagebox(0,"No file chosen","",MB_TOPMOST)
                End If
               
            Case fullcompile'compile
                 if useclipboard then
                    messagebox(0,"Only Quick compile clipboard","", MB_TOPMOST)
                    goto cont3
                    end if
                Kill   cd+"/buildoptionsTEMP.exe" 'delete temp stuff
               ' Kill   cd+"/BuildoptionsTEMP.bas"
                If Len(s1) Then
                    textmessage=loadfile(ld+"\Buildoptions.txt",3)
                    s1=somefile
                    Var tst1=loadfile(cpy,3)
                    Var tst2=loadfile(Somefile,3)
                    If tst1<>tst2 And useclipboard=0 Then
                        filechanged=1
                        savefile(cd+"/BuildoptionsTEMP.bas",tst1)
                    End If
                    Dim As String tm="Command "+Chr(13,10)+fbpath+Chr(13,10)+s1+" "+textmessage
                    setwindowtext(clabel,tm)
                    Print
                    Print "compiling . . ."
                    fbpath=remove(fbpath,Chr(34))
                    Err= Exec (fbpath,Chr(32,34)+s1+Chr(34,32)+textmessage)
                    If Err<>0 Then
                        dim as long flag
                        Print "ERROR"
                        for n as long=lbound(s) to ubound(s)
    if remove(Mid(somefile,1,Instrrev(somefile,"."))+"exe",chr(34)) = remove(s(n),chr(34)) then flag=1
                        next
                      if flag=0 then  kill Mid(somefile,1,Instrrev(somefile,"."))+"exe"
                    end if
                    Print
                    Exec (fbpath , " -version")
                    Print loadfile(ld+"\Buildoptions.txt",3)
                Else
                    messagebox(0,"No file chosen","", MB_TOPMOST)
                End If
               cont3:
            Case runbut 'quick run
                Dim As String tm
                If Fileexists(cd +"\buildoptionsTEMP.exe")=0 Then
                    messagebox(0,"Nothing to run yet","Message", MB_TOPMOST)
                    Goto fin4
                End If
                tm="Command "+Chr(13,10)+cd+"/buildoptionsTEMP.exe"
                setwindowtext(clabel,tm)
                If Fileexists (  cd+"/buildoptionsTEMP.exe")  Then
                    ShellExecute (0,"", cd+"/buildoptionsTEMP.exe","","",SW_SHOWNORMAL)
                End If
                fin4:
               
            Case fullrun 'run
                Dim As String rnr=Mid(somefile,1,Instrrev(somefile,"."))+"exe"
                Dim As String tm="Command "+Chr(13,10)+rnr
                setwindowtext(clabel,tm)
                If Fileexists ( rnr)  Then
                    ShellExecute (0,"",rnr,"","",SW_SHOWNORMAL)
                Else
                    messagebox(0,"Nothing compiled","Message", MB_TOPMOST)     
                End If
               
            Case compiler'add compiler
               var somefile=getfiles(comp)
               var s1=somefile
                If Instr(s1," ") Then s1=Chr(34)+s1+Chr(34)
                Redim As String tmp()
                Var g=loadfile(ld+"\list.txt")
                string_split(g,Chr(10),tmp())
                If Ubound(tmp)>12 Then
                    messagebox(0,"Delete some compilers from the list","You have exceeded the maximum number of compilers",MB_TOPMOST)
                    Goto cont
                End If
                If Instr(Lcase(s1),"fbc.exe")=0 Then
                    messagebox(0,"fbc.exe is expected, but carry on anyway","REMINDER",MB_TOPMOST)
                End If
                ap_pend(ld+"\list.txt",s1+Chr(10))
                cont:
               
            Case listcompilers 'select a compiler
                If washandled =0 Then
                    CreatecomboWindow(wparam,lparam)
                    Var g=loadfile(ld+"\list.txt",3)
                    string_split(g,Chr(10),t())
                    Redim Preserve t(0 To Ubound(t)-1)
                    For n As Long=Lbound(t) To Ubound(t)
                        s(n)=t(n)
                    Next
                    washandled=1
                End If
               
            Case deleter  'edit / delete compilers via notepad
                ShellExecute (0,"edit",ld+"\list.txt","","",SW_SHOWNORMAL)
               
            End Select 'lparam
           
        End Select  'msg  of hwnd   
       
    Case ListWindow 'combobox window(free window)
        Select Case msg
       
        Case WM_COMMAND 'process combobox value (must be via WM_COMMAND)
            If(Hiword(wParam) = CBN_SELCHANGE) Then
                Var ItemIndex = SendMessage(Cast(Any Ptr,lParam), CB_GETCURSEL, 0,0)+1
                pre_pend(ld+"\list.txt",Str(itemIndex))
                Var g=loadfile(ld+"\list.txt",3)
                string_split(g,Chr(10),t())
                Redim Preserve t(0 To Ubound(t)-1)
                For n As Long=Lbound(t) To Ubound(t)
                    s(n)=t(n)
                Next
            End If
           
            Select Case lParam 'of msg/listwindow
           
            Case OK 'apply button
                destroywindow(Listwindow)
                washandled=0
                If Val(s(0))=1000 Then
                    messagebox(0,"Add a compiler","You have no compilers chosen ", MB_TOPMOST)
                    Goto cont1
                End If
                savefile(ld+"/CompilerPath.txt",s(Val(s(0))))
                fbpath=loadfile(ld +"/CompilerPath.txt",3)
                setwindowtext(label, fbpath)
                cont1:
            End Select 'lparam of msg/listwindow
           
        Case WM_CLOSE
            destroywindow(Listwindow)
            washandled=0
            If Val(s(0))=1000 Then
                messagebox(0,"Add a compiler","You have no compilers chosen ", MB_TOPMOST)
                Goto cont2
            End If
            savefile(ld+"/CompilerPath.txt",s(Val(s(0))))
            fbpath=loadfile(ld +"/CompilerPath.txt",3)
            setwindowtext(label, fbpath)
            washandled=0
            cont2:
        End Select 'msg/listwindow
       
    Case MessageWindow  'build options window (free window)
        Select Case msg
        Case WM_COMMAND
            Select Case lParam
            Case Button   
                GetWindowText(EditBox, @textMessage, 255)
                savefile(ld+"\buildoptions.txt",textmessage)
                destroywindow(messagewindow)
                destroyed=1
            End Select
        Case WM_CLOSE
            destroyed=1
        End Select 'msg/messagewindow
       
    End Select 'hwnd
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Function winmain As Long
    Dim As WNDCLASS wcls
    With wcls
        .style      = CS_HREDRAW Or CS_VREDRAW Or CS_DROPSHADOW'
        .lpfnWndProc  = Cast(WNDPROC, @WndProc)
        .hInstance    = GetModuleHandle(NULL)
        .hIcon      = LoadIcon(NULL, IDI_APPLICATION)
        .hCursor      = LoadCursor(NULL, IDC_ARROW)
        .hbrBackground  = GetStockObject(WHITE_BRUSH)
        .lpszMenuName  = NULL
        .lpszClassName  = Strptr("WindowClass")
    End With
    If RegisterClass(@wcls) = FALSE Then
        MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
        End
    End If
    'set the windows
    'un-resizable windows with bare title bar
    MainWindow = CreateWindowEx( WS_EX_TOPMOST Or WS_EX_TOOLWINDOW  , "WindowClass", "Quick runner -->  Quick compile  then  Quick run     (End program by closing window) --->", (WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME) Or WS_VISIBLE , 100, 100, 630, 500, NULL, NULL, NULL, NULL)
    msgon= CreateWindowEx(NULL, "Button", "Build options", WS_VISIBLE Or WS_CHILD , 10, 40, 90, 24, MainWindow, NULL, NULL, NULL)
    btn=CreateWindowEx( 0,"BUTTON","Open file", ws_border Or WS_VISIBLE Or WS_CHILD ,150,50,100,30,  MainWindow,0,0,0)
    btn2  =createwindowex(0,"BUTTON","Quick Compile"  ,ws_border Or WS_VISIBLE Or WS_CHILD,280,50,120,30,MainWindow,0,0,0)
    runbut=createwindowex(0,"BUTTON","Quick Run"  ,ws_border Or WS_VISIBLE Or WS_CHILD,430,50,120,30,MainWindow,0,0,0)
    fullcompile=createwindowex(0,"BUTTON","Compile"  ,ws_border Or WS_VISIBLE Or WS_CHILD,280,100,120,30,MainWindow,0,0,0)
    fullrun=createwindowex(0,"BUTTON","Run"  ,ws_border Or WS_VISIBLE Or WS_CHILD,430,100,120,30,MainWindow,0,0,0)
    clipboard=CreateWindowEx( 0,"BUTTON","Get clipboard", ws_border Or WS_VISIBLE Or WS_CHILD ,110,150,120,30,  MainWindow,0,0,0)
    compiler=createwindowex(0,"BUTTON","Add Compiler"  ,ws_border Or WS_VISIBLE Or WS_CHILD,230,150,120,30,MainWindow,0,0,0)
    listcompilers =createwindowex(0,"BUTTON","Select Compiler",ws_border Or WS_VISIBLE Or WS_CHILD,350,150,120,30,MainWindow,0,0,0)
    deleter=createwindowex(0,"BUTTON","Edit compiler list",ws_border Or WS_VISIBLE Or WS_CHILD,470,150,120,30,MainWindow,0,0,0)
    label=createwindowex(0,"STATIC",fbpath , WS_VISIBLE Or WS_CHILD or SS_EDITCONTROL,10,200,600,60,MainWindow,0,0,0)
    minilabel=Createwindowex(0,"STATIC","Compiler:"  ,WS_VISIBLE Or WS_CHILD or SS_EDITCONTROL,10,170,100,30,MainWindow,0,0,0)
    clabel=createwindowex(0,"STATIC","Command " , WS_VISIBLE Or WS_CHILD or SS_EDITCONTROL,10,280,600,80,MainWindow,0,0,0)
    file=createwindowex(0,"STATIC","File" , WS_VISIBLE Or WS_CHILD or SS_EDITCONTROL,10,380,600,60,MainWindow,0,0,0)
    SetWindowTheme(mainwindow," "," ")
    While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
        TranslateMessage(@uMsg)
        DispatchMessage(@uMsg)
    Wend
    Return 0
End Function

' two seperate windows
Sub CreateMessageWindow 'for setting compiler options
    MessageWindow = CreateWindowEx(WS_EX_TOPMOST Or WS_EX_TOOLWINDOW, "WindowClass", "Options", (WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME) Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 300, 150, NULL, NULL, NULL, NULL)
    EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD Or WS_HSCROLL  Or ES_AUTOHSCROLL Or ES_MULTILINE, 10, 0, 250, 50, MessageWindow, NULL, NULL, NULL)
    Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
    SetWindowTheme(messagewindow," "," ")'  optional
    createtooltip(EditBox,"example: -gen gcc -Wc -O3")
End Sub

Sub CreatecomboWindow(wparam As WPARAM,lparam As lparam)'for a list of compilers
    Var g2=loadfile(ld+"\list.txt",3)
    string_split(g2,Chr(10),t())
    Redim Preserve t(0 To Ubound(t)-1)
    For n As Long=Lbound(s) To Ubound(s)
        s(n)=""
    Next
    For n As Long=Lbound(t) To Ubound(t)
        s(n)=t(n)
    Next
    ListWindow=CreateWindowEx(WS_EX_TOPMOST Or WS_EX_TOOLWINDOW,"windowclass","Choose from compiler list",_
    WS_VISIBLE Or (WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME),100,100,800,300,0,0,Hinst,0)
    Combobox=CreateWindowEx( null,_
    WC_COMBOBOX,_
    "ComboBox",_
    WS_VISIBLE Or WS_CHILD Or CBS_DROPDOWN Or WS_VSCROLL Or WS_HSCROLL,_
    10,10,770,200,ListWindow,Cast(HMENU,1),0,0)
    ok=CreateWindowEx(0,"Button","Apply",_
    WS_VISIBLE Or WS_CHILD,150,230,150,30,listwindow,0,0,0)
    For n As Long=Lbound(s)+1 To Ubound(s)
        SendMessage(Combobox,CB_ADDSTRING,0,Cast(LPARAM,@s(n)))
    Next
    Var g=loadfile(ld+"\list.txt",3)
    string_split(g,Chr(10),t())
    Redim Preserve t(0 To Ubound(t)-1)
    For n As Long=Lbound(t) To Ubound(t)
        s(n)=t(n)
    Next
    SendMessage(ComboBox, CB_SETCURSEL, -1+Val(s(0)),0)
    washandled=1
    SetWindowTheme(ListWindow," "," ")'  optional
    createtooltip(combobox,"Scroll to choose a compiler")
End Sub

Function getfiles(filetypes As String) As String
    Dim As zstring * 2048 SELFILE
    Dim As String MYFILTER
    myfilter=filetypes
    Dim As OpenFileName SomeFile
    With SomeFile
        .lStructSize = Sizeof(OpenFileName)
        .hInstance = null
        .lpstrFilter = Strptr(MYFILTER)
        .lpstrFile = @SELFILE
        .nMaxFile = 2048
        .nMaxFileTitle = 0
        .lpstrTitle =@"Open"
        .hwndOwner=mainwindow
    End With
    GetOpenFileName(@SomeFile)
    Return *SomeFile.lpstrFile
End Function

Function loadfile(file As String,flag As Long=1) As String
    If flag=1 Then
        If Fileexists(ld+"\Buildoptions.txt")=0 Then savefile(ld+"\Buildoptions.txt","")
    End If
    If flag=0 Then
        If Fileexists(ld+"\CompilerPath.txt")=0 Then savefile(ld+"\CompilerPath.txt","")
    End If
    Var  f=Freefile
    If Fileexists(file)=0 Then Print file + "  not found":Exit Function
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
        text = String(Lof(f), 0)
        Get #f, , text
    End If
    Close #f
    Return text
End Function

Sub savefile(filename As String,p As String)
    Dim As Integer n
    n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename
    End If
End Sub

Function pre_pend(filename As String,txt As String) As String
    Dim As String s=loadfile(filename,3),tmp
    Redim As String g()
    string_split(s,Chr(10),g())
    g(1)=""
    For n As Long=2 To Ubound(g)
        tmp+=g(n)+Chr(10)
    Next
    savefile(filename,tmp)
    s=loadfile(filename,3)
    If Len(s) Then savefile(filename,txt+Chr(10)+s)
    Return filename
End Function

Function ap_pend(filename As String,txt As String) As String
    Dim As String s=loadfile(filename,3)
    If Len(s) Then savefile(filename,s+txt)
    Return filename
End Function

Function getclipboard() As String
    If IsClipboardFormatAvailable(CF_TEXT) = 0 Then Return "Error"
    If OpenClipboard(0) = 0 Then Return "Error"
    Function = *Cast(zstring Ptr,GetClipboardData(CF_TEXT))
    CloseClipboard()
End Function

Function CreateToolTip(X As hwnd,msg As String="") As hwnd
    Dim As hwnd  TT= CreateWindowEx(0,"ToolTips_Class32","",64,0,0,0,0,X,0,GetModuleHandle(0),0)
    SendMessage(TT, TTM_SETMAXTIPWIDTH, 0 , 280)
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_INITIAL ,40)
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_RESHOW  ,60)
    Dim bubble As TOOLINFO
    bubble.cbSize = Len(TOOLINFO)
    bubble.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
    bubble.uId = Cast(Uinteger,X)
    bubble.lpszText = Strptr(msg)
    SendMessage(TT, TTM_ADDTOOL, 0,Cast(LPARAM,@bubble))
    Return TT
End Function

Sub string_split(Byval s As String,chars As String,result() As String)
    Redim result(0)
    Dim As String var1,var2
    Dim As Long pst,LC=Len(chars)
    #macro split(stri)
    pst=Instr(stri,chars)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+LC)
    Else
        var1=stri
    End If
    If Len(var1) Then
        Redim Preserve result(1 To Ubound(result)+1)
        result(Ubound(result))=var1
    End If
    #endmacro
    Do
        split(s):s=var2
    Loop Until var2=""
End Sub

Function remove(Byval txt As String,Char As String,start As Long=0,Byref dups As String="") As String
    Var id = start
    For i As Long = start To Len(txt) - 1
        If txt[i]<>Asc(char) Then txt[id]=txt[i]:id+=1 Else dups=Chr(txt[i])
    Next
    Return Left(txt,id)
End Function

Sub cleanup Destructor
    Kill   cd+"/buildoptionsTEMP.exe"
    Kill   cd+"/BuildoptionsTEMP.bas"
    Kill   ld+"/Clipboard.txt"
End Sub

End winmain

 

Added a slimline version.

Code: Select all

#define WIN_INCLUDEALL
#Include Once "windows.bi"
#Include once "/win/commctrl.bi"
#include "file.bi"
#define nul chr(0)

Dim Shared As String req,comp
req="Basic (.bas) files"+NUL+"*.BAS"+NUL+"Include (.bi,.inc) files"+NUL+"*.INC;*.BI"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
comp="Choose (fbc) "+nul+"*.*"+nul+nul
Shell "title Compiler output"
Shell "color 4f"
Dim Shared As String fbpath,s1,cd,cpy,L,original,content,ld,rnr
Dim Shared As Long filechanged,cleanend,destroyed,washandled,useclipboard
Dim Shared As Long tx,ty,frame
frame=GetSystemMetrics(SM_CYCAPTION)
If frame<23 Then frame=23
Redim Shared As zstring * 1000 s(0 To 14) 'the compiler list
Dim Shared As HINSTANCE Hinst:hinst=GetModuleHandle(0)
ld=Curdir
destroyed=1

'procedures outwith winmain and winproc
Declare Sub string_split(Byval s As String,chars As String,result() As String)
Declare Function pre_pend(filename As String,txt As String) As String
Declare Function ap_pend(filename As String,txt As String) As String
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Declare Function getfiles(filetypes As String) As String
Declare Sub CreateMessageWindow
Declare Sub CreatecomboWindow()
Declare Function loadfile(file As String,flag As Long=1) As String
Declare Sub savefile(filename As String,p As String)
Declare Function getclipboard() As String
Declare Function CreateToolTip(X As hwnd,msg As String="") As hwnd
Declare Function remove(Byval txt As String,Char As String,start As Long=0,Byref dups As String="") As String

Dim Shared As zString * 500 textMessage=""  'switches e.g. -gen gas
textmessage=loadfile(ld+"\Buildoptions.txt") 'created if doesn't yet exist
Dim As String tmp
savefile(ld+"\Clipboard.txt","")
If Fileexists(ld+"\list.txt")=0 Then savefile(ld+"\list.txt","1000"+Chr(10))'created if doesn't yet exist
If Len(loadfile(ld+"\list.txt",3))<=5 Then savefile(ld+"\list.txt","1000"+Chr(10))'renew if required
Redim Shared As String t(Lbound(s) To Ubound(s))'string then to zstring
Var g=loadfile(ld+"\list.txt",3)
string_split(g,Chr(10),t())
Redim Preserve t(0 To Ubound(t)-1)
For n As Long=Lbound(t) To Ubound(t)
    s(n)=t(n) 'load list.txt into a zstring array for winapi
Next
fbpath=loadfile(ld+"\CompilerPath.txt",0)'created if doesn't yet exist
'global for winprocs
Dim Shared As hwnd  MainWindow, MessageWindow,btn,btn2,runbut,compiler
Dim Shared As hwnd EditBox, Button,msgon,label,clabel,file,clipboard,OK
Dim Shared As hwnd fullcompile,fullrun,listcompilers ,combobox,deleter,listwindow
Dim Shared SomeFile As String'OpenFileName
Dim Shared As MSG uMsg
Dim Shared As hfont hfont

var consoleWindow = GetConsoleWindow()

SetWindowPos(consoleWindow,0,0,0,0,0,SWP_NOSIZE or SWP_NOZORDER )

'Note files:
'files buildoptions.txt compilerpath.txt and list.txt and clipboard.txt are located in the
'same folder as this executable.
'clipboard.txt only exists while the program is running.

'The other temporary files for quick compile/run are located in the same folder as the source code to compile/run
'these other files are buildoptionsTEMP.bas and buildoptionsTEMP.exe.
'I have kept the silly names so they are easily spotted in case they don't delete properly (e.g. a power cut)

Function WndProc(hWnd As hwnd, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case hWnd
    Case MainWindow
        Select Case msg
       
        Case WM_PAINT 'hatch the mainwindow blue
            Dim As PAINTSTRUCT ps
            BeginPaint(hWnd, @ps)
             FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(BGR(240,240,240)))
         
            EndPaint(hWnd, @ps)
           
        Case WM_CLOSE
            Kill   cd+"/buildoptionsTEMP.exe"
            Kill   cd+"/BuildoptionsTEMP.bas"
            Kill   ld+"/Clipboard.txt"
            If filechanged Then
                Var answer=messagebox(0,"Save all changes?",cpy,MB_YESNO Or MB_TOPMOST)
                If answer=IDYES Then:End If
                If answer=IDNO Then
                    savefile(original,content)
                End If
            End If
            cleanend=1
            PostQuitMessage(NULL)
           
        Case WM_COMMAND
            Select Case lParam
            Case msgon 'Build options
                If destroyed=1 Then
                    CreateMessageWindow
                    destroyed=0
                End If
               
            Case clipboard
                Kill   cd+"/buildoptionsTEMP.exe"
                Kill   cd+"/BuildoptionsTEMP.bas"
                useclipboard=1
                L=getclipboard
                savefile(ld+"\Clipboard.txt",L)
                cpy=ld+"\clipboard.txt"
                setwindowtext(file,"File" +Chr(13,10)+cpy)
                cd=Curdir
                Goto labl
               
            Case btn 'open
                Kill   cd+"/buildoptionsTEMP.exe"
                Kill   cd+"/BuildoptionsTEMP.bas"
                'shell "start taskkill /F /IM notepad.exe"' > T.txt" '' no, self close notepad
                useclipboard=0
                filechanged=0
                somefile=getfiles(req)
                s1=SomeFile
                cpy=s1
                original=s1
                cd= Mid(somefile,1,Instrrev(somefile,"\")-1)
                setwindowtext(file,"File" +Chr(13,10)+cpy)
                L=loadfile(s1,3)
                content=L
                labl:
                savefile(cd +"/BuildoptionsTEMP.bas",L)
                s1=cd+"/BuildoptionsTEMP.bas"
                ShellExecute (0,"","notepad.exe ",cpy,"",SW_SHOWNORMAL)
               
            Case btn2'quick compile
                If Len(s1) Then
                    textmessage=loadfile(ld+"\Buildoptions.txt",3)
                    s1=cd+"/BuildoptionsTEMP.bas"
                    Var tst1=loadfile(cpy,3)
                    Var tst2=loadfile(cd +"/BuildoptionsTEMP.bas",3)
                    If tst1<>tst2 And useclipboard=0 Then
                        filechanged=1
                        savefile(cd+"/BuildoptionsTEMP.bas",tst1)
                    End If
                    Dim As String tm="Command "+Chr(13,10)+fbpath+Chr(13,10)+s1+" "+textmessage
                    setwindowtext(clabel,tm)
                    Print
                    Print "compiling . . ."
                    fbpath=remove(fbpath,Chr(34))
                    var t=timer
                    Err= Exec (fbpath,Chr(32,34)+s1+Chr(34,32)+textmessage)
                    If Err<>0 Then
                    Print "ERROR": Kill   cd+"/buildoptionsTEMP.exe"': setwindowtext(clabel,"Command")
                    else
                     print "Success (";timer-t;"  seconds)" 
                     end if
                    Print
                    Exec(fbpath," -version")
                    Print loadfile(ld+"\Buildoptions.txt",3)
                Else
                    messagebox(0,"No file chosen","",MB_TOPMOST)
                End If
               
            Case fullcompile'compile
                If useclipboard Then
                    messagebox(0,"Only Quick compile clipboard","", MB_TOPMOST)
                    Goto cont2
                    End If
                Kill   cd+"/buildoptionsTEMP.exe" 'delete temp stuff
               ' Kill   cd+"/BuildoptionsTEMP.bas"
                If Len(s1) Then
                    textmessage=loadfile(ld+"\Buildoptions.txt",3)
                    s1=somefile
                    Var tst1=loadfile(cpy,3)
                    Var tst2=loadfile(Somefile,3)
                    If tst1<>tst2 And useclipboard=0 Then
                        filechanged=1
                        savefile(cd+"/BuildoptionsTEMP.bas",tst1)
                    End If
                    Dim As String tm="Command "+Chr(13,10)+fbpath+Chr(13,10)+s1+" "+textmessage
                    setwindowtext(clabel,tm)
                    Print
                    Print "compiling . . ."
                    fbpath=remove(fbpath,Chr(34))
                    var t=timer
                    Err= Exec (fbpath,Chr(32,34)+s1+Chr(34,32)+textmessage)
                    If Err<>0 Then
                        Dim As Long flag
                        Print "ERROR"
                        For n As Long=Lbound(s) To Ubound(s)
     
    If remove(Mid(somefile,1,Instrrev(somefile,"."))+"exe",Chr(34)) = remove(s(n),Chr(34)) Then flag=1
                        Next
            If flag=0 Then  Kill Mid(somefile,1,Instrrev(somefile,"."))+"exe"':setwindowtext(clabel,"Command")
                       
                    Else
                   print "Success (";timer-t;"  seconds)"
                   end if
                    Print
                    Exec (fbpath , " -version")
                    Print loadfile(ld+"\Buildoptions.txt",3)
                Else
                    messagebox(0,"No file chosen","", MB_TOPMOST)
                End If
                cont2:
            Case runbut 'quick run
                Dim As String tm
                If Fileexists(cd +"\buildoptionsTEMP.exe")=0 Then
                    messagebox(0,"Nothing to run yet","Message", MB_TOPMOST)
                    Goto fin4
                End If
                tm="Command "+Chr(13,10)+cd+"/buildoptionsTEMP.exe"
                setwindowtext(clabel,tm)
                If Fileexists (  cd+"/buildoptionsTEMP.exe")  Then
                    ShellExecute (0,"", cd+"/buildoptionsTEMP.exe","","",SW_SHOWNORMAL)
                End If
                fin4:
               
            Case fullrun 'run
                rnr=Mid(somefile,1,Instrrev(somefile,"."))+"exe"
                Dim As String tm="Command "+Chr(13,10)+rnr
                setwindowtext(clabel,tm)
                If Fileexists ( rnr)  Then
                    ShellExecute (0,"",rnr,"","",SW_SHOWNORMAL)
                Else
                     setwindowtext(clabel,"Command")
                    messagebox(0,"Nothing compiled","Message", MB_TOPMOST)
                End If
               
            Case compiler'add compiler
               Var somefile=getfiles(comp)
               Var  s1=somefile
                If Instr(s1," ") Then s1=Chr(34)+s1+Chr(34)
                Redim As String tmp()
                Var g=loadfile(ld+"\list.txt")
                string_split(g,Chr(10),tmp())
                If Ubound(tmp)>12 Then
                    messagebox(0,"Delete some compilers from the list","You have exceeded the maximum number of compilers",MB_TOPMOST)
                    Goto cont
                End If
                If Instr(Lcase(s1),"fbc.exe")=0 Then
                    messagebox(0,"fbc.exe is expected, but carry on anyway","REMINDER",MB_TOPMOST)
                End If
                ap_pend(ld+"\list.txt",s1+Chr(10))
                cont:
               
            Case listcompilers 'select a compiler
                If washandled =0 Then
                    CreatecomboWindow()
                    Var g=loadfile(ld+"\list.txt",3)
                    string_split(g,Chr(10),t())
                    Redim Preserve t(0 To Ubound(t)-1)
                    For n As Long=Lbound(t) To Ubound(t)
                        s(n)=t(n)
                    Next
                    washandled=1
                End If
               
            Case deleter  'edit / delete compilers via notepad
                ShellExecute (0,"edit",ld+"\list.txt","","",SW_SHOWNORMAL)
            End Select 'lparam
           
           Case Else
               'handle highlighting boxes
               #define es Exit Select
               Dim As rect r
               Dim As Point m
               getcursorpos(@m)
               getwindowrect(MainWindow,@r)
    tx=r.left:ty=r.top
    Static As boolean cond(1 To 10)
    Static As Any Ptr twin(1 To 10)
   cond(1)=m.x>tx And m.x < tx+70 And m.y< ty+ frame+20 And m.y>ty+frame
   cond(2)=m.x>tx+70 And m.x < tx+70+100 And m.y< ty+ frame+20 And m.y>ty+frame
   cond(3)=m.x>tx+170 And m.x < tx+170+110 And m.y< ty+ frame+20 And m.y>ty+frame
   cond(4)=m.x>tx+280 And m.x < tx+280+85 And m.y< ty+ frame+20 And m.y>ty+frame
   cond(5)=m.x>tx+365 And m.x < tx+365+70 And m.y< ty+ frame+20 And m.y>ty+frame
   cond(6)=m.x>tx+435 And m.x < tx+435+45 And m.y< ty+ frame+20 And m.y>ty+frame
   cond(7)=m.x>tx+480 And m.x < tx+480+105 And m.y< ty+ frame+20 And m.y>ty+frame
   cond(8)=m.x>tx+585 And m.x < tx+585+120 And m.y< ty+ frame+20 And m.y>ty+frame
   cond(9)=m.x>tx+705 And m.x < tx+705+115 And m.y< ty+ frame+20 And m.y>ty+frame
   cond(10)=m.x>tx+820 And m.x < tx+820+100 And m.y< ty+ frame+20 And m.y>ty+frame
    If cond(1) And twin(1)=0 Then twin(1)= CreateWindowEx(0,"static","Open file",WS_visible Or WS_CHILD,0,0,70,20,btn,0,0,0):es
    If cond(2) And twin(2)=0 Then twin(2)= CreateWindowEx(0,"static","Get clipboard",WS_visible Or WS_CHILD,0,0,90,20,clipboard,0,0,0):es
    If cond(3) And twin(3)=0 Then twin(3)= CreateWindowEx(0,"static","Quick Compile",WS_visible Or WS_CHILD,0,0,110,20,btn2,0,0,0):es
    If cond(4) And twin(4)=0 Then twin(4)= CreateWindowEx(0,"static","Quick Run",WS_visible Or WS_CHILD,0,0,80,20,runbut,0,0,0):es
    If cond(5) And twin(5)=0 Then twin(5)= CreateWindowEx(0,"static","Compile",WS_visible Or WS_CHILD,0,0,70,20,fullcompile,0,0,0):es
    If cond(6) And twin(6)=0 Then twin(6)= CreateWindowEx(0,"static","Run",WS_visible Or WS_CHILD,0,0,45,20,fullrun,0,0,0):es
    If cond(7) And twin(7)=0 Then twin(7)= CreateWindowEx(0,"static","Add Compiler",WS_visible Or WS_CHILD,0,0,105,20,compiler,0,0,0):es
    If cond(8) And twin(8)=0 Then twin(8)= CreateWindowEx(0,"static","Select Compiler",WS_visible Or WS_CHILD,0,0,120,20,listcompilers,0,0,0):es
    If cond(9) And twin(9)=0 Then twin(9)= CreateWindowEx(0,"static","Edit Compilers",WS_visible Or WS_CHILD,0,0,115,20,deleter,0,0,0):es
    If cond(10) And twin(10)=0 Then twin(10)= CreateWindowEx(0,"static","Build options",WS_visible Or WS_CHILD,0,0,100,20,msgon,0,0,0):es
   
    For n As Long=1 To 10
    If cond(n)=0 Then  destroywindow twin(n):twin(n)=0
    Next
 
        End Select  'msg  of hwnd   
       
    Case ListWindow 'combobox window(free window)
        Select Case msg
       
        Case WM_COMMAND 'process combobox value (must be via WM_COMMAND)
            If(Hiword(wParam) = CBN_SELCHANGE) Then
                Var ItemIndex = SendMessage(Cast(Any Ptr,lParam), CB_GETCURSEL, 0,0)+1
                pre_pend(ld+"\list.txt",Str(itemIndex))
                Var g=loadfile(ld+"\list.txt",3)
                string_split(g,Chr(10),t())
                Redim Preserve t(0 To Ubound(t)-1)
                For n As Long=Lbound(t) To Ubound(t)
                    s(n)=t(n)
                Next
            End If
           
            Select Case lParam 'of msg/listwindow
           
            Case OK 'apply button
                destroywindow(Listwindow)
                washandled=0
                If Val(s(0))=1000 Then
                    messagebox(0,"Add a compiler","You have no compilers chosen ", MB_TOPMOST)
                    Goto cont1
                End If
                savefile(ld+"/CompilerPath.txt",s(Val(s(0))))
                fbpath=loadfile(ld +"/CompilerPath.txt",3)
                setwindowtext(label,"Compiler "+Chr(13,10)+fbpath)'
                cont1:
            End Select 'lparam of msg/listwindow
           
        Case WM_CLOSE
            destroywindow(Listwindow)
            washandled=0
            If Val(s(0))=1000 Then
                messagebox(0,"Add a compiler","You have no compilers chosen ", MB_TOPMOST)
                Goto cont3
            End If
            savefile(ld+"/CompilerPath.txt",s(Val(s(0))))
            fbpath=loadfile(ld +"/CompilerPath.txt",3)
           
            setwindowtext(label,"Compiler "+Chr(13,10)+fbpath)
            washandled=0
            cont3:
        End Select 'msg/listwindow
       
    Case MessageWindow  'build options window (free window)
        Select Case msg
        Case WM_COMMAND
            Select Case lParam
            Case Button   
                GetWindowText(EditBox, @textMessage, 255)
                savefile(ld+"\buildoptions.txt",textmessage)
                destroywindow(messagewindow)
                destroyed=1
            End Select
        Case WM_CLOSE
            destroyed=1
        End Select 'msg/messagewindow
       
    End Select 'hwnd
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Function winmain As Long
    Dim As WNDCLASS wcls
    With wcls
        .style      = CS_HREDRAW Or CS_VREDRAW Or CS_DROPSHADOW '
        .lpfnWndProc  = Cast(WNDPROC, @WndProc)
        .hInstance    = GetModuleHandle(NULL)
        .hIcon      = LoadIcon(NULL, IDI_APPLICATION)
        .hCursor      = LoadCursor(NULL, IDC_ARROW)
        .hbrBackground  = GetStockObject(WHITE_BRUSH)
        .lpszMenuName  = NULL
        .lpszClassName  = Strptr("WindowClass")
    End With
    If RegisterClass(@wcls) = FALSE Then
        MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
        End
    End If
   
    'set the windows
    'un-resizable windows with bare title bar
    MainWindow = CreateWindowEx( WS_EX_TOPMOST Or WS_EX_TOOLWINDOW  , "WindowClass", "Quick runner -->  Quick compile  then  Quick run"  +space(120)+   "(End program by closing window) --->", (WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME) Or WS_VISIBLE , 100, 100, 920, 320, NULL, NULL, NULL, NULL)
   
    btn=CreateWindowEx(0,"static","Open file", WS_VISIBLE Or WS_CHILD Or SS_NOTIFY,0,0,70,20,  MainWindow,0,0,0)',,,
    clipboard=CreateWindowEx(0,"static","Get clipboard",WS_VISIBLE Or WS_CHILD Or SS_NOTIFY ,70,0,100,20,  MainWindow,0,0,0)'''
    btn2  =createwindowex(0,"static","Quick Compile"  ,WS_VISIBLE Or WS_CHILD Or SS_NOTIFY,170,0,110,20,MainWindow,0,0,0)
    runbut=createwindowex(0,"static","Quick Run"  ,WS_VISIBLE Or WS_CHILD Or SS_NOTIFY,280,0,85,20,MainWindow,0,0,0)
    fullcompile=createwindowex(0,"static","Compile"  ,WS_VISIBLE Or WS_CHILD Or SS_NOTIFY,365,0,70,20,MainWindow,0,0,0)
    fullrun=createwindowex(0,"static","Run"  ,WS_VISIBLE Or WS_CHILD Or SS_NOTIFY,435,0,45,20,MainWindow,0,0,0)
    compiler=createwindowex(0,"static","Add Compiler"  ,WS_VISIBLE Or WS_CHILD Or SS_NOTIFY,480,0,105,20,MainWindow,0,0,0)
    listcompilers =createwindowex(0,"static","Select Compiler",WS_VISIBLE Or WS_CHILD Or SS_NOTIFY,585,0,120,20,MainWindow,0,0,0)
    deleter=createwindowex(0,"static","Edit compilers",WS_VISIBLE Or WS_CHILD Or SS_NOTIFY,705,0,115,20,MainWindow,0,0,0)
    msgon= CreateWindowEx(0, "static", "Build options", WS_VISIBLE Or WS_CHILD Or SS_NOTIFY ,820,0,100,20, MainWindow, NULL, NULL, NULL)
   
    label=createwindowex(0,"static","Compiler"+Chr(13,10)+fbpath , WS_VISIBLE Or WS_CHILD Or SS_EDITCONTROL,10,200-160,900,60,MainWindow,0,0,0)
    clabel=createwindowex(0,"STATIC","Command" , WS_VISIBLE Or WS_CHILD Or SS_EDITCONTROL,10,280-165,900,90,MainWindow,0,0,0)
    file=createwindowex(0,"STATIC","File" ,WS_VISIBLE Or WS_CHILD Or SS_EDITCONTROL,10,380-160,900,60,MainWindow,0,0,0)
    SetWindowTheme(mainwindow," "," ")
 
    'handle fonts
    Dim As logfont lf
    memset(@lf, 0, Sizeof(logFont))
    lf.lfHeight = -15
    lf.lfWeight = FW_NORMAL
    hFont = CreateFontIndirect(@lf)
    Dim As Any Ptr g(...)={msgon,btn,btn2,runbut,fullcompile,fullrun,clipboard, _
                           compiler,listcompilers,deleter,label,clabel,file}
   
    For n As Long=0 To Ubound(g)
        SendMessage(g(n), WM_SETFONT, Cast(WPARAM, hFont), TRUE)
    Next
   
    While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
        TranslateMessage(@uMsg)
        DispatchMessage(@uMsg)
    Wend
    Return 0
End Function

' two seperate windows
Sub CreateMessageWindow 'for setting compiler options
    MessageWindow = CreateWindowEx(WS_EX_TOPMOST Or WS_EX_TOOLWINDOW, "WindowClass", "Options", (WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME) Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 300, 150, NULL, NULL, NULL, NULL)
    EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD Or WS_HSCROLL  Or ES_AUTOHSCROLL Or ES_MULTILINE, 10, 0, 250, 50, MessageWindow, NULL, NULL, NULL)
    Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
    SetWindowTheme(messagewindow," "," ")'  optional
    createtooltip(EditBox,"example: -gen gcc -Wc -O3")
End Sub

Sub CreatecomboWindow()'for a list of compilers
    Var g2=loadfile(ld+"\list.txt",3)
    string_split(g2,Chr(10),t())
    Redim Preserve t(0 To Ubound(t)-1)
    For n As Long=Lbound(s) To Ubound(s)
        s(n)=""
    Next
    For n As Long=Lbound(t) To Ubound(t)
        s(n)=t(n)
    Next
    ListWindow=CreateWindowEx(WS_EX_TOPMOST Or WS_EX_TOOLWINDOW,"windowclass","Choose from compiler list",_
    WS_VISIBLE Or (WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME),100,100,800,300,0,0,Hinst,0)
    Combobox=CreateWindowEx( null,_
    WC_COMBOBOX,_
    "ComboBox",_
    WS_VISIBLE Or WS_CHILD Or CBS_DROPDOWN Or WS_VSCROLL Or WS_HSCROLL,_
    10,10,770,200,ListWindow,Cast(HMENU,1),0,0)
    ok=CreateWindowEx(0,"Button","Apply",_
    WS_VISIBLE Or WS_CHILD,150,230,150,30,listwindow,0,0,0)
    For n As Long=Lbound(s)+1 To Ubound(s)
        SendMessage(Combobox,CB_ADDSTRING,0,Cast(LPARAM,@s(n)))
    Next
    Var g=loadfile(ld+"\list.txt",3)
    string_split(g,Chr(10),t())
    Redim Preserve t(0 To Ubound(t)-1)
    For n As Long=Lbound(t) To Ubound(t)
        s(n)=t(n)
    Next
    SendMessage(ComboBox, CB_SETCURSEL, -1+Val(s(0)),0)
    washandled=1
    SetWindowTheme(ListWindow," "," ")'  optional
    createtooltip(combobox,"Scroll to choose a compiler")
End Sub

Function getfiles(filetypes As String) As String
    Dim As zstring * 2048 SELFILE
    Dim As String MYFILTER
    myfilter=filetypes
    Dim As OpenFileName SomeFile
    With SomeFile
        .lStructSize = Sizeof(OpenFileName)
        .hInstance = null
        .lpstrFilter = Strptr(MYFILTER)
        .lpstrFile = @SELFILE
        .nMaxFile = 2048
        .nMaxFileTitle = 0
        .lpstrTitle =@"Open"
        .Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
        .hwndOwner=mainwindow
    End With
    GetOpenFileName(@SomeFile)
    Return *SomeFile.lpstrFile
End Function

Function loadfile(file As String,flag As Long=1) As String
    If flag=1 Then
        If Fileexists(ld+"\Buildoptions.txt")=0 Then savefile(ld+"\Buildoptions.txt","")
    End If
    If flag=0 Then
        If Fileexists(ld+"\CompilerPath.txt")=0 Then savefile(ld+"\CompilerPath.txt","")
    End If
    Var  f=Freefile
    If Fileexists(file)=0 Then Print file + "  not found":Exit Function
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
        text = String(Lof(f), 0)
        Get #f, , text
    End If
    Close #f
    Return text
End Function

Sub savefile(filename As String,p As String)
    Dim As Integer n
    n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename
    End If
End Sub

Function pre_pend(filename As String,txt As String) As String
    Dim As String s=loadfile(filename,3),tmp
    Redim As String g()
    string_split(s,Chr(10),g())
    g(1)=""
    For n As Long=2 To Ubound(g)
        tmp+=g(n)+Chr(10)
    Next
    savefile(filename,tmp)
    s=loadfile(filename,3)
    If Len(s) Then savefile(filename,txt+Chr(10)+s)
    Return filename
End Function

Function ap_pend(filename As String,txt As String) As String
    Dim As String s=loadfile(filename,3)
    If Len(s) Then savefile(filename,s+txt)
    Return filename
End Function

Function getclipboard() As String
    If IsClipboardFormatAvailable(CF_TEXT) = 0 Then Return "Error"
    If OpenClipboard(0) = 0 Then Return "Error"
    Function = *Cast(zstring Ptr,GetClipboardData(CF_TEXT))
    CloseClipboard()
End Function

Function CreateToolTip(X As hwnd,msg As String="") As hwnd
    Dim As hwnd  TT= CreateWindowEx(0,"ToolTips_Class32","",64,0,0,0,0,X,0,GetModuleHandle(0),0)
    SendMessage(TT, TTM_SETMAXTIPWIDTH, 0 , 280)
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_INITIAL ,40)
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_RESHOW  ,60)
    Dim bubble As TOOLINFO
    bubble.cbSize = Len(TOOLINFO)
    bubble.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
    bubble.uId = Cast(Uinteger,X)
    bubble.lpszText = Strptr(msg)
    SendMessage(TT, TTM_ADDTOOL, 0,Cast(LPARAM,@bubble))
    Return TT
End Function

Sub string_split(Byval s As String,chars As String,result() As String)
    Redim result(0)
    Dim As String var1,var2
    Dim As Long pst,LC=Len(chars)
    #macro split(stri)
    pst=Instr(stri,chars)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+LC)
    Else
        var1=stri
    End If
    If Len(var1) Then
        Redim Preserve result(1 To Ubound(result)+1)
        result(Ubound(result))=var1
    End If
    #endmacro
    Do
        split(s):s=var2
    Loop Until var2=""
End Sub

Function remove(Byval txt As String,Char As String,start As Long=0,Byref dups As String="") As String
    Var id = start
    For i As Long = start To Len(txt) - 1
        If txt[i]<>Asc(char) Then txt[id]=txt[i]:id+=1 Else dups=Chr(txt[i])
    Next
    Return Left(txt,id)
End Function

Sub cleanup Destructor
    Kill   cd+"/buildoptionsTEMP.exe"
    Kill   cd+"/BuildoptionsTEMP.bas"
    Kill   ld+"/Clipboard.txt"
    DeleteObject(hfont)
End Sub

End winmain

 
Last edited by dodicat on Oct 06, 2019 12:16, edited 5 times in total.
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Sep 29, 2019 18:06

@dodicat

IMHO, I think your GUI's are diabolical.Image

It could do with a serious spruce up but themed will help.

Quick Runner.rc

Code: Select all

#define IDR_VERSION 1
 
IDR_VERSION VERSIONINFO
FILEVERSION 1,0,0,0000
FILEOS VOS__WINDOWS32
FILETYPE VFT_APP
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "080904E4"
    BEGIN
      VALUE "FileDescription", "Quick run FreeBASIC code\0"
      VALUE "ProductName", "Quick Runner\0"
      VALUE "LegalCopyright", " \251 2019 dodicat\0"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x0809, 0x04E4
  END
END
 
1 24 "Theme.xml"


Theme.xml

Code: Select all

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
 
    <assemblyIdentity
        version="1.0.0.1"
        processorArchitecture="*"
        name="MyAppName.exe"
        type="win32"
    />
    <description>Optional MyDescription for MyAppName.exe</description>
 
    <asmv3:application>
        <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
        <dpiAware>true</dpiAware>
        </asmv3:windowsSettings>
    </asmv3:application>
 
    <!-- Compatibility section for Program Compatibility Assistant (PCA) -->
    <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
        <application>
            <!-- Windows Vista -->
            <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
            <!-- Windows 7 -->
            <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
            <!-- Windows 8 -->
            <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
            <!-- Windows 8.1 -->
            <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
            <!-- Windows 10 -->
            <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
        </application>
    </compatibility>
 
    <!-- Trustinfo section for User Account Control (UAC) -->
    <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
        <security>
            <requestedPrivileges>
                <!-- level   = "asInvoker"            -->
                <requestedExecutionLevel
                    level    = "asInvoker"
                    uiAccess = "false"
                />
            </requestedPrivileges>
        </security>
    </trustInfo>
 
    <!-- Dependency section -->
    <dependency>
        <dependentAssembly>
            <assemblyIdentity
                type="win32"
                name="Microsoft.Windows.Common-Controls"
                version="6.0.0.0"
                processorArchitecture="*"
                publicKeyToken="6595b64144ccf1df"
                language="*"
            />
        </dependentAssembly>
    </dependency>
 
</assembly>


However, WS_BORDER is far too busy for buttons when themed.

Result.

Image
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Sep 29, 2019 19:36

@dodicat

I hope you didn't take my comments badly.

I had the following as a bookmark but it got lost somehow but I found it again. It is a longish read but written by folk who know a thing or two about GUI design. It is reckoned to take about 37 minutes to read but it took me longer as I hovered on areas soaking it in.

User Interface Principles
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Quick run tool - Windows

Postby dodicat » Sep 29, 2019 20:02

No problem deltarho[].
I only used SetWindowTheme to get a blue top title bar, the white of win 10 isn't good here.
I included your .rc, I still get the same colours though, although in properties I get the various details.
I have also tested on XP, I see you start the manifest at Vista.
Also the windows are fixed with no frills (WS_EX_TOOLWINDOW).
This is so you can swing them about to your heart's content and use only a closing X, which is the only icon.
The main thing, does it work OK with your compilers?
I was toying with the idea of having a copy array so you can rename the compilers to suit (the combobox is editable of course).
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Sep 29, 2019 20:32

dodicat wrote:The main thing, does it work OK with your compilers?

I haven't tried it yet - have been busy. I will do.

With regard XP mainstream support ended on April 14, 2009 and extended support ended on April 8, 2014. I hope anyone still using that are not connecting to the internet with it. As far as I am concerned it is stone dead. Vista's extended support ended on April 11, 2017. Windows 8 is unsupported as of January 12, 2016. Windows 8.1 has extended support until January 10, 2023 with mainstream support ending on January 9, 2018.

XP Image
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Sep 29, 2019 23:11

dodicat wrote:The main thing, does it work OK with your compilers?

I found it hard work.

More to the point I found a copy of Buildoptions.txt in my compiler path as well as your main program path and the fbc.exe in my compiler path had been deleted. Ouch, that hurt. So, you need to do some further testing.
Might be handy for fbide users.

Blimey, XP and fbide in the same thread. It is like spending an afternoon at the British Museum.

Anyway, I use WinFBE with my SetCompilerPathsII and SetCompilerSwitches tools.

Take them for test drive - you will never look back. Image
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Quick run tool - Windows

Postby dodicat » Sep 29, 2019 23:57

Thanks for testing.
I have used fbide from day one of my fb.
I have tried all the others, or 99% of the others, and there are many.
But I find fbide still my favourite.
The only snag is of course the inability to use uppercase in switches, thus my little quick runner.
WinFBE is evolving I see, and good luck to the project and your participation in it.
But I'll get a fresh copy and give it a run.
buildoptions.txt, compilerpath.txt and list.txt are the three reference texts (normally in one .ini I suppose).
fbc.exe is only pointed to, I am amazed that it got deleted, how can that be I wonder?
I use a remove function but only to clear chr(34) from a string.
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Sep 30, 2019 10:10

@dodicat

Hold off from downloading WinFBE there should be some breaking news coming shortly and it will be right up your street; and many other folk I should imagine. Image
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Quick run tool - Windows

Postby dodicat » Oct 01, 2019 1:46

A little spruce up.

Code: Select all

#define WIN_INCLUDEALL
#Include Once "windows.bi"
#Include once "/win/commctrl.bi"
#include "file.bi"
#define nul chr(0)
Dim Shared As String req,comp
req="Basic (.bas) files"+NUL+"*.BAS"+NUL+"Include (.bi,.inc) files"+NUL+"*.INC;*.BI"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
comp="Choose (fbc) "+nul+"*.*"+nul+nul
Shell "title Compiler output"
Shell "color 4f"
Dim Shared As String fbpath,s1,cd,cpy,L,original,content,ld,rnr
Dim Shared As Long filechanged,cleanend,destroyed,washandled,useclipboard
Redim Shared As zstring * 1000 s(0 To 14) 'the compiler list
Dim Shared As HINSTANCE Hinst:hinst=GetModuleHandle(0)
ld=Curdir
destroyed=1

'procedures outwith winmain and winproc
Declare Sub string_split(Byval s As String,chars As String,result() As String)
Declare Function pre_pend(filename As String,txt As String) As String
Declare Function ap_pend(filename As String,txt As String) As String
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Declare Function getfiles(filetypes As String) As String
Declare Sub CreateMessageWindow
Declare Sub CreatecomboWindow()
Declare Function loadfile(file As String,flag As Long=1) As String
Declare Sub savefile(filename As String,p As String)
Declare Function getclipboard() As String
Declare Function CreateToolTip(X As hwnd,msg As String="") As hwnd
Declare Function remove(Byval txt As String,Char As String,start As Long=0,Byref dups As String="") As String

Dim Shared As zString * 500 textMessage=""  'switches e.g. -gen gas
textmessage=loadfile(ld+"\Buildoptions.txt") 'created if doesn't yet exist
Dim As String tmp
savefile(ld+"\Clipboard.txt","")
If Fileexists(ld+"\list.txt")=0 Then savefile(ld+"\list.txt","1000"+Chr(10))'created if doesn't yet exist
If Len(loadfile(ld+"\list.txt",3))<=5 Then savefile(ld+"\list.txt","1000"+Chr(10))'renew if required
Redim Shared As String t(Lbound(s) To Ubound(s))'string then to zstring
Var g=loadfile(ld+"\list.txt",3)
string_split(g,Chr(10),t())
Redim Preserve t(0 To Ubound(t)-1)
For n As Long=Lbound(t) To Ubound(t)
    s(n)=t(n) 'load list.txt into a zstring array for winapi
Next
fbpath=loadfile(ld+"\CompilerPath.txt",0)'created if doesn't yet exist
'global for winprocs
Dim Shared As hwnd  MainWindow, MessageWindow,btn,btn2,runbut,compiler
Dim Shared As hwnd EditBox, Button,msgon,label,minilabel,clabel,file,clipboard,OK
Dim Shared As hwnd fullcompile,fullrun,listcompilers ,combobox,deleter,listwindow
Dim Shared SomeFile As String'OpenFileName
Dim Shared As MSG uMsg
Dim Shared As hfont hfont

'Note files:
'files buildoptions.txt compilerpath.txt and list.txt and clipboard.txt are located in the
'same folder as this executable.
'clipboard.txt only exists while the program is running.

'The other temporary files for quick compile/run are located in the same folder as the source code to compile/run
'these other files are buildoptionsTEMP.bas and buildoptionsTEMP.exe.
'I have kept the silly names so they are easily spotted in case they don't delete properly (e.g. a power cut)

Function WndProc(hWnd As hwnd, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case hWnd
    Case MainWindow
        Select Case msg
       
        Case WM_PAINT 'hatch the mainwindow blue
            Dim As PAINTSTRUCT ps
            BeginPaint(hWnd, @ps)
            FillRect(ps.hdc, @ps.rcPaint,CreatehatchBrush(HS_DIAGCROSS,BGR(0,100,255)))
            EndPaint(hWnd, @ps)
           
        Case WM_CLOSE
            Kill   cd+"/buildoptionsTEMP.exe"
            Kill   cd+"/BuildoptionsTEMP.bas"
            Kill   ld+"/Clipboard.txt"
            If filechanged Then
                Var answer=messagebox(0,"Save all changes?",cpy,MB_YESNO Or MB_TOPMOST)
                If answer=IDYES Then:End If
                If answer=IDNO Then
                    savefile(original,content)
                End If
            End If
            cleanend=1
            PostQuitMessage(NULL)
           
        Case WM_COMMAND
            Select Case lParam
            Case msgon 'Build options
                If destroyed=1 Then
                    CreateMessageWindow
                    destroyed=0
                End If
               
            Case clipboard
                Kill   cd+"/buildoptionsTEMP.exe"
                Kill   cd+"/BuildoptionsTEMP.bas"
                useclipboard=1
                L=getclipboard
                savefile(ld+"\Clipboard.txt",L)
                cpy=ld+"\clipboard.txt"
                setwindowtext(file,"File" +Chr(13,10)+cpy)
                cd=Curdir
                Goto label
            Case btn 'open
                Kill   cd+"/buildoptionsTEMP.exe"
                Kill   cd+"/BuildoptionsTEMP.bas"
                'shell "start taskkill /F /IM notepad.exe"' > T.txt" '' no, self close notepad
                useclipboard=0
                filechanged=0
                somefile=getfiles(req)
                s1=SomeFile
                cpy=s1
                original=s1
                cd= Mid(somefile,1,Instrrev(somefile,"\")-1)
                setwindowtext(file,"File" +Chr(13,10)+cpy)
                L=loadfile(s1,3)
                content=L
                label:
                savefile(cd +"/BuildoptionsTEMP.bas",L)
                s1=cd+"/BuildoptionsTEMP.bas"
                ShellExecute (0,"","notepad.exe ",cpy,"",SW_SHOWNORMAL)
               
            Case btn2'quick compile
                If Len(s1) Then
                    textmessage=loadfile(ld+"\Buildoptions.txt",3)
                    s1=cd+"/BuildoptionsTEMP.bas"
                    Var tst1=loadfile(cpy,3)
                    Var tst2=loadfile(cd +"/BuildoptionsTEMP.bas",3)
                    If tst1<>tst2 And useclipboard=0 Then
                        filechanged=1
                        savefile(cd+"/BuildoptionsTEMP.bas",tst1)
                    End If
                    Dim As String tm="Command "+Chr(13,10)+fbpath+Chr(13,10)+s1+" "+textmessage
                    setwindowtext(clabel,tm)
                    Print
                    Print "compiling . . ."
                    fbpath=remove(fbpath,Chr(34))
                    Err= Exec (fbpath,Chr(32,34)+s1+Chr(34,32)+textmessage)
                    If Err<>0 Then Print "ERROR": Kill   cd+"/buildoptionsTEMP.exe"
                    Print
                    Exec(fbpath," -version")
                    Print loadfile(ld+"\Buildoptions.txt",3)
                Else
                    messagebox(0,"No file chosen","",MB_TOPMOST)
                End If
               
            Case fullcompile'compile
                if useclipboard then
                    messagebox(0,"Only Quick compile clipboard","", MB_TOPMOST)
                    goto cont2
                    end if
                Kill   cd+"/buildoptionsTEMP.exe" 'delete temp stuff
                If Len(s1) Then
                    textmessage=loadfile(ld+"\Buildoptions.txt",3)
                    s1=somefile
                    Var tst1=loadfile(cpy,3)
                    Var tst2=loadfile(Somefile,3)
                    If tst1<>tst2 And useclipboard=0 Then
                        filechanged=1
                        savefile(cd+"/BuildoptionsTEMP.bas",tst1)
                    End If
                    Dim As String tm="Command "+Chr(13,10)+fbpath+Chr(13,10)+s1+" "+textmessage
                    setwindowtext(clabel,tm)
                    Print
                    Print "compiling . . ."
                    fbpath=remove(fbpath,Chr(34))
                    Err= Exec (fbpath,Chr(32,34)+s1+Chr(34,32)+textmessage)
                    If Err<>0 Then
                        dim as long flag
                        Print "ERROR"
                        for n as long=lbound(s) to ubound(s)
    if remove(Mid(somefile,1,Instrrev(somefile,"."))+"exe",chr(34)) = remove(s(n),chr(34)) then flag=1
                        next
                      if flag=0 then  kill Mid(somefile,1,Instrrev(somefile,"."))+"exe"
                       
                    end if
                    Print
                    Exec (fbpath , " -version")
                    Print loadfile(ld+"\Buildoptions.txt",3)
                Else
                    messagebox(0,"No file chosen","", MB_TOPMOST)
                End If
                cont2:
            Case runbut 'quick run
                Dim As String tm
                If Fileexists(cd +"\buildoptionsTEMP.exe")=0 Then
                    messagebox(0,"Nothing to run yet","Message", MB_TOPMOST)
                    Goto fin4
                End If
                tm="Command "+Chr(13,10)+cd+"/buildoptionsTEMP.exe"
                setwindowtext(clabel,tm)
                If Fileexists (  cd+"/buildoptionsTEMP.exe")  Then
                    ShellExecute (0,"", cd+"/buildoptionsTEMP.exe","","",SW_SHOWNORMAL)
                End If
                fin4:
               
            Case fullrun 'run
                rnr=Mid(somefile,1,Instrrev(somefile,"."))+"exe"
                Dim As String tm="Command "+Chr(13,10)+rnr
                setwindowtext(clabel,tm)
                If Fileexists ( rnr)  Then
                    ShellExecute (0,"",rnr,"","",SW_SHOWNORMAL)
                Else
                    messagebox(0,"Nothing compiled","Message", MB_TOPMOST)     
                End If
               
            Case compiler'add compiler
               var somefile=getfiles(comp)  ''''''
               var s1=somefile
                If Instr(s1," ") Then s1=Chr(34)+s1+Chr(34)
                Redim As String tmp()
                Var g=loadfile(ld+"\list.txt")
                string_split(g,Chr(10),tmp())
                If Ubound(tmp)>12 Then
                    messagebox(0,"Delete some compilers from the list","You have exceeded the maximum number of compilers",MB_TOPMOST)
                    Goto cont
                End If
                If Instr(Lcase(s1),"fbc.exe")=0 Then
                    messagebox(0,"fbc.exe is expected, but carry on anyway","REMINDER",MB_TOPMOST)
                End If
                ap_pend(ld+"\list.txt",s1+Chr(10))
                cont:
               
            Case listcompilers 'select a compiler
                If washandled =0 Then
                    CreatecomboWindow()
                    Var g=loadfile(ld+"\list.txt",3)
                    string_split(g,Chr(10),t())
                    Redim Preserve t(0 To Ubound(t)-1)
                    For n As Long=Lbound(t) To Ubound(t)
                        s(n)=t(n)
                    Next
                    washandled=1
                End If
               
            Case deleter  'edit / delete compilers via notepad
                ShellExecute (0,"edit",ld+"\list.txt","","",SW_SHOWNORMAL)
               
            End Select 'lparam
           
        End Select  'msg  of hwnd   
       
    Case ListWindow 'combobox window(free window)
        Select Case msg
       
        Case WM_COMMAND 'process combobox value (must be via WM_COMMAND)
            If(Hiword(wParam) = CBN_SELCHANGE) Then
                Var ItemIndex = SendMessage(Cast(Any Ptr,lParam), CB_GETCURSEL, 0,0)+1
                pre_pend(ld+"\list.txt",Str(itemIndex))
                Var g=loadfile(ld+"\list.txt",3)
                string_split(g,Chr(10),t())
                Redim Preserve t(0 To Ubound(t)-1)
                For n As Long=Lbound(t) To Ubound(t)
                    s(n)=t(n)
                Next
            End If
           
            Select Case lParam 'of msg/listwindow
           
            Case OK 'apply button
                destroywindow(Listwindow)
                washandled=0
                If Val(s(0))=1000 Then
                    messagebox(0,"Add a compiler","You have no compilers chosen ", MB_TOPMOST)
                    Goto cont1
                End If
                savefile(ld+"/CompilerPath.txt",s(Val(s(0))))
                fbpath=loadfile(ld +"/CompilerPath.txt",3)
                setwindowtext(label, fbpath)
                cont1:
            End Select 'lparam of msg/listwindow
           
        Case WM_CLOSE
            destroywindow(Listwindow)
            washandled=0
            If Val(s(0))=1000 Then
                messagebox(0,"Add a compiler","You have no compilers chosen ", MB_TOPMOST)
                Goto cont3
            End If
            savefile(ld+"/CompilerPath.txt",s(Val(s(0))))
            fbpath=loadfile(ld +"/CompilerPath.txt",3)
            setwindowtext(label, fbpath)
            washandled=0
            cont3:
        End Select 'msg/listwindow
       
    Case MessageWindow  'build options window (free window)
        Select Case msg
        Case WM_COMMAND
            Select Case lParam
            Case Button   
                GetWindowText(EditBox, @textMessage, 255)
                savefile(ld+"\buildoptions.txt",textmessage)
                destroywindow(messagewindow)
                destroyed=1
            End Select
        Case WM_CLOSE
            destroyed=1
        End Select 'msg/messagewindow
       
    End Select 'hwnd
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Function winmain As Long
    Dim As WNDCLASS wcls
    With wcls
        .style      = CS_HREDRAW Or CS_VREDRAW Or CS_DROPSHADOW '
        .lpfnWndProc  = Cast(WNDPROC, @WndProc)
        .hInstance    = GetModuleHandle(NULL)
        .hIcon      = LoadIcon(NULL, IDI_APPLICATION)
        .hCursor      = LoadCursor(NULL, IDC_ARROW)
        .hbrBackground  = GetStockObject(WHITE_BRUSH)
        .lpszMenuName  = NULL
        .lpszClassName  = Strptr("WindowClass")
    End With
    If RegisterClass(@wcls) = FALSE Then
        MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
        End
    End If
   
    'set the windows
    'un-resizable windows with bare title bar
    MainWindow = CreateWindowEx( WS_EX_TOPMOST Or WS_EX_TOOLWINDOW  , "WindowClass", "Quick runner -->  Quick compile  then  Quick run     (End program by closing window) --->", (WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME) Or WS_VISIBLE , 100, 100, 630, 500, NULL, NULL, NULL, NULL)
    msgon= CreateWindowEx(WS_EX_CLIENTEDGE, "Button", "Build options", WS_VISIBLE Or WS_CHILD , 10, 50,100, 30, MainWindow, NULL, NULL, NULL)
    btn=CreateWindowEx( WS_EX_CLIENTEDGE,"BUTTON","Open file", WS_VISIBLE Or WS_CHILD ,150,50,100,30,  MainWindow,0,0,0)
    btn2  =createwindowex(WS_EX_CLIENTEDGE,"BUTTON","Quick Compile"  ,ws_border Or WS_VISIBLE Or WS_CHILD,280,50,120,30,MainWindow,0,0,0)
    runbut=createwindowex(WS_EX_CLIENTEDGE,"BUTTON","Quick Run"  ,WS_VISIBLE Or WS_CHILD,430,50,120,30,MainWindow,0,0,0)
    fullcompile=createwindowex(WS_EX_CLIENTEDGE,"BUTTON","Compile"  ,WS_VISIBLE Or WS_CHILD,280,100,120,30,MainWindow,0,0,0)
    fullrun=createwindowex(WS_EX_CLIENTEDGE,"BUTTON","Run"  ,WS_VISIBLE Or WS_CHILD,430,100,120,30,MainWindow,0,0,0)
    clipboard=CreateWindowEx( WS_EX_CLIENTEDGE,"BUTTON","Get clipboard",WS_VISIBLE Or WS_CHILD ,110,150,120,30,  MainWindow,0,0,0)
    compiler=createwindowex(WS_EX_CLIENTEDGE,"BUTTON","Add Compiler"  ,WS_VISIBLE Or WS_CHILD,230,150,120,30,MainWindow,0,0,0)
    listcompilers =createwindowex(WS_EX_CLIENTEDGE,"BUTTON","Select Compiler",WS_VISIBLE Or WS_CHILD,350,150,120,30,MainWindow,0,0,0)
    deleter=createwindowex(WS_EX_CLIENTEDGE,"BUTTON","Edit compilers",WS_VISIBLE Or WS_CHILD,470,150,120,30,MainWindow,0,0,0)
    label=createwindowex(0,"static",fbpath ,ws_border Or  WS_VISIBLE Or WS_CHILD or SS_EDITCONTROL,10,200,600,60,MainWindow,0,0,0)
    minilabel=Createwindowex(0,"STATIC","Compiler:"  ,ws_border Or WS_VISIBLE Or WS_CHILD,10,170,80,30,MainWindow,0,0,0)
    clabel=createwindowex(0,"STATIC","Command " ,WS_BORDER Or WS_VISIBLE Or WS_CHILD or SS_EDITCONTROL,10,280,600,90,MainWindow,0,0,0)
    file=createwindowex(0,"STATIC","File" ,WS_Border Or  WS_VISIBLE Or WS_CHILD or SS_EDITCONTROL,10,380,600,60,MainWindow,0,0,0)
    SetWindowTheme(mainwindow," "," ")
    'handle fonts
    Dim As logfont lf
    memset(@lf, 0, Sizeof(logFont))
    lf.lfHeight = -15
    lf.lfWeight = FW_BOLD
    lf.lfFaceName="cambria"
    lf.lfitalic=1
    hFont = CreateFontIndirect(@lf)
   
    Dim As Any Ptr Ptr g(...)={@msgon,@btn,@btn2,@runbut,@fullcompile,@fullrun,@clipboard, _
    @compiler,@listcompilers,@deleter,@label,@minilabel,@clabel,@file}
   
    For n As Long=0 To Ubound(g)
        SendMessage(*g(n), WM_SETFONT, Cast(WPARAM, hFont), TRUE)
    Next
    While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
        TranslateMessage(@uMsg)
        DispatchMessage(@uMsg)
    Wend
    Return 0
End Function

' two seperate windows
Sub CreateMessageWindow 'for setting compiler options
    MessageWindow = CreateWindowEx(WS_EX_TOPMOST Or WS_EX_TOOLWINDOW, "WindowClass", "Options", (WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME) Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 300, 150, NULL, NULL, NULL, NULL)
    EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD Or WS_HSCROLL  Or ES_AUTOHSCROLL Or ES_MULTILINE, 10, 0, 250, 50, MessageWindow, NULL, NULL, NULL)
    Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
    SetWindowTheme(messagewindow," "," ")'  optional
    createtooltip(EditBox,"example: -gen gcc -Wc -O3")
End Sub

Sub CreatecomboWindow()'for a list of compilers
    Var g2=loadfile(ld+"\list.txt",3)
    string_split(g2,Chr(10),t())
    Redim Preserve t(0 To Ubound(t)-1)
    For n As Long=Lbound(s) To Ubound(s)
        s(n)=""
    Next
    For n As Long=Lbound(t) To Ubound(t)
        s(n)=t(n)
    Next
    ListWindow=CreateWindowEx(WS_EX_TOPMOST Or WS_EX_TOOLWINDOW,"windowclass","Choose from compiler list",_
    WS_VISIBLE Or (WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME),100,100,800,300,0,0,Hinst,0)
    Combobox=CreateWindowEx( null,_
    WC_COMBOBOX,_
    "ComboBox",_
    WS_VISIBLE Or WS_CHILD Or CBS_DROPDOWN Or WS_VSCROLL Or WS_HSCROLL,_
    10,10,770,200,ListWindow,Cast(HMENU,1),0,0)
    ok=CreateWindowEx(0,"Button","Apply",_
    WS_VISIBLE Or WS_CHILD,150,230,150,30,listwindow,0,0,0)
    For n As Long=Lbound(s)+1 To Ubound(s)
        SendMessage(Combobox,CB_ADDSTRING,0,Cast(LPARAM,@s(n)))
    Next
    Var g=loadfile(ld+"\list.txt",3)
    string_split(g,Chr(10),t())
    Redim Preserve t(0 To Ubound(t)-1)
    For n As Long=Lbound(t) To Ubound(t)
        s(n)=t(n)
    Next
    SendMessage(ComboBox, CB_SETCURSEL, -1+Val(s(0)),0)
    washandled=1
    SetWindowTheme(ListWindow," "," ")'  optional
    createtooltip(combobox,"Scroll to choose a compiler")
End Sub

Function getfiles(filetypes As String) As String
    Dim As zstring * 2048 SELFILE
    Dim As String MYFILTER
    myfilter=filetypes
    Dim As OpenFileName SomeFile
    With SomeFile
        .lStructSize = Sizeof(OpenFileName)
        .hInstance = null
        .lpstrFilter = Strptr(MYFILTER)
        .lpstrFile = @SELFILE
        .nMaxFile = 2048
        .nMaxFileTitle = 0
        .lpstrTitle =@"Open"
        .Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
        .hwndOwner=mainwindow
    End With
    GetOpenFileName(@SomeFile)
    Return *SomeFile.lpstrFile
End Function

Function loadfile(file As String,flag As Long=1) As String
    If flag=1 Then
        If Fileexists(ld+"\Buildoptions.txt")=0 Then savefile(ld+"\Buildoptions.txt","")
    End If
    If flag=0 Then
        If Fileexists(ld+"\CompilerPath.txt")=0 Then savefile(ld+"\CompilerPath.txt","")
    End If
    Var  f=Freefile
    If Fileexists(file)=0 Then Print file + "  not found":Exit Function
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
        text = String(Lof(f), 0)
        Get #f, , text
    End If
    Close #f
    Return text
End Function

Sub savefile(filename As String,p As String)
    Dim As Integer n
    n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename
    End If
End Sub

Function pre_pend(filename As String,txt As String) As String
    Dim As String s=loadfile(filename,3),tmp
    Redim As String g()
    string_split(s,Chr(10),g())
    g(1)=""
    For n As Long=2 To Ubound(g)
        tmp+=g(n)+Chr(10)
    Next
    savefile(filename,tmp)
    s=loadfile(filename,3)
    If Len(s) Then savefile(filename,txt+Chr(10)+s)
    Return filename
End Function

Function ap_pend(filename As String,txt As String) As String
    Dim As String s=loadfile(filename,3)
    If Len(s) Then savefile(filename,s+txt)
    Return filename
End Function

Function getclipboard() As String
    If IsClipboardFormatAvailable(CF_TEXT) = 0 Then Return "Error"
    If OpenClipboard(0) = 0 Then Return "Error"
    Function = *Cast(zstring Ptr,GetClipboardData(CF_TEXT))
    CloseClipboard()
End Function

Function CreateToolTip(X As hwnd,msg As String="") As hwnd
    Dim As hwnd  TT= CreateWindowEx(0,"ToolTips_Class32","",64,0,0,0,0,X,0,GetModuleHandle(0),0)
    SendMessage(TT, TTM_SETMAXTIPWIDTH, 0 , 280)
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_INITIAL ,40)
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_RESHOW  ,60)
    Dim bubble As TOOLINFO
    bubble.cbSize = Len(TOOLINFO)
    bubble.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
    bubble.uId = Cast(Uinteger,X)
    bubble.lpszText = Strptr(msg)
    SendMessage(TT, TTM_ADDTOOL, 0,Cast(LPARAM,@bubble))
    Return TT
End Function

Sub string_split(Byval s As String,chars As String,result() As String)
    Redim result(0)
    Dim As String var1,var2
    Dim As Long pst,LC=Len(chars)
    #macro split(stri)
    pst=Instr(stri,chars)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+LC)
    Else
        var1=stri
    End If
    If Len(var1) Then
        Redim Preserve result(1 To Ubound(result)+1)
        result(Ubound(result))=var1
    End If
    #endmacro
    Do
        split(s):s=var2
    Loop Until var2=""
End Sub

Function remove(Byval txt As String,Char As String,start As Long=0,Byref dups As String="") As String
    Var id = start
    For i As Long = start To Len(txt) - 1
        If txt[i]<>Asc(char) Then txt[id]=txt[i]:id+=1 Else dups=Chr(txt[i])
    Next
    Return Left(txt,id)
End Function

Sub cleanup Destructor
    Kill   cd+"/buildoptionsTEMP.exe"
    Kill   cd+"/BuildoptionsTEMP.bas"
    Kill   ld+"/Clipboard.txt"
    DeleteObject(hfont)
End Sub

End winmain



 
 
Last edited by dodicat on Oct 04, 2019 0:00, edited 4 times in total.
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Oct 01, 2019 10:16

@dodicat

Now is a good time to download WinFBE. However, a little bit of work is required so go here.
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Oct 02, 2019 22:01

dodicat wrote:A little spruce up.

I have been busy but found time to have a look.

Your little spruce up now qualifies as the worst GUI that I have ever seen. I should imagine that a few think that but, sadly, I am probably the only one who will say so. I hope that you know me well enough to know that I am not being spitefully critical.

Using italics now sees the 'Select Compiler' text almost being crushed to death by its border. Italics? Image

I posted a link above: 'User Interface Principles'.

Before embarking on another GUI please read it.

After you have digested that not only will you be a great coder but also a great GUI designer as well. Image
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Oct 03, 2019 20:00

@dodicat

Just to let you know that I have compiled and run Encrypternet successfully.

The build option was

Code: Select all

-s gui -gen gcc -Wc -O2 "Encrypternet.rc"

I had to use the rc file because that in turn loads a manifest without which I cannot access TaskDialog. With WinFBE we can include this as the first line of the source code.

Code: Select all

'#Resource "Encrypternet.rc"

The compiler used was

Code: Select all

F:\WinFBE_Suite_1.94\FreeBASIC-1.07.1-gcc-8.3\fbc64.exe

That is 64-bit gcc 8.3.

I would still like to see the buttons better arranged but, I guess, if I used this regularly I would get used to it, like most things.

The bad news is that fbc64.exe got 'wiped out'. Fortunately, I have backups. I don't have time to check but you may want to look at 'if flag=0 then kill Mid(somefile,1,Instrrev(somefile,"."))+"exe" ' which seems to be the only candidate.
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Quick run tool - Windows

Postby dodicat » Oct 04, 2019 0:19

Thanks deltarho[]
I have fixed that awful bug.
I was using the global string somestring for a compiler and a file, stupid mistake.
I tried out the winFBE_suite compilers.
I note that the WinFBE_Suite\FreeBASIC-1.07.1-gcc-5.2\bin\win32\gcc.exe" doesn't exist, (no gcc.exe).

A static window flagged with WS_VISIBLE Or WS_CHILD or SS_NOTIFY works just like a button with no border shown.
if I could get a mouse hover to change the colour, I might put all the boxes along the top of a window.
But just now I have only changed the type of font a bit, but still kept the italic mode.
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Oct 04, 2019 2:07

Yours truly wrote:I thought that I had checked everything - 5.2 32-bit is still wrong.

gcc.exe was in '\bin\libexec\gcc\*.*' and it should be in' \bin\win32\*.*'.

I mentioned that in the main WinFBE thread.

Paul will fix that in the next release.
I might put all the boxes along the top of a window.

Or use a menu?
deltarho[1859]
Posts: 2093
Joined: Jan 02, 2017 0:34
Location: UK

Re: Quick run tool - Windows

Postby deltarho[1859] » Oct 04, 2019 2:41

To get the best out of WinFBE (1.94) you'll need to look at the tutorial here.

You will also need the updates for the additional toolchains here. My current advice is to download only 8.3, in which case SetCompilerPathsII.ini, in the Tools folder, will need the 9.2 line removing. Put 'FreeBASIC-1.07.1-gcc-8.3' next to 'FreeBASIC-1.07.1-gcc-5.2'.

Bit of a 'carry on' but it is worth it, you won't be using FBIde any more. Image

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest