Here is a windows quickrunner.
Compile to .exe.
click the .exe.
Find your compiler via select compiler.
For the dislin examples get a 32 bit fb compiler.
press compile then run (the compile run is in effect a quick run mode).
You can set some optimisations in the build options.
Code: Select all
'quickrunner.bas
#define WIN_INCLUDEALL
#Include Once "windows.bi"
#Include once "/win/commctrl.bi"
#include "file.bi"
shell "title Compiler output"
'shell "color f0"
Dim Shared As String fbpath,s1,cd,cpy,L,original,content
dim shared as long filechanged,cleanend
cd=Curdir
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Declare Sub getfiles(Byref SomeFile As OpenFileName,msg As String,flag As String)
Declare Sub CreateMessageWindow
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
' Globals (unavoidable)
Dim Shared As HFONT guiFont
Dim Shared As zString * 255 textMessage=""
textmessage=loadfile("Buildoptions.txt")
Dim As String tmp
savefile(cd+"\Clipboard.txt","")
fbpath=loadfile("CompilerPath.txt",0)
Dim Shared As Long flag
Dim Shared As HWND MainWindow, MessageWindow,btn,btn2,runbut,compiler
Dim Shared As HWND EditBox, Button,msgon,label,bar2,label2,minilabel,clabel,file,clipboard
Dim Shared As Long trackpos
Dim Shared SomeFile As OpenFileName
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
Dim As PAINTSTRUCT ps
BeginPaint(hWnd, @ps)
FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(BGR(100,100,255)))
EndPaint(hWnd, @ps)
Case WM_CLOSE
Kill cd+"/buildoptionsTEMP.exe"
Kill cd+"/BuildoptionsTEMP.bas"
Kill cd+"/Clipboard.txt"
if filechanged then
var answer=messagebox(0,"Has changed,save?",cpy,MB_YESNO)
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
CreateMessageWindow
Case clipboard
L=getclipboard
savefile("Clipboard.txt",L)
cpy="clipboard.txt"
setwindowtext(file,"File" +Chr(13,10)+cpy)
Goto label
Case btn 'open
filechanged=0
getfiles(SomeFile, "FreeBASIC Files","*.bas")
s1=*SomeFile.lpstrFile
cpy=s1
original=s1
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'compile
If Len(s1) Then
textmessage=loadfile(cd+"\Buildoptions.txt",3)
s1=" "+cd+"/BuildoptionsTEMP.bas"
s1+=" "+textmessage+" "
var tst1=loadfile(cpy,3)
var tst2=loadfile(cd +"/BuildoptionsTEMP.bas",3)
if tst1<>tst2 then
filechanged=1
savefile(cd+"/BuildoptionsTEMP.bas",tst1)
end if
Dim As String tm="Command "+Chr(13,10)+fbpath+Chr(13,10)+s1
setwindowtext(clabel,tm)
Shell fbpath+s1
Else
messagebox(0,"No file chosen","",0)
End If
Case runbut
Dim As String 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
Case compiler'select a compiler
getfiles(SomeFile, "Fbc.exe","fbc*.exe")
s1=*SomeFile.lpstrFile
if instr(s1," ") then s1=chr(34)+s1+chr(34) '''''''''''''''
savefile(cd+"/CompilerPath.txt",s1)
fbpath=loadfile(cd +"/CompilerPath.txt",3)
setwindowtext(label, fbpath)
End Select
End Select
Case MessageWindow
Select Case msg
Case WM_COMMAND
Select Case lParam
Case Button
GetWindowText(EditBox, @textMessage, 255)
flag=0
savefile(cd+"\buildoptions.txt",textmessage)
destroywindow(messagewindow)
End Select
Case WM_CLOSE
flag=0
End Select
End Select
Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function
' Create window class:
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
MainWindow = CreateWindowEx(NULL, "WindowClass", "Flag setter", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 650, 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", ws_border Or WS_VISIBLE Or WS_CHILD ,150,50,100,30, MainWindow,0,0,0)
btn2 =createwindowex(0,"BUTTON","Compile" ,ws_border Or WS_VISIBLE Or WS_CHILD,280,50,120,30,MainWindow,0,0,0)
runbut=createwindowex(0,"BUTTON","Run" ,ws_border Or WS_VISIBLE Or WS_CHILD,430,50,120,30,MainWindow,0,0,0)
compiler=createwindowex(0,"BUTTON","Select Compiler" ,ws_border Or WS_VISIBLE Or WS_CHILD,230,150,120,30,MainWindow,0,0,0)
label=createwindowex(0,"STATIC",fbpath , WS_VISIBLE Or WS_CHILD,0,200,600,60,MainWindow,0,0,0)
minilabel=Createwindowex(0,"STATIC","Compiler:" ,WS_VISIBLE Or WS_CHILD,0,170,100,30,MainWindow,0,0,0)
clabel=createwindowex(0,"STATIC","Command " , WS_VISIBLE Or WS_CHILD,0,280,600,80,MainWindow,0,0,0)
file=createwindowex(0,"STATIC","File" , WS_VISIBLE Or WS_CHILD,0,380,600,60,MainWindow,0,0,0)
clipboard=CreateWindowEx( 0,"BUTTON","Clipboard", ws_border Or WS_VISIBLE Or WS_CHILD ,150,100,100,30, MainWindow,0,0,0)
SetWindowTheme(mainwindow," "," ")
Sub CreateMessageWindow
If flag=0 Then
flag=1
MessageWindow = CreateWindowEx(NULL, "WindowClass", "Options", WS_OVERLAPPEDWINDOW 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,"-gen gcc -Wc -O3")
End If
End Sub
Sub getfiles(Byref SomeFile As OpenFileName,msg As String,flag As String)
Dim As zstring * 2048 SELFILE
Dim As String MYFILTER
MYFILTER = msg+Chr(0)+flag+Chr(0)
With SomeFile
.lStructSize = Sizeof(OpenFileName)
.hInstance = null
.lpstrFilter = Strptr(MYFILTER)
.lpstrFile = @SELFILE
.nMaxFile = 2048
.nMaxFileTitle = 0
.lpstrTitle =@"Open"
End With
GetOpenFileName(@SomeFile)
End Sub
Function loadfile(file As String,flag As Long=1) As String
If flag=1 Then
If Fileexists("Buildoptions.txt")=0 Then savefile("Buildoptions.txt","")
End If
If flag=0 Then
If Fileexists("CompilerPath.txt")=0 Then savefile("CompilerPath.txt","")
End If
Var f=Freefile
Open file For Binary Access Read As #f
Dim As String text
If Lof(1) > 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 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)
'64=bubble,0 = rectangle
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 cleanup Destructor
Kill cd+"/buildoptionsTEMP.exe"
Kill cd+"/BuildoptionsTEMP.bas"
Kill cd+"/Clipboard.txt"
End Sub
Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
TranslateMessage(@uMsg)
DispatchMessage(@uMsg)
Wend