1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2024-05-12 06:50:12 +00:00

Merge pull request #7 from GeorgeMcGinn/development

Update InForm to Install/Run on either QB64 or QB64pe
This commit is contained in:
Samuel Gomes 2022-11-02 06:04:03 +05:30 committed by GitHub
commit fb177d6abf
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
18 changed files with 9505 additions and 11999 deletions

File diff suppressed because it is too large Load diff

View file

@ -10,7 +10,7 @@ Declare CustomType Library
Sub __UI_MemCopy Alias memcpy (ByVal dest As _Offset, Byval source As _Offset, Byval bytes As Long)
End Declare
Declare Library "./falcon"
Declare Library "./InForm/falcon"
Sub uprint_extra (ByVal x&, Byval y&, Byval chars%&, Byval length%&, Byval kern&, Byval do_render&, txt_width&, Byval charpos%&, charcount&, Byval colour~&, Byval max_width&)
Function uprint (ByVal x&, Byval y&, chars$, Byval txt_len&, Byval colour~&, Byval max_width&)
Function uprintwidth (chars$, Byval txt_len&, Byval max_width&)
@ -21,15 +21,15 @@ End Declare
$If WIN Then
Declare Library
Function __UI_MB& Alias MessageBox (ByVal ignore&, message$, title$, Byval type&)
Function GetSystemMetrics& (ByVal WhichMetric&)
Function __UI_MB& Alias MessageBox (ByVal ignore&, message$, title$, Byval type&)
Function GetSystemMetrics& (ByVal WhichMetric&)
End Declare
Const __UI_SM_SWAPBUTTON = 23
$Else
DECLARE LIBRARY ""
DECLARE LIBRARY ""
FUNCTION __UI_MB& ALIAS MessageBox (BYVAL ignore&, message$, title$, BYVAL type&)
END DECLARE
END DECLARE
$End If
$ScreenHide

View file

@ -1,5 +1,5 @@
Option _Explicit
Option _ExplicitArray
OPTION _EXPLICIT
OPTION _EXPLICITARRAY
$ExeIcon:'.\resources\InForm.ico'
@ -64,8 +64,6 @@ Dim Shared AlignMenuDistributeV As Long
Dim Shared AlignMenuDistributeH As Long
Dim Shared OptionsMenuAutoName As Long, OptionsMenuSwapButtons As Long
Dim Shared OptionsMenuCheckUpdates As Long, OptionsMenuCheckUpdatesNow As Long
Dim Shared OptionsMenuDevChannel As Long
Dim Shared HelpMenuHelp As Long, HelpMenuAbout As Long
@ -151,8 +149,7 @@ Dim Shared KeyboardComboLB As Long, KeyboardComboBT As Long
Dim Shared UiPreviewPID As Long, TotalSelected As Long, FirstSelected As Long
Dim Shared PreviewFormID As Long, PreviewSelectionRectangle As Integer
Dim Shared PreviewAttached As _Byte, AutoNameControls As _Byte
Dim Shared LastKeyPress As Double, CheckUpdates As _Byte, CheckUpdatesNow As _Byte
Dim Shared CheckDevUpdates As _Byte, CheckUpdateDone As _Byte, CheckUpdateStartUpTrigger As _Byte
Dim Shared LastKeyPress As Double
Dim Shared UiEditorTitle$, Edited As _Byte, ZOrderingDialogOpen As _Byte
Dim Shared OpenDialogOpen As _Byte
Dim Shared PropertySent As _Byte, RevertEdit As _Byte, OldColor As _Unsigned Long
@ -167,6 +164,7 @@ Dim Shared RecentMenuItem(1 To 9) As Long, RecentListBuilt As _Byte
Dim Shared LoadedWithGifExtension As _Byte, AddGifExtension As _Byte
Dim Shared TotalGifLoaded As Long, SetBindingDialogOpen As _Byte
Dim Shared InitialControlSet As String
DIM SHARED Answer AS LONG
Type newInputBox
ID As Long
@ -206,12 +204,32 @@ Dim Shared AttemptToShowFontList As _Byte, BypassShowFontList As _Byte
Dim Shared TotalFontsFound As Long
ReDim Shared FontFile(0) As String
DIM SHARED AS STRING QB64_EXE, QB64_DISPLAY
$If WIN Then
Const PathSep$ = "\"
Const QB64PE_EXE = "qb64pe.exe"
IF _FILEEXISTS(".." + PathSep$ + "qb64pe.exe") THEN
QB64_EXE = "qb64pe.exe"
QB64_DISPLAY = "QB64/PE"
ELSEIF _FILEEXISTS(".." + PathSep$ + "qb64.exe") THEN
QB64_EXE = "qb64.exe"
QB64_DISPLAY = "QB64"
ELSE
Answer = MessageBox("InForm aborted - Neither qb64pe.exe or qb64.exe executable found.", "", MsgBox_Ok + MsgBox_Critical)
SYSTEM 1
END IF
$Else
CONST PathSep$ = "/"
Const QB64PE_EXE = "qb64pe"
CONST PathSep$ = "/"
IF _FILEEXISTS(".." + PathSep$ + "qb64pe") THEN
QB64_EXE = "qb64pe"
QB64_DISPLAY = "QB64/PE"
ELSEIF _FILEEXISTS(".." + PathSep$ + "qb64") THEN
QB64_EXE = "qb64"
QB64_DISPLAY = "QB64"
ELSE
Answer = MessageBox("InForm aborted - Neither qb64pe or qb64 executable found.", "", MsgBox_Ok + MsgBox_Critical)
SYSTEM 1
END IF
$End If
Dim Shared CurrentPath$, ThisFileName$
@ -335,18 +353,6 @@ Sub __UI_Click (id As Long)
AutoNameControls = Not AutoNameControls
Control(id).Value = AutoNameControls
SaveSettings
Case OptionsMenuCheckUpdates
CheckUpdates = Not CheckUpdates
Control(id).Value = CheckUpdates
SaveSettings
Case OptionsMenuDevChannel
CheckDevUpdates = Not CheckDevUpdates
Control(id).Value = CheckDevUpdates
SaveSettings
Case OptionsMenuCheckUpdatesNow
CheckUpdatesNow = True
CheckUpdateDone = False
CheckUpdateStartUpTrigger = False
Case EditMenuConvertType
b$ = MKI$(0)
SendData b$, 225
@ -461,9 +467,9 @@ Sub __UI_Click (id As Long)
End If
Case ViewMenuPreview
$If WIN Then
Shell _DontWait ".\InForm\UiEditorPreview.exe " + HostPort
Shell _DontWait ".\UiEditorPreview.exe " + HostPort
$Else
SHELL _DONTWAIT "./InForm/UiEditorPreview " + HostPort
SHELL _DONTWAIT "./UiEditorPreview " + HostPort
$End If
Case ViewMenuLoadedFonts
Dim Temp$
@ -568,7 +574,7 @@ Sub __UI_Click (id As Long)
Case HelpMenuAbout
Dim isBeta$
If __UI_VersionIsBeta Then isBeta$ = " Beta Version" Else isBeta$ = ""
Answer = MessageBox(UiEditorTitle$ + " " + __UI_Version + " (build" + Str$(__UI_VersionNumber) + isBeta$ + ")\nby Fellippe Heitor\n\nTwitter: @fellippeheitor\ne-mail: fellippe@qb64.org", "About", MsgBox_OkOnly + MsgBox_Information)
Answer = MessageBox("InForm GUI for QB64 - Created by Fellippe Heitor (2016-2021)\n\n" + UiEditorTitle$ + " " + __UI_Version + " (build" + Str$(__UI_VersionNumber) + isBeta$ + ")\nby George McGinn (gbytes58@gmail.com)\n Samuel Gomes\n\nGitHub: https://github.com/a740g/InForm\n\nContact: gbytes58@gmail.com", "About", MsgBox_OkOnly + MsgBox_Information)
Case HelpMenuHelp
Answer = MessageBox("Design a form and export the resulting code to generate an event-driven QB64 program.", "What's all this?", MsgBox_OkOnly + MsgBox_Information)
Case FileMenuExit
@ -584,6 +590,11 @@ Sub __UI_Click (id As Long)
SaveForm False, False
End If
End If
$IF WIN THEN
IF _FileExists("..\UiEditorPreview.frmbin") THEN Kill "..\UiEditorPreview.frmbin"
$ELSE
IF _FileExists("UiEditorPreview.frmbin") Then Kill "UiEditorPreview.frmbin"
$END IF
System
Case EditMenuZOrdering
'Fill the list:
@ -647,7 +658,7 @@ Sub __UI_Click (id As Long)
Control(SetControlBinding).Left = 83: Control(SetControlBinding).Top = 169
__UI_Focus = SourcePropertyList
SetBindingDialogOpen = True
'CASE SwapBT
'CASE SwapBT
' SWAP Caption(SourceControlNameLB), Caption(TargetControlNameLB)
' SWAP Control(SourcePropertyList).Value, Control(TargetPropertyList).Value
Case BindBT
@ -1003,12 +1014,6 @@ Sub __UI_MouseEnter (id As Long)
Caption(StatusBar) = "Automatically sets control names based on caption and type"
Case OptionsMenuSwapButtons
Caption(StatusBar) = "Toggles left/right mouse buttons."
Case OptionsMenuCheckUpdates
Caption(StatusBar) = "Allows InForm to automatically check for updates at start-up."
Case OptionsMenuDevChannel
Caption(StatusBar) = "Receive updates from the development channel, for beta testing new features (experimental)."
Case OptionsMenuCheckUpdatesNow
Caption(StatusBar) = "Connects to server and check for new updates."
Case FontLB, FontListLB
Control(FontLB).BackColor = Darken(__UI_DefaultColor(__UI_Type_Form, 2), 90)
Control(FontListLB).BackColor = Darken(__UI_DefaultColor(__UI_Type_Form, 2), 90)
@ -1111,11 +1116,11 @@ Sub AddToRecentList (FileName$)
'Check if this FileName$ is already in the list; if so, delete it.
For i = 1 To 9
b$ = ReadSetting("InForm/InForm.ini", "Recent Projects", Str$(i))
b$ = ReadSetting("InForm.ini", "Recent Projects", Str$(i))
If b$ = FileName$ Then
For j = i + 1 To 9
b$ = ReadSetting("InForm/InForm.ini", "Recent Projects", Str$(j))
WriteSetting "InForm/InForm.ini", "Recent Projects", Str$(j - 1), b$
b$ = ReadSetting("InForm.ini", "Recent Projects", Str$(j))
WriteSetting "InForm.ini", "Recent Projects", Str$(j - 1), b$
Next
Exit For
End If
@ -1124,11 +1129,11 @@ Sub AddToRecentList (FileName$)
'Make room for FileName$ by shifting existing list by one;
'1 is the most recent, 9 is the oldest;
For i = 8 To 1 Step -1
b$ = ReadSetting("InForm/InForm.ini", "Recent Projects", Str$(i))
WriteSetting "InForm/InForm.ini", "Recent Projects", Str$(i + 1), b$
b$ = ReadSetting("InForm.ini", "Recent Projects", Str$(i))
WriteSetting "InForm.ini", "Recent Projects", Str$(i + 1), b$
Next
WriteSetting "InForm/InForm.ini", "Recent Projects", "1", FileName$
WriteSetting "InForm.ini", "Recent Projects", "1", FileName$
RecentListBuilt = False
End Sub
@ -1137,13 +1142,13 @@ Sub RemoveFromRecentList (FileName$)
'Check if this FileName$ is already in the list; if so, delete it.
For i = 1 To 9
b$ = ReadSetting("InForm/InForm.ini", "Recent Projects", Str$(i))
b$ = ReadSetting("InForm.ini", "Recent Projects", Str$(i))
If b$ = FileName$ Then
For j = i + 1 To 9
b$ = ReadSetting("InForm/InForm.ini", "Recent Projects", Str$(j))
WriteSetting "InForm/InForm.ini", "Recent Projects", Str$(j - 1), b$
b$ = ReadSetting("InForm.ini", "Recent Projects", Str$(j))
WriteSetting "InForm.ini", "Recent Projects", Str$(j - 1), b$
Next
WriteSetting "InForm/InForm.ini", "Recent Projects", "9", ""
WriteSetting "InForm.ini", "Recent Projects", "9", ""
Exit For
End If
Next
@ -1285,7 +1290,7 @@ Sub __UI_BeforeUpdateDisplay
'Build list of recent projects
RecentListBuilt = True
For i = 1 To 9
b$ = ReadSetting("InForm/InForm.ini", "Recent Projects", Str$(i))
b$ = ReadSetting("InForm.ini", "Recent Projects", Str$(i))
If Len(b$) Then
ToolTip(RecentMenuItem(i)) = b$
If InStr(b$, PathSep$) > 0 Then
@ -1402,146 +1407,6 @@ Sub __UI_BeforeUpdateDisplay
End If
Next
If CheckUpdatesNow Then
If CheckUpdateDone = False Then
Static ThisStep As Integer
Static serverVersion$, isBeta$, serverBeta$, serverBeta%%
Static updateDescription$, serverVersionString$
Static OverallDownloadStart!
Dim Result$, remoteFile$, start!
If ThisStep = 0 Then
'"Beginning update process"
ThisStep = 1
updateDescription$ = ""
serverVersion$ = ""
isBeta$ = ""
serverVersionString$ = ""
serverBeta%% = False
Result$ = Download$("", "", 10)
If _FileExists("InForm/InFormUpdate.ini") Then Kill "InForm/InFormUpdate.ini"
OverallDownloadStart! = Timer
End If
Caption(StatusBar) = "Contacting update server" + String$(Int(Timer - OverallDownloadStart!), ".")
Select EveryCase ThisStep
Case 1 'check availability
'"Checking availability"
start! = Timer
If CheckDevUpdates Then
remoteFile$ = "www.qb64.org/inform/update/latestdev.ini"
Else
remoteFile$ = "www.qb64.org/inform/update/latest.ini"
End If
'"Fetching " + remoteFile$
Result$ = Download$(remoteFile$, "InForm/InFormUpdate.ini", 30)
Select Case CVI(Left$(Result$, 2))
Case 1 'Success
ThisStep = 2
Case 2, 3 'Can't reach server / Timeout
ThisStep = 0
If Timer - start! > 5 Then
CheckUpdates = False 'disable auto-check if it times out
SaveSettings
End If
If Not CheckUpdateStartUpTrigger Then
b$ = "An error occurred. Make sure your computer is online."
Answer = MessageBox(b$, "", MsgBox_OkOnly + MsgBox_Exclamation)
CheckUpdatesNow = False
CheckUpdateStartUpTrigger = False
End If
CheckUpdateDone = True
Caption(StatusBar) = "Ready."
End Select
Case 2 'compare with current version
Dim localVersionNumber!
localVersionNumber! = __UI_VersionNumber
'"Comparing versions"
If __UI_VersionIsBeta Then isBeta$ = " Beta Version" Else isBeta$ = ""
serverBeta$ = ReadSetting("InForm/InFormUpdate.ini", "", "beta")
serverBeta%% = (serverBeta$ = "true")
If serverBeta%% Then serverBeta$ = " Beta Version" Else serverBeta$ = ""
serverVersion$ = ReadSetting("InForm/InFormUpdate.ini", "", "version")
serverVersionString$ = ReadSetting("InForm/InFormUpdate.ini", "", "versionstring")
updateDescription$ = ReadSetting("InForm/InFormUpdate.ini", "", "description")
'STR$(serverBeta%%) + "," + serverVersion$ + "," + serverVersionString$ + "," + updateDescription$
If serverBeta%% And CheckDevUpdates = False Then
CheckUpdateDone = True
If Not CheckUpdateStartUpTrigger Then
If __UI_VersionIsBeta Then
b$ = "You already have the latest version of InForm."
If Val(serverVersion$) > localVersionNumber! Then
b$ = b$ + "\nThere is a new development build available. Reenable 'Receive development updates' in the Options menu and\ntry updating again if you wish to keep helping beta test the new experimental features."
End If
Else
b$ = "You already have the latest stable version of InForm."
If Val(serverVersion$) > localVersionNumber! Then
b$ = b$ + "\nThere is a development build available. Check 'Receive development updates' in the Options menu and\ntry updating again if you wish to help beta test the new experimental features."
End If
End If
Answer = MessageBox(b$, "", MsgBox_OkOnly + MsgBox_Information)
CheckUpdatesNow = False
CheckUpdateStartUpTrigger = False
End If
ThisStep = 0
Caption(StatusBar) = "Ready."
Exit Sub
End If
If Val(serverVersion$) <= localVersionNumber! Then
CheckUpdateDone = True
If Not CheckUpdateStartUpTrigger Then
b$ = "You already have the latest version of InForm."
If __UI_VersionIsBeta Then
b$ = b$ + "\nThis is a development build."
End If
Answer = MessageBox(b$, "", MsgBox_OkOnly + MsgBox_Information)
CheckUpdatesNow = False
CheckUpdateStartUpTrigger = False
End If
ThisStep = 0
Caption(StatusBar) = "Ready."
Exit Sub
End If
ThisStep = 3
Exit Sub
Case 3 'An update is available.
Result$ = Download$("", "", 30) 'close connection
CheckUpdateDone = True
Dim updaterPath$
$If WIN Then
updaterPath$ = ".\InForm\updater\InFormUpdater.exe"
$Else
updaterPath$ = "./InForm/updater/InFormUpdater"
$End If
If _FileExists(updaterPath$) Then
_Delay .2
If Len(updateDescription$) Then
updateDescription$ = "\n" + Chr$(34) + updateDescription$ + Chr$(34) + "\n"
End If
Caption(StatusBar) = "New version available: " + serverVersionString$ + " (build " + serverVersion$ + serverBeta$ + ")"
b$ = "A new version of InForm is available.\n\nCurrent version: " + __UI_Version + " (build" + Str$(__UI_VersionNumber) + isBeta$ + ")\n" + "New version: " + serverVersionString$ + " (build " + serverVersion$ + serverBeta$ + ")\n" + updateDescription$ + "\n" + "Update now?"
Answer = MessageBox(b$, "", MsgBox_YesNo + MsgBox_Question)
If Answer = MsgBox_Yes Then
Shell _DontWait updaterPath$
System
End If
ThisStep = 0
Else
b$ = "A new version of InForm is available, but the updater is\ncurrently being recompiled.\nPlease check again in a few moments."
Answer = MessageBox(b$, "", MsgBox_OkOnly + MsgBox_Information)
End If
End Select
End If
End If
CheckPreview
Get #Client, , incomingData$
@ -2733,33 +2598,33 @@ Sub SaveSettings
If _DirExists("InForm") = 0 Then Exit Sub
If PreviewAttached Then value$ = "True" Else value$ = "False"
WriteSetting "InForm/InForm.ini", "InForm Settings", "Keep preview window attached", value$
WriteSetting "InForm.ini", "InForm Settings", "Keep preview window attached", value$
If AutoNameControls Then value$ = "True" Else value$ = "False"
WriteSetting "InForm/InForm.ini", "InForm Settings", "Auto-name controls", value$
WriteSetting "InForm.ini", "InForm Settings", "Auto-name controls", value$
If __UI_SnapLines Then value$ = "True" Else value$ = "False"
WriteSetting "InForm/InForm.ini", "InForm Settings", "Snap to edges", value$
WriteSetting "InForm.ini", "InForm Settings", "Snap to edges", value$
If __UI_ShowPositionAndSize Then value$ = "True" Else value$ = "False"
WriteSetting "InForm/InForm.ini", "InForm Settings", "Show position and size", value$
WriteSetting "InForm.ini", "InForm Settings", "Show position and size", value$
If __UI_ShowInvisibleControls Then value$ = "True" Else value$ = "False"
WriteSetting "InForm/InForm.ini", "InForm Settings", "Show invisible controls", value$
WriteSetting "InForm.ini", "InForm Settings", "Show invisible controls", value$
If CheckUpdates Then value$ = "True" Else value$ = "False"
WriteSetting "InForm/InForm.ini", "InForm Settings", "Check for updates", value$
value$ = "False" ' *** Removing the checking for update function
WriteSetting "InForm.ini", "InForm Settings", "Check for updates", value$
If CheckDevUpdates Then value$ = "True" Else value$ = "False"
WriteSetting "InForm/InForm.ini", "InForm Settings", "Receive development updates", value$
value$ = "False" ' *** Removing the checking for update function
WriteSetting "InForm.ini", "InForm Settings", "Receive development updates", value$
If ShowFontList Then value$ = "True" Else value$ = "False"
WriteSetting "InForm/InForm.ini", "InForm Settings", "Show font list", value$
WriteSetting "InForm.ini", "InForm Settings", "Show font list", value$
$If WIN Then
$Else
IF __UI_MouseButtonsSwap THEN value$ = "True" ELSE value$ = "False"
WriteSetting "InForm/InForm.ini", "InForm Settings", "Swap mouse buttons", value$
IF __UI_MouseButtonsSwap THEN value$ = "True" ELSE value$ = "False"
WriteSetting "InForm.ini", "InForm Settings", "Swap mouse buttons", value$
$End If
End Sub
@ -2818,7 +2683,7 @@ Sub __UI_OnLoad
'Load splash image:
Dim tempIcon As Long
tempIcon = _LoadImage("./InForm/resources/Application-icon-128.png", 32)
tempIcon = _LoadImage("resources/Application-icon-128.png", 32)
GoSub ShowMessage
@ -2869,7 +2734,6 @@ Sub __UI_OnLoad
PreviewAttached = True
AutoNameControls = True
CheckUpdates = True
__UI_ShowPositionAndSize = True
__UI_ShowInvisibleControls = True
__UI_SnapLines = True
@ -2889,88 +2753,68 @@ Sub __UI_OnLoad
If _DirExists("InForm") = 0 Then MkDir "InForm"
Dim value$
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Keep preview window attached")
value$ = ReadSetting("InForm.ini", "InForm Settings", "Keep preview window attached")
If Len(value$) Then
PreviewAttached = (value$ = "True")
Else
WriteSetting "InForm/InForm.ini", "InForm Settings", "Keep preview window attached", "True"
WriteSetting "InForm.ini", "InForm Settings", "Keep preview window attached", "True"
PreviewAttached = True
End If
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Auto-name controls")
value$ = ReadSetting("InForm.ini", "InForm Settings", "Auto-name controls")
If Len(value$) Then
AutoNameControls = (value$ = "True")
Else
WriteSetting "InForm/InForm.ini", "InForm Settings", "Auto-name controls", "True"
WriteSetting "InForm.ini", "InForm Settings", "Auto-name controls", "True"
AutoNameControls = True
End If
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Snap to edges")
value$ = ReadSetting("InForm.ini", "InForm Settings", "Snap to edges")
If Len(value$) Then
__UI_SnapLines = (value$ = "True")
Else
WriteSetting "InForm/InForm.ini", "InForm Settings", "Snap to edges", "True"
WriteSetting "InForm.ini", "InForm Settings", "Snap to edges", "True"
__UI_SnapLines = True
End If
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Show position and size")
value$ = ReadSetting("InForm.ini", "InForm Settings", "Show position and size")
If Len(value$) Then
__UI_ShowPositionAndSize = (value$ = "True")
Else
WriteSetting "InForm/InForm.ini", "InForm Settings", "Show position and size", "True"
WriteSetting "InForm.ini", "InForm Settings", "Show position and size", "True"
__UI_ShowPositionAndSize = True
End If
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Show invisible controls")
value$ = ReadSetting("InForm.ini", "InForm Settings", "Show invisible controls")
If Len(value$) Then
__UI_ShowInvisibleControls = (value$ = "True")
Else
WriteSetting "InForm/InForm.ini", "InForm Settings", "Show invisible controls", "True"
WriteSetting "InForm.ini", "InForm Settings", "Show invisible controls", "True"
__UI_ShowInvisibleControls = True
End If
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Check for updates")
If Len(value$) Then
CheckUpdates = (value$ = "True")
Else
WriteSetting "InForm/InForm.ini", "InForm Settings", "Check for updates", "True"
CheckUpdates = True
End If
CheckUpdatesNow = CheckUpdates
If CheckUpdatesNow Then CheckUpdateStartUpTrigger = True
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Receive development updates")
If Len(value$) Then
CheckDevUpdates = (value$ = "True")
Else
WriteSetting "InForm/InForm.ini", "InForm Settings", "Receive development updates", "False"
CheckDevUpdates = False
End If
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Show font list")
value$ = ReadSetting("InForm.ini", "InForm Settings", "Show font list")
If Len(value$) Then
ShowFontList = (value$ = "True")
Else
WriteSetting "InForm/InForm.ini", "InForm Settings", "Show font list", "True"
WriteSetting "InForm.ini", "InForm Settings", "Show font list", "True"
ShowFontList = True
End If
$If WIN Then
$Else
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Swap mouse buttons")
__UI_MouseButtonsSwap = (value$ = "True")
Control(OptionsMenuSwapButtons).Value = __UI_MouseButtonsSwap
value$ = ReadSetting("InForm.ini", "InForm Settings", "Swap mouse buttons")
__UI_MouseButtonsSwap = (value$ = "True")
Control(OptionsMenuSwapButtons).Value = __UI_MouseButtonsSwap
$End If
Control(ViewMenuPreviewDetach).Value = PreviewAttached
Control(OptionsMenuAutoName).Value = AutoNameControls
Control(OptionsMenuCheckUpdates).Value = CheckUpdates
Control(OptionsMenuDevChannel).Value = CheckDevUpdates
Control(OptionsMenuSnapLines).Value = __UI_SnapLines
Control(ViewMenuShowPositionAndSize).Value = __UI_ShowPositionAndSize
Control(ViewMenuShowInvisibleControls).Value = __UI_ShowInvisibleControls
If _FileExists("InForm/UiEditorPreview.frmbin") Then Kill "InForm/UiEditorPreview.frmbin"
If _FileExists("UiEditorPreview.frmbin") Then Kill "UiEditorPreview.frmbin"
b$ = "Parsing command line..."
GoSub ShowMessage
@ -3054,7 +2898,7 @@ Sub __UI_OnLoad
Get #FreeFileNum, 1, b$
Close #FreeFileNum
Open "InForm/UiEditorPreview.frmbin" For Binary As #FreeFileNum
Open "UiEditorPreview.frmbin" For Binary As #FreeFileNum
Put #FreeFileNum, 1, b$
Close #FreeFileNum
If LoadedWithGifExtension = False Then
@ -3068,39 +2912,15 @@ Sub __UI_OnLoad
End If
b$ = "Checking Preview component..."
GoSub ShowMessage
Dim As _Byte JustRecompiledPreview
$If WIN Then
If _FileExists("InForm/UiEditorPreview.exe") = 0 Then
If _FileExists("InForm/UiEditorPreview.bas") = 0 Then
GoTo UiEditorPreviewNotFound
Else
b$ = "Compiling Preview component..."
GoSub ShowMessage
Shell _Hide QB64PE_EXE + " -s:exewithsource=true -x .\InForm\UiEditorPreview.bas"
If _FileExists("InForm/UiEditorPreview.exe") = 0 Then GoTo UiEditorPreviewNotFound
JustRecompiledPreview = True
End If
End If
$Else
IF _FILEEXISTS("InForm/UiEditorPreview") = 0 THEN
IF _FILEEXISTS("./InForm/UiEditorPreview.bas") = 0 THEN
GOTO UiEditorPreviewNotFound
ELSE
b$ = "Compiling Preview component..."
GOSUB ShowMessage
SHELL _HIDE "./" + QB64PE_EXE + " -s:exewithsource=true -x ./InForm/UiEditorPreview.bas"
IF _FILEEXISTS("InForm/UiEditorPreview") = 0 THEN GOTO UiEditorPreviewNotFound
JustRecompiledPreview = True
END IF
END IF
$End If
GOSUB ShowMessage
$IF WIN THEN
IF _FileExists("UiEditorPreview.exe") = 0 THEN GOTO UiEditorPreviewNotFound
$ELSE
IF _FILEEXISTS("UiEditorPreview") = 0 THEN GOTO UiEditorPreviewNotFound
$END IF
b$ = "Reading directory..."
GoSub ShowMessage
'Fill "open dialog" listboxes:
'-------------------------------------------------
Dim TotalFiles%
@ -3257,9 +3077,9 @@ Sub __UI_OnLoad
b$ = "Launching Preview component..."
GoSub ShowMessage
$If WIN Then
Shell _DontWait ".\InForm\UiEditorPreview.exe " + HostPort
Shell _DontWait ".\UiEditorPreview.exe " + HostPort
$Else
SHELL _DONTWAIT "./InForm/UiEditorPreview " + HostPort
SHELL _DONTWAIT "./UiEditorPreview " + HostPort
$End If
b$ = "Connecting to preview component..."
@ -3276,37 +3096,6 @@ Sub __UI_OnLoad
GoSub ShowMessage
Handshake
Dim TriggerUpdaterRecompile As _Byte
TriggerUpdaterRecompile = False
If JustRecompiledPreview = False Then
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Recompile updater")
If value$ = "True" Then
TriggerUpdaterRecompile = True
WriteSetting "InForm/InForm.ini", "InForm Settings", "Recompile updater", "False"
Else
$If WIN Then
If _FileExists("InForm/updater/InFormUpdater.exe") = False Then
TriggerUpdaterRecompile = True
End If
$Else
IF _FILEEXISTS("InForm/updater/InFormUpdater") = False THEN
TriggerUpdaterRecompile = True
END IF
$End If
End If
If TriggerUpdaterRecompile Then
$If WIN Then
Shell _Hide _DontWait QB64PE_EXE + " -s:exewithsource=true -x InForm/updater/InFormUpdater.bas"
$Else
SHELL _HIDE _DONTWAIT "./" + QB64PE_EXE + " -s:exewithsource=true -x InForm/updater/InFormUpdater.bas"
$End If
End If
If CheckUpdates Then b$ = "Checking for updates..." Else b$ = "InForm Designer"
GoSub ShowMessage
End If
__UI_RefreshMenuBar
__UI_ForceRedraw = True
_FreeImage tempIcon
@ -4152,7 +3941,7 @@ Sub CheckPreview
__UI_UpdateDisplay
Shell _DontWait ".\InForm\UiEditorPreview.exe " + HostPort
Shell _DontWait ".\UiEditorPreview.exe " + HostPort
Do
Client = _OpenConnection(Host)
@ -4191,7 +3980,7 @@ Sub CheckPreview
__UI_UpdateDisplay
SHELL _DONTWAIT "./InForm/UiEditorPreview " + HostPort
SHELL _DONTWAIT "./UiEditorPreview " + HostPort
DO
Client = _OPENCONNECTION(Host)
@ -4843,7 +4632,7 @@ Sub SaveForm (ExitToQB64 As _Byte, SaveOnlyFrm As _Byte)
If AddGifExtension = True And TotalGifLoaded > 0 Then
Print #TextFileNum,
Print #TextFileNum, " 'The lines below ensure your GIFs will display properly;"
Print #TextFileNum, " 'Please refer to the documentation in 'InForm/extensions/README - gifplay.txt'"
Print #TextFileNum, " 'Please refer to the documentation in 'extensions/README - gifplay.txt'"
For Dummy = 1 To UBound(PreviewControls)
If PreviewAnimatedGif(Dummy) Then
Print #TextFileNum, " UpdateGif " + RTrim$(PreviewControls(Dummy).Name)
@ -4908,27 +4697,23 @@ Sub SaveForm (ExitToQB64 As _Byte, SaveOnlyFrm As _Byte)
b$ = b$ + " " + Mid$(BaseOutputFileName, Len(CurrentPath$) + 2) + ".frm"
If ExitToQB64 And Not SaveOnlyFrm Then
$If WIN Then
If _FileExists(QB64PE_EXE) Then
b$ = b$ + Chr$(10) + Chr$(10) + "Exit to QB64?"
Else
b$ = b$ + Chr$(10) + Chr$(10) + "Close the editor?"
End If
$Else
IF _FILEEXISTS("qb64") THEN
b$ = b$ + CHR$(10) + CHR$(10) + "Exit to QB64?"
ELSE
b$ = b$ + CHR$(10) + CHR$(10) + "Close the editor?"
END IF
$End If
Answer = MessageBox(b$, "", MsgBox_YesNo + MsgBox_Question)
If Answer = MsgBox_No Then Edited = False: Exit Sub
$If WIN Then
If _FileExists(QB64PE_EXE) Then Shell _DontWait QB64PE_EXE + " " + QuotedFilename$(BaseOutputFileName + ".bas")
$Else
IF _FILEEXISTS(QB64PE_EXE) THEN SHELL _DONTWAIT "./" + QB64PE_EXE + " " + QuotedFilename$(BaseOutputFileName + ".bas")
$End If
System
IF _FILEEXISTS(".." + PathSep$ + QB64_EXE) THEN
b$ = b$ + Chr$(10) + Chr$(10) + "Exit to " + QB64_DISPLAY + "?"
Answer = MessageBox(b$, "", MsgBox_YesNo + MsgBox_Question)
If Answer = MsgBox_No Then Edited = False:EXIT SUB
IF _FileExists("UiEditorPreview.frmbin") THEN Kill "UiEditorPreview.frmbin"
$IF WIN THEN
IF _FileExists("..\UiEditorPreview.frmbin") THEN Kill "..\UiEditorPreview.frmbin"
Shell _DontWait ".." + PathSep$ + QB64_EXE + " " + QuotedFilename$(BaseOutputFileName + ".bas")
$ELSE
SHELL _DONTWAIT ".." + PathSep$ + + QB64_EXE + " " + QuotedFilename$(BaseOutputFileName + ".bas")
$END IF
System
ELSE
b$ = b$ + Chr$(10) + Chr$(10) + "Close the editor?"
Answer = MessageBox(b$, "", MsgBox_YesNo + MsgBox_Question)
If Answer = MsgBox_No Then Edited = False: EXIT SUB
END IF
Else
Answer = MessageBox(b$, "", MsgBox_OkOnly + MsgBox_Information)
Edited = False

View file

@ -227,23 +227,6 @@ SUB __UI_LoadForm
SetCaption __UI_NewID, "&Auto-name controls"
Control(__UI_NewID).Value = True
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuAutoUpdate", 155, 18, 0, 4, __UI_GetID("OptionsMenu"))
$IF WIN THEN
SetCaption __UI_NewID, "Auto-&Update"
$ELSE
SetCaption __UI_NewID, "Auto-&Update-"
$END IF
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuCheckUpdates", 155, 18, 0, 4, __UI_GetID("OptionsMenuAutoUpdate"))
SetCaption __UI_NewID, "&Check for updates at start-up"
Control(__UI_NewID).Value = True
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuDevChannel", 155, 18, 0, 4, __UI_GetID("OptionsMenuAutoUpdate"))
SetCaption __UI_NewID, "Receive &development updates-"
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuCheckUpdatesNow", 155, 18, 0, 4, __UI_GetID("OptionsMenuAutoUpdate"))
SetCaption __UI_NewID, "Check for updates &now"
$IF WIN THEN
$ELSE
__UI_NewID = __UI_NewControl(__UI_Type_MenuItem, "OptionsMenuSwapButtons", 0, 0, 0, 0, __UI_GetID("OptionsMenu"))
@ -981,9 +964,6 @@ SUB __UI_AssignIDs
ControlToggles = __UI_GetID("ControlToggles")
BulletOptions = __UI_GetID("BulletOptions")
BulletOptionsLB = __UI_GetID("BulletOptionsLB")
OptionsMenuCheckUpdates = __UI_GetID("OptionsMenuCheckUpdates")
OptionsMenuCheckUpdatesNow = __UI_GetID("OptionsMenuCheckUpdatesNow")
OptionsMenuDevChannel = __UI_GetID("OptionsMenuDevChannel")
BooleanOptions = __UI_GetID("BooleanOptions")
BooleanLB = __UI_GetID("BooleanLB")
FontList = __UI_GetID("FontList")

View file

@ -78,14 +78,12 @@ $If WIN Then
Function CloseHandle& (ByVal hObject As Long)
Function GetExitCodeProcess& (ByVal hProcess As Long, lpExitCode As Long)
End Declare
Const PathSep$ = "\"
$Else
DECLARE LIBRARY
DECLARE LIBRARY
FUNCTION PROCESS_CLOSED& ALIAS kill (BYVAL pid AS INTEGER, BYVAL signal AS INTEGER)
END DECLARE
CONST PathSep$ = "/"
END DECLARE
CONST PathSep$ = "/"
$End If
'Load context menu icon image:
@ -401,11 +399,15 @@ Sub __UI_BeforeUpdateDisplay
_ScreenHide
Answer = MessageBox("InForm Designer is not running. Please run the main program.", "InForm Preview", 0)
End If
If _FileExists("..\UiEditorPreview.frmbin") Then Kill "..\UiEditorPreview.frmbin"
System
End If
b& = CloseHandle(hnd&)
$Else
IF PROCESS_CLOSED(UiEditorPID, 0) THEN SYSTEM
IF PROCESS_CLOSED(UiEditorPID, 0) THEN
If _FileExists("UiEditorPreview.frmbin") Then Kill "UiEditorPreview.frmbin"
SYSTEM
END IF
$End If
If __UI_IsDragging Then
@ -601,7 +603,7 @@ Sub __UI_BeforeUpdateDisplay
Close #FileToLoad
FileToLoad = FreeFile
Open "InForm/UiEditorPreview.frmbin" For Binary As #FileToLoad
Open "UiEditorPreview.frmbin" For Binary As #FileToLoad
Put #FileToLoad, 1, a$
Close #FileToLoad
@ -621,7 +623,7 @@ Sub __UI_BeforeUpdateDisplay
a$ = Unpack$(EmptyForm$)
FileToLoad = FreeFile
Open "InForm/UiEditorPreview.frmbin" For Binary As #FileToLoad
Open "UiEditorPreview.frmbin" For Binary As #FileToLoad
Put #FileToLoad, 1, a$
Close #FileToLoad
@ -1661,10 +1663,10 @@ End Sub
Sub __UI_BeforeInit
__UI_DesignMode = True
If _FileExists("InForm/UiEditorPreview.frmbin") Then
If _FileExists("UiEditorPreview.frmbin") Then
Dim FileToLoad As Integer, a$
FileToLoad = FreeFile
Open "InForm/UiEditorPreview.frmbin" For Binary As #FileToLoad
Open "UiEditorPreview.frmbin" For Binary As #FileToLoad
a$ = Space$(LOF(FileToLoad))
Get #FileToLoad, 1, a$
Close #FileToLoad
@ -2344,14 +2346,14 @@ Sub LoadPreview (Destination As _Byte)
Const LogFileLoad = False
If _FileExists("InForm/UiEditorPreview.frmbin") = 0 And Destination = InDisk Then
If _FileExists("UiEditorPreview.frmbin") = 0 And Destination = InDisk Then
Exit Sub
End If
If Destination = InDisk Then
Disk = True
BinaryFileNum = FreeFile
Open "InForm/UiEditorPreview.frmbin" For Binary As #BinaryFileNum
Open "UiEditorPreview.frmbin" For Binary As #BinaryFileNum
ElseIf Destination = ToUndoBuffer Then
UndoBuffer = True
End If
@ -2775,7 +2777,7 @@ Sub LoadPreview (Destination As _Byte)
LoadError:
If Disk Then
Close #BinaryFileNum
Kill "InForm/UiEditorPreview.frmbin"
Kill "UiEditorPreview.frmbin"
End If
If LogFileLoad Then Close #LogFileNum
__UI_AutoRefresh = True
@ -2792,11 +2794,11 @@ Sub LoadPreviewText
Const LogFileLoad = False
If _FileExists("InForm/UiEditorPreview.frmbin") = 0 Then
If _FileExists("UiEditorPreview.frmbin") = 0 Then
Exit Sub
Else
BinaryFileNum = FreeFile
Open "InForm/UiEditorPreview.frmbin" For Binary As #BinaryFileNum
Open "UiEditorPreview.frmbin" For Binary As #BinaryFileNum
LogFileNum = FreeFile
If LogFileLoad Then Open "ui_log.txt" For Output As #LogFileNum
@ -3148,7 +3150,7 @@ Sub LoadPreviewText
LoadError:
Close #BinaryFileNum
Kill "InForm/UiEditorPreview.frmbin"
Kill "UiEditorPreview.frmbin"
__UI_AutoRefresh = True
Exit Sub
End If
@ -3247,7 +3249,7 @@ Sub SavePreview (Destination As _Byte)
If Destination = InDisk Then
Disk = True
BinFileNum = FreeFile
Open "InForm/UiEditorPreview.frmbin" For Binary As #BinFileNum
Open "UiEditorPreview.frmbin" For Binary As #BinFileNum
ElseIf Destination = ToEditor Then
TCP = True
ElseIf Destination = ToUndoBuffer Then
@ -3931,7 +3933,7 @@ Sub LoadDefaultFonts
Control(__UI_FormID).Font = SetFont("/usr/share/fonts/TTF/arial.ttf", 12)
End If
If Control(__UI_FormID).Font = 8 Or Control(__UI_FormID).Font = 16 Then
Control(__UI_FormID).Font = SetFont("InForm/resources/NotoMono-Regular.ttf", 12)
Control(__UI_FormID).Font = SetFont("resources/NotoMono-Regular.ttf", 12)
End If
End Sub

File diff suppressed because it is too large Load diff

View file

@ -1,78 +0,0 @@
': This form was generated by
': InForm - GUI library for QB64 - Beta version 9
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
$EXEICON:'./../resources/updater.ico'
DIM __UI_NewID AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "InFormSetup", 500, 425, 0, 0, 0)
SetCaption __UI_NewID, "InForm Setup"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).Font = SetFont("segoeui.ttf?arial.ttf?/Library/Fonts/Arial.ttf?/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf?/usr/share/fonts/TTF/arial.ttf?InForm/resources/NotoMono-Regular.ttf?cour.ttf", 12)
Control(__UI_NewID).CenteredWindow = True
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox2", 500, 150, 0, 0, 0)
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).BackColor = _RGB32(255, 255, 255)
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "InFormresourcesApplicationicon128PX", 128, 128, 10, 11, 0)
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).BackStyle = __UI_Transparent
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Label, "InFormLB", 258, 90, 199, 22, 0)
SetCaption __UI_NewID, "InForm"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).Font = SetFont("segoeui.ttf?arial.ttf?/Library/Fonts/Arial.ttf?/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf?/usr/share/fonts/TTF/arial.ttf?InForm/resources/NotoMono-Regular.ttf?cour.ttf", 72)
Control(__UI_NewID).BackStyle = __UI_Transparent
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Label, "forQB64LB", 152, 43, 305, 88, 0)
SetCaption __UI_NewID, "for QB64"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).Font = SetFont("segoeui.ttf?arial.ttf?/Library/Fonts/Arial.ttf?/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf?/usr/share/fonts/TTF/arial.ttf?InForm/resources/NotoMono-Regular.ttf?cour.ttf", 32)
Control(__UI_NewID).BackStyle = __UI_Transparent
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_ListBox, "ListBox1", 480, 224, 10, 159, 0)
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).AutoScroll = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "RetryBT", 80, 23, 10, 392, 0)
SetCaption __UI_NewID, "&Retry"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).Hidden = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBT", 80, 23, 410, 392, 0)
SetCaption __UI_NewID, "&Cancel"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "ActivityIndicator", 266, 32, 117, 388, 0)
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
END SUB
SUB __UI_AssignIDs
InFormSetup = __UI_GetID("InFormSetup")
PictureBox2 = __UI_GetID("PictureBox2")
InFormresourcesApplicationicon128PX = __UI_GetID("InFormresourcesApplicationicon128PX")
InFormLB = __UI_GetID("InFormLB")
forQB64LB = __UI_GetID("forQB64LB")
ListBox1 = __UI_GetID("ListBox1")
RetryBT = __UI_GetID("RetryBT")
CancelBT = __UI_GetID("CancelBT")
ActivityIndicator = __UI_GetID("ActivityIndicator")
END SUB

View file

@ -1,421 +0,0 @@
': This program uses
': InForm - GUI library for QB64 - Beta version 9
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
': Controls' IDs: ------------------------------------------------------------------
Dim Shared InFormUpdater As Long
Dim Shared PictureBox2 As Long
Dim Shared InFormresourcesApplicationicon128PX As Long
Dim Shared InFormLB As Long
Dim Shared forQB64LB As Long
Dim Shared ListBox1 As Long
Dim Shared RetryBT As Long
Dim Shared CancelBT As Long
Dim Shared ActivityIndicator As Long
Dim Shared binaryExtension$, pathAppend$
Dim Shared CheckDevUpdates As _Byte
$If WIN Then
binaryExtension$ = ".exe"
pathAppend$ = ""
$Else
binaryExtension$ = ""
pathAppend$ = "./"
$End If
': External modules: ---------------------------------------------------------------
'$INCLUDE:'../InForm.bi'
'$INCLUDE:'../xp.uitheme'
'$INCLUDE:'InFormUpdater.frm'
'$INCLUDE:'../ini.bm'
'$include:'../extensions/download.bas'
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
END SUB
SUB __UI_OnLoad
Report "Contacting server..."
CHDIR "../.."
IF _FILEEXISTS("InFormUpdate.ini") THEN KILL "InFormUpdate.ini"
DIM value$
value$ = ReadSetting("InForm/InForm.ini", "InForm Settings", "Receive development updates")
IF LEN(value$) THEN
CheckDevUpdates = (value$ = "True")
ELSE
WriteSetting "InForm/InForm.ini", "InForm Settings", "Receive development updates", "False"
CheckDevUpdates = False
END IF
END SUB
SUB __UI_BeforeUpdateDisplay STATIC
DIM NextEvent AS LONG, remoteFile$
SHARED ThisStep AS INTEGER
IF ThisStep = 0 THEN ThisStep = 1
SELECT EVERYCASE ThisStep
CASE 1 'check availability
IF CheckDevUpdates THEN
remoteFile$ = "www.qb64.org/inform/update/latestdev.ini"
ELSE
remoteFile$ = "www.qb64.org/inform/update/latest.ini"
END IF
Result$ = Download$(remoteFile$, "InFormUpdate.ini", 30)
SELECT CASE CVI(LEFT$(Result$, 2))
CASE 1 'Success
Report "Script downloaded:" + STR$(CVL(MID$(Result$, 3))) + " bytes."
ThisStep = 2
NextEvent = True
CASE 2 'Can't reach server
Report "Can't reach server."
ThisStep = -1
NextEvent = True
CASE 3 'Timeout :-(
Report "Failed to download update script."
ThisStep = -1
NextEvent = True
END SELECT
CASE 2 'compare with current version
IF NextEvent THEN NextEvent = False: Report "Parsing update script..."
localVersion$ = ReadSetting("InForm/InFormVersion.bas", "", "CONST __UI_Version")
localVersionNumber! = VAL(ReadSetting("InForm/InFormVersion.bas", "", "CONST __UI_VersionNumber"))
localVersionisBeta%% = VAL(ReadSetting("InForm/InFormVersion.bas", "", "CONST __UI_VersionIsBeta"))
IF localVersionisBeta%% THEN localBeta$ = " Beta Version" ELSE localBeta$ = ""
Report "Local build:" + STR$(localVersionNumber!) + localBeta$
serverVersion$ = ReadSetting("InFormUpdate.ini", "", "version")
serverBeta$ = ReadSetting("InFormUpdate.ini", "", "beta")
serverBeta%% = (serverBeta$ = "true")
IF serverBeta%% THEN serverBeta$ = " Beta Version" ELSE serverBeta$ = ""
Report "Remote build: " + serverVersion$ + serverBeta$
IF VAL(serverVersion$) <= localVersionNumber! THEN
NextEvent = True: ThisStep = 7: EXIT SUB
END IF
thisFile% = 0
baseUrl$ = ReadSetting("InFormUpdate.ini", "", "baseurl")
NextEvent = True: ThisStep = 3
CASE 3 'download new content
IF NextEvent THEN NextEvent = False: Report "Downloading content..."
IF url$ = "" THEN
thisFile% = thisFile% + 1
url$ = ReadSetting("InFormUpdate.ini", LTRIM$(STR$(thisFile%)), "filename")
IF url$ = "" THEN
NextEvent = True: ThisStep = 4: EXIT SUB
END IF
IF INSTR(url$, "/") > 0 THEN
FOR i = LEN(url$) TO 1 STEP -1
IF ASC(url$, i) = 47 THEN '/
target$ = LEFT$(url$, i)
EXIT FOR
END IF
NEXT
IF _DIREXISTS(target$) = 0 THEN MKDIR target$
ELSE
target$ = ""
END IF
outputFileName$ = url$
checksum$ = ReadSetting("InFormUpdate.ini", LTRIM$(STR$(thisFile%)), "checksum")
IF _FILEEXISTS(outputFileName$) THEN
IF getChecksum$(outputFileName$) = checksum$ THEN
url$ = ""
END IF
END IF
IF LEN(url$) THEN Report "Downloading " + outputFileName$ + "...;"
END IF
IF LEN(url$) THEN
IF INSTR(url$, "updater") > 0 THEN
WriteSetting "InForm/InForm.ini", "InForm Settings", "Recompile updater", "True"
END IF
Result$ = Download$(baseUrl$ + url$, outputFileName$, 30)
ELSE
Result$ = MKI$(0)
END IF
SELECT CASE CVI(LEFT$(Result$, 2))
CASE 1 'Success
'Checksum:
IF getChecksum(outputFileName$) <> checksum$ THEN
Report "Failed."
ThisStep = -1
NextEvent = True
EXIT SUB
END IF
Report " done (" + LTRIM$(STR$(CVL(MID$(Result$, 3)))) + " bytes)"
url$ = ""
CASE 2 'Can't reach server
Report "failed."
Report "Can't reach server."
ThisStep = -1
NextEvent = True
CASE 3 'Timeout :-(
Report "failed."
Report "Failed to download update files from server."
ThisStep = -1
NextEvent = True
END SELECT
CASE 4 'compile UiEditor.bas
IF NextEvent THEN NextEvent = False: Report "Compiling UiEditor.bas...": EXIT SUB
SHELL _HIDE pathAppend$ + "qb64" + binaryExtension$ + " -s:exewithsource=false"
Result% = SHELL(pathAppend$ + "qb64" + binaryExtension$ + " -x InForm/UiEditor.bas")
IF Result% > 0 OR _FILEEXISTS(pathAppend$ + "qb64" + binaryExtension$) = 0 THEN
Report "Compilation failed."
ThisStep = -1
NextEvent = True
ELSE
ThisStep = 5
NextEvent = True
END IF
CASE 5 'compile UiEditorPreview.bas
IF NextEvent THEN NextEvent = False: Report "Compiling UiEditorPreview.bas...": EXIT SUB
Result% = SHELL(pathAppend$ + "qb64" + binaryExtension$ + " -x InForm/UiEditorPreview.bas -o InForm/UiEditorPreview.exe")
IF Result% THEN
Report "Compilation failed."
ThisStep = -1
NextEvent = True
ELSE
ThisStep = 6
NextEvent = True
END IF
CASE 6 'clean up
IF NextEvent THEN NextEvent = False: Report "Cleaning up...": EXIT SUB
KILL "InFormUpdate.ini"
ThisStep = 8
NextEvent = True
CASE 7 'already up-to-date
DIM b$
b$ = ""
IF CheckDevUpdates THEN b$ = "\n(You are currently in the development channel; you can\nchange that in InForm Designer, Options menu -> Auto-update)"
Answer = MessageBox("You already have the latest version." + b$, "", MsgBox_OkOnly + MsgBox_Information)
KILL "InFormUpdate.ini"
SYSTEM
CASE 8 'done
IF NextEvent THEN NextEvent = False: Report "Update complete.": EXIT SUB
Result$ = Download$("", "", 30) 'close client
Control(ActivityIndicator).Hidden = True
Caption(CancelBT) = "Finish"
SetFocus CancelBT
CASE 1 TO 6
BeginDraw ActivityIndicator
CLS , __UI_DefaultColor(__UI_Type_Form, 2)
angle = angle + .05
indicatorSize = 2
IF angle > _PI(2) THEN angle = _PI(2) - angle
FOR i = 0 TO 360 STEP 90
CircleFill _WIDTH / 2 + COS(angle + _D2R(i)) * (_WIDTH * .2), _HEIGHT / 2, indicatorSize, _RGBA32(0, 0, 0, map(i, 0, 360, 20, 255))
NEXT
EndDraw ActivityIndicator
CASE ELSE
IF NextEvent THEN NextEvent = False: Report "Updated failed.": AddItem ListBox1, ""
Result$ = Download$("", "", 30)
KILL "InFormUpdate.ini"
Control(RetryBT).Hidden = False
Control(ActivityIndicator).Hidden = True
END SELECT
END SUB
SUB Report (__text$)
STATIC Continue%%
DIM text$
text$ = __text$
IF text$ = "" THEN
Continue%% = False
EXIT SUB
END IF
IF RIGHT$(text$, 1) = ";" THEN
text$ = LEFT$(text$, LEN(text$) - 1)
GOSUB AddThisItem
Continue%% = True
ELSE
GOSUB AddThisItem
Continue%% = False
END IF
EXIT SUB
AddThisItem:
IF Continue%% THEN
text$ = GetItem(ListBox1, Control(ListBox1).Max) + text$
ReplaceItem ListBox1, Control(ListBox1).Max, text$
ELSE
AddItem ListBox1, TIME$ + ": " + text$
END IF
RETURN
END SUB
FUNCTION getChecksum$ (File$)
DIM fileHandle AS LONG
IF _FILEEXISTS(File$) = 0 THEN EXIT SUB
fileHandle = FREEFILE
OPEN File$ FOR BINARY AS fileHandle
DataArray$ = SPACE$(LOF(fileHandle))
GET #fileHandle, 1, DataArray$
CLOSE #fileHandle
getChecksum$ = HEX$(crc32~&(DataArray$))
END FUNCTION
FUNCTION crc32~& (buf AS STRING)
'adapted from https://rosettacode.org/wiki/CRC-32
STATIC table(255) AS _UNSIGNED LONG
STATIC have_table AS _BYTE
DIM crc AS _UNSIGNED LONG, k AS _UNSIGNED LONG
DIM i AS LONG, j AS LONG
IF have_table = 0 THEN
FOR i = 0 TO 255
k = i
FOR j = 0 TO 7
IF (k AND 1) THEN
k = _SHR(k, 1)
k = k XOR &HEDB88320
ELSE
k = _SHR(k, 1)
END IF
table(i) = k
NEXT
NEXT
have_table = -1
END IF
crc = NOT crc ' crc = &Hffffffff
FOR i = 1 TO LEN(buf)
crc = (_SHR(crc, 8)) XOR table((crc AND &HFF) XOR ASC(buf, i))
NEXT
crc32~& = NOT crc
END FUNCTION
SUB CircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
DIM x0 AS SINGLE, y0 AS SINGLE
DIM e AS SINGLE
x0 = R
y0 = 0
e = 0
DO WHILE y0 < x0
IF e <= 0 THEN
y0 = y0 + 1
LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
e = e + 2 * y0
ELSE
LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
x0 = x0 - 1
e = e - 2 * x0
END IF
LOOP
LINE (x - R, y)-(x + R, y), C, BF
END SUB
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION
SUB __UI_BeforeUnload
'If you set __UI_UnloadSignal = False here you can
'cancel the user's request to close.
END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE InFormUpdater
CASE RetryBT
SHARED ThisStep AS INTEGER
ThisStep = 1
Control(RetryBT).Hidden = True
Control(ActivityIndicator).Hidden = False
Report "Contacting server"
IF _FILEEXISTS("InFormUpdate.ini") THEN KILL "InFormUpdate.ini"
CASE CancelBT
IF Caption(CancelBT) = "Finish" THEN
DIM Answer AS _BYTE
IF _FILEEXISTS("UiEditor" + binaryExtension$) THEN
Answer = MessageBox("Launch InForm Designer?", "", MsgBox_YesNo + MsgBox_Question)
IF Answer = MsgBox_Yes THEN
SHELL _DONTWAIT pathAppend$ + "UiEditor" + binaryExtension$
END IF
END IF
END IF
SYSTEM
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
SELECT CASE id
END SELECT
END SUB
SUB __UI_MouseLeave (id AS LONG)
SELECT CASE id
END SELECT
END SUB
SUB __UI_FocusIn (id AS LONG)
SELECT CASE id
END SELECT
END SUB
SUB __UI_FocusOut (id AS LONG)
'This event occurs right before a control loses focus.
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
SELECT CASE id
END SELECT
END SUB
SUB __UI_MouseDown (id AS LONG)
SELECT CASE id
END SELECT
END SUB
SUB __UI_MouseUp (id AS LONG)
SELECT CASE id
END SELECT
END SUB
SUB __UI_KeyPress (id AS LONG)
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
'You can change it and even cancel it by making it = 0
SELECT CASE id
END SELECT
END SUB
SUB __UI_TextChanged (id AS LONG)
SELECT CASE id
END SELECT
END SUB
SUB __UI_ValueChanged (id AS LONG)
SELECT CASE id
END SELECT
END SUB
SUB __UI_FormResized
END SUB
'$INCLUDE:'../InForm.ui'

View file

@ -1,79 +0,0 @@
': This form was generated by
': InForm - GUI library for QB64 - Beta version 9
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
$EXEICON:'./../resources/updater.ico'
DIM __UI_NewID AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "InFormUpdater", 500, 425, 0, 0, 0)
SetCaption __UI_NewID, "InForm Updater"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).Font = SetFont("../resources/NotoMono-Regular.ttf", 12)
Control(__UI_NewID).CenteredWindow = True
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox2", 500, 150, 0, 0, 0)
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).BackColor = _RGB32(255, 255, 255)
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "InFormresourcesApplicationicon128PX", 128, 128, 10, 11, 0)
LoadImage Control(__UI_NewID), "../resources/Application-icon-128.png"
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).BackStyle = __UI_Transparent
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Label, "InFormLB", 258, 90, 199, 22, 0)
SetCaption __UI_NewID, "InForm"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).Font = SetFont("../resources/NotoMono-Regular.ttf", 72)
Control(__UI_NewID).BackStyle = __UI_Transparent
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Label, "forQB64LB", 152, 43, 305, 88, 0)
SetCaption __UI_NewID, "for QB64"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).Font = SetFont("../resources/NotoMono-Regular.ttf", 32)
Control(__UI_NewID).BackStyle = __UI_Transparent
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_ListBox, "ListBox1", 480, 224, 10, 159, 0)
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).AutoScroll = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "RetryBT", 80, 23, 10, 392, 0)
SetCaption __UI_NewID, "&Retry"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).Hidden = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBT", 80, 23, 410, 392, 0)
SetCaption __UI_NewID, "&Cancel"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "ActivityIndicator", 266, 32, 117, 388, 0)
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
END SUB
SUB __UI_AssignIDs
InFormUpdater = __UI_GetID("InFormUpdater")
PictureBox2 = __UI_GetID("PictureBox2")
InFormresourcesApplicationicon128PX = __UI_GetID("InFormresourcesApplicationicon128PX")
InFormLB = __UI_GetID("InFormLB")
forQB64LB = __UI_GetID("forQB64LB")
ListBox1 = __UI_GetID("ListBox1")
RetryBT = __UI_GetID("RetryBT")
CancelBT = __UI_GetID("CancelBT")
ActivityIndicator = __UI_GetID("ActivityIndicator")
END SUB

View file

@ -1,53 +1,38 @@
Option _Explicit
Option _ExplicitArray
$Console:Only
_Dest _Console
'$INCLUDE:'InFormVersion.bas'
' Damn!
Dim As Long i, row, percentage, eq, TextFileNum
Dim As String property, value, wdth, hght, caption, text, leftSide, top, disabled, backColorStr, foreColorStr
Dim As String hidden, controlType, control, controlName, iStr, controlList, caseAll, caseFocus, caseList
Dim As String caseTextBox, assignIDs, controlIDsDIM, Frame, newFile, newTextFile, theFile, a, FormName, o
Dim As String formBackColor, formForeColor
Dim As String * 1 lf, q
PRINT "InForm - GUI system for QB64 - "; __UI_Version
PRINT "VBDOS to InForm form conversion utility"
PRINT "-------------------------------------------------"
lf = Chr$(10)
q = Chr$(34)
DIM lf AS STRING * 1, q AS STRING * 1
lf = CHR$(10)
q = CHR$(34)
IF LEN(COMMAND$) > 0 THEN
IF _FILEEXISTS(COMMAND$) = 0 THEN PRINT "File not found.": END
theFile$ = COMMAND$
ELSE
DO
INPUT "File to convert (.frm):", theFile$
IF LEN(theFile$) = 0 THEN END
IF UCASE$(RIGHT$(theFile$, 4)) <> ".FRM" THEN theFile$ = theFile$ + ".FRM"
IF _FILEEXISTS(theFile$) = 0 THEN PRINT "File "; theFile$; " not found." ELSE EXIT DO
LOOP
END IF
OPEN theFile$ FOR BINARY AS #1
Print "InForm - GUI system for QB64 - "; __UI_Version
Print "VBDOS to InForm form conversion utility"
Print "-------------------------------------------------"
LINE INPUT #1, a$
IF a$ <> "Version 1.00" THEN
PRINT "Expected VBDOS text form file. Exiting."
END
END IF
If Len(Command$) > 0 Then
If _FileExists(Command$) = 0 Then Print "File not found.": End
theFile$ = Command$
Else
Do
Input "File to convert (.frm):", theFile$
If Len(theFile$) = 0 Then End
If UCase$(Right$(theFile$, 4)) <> ".FRM" Then theFile$ = theFile$ + ".FRM"
If _FileExists(theFile$) = 0 Then Print "File "; theFile$; " not found." Else Exit Do
Loop
End If
LINE INPUT #1, a$
IF LEFT$(a$, 11) <> "BEGIN Form " THEN
PRINT "Invalid VBDOS text form file. Exiting."
END
END IF
Open theFile$ For Binary As #1
Line Input #1, a$
If a$ <> "Version 1.00" Then
Print "Expected VBDOS text form file. Exiting."
End
End If
Line Input #1, a$
If Left$(a$, 11) <> "BEGIN Form " Then
Print "Invalid VBDOS text form file. Exiting."
End
End If
FormName$ = Mid$(a$, 12)
FormName$ = MID$(a$, 12)
o$ = "'InForm - GUI system for QB64 - " + __UI_Version
o$ = o$ + lf + "'Fellippe Heitor, " + __UI_CopyrightSpan + " - fellippe@qb64.org - @FellippeHeitor"
@ -58,224 +43,223 @@ o$ = o$ + lf + " DIM __UI_NewID AS LONG"
o$ = o$ + lf
o$ = o$ + lf + " __UI_NewID = __UI_NewControl(__UI_Type_Form, " + q + FormName$ + q + ", "
row = CsrLin
row = CSRLIN
Do
If EOF(1) Then Exit Do
Line Input #1, a$
Do While Left$(a$, 1) = Chr$(9)
a$ = Mid$(a$, 2)
Loop
percentage = (Seek(1) / LOF(1)) * 100
Locate row, 1: Color 7: Print String$(80, 176);
Locate row, 1: Color 11: Print String$((80 * percentage) / 100, 219);
Color 8
Locate row + 1, 1: Print Space$(80);
Locate row + 1, 1: Print a$;
Color 7
eq = InStr(a$, "=")
If eq Then
property$ = RTrim$(Left$(a$, eq - 1))
value$ = LTrim$(RTrim$(Mid$(a$, eq + 1)))
Select Case property$
Case "Width"
If Left$(value$, 5) = "Char(" Then wdth = Str$(Val(Mid$(value$, 6)) * _FontWidth + 5)
Case "Height"
If Left$(value$, 5) = "Char(" Then hght = Str$(Val(Mid$(value$, 6)) * _FontHeight + 15)
Case "BackColor"
If Left$(value$, 8) = "QBColor(" Then backColorStr = QBColor2QB64$(Val(Mid$(value$, 9)))
Case "ForeColor"
If Left$(value$, 8) = "QBColor(" Then foreColorStr = QBColor2QB64$(Val(Mid$(value$, 9)))
Case "Caption"
DO
IF EOF(1) THEN EXIT DO
LINE INPUT #1, a$
DO WHILE LEFT$(a$, 1) = CHR$(9)
a$ = MID$(a$, 2)
LOOP
percentage% = (SEEK(1) / LOF(1)) * 100
LOCATE row, 1: COLOR 7: PRINT STRING$(80, 176);
LOCATE row, 1: COLOR 11: PRINT STRING$((80 * percentage%) / 100, 219);
COLOR 8
LOCATE row + 1, 1: PRINT SPACE$(80);
LOCATE row + 1, 1: PRINT a$;
COLOR 7
eq = INSTR(a$, "=")
IF eq THEN
property$ = RTRIM$(LEFT$(a$, eq - 1))
value$ = LTRIM$(RTRIM$(MID$(a$, eq + 1)))
SELECT CASE property$
CASE "Width"
IF LEFT$(value$, 5) = "Char(" THEN width$ = STR$(VAL(MID$(value$, 6)) * _FONTWIDTH + 5)
CASE "Height"
IF LEFT$(value$, 5) = "Char(" THEN height$ = STR$(VAL(MID$(value$, 6)) * _FONTHEIGHT + 15)
CASE "BackColor"
IF LEFT$(value$, 8) = "QBColor(" THEN backColor$ = QBColor2QB64$(VAL(MID$(value$, 9)))
CASE "ForeColor"
IF LEFT$(value$, 8) = "QBColor(" THEN foreColor$ = QBColor2QB64$(VAL(MID$(value$, 9)))
CASE "Caption"
caption$ = value$
Case "Text"
CASE "Text"
text$ = value$
Case "Left"
If Left$(value$, 5) = "Char(" Then leftSide$ = Str$(Val(Mid$(value$, 6)) * _FontWidth + 5)
Case "Top"
If Left$(value$, 5) = "Char(" Then top$ = Str$(Val(Mid$(value$, 6)) * _FontHeight + 15)
Case "Enabled"
If value$ = "0" Then disabled$ = "True"
Case "Visible"
If value$ = "0" Then hidden$ = "True"
End Select
Else
Color 15
If Left$(a$, 6) = "BEGIN " Then
If Len(FormName$) Then
CASE "Left"
IF LEFT$(value$, 5) = "Char(" THEN leftSide$ = STR$(VAL(MID$(value$, 6)) * _FONTWIDTH + 5)
CASE "Top"
IF LEFT$(value$, 5) = "Char(" THEN top$ = STR$(VAL(MID$(value$, 6)) * _FONTHEIGHT + 15)
CASE "Enabled"
IF value$ = "0" THEN disabled$ = "True"
CASE "Visible"
IF value$ = "0" THEN hidden$ = "True"
END SELECT
ELSE
COLOR 15
IF LEFT$(a$, 6) = "BEGIN " THEN
IF LEN(FormName$) THEN
FormName$ = ""
o$ = o$ + wdth + "," + hght + ", 0, 0, 0)"
o$ = o$ + width$ + "," + height$ + ", 0, 0, 0)"
o$ = o$ + lf + " Control(__UI_NewID).Font = SetFont(" + q + q + ", 16, " + q + q + ")"
GoSub AddProperties
ElseIf controlType$ = "__UI_Type_Frame" Then
GoSub FinishFrame
End If
control$ = Mid$(a$, 7)
controlType$ = Left$(control$, InStr(control$, " ") - 1)
controlName$ = Mid$(control$, InStr(control$, " ") + 1)
i = 1: iStr = ""
Do While InStr(controlList$, "$" + controlName$ + iStr + "$") > 0
i = i + 1: iStr = LTrim$(Str$(i))
Loop
controlName$ = controlName$ + iStr
GOSUB AddProperties
ELSEIF controlType$ = "__UI_Type_Frame" THEN
GOSUB FinishFrame
END IF
control$ = MID$(a$, 7)
controlType$ = LEFT$(control$, INSTR(control$, " ") - 1)
controlName$ = MID$(control$, INSTR(control$, " ") + 1)
i = 1: i$ = ""
DO WHILE INSTR(controlList$, "$" + controlName$ + i$ + "$") > 0
i = i + 1: i$ = LTRIM$(STR$(i))
LOOP
controlName$ = controlName$ + i$
controlList$ = controlList$ + "$" + controlName$ + "$"
caseAll$ = caseAll$ + " CASE " + controlName$ + lf + lf
Select Case controlType$
Case "Label"
SELECT CASE controlType$
CASE "Label"
controlType$ = "__UI_Type_Label"
Case "ComboBox", "DriveListBox"
CASE "ComboBox", "DriveListBox"
controlType$ = "__UI_Type_DropdownList"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
Case "CommandButton"
CASE "CommandButton"
controlType$ = "__UI_Type_Button"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
Case "ListBox", "DirListBox", "FileListBox"
CASE "ListBox", "DirListBox", "FileListBox"
controlType$ = "__UI_Type_ListBox"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
caseList$ = caseList$ + " CASE " + controlName$ + lf + lf
Case "Frame"
CASE "Frame"
controlType$ = "__UI_Type_Frame"
Case "CheckBox"
CASE "CheckBox"
controlType$ = "__UI_Type_CheckBox"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
Case "OptionButton"
CASE "OptionButton"
controlType$ = "__UI_Type_RadioButton"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
Case "PictureBox"
CASE "PictureBox"
controlType$ = "__UI_Type_PictureBox"
Case "TextBox"
CASE "TextBox"
controlType$ = "__UI_Type_TextBox"
caseFocus$ = caseFocus$ + " CASE " + controlName$ + lf + lf
caseTextBox$ = caseTextBox$ + " CASE " + controlName$ + lf + lf
Case Else
CASE ELSE
controlType$ = "__UI_Type_PictureBox"
End Select
END SELECT
assignIDs$ = assignIDs$ + lf + " " + controlName$ + " = __UI_GetID(" + q + controlName$ + q + ")"
controlIDsDIM$ = controlIDsDIM$ + lf + "DIM SHARED " + controlName$ + " AS LONG"
If controlType$ = "__UI_Type_Frame" Then
IF controlType$ = "__UI_Type_Frame" THEN
Frame$ = controlName$
control$ = ""
End If
ElseIf a$ = "END" Then
If Len(control$) > 0 Then
END IF
ELSEIF a$ = "END" THEN
IF LEN(control$) > 0 THEN
FinishFrame:
o$ = o$ + lf + " __UI_NewID = __UI_NewControl(" + controlType$ + ", " + q + controlName$ + q + ", "
o$ = o$ + wdth + "," + hght + ", " + leftSide$ + ", " + top$ + ", "
If Len(Frame$) > 0 And controlType$ <> "__UI_Type_Frame" Then
o$ = o$ + width$ + "," + height$ + ", " + leftSide$ + ", " + top$ + ", "
IF LEN(Frame$) > 0 AND controlType$ <> "__UI_Type_Frame" THEN
o$ = o$ + "__UI_GetID(" + q + Frame$ + q + "))"
Else
ELSE
o$ = o$ + "0)"
End If
GoSub AddProperties
END IF
GOSUB AddProperties
control$ = ""
If controlType$ = "__UI_Type_Frame" Then Return
Else
If Len(Frame$) Then
IF controlType$ = "__UI_Type_Frame" THEN RETURN
ELSE
IF LEN(Frame$) THEN
Frame$ = ""
Else
Exit Do
End If
End If
End If
End If
_Limit 500
Loop
ELSE
EXIT DO
END IF
END IF
END IF
END IF
_LIMIT 500
LOOP
o$ = o$ + lf + "END SUB"
o$ = o$ + lf
o$ = o$ + lf + "SUB __UI_AssignIDs"
o$ = o$ + assignIDs$
o$ = o$ + lf + "END SUB"
newFile$ = Left$(theFile$, InStr(theFile$, ".") - 1) + "_InForm.frm"
Close
Open newFile$ For Binary As #1
Put #1, , o$
Close
TextFileNum = FreeFile
newTextFile$ = Left$(theFile$, InStr(theFile$, ".") - 1) + "_InForm.bas"
Open newTextFile$ For Output As #TextFileNum
Print #TextFileNum, "': This program was generated by"
Print #TextFileNum, "': InForm - GUI system for QB64 - "; __UI_Version
Print #TextFileNum, "': Fellippe Heitor, " + __UI_CopyrightSpan + " - fellippe@qb64.org - @fellippeheitor"
Print #TextFileNum, "'-----------------------------------------------------------"
Print #TextFileNum,
Print #TextFileNum, "': Controls' IDs: ------------------------------------------------------------------";
Print #TextFileNum, controlIDsDIM$
Print #TextFileNum,
Print #TextFileNum, "': External modules: ---------------------------------------------------------------"
Print #TextFileNum, "'$INCLUDE:'InForm\InForm.ui'"
Print #TextFileNum, "'$INCLUDE:'InForm\xp.uitheme'"
Print #TextFileNum, "'$INCLUDE:'" + newFile$ + "'"
Print #TextFileNum,
Print #TextFileNum, "': Event procedures: ---------------------------------------------------------------"
For i = 0 To 14
Select EveryCase i
Case 0: Print #TextFileNum, "SUB __UI_BeforeInit"
Case 1: Print #TextFileNum, "SUB __UI_OnLoad"
Case 2: Print #TextFileNum, "SUB __UI_BeforeUpdateDisplay"
Case 3: Print #TextFileNum, "SUB __UI_BeforeUnload"
Case 4: Print #TextFileNum, "SUB __UI_Click (id AS LONG)"
Case 5: Print #TextFileNum, "SUB __UI_MouseEnter (id AS LONG)"
Case 6: Print #TextFileNum, "SUB __UI_MouseLeave (id AS LONG)"
Case 7: Print #TextFileNum, "SUB __UI_FocusIn (id AS LONG)"
Case 8: Print #TextFileNum, "SUB __UI_FocusOut (id AS LONG)"
Case 9: Print #TextFileNum, "SUB __UI_MouseDown (id AS LONG)"
Case 10: Print #TextFileNum, "SUB __UI_MouseUp (id AS LONG)"
Case 11: Print #TextFileNum, "SUB __UI_KeyPress (id AS LONG)"
Case 12: Print #TextFileNum, "SUB __UI_TextChanged (id AS LONG)"
Case 13: Print #TextFileNum, "SUB __UI_ValueChanged (id AS LONG)"
Case 14: Print #TextFileNum, "SUB __UI_FormResized"
newFile$ = LEFT$(theFile$, INSTR(theFile$, ".") - 1) + "_InForm.frm"
CLOSE
OPEN newFile$ FOR BINARY AS #1
PUT #1, , o$
CLOSE
TextFileNum = FREEFILE
newTextFile$ = LEFT$(theFile$, INSTR(theFile$, ".") - 1) + "_InForm.bas"
OPEN newTextFile$ FOR OUTPUT AS #TextFileNum
PRINT #TextFileNum, "': This program was generated by"
PRINT #TextFileNum, "': InForm - GUI system for QB64 - "; __UI_Version
PRINT #TextFileNum, "': Fellippe Heitor, " + __UI_CopyrightSpan + " - fellippe@qb64.org - @fellippeheitor"
PRINT #TextFileNum, "'-----------------------------------------------------------"
PRINT #TextFileNum,
PRINT #TextFileNum, "': Controls' IDs: ------------------------------------------------------------------";
PRINT #TextFileNum, controlIDsDIM$
PRINT #TextFileNum,
PRINT #TextFileNum, "': External modules: ---------------------------------------------------------------"
PRINT #TextFileNum, "'$INCLUDE:'InForm\InForm.ui'"
PRINT #TextFileNum, "'$INCLUDE:'InForm\xp.uitheme'"
PRINT #TextFileNum, "'$INCLUDE:'" + newFile$ + "'"
PRINT #TextFileNum,
PRINT #TextFileNum, "': Event procedures: ---------------------------------------------------------------"
FOR i = 0 TO 14
SELECT EVERYCASE i
CASE 0: PRINT #TextFileNum, "SUB __UI_BeforeInit"
CASE 1: PRINT #TextFileNum, "SUB __UI_OnLoad"
CASE 2: PRINT #TextFileNum, "SUB __UI_BeforeUpdateDisplay"
CASE 3: PRINT #TextFileNum, "SUB __UI_BeforeUnload"
CASE 4: PRINT #TextFileNum, "SUB __UI_Click (id AS LONG)"
CASE 5: PRINT #TextFileNum, "SUB __UI_MouseEnter (id AS LONG)"
CASE 6: PRINT #TextFileNum, "SUB __UI_MouseLeave (id AS LONG)"
CASE 7: PRINT #TextFileNum, "SUB __UI_FocusIn (id AS LONG)"
CASE 8: PRINT #TextFileNum, "SUB __UI_FocusOut (id AS LONG)"
CASE 9: PRINT #TextFileNum, "SUB __UI_MouseDown (id AS LONG)"
CASE 10: PRINT #TextFileNum, "SUB __UI_MouseUp (id AS LONG)"
CASE 11: PRINT #TextFileNum, "SUB __UI_KeyPress (id AS LONG)"
CASE 12: PRINT #TextFileNum, "SUB __UI_TextChanged (id AS LONG)"
CASE 13: PRINT #TextFileNum, "SUB __UI_ValueChanged (id AS LONG)"
CASE 14: PRINT #TextFileNum, "SUB __UI_FormResized"
Case 0 To 3, 14
Print #TextFileNum,
CASE 0 TO 3, 14
PRINT #TextFileNum,
Case 4 To 6, 9, 10 'All controls except for Menu panels, and internal context menus
Print #TextFileNum, " SELECT CASE id"
Print #TextFileNum, caseAll$;
Print #TextFileNum, " END SELECT"
CASE 4 TO 6, 9, 10 'All controls except for Menu panels, and internal context menus
PRINT #TextFileNum, " SELECT CASE id"
PRINT #TextFileNum, caseAll$;
PRINT #TextFileNum, " END SELECT"
Case 7, 8, 11 'Controls that can have focus only
Print #TextFileNum, " SELECT CASE id"
Print #TextFileNum, caseFocus$;
Print #TextFileNum, " END SELECT"
CASE 7, 8, 11 'Controls that can have focus only
PRINT #TextFileNum, " SELECT CASE id"
PRINT #TextFileNum, caseFocus$;
PRINT #TextFileNum, " END SELECT"
Case 12 'Text boxes
Print #TextFileNum, " SELECT CASE id"
Print #TextFileNum, caseTextBox$;
Print #TextFileNum, " END SELECT"
CASE 12 'Text boxes
PRINT #TextFileNum, " SELECT CASE id"
PRINT #TextFileNum, caseTextBox$;
PRINT #TextFileNum, " END SELECT"
Case 13 'Dropdown list, List box and Track bar
Print #TextFileNum, " SELECT CASE id"
Print #TextFileNum, caseList$;
Print #TextFileNum, " END SELECT"
End Select
Print #TextFileNum, "END SUB"
Print #TextFileNum,
Next
Close #TextFileNum
Locate row, 1: Color 11: Print String$(80, 219);
Color 15
Print
Print "Conversion finished. Files output:"
Print " "; newFile$
Print " "; newTextFile$
End
CASE 13 'Dropdown list, List box and Track bar
PRINT #TextFileNum, " SELECT CASE id"
PRINT #TextFileNum, caseList$;
PRINT #TextFileNum, " END SELECT"
END SELECT
PRINT #TextFileNum, "END SUB"
PRINT #TextFileNum,
NEXT
CLOSE #TextFileNum
LOCATE row, 1: COLOR 11: PRINT STRING$(80, 219);
COLOR 15
PRINT
PRINT "Conversion finished. Files output:"
PRINT " "; newFile$
PRINT " "; newTextFile$
END
AddProperties:
If Len(caption$) Then o$ = o$ + lf + " SetCaption __UI_NewID, " + caption$: caption$ = ""
If Len(FormName$) = 0 Then
If backColorStr = formBackColor$ Then backColorStr = ""
If foreColorStr = formForeColor$ Then foreColorStr = ""
End If
If Len(backColorStr) Then o$ = o$ + lf + " Control(__UI_NewID).BackColor = " + backColorStr: If control$ = "" Then formBackColor$ = backColorStr: backColorStr = ""
If Len(foreColorStr) Then o$ = o$ + lf + " Control(__UI_NewID).ForeColor = " + foreColorStr: If control$ = "" Then formForeColor$ = foreColorStr: foreColorStr = ""
If Len(text$) Then o$ = o$ + lf + " Text(__UI_NewID) = " + text$: text$ = ""
If Len(disabled$) Then o$ = o$ + lf + " Control(__UI_NewID).Disabled = True": disabled$ = ""
If Len(hidden$) Then o$ = o$ + lf + " Control(__UI_NewID).Hidden = True": hidden$ = ""
IF LEN(caption$) THEN o$ = o$ + lf + " SetCaption __UI_NewID, " + caption$: caption$ = ""
IF LEN(FormName$) = 0 THEN
IF backColor$ = formBackColor$ THEN backColor$ = ""
IF foreColor$ = formForeColor$ THEN foreColor$ = ""
END IF
IF LEN(backColor$) THEN o$ = o$ + lf + " Control(__UI_NewID).BackColor = " + backColor$: IF control$ = "" THEN formBackColor$ = backColor$: backColor$ = ""
IF LEN(foreColor$) THEN o$ = o$ + lf + " Control(__UI_NewID).ForeColor = " + foreColor$: IF control$ = "" THEN formForeColor$ = foreColor$: foreColor$ = ""
IF LEN(text$) THEN o$ = o$ + lf + " Text(__UI_NewID) = " + text$: text$ = ""
IF LEN(disabled$) THEN o$ = o$ + lf + " Control(__UI_NewID).Disabled = True": disabled$ = ""
IF LEN(hidden$) THEN o$ = o$ + lf + " Control(__UI_NewID).Hidden = True": hidden$ = ""
o$ = o$ + lf
Return
Function QBColor2QB64$ (index As _Byte)
QBColor2QB64$ = "_RGB32(" + LTrim$(Str$(_Red(index))) + ", " + LTrim$(Str$(_Green(index))) + ", " + LTrim$(Str$(_Blue(index))) + ")"
End Function
RETURN
FUNCTION QBColor2QB64$ (index AS _BYTE)
QBColor2QB64$ = "_RGB32(" + LTRIM$(STR$(_RED(index))) + ", " + LTRIM$(STR$(_GREEN(index))) + ", " + LTRIM$(STR$(_BLUE(index))) + ")"
END FUNCTION

View file

@ -1,47 +0,0 @@
# Makefile for InForm
# Copyright (c) 2022 Samuel Gomes
ifndef OS
$(error "OS must be set to 'lnx', 'win', or 'osx'")
endif
ifeq ($(OS),lnx)
RM := rm -fr
EXTENSION :=
endif
ifeq ($(OS),win)
RM := del /Q
EXTENSION := .exe
endif
ifeq ($(OS),osx)
RM := rm -fr
EXTENSION :=
endif
# This should point to your QB64 installation
QB64PE_PATH := ../QB64pe/
QB64PE := qb64pe
QB64PE_FLAGS := -x -w -e
.PHONY: all clean
all: UiEditor$(EXTENSION) InForm/UiEditorPreview$(EXTENSION) InForm/vbdos2inform$(EXTENSION)
UiEditor$(EXTENSION) : InForm/UiEditor.bas
$(QB64PE_PATH)$(QB64PE)$(EXTENSION) $(QB64PE_FLAGS) $< -o $@
InForm/UiEditorPreview$(EXTENSION) : InForm/UiEditorPreview.bas
$(QB64PE_PATH)$(QB64PE)$(EXTENSION) $(QB64PE_FLAGS) $< -o $@
InForm/vbdos2inform$(EXTENSION) : InForm/vbdos2inform.bas
$(QB64PE_PATH)$(QB64PE)$(EXTENSION) $(QB64PE_FLAGS) $< -o $@
clean:
ifeq ($(OS),win)
$(RM) UiEditor$(EXTENSION) InForm\UiEditorPreview$(EXTENSION) InForm\vbdos2inform$(EXTENSION)
else
$(RM) UiEditor$(EXTENSION) InForm/UiEditorPreview$(EXTENSION) InForm/vbdos2inform$(EXTENSION)
endif

68
makefile.inform Normal file
View file

@ -0,0 +1,68 @@
# Makefile for InForm
# Copyright (c) 2022 Samuel Gomes
#MAKEFLAGS += --no-builtin-rules
ifndef OS
$(error "OS must be set to 'lnx', 'win', or 'osx'")
endif
ifeq ($(OS),lnx)
RM := rm -fr
EXTENSION :=
DIR_SLASH := /
endif
ifeq ($(OS),win)
RM := del /Q
EXTENSION := .exe
DIR_SLASH := /
endif
ifeq ($(OS),osx)
RM := rm -fr
EXTENSION :=
DIR_SLASH := \\
endif
# This should point to your QB64 installation
FILE1 := qb64
FILE2 := qb64pe
ROOT_DIR := $(patsubst %/,%,$(dir $(abspath $(lastword $(MAKEFILE_LIST)))))
ifeq (,$(wildcard $(FILE1)$(EXTENSION)))
QB64 := $(FILE2)
else ifeq (,$(wildcard $(FILE2)$(EXTENSION)))
QB64 := $(FILE1)
endif
QB64PE_FLAGS := -x -p
ROOT_PATH := $(ROOT_DIR)$(DIR_SLASH)
INFORM_PATH := InForm$(DIR_SLASH)
UiEditorSRC := UiEditor.bas
UiEditorEXE := UiEditor$(EXTENSION)
UiEditorPreviewSRC := UiEditorPreview.bas
UiEditorPreviewEXE := UiEditorPreview$(EXTENSION)
.PHONY: all clean
all: $(UiEditorEXE) $(UiEditorPreviewEXE)
$(UiEditorEXE) : $(INFORM_PATH)$(UiEditorSRC)
$(ROOT_PATH)$(QB64)$(EXTENSION) $(QB64PE_FLAGS) -o $(INFORM_PATH)$(UiEditorEXE) $(INFORM_PATH)$(UiEditorSRC)
strip $(INFORM_PATH)$(UiEditorEXE)
$(UiEditorPreviewEXE): $(INFORM_PATH)$(UiEditorPreviewSRC)
$(ROOT_PATH)$(QB64)$(EXTENSION) $(QB64PE_FLAGS) -s:exewithsource=true -o $(INFORM_PATH)$(UiEditorPreviewEXE) $(INFORM_PATH)$(UiEditorPreviewSRC)
strip $(INFORM_PATH)$(UiEditorPreviewEXE)
clean:
ifeq ($(OS),win)
$(RM) InForm\UiEditor$(EXTENSION) InForm\UiEditorPreview$(EXTENSION) InForm\vbdos2inform$(EXTENSION)
else
$(RM) InForm/UiEditor$(EXTENSION) InForm/UiEditorPreview$(EXTENSION) InForm/vbdos2inform$(EXTENSION)
endif

31
setup_inform_lnx.sh Executable file
View file

@ -0,0 +1,31 @@
#!/bin/bash
# InForm for QB64-PE Setup script
cd "$(dirname "$0")"
echo "Compiling InForm..."
make -f makefile.inform clean OS=lnx
make -f makefile.inform OS=lnx
if [ -e "./InForm/UiEditor" ]; then
echo "Adding InForm menu entry..."
cat > ~/.local/share/applications/qb64-inform.desktop <<EOF
[Desktop Entry]
Name=QB64 InForm GUI Designer
GenericName=QB64 InForm GUI Designer
Exec=$_pwd/InForm/UiEditor
Icon=$_pwd/InForm/resources/InForm.ico
Terminal=false
Type=Application
Categories=Development;IDE;GUI
Path=$_pwd
StartupNotify=false
EOF
echo "Running InForm Designer..."
cd InForm
./UiEditor &
else
echo "Compilation failed."
echo "Make sure you unpacked all files in QB64's folder, preserving the directory structure and also that you have the latest version of QB64 to use InForm."
fi

55
setup_inform_osx.command Executable file
View file

@ -0,0 +1,55 @@
cd "$(dirname "$0")"
# InForm for QB64/QB64PE - Setup script
### Perform CLEAN function
rm -fr InForm/UiEditor InForm/UiEditor_start.command InForm/UiEditorPreview InForm/UiEditorPreview_start.command
### Install if QB64 is found
if [ -e "./qb64" ]; then
echo "Compiling InForm..."
./qb64 -x -p ./InForm/UiEditor.bas -o ./InForm/UiEditor
./qb64 -x -p ./InForm/UiEditorPreview.bas -s:exewithsource=true -o ./InForm/UiEditorPreview
cd InForm
if [ -e "./UiEditor" ]; then
echo "Running InForm Designer..."
./UiEditor &
echo
echo "Thank you for choosing InForm for QB64."
osascript -e 'tell application "Terminal" to close (every window whose name contains "UiEditor_start.command")' &
osascript -e 'if (count the windows of application "Terminal") is 0 then tell application "Terminal" to quit' &
exit 0
else
echo "Compilation failed."
echo "Make sure you unpacked all files in QB64's folder, preserving the directory structure, and also that you have QB64 to use InForm."
exit 1
fi
### Install if Q64PE is found
elif [ -e "./qb64pe" ]; then
echo "Compiling InForm..."
./qb64pe -x -p ./InForm/UiEditor.bas -o ./InForm/UiEditor
./qb64pe -x -p ./InForm/UiEditorPreview.bas -s:exewithsource=true -o ./InForm/UiEditorPreview
cd InForm
if [ -e "./UiEditor" ]; then
echo "Running InForm Designer..."
./UiEditor &
echo
echo "Thank you for choosing InForm for QB64PE."
osascript -e 'tell application "Terminal" to close (every window whose name contains "UiEditor_start.command")' &
osascript -e 'if (count the windows of application "Terminal") is 0 then tell application "Terminal" to quit' &
exit 0
else
echo "Compilation failed."
echo "Make sure you unpacked all files in QB64PE's folder, preserving the directory structure, and also that you have QB64PE to use InForm."
exit 1
fi
### If neither QB64 or QB64PE is found, message and error out.
else
echo "Compilation failed."
echo "Make sure you have either QB64 or QB64PE installed to use InForm."
exit 1
fi
exit 0

30
setup_inform_win.cmd Normal file
View file

@ -0,0 +1,30 @@
@rem InForm for QB64-PE Setup script
@echo off
%~d0
cd %~dp0
rem Clean old .exe files from InForm
del /Q InForm\UiEditor.exe InForm\UiEditorPreview.exe
rem Check for which compiler for use in your QB64/QB64pe installation
echo Compiling InForm...
if exist qb64.exe (
qb64 -x -p -o InForm/UiEditor.exe InForm/UiEditor.bas
qb64 -x -p -s:exewithsource=true -o InForm/UiEditorPreview.exe InForm/UiEditorPreview.bas
cd InForm
UiEditor
goto end)
if exist qb64pe.exe (
qb64pe -x -p -o InForm/UiEditor.exe InForm/UiEditor.bas
qb64pe -x -p -s:exewithsource=true -o InForm/UiEditorPreview.exe InForm/UiEditorPreview.bas
cd InForm
UiEditor
goto end)
echo qb64 or qb64pe not found. Setup Terminated.
:end
endlocal

View file

@ -1,8 +0,0 @@
#!/bin/bash
# InForm for QB64-PE Setup script
cd "$(dirname "$0")"
echo "Compiling InForm..."
make clean OS=lnx
make OS=lnx

View file

@ -1,7 +0,0 @@
# InForm for QB64-PE Setup script
cd "$(dirname "$0")"
echo "Compiling InForm..."
make clean OS=osx
make OS=osx

View file

@ -1,10 +0,0 @@
@rem InForm for QB64-PE Setup script
@echo off
%~d0
cd %~dp0
rem Adjust the path below to point to mingw32-make.exe in your QB64 installation
echo Compiling InForm...
..\QB64pe\internal\c\c_compiler\bin\mingw32-make.exe clean OS=win
..\QB64pe\internal\c\c_compiler\bin\mingw32-make.exe OS=win