1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-06-26 17:10:38 +00:00

Unifies message boxes.

This commit is contained in:
FellippeHeitor 2021-01-12 19:41:11 -03:00
parent 78decc2d24
commit 4de09d6658

View file

@ -5872,7 +5872,7 @@ FUNCTION ide2 (ignore)
LOOP
IF NOT FoundBrokenLink THEN
ideerrormessage "All files in the list are accessible."
result = idemessagebox("Remove Broken Links", "All files in the list are accessible.", "#OK")
END IF
IF ln > 0 AND FoundBrokenLink THEN
@ -6782,139 +6782,7 @@ SUB idedrawpar (p AS idedbptype)
END IF
END SUB
SUB ideerrormessage (mess$)
'-------- generic dialog box header --------
PCOPY 3, 0
PCOPY 0, 2
PCOPY 0, 1
SCREEN , , 1, 0
focus = 1
DIM p AS idedbptype
DIM o(1 TO 100) AS idedbotype
DIM sep AS STRING * 1
sep = CHR$(0)
'-------- end of generic dialog box header --------
'-------- init --------
i = 0
idepar p, LEN(mess$) + 4, 4, ""
i = i + 1
o(i).typ = 3
o(i).y = 4
o(i).txt = idenewtxt("#OK")
o(i).dft = 1
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
DO 'main loop
'-------- generic display dialog box & objects --------
idedrawpar p
f = 1: cx = 0: cy = 0
FOR i = 1 TO 100
IF o(i).typ THEN
'prepare object
o(i).foc = focus - f 'focus offset
o(i).cx = 0: o(i).cy = 0
idedrawobj o(i), f 'display object
IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy
END IF
NEXT i
lastfocus = f - 1
'-------- end of generic display dialog box & objects --------
'-------- custom display changes --------
COLOR 0, 7: LOCATE p.y + 2, p.x + 3: PRINT mess$;
'-------- end of custom display changes --------
'update visual page and cursor position
PCOPY 1, 0
IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0
'-------- read input --------
change = 0
DO
GetInput
IF mWHEEL THEN change = 1
IF KB THEN change = 1
IF mCLICK THEN mousedown = 1: change = 1
IF mRELEASE THEN mouseup = 1: change = 1
IF mB THEN change = 1
alt = KALT: IF alt <> oldalt THEN change = 1
oldalt = alt
_LIMIT 100
LOOP UNTIL change
IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0
'convert "alt+letter" scancode to letter's ASCII character
altletter$ = ""
IF alt AND NOT KCTRL THEN
IF LEN(K$) = 1 THEN
k = ASC(UCASE$(K$))
IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k)
END IF
END IF
SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0
'-------- end of read input --------
IF UCASE$(K$) = "Y" THEN altletter$ = "Y"
IF UCASE$(K$) = "N" THEN altletter$ = "N"
'-------- generic input response --------
info = 0
IF K$ = "" THEN K$ = CHR$(255)
IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1
IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = ""
IF focus < 1 THEN focus = lastfocus
IF focus > lastfocus THEN focus = 1
f = 1
FOR i = 1 TO 100
t = o(i).typ
IF t THEN
focusoffset = focus - f
ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL
END IF
NEXT
'-------- end of generic input response --------
IF K$ = CHR$(27) THEN
EXIT SUB
END IF
IF info THEN
EXIT SUB
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END SUB
FUNCTION idefileexists$(f$)
'-------- generic dialog box header --------
PCOPY 3, 0
PCOPY 0, 2
PCOPY 0, 1
SCREEN , , 1, 0
focus = 1
DIM p AS idedbptype
DIM o(1 TO 100) AS idedbotype
DIM sep AS STRING * 1
sep = CHR$(0)
'-------- end of generic dialog box header --------
'-------- init --------
i = 0
'idepar p, 30, 6, "File already exists. Overwrite?"
l = LEN(f$)
DO
IF l < LEN(f$) THEN
@ -6925,109 +6793,10 @@ FUNCTION idefileexists$(f$)
l = l - 1
LOOP UNTIL LEN(m$) + 4 < (idewx - 6)
idepar p, LEN(m$) + 4, 4, ""
i = i + 1
o(i).typ = 3
o(i).y = 4
o(i).txt = idenewtxt("#Yes" + sep + "#No")
o(i).dft = 1
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
DO 'main loop
'-------- generic display dialog box & objects --------
idedrawpar p
f = 1: cx = 0: cy = 0
FOR i = 1 TO 100
IF o(i).typ THEN
'prepare object
o(i).foc = focus - f 'focus offset
o(i).cx = 0: o(i).cy = 0
idedrawobj o(i), f 'display object
IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy
END IF
NEXT i
lastfocus = f - 1
'-------- end of generic display dialog box & objects --------
'-------- custom display changes --------
COLOR 0, 7: LOCATE p.y + 2, p.x + 3: PRINT m$;
'-------- end of custom display changes --------
'update visual page and cursor position
PCOPY 1, 0
IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0
'-------- read input --------
change = 0
DO
GetInput
IF mWHEEL THEN change = 1
IF KB THEN change = 1
IF mCLICK THEN mousedown = 1: change = 1
IF mRELEASE THEN mouseup = 1: change = 1
IF mB THEN change = 1
alt = KALT: IF alt <> oldalt THEN change = 1
oldalt = alt
_LIMIT 100
LOOP UNTIL change
IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0
'convert "alt+letter" scancode to letter's ASCII character
altletter$ = ""
IF alt AND NOT KCTRL THEN
IF LEN(K$) = 1 THEN
k = ASC(UCASE$(K$))
IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k)
END IF
END IF
SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0
'-------- end of read input --------
IF UCASE$(K$) = "Y" THEN altletter$ = "Y"
IF UCASE$(K$) = "N" THEN altletter$ = "N"
'-------- generic input response --------
info = 0
IF K$ = "" THEN K$ = CHR$(255)
IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1
IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = ""
IF focus < 1 THEN focus = lastfocus
IF focus > lastfocus THEN focus = 1
f = 1
FOR i = 1 TO 100
t = o(i).typ
IF t THEN
focusoffset = focus - f
ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL
END IF
NEXT
'-------- end of generic input response --------
IF K$ = CHR$(27) THEN
idefileexists$ = "N"
EXIT FUNCTION
END IF
IF info THEN
IF info = 1 THEN idefileexists$ = "Y" ELSE idefileexists$ = "N"
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
result = idemessagebox("Save", m$, "#Yes;#No")
IF result = 1 THEN idefileexists$ = "Y" ELSE idefileexists$ = "N"
END FUNCTION
FUNCTION idefind$
REDIM SearchHistory(0) AS STRING
@ -8273,235 +8042,22 @@ SUB idepar (par AS idedbptype, w, h, title$)
END SUB
FUNCTION iderestore$
'-------- generic dialog box header --------
PCOPY 3, 0
PCOPY 0, 2
PCOPY 0, 1
SCREEN , , 1, 0
focus = 1
DIM p AS idedbptype
DIM o(1 TO 100) AS idedbotype
DIM sep AS STRING * 1
sep = CHR$(0)
'-------- end of generic dialog box header --------
'-------- init --------
i = 0
'idepar p, 30, 6, "File already exists. Overwrite?"
idepar p, 43, 4, ""
i = i + 1
o(i).typ = 3
o(i).y = 4
o(i).txt = idenewtxt("#Yes" + sep + "#No")
o(i).dft = 1
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
DO 'main loop
'-------- generic display dialog box & objects --------
idedrawpar p
f = 1: cx = 0: cy = 0
FOR i = 1 TO 100
IF o(i).typ THEN
'prepare object
o(i).foc = focus - f 'focus offset
o(i).cx = 0: o(i).cy = 0
idedrawobj o(i), f 'display object
IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy
END IF
NEXT i
lastfocus = f - 1
'-------- end of generic display dialog box & objects --------
'-------- custom display changes --------
COLOR 0, 7: LOCATE p.y + 2, p.x + 3: PRINT "Recover program from auto-saved backup?";
'-------- end of custom display changes --------
'update visual page and cursor position
PCOPY 1, 0
IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0
'-------- read input --------
change = 0
DO
GetInput
IF mWHEEL THEN change = 1
IF KB THEN change = 1
IF mCLICK THEN mousedown = 1: change = 1
IF mRELEASE THEN mouseup = 1: change = 1
IF mB THEN change = 1
alt = KALT: IF alt <> oldalt THEN change = 1
oldalt = alt
_LIMIT 100
LOOP UNTIL change
IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0
'convert "alt+letter" scancode to letter's ASCII character
altletter$ = ""
IF alt AND NOT KCTRL THEN
IF LEN(K$) = 1 THEN
k = ASC(UCASE$(K$))
IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k)
END IF
END IF
SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0
'-------- end of read input --------
IF UCASE$(K$) = "Y" THEN altletter$ = "Y"
IF UCASE$(K$) = "N" THEN altletter$ = "N"
'-------- generic input response --------
info = 0
IF K$ = "" THEN K$ = CHR$(255)
IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1
IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = ""
IF focus < 1 THEN focus = lastfocus
IF focus > lastfocus THEN focus = 1
f = 1
FOR i = 1 TO 100
t = o(i).typ
IF t THEN
focusoffset = focus - f
ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL
END IF
NEXT
'-------- end of generic input response --------
IF info THEN
IF info = 1 THEN iderestore$ = "Y" ELSE iderestore$ = "N"
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
result = idemessagebox("Backup found", "Recover program from auto-saved backup?", "#Yes;#No")
IF result = 1 THEN iderestore$ = "Y" ELSE iderestore$ = "N"
END FUNCTION
FUNCTION ideclearhistory$ (WhichHistory$)
'-------- generic dialog box header --------
PCOPY 3, 0
PCOPY 0, 2
PCOPY 0, 1
SCREEN , , 1, 0
focus = 1
DIM p AS idedbptype
DIM o(1 TO 100) AS idedbotype
DIM sep AS STRING * 1
sep = CHR$(0)
'-------- end of generic dialog box header --------
'-------- init --------
i = 0
'idepar p, 30, 6, "File already exists. Overwrite?"
idepar p, 48, 4, ""
i = i + 1
o(i).typ = 3
o(i).y = 4
o(i).txt = idenewtxt("#Yes" + sep + "#No")
o(i).dft = 1
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
DO 'main loop
'-------- generic display dialog box & objects --------
idedrawpar p
f = 1: cx = 0: cy = 0
FOR i = 1 TO 100
IF o(i).typ THEN
'prepare object
o(i).foc = focus - f 'focus offset
o(i).cx = 0: o(i).cy = 0
idedrawobj o(i), f 'display object
IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy
END IF
NEXT i
lastfocus = f - 1
'-------- end of generic display dialog box & objects --------
'-------- custom display changes --------
COLOR 0, 7: LOCATE p.y + 2, p.x + 3
SELECT CASE WhichHistory$
CASE "SEARCH": PRINT "This cannot be undone. Clear search history?";
CASE "FILES": PRINT " This cannot be undone. Clear recent files?";
CASE "INVALID": PRINT " Remove broken links from recent files?";
END SELECT
'-------- end of custom display changes --------
'update visual page and cursor position
PCOPY 1, 0
IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0
'-------- read input --------
change = 0
DO
GetInput
IF mWHEEL THEN change = 1
IF KB THEN change = 1
IF mCLICK THEN mousedown = 1: change = 1
IF mRELEASE THEN mouseup = 1: change = 1
IF mB THEN change = 1
alt = KALT: IF alt <> oldalt THEN change = 1
oldalt = alt
_LIMIT 100
LOOP UNTIL change
IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0
'convert "alt+letter" scancode to letter's ASCII character
altletter$ = ""
IF alt AND NOT KCTRL THEN
IF LEN(K$) = 1 THEN
k = ASC(UCASE$(K$))
IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k)
END IF
END IF
SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0
'-------- end of read input --------
IF UCASE$(K$) = "Y" THEN altletter$ = "Y"
IF UCASE$(K$) = "N" THEN altletter$ = "N"
'-------- generic input response --------
info = 0
IF K$ = "" THEN K$ = CHR$(255)
IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1
IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = ""
IF focus < 1 THEN focus = lastfocus
IF focus > lastfocus THEN focus = 1
f = 1
FOR i = 1 TO 100
t = o(i).typ
IF t THEN
focusoffset = focus - f
ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL
END IF
NEXT
'-------- end of generic input response --------
IF info THEN
IF info = 1 THEN ideclearhistory$ = "Y" ELSE ideclearhistory$ = "N"
EXIT FUNCTION
END IF
IF K$ = CHR$(27) THEN
ideclearhistory$ = "N"
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
SELECT CASE WhichHistory$
CASE "SEARCH": t$ = "Clear search history": m$ = "This cannot be undone. Proceed?"
CASE "FILES": t$ = "Clear recent files": m$ = "This cannot be undone. Proceed?"
CASE "INVALID": t$ = "Recent files": m$ = "Remove broken links from recent files?"
END SELECT
result = idemessagebox(t$, m$, "#Yes;#No")
IF result = 1 THEN ideclearhistory$ = "Y" ELSE ideclearhistory$ = "N"
END FUNCTION
SUB idesave (f$)
@ -8516,122 +8072,13 @@ SUB idesave (f$)
END SUB
FUNCTION idesavenow$
'-------- generic dialog box header --------
PCOPY 3, 0
PCOPY 0, 2
PCOPY 0, 1
SCREEN , , 1, 0
focus = 1
DIM p AS idedbptype
DIM o(1 TO 100) AS idedbotype
DIM sep AS STRING * 1
sep = CHR$(0)
'-------- end of generic dialog box header --------
'-------- init --------
i = 0
idepar p, 40, 4, ""
i = i + 1
o(i).typ = 3
o(i).y = 4
o(i).txt = idenewtxt("#Yes" + sep + "#No" + sep + "#Cancel")
o(i).dft = 1
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
DO 'main loop
'-------- generic display dialog box & objects --------
idedrawpar p
f = 1: cx = 0: cy = 0
FOR i = 1 TO 100
IF o(i).typ THEN
'prepare object
o(i).foc = focus - f 'focus offset
o(i).cx = 0: o(i).cy = 0
idedrawobj o(i), f 'display object
IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy
END IF
NEXT i
lastfocus = f - 1
'-------- end of generic display dialog box & objects --------
'-------- custom display changes --------
COLOR 0, 7: LOCATE p.y + 2, p.x + 4: PRINT "Program is not saved. Save it now?";
'-------- end of custom display changes --------
'update visual page and cursor position
PCOPY 1, 0
IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0
'-------- read input --------
change = 0
DO
GetInput
IF mWHEEL THEN change = 1
IF KB THEN change = 1
IF mCLICK THEN mousedown = 1: change = 1
IF mRELEASE THEN mouseup = 1: change = 1
IF mB THEN change = 1
alt = KALT: IF alt <> oldalt THEN change = 1
oldalt = alt
_LIMIT 100
LOOP UNTIL change
IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0
'convert "alt+letter" scancode to letter's ASCII character
altletter$ = ""
IF alt AND NOT KCTRL THEN
IF LEN(K$) = 1 THEN
k = ASC(UCASE$(K$))
IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k)
END IF
END IF
SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0
'-------- end of read input --------
IF UCASE$(K$) = "Y" THEN altletter$ = "Y"
IF UCASE$(K$) = "N" THEN altletter$ = "N"
IF UCASE$(K$) = "C" THEN altletter$ = "C"
'-------- generic input response --------
info = 0
IF K$ = "" THEN K$ = CHR$(255)
IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1
IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = ""
IF focus < 1 THEN focus = lastfocus
IF focus > lastfocus THEN focus = 1
f = 1
FOR i = 1 TO 100
t = o(i).typ
IF t THEN
focusoffset = focus - f
ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL
END IF
NEXT
'-------- end of generic input response --------
IF K$ = CHR$(27) THEN
idesavenow$ = "C"
EXIT FUNCTION
END IF
IF info THEN
IF info = 1 THEN idesavenow$ = "Y"
IF info = 2 THEN idesavenow$ = "N"
IF info = 3 THEN idesavenow$ = "C"
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
m$ = "Program is not saved. Save it now?"
result = idemessagebox("", m$, "#Yes;#No;#Cancel")
SELECT CASE result
CASE 1: idesavenow$ = "Y"
CASE 2: idesavenow$ = "N"
CASE 0, 3: idesavenow$ = "C"
END SELECT
END FUNCTION
SUB idesetline (i, text$)
@ -13501,13 +12948,13 @@ FUNCTION idecolorpicker$ (editing)
detail$ = "can't insert - multiple lines"
END IF
_CLIPBOARD$ = CurrentRGB$
ideerrormessage "Copied to the clipboard (" + detail$ + ")."
result = idemessagebox("RGB Color Mixer", "Copied to the clipboard (" + detail$ + ").", "#OK")
END IF
ELSE
IF ideselect THEN
IF ideselecty1 <> idecy THEN
_CLIPBOARD$ = CurrentRGB$
ideerrormessage "Copied to the clipboard (can't insert - multiple lines)."
result = idemessagebox("RGB Color Mixer", "Copied to the clipboard (can't insert - multiple lines).", "#OK")
ELSE
'Delete selection and insert current RGB values
sx1 = ideselectx1: sx2 = idecx
@ -13779,6 +13226,7 @@ SUB Help_ShowText
END SUB
FUNCTION idesearchedbox$
'-------- generic dialog box header --------
@ -14052,7 +13500,7 @@ FUNCTION iderecentbox$
i = i + 1
o(i).typ = 3
o(i).y = idewy + idesubwindow - 6
o(i).txt = idenewtxt("#OK" + sep + "#Cancel" + sep + "Clea#r list" + sep + "#Remove broken links")
o(i).txt = idenewtxt("#OK" + sep + "#Cancel" + sep + "Clear #list" + sep + "#Remove broken links")
o(i).dft = 1
'-------- end of init --------
@ -14731,7 +14179,7 @@ FUNCTION idef1box$ (lnks$, lnks)
'72,19
i = 0
idepar p, 40, lnks + 3, "F1"
idepar p, 40, lnks + 3, "Contextual help"
i = i + 1
o(i).typ = 2