1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2025-01-15 11:59:34 +00:00

UiEditor will now incrementally add new controls to the .bas source too.

Up until v1.2, overwriting an existing .bas/.frm project would result in 2 extra backup files and the code in the .bas would remain unaltered - that is, the DIM SHARED block with control declarations would be adapted but all SELECT CASE blocks would lack the new controls added since the last edits.

With this patch the existing .bas file is considered and SELECT CASE blocks are also updated with newly added controls.
This commit is contained in:
FellippeHeitor 2020-11-01 02:42:06 -03:00
parent f56ada72cc
commit 8a279744ef
2 changed files with 237 additions and 137 deletions

View file

@ -1110,7 +1110,7 @@ SUB __UI_UpdateDisplay
EXIT SUB EXIT SUB
END IF END IF
ON ERROR GOTO __UI_ErrorHandler 'ON ERROR GOTO __UI_ErrorHandler
'Clear frames canvases and count its children; 'Clear frames canvases and count its children;
FOR i = 1 TO UBOUND(Control) FOR i = 1 TO UBOUND(Control)

View file

@ -4251,12 +4251,10 @@ SUB SaveForm (ExitToQB64 AS _BYTE, SaveOnlyFrm AS _BYTE)
CLOSE #TextFileNum CLOSE #TextFileNum
IF i = 1 THEN IF i = 1 THEN
IF INSTR(b$, "': Event procedures: ---------------------------------------------------------------") > 0 THEN BackupCode$ = Replace$(b$, CHR$(13) + CHR$(10), CHR$(10), 0, 0)
BackupCode$ = MID$(b$, INSTR(b$, "': Event procedures: ---------------------------------------------------------------"))
PreserveBackup = True PreserveBackup = True
END IF END IF
END IF END IF
END IF
NEXT NEXT
TextFileNum = FREEFILE TextFileNum = FREEFILE
@ -4350,17 +4348,17 @@ SUB SaveForm (ExitToQB64 AS _BYTE, SaveOnlyFrm AS _BYTE)
IF LEN(PreviewTexts(i)) > 0 THEN IF LEN(PreviewTexts(i)) > 0 THEN
SELECT CASE PreviewControls(i).Type SELECT CASE PreviewControls(i).Type
CASE __UI_Type_ListBox, __UI_Type_DropdownList CASE __UI_Type_ListBox, __UI_Type_DropdownList
DIM TempCaption$, TempText$, FindLF&, ThisItem%, ThisItemTop% DIM TempCaption$, TempText$, ThisItem%, ThisItemTop%
DIM LastVisibleItem AS INTEGER DIM LastVisibleItem AS INTEGER, findLF&
TempText$ = PreviewTexts(i) TempText$ = PreviewTexts(i)
ThisItem% = 0 ThisItem% = 0
DO WHILE LEN(TempText$) DO WHILE LEN(TempText$)
ThisItem% = ThisItem% + 1 ThisItem% = ThisItem% + 1
FindLF& = INSTR(TempText$, CHR$(10)) findLF& = INSTR(TempText$, CHR$(10))
IF FindLF& THEN IF findLF& THEN
TempCaption$ = LEFT$(TempText$, FindLF& - 1) TempCaption$ = LEFT$(TempText$, findLF& - 1)
TempText$ = MID$(TempText$, FindLF& + 1) TempText$ = MID$(TempText$, findLF& + 1)
ELSE ELSE
TempCaption$ = TempText$ TempCaption$ = TempText$
TempText$ = "" TempText$ = ""
@ -4561,6 +4559,121 @@ SUB SaveForm (ExitToQB64 AS _BYTE, SaveOnlyFrm AS _BYTE)
PRINT #TextFileNum, "END SUB" PRINT #TextFileNum, "END SUB"
CLOSE #TextFileNum CLOSE #TextFileNum
IF NOT SaveOnlyFrm THEN IF NOT SaveOnlyFrm THEN
IF PreserveBackup THEN
DIM insertionPoint AS LONG, endPoint AS LONG, firstCASE AS LONG
DIM temp$, thisBlock$, addedCASES$, indenting AS LONG
'Find insertion points in BackupCode$ for eventual new controls
'1- Controls' IDs
insertionPoint = INSTR(BackupCode$, "DIM SHARED ")
FOR i = 1 TO UBOUND(PreviewControls)
IF PreviewControls(i).ID > 0 AND PreviewControls(i).Type <> __UI_Type_Font AND PreviewControls(i).Type <> __UI_Type_MenuPanel THEN
temp$ = "DIM SHARED " + RTRIM$(__UI_TrimAt0$(PreviewControls(i).Name)) + " AS LONG"
IF INSTR(BackupCode$, temp$) = 0 THEN
BackupCode$ = LEFT$(BackupCode$, insertionPoint - 1) + temp$ + CHR$(10) + MID$(BackupCode$, insertionPoint)
END IF
END IF
NEXT
'2- Even procedures
FOR i = 4 TO 13
SELECT EVERYCASE i
CASE 4: temp$ = "SUB __UI_Click (id AS LONG)"
CASE 5: temp$ = "SUB __UI_MouseEnter (id AS LONG)"
CASE 6: temp$ = "SUB __UI_MouseLeave (id AS LONG)"
CASE 7: temp$ = "SUB __UI_FocusIn (id AS LONG)"
CASE 8: temp$ = "SUB __UI_FocusOut (id AS LONG)"
CASE 9: temp$ = "SUB __UI_MouseDown (id AS LONG)"
CASE 10: temp$ = "SUB __UI_MouseUp (id AS LONG)"
CASE 11: temp$ = "SUB __UI_KeyPress (id AS LONG)"
CASE 12: temp$ = "SUB __UI_TextChanged (id AS LONG)"
CASE 13: temp$ = "SUB __UI_ValueChanged (id AS LONG)"
CASE 4 TO 13
insertionPoint = INSTR(BackupCode$, temp$)
endPoint = INSTR(insertionPoint, BackupCode$, "END SUB" + CHR$(10)) + 8
thisBlock$ = MID$(BackupCode$, insertionPoint, endPoint - insertionPoint)
CASE 4 TO 6, 9, 10 'All controls except for Menu panels, and internal context menus
IF INSTR(thisBlock$, "SELECT CASE id") THEN
firstCASE = _INSTRREV(INSTR(thisBlock$, " CASE "), thisBlock$, CHR$(10))
indenting = INSTR(firstCASE, thisBlock$, "CASE ") - firstCASE - 1
addedCASES$ = ""
IF firstCASE = 0 THEN firstCASE = INSTR(thisBlock$, " SELECT CASE id") + 2
FOR Dummy = 1 TO UBOUND(PreviewControls)
IF PreviewControls(Dummy).ID > 0 AND PreviewControls(Dummy).Type <> __UI_Type_Font AND PreviewControls(Dummy).Type <> __UI_Type_ContextMenu THEN
IF INSTR(thisBlock$, " CASE " + RTRIM$(PreviewControls(Dummy).Name) + CHR$(10)) = 0 THEN
addedCASES$ = addedCASES$ + SPACE$(indenting) + "CASE " + RTRIM$(PreviewControls(Dummy).Name) + CHR$(10) + CHR$(10)
END IF
END IF
NEXT
IF LEN(addedCASES$) THEN
thisBlock$ = LEFT$(thisBlock$, firstCASE) + addedCASES$ + MID$(thisBlock$, firstCASE + 1)
END IF
END IF
BackupCode$ = LEFT$(BackupCode$, insertionPoint - 1) + thisBlock$ + MID$(BackupCode$, endPoint)
CASE 7, 8, 11 'Controls that can have focus only
IF INSTR(thisBlock$, "SELECT CASE id") THEN
firstCASE = _INSTRREV(INSTR(thisBlock$, " CASE "), thisBlock$, CHR$(10))
indenting = INSTR(firstCASE, thisBlock$, "CASE ") - firstCASE - 1
addedCASES$ = ""
IF firstCASE = 0 THEN firstCASE = INSTR(thisBlock$, " SELECT CASE id") + 2
FOR Dummy = 1 TO UBOUND(PreviewControls)
IF PreviewControls(Dummy).ID > 0 AND PreviewControls(Dummy).CanHaveFocus THEN
IF INSTR(thisBlock$, " CASE " + RTRIM$(PreviewControls(Dummy).Name) + CHR$(10)) = 0 THEN
addedCASES$ = addedCASES$ + SPACE$(indenting) + "CASE " + RTRIM$(PreviewControls(Dummy).Name) + CHR$(10) + CHR$(10)
END IF
END IF
NEXT
IF LEN(addedCASES$) THEN
thisBlock$ = LEFT$(thisBlock$, firstCASE) + addedCASES$ + MID$(thisBlock$, firstCASE + 1)
END IF
END IF
BackupCode$ = LEFT$(BackupCode$, insertionPoint - 1) + thisBlock$ + MID$(BackupCode$, endPoint)
CASE 12 'Text boxes
IF INSTR(thisBlock$, "SELECT CASE id") THEN
firstCASE = _INSTRREV(INSTR(thisBlock$, " CASE "), thisBlock$, CHR$(10))
indenting = INSTR(firstCASE, thisBlock$, "CASE ") - firstCASE - 1
addedCASES$ = ""
IF firstCASE = 0 THEN firstCASE = INSTR(thisBlock$, " SELECT CASE id") + 2
FOR Dummy = 1 TO UBOUND(PreviewControls)
IF PreviewControls(Dummy).ID > 0 AND (PreviewControls(Dummy).Type = __UI_Type_TextBox) THEN
IF INSTR(thisBlock$, " CASE " + RTRIM$(PreviewControls(Dummy).Name) + CHR$(10)) = 0 THEN
addedCASES$ = addedCASES$ + SPACE$(indenting) + "CASE " + RTRIM$(PreviewControls(Dummy).Name) + CHR$(10) + CHR$(10)
END IF
END IF
NEXT
IF LEN(addedCASES$) THEN
thisBlock$ = LEFT$(thisBlock$, firstCASE) + addedCASES$ + MID$(thisBlock$, firstCASE + 1)
END IF
END IF
BackupCode$ = LEFT$(BackupCode$, insertionPoint - 1) + thisBlock$ + MID$(BackupCode$, endPoint)
CASE 13 'Dropdown list, List box, Track bar, ToggleSwitch, CheckBox
IF INSTR(thisBlock$, "SELECT CASE id") THEN
firstCASE = _INSTRREV(INSTR(thisBlock$, " CASE "), thisBlock$, CHR$(10))
indenting = INSTR(firstCASE, thisBlock$, "CASE ") - firstCASE - 1
addedCASES$ = ""
IF firstCASE = 0 THEN firstCASE = INSTR(thisBlock$, " SELECT CASE id") + 2
FOR Dummy = 1 TO UBOUND(PreviewControls)
IF PreviewControls(Dummy).ID > 0 AND (PreviewControls(Dummy).Type = __UI_Type_ListBox OR PreviewControls(Dummy).Type = __UI_Type_DropdownList OR PreviewControls(Dummy).Type = __UI_Type_TrackBar OR PreviewControls(Dummy).Type = __UI_Type_ToggleSwitch OR PreviewControls(Dummy).Type = __UI_Type_CheckBox OR PreviewControls(Dummy).Type = __UI_Type_RadioButton) THEN
IF INSTR(thisBlock$, " CASE " + RTRIM$(PreviewControls(Dummy).Name) + CHR$(10)) = 0 THEN
addedCASES$ = addedCASES$ + SPACE$(indenting) + "CASE " + RTRIM$(PreviewControls(Dummy).Name) + CHR$(10) + CHR$(10)
END IF
END IF
NEXT
IF LEN(addedCASES$) THEN
thisBlock$ = LEFT$(thisBlock$, firstCASE) + addedCASES$ + MID$(thisBlock$, firstCASE + 1)
END IF
END IF
BackupCode$ = LEFT$(BackupCode$, insertionPoint - 1) + thisBlock$ + MID$(BackupCode$, endPoint)
END SELECT
NEXT
OPEN BaseOutputFileName + ".bas" FOR BINARY AS #TextFileNum
PUT #TextFileNum, , BackupCode$
ELSE
OPEN BaseOutputFileName + ".bas" FOR OUTPUT AS #TextFileNum OPEN BaseOutputFileName + ".bas" FOR OUTPUT AS #TextFileNum
PRINT #TextFileNum, "': This program uses" PRINT #TextFileNum, "': This program uses"
PRINT #TextFileNum, "': InForm - GUI library for QB64 - "; __UI_Version PRINT #TextFileNum, "': InForm - GUI library for QB64 - "; __UI_Version
@ -4569,15 +4682,6 @@ SUB SaveForm (ExitToQB64 AS _BYTE, SaveOnlyFrm AS _BYTE)
PRINT #TextFileNum, "'-----------------------------------------------------------" PRINT #TextFileNum, "'-----------------------------------------------------------"
PRINT #TextFileNum, PRINT #TextFileNum,
PRINT #TextFileNum, "': Controls' IDs: ------------------------------------------------------------------" PRINT #TextFileNum, "': Controls' IDs: ------------------------------------------------------------------"
IF PreserveBackup THEN
PRINT #TextFileNum, "REM NOTICE: THIS FORM HAS BEEN RECENTLY EDITED"
PRINT #TextFileNum, "'>> The controls in the list below may have been added or renamed,"
PRINT #TextFileNum, "'>> and previously existing controls may have been deleted since"
PRINT #TextFileNum, "'>> this program's structure was first generated."
PRINT #TextFileNum, "'>> Make sure to check your code in the events SUBs so that"
PRINT #TextFileNum, "'>> you can take your recent edits into consideration."
PRINT #TextFileNum, "': ---------------------------------------------------------------------------------"
END IF
FOR i = 1 TO UBOUND(PreviewControls) FOR i = 1 TO UBOUND(PreviewControls)
IF PreviewControls(i).ID > 0 AND PreviewControls(i).Type <> __UI_Type_Font AND PreviewControls(i).Type <> __UI_Type_MenuPanel THEN IF PreviewControls(i).ID > 0 AND PreviewControls(i).Type <> __UI_Type_Font AND PreviewControls(i).Type <> __UI_Type_MenuPanel THEN
PRINT #TextFileNum, "DIM SHARED " + RTRIM$(__UI_TrimAt0$(PreviewControls(i).Name)) + " AS LONG" PRINT #TextFileNum, "DIM SHARED " + RTRIM$(__UI_TrimAt0$(PreviewControls(i).Name)) + " AS LONG"
@ -4595,10 +4699,6 @@ SUB SaveForm (ExitToQB64 AS _BYTE, SaveOnlyFrm AS _BYTE)
PRINT #TextFileNum, "'$INCLUDE:'InForm\extensions\gifplay.bm'" PRINT #TextFileNum, "'$INCLUDE:'InForm\extensions\gifplay.bm'"
END IF END IF
PRINT #TextFileNum, PRINT #TextFileNum,
IF PreserveBackup THEN
PRINT #TextFileNum, BackupCode$
GOTO BackupRestored
END IF
PRINT #TextFileNum, "': Event procedures: ---------------------------------------------------------------" PRINT #TextFileNum, "': Event procedures: ---------------------------------------------------------------"
FOR i = 0 TO 14 FOR i = 0 TO 14
SELECT EVERYCASE i SELECT EVERYCASE i
@ -4697,7 +4797,7 @@ SUB SaveForm (ExitToQB64 AS _BYTE, SaveOnlyFrm AS _BYTE)
PRINT #TextFileNum, "END SUB" PRINT #TextFileNum, "END SUB"
PRINT #TextFileNum, PRINT #TextFileNum,
NEXT NEXT
BackupRestored: END IF
CLOSE #TextFileNum CLOSE #TextFileNum
END IF END IF