Keep this file in it's own folder, there are four .txt files written.
It can be compiled to .exe by either 32 or 64 bits, use the .exe to use the tool.
Some users have an assortment of fb compilers.
Add some of your favourites and select one from your list.
Mainly quick compile then quick run, but compile and run are available.
Your chosen code is shown in notepad, which can be edited and saved.
You can use the build options, e.g. -Wc -O3 from a list (set up by you) to quickly test out your code.
But since fb 1.09.0 options can be put into the code via #cmdline "options"
Handy for testing out gas64.
Handy for testing out the new builds.
Can also be used for freepascal .pas files.
Will keep the console open to see any runtime errors.
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,.pas) files"+NUL+"*.pas;*.BI"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
comp="Choose (fbc) "+nul+"*.*"+nul+nul
Shell "title Compiler output:"
Shell "color f1" '4f
Var sysMenu = GetSystemMenu(getconsolewindow(), False)
DeleteMenu(sysMenu, SC_CLOSE, MF_BYCOMMAND)
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
Redim Shared As zstring * 1000 b(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 Sub CreatecomboWindowforbuild()
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 Fileexists(ld+"\buildlist.txt")=0 Then savefile(ld+"\buildlist.txt","1 (Please do not edit this line)"+Chr(10)+"-s console"+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
If Len(loadfile(ld+"\buildlist.txt",3))<=5 Then savefile(ld+"\buildlist.txt","1000"+Chr(10))'renew if required
Redim Shared As String t(Lbound(s) To Ubound(s))'string then to zstring
Redim Shared As String bt(Lbound(b) To Ubound(b))'string then to zstring for buildoptions
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
Redim Preserve bt(0 To Ubound(bt)-1)
For n As Long=Lbound(bt) To Ubound(bt)
b(n)=bt(n) 'load list.txt into a zstring array for winapi for buildoptions
Next
fbpath=loadfile(ld+"\CompilerPath.txt",0)'created if doesn't yet exist
'global for winprocs
Dim Shared As hwnd MainWindow,btn,btn2,runbut,compiler
Dim Shared As hwnd msgon,label,clabel,file,clipboard,OK,buildok,buildlabel
Dim Shared As hwnd fullcompile,fullrun,listcompilers ,combobox,buildcombobox,deleter,listwindow,buildlistwindow,editbuilds
Dim Shared SomeFile As String'OpenFileName
Dim Shared As MSG uMsg
Dim Shared As hfont hfont
Dim Shared As Ulong Ptr UP
Dim Shared As BITMAPINFOHEADER bi = Type(Sizeof(BITMAPINFOHEADER),920,-420,1,32,0,0,0,0,0,0)
Var consoleWindow = GetConsoleWindow()
SetWindowPos(consoleWindow,0,100,100,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)
Sub BackGround()
Dim As Long x, y, k, cx, cy
For y = 1 To 420
cy = (256/(420)*y)
For x = 1 To 920
cx = (256/(920)*x)
*(UP + k) = Rgb(128, cy, cx)
k+=1
Next
Next
End Sub
Function WndProc(hWnd As hwnd, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
Static As HDC bufDIBDC
Static As HBITMAP hMainDIB
Dim As HDC hdc
Dim As PAINTSTRUCT ps
Static As HGDIOBJ hOldDIB=0, hGDITmp
Dim As Integer bResult
Select Case msg
Case WM_CREATE'
'920,420
hdc = GetDC(hwnd)
bufDIBDC = CreateCompatibleDC (hdc)
hMainDIB = CreateDIBSection(hdc,Cast(Any Ptr, @bi), DIB_RGB_COLORS, @UP, NULL, 0)
hOldDIB = SelectObject (bufDIBDC, hMainDIB)
ReleaseDC (hWnd, hdc)
BackGround()
Case WM_PAINT
hdc = BeginPaint(hwnd, @ps)
bResult = BitBlt(hdc, 0, 0, 920, 420, bufDIBDC, 0, 0, SRCCOPY)
EndPaint(hwnd, @ps)
End Select
Select Case hWnd
Case MainWindow
Select Case msg
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
createcombowindowforbuild
Var g=loadfile(ld+"\buildlist.txt",3)
string_split(g,Chr(10),bt())
Redim Preserve bt(0 To Ubound(bt)-1)
For n As Long=Lbound(bt) To Ubound(bt)
b(n)=bt(n)
Next
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
Color 15,4
Print "ERROR": Kill cd+"/buildoptionsTEMP.exe"': setwindowtext(clabel,"Command")
Color 1,15
Else
Print "Success (";Timer-t;" seconds)"
End If
Print
If Instr(Lcase(fbpath),"fbc") Then 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
Color 15,4
Print "ERROR"
Color 1,15
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"
Else
Print "Success (";Timer-t;" seconds)"
End If
Print
If Instr(Lcase(fbpath),"fbc") Then 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
Shell "start cmd /k "+ cd+"\buildoptionsTEMP.exe"
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
Shell "start cmd /k "+rnr
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 buildlistwindow
Select Case msg
Case WM_COMMAND 'process combobox value (must be via WM_COMMAND)
If(Hiword(wParam) = CBN_SELCHANGE) Then
Var ItemIndex = SendMessage(buildcombobox, CB_GETCURSEL, 0,0)+1
pre_pend(ld+"\buildlist.txt",Str(itemIndex)+ " (Please do not edit this line)")
Var g=loadfile(ld+"\buildlist.txt",3)
string_split(g,Chr(10),bt())
Redim Preserve bt(0 To Ubound(bt)-1)
For n As Long=Lbound(bt) To Ubound(bt)
b(n)=bt(n)
Next
End If
Select Case lParam 'of msg/buildlistwindow
Case editbuilds
ShellExecute (0,"edit",ld+"\buildlist.txt","","",SW_SHOWNORMAL)
Case buildOK 'apply button
Dim As String k
destroywindow(buildListwindow)
washandled=0
' If Val(b(0))=1000 Then
' messagebox(0,"","You have no compiler options chosen ", MB_TOPMOST)
' Goto cont1
' End If
savefile(ld+"/buildoptions.txt",b(Val(b(0))))
k=loadfile(ld+"/buildoptions.txt")
setwindowtext(buildlabel,"Options :" +k +Chr(13,10))
cont1:
End Select 'lparam of msg/buildlistwindow
Case WM_CLOSE
Dim As String k
destroywindow(buildListwindow)
washandled=0
If Val(s(0))=1000 Then
messagebox(0,"","You have no compilers options chosen ", MB_TOPMOST)
Goto cont3
End If
savefile(ld+"/buildoptions.txt",b(Val(b(0))))
k=loadfile(ld+"/buildoptions.txt")
setwindowtext(buildlabel,"Options :" +k +Chr(13,10))
washandled=0
cont3:
End Select 'msg/buildlistwindow
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(combobox, 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 cont4
End If
savefile(ld+"/CompilerPath.txt",s(Val(s(0))))
fbpath=loadfile(ld +"/CompilerPath.txt",3)
setwindowtext(label,"Compiler "+Chr(13,10)+fbpath)'
cont4:
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 cont5
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
cont5:
End Select 'msg/listwindow
End Select 'hwnd
'#endmacro
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_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, 420, NULL, NULL, NULL, NULL)
' 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, 420, 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)
buildlabel=createwindowex(0,"STATIC","Options :"+textmessage ,WS_VISIBLE Or WS_CHILD Or SS_EDITCONTROL,10,380-70,900,60,MainWindow,0,0,0)
SetWindowTheme(mainwindow," "," ")
createtooltip(msgon,"Note: since fb 1.09 options can be in the code")
'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
SendMessage(buildlabel, WM_SETFONT, Cast(WPARAM, hFont), TRUE)
While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
TranslateMessage(@uMsg)
DispatchMessage(@uMsg)
Wend
Return 0
End Function
Sub createcombowindowforbuild
Var g2=loadfile(ld+"\buildlist.txt",3)
string_split(g2,Chr(10),bt())
Redim Preserve bt(0 To Ubound(bt)-1)
For n As Long=Lbound(b) To Ubound(b)
b(n)=""
Next
For n As Long=Lbound(bt) To Ubound(bt)
b(n)=bt(n)
Next
buildListWindow=CreateWindowEx(WS_EX_TOPMOST Or WS_EX_TOOLWINDOW,"windowclass","Choose from 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)
buildCombobox=CreateWindowEx( null,_
WC_COMBOBOX,_
"ComboBox",_
WS_VISIBLE Or WS_CHILD Or CBS_DROPDOWN Or WS_VSCROLL Or WS_HSCROLL,_
10,10,770,200,buildListWindow,Cast(HMENU,1),0,0)
buildok=CreateWindowEx(0,"Button","Apply",_
WS_VISIBLE Or WS_CHILD,150,230,150,30,buildlistwindow,0,0,0)
editbuilds=CreateWindowEx(0,"Button","Edit",_
WS_VISIBLE Or WS_CHILD,400,230,150,30,buildlistwindow,0,0,0)
SendMessage(editbuilds, WM_SETFONT, Cast(WPARAM, hFont), TRUE)
For n As Long=Lbound(b)+1 To Ubound(b)
SendMessage(buildCombobox,CB_ADDSTRING,0,Cast(LPARAM,@b(n)))
Next
SendMessage(combobox, WM_SETFONT, Cast(WPARAM, hFont), TRUE)
SendMessage(buildok, WM_SETFONT, Cast(WPARAM, hFont), TRUE)
Var g=loadfile(ld+"\buildlist.txt",3)
string_split(g,Chr(10),bt())
Redim Preserve bt(0 To Ubound(bt)-1)
For n As Long=Lbound(bt) To Ubound(bt)
b(n)=bt(n)
Next
SendMessage(buildComboBox, CB_SETCURSEL, -1+Val(b(0)),0)
washandled=1
SetWindowTheme(buildListWindow," "," ")' optional
createtooltip(buildcombobox,"Scroll to choose a command line")
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
SendMessage(combobox, WM_SETFONT, Cast(WPARAM, hFont), TRUE)
SendMessage(ok, WM_SETFONT, Cast(WPARAM, hFont), TRUE)
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