QB64/InForm
QB64/InForm
1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2025-01-14 19:49:33 +00:00
Code Issues Releases Wiki Activity

Add many examples. Add legacy MessageBox extension

Browse source
This commit is contained in:
Samuel Gomes 2023-06-24 08:08:56 +05:30
parent e2ee59af0f
commit 6fe16f957c
305 changed files with 119449 additions and 73478 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
InForm/InForm.bi
View file

@ -2,9 +2,9 @@
'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
'
$If VERSION < 3.8 Then
$Error This requires the latest version of QB64-PE from https://github.com/QB64-Phoenix-Edition/QB64pe/releases
$End If
$IF VERSION < 3.8 THEN
$Error This requires the latest version of QB64-PE from https://github.com/QB64-Phoenix-Edition/QB64pe/releases
$END IF
DECLARE LIBRARY
FUNCTION __UI_GetPID ALIAS getpid ()
@ -341,4 +341,3 @@ SYSTEM
__UI_ErrorHandler:
RESUME NEXT

1
InForm/InForm.ui
View file

@ -8694,4 +8694,3 @@ SUB __UI_ShadowBox (bX AS INTEGER, bY AS INTEGER, bW AS INTEGER, bH AS INTEGER,
LINE (bX, bY)-STEP(bW, bH), C, BF
END SUB

1
InForm/InFormVersion.bas
View file

@ -4,4 +4,3 @@ CONST __UI_Version = "v1.5"
CONST __UI_VersionNumber = 1
CONST __UI_VersionIsBeta = 1
CONST __UI_CopyrightSpan = "2016-2023"

3
InForm/UiEditor.bas
View file

@ -240,7 +240,7 @@ IF NOT _FILEEXISTS(QB64_EXE_PATH) THEN ' if the compiler is missing then look fo
SYSTEM 1
END IF
WriteSetting "InForm/InForm.ini", "InForm Settings", "QB64PE path", QB64_EXE_PATH ' save the complete path name to the INI
WriteSetting "InForm/InForm.ini", "InForm Settings", "QB64PE path", QB64_EXE_PATH ' save the complete path name to the INI
END IF
END IF
@ -5116,4 +5116,3 @@ FUNCTION OutsideQuotes%% (text$, position AS LONG)
END FUNCTION
'$include:'InForm.ui'

1
InForm/UiEditorPreview.bas
View file

@ -3993,4 +3993,3 @@ FUNCTION LoadEditorImage& (FileName$)
END FUNCTION
'$include:'InForm.ui'

129
InForm/extensions/MessageBox.bas Normal file
View file

@ -0,0 +1,129 @@
' MessageBox compatibility functions
' These basically emulate the legacy InForm MessageBox routines
' All it does is calls the new QB64-PE _MESSAGEBOX$ function
'$INCLUDE:'MessageBox.bi'
$IF MESSAGEBOX_BAS = UNDEFINED THEN
$LET MESSAGEBOX_BAS = TRUE
FUNCTION MessageBox& (message AS STRING, caption AS STRING, setup AS LONG)
DIM dialogType AS STRING
IF setup AND MsgBox_YesNo THEN
dialogType = "yesno"
ELSEIF setup AND MsgBox_YesNoCancel THEN
dialogType = "yesnocancel"
ELSEIF setup AND MsgBox_OkCancel THEN
dialogType = "okcancel"
ELSEIF setup AND MsgBox_OkOnly THEN
dialogType = "ok"
END IF
DIM iconType AS STRING
IF setup AND MsgBox_Critical THEN
iconType = "error"
ELSEIF setup AND MsgBox_Question THEN
iconType = "question"
ELSEIF setup AND MsgBox_Exclamation THEN
iconType = "warning"
ELSEIF setup AND MsgBox_Information THEN
iconType = "info"
END IF
DIM defaultButton AS LONG
IF setup AND MsgBox_DefaultButton3 THEN
SELECT CASE dialogType
CASE "yesnocancel"
defaultButton = 0
CASE "yesno"
defaultButton = 0
CASE "okcancel"
defaultButton = 0
CASE "ok"
defaultButton = 1
END SELECT
ELSEIF setup AND MsgBox_DefaultButton2 THEN
SELECT CASE dialogType
CASE "yesnocancel"
defaultButton = 2
CASE "yesno"
defaultButton = 0
CASE "okcancel"
defaultButton = 0
CASE "ok"
defaultButton = 1
END SELECT
ELSEIF setup AND MsgBox_DefaultButton1 THEN
SELECT CASE dialogType
CASE "yesnocancel"
defaultButton = 1
CASE "yesno"
defaultButton = 1
CASE "okcancel"
defaultButton = 1
CASE "ok"
defaultButton = 1
END SELECT
END IF
DIM __caption AS STRING
IF caption = "" THEN
IF __UI_CurrentTitle <> "" THEN
__caption = __UI_CurrentTitle
ELSEIF _TITLE$ <> "" THEN
__caption = _TITLE$
ELSE
__caption = COMMAND$(0)
END IF
ELSE
__caption = caption
END IF
_DELAY 0.2 ' delay a bit so that the interface can redraw before the messagebox kicks in
DIM returnValue AS LONG: returnValue = _MESSAGEBOX(__caption, message, dialogType, iconType, defaultButton)
SELECT CASE returnValue
CASE 0
SELECT CASE dialogType
CASE "yesnocancel"
MessageBox = MsgBox_Cancel
CASE "yesno"
MessageBox = MsgBox_No
CASE "okcancel"
MessageBox = MsgBox_Cancel
CASE "ok"
MessageBox = MsgBox_Ok
END SELECT
CASE 1
SELECT CASE dialogType
CASE "yesnocancel"
MessageBox = MsgBox_Yes
CASE "yesno"
MessageBox = MsgBox_Yes
CASE "okcancel"
MessageBox = MsgBox_Ok
CASE "ok"
MessageBox = MsgBox_Ok
END SELECT
CASE 2
SELECT CASE dialogType
CASE "yesnocancel"
MessageBox = MsgBox_No
CASE "yesno"
MessageBox = MsgBox_No
CASE "okcancel"
MessageBox = MsgBox_Cancel
CASE "ok"
MessageBox = MsgBox_Ok
END SELECT
END SELECT
END FUNCTION
SUB MessageBox (message AS STRING, caption AS STRING, setup AS LONG)
DIM returnValue AS LONG: returnValue = MessageBox(message, caption, setup)
END SUB
$END IF

40
InForm/extensions/MessageBox.bi Normal file
View file

@ -0,0 +1,40 @@
' MessageBox compatibility functions
' These basically emulate the legacy InForm MessageBox routines
' All it does is calls the new QB64-PE _MESSAGEBOX$ function
$IF MESSAGEBOX_BI = UNDEFINED THEN
$LET MESSAGEBOX_BI = TRUE
'Messagebox constants
CONST MsgBox_OkOnly = 1
CONST MsgBox_OkCancel = 2
CONST MsgBox_AbortRetryIgnore = 4
CONST MsgBox_YesNoCancel = 8
CONST MsgBox_YesNo = 16
CONST MsgBox_RetryCancel = 32
CONST MsgBox_CancelTryagainContinue = 64
CONST MsgBox_Critical = 128
CONST MsgBox_Question = 256
CONST MsgBox_Exclamation = 512
CONST MsgBox_Information = 1024
CONST MsgBox_DefaultButton1 = 2048
CONST MsgBox_DefaultButton2 = 4096
CONST MsgBox_DefaultButton3 = 8192
CONST MsgBox_Defaultbutton4 = 16384
CONST MsgBox_AppModal = 32768
CONST MsgBox_SystemModal = 65536
CONST MsgBox_SetForeground = 131072
CONST MsgBox_Ok = 1
CONST MsgBox_Yes = 2
CONST MsgBox_No = 3
CONST MsgBox_Cancel = 4
CONST MsgBox_Abort = 5
CONST MsgBox_Retry = 6
CONST MsgBox_Ignore = 7
CONST MsgBox_Tryagain = 8
CONST MsgBox_Continue = 9
$END IF

1
InForm/extensions/gifplay.bi
View file

@ -55,4 +55,3 @@ END TYPE
REDIM SHARED GifData(0) AS GIFDATA
REDIM SHARED GifFrameData(0) AS FRAMEDATA
DIM SHARED TotalGIFLoaded AS LONG, TotalGIFFrames AS LONG

36
InForm/extensions/gifplay.bm
View file

@ -43,19 +43,19 @@ FUNCTION GifIsPlaying%% (ID AS LONG)
GifIsPlaying%% = GifData(i).IsPlaying
END FUNCTION
FUNCTION GifWidth%(ID AS LONG)
FUNCTION GifWidth% (ID AS LONG)
DIM i AS LONG
i = GetGifIndex(ID)
GifWidth% = GifData(i).width
END FUNCTION
FUNCTION GifHeight%(ID AS LONG)
FUNCTION GifHeight% (ID AS LONG)
DIM i AS LONG
i = GetGifIndex(ID)
GifHeight% = GifData(i).height
END FUNCTION
FUNCTION TotalFrames&(ID AS LONG)
FUNCTION TotalFrames& (ID AS LONG)
DIM i AS LONG
i = GetGifIndex(ID)
TotalFrames& = GifData(i).totalFrames
@ -86,7 +86,7 @@ SUB StopGif (ID AS LONG)
GifData(i).Frame = 1
END SUB
FUNCTION OpenGif%%(ID AS LONG, filename$)
FUNCTION OpenGif%% (ID AS LONG, filename$)
DIM i AS LONG, Index AS LONG
DIM byte~%%, palette$, delay~%
@ -104,7 +104,7 @@ FUNCTION OpenGif%%(ID AS LONG, filename$)
GifData(Index).ID = ID
GifData(Index).file = FREEFILE
IF _FILEEXISTS(filename$) = 0 THEN EXIT FUNCTION
IF NOT _FILEEXISTS(filename$) THEN EXIT FUNCTION
OPEN filename$ FOR BINARY AS GifData(Index).file
GET GifData(Index).file, , GifData(Index).sigver
@ -206,7 +206,7 @@ FUNCTION OpenGif%%(ID AS LONG, filename$)
REDIM _PRESERVE GifFrameData(0 TO TotalGIFFrames) AS FRAMEDATA
GifData(Index).IsPlaying = False
OpenGif%% = True
OpenGif = True
EXIT FUNCTION
LoadError:
@ -865,18 +865,26 @@ FUNCTION gifUnpack$ (PackedData$)
A$ = PackedData$
FOR i& = 1 TO LEN(A$) STEP 4: B$ = MID$(A$, i&, 4)
FOR i& = 1 TO LEN(A$) STEP 4
B$ = MID$(A$, i&, 4)
IF INSTR(1, B$, "%") THEN
FOR C% = 1 TO LEN(B$): F$ = MID$(B$, C%, 1)
FOR C% = 1 TO LEN(B$)
F$ = MID$(B$, C%, 1)
IF F$ <> "%" THEN C$ = C$ + F$
NEXT: B$ = C$
END IF: FOR t% = LEN(B$) TO 1 STEP -1
NEXT
B$ = C$
END IF
FOR t% = LEN(B$) TO 1 STEP -1
B& = B& * 64 + ASC(MID$(B$, t%)) - 48
NEXT: X$ = "": FOR t% = 1 TO LEN(B$) - 1
X$ = X$ + CHR$(B& AND 255): B& = B& \ 256
NEXT: btemp$ = btemp$ + X$: NEXT
NEXT
X$ = ""
FOR t% = 1 TO LEN(B$) - 1
X$ = X$ + CHR$(B& AND 255)
B& = B& \ 256
NEXT
btemp$ = btemp$ + X$
NEXT
gifUnpack$ = btemp$
END FUNCTION
'############################################################################################

1
InForm/vbdos2inform.bas
View file

@ -279,4 +279,3 @@ RETURN
FUNCTION QBColor2QB64$ (index AS _BYTE)
QBColor2QB64$ = "_RGB32(" + LTRIM$(STR$(_RED(index))) + ", " + LTRIM$(STR$(_GREEN(index))) + ", " + LTRIM$(STR$(_BLUE(index))) + ")"
END FUNCTION

68
README.md
View file

@ -15,7 +15,9 @@ Wiki: <https://github.com/a740g/InForm-PE/wiki>
## USAGE
Install InForm-PE and QB64-PE side-by-side in their own directories. There is no need to copy InForm-PE files to the QB64-PE directory. The following directory setup is recommended.
Install InForm-PE and QB64-PE side-by-side in their own directories. There is no need to copy InForm-PE files to the QB64-PE directory.
> The following directory setup is recommended
```text
<some-drive-or-directory>
@ -57,15 +59,63 @@ Assuming your setup is like the above, do the following:
- *BeforeUnload*, triggered when the user tries to close the program, either via clicking the window's X button, right click in the task bar -> Close or with Alt+F4 (Windows only).
- *FormResized*, triggered when a form with the CanResize property is resized at runtime.
# EXAMPLES
***The following files need to be copied to your project directory for it to compile.***
- Calculator by Terry Ritchie
- Fireworks by Fellippe Heitor
- TicTacToe by Fellippe Heitor
- TicTacToe2 by Fellippe Heitor
- Stopwatch by Fellippe Heitor
- WordClock by Fellippe Heitor
> Required
```text
InForm/InFormVersion.bas
InForm/InForm.bi
InForm/InForm.ui
InForm/xp.uitheme
```
> Required only when GIF picturebox is used
```text
InForm/extensions/gifplay.bi
InForm/extensions/gifplay.bm
```
> Required only when using legacy InForm MessageBox routines (use [QB64-PE's native common dialog functions](https://qb64phoenix.com/qb64wiki/index.php/Keyword_Reference_-_By_usage#Window_and_Desktop) when writing new code)
```text
InForm/extensions/MessageBox.bi
InForm/extensions/MessageBox.bas
```
## EXAMPLES
| Name | Author |
|------|-------------|
| Bin2Include | SpriggsySpriggs |
| Calculator | Terry Ritchie |
| ClickTheVoid | Fellippe Heitor |
| ClockPatience | Richard Notley |
| DuckShoot | Richard Notley |
| ebacCalculator | George McGinn |
| Fahrenheit-Celsius | Richard Notley |
| Fireworks2 | Fellippe Heitor |
| GIFPlaySample | Fellippe Heitor |
| GravitationSimulation | Richard Notley |
| InFormPaint | Fellippe Heitor |
| InsideOutsideTriangle | Richard Notley |
| Lander1 | B+ |
| Lander2 | B+ |
| Mahjong | Richard Notley |
| MasterMindGuessTheSequence | TempodiBasic |
| Pelmanism | Richard Notley |
| PictureGrid | Richard Notley |
| PlayFX | Samuel Gomes |
| RockPaperScissorsSpockLizard | TempodiBasic |
| Stopwatch | Fellippe Heitor |
| TextFetch | B+ |
| TicTacToe | Fellippe Heitor |
| TicTacToe2 | Fellippe Heitor |
| Trackword | Richard Notley |
| WordClock | Fellippe Heitor |
| wordSearch | George McGinn |
## NOTES
- This requires the latest version of [QB64-PE](https://github.com/QB64-Phoenix-Edition/QB64pe/releases). More accurately, it only works with QB64-PE v3.8.0 or above.
- This requires the latest version of [QB64-PE](https://github.com/QB64-Phoenix-Edition/QB64pe/releases/latest). More accurately, it only works with QB64-PE v3.8.0 or above.

723
examples/Bin2Include/BIN2INCLUDE.bas Normal file
View file

@ -0,0 +1,723 @@
': This program uses
': InForm - GUI library for QB64 - v1.5
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
$VERSIONINFO:CompanyName=SpriggsySpriggs
$VERSIONINFO:FileDescription=Converts a binary file into an INCLUDE-able
$VERSIONINFO:LegalCopyright=(c) 2019-2020 SpriggsySpriggs
$VERSIONINFO:ProductName=BIN2INCLUDE
$VERSIONINFO:InternalName=BIN2INCLUDE
$VERSIONINFO:OriginalFilename=BIN2INCLUDE.exe
$VERSIONINFO:Web=https://github.com/a740g/QB64-Museum/tree/main/SpriggsySpriggs/Bin2Include
$VERSIONINFO:Comments=QB64-PE and InForm-PE port by a740g
$VERSIONINFO:FILEVERSION#=2,6,0,0
$VERSIONINFO:PRODUCTVERSION#=2,6,0,0
OPTION _EXPLICIT
$EXEICON:'./BIN2INCLUDE.ico'
_TITLE "BIN2INCLUDE"
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED BIN2INCLUDE AS LONG
DIM SHARED SelectedFileTB AS LONG
DIM SHARED OpenBT AS LONG
DIM SHARED SaveBT AS LONG
DIM SHARED CONVERTBT AS LONG
DIM SHARED OutputFileTB AS LONG
DIM SHARED ListBox1 AS LONG
DIM SHARED ClearLogBT AS LONG
DIM SHARED BIN2BASRB AS LONG
DIM SHARED PIC2MEMRB AS LONG
DIM SHARED ResetBT AS LONG
': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'BIN2INCLUDE.frm'
': Custom procedures: --------------------------------------------------------------
SUB MessageBox (message AS STRING, caption AS STRING, icon AS STRING)
_DELAY 0.2 ' delay a bit to allow InFrom to draw and refresh all comtrols before the modal dialog box takes over
_MESSAGEBOX caption, message, icon
END SUB
FUNCTION checkExt%% (OFile$)
IF UCASE$(RIGHT$(OFile$, 4)) <> ".BMP" AND UCASE$(RIGHT$(OFile$, 4)) <> ".JPG" _
AND UCASE$(RIGHT$(OFile$, 4)) <> ".PNG" AND UCASE$(RIGHT$(OFile$, 5)) <> ".JPEG" _
AND UCASE$(RIGHT$(OFile$, 4)) <> ".GIF" THEN
checkExt = False
ELSE
checkExt = True
END IF
END FUNCTION
FUNCTION ReplaceString$ (a AS STRING, b AS STRING, c AS STRING)
DIM j AS LONG: j = INSTR(a, b)
DIM r AS STRING
IF j > 0 THEN
r = LEFT$(a, j - 1) + c + ReplaceString(RIGHT$(a, LEN(a) - j + 1 - LEN(b)), b, c)
ELSE
r = a
END IF
ReplaceString = r
END FUNCTION
FUNCTION StripDirectory$ (s AS STRING)
DIM t AS STRING: t = MID$(s, _INSTRREV(s, "\") + 1)
StripDirectory = t
END FUNCTION
FUNCTION E$ (BS AS STRING)
DIM AS LONG t, b
FOR t = LEN(BS) TO 1 STEP -1
b = b * 256 + ASC(MID$(BS, t))
NEXT
DIM AS STRING a, g
FOR t = 1 TO LEN(BS) + 1
g = CHR$(48 + (b AND 63)): b = b \ 64
IF g = "@" THEN g = "#"
a = a + g
NEXT
E = a
END FUNCTION
SUB bin2bas (IN$, OUT$)
OPEN IN$ FOR BINARY AS 1
IF LOF(1) = 0 THEN
CLOSE 1
ELSE
DIM INDATA$: INDATA$ = (INPUT$(LOF(1), 1))
INDATA$ = _DEFLATE$(INDATA$)
OPEN OUT$ FOR OUTPUT AS 2
DIM Q$: Q$ = CHR$(34) 'quotation mark
DIM inFunc$: inFunc$ = LEFT$(IN$, LEN(IN$) - 4)
DIM i AS LONG
FOR i = 32 TO 64
IF INSTR(inFunc$, CHR$(i)) THEN
inFunc$ = ReplaceString(inFunc$, CHR$(i), "")
END IF
NEXT
FOR i = 91 TO 96
IF INSTR(inFunc$, CHR$(i)) THEN
IF i <> 92 THEN
inFunc$ = ReplaceString(inFunc$, CHR$(i), "")
END IF
END IF
NEXT
PRINT #2, "SUB __" + StripDirectory(inFunc$)
PRINT #2, "IF NOT _FILEEXISTS(" + Q$ + StripDirectory(IN$) + Q$ + ") THEN"
AddItem ListBox1, TIME$ + ": Opening file: " + IN$
AddItem ListBox1, TIME$ + ": Processing file..."
PRINT #2, "DIM A$:A$="; Q$;
AddItem ListBox1, TIME$ + ": Converting lines..."
DIM BC&: BC& = 1
DO
DIM a$: a$ = MID$(INDATA$, BC&, 3)
BC& = BC& + 3
DIM LL&: LL& = LL& + 4
IF LL& = 60 THEN
LL& = 0
PRINT #2, E$(a$);
PRINT #2, Q$
PRINT #2, "A$=A$+"; Q$;
ELSE
PRINT #2, E$(a$);
END IF
IF LEN(INDATA$) - BC& < 3 THEN
a$ = MID$(INDATA$, LEN(INDATA$) - BC&, 1)
DIM B$: B$ = E$(a$)
SELECT CASE LEN(B$)
CASE 0: a$ = Q$
CASE 1: a$ = "%%%" + B$ + Q$
CASE 2: a$ = "%%" + B$ + Q$
CASE 3: a$ = "%" + B$ + Q$
END SELECT:
PRINT #2, a$;
EXIT DO
END IF
LOOP
PRINT #2, ""
AddItem ListBox1, TIME$ + ": DONE"
AddItem ListBox1, TIME$ + ": Writing decoding function to file..."
PRINT #2, "DIM btemp$,i&,B$,C%,F$,C$,j,t%,B&,X$,BASFILE$"
PRINT #2, "FOR i&=1TO LEN(A$) STEP 4"
PRINT #2, "B$=MID$(A$,i&,4)"
PRINT #2, "IF INSTR(1,B$,"; Q$; "%"; Q$; ") THEN"
PRINT #2, "FOR C%=1 TO LEN(B$)"
PRINT #2, "F$=MID$(B$,C%,1)"
PRINT #2, "IF F$<>"; Q$; "%"; Q$; "THEN C$=C$+F$"
PRINT #2, "NEXT"
PRINT #2, "B$=C$"
PRINT #2, "END IF"
PRINT #2, "FOR j=1 TO LEN(B$)"
PRINT #2, "IF MID$(B$,j,1)="; Q$; "#"; Q$; " THEN"
PRINT #2, "MID$(B$,j)="; Q$; "@"; Q$
PRINT #2, "END IF"
PRINT #2, "NEXT"
PRINT #2, "FOR t%=LEN(B$) TO 1 STEP-1"
PRINT #2, "B&=B&*64+ASC(MID$(B$,t%))-48"
PRINT #2, "NEXT"
PRINT #2, "X$="; Q$; Q$
PRINT #2, "FOR t%=1 TO LEN(B$)-1"
PRINT #2, "X$=X$+CHR$(B& AND 255)"
PRINT #2, "B&=B&\256"
PRINT #2, "NEXT"
PRINT #2, "btemp$=btemp$+X$"
PRINT #2, "NEXT"
PRINT #2, "BASFILE$=_INFLATE$(btemp$,"; LTRIM$(STR$(LOF(1))); " )"
PRINT #2, "DIM FF&: FF&=FREEFILE"
PRINT #2, "OPEN "; Q$; StripDirectory(IN$); Q$; " FOR OUTPUT AS #FF&"
PRINT #2, "PRINT #FF&, BASFILE$;"
PRINT #2, "CLOSE #FF&"
PRINT #2, "END IF"
PRINT #2, "END SUB"
CLOSE #1
CLOSE #2
AddItem ListBox1, TIME$ + ": DONE"
AddItem ListBox1, TIME$ + ": File exported to " + OUT$
ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$
Text(SelectedFileTB) = ""
Text(OutputFileTB) = ""
Control(CONVERTBT).Disabled = True
Control(OpenBT).Disabled = True
Control(BIN2BASRB).Value = False
Control(PIC2MEMRB).Value = False
END IF
END SUB
SUB pic2mem (IN$, OUT$)
AddItem ListBox1, TIME$ + ": Opening file: " + IN$
AddItem ListBox1, TIME$ + ": Processing file..."
'Load image file to screen mode
DIM pic AS LONG: pic = _LOADIMAGE(IN$, 32)
DIM m AS _MEM: m = _MEMIMAGE(pic)
'Grab screen data
DIM INDATA$: INDATA$ = SPACE$(m.SIZE)
_MEMGET m, m.OFFSET, INDATA$
'Compress it
INDATA$ = _DEFLATE$(INDATA$)
'get screen specs
DIM AS LONG wid, hih
wid = _WIDTH(pic): hih = _HEIGHT(pic)
OPEN OUT$ FOR OUTPUT AS 2
DIM Q$: Q$ = CHR$(34) 'quotation mark
DIM inFunc$: inFunc$ = LEFT$(IN$, LEN(IN$) - 4)
DIM AS LONG i
FOR i = 32 TO 64
IF INSTR(inFunc$, CHR$(i)) THEN
inFunc$ = ReplaceString(inFunc$, CHR$(i), "")
END IF
NEXT
FOR i = 91 TO 96
IF INSTR(inFunc$, CHR$(i)) THEN
IF i <> 92 THEN
inFunc$ = ReplaceString(inFunc$, CHR$(i), "")
END IF
END IF
NEXT
PRINT #2, "FUNCTION __" + StripDirectory(inFunc$) + "&"
PRINT #2, "DIM A$,btemp$,i&,B$,C%,F$,C$,j,t%,B&,X$"
PRINT #2, "DIM v&:v&=_NEWIMAGE("; wid; ","; hih; ",32)"
PRINT #2, "DIM m AS _MEM:m=_MEMIMAGE(v&)"
PRINT #2, "A$="; Q$;
DIM BC&: BC& = 1
DO
DIM a$: a$ = MID$(INDATA$, BC&, 3)
BC& = BC& + 3
DIM LL&: LL& = LL& + 4
IF LL& = 60 THEN
LL& = 0
PRINT #2, E$(a$);: PRINT #2, Q$
PRINT #2, "A$=A$+"; Q$;
ELSE
PRINT #2, E$(a$);
END IF
IF LEN(INDATA$) - BC& < 3 THEN
a$ = MID$(INDATA$, LEN(INDATA$) - BC&, 1)
DIM B$: B$ = E$(a$)
SELECT CASE LEN(B$)
CASE 0: a$ = Q$
CASE 1: a$ = "%%%" + B$ + Q$
CASE 2: a$ = "%%" + B$ + Q$
CASE 3: a$ = "%" + B$ + Q$
END SELECT: PRINT #2, a$;: EXIT DO
END IF
LOOP: PRINT #2, ""
PRINT #2, "FOR i&=1TO LEN(A$) STEP 4"
PRINT #2, "B$=MID$(A$,i&,4)"
PRINT #2, "IF INSTR(1,B$,"; Q$; "%"; Q$; ") THEN"
PRINT #2, "FOR C%=1 TO LEN(B$)"
PRINT #2, "F$=MID$(B$,C%,1)"
PRINT #2, "IF F$<>"; Q$; "%"; Q$; "THEN C$=C$+F$"
PRINT #2, "NEXT"
PRINT #2, "B$=C$"
PRINT #2, "END IF"
PRINT #2, "FOR j=1 TO LEN(B$)"
PRINT #2, "IF MID$(B$,j,1)="; Q$; "#"; Q$; " THEN"
PRINT #2, "MID$(B$,j)="; Q$; "@"; Q$
PRINT #2, "END IF"
PRINT #2, "NEXT"
PRINT #2, "FOR t%=LEN(B$) TO 1 STEP-1"
PRINT #2, "B&=B&*64+ASC(MID$(B$,t%))-48"
PRINT #2, "NEXT"
PRINT #2, "X$="; Q$; Q$
PRINT #2, "FOR t%=1 TO LEN(B$)-1"
PRINT #2, "X$=X$+CHR$(B& AND 255)"
PRINT #2, "B&=B&\256"
PRINT #2, "NEXT"
PRINT #2, "btemp$=btemp$+X$"
PRINT #2, "NEXT"
PRINT #2, "btemp$=_INFLATE$(btemp$,m.SIZE)"
PRINT #2, "_MEMPUT m,m.OFFSET,btemp$"
PRINT #2, "_MEMFREE m"
PRINT #2, "__" + StripDirectory(inFunc$) + "&=v&"
PRINT #2, "END FUNCTION"
CLOSE #2
_MEMFREE m
_FREEIMAGE pic
AddItem ListBox1, TIME$ + ": Image converted to MEM successfully"
AddItem ListBox1, TIME$ + ": File exported to " + OUT$
ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$
Text(SelectedFileTB) = ""
Text(OutputFileTB) = ""
Control(CONVERTBT).Disabled = True
Control(OpenBT).Disabled = True
Control(BIN2BASRB).Value = False
Control(PIC2MEMRB).Value = False
END SUB
FUNCTION __opensmall&
DIM v&
DIM A$
DIM btemp$
DIM i&
DIM B$
DIM C%
DIM F$
DIM C$
DIM j
DIM t%
DIM B&
DIM X$
v& = _NEWIMAGE(16, 16, 32)
DIM m AS _MEM: m = _MEMIMAGE(v&)
A$ = "haiHP1:6<GPhK34O7Xh[24W99XooS3\jDXng<#lD#3g>#\\4Yna5n^0a\#1j"
A$ = A$ + "74FIlXoo0e>^1N`bS5moGPhf0R5Q82c`Vo?66P4V_MPhOCTn3HZ[1PHi0RO>"
A$ = A$ + "96><APhU14c7#l59Am^EPHV1RiV18aeTRN_4#<_#moMCRjmY<PJh?XdEKQ8`"
A$ = A$ + "K28^IPHa`GT1m600eW8R%%%0"
FOR i& = 1 TO LEN(A$) STEP 4
B$ = MID$(A$, i&, 4)
IF INSTR(1, B$, "%") THEN
FOR C% = 1 TO LEN(B$)
F$ = MID$(B$, C%, 1)
IF F$ <> "%" THEN C$ = C$ + F$
NEXT
B$ = C$
END IF
FOR j = 1 TO LEN(B$)
IF MID$(B$, j, 1) = "#" THEN
MID$(B$, j) = "@"
END IF
NEXT
FOR t% = LEN(B$) TO 1 STEP -1
B& = B& * 64 + ASC(MID$(B$, t%)) - 48
NEXT
X$ = ""
FOR t% = 1 TO LEN(B$) - 1
X$ = X$ + CHR$(B& AND 255)
B& = B& \ 256
NEXT
btemp$ = btemp$ + X$
NEXT
btemp$ = _INFLATE$(btemp$, m.SIZE)
_MEMPUT m, m.OFFSET, btemp$: _MEMFREE m
__opensmall& = v&
END FUNCTION
FUNCTION __convert&
DIM v&
DIM A$
DIM btemp$
DIM i&
DIM B$
DIM C%
DIM F$
DIM C$
DIM j
DIM t%
DIM B&
DIM X$
v& = _NEWIMAGE(16, 16, 32)
DIM m AS _MEM: m = _MEMIMAGE(v&)
A$ = "haIM#f6BC6557olUj3A#R44H98hDS4c\b:B]V:Jj23JiCBjl56FKfHVV6[Dc"
A$ = A$ + "5R_lm\_F8dl;1Q8EFOaNA4[Xd4eLY=L[mBZK=leIcmfYcARAbcj2ohN_?Wko"
A$ = A$ + "O?gkA_NQRd[G#E4#Bc=;7dYk2`2]E5h\MUBMgeEAJN[molNE0fKE1#WAM`PN"
A$ = A$ + "`=gLILS=F4GK=Kh#3e?bOW81>?OF2T`2A0RAMX_lThlDm[kcgjX7?^aEFI1d"
A$ = A$ + "U[i`16XGT7L=R4_o]_8H]UBUJBW0BcPikDBjdjn8P6J#V6ongPng;7fQ13M7"
A$ = A$ + "V2;<QF8P^ZA;<CSbQ>DY1NUVc1CMSRTA0eFKNJ34`;jekJKc1O?hg2G?C5e3"
A$ = A$ + "9;X?<2293?_VlH7PJeIGG`Pn#Onl8ba;7n3H^:^fCX<ZnGXlB:^h31bUO##Y"
A$ = A$ + "b<^IX#1#onm:bQQGlFLL;^a?>[3L4Sf`QoZE\Wn72Y\Z8T`i;[\CdHX#1a01"
A$ = A$ + "l;baSO6Ug\CLhY<Q_KRIaGo5Sh3jMP]j]DFe4988L4Mln8iXWnO3>YEghkoV"
A$ = A$ + "U`>J[K3Q9jSOi>b?oh_;ng1kPO;LoPkY?\_1AS>F6oT9kKc1O?hgBlbZ_>9B"
A$ = A$ + "f]VDCM?M69B<[26lk;^:>Vii5iH4SfahbGK300kR8V8A<IEIkcm;?h4fL9b1"
A$ = A$ + "gCS=gJd=Fa758TmX\C2dVb1P9;9MXf37;\gD??4cI[^9[;i5WNnU4ihcVF0i"
A$ = A$ + "jCOUC24m=CYW:MC:>=_6YIYAWB1`nbXbF]_R?L6W[:bahVMQLMcUW1HYR<Cj"
A$ = A$ + "7EVeX418\#Pdm?ZXBkBMjLmP8k`jBo6ig2g?hNZA7[RLM>?MN`FEW1LXD:h\"
A$ = A$ + "jL`W:;=YDnhfan?FCk<nLjno1EoFo1`f%%L2"
FOR i& = 1 TO LEN(A$) STEP 4
B$ = MID$(A$, i&, 4)
IF INSTR(1, B$, "%") THEN
FOR C% = 1 TO LEN(B$)
F$ = MID$(B$, C%, 1)
IF F$ <> "%" THEN C$ = C$ + F$
NEXT
B$ = C$
END IF
FOR j = 1 TO LEN(B$)
IF MID$(B$, j, 1) = "#" THEN
MID$(B$, j) = "@"
END IF
NEXT
FOR t% = LEN(B$) TO 1 STEP -1
B& = B& * 64 + ASC(MID$(B$, t%)) - 48
NEXT
X$ = ""
FOR t% = 1 TO LEN(B$) - 1
X$ = X$ + CHR$(B& AND 255)
B& = B& \ 256
NEXT
btemp$ = btemp$ + X$
NEXT
btemp$ = _INFLATE$(btemp$, m.SIZE)
_MEMPUT m, m.OFFSET, btemp$: _MEMFREE m
__convert& = v&
END FUNCTION
FUNCTION __reset&
DIM v&
DIM A$
DIM btemp$
DIM i&
DIM B$
DIM C%
DIM F$
DIM C$
DIM j
DIM t%
DIM B&
DIM X$
v& = _NEWIMAGE(16, 16, 32)
DIM m AS _MEM: m = _MEMIMAGE(v&)
A$ = "haiHP1J3`03<#1S<bXP<a4C:cHS=>;Pd6B<jc#3=D:PZO10a_08N30aM3D_["
A$ = A$ + "58mS0Rg;#\LhB_VK^ib0Dnk3dNKAK]eV7dTVAPVCQP<GPbK;jj=d#3UIPbM9"
A$ = A$ + "PbE0bRS^J1jnL6Xj^WeFK=_PhkP3>`2#ni3DM12TNoXK^05ki0MGRSVI>IPR"
A$ = A$ + "g3<g5#fG6Tj0jnf3#jSPVnOQYVJZ4Xi6<1Xh?59eh6#lo1R_6#\bX[O#f5#k"
A$ = A$ + "\NPH=19V:ZX2k05kGjYWNL3CM0]kT0:6oXkn19>#L3Pd?#ie0GjWD0Xkn9E0"
A$ = A$ + "JQOTZM3>n3;Y?84P9Pj[8LUn1G0PZ=EPjIM4CjG\10Znh1Rc4HJ038Ag;A10"
A$ = A$ + "0lQl%%h1"
FOR i& = 1 TO LEN(A$) STEP 4
B$ = MID$(A$, i&, 4)
IF INSTR(1, B$, "%") THEN
FOR C% = 1 TO LEN(B$)
F$ = MID$(B$, C%, 1)
IF F$ <> "%" THEN C$ = C$ + F$
NEXT
B$ = C$
END IF
FOR j = 1 TO LEN(B$)
IF MID$(B$, j, 1) = "#" THEN
MID$(B$, j) = "@"
END IF
NEXT
FOR t% = LEN(B$) TO 1 STEP -1
B& = B& * 64 + ASC(MID$(B$, t%)) - 48
NEXT
X$ = ""
FOR t% = 1 TO LEN(B$) - 1
X$ = X$ + CHR$(B& AND 255)
B& = B& \ 256
NEXT
btemp$ = btemp$ + X$
NEXT
btemp$ = _INFLATE$(btemp$, m.SIZE)
_MEMPUT m, m.OFFSET, btemp$: _MEMFREE m
__reset& = v&
END FUNCTION
FUNCTION __deletesmall&
DIM v&
DIM A$
DIM btemp$
DIM i&
DIM B$
DIM C%
DIM F$
DIM C$
DIM j
DIM t%
DIM B&
DIM X$
v& = _NEWIMAGE(16, 16, 32)
DIM m AS _MEM: m = _MEMIMAGE(v&)
A$ = "haiHP1D16JXQm04o7S=fhoS<6ZHMa010PDWEFI5_X;>8a0:g_aVN<b8Sj3Kf"
A$ = A$ + "9^`PD;#md9Q\CL1PjFn5BjoG0=g68Al?ABon2e]A\jmo0MonP\K2TH#Y;28^"
A$ = A$ + "#THG4d`XRQa6VJaQn1K74PmXjWfYo=1<^J34P=fdo[0:_iX;>j0C<a4[0VNk"
A$ = A$ + "5HAon34oBR8_c;0UN5Vn04BU%%h1"
FOR i& = 1 TO LEN(A$) STEP 4
B$ = MID$(A$, i&, 4)
IF INSTR(1, B$, "%") THEN
FOR C% = 1 TO LEN(B$)
F$ = MID$(B$, C%, 1)
IF F$ <> "%" THEN C$ = C$ + F$
NEXT
B$ = C$
END IF
FOR j = 1 TO LEN(B$)
IF MID$(B$, j, 1) = "#" THEN
MID$(B$, j) = "@"
END IF
NEXT
FOR t% = LEN(B$) TO 1 STEP -1
B& = B& * 64 + ASC(MID$(B$, t%)) - 48
NEXT
X$ = ""
FOR t% = 1 TO LEN(B$) - 1
X$ = X$ + CHR$(B& AND 255)
B& = B& \ 256
NEXT
btemp$ = btemp$ + X$
NEXT
btemp$ = _INFLATE$(btemp$, m.SIZE)
_MEMPUT m, m.OFFSET, btemp$: _MEMFREE m
__deletesmall& = v&
END FUNCTION
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
END SUB
SUB __UI_OnLoad
Control(OpenBT).HelperCanvas = __opensmall&
Control(CONVERTBT).HelperCanvas = __convert&
Control(ResetBT).HelperCanvas = __reset&
Control(ClearLogBT).HelperCanvas = __deletesmall&
Control(OpenBT).Disabled = True
SetFrameRate 60
_ACCEPTFILEDROP
AddItem ListBox1, "Open a file above or drag and drop."
AddItem ListBox1, "Select BIN2BAS to convert a binary file to BM or select PIC2MEM to convert an image to MEM."
AddItem ListBox1, "To compile a file that is creating memory errors,"
AddItem ListBox1, "consult the readme on https://github.com/SpriggsySpriggs/BIN2INCLUDE"
END SUB
SUB __UI_BeforeUpdateDisplay
IF _TOTALDROPPEDFILES THEN
DIM drop$: drop$ = _DROPPEDFILE
IF _FILEEXISTS(drop$) THEN
IF NOT checkExt(drop$) AND Control(PIC2MEMRB).Value = False THEN
Control(BIN2BASRB).Value = True
Control(PIC2MEMRB).Disabled = True
Text(SelectedFileTB) = drop$
Text(OutputFileTB) = drop$ + ".BM"
Control(CONVERTBT).Disabled = False
ELSEIF checkExt(drop$) AND Control(PIC2MEMRB).Value = True THEN
Control(BIN2BASRB).Disabled = True
Text(SelectedFileTB) = drop$
Text(OutputFileTB) = drop$ + ".MEM"
Control(CONVERTBT).Disabled = False
ELSEIF checkExt(drop$) = 0 AND Control(PIC2MEMRB).Value = True THEN
MessageBox "Unsupported file type for PIC2MEM", _TITLE$, "warning"
Control(BIN2BASRB).Disabled = False
END IF
END IF
END IF
END SUB
SUB __UI_BeforeUnload
END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE BIN2INCLUDE
CASE SelectedFileTB
CASE OpenBT
IF Control(BIN2BASRB).Value = True THEN
_DELAY 0.2 ' delay a bit to allow InFrom to draw and refresh all comtrols before the modal dialog box takes over
DIM oFile$: oFile$ = _OPENFILEDIALOG$(_TITLE$)
Control(PIC2MEMRB).Disabled = True
ELSEIF Control(PIC2MEMRB).Value = True THEN
_DELAY 0.2 ' delay a bit to allow InFrom to draw and refresh all comtrols before the modal dialog box takes over
oFile$ = _OPENFILEDIALOG$(_TITLE$, , "*.BMP|*.bmp|*.JPG|*.jpg|*.JPEG|*.jpeg|*.PNG|*.png|*.GIF|*.gif", "Supported image files")
Control(BIN2BASRB).Disabled = True
END IF
IF oFile$ <> "" THEN
IF checkExt(oFile$) = 0 AND Control(PIC2MEMRB).Value = True THEN
MessageBox "Unsupported file type for PIC2MEM", _TITLE$, "warning"
Control(BIN2BASRB).Disabled = False
ELSEIF checkExt(oFile$) AND Control(PIC2MEMRB).Value = True THEN
Control(CONVERTBT).Disabled = False
Text(SelectedFileTB) = oFile$
Text(OutputFileTB) = oFile$ + ".MEM"
ELSE
Control(CONVERTBT).Disabled = False
Text(SelectedFileTB) = oFile$
Text(OutputFileTB) = oFile$ + ".BM"
END IF
ELSE
Text(SelectedFileTB) = ""
Text(OutputFileTB) = ""
Control(BIN2BASRB).Disabled = False
Control(PIC2MEMRB).Disabled = False
Control(CONVERTBT).Disabled = True
END IF
CASE CONVERTBT
IF Control(BIN2BASRB).Value = True THEN
_TITLE _TITLE$ + " - WORKING..."
bin2bas Text(SelectedFileTB), Text(OutputFileTB)
Control(PIC2MEMRB).Disabled = False
_TITLE "BIN2INCLUDE"
ELSEIF Control(PIC2MEMRB).Value = True THEN
_TITLE _TITLE$ + " - WORKING..."
pic2mem Text(SelectedFileTB), Text(OutputFileTB)
Control(BIN2BASRB).Disabled = False
_TITLE "BIN2INCLUDE"
ELSE
MessageBox "Select an option BIN2BAS or PIC2MEM first.", _TITLE$, "error"
END IF
CASE OutputFileTB
CASE ListBox1
CASE ClearLogBT
ResetList ListBox1
CASE ResetBT
ResetScreen
END SELECT
END SUB
SUB ResetScreen
Text(SelectedFileTB) = ""
Text(OutputFileTB) = ""
Control(BIN2BASRB).Disabled = False
Control(PIC2MEMRB).Disabled = False
Control(CONVERTBT).Disabled = True
ToolTip(ListBox1) = ""
END SUB
SUB __UI_MouseEnter (id AS LONG)
SELECT CASE id
CASE BIN2INCLUDE
CASE SelectedFileTB
CASE OpenBT
CASE CONVERTBT
CASE SaveBT
CASE OutputFileTB
CASE ListBox1
END SELECT
END SUB
SUB __UI_MouseLeave (id AS LONG)
SELECT CASE id
CASE BIN2INCLUDE
CASE SelectedFileTB
CASE OpenBT
CASE CONVERTBT
CASE SaveBT
CASE OutputFileTB
CASE ListBox1
END SELECT
END SUB
SUB __UI_FocusIn (id AS LONG)
SELECT CASE id
CASE SelectedFileTB
CASE OpenBT
CASE CONVERTBT
CASE SaveBT
CASE OutputFileTB
CASE ListBox1
END SELECT
END SUB
SUB __UI_FocusOut (id AS LONG)
SELECT CASE id
CASE SelectedFileTB
CASE OpenBT
CASE CONVERTBT
CASE SaveBT
CASE OutputFileTB
CASE ListBox1
END SELECT
END SUB
SUB __UI_MouseDown (id AS LONG)
SELECT CASE id
CASE BIN2INCLUDE
CASE SelectedFileTB
CASE OpenBT
CASE CONVERTBT
CASE SaveBT
CASE OutputFileTB
CASE ListBox1
END SELECT
END SUB
SUB __UI_MouseUp (id AS LONG)
SELECT CASE id
CASE BIN2INCLUDE
CASE SelectedFileTB
CASE OpenBT
CASE CONVERTBT
CASE SaveBT
CASE OutputFileTB
CASE ListBox1
END SELECT
END SUB
SUB __UI_KeyPress (id AS LONG)
SELECT CASE id
CASE SelectedFileTB
CASE OpenBT
CASE CONVERTBT
CASE OutputFileTB
CASE ListBox1
END SELECT
END SUB
SUB __UI_TextChanged (id AS LONG)
SELECT CASE id
CASE SelectedFileTB
CASE OutputFileTB
END SELECT
END SUB
SUB __UI_ValueChanged (id AS LONG)
SELECT CASE id
CASE ListBox1
CASE BIN2BASRB
Control(OpenBT).Disabled = False
_TITLE "BIN2INCLUDE - BIN2BAS"
CASE PIC2MEMRB
Control(OpenBT).Disabled = False
_TITLE "BIN2INCLUDE - PIC2MEM"
END SELECT
END SUB
SUB __UI_FormResized
END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

90
examples/Bin2Include/BIN2INCLUDE.frm Normal file
View file

@ -0,0 +1,90 @@
': This form was generated by
': InForm - GUI library for QB64 - v1.5
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "BIN2INCLUDE", 589, 324, 0, 0, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "BIN2INCLUDE"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CenteredWindow = True
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "SelectedFileTB", 567, 23, 11, 10, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Selected File"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).Disabled = True
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Button, "OpenBT", 80, 23, 11, 78, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Open"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CONVERTBT", 80, 23, 96, 78, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Convert"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).Disabled = True
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "OutputFileTB", 567, 23, 11, 38, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Output File"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).Disabled = True
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_ListBox, "ListBox1", 567, 200, 11, 114, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).BorderSize = 1
Control(__UI_NewID).AutoScroll = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ClearLogBT", 80, 23, 498, 78, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Clear Log"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "BIN2BASRB", 76, 23, 189, 78, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "BIN2BAS"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "PIC2MEMRB", 82, 23, 270, 78, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "PIC2MEM"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ResetBT", 80, 23, 413, 78, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Reset"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
END SUB
SUB __UI_AssignIDs
BIN2INCLUDE = __UI_GetID("BIN2INCLUDE")
SelectedFileTB = __UI_GetID("SelectedFileTB")
OpenBT = __UI_GetID("OpenBT")
CONVERTBT = __UI_GetID("CONVERTBT")
OutputFileTB = __UI_GetID("OutputFileTB")
ListBox1 = __UI_GetID("ListBox1")
ClearLogBT = __UI_GetID("ClearLogBT")
BIN2BASRB = __UI_GetID("BIN2BASRB")
PIC2MEMRB = __UI_GetID("PIC2MEMRB")
ResetBT = __UI_GetID("ResetBT")
END SUB

BIN
examples/Bin2Include/BIN2INCLUDE.ico Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 7.8 KiB

998
examples/Calculator/Calculator.bas
View file

File diff suppressed because it is too large Load diff

344
examples/Calculator/InForm/InForm.bi
View file

@ -1,344 +0,0 @@
'InForm - GUI library for QB64
'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
'
$If VERSION < 3.8 Then
$Error This requires the latest version of QB64-PE from https://github.com/QB64-Phoenix-Edition/QB64pe/releases
$End If
DECLARE LIBRARY
FUNCTION __UI_GetPID ALIAS getpid ()
END DECLARE
DECLARE CUSTOMTYPE LIBRARY
SUB __UI_MemCopy ALIAS memcpy (BYVAL dest AS _OFFSET, BYVAL source AS _OFFSET, BYVAL bytes AS LONG)
END DECLARE
$IF WIN THEN
DECLARE LIBRARY
FUNCTION GetSystemMetrics& (BYVAL WhichMetric&)
END DECLARE
CONST __UI_SM_SWAPBUTTON = 23
$END IF
$SCREENHIDE
_CONTROLCHR OFF
TYPE __UI_ControlTYPE
ID AS LONG
ParentID AS LONG
PreviousParentID AS LONG
ContextMenuID AS LONG
Type AS INTEGER
Name AS STRING * 40
ParentName AS STRING * 40
SubMenu AS _BYTE
MenuPanelID AS LONG
SourceControl AS LONG
Top AS INTEGER
Left AS INTEGER
Width AS INTEGER
Height AS INTEGER
Canvas AS LONG
HelperCanvas AS LONG
TransparentColor AS _UNSIGNED LONG
Stretch AS _BYTE
PreviousStretch AS _BYTE
Font AS INTEGER
PreviousFont AS INTEGER
BackColor AS _UNSIGNED LONG
ForeColor AS _UNSIGNED LONG
SelectedForeColor AS _UNSIGNED LONG
SelectedBackColor AS _UNSIGNED LONG
BackStyle AS _BYTE
HasBorder AS _BYTE
BorderSize AS INTEGER
Padding AS INTEGER
Encoding AS LONG
Align AS _BYTE
PrevAlign AS _BYTE
VAlign AS _BYTE
PrevVAlign AS _BYTE
BorderColor AS _UNSIGNED LONG
Value AS _FLOAT
PreviousValue AS _FLOAT
Min AS _FLOAT
PrevMin AS _FLOAT
Max AS _FLOAT
PrevMax AS _FLOAT
Interval AS _FLOAT
PrevInterval AS _FLOAT
MinInterval AS _FLOAT
PrevMinInterval AS _FLOAT
HotKey AS INTEGER
HotKeyOffset AS INTEGER
HotKeyPosition AS INTEGER
ShowPercentage AS _BYTE
AutoScroll AS _BYTE
AutoSize AS _BYTE
InputViewStart AS LONG
PreviousInputViewStart AS LONG
LastVisibleItem AS INTEGER
ItemHeight AS INTEGER
HasVScrollbar AS _BYTE
VScrollbarButton2Top AS INTEGER
HoveringVScrollbarButton AS _BYTE
ThumbHeight AS INTEGER
ThumbTop AS INTEGER
VScrollbarRatio AS SINGLE
Cursor AS LONG
PasswordField AS _BYTE
PrevCursor AS LONG
FieldArea AS LONG
PreviousFieldArea AS LONG
TextIsSelected AS _BYTE
BypassSelectOnFocus AS _BYTE
Multiline AS _BYTE
NumericOnly AS _BYTE
FirstVisibleLine AS LONG
PrevFirstVisibleLine AS LONG
CurrentLine AS LONG
PrevCurrentLine AS LONG
VisibleCursor AS LONG
PrevVisibleCursor AS LONG
ControlIsSelected AS _BYTE
LeftOffsetFromFirstSelected AS INTEGER
TopOffsetFromFirstSelected AS INTEGER
SelectionLength AS LONG
SelectionStart AS LONG
WordWrap AS _BYTE
CanResize AS _BYTE
CanHaveFocus AS _BYTE
Disabled AS _BYTE
Hidden AS _BYTE
PreviouslyHidden AS _BYTE
CenteredWindow AS _BYTE
ControlState AS _BYTE
ChildrenRedrawn AS _BYTE
FocusState AS LONG
LastChange AS SINGLE
Redraw AS _BYTE
BulletStyle AS _BYTE
MenuItemGroup AS INTEGER
KeyCombo AS LONG
BoundTo AS LONG
BoundProperty AS LONG
END TYPE
TYPE __UI_Types
Name AS STRING * 16
Count AS LONG
TurnsInto AS INTEGER
DefaultHeight AS INTEGER
MinimumHeight AS INTEGER
DefaultWidth AS INTEGER
MinimumWidth AS INTEGER
RestrictResize AS _BYTE
END TYPE
TYPE __UI_ThemeImagesType
FileName AS STRING * 32
Handle AS LONG
END TYPE
TYPE __UI_WordWrapHistoryType
StringSlot AS LONG
Width AS INTEGER
LongestLine AS INTEGER
Font AS LONG
TotalLines AS INTEGER
END TYPE
TYPE __UI_KeyCombos
Combo AS STRING * 14 ' "CTRL+SHIFT+F12"
FriendlyCombo AS STRING * 14 ' "Ctrl+Shift+F12"
ControlID AS LONG
END TYPE
REDIM SHARED Caption(0 TO 100) AS STRING
REDIM SHARED __UI_TempCaptions(0 TO 100) AS STRING
REDIM SHARED Text(0 TO 100) AS STRING
REDIM SHARED __UI_TempTexts(0 TO 100) AS STRING
REDIM SHARED Mask(0 TO 100) AS STRING
REDIM SHARED __UI_TempMask(0 TO 100) AS STRING
REDIM SHARED ToolTip(0 TO 100) AS STRING
REDIM SHARED __UI_TempTips(0 TO 100) AS STRING
REDIM SHARED Control(0 TO 100) AS __UI_ControlTYPE
REDIM SHARED ControlDrawOrder(0) AS LONG
REDIM SHARED __UI_ThemeImages(0 TO 100) AS __UI_ThemeImagesType
REDIM SHARED __UI_WordWrapHistoryTexts(0 TO 100) AS STRING
REDIM SHARED __UI_WordWrapHistoryResults(0 TO 100) AS STRING
REDIM SHARED __UI_WordWrapHistory(0 TO 100) AS __UI_WordWrapHistoryType
REDIM SHARED __UI_ThisLineChars(0) AS LONG, __UI_FocusedTextBoxChars(0) AS LONG
REDIM SHARED __UI_ActiveMenu(0 TO 100) AS LONG, __UI_ParentMenu(0 TO 100) AS LONG
REDIM SHARED __UI_KeyCombo(0 TO 100) AS __UI_KeyCombos
DIM SHARED __UI_TotalKeyCombos AS LONG, __UI_BypassKeyCombos AS _BYTE
DIM SHARED table1252$(0 TO 255), table437$(0 TO 255)
DIM SHARED __UI_MouseLeft AS INTEGER, __UI_MouseTop AS INTEGER
DIM SHARED __UI_MouseWheel AS INTEGER, __UI_MouseButtonsSwap AS _BYTE
DIM SHARED __UI_PrevMouseLeft AS INTEGER, __UI_PrevMouseTop AS INTEGER
DIM SHARED __UI_MouseButton1 AS _BYTE, __UI_MouseButton2 AS _BYTE
DIM SHARED __UI_MouseIsDown AS _BYTE, __UI_MouseDownOnID AS LONG
DIM SHARED __UI_Mouse2IsDown AS _BYTE, __UI_Mouse2DownOnID AS LONG
DIM SHARED __UI_PreviousMouseDownOnID AS LONG
DIM SHARED __UI_KeyIsDown AS _BYTE, __UI_KeyDownOnID AS LONG
DIM SHARED __UI_ShiftIsDown AS _BYTE, __UI_CtrlIsDown AS _BYTE
DIM SHARED __UI_AltIsDown AS _BYTE, __UI_ShowHotKeys AS _BYTE, __UI_AltCombo$
DIM SHARED __UI_LastMouseClick AS SINGLE, __UI_MouseDownOnScrollbar AS SINGLE
DIM SHARED __UI_DragX AS INTEGER, __UI_DragY AS INTEGER
DIM SHARED __UI_DefaultButtonID AS LONG
DIM SHARED __UI_KeyHit AS LONG, __UI_KeepFocus AS _BYTE
DIM SHARED __UI_Focus AS LONG, __UI_PreviousFocus AS LONG, __UI_KeyboardFocus AS _BYTE
DIM SHARED __UI_HoveringID AS LONG, __UI_LastHoveringID AS LONG, __UI_BelowHoveringID AS LONG
DIM SHARED __UI_IsDragging AS _BYTE, __UI_DraggingID AS LONG
DIM SHARED __UI_IsResizing AS _BYTE, __UI_ResizingID AS LONG
DIM SHARED __UI_ResizeHandleHover AS _BYTE
DIM SHARED __UI_IsSelectingText AS _BYTE, __UI_IsSelectingTextOnID AS LONG
DIM SHARED __UI_SelectedText AS STRING, __UI_SelectionLength AS LONG
DIM SHARED __UI_StateHasChanged AS _BYTE
DIM SHARED __UI_DraggingThumb AS _BYTE, __UI_ThumbDragTop AS INTEGER
DIM SHARED __UI_DraggingThumbOnID AS LONG
DIM SHARED __UI_HasInput AS _BYTE, __UI_ProcessInputTimer AS SINGLE
DIM SHARED __UI_UnloadSignal AS _BYTE, __UI_HasResized AS _BYTE
DIM SHARED __UI_ExitTriggered AS _BYTE
DIM SHARED __UI_Loaded AS _BYTE
DIM SHARED __UI_EventsTimer AS INTEGER, __UI_RefreshTimer AS INTEGER
DIM SHARED __UI_ActiveDropdownList AS LONG, __UI_ParentDropdownList AS LONG
DIM SHARED __UI_TotalActiveMenus AS LONG, __UI_ActiveMenuIsContextMenu AS _BYTE
DIM SHARED __UI_SubMenuDelay AS SINGLE, __UI_HoveringSubMenu AS _BYTE
DIM SHARED __UI_TopMenuBarItem AS LONG
DIM SHARED __UI_ActiveTipID AS LONG, __UI_TipTimer AS SINGLE, __UI_PreviousTipID AS LONG
DIM SHARED __UI_ActiveTipTop AS INTEGER, __UI_ActiveTipLeft AS INTEGER
DIM SHARED __UI_FormID AS LONG, __UI_HasMenuBar AS LONG
DIM SHARED __UI_ScrollbarWidth AS INTEGER, __UI_ScrollbarButtonHeight AS INTEGER
DIM SHARED __UI_MenuBarOffset AS INTEGER, __UI_MenuItemOffset AS INTEGER
DIM SHARED __UI_NewMenuBarTextLeft AS INTEGER, __UI_DefaultCaptionIndent AS INTEGER
DIM SHARED __UI_ForceRedraw AS _BYTE, __UI_AutoRefresh AS _BYTE
DIM SHARED __UI_CurrentTitle AS STRING
DIM SHARED __UI_DesignMode AS _BYTE, __UI_FirstSelectedID AS LONG
DIM SHARED __UI_WaitMessage AS STRING, __UI_TotalSelectedControls AS LONG
DIM SHARED __UI_WaitMessageHandle AS LONG, __UI_EditorMode AS _BYTE
DIM SHARED __UI_LastRenderedCharCount AS LONG
DIM SHARED __UI_SelectionRectangleTop AS INTEGER, __UI_SelectionRectangleLeft AS INTEGER
DIM SHARED __UI_SelectionRectangle AS _BYTE
DIM SHARED __UI_CantShowContextMenu AS _BYTE, __UI_ShowPositionAndSize AS _BYTE
DIM SHARED __UI_ShowInvisibleControls AS _BYTE, __UI_Snapped AS _BYTE
DIM SHARED __UI_SnappedByProximityX AS _BYTE, __UI_SnappedByProximityY AS _BYTE
DIM SHARED __UI_SnappedX AS INTEGER, __UI_SnappedY AS INTEGER
DIM SHARED __UI_SnappedXID AS LONG, __UI_SnappedYID AS LONG
DIM SHARED __UI_SnapLines AS _BYTE, __UI_SnapDistance AS INTEGER, __UI_SnapDistanceFromForm AS INTEGER
DIM SHARED __UI_FrameRate AS SINGLE, __UI_Font8Offset AS INTEGER, __UI_Font16Offset AS INTEGER
DIM SHARED __UI_ClipboardCheck$, __UI_MenuBarOffsetV AS INTEGER
DIM SHARED __UI_KeepScreenHidden AS _BYTE, __UI_MaxBorderSize AS INTEGER
DIM SHARED __UI_InternalContextMenus AS LONG, __UI_DidClick AS _BYTE
DIM SHARED __UI_ContextMenuSourceID AS LONG
DIM SHARED __UI_FKey(1 TO 12) AS LONG
'Control types: -----------------------------------------------
DIM SHARED __UI_Type(0 TO 18) AS __UI_Types
__UI_Type(__UI_Type_Form).Name = "Form"
__UI_Type(__UI_Type_Frame).Name = "Frame"
__UI_Type(__UI_Type_Frame).DefaultWidth = 230
__UI_Type(__UI_Type_Frame).DefaultHeight = 150
__UI_Type(__UI_Type_Button).Name = "Button"
__UI_Type(__UI_Type_Button).DefaultWidth = 80
__UI_Type(__UI_Type_Button).DefaultHeight = 23
__UI_Type(__UI_Type_Label).Name = "Label"
__UI_Type(__UI_Type_Label).DefaultWidth = 150
__UI_Type(__UI_Type_Label).DefaultHeight = 23
__UI_Type(__UI_Type_CheckBox).Name = "CheckBox"
__UI_Type(__UI_Type_CheckBox).DefaultWidth = 150
__UI_Type(__UI_Type_CheckBox).DefaultHeight = 23
__UI_Type(__UI_Type_CheckBox).TurnsInto = __UI_Type_ToggleSwitch
__UI_Type(__UI_Type_RadioButton).Name = "RadioButton"
__UI_Type(__UI_Type_RadioButton).DefaultWidth = 150
__UI_Type(__UI_Type_RadioButton).DefaultHeight = 23
__UI_Type(__UI_Type_TextBox).Name = "TextBox"
__UI_Type(__UI_Type_TextBox).DefaultWidth = 120
__UI_Type(__UI_Type_TextBox).DefaultHeight = 23
__UI_Type(__UI_Type_ProgressBar).Name = "ProgressBar"
__UI_Type(__UI_Type_ProgressBar).DefaultWidth = 300
__UI_Type(__UI_Type_ProgressBar).DefaultHeight = 23
__UI_Type(__UI_Type_ListBox).Name = "ListBox"
__UI_Type(__UI_Type_ListBox).DefaultWidth = 200
__UI_Type(__UI_Type_ListBox).DefaultHeight = 200
__UI_Type(__UI_Type_ListBox).TurnsInto = __UI_Type_DropdownList
__UI_Type(__UI_Type_DropdownList).Name = "DropdownList"
__UI_Type(__UI_Type_DropdownList).DefaultWidth = 200
__UI_Type(__UI_Type_DropdownList).DefaultHeight = 23
__UI_Type(__UI_Type_DropdownList).TurnsInto = __UI_Type_ListBox
__UI_Type(__UI_Type_MenuBar).Name = "MenuBar"
__UI_Type(__UI_Type_MenuBar).TurnsInto = __UI_Type_ContextMenu
__UI_Type(__UI_Type_MenuBar).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_MenuItem).Name = "MenuItem"
__UI_Type(__UI_Type_MenuItem).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_MenuPanel).Name = "MenuPanel"
__UI_Type(__UI_Type_PictureBox).Name = "PictureBox"
__UI_Type(__UI_Type_PictureBox).DefaultWidth = 230
__UI_Type(__UI_Type_PictureBox).DefaultHeight = 150
__UI_Type(__UI_Type_TrackBar).Name = "TrackBar"
__UI_Type(__UI_Type_TrackBar).DefaultWidth = 300
__UI_Type(__UI_Type_TrackBar).DefaultHeight = 40
__UI_Type(__UI_Type_TrackBar).MinimumHeight = 30
__UI_Type(__UI_Type_TrackBar).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_ContextMenu).Name = "ContextMenu"
__UI_Type(__UI_Type_ContextMenu).TurnsInto = __UI_Type_MenuBar
__UI_Type(__UI_Type_ContextMenu).RestrictResize = __UI_CantResize
__UI_Type(__UI_Type_ContextMenu).DefaultWidth = 22
__UI_Type(__UI_Type_ContextMenu).DefaultHeight = 22
__UI_Type(__UI_Type_Font).Name = "Font"
__UI_Type(__UI_Type_ToggleSwitch).Name = "ToggleSwitch"
__UI_Type(__UI_Type_ToggleSwitch).DefaultWidth = 40
__UI_Type(__UI_Type_ToggleSwitch).DefaultHeight = 17
__UI_Type(__UI_Type_ToggleSwitch).TurnsInto = __UI_Type_CheckBox
__UI_Type(__UI_Type_ToggleSwitch).RestrictResize = __UI_CantResize
'--------------------------------------------------------------
__UI_RestoreFKeys
CONST False = 0, True = Not False
'$INCLUDE:'InFormVersion.bas'
__UI_SubMenuDelay = .4
__UI_SnapDistance = 5
__UI_SnapDistanceFromForm = 10
__UI_MaxBorderSize = 10
__UI_Font8Offset = 5
__UI_Font16Offset = 3
__UI_ClipboardCheck$ = "InForm" + STRING$(2, 10) + "BEGIN CONTROL DATA" + CHR$(10) + STRING$(60, 45) + CHR$(10)
__UI_ThemeSetup
__UI_InternalMenus
__UI_LoadForm
__UI_Init
'Main loop
DO
_LIMIT 1
LOOP
SYSTEM
__UI_ErrorHandler:
RESUME NEXT

8697
examples/Calculator/InForm/InForm.ui
View file

File diff suppressed because it is too large Load diff

7
examples/Calculator/InForm/InFormVersion.bas
View file

@ -1,7 +0,0 @@
'Starting with v1.0, __UI_VersionNumber is actually the current build.
CONST __UI_Version = "v1.5"
CONST __UI_VersionNumber = 1
CONST __UI_VersionIsBeta = 1
CONST __UI_CopyrightSpan = "2016-2023"

1144
examples/Calculator/InForm/xp.uitheme
View file

File diff suppressed because it is too large Load diff

182
examples/ClickTheVoid/ClickTheVoid.bas Normal file
View file

@ -0,0 +1,182 @@
': This program was generated by
': InForm - GUI system for QB64 - Beta version 7
': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - @fellippeheitor
'-----------------------------------------------------------
OPTION _EXPLICIT
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED ClickTheVoid AS LONG
DIM SHARED PictureBox1 AS LONG
DIM SHARED Button1 AS LONG
DIM SHARED TrackBar1 AS LONG
DIM SHARED fpsLB AS LONG
DIM SHARED start!, totalFrames AS _UNSIGNED LONG, fps AS INTEGER
DIM AS SINGLE CenterX, CenterY, Radius, MaxRadius
': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'ClickTheVoid.frm'
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
END SUB
SUB __UI_OnLoad
Caption(Button1) = "Clear"
SetFrameRate 120
start! = TIMER
END SUB
SUB __UI_BeforeUpdateDisplay
SHARED CenterX, CenterY, Radius, MaxRadius
BeginDraw PictureBox1
LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, 10), BF
totalFrames = totalFrames + 1
fps% = totalFrames / (TIMER - start!)
_PRINTSTRING (0, 0), STR$(fps%)
EndDraw PictureBox1
Radius = Radius + 1
IF Radius <= MaxRadius THEN
BeginDraw PictureBox1
CIRCLE (CenterX, CenterY), Radius, _RGBA32(RND * 255, RND * 255, RND * 255, RND * 255)
EndDraw PictureBox1
END IF
END SUB
SUB __UI_BeforeUnload
END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE TrackBar1
CASE fpsLB
CASE ClickTheVoid
CASE PictureBox1
SHARED MaxRadius, CenterX, CenterY, Radius
Radius = 0
MaxRadius = RND * 100 + 30
CenterX = __UI_MouseLeft - Control(id).Left
CenterY = __UI_MouseTop - Control(id).Top
CASE Button1
BeginDraw PictureBox1
CLS
MaxRadius = 0
start! = TIMER
totalFrames = 0
EndDraw PictureBox1
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
SELECT CASE id
CASE TrackBar1
CASE fpsLB
CASE ClickTheVoid
CASE PictureBox1
CASE Button1
END SELECT
END SUB
SUB __UI_MouseLeave (id AS LONG)
SELECT CASE id
CASE TrackBar1
CASE fpsLB
CASE ClickTheVoid
CASE PictureBox1
CASE Button1
END SELECT
END SUB
SUB __UI_FocusIn (id AS LONG)
SELECT CASE id
CASE TrackBar1
CASE Button1
END SELECT
END SUB
SUB __UI_FocusOut (id AS LONG)
SELECT CASE id
CASE TrackBar1
CASE Button1
END SELECT
END SUB
SUB __UI_MouseDown (id AS LONG)
SELECT CASE id
CASE TrackBar1
CASE fpsLB
CASE ClickTheVoid
CASE PictureBox1
CASE Button1
END SELECT
END SUB
SUB __UI_MouseUp (id AS LONG)
SELECT CASE id
CASE TrackBar1
CASE fpsLB
CASE ClickTheVoid
CASE PictureBox1
CASE Button1
END SELECT
END SUB
SUB __UI_KeyPress (id AS LONG)
SELECT CASE id
CASE TrackBar1
CASE Button1
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
CASE TrackBar1
Caption(fpsLB) = LTRIM$(STR$(Control(id).Value)) + "fps"
SetFrameRate Control(id).Value
END SELECT
END SUB
SUB __UI_FormResized
END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

54
examples/ClickTheVoid/ClickTheVoid.frm Normal file
View file

@ -0,0 +1,54 @@
': This form was generated by
': InForm - GUI library for QB64 - v1.5
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "ClickTheVoid", 300, 322, 0, 0, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Click the void"
Control(__UI_NewID).Font = SetFont("segoeui.ttf?arial.ttf?/Library/Fonts/Arial.ttf?InForm/resources/NotoMono-Regular.ttf?cour.ttf", 12)
Control(__UI_NewID).HasBorder = False
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox1", 280, 258, 10, 10, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).BackColor = _RGB32(0, 0, 0)
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Button, "Button1", 80, 23, 210, 280, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Button1"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_TrackBar, "TrackBar1", 143, 40, 16, 272, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Value = 30
Control(__UI_NewID).Min = 30
Control(__UI_NewID).Max = 1000
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).Interval = 50
__UI_NewID = __UI_NewControl(__UI_Type_Label, "fpsLB", 38, 41, 164, 272, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "30fps"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).VAlign = __UI_Middle
END SUB
SUB __UI_AssignIDs
ClickTheVoid = __UI_GetID("ClickTheVoid")
PictureBox1 = __UI_GetID("PictureBox1")
Button1 = __UI_GetID("Button1")
TrackBar1 = __UI_GetID("TrackBar1")
fpsLB = __UI_GetID("fpsLB")
END SUB

665
examples/ClockPatience/Clock Patience.bas Normal file
View file

@ -0,0 +1,665 @@
': Clock Patience (extra animations) by QWERKEY 2019-01-30 (updated 2019-03-16)
': Version with card pick-up and placement animation
': Images from pngimg.com, all-free-download.com, openclipart.org
': This program uses
': InForm - GUI library for QB64 - Beta version 8
': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED ClockPatience AS LONG
DIM SHARED ExitBT AS LONG
DIM SHARED NewGameBT AS LONG
CONST Offset%% = 7, Pi! = 3.141592, Hours! = -Pi! / 6, ZOffset! = -398, XImage% = 182, YImage% = 252
CONST Halfwidth%% = 50, Halfheight%% = Halfwidth%% * YImage% / XImage%, Radius% = 320, Tucked%% = 7
DIM SHARED CardsImg&(51), Obverse&, RedHighlight&, GreenHighlight&, GameOver&, GameWon&, XM%, YM%
DIM SHARED PickedUp%%, PickedHour%%, PickedCard%%, CanPutDown%%, Orient!, Orient0!, OldHour%%
DIM SHARED Anime1%%, Anime2%%, DoPickUp%%, TurnOver%%, GreenValid%%, RedValid%%, Cards%%(51)
DIM SHARED DoPatience%%, Stock%%, IsComplete%%, GotOut%%, Positions!(4, 12, 1, 4), Phi!(12)
REDIM SHARED Clock%%(12, 4, 2)
': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Clock Patience.frm'
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
$EXEICON:'.\clubs.ico'
DoPatience%% = False
Anime1%% = 31
Anime2%% = 43
'Set Data
FOR N%% = 0 TO 6
Phi!(N%%) = N%% * Hours!
NEXT N%%
FOR N%% = 7 TO 11
Phi!(N%%) = (N%% - 12) * Hours!
NEXT N%%
FOR S%% = 0 TO 4
Positions!(S%%, 0, 0, 4) = 0
Positions!(S%%, 0, 1, 4) = Radius% - Tucked%% * S%%
Positions!(S%%, 0, 0, 3) = Positions!(S%%, 0, 0, 4) + Halfwidth%%
Positions!(S%%, 0, 1, 3) = Positions!(S%%, 0, 1, 4) - Halfheight%%
Positions!(S%%, 0, 0, 2) = Positions!(S%%, 0, 0, 4) - Halfwidth%%
Positions!(S%%, 0, 1, 2) = Positions!(S%%, 0, 1, 4) - Halfheight%%
Positions!(S%%, 0, 0, 1) = Positions!(S%%, 0, 0, 4) + Halfwidth%%
Positions!(S%%, 0, 1, 1) = Positions!(S%%, 0, 1, 4) + Halfheight%%
Positions!(S%%, 0, 0, 0) = Positions!(S%%, 0, 0, 4) - Halfwidth%%
Positions!(S%%, 0, 1, 0) = Positions!(S%%, 0, 1, 4) + Halfheight%%
NEXT S%%
FOR S%% = 0 TO 4
FOR N%% = 1 TO 11
FOR M%% = 0 TO 4
CALL Angle((Positions!(S%%, 0, 0, M%%)), (Positions!(S%%, 0, 1, M%%)), Positions!(S%%, N%%, 0, M%%), Positions!(S%%, N%%, 1, M%%), (Phi!(N%%)))
NEXT M%%
NEXT N%%
NEXT S%%
FOR S%% = 0 TO 4
Positions!(S%%, 12, 0, 0) = Tucked%% * (3 - S%%) - Halfwidth%%
Positions!(S%%, 12, 1, 0) = Halfheight%%
Positions!(S%%, 12, 0, 1) = Positions!(S%%, 12, 0, 0) + 2 * Halfwidth%%
Positions!(S%%, 12, 1, 1) = Halfheight%%
Positions!(S%%, 12, 0, 2) = Tucked%% * (3 - S%%) - Halfwidth%%
Positions!(S%%, 12, 1, 2) = -Halfheight%%
Positions!(S%%, 12, 0, 3) = Positions!(S%%, 12, 0, 2) + 2 * Halfwidth%%
Positions!(S%%, 12, 1, 3) = -Halfheight%%
Positions!(S%%, 12, 0, 4) = Tucked%% * (3 - S%%)
Positions!(S%%, 12, 1, 4) = 0
NEXT S%%
'Images
playingcards& = _LOADIMAGE("pack of cards.png", 32)
Corner& = _NEWIMAGE(33, 33, 32)
_DEST Corner&
COLOR _RGB32(247, 247, 247), _RGBA32(100, 100, 100, 0)
CIRCLE (16, 16), 16
PAINT (16, 16)
CIRCLE (16, 16), 16, _RGB32(204, 119, 34)
FOR N%% = 0 TO 51
R1%% = N%% \ 13
C1%% = N%% MOD 13
R2%% = R1%% \ 2
C2%% = R1%% MOD 2
R3%% = C1%% \ 5
C3%% = C1%% MOD 5
TempImg& = _NEWIMAGE(XImage%, YImage%, 32)
_DEST TempImg&
COLOR _RGB32(247, 247, 247), _RGBA32(100, 100, 100, 0)
_PUTIMAGE (0, 0), Corner&
_PUTIMAGE (0, YImage% - 33), Corner&
_PUTIMAGE (XImage% - 33, 0), Corner&
_PUTIMAGE (XImage% - 33, YImage% - 33), Corner&
LINE (16, 0)-(XImage% - 17, YImage% - 1), , BF
LINE (0, 16)-(XImage% - 1, YImage% - 17), , BF
LINE (16, 0)-(XImage% - 17, 0), _RGB32(204, 119, 34)
LINE (16, YImage% - 1)-(XImage% - 17, YImage% - 1), _RGB32(204, 119, 34)
LINE (0, 16)-(0, YImage% - 17), _RGB32(204, 119, 34)
LINE (XImage% - 1, 16)-(XImage% - 1, YImage% - 17), _RGB32(204, 119, 34)
X1! = 7 + 203 * C3%% + 996 * C2%%
X2! = 167 + X1!
Y1! = 13 + 267 * R3%% + 786 * R2%%
Y2! = Y1! + 222
_PUTIMAGE (6, 14)-(XImage% - 7, YImage% - 15), playingcards&, , (7 + 203 * C3%% + 996 * C2%%, Y1!)-(X2!, Y2!)
IF N%% = 23 THEN
F& = _LOADFONT("cyberbit.ttf", 14)
_FONT F&
COLOR _RGB32(226, 226, 226)
Q1$ = "PVDQJDX"
FOR M%% = 1 TO 7
Q2$ = Q2$ + CHR$(ASC(MID$(Q1$, M%%, 1)) + 1)
NEXT M%%
_PRINTSTRING (XImage% - 110, YImage% - 20), Q2$
_FONT 16
_FREEFONT F&
END IF
CardsImg&(N%%) = _COPYIMAGE(TempImg&, 33)
_FREEIMAGE TempImg&
NEXT N%%
_FREEIMAGE Corner&
Corner& = _NEWIMAGE(33, 33, 32)
_DEST Corner&
COLOR _RGB32(200, 200, 247), _RGBA32(100, 100, 100, 0)
CIRCLE (16, 16), 16
PAINT (16, 16)
CIRCLE (16, 16), 16, _RGB32(204, 119, 34)
TempImg& = _NEWIMAGE(XImage%, YImage%, 32)
_DEST TempImg&
COLOR _RGB32(200, 200, 247)
_PUTIMAGE (0, 0), Corner&
_PUTIMAGE (0, YImage% - 33), Corner&
_PUTIMAGE (XImage% - 33, 0), Corner&
_PUTIMAGE (XImage% - 33, YImage% - 33), Corner&
LINE (16, 0)-(XImage% - 17, YImage% - 1), , BF
LINE (0, 16)-(XImage% - 1, YImage% - 17), , BF
LINE (16, 0)-(XImage% - 17, 0), _RGB32(204, 119, 34)
LINE (16, YImage% - 1)-(XImage% - 17, YImage% - 1), _RGB32(204, 119, 34)
LINE (0, 16)-(0, YImage% - 17), _RGB32(204, 119, 34)
LINE (XImage% - 1, 16)-(XImage% - 1, YImage% - 17), _RGB32(204, 119, 34)
C3%% = 4
C2%% = 0
R3%% = 2
R2%% = 0
X1! = 7 + 203 * C3%% + 996 * C2%%
X2! = 167 + X1!
Y1! = 13 + 267 * R3%% + 786 * R2%%
Y2! = Y1! + 222
_PUTIMAGE (14, 14)-(XImage% - 15, YImage% - 15), playingcards&, , (14 + 203 * C3%% + 996 * C2%%, Y1!)-(X2! - 4, Y2!)
Obverse& = _COPYIMAGE(TempImg&, 33)
_FREEIMAGE TempImg&
_FREEIMAGE Corner&
_FREEIMAGE playingcards&
TempImg& = _NEWIMAGE(81, 81, 32)
_DEST TempImg&
COLOR _RGB32(200, 0, 0)
CIRCLE (40, 40), 40
CIRCLE (40, 40), 39
CIRCLE (40, 40), 38
RedHighlight& = _COPYIMAGE(TempImg&, 33)
_FREEIMAGE TempImg&
TempImg& = _NEWIMAGE(81, 81, 32)
_DEST TempImg&
COLOR _RGB32(0, 200, 0)
CIRCLE (40, 40), 40
CIRCLE (40, 40), 39
CIRCLE (40, 40), 38
GreenHighlight& = _COPYIMAGE(TempImg&, 33)
_FREEIMAGE TempImg&
TempImg& = _NEWIMAGE(340, 80, 32)
_DEST TempImg&
COLOR _RGB32(0, 80, 32), _RGBA32(100, 100, 100, 0)
F& = _LOADFONT("cyberbit.ttf", 70)
_FONT F&
_PRINTSTRING (5, 5), "Game End"
_FONT 16
_FREEFONT F&
GameOver& = _COPYIMAGE(TempImg&, 33)
_FREEIMAGE TempImg&
TempImg& = _NEWIMAGE(356, 80, 32)
_DEST TempImg&
COLOR _RGB32(0, 80, 32), _RGBA32(100, 100, 100, 0)
F& = _LOADFONT("cyberbit.ttf", 70)
_FONT F&
_PRINTSTRING (5, 5), "Completed"
_FONT 16
_FREEFONT F&
GameWon& = _COPYIMAGE(TempImg&, 33)
_FREEIMAGE TempImg&
FOR N%% = 0 TO 51
Cards%%(N%%) = N%% + 1 'Cards%%() values adjusted to 1 - 13: then value 0 is empty
NEXT N%%
FOR N%% = 1 TO 4
CALL Shuffle(Cards%%())
NEXT N%%
END SUB
SUB __UI_OnLoad
_SCREENMOVE 50, 0
Caption(NewGameBT) = "Deal"
SetFocus NewGameBT
END SUB
SUB __UI_BeforeUpdateDisplay
'This event occurs at approximately 30 frames per second.
'You can change the update frequency by calling SetFrameRate DesiredRate%
STATIC Count%, InitDone%%, Grandad&, XStart%, YStart%
IF NOT InitDone%% THEN
InitDone%% = True
XStart% = -120
YStart% = 0
Grandad& = _LOADIMAGE("Clock1.png", 33)
END IF
IF NOT DoPatience%% THEN
_PUTIMAGE (201, 10), Grandad&
ELSE
IF GreenValid%% THEN
_MAPTRIANGLE (0, 0)-(80, 0)-(0, 80), GreenHighlight& TO(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)
_MAPTRIANGLE (80, 80)-(0, 80)-(80, 0), GreenHighlight& TO(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + -40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)
ELSEIF RedValid%% THEN
_MAPTRIANGLE (0, 0)-(80, 0)-(0, 80), RedHighlight& TO(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)
_MAPTRIANGLE (80, 80)-(0, 80)-(80, 0), RedHighlight& TO(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + -40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)
END IF
IF Anime1%% < 31 THEN
'Display turning-over
IF OldHour%% = 12 THEN
IF Anime1%% > 15 THEN
Xtent! = 2 * Halfwidth%% * (Anime1%% - 15) / 15
X0! = Positions!(4, OldHour%%, 0, 0)
Y0! = Positions!(4, OldHour%%, 1, 0)
Z0! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
X1! = Positions!(4, OldHour%%, 0, 0) + Xtent!
Y1! = Positions!(4, OldHour%%, 1, 0)
Z1! = 0
X2! = Positions!(4, OldHour%%, 0, 2)
Y2! = Positions!(4, OldHour%%, 1, 2)
Z2! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
X3! = Positions!(4, OldHour%%, 0, 2) + Xtent!
Y3! = Positions!(4, OldHour%%, 1, 2)
Z3! = 0
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
ELSE
Psi! = Anime1%% * Pi! / (2 * 15)
X0! = Positions!(4, OldHour%%, 0, 0)
Y0! = Positions!(4, OldHour%%, 1, 0)
Z0! = 0
X1! = X0! + 2 * Halfwidth%% * COS(Psi!)
Y1! = Y0!
Z1! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
X2! = Positions!(4, OldHour%%, 0, 2)
Y2! = Positions!(4, OldHour%%, 1, 2)
Z2! = 0
X3! = X2! + 2 * Halfwidth%% * COS(Psi!)
Y3! = Y2!
Z3! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
END IF
ELSE
IF Anime1%% > 15 THEN
Xtent! = 2 * Halfwidth%% * (Anime1%% - 15) / 15
XA! = Positions!(4, 0, 0, 0)
YA! = Positions!(4, 0, 1, 0)
Z0! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
XB! = Positions!(4, 0, 0, 0) + Xtent!
YB! = Positions!(4, 0, 1, 0)
Z1! = 0
XC! = Positions!(4, 0, 0, 2)
YC! = Positions!(4, 0, 1, 2)
Z2! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
XD! = Positions!(4, 0, 0, 2) + Xtent!
YD! = Positions!(4, 0, 1, 2)
Z3! = 0
CALL Angle((XA!), (YA!), X0!, Y0!, Orient0!)
CALL Angle((XB!), (YB!), X1!, Y1!, Orient0!)
CALL Angle((XC!), (YC!), X2!, Y2!, Orient0!)
CALL Angle((XD!), (YD!), X3!, Y3!, Orient0!)
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
ELSE
Psi! = Anime1%% * Pi! / (2 * 15)
XA! = Positions!(4, 0, 0, 0)
YA! = Positions!(4, 0, 1, 0)
Z0! = 0
XB! = XA! + 2 * Halfwidth%% * COS(Psi!)
YB! = YA!
Z1! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
XC! = Positions!(4, 0, 0, 2)
YC! = Positions!(4, 0, 1, 2)
Z2! = 0
XD! = XC! + 2 * Halfwidth%% * COS(Psi!)
YD! = YC!
Z3! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
CALL Angle((XA!), (YA!), X0!, Y0!, Orient0!)
CALL Angle((XB!), (YB!), X1!, Y1!, Orient0!)
CALL Angle((XC!), (YC!), X2!, Y2!, Orient0!)
CALL Angle((XD!), (YD!), X3!, Y3!, Orient0!)
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
END IF
END IF
Anime1%% = Anime1%% + 1
IF Anime1%% = 31 THEN
TurnOver%% = False
Clock%%(PickedHour%%, 4, 0) = PickedCard%%
Clock%%(PickedHour%%, 4, 1) = True 'Temporary until picked up
END IF
ELSEIF Anime2%% < 43 THEN
'Display Tucking-in
IF PickedHour%% = 12 THEN
'Horizontal for Kings
IF Anime2%% > 22 THEN
Xdelta% = Positions!(1, PickedHour%%, 0, 1) - Positions!(4, PickedHour%%, 0, 0) + Tucked%%
X0! = Positions!(4, PickedHour%%, 0, 0) + Xdelta% * (45 - Anime2%%) / 23
Y0! = Positions!(4, PickedHour%%, 1, 0)
X1! = Positions!(4, PickedHour%%, 0, 1) + Xdelta% * (45 - Anime2%%) / 23
Y1! = Positions!(4, PickedHour%%, 1, 1)
X2! = Positions!(4, PickedHour%%, 0, 2) + Xdelta% * (45 - Anime2%%) / 23
Y2! = Positions!(4, PickedHour%%, 1, 2)
X3! = Positions!(4, PickedHour%%, 0, 3) + Xdelta% * (45 - Anime2%%) / 23
Y3! = Positions!(4, PickedHour%%, 1, 3)
Zpos! = -0.5
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
ELSE
Xdelta% = Positions!(1, PickedHour%%, 0, 1) - Positions!(4, PickedHour%%, 0, 0) + Tucked%%
X0! = Positions!(4, PickedHour%%, 0, 0) + Xdelta% * Anime2%% / 22
Y0! = Positions!(4, PickedHour%%, 1, 0)
X1! = Positions!(4, PickedHour%%, 0, 1) + Xdelta% * Anime2%% / 22
Y1! = Positions!(4, PickedHour%%, 1, 1)
X2! = Positions!(4, PickedHour%%, 0, 2) + Xdelta% * Anime2%% / 22
Y2! = Positions!(4, PickedHour%%, 1, 2)
X3! = Positions!(4, PickedHour%%, 0, 3) + Xdelta% * Anime2%% / 22
Y3! = Positions!(4, PickedHour%%, 1, 3)
Zpos! = 0.5
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
END IF
ELSE
'Vertical for others
IF Anime2%% > 22 THEN
Ydelta% = Positions!(0, 0, 1, 0) - Positions!(4, 0, 1, 2) + Tucked%%
XA! = Positions!(4, 0, 0, 0)
YA! = Positions!(4, 0, 1, 0) + Ydelta% * (45 - Anime2%%) / 23
XB! = Positions!(4, 0, 0, 1)
YB! = Positions!(4, 0, 1, 1) + Ydelta% * (45 - Anime2%%) / 23
XC! = Positions!(4, 0, 0, 2)
YC! = Positions!(4, 0, 1, 2) + Ydelta% * (45 - Anime2%%) / 23
XD! = Positions!(4, 0, 0, 3)
YD! = Positions!(4, 0, 1, 3) + Ydelta% * (45 - Anime2%%) / 23
CALL Angle((XA!), (YA!), X0!, Y0!, Orient!)
CALL Angle((XB!), (YB!), X1!, Y1!, Orient!)
CALL Angle((XC!), (YC!), X2!, Y2!, Orient!)
CALL Angle((XD!), (YD!), X3!, Y3!, Orient!)
Zpos! = -0.5
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
ELSE
Ydelta% = Positions!(0, 0, 1, 0) - Positions!(4, 0, 1, 2) + Tucked%%
XA! = Positions!(4, 0, 0, 0)
YA! = Positions!(4, 0, 1, 0) + Ydelta% * Anime2%% / 22
XB! = Positions!(4, 0, 0, 1)
YB! = Positions!(4, 0, 1, 1) + Ydelta% * Anime2%% / 22
XC! = Positions!(4, 0, 0, 2)
YC! = Positions!(4, 0, 1, 2) + Ydelta% * Anime2%% / 22
XD! = Positions!(4, 0, 0, 3)
YD! = Positions!(4, 0, 1, 3) + Ydelta% * Anime2%% / 22
CALL Angle((XA!), (YA!), X0!, Y0!, Orient!)
CALL Angle((XB!), (YB!), X1!, Y1!, Orient!)
CALL Angle((XC!), (YC!), X2!, Y2!, Orient!)
CALL Angle((XD!), (YD!), X3!, Y3!, Orient!)
Zpos! = 0.5
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
END IF
END IF
Anime2%% = Anime2%% + 1
IF Anime2%% = 43 THEN CanPutDown%% = True
ELSEIF PickedUp%% THEN
'Display picked-up card
IF __UI_MouseLeft > 680 AND __UI_MouseTop > 738 THEN
'Do Nothing
ELSE
CALL Angle(-Halfwidth%%, Halfheight%, X0!, Y0!, Orient!)
CALL Angle(Halfwidth%%, Halfheight%, X1!, Y1!, Orient!)
CALL Angle(-Halfwidth%%, -Halfheight%, X2!, Y2!, Orient!)
CALL Angle(Halfwidth%%, -Halfheight%, X3!, Y3!, Orient!)
X0! = X0! + XM%
Y0! = Y0! + YM%
X1! = X1! + XM%
Y1! = Y1! + YM%
X2! = X2! + XM%
Y2! = Y2! + YM%
X3! = X3! + XM%
Y3! = Y3! + YM%
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, ZOffset!)-(X1!, Y1!, ZOffset!)-(X2!, Y2!, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, ZOffset!)-(X2!, Y2!, ZOffset!)-(X1!, Y1!, ZOffset!)
END IF
END IF
'Display Piles
FOR S%% = 4 TO 0 STEP -1 'Maptriangle order is backwards
FOR N%% = 0 TO 12
IF Clock%%(N%%, S%%, 0) <> 0 THEN
IF Clock%%(N%%, S%%, 1) THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(Clock%%(N%%, S%%, 0) - 1) TO(Positions!(S%%, N%%, 0, 0), Positions!(S%%, N%%, 1, 0), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(Clock%%(N%%, S%%, 0) - 1) TO(Positions!(S%%, N%%, 0, 3), Positions!(S%%, N%%, 1, 3), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)
ELSE
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(Positions!(S%%, N%%, 0, 0), Positions!(S%%, N%%, 1, 0), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(Positions!(S%%, N%%, 0, 3), Positions!(S%%, N%%, 1, 3), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)
END IF
END IF
NEXT N%%
NEXT S%%
IF Stock%% > 0 THEN
'Display Stock
IF Stock%% > 1 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%%, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%%, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%%, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%%, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%%, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%%, ZOffset!)
END IF
IF Stock%% > 10 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 1, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 1, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 1, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 1, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 1, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 1, ZOffset!)
END IF
IF Stock%% > 20 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 2, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 2, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 2, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 2, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 2, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 2, ZOffset!)
END IF
IF Stock%% > 30 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 3, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 3, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 3, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 3, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 3, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 3, ZOffset!)
END IF
IF Stock%% > 41 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 4, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 4, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 4, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 4, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 4, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 4, ZOffset!)
END IF
'Display dealt card
S%% = (52 - Stock%%) \ 13
N%% = (52 - Stock%%) MOD 13
Count% = Count% + 1
Zpos! = 50 * SIN(Pi! * Count% / 15)
ActualAngle! = Phi!(N%%) * Count% / 15
XPos! = XStart% + (Positions!(S%%, N%%, 0, 4) - XStart%) * Count% / 15
YPos! = YStart% + (Positions!(S%%, N%%, 1, 4) - YStart%) * Count% / 15
CALL Angle((-Halfwidth%%), (Halfheight%%), X0!, Y0!, (ActualAngle!))
CALL Angle((Halfwidth%%), (Halfheight%%), X1!, Y1!, (ActualAngle!))
CALL Angle((-Halfwidth%%), (-Halfheight%%), X2!, Y2!, (ActualAngle!))
CALL Angle((Halfwidth%%), (-Halfheight%%), X3!, Y3!, (ActualAngle!))
X0! = XPos! + X0!
Y0! = YPos! + Y0!
X1! = XPos! + X1!
Y1! = YPos! + Y1!
X2! = XPos! + X2!
Y2! = YPos! + Y2!
X3! = XPos! + X3!
Y3! = YPos! + Y3!
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
IF Count% = 15 THEN
Count% = 0
Clock%%((52 - Stock%%) MOD 13, 1 + ((52 - Stock%%) \ 13), 0) = Clock%%((52 - Stock%%) MOD 13, 1 + ((52 - Stock%%) \ 13), 2)
Stock%% = Stock%% - 1
END IF
END IF
IF IsComplete%% THEN
_PUTIMAGE (230, 246), GameOver&
IF GotOut%% THEN _PUTIMAGE (222, 490), GameWon&
END IF
END IF
END SUB
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 ClockPatience
IF GreenValid%% THEN
DoPickUp%% = True
ELSEIF RedValid%% THEN
Anime2%% = 0
END IF
CASE ExitBT
SYSTEM
CASE NewGameBT
IF NOT DoPatience%% THEN
Control(NewGameBT).Disabled = True
Control(NewGameBT).Hidden = True
Caption(NewGameBT) = "New Game"
SetFocus ExitBT
CALL Patience
ELSE
DoPatience%% = False
Caption(NewGameBT) = "Deal"
END IF
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
END SUB
SUB __UI_MouseLeave (id AS LONG)
END SUB
SUB __UI_FocusIn (id AS LONG)
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.
END SUB
SUB __UI_MouseDown (id AS LONG)
END SUB
SUB __UI_MouseUp (id AS LONG)
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
END SUB
SUB __UI_TextChanged (id AS LONG)
END SUB
SUB __UI_ValueChanged (id AS LONG)
END SUB
SUB __UI_FormResized
END SUB
SUB Angle (Xin!, Yin!, Xout!, Yout!, Theta!)
Xout! = Xin! * COS(Theta!) - Yin! * SIN(Theta!)
Yout! = Xin! * SIN(Theta!) + Yin! * COS(Theta!)
END SUB
SUB Patience
RANDOMIZE (TIMER)
BadDeal%% = True
WHILE BadDeal%%
REDIM Clock%%(12, 4, 2)
CALL Shuffle(Cards%%())
'Deal Sim
FOR N%% = 0 TO 51
S%% = N%% \ 13
R%% = N%% MOD 13
Clock%%(R%%, S%% + 1, 2) = Cards%%(N%%)
NEXT N%%
BadDeal%% = False
FOR M%% = 0 TO 12 'Cards are in S 1 to 4
IF Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 2, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 3, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 4, 2) MOD 13 THEN BadDeal%% = True
NEXT M%%
WEND
Stock%% = 52
Anime1%% = 31
Anime2%% = 43
TurnOver%% = True
DoPickUp%% = False
PickedUp%% = False
PickedCard%% = 0
PickedHour%% = 12
CanPutDown%% = False
IsComplete%% = False
DoPatience%% = True
HangOn%% = True
HangStop%% = 50
HCount%% = 0
WHILE DoPatience%%
_LIMIT 60
GreenValid%% = False
RedValid%% = False
IF Stock%% = 0 AND HangOn%% THEN
HCount%% = HCount%% + 1
IF HCount%% = HangStop%% THEN
HangOn%% = False
HCount%% = 0
HangStop%% = 20
END IF
END IF
IF Stock%% = 0 AND NOT IsComplete%% AND Anime1%% = 31 AND Anime2%% = 43 AND NOT HangOn%% THEN
'In _MAPTRIANGLE3D, all distances relative to centre of screen
XM% = __UI_MouseLeft - _WIDTH / 2
YM% = _HEIGHT / 2 - __UI_MouseTop
IF TurnOver%% THEN
Orient0! = Phi!(PickedHour%%) 'Start orientation is from where the card is taken
PickedCard%% = Clock%%(PickedHour%%, 4, 0) 'From 1 to 52
Clock%%(PickedHour%%, 4, 0) = 0
OldHour%% = PickedHour%%
Anime1%% = 0
ELSEIF NOT DoPickUp%% AND NOT PickedUp%% THEN
IF SQR((Positions!(4, PickedHour%%, 0, 4) - XM%) * (Positions!(4, PickedHour%%, 0, 4) - XM%) + (Positions!(4, PickedHour%%, 1, 4) - YM%) * (Positions!(4, PickedHour%%, 1, 4) - YM%)) < 40 THEN GreenValid%% = True
ELSEIF DoPickUp%% THEN
IF PickedHour%% = 12 THEN
FOR R%% = 4 TO 2 STEP -1
Clock%%(PickedHour%%, R%%, 0) = Clock%%(PickedHour%%, R%% - 1, 0)
Clock%%(PickedHour%%, R%%, 1) = Clock%%(PickedHour%%, R%% - 1, 1)
NEXT R%%
Clock%%(PickedHour%%, 1, 0) = 0
ELSE
FOR R%% = 4 TO 1 STEP -1
Clock%%(PickedHour%%, R%%, 0) = Clock%%(PickedHour%%, R%% - 1, 0)
Clock%%(PickedHour%%, R%%, 1) = Clock%%(PickedHour%%, R%% - 1, 1)
NEXT R%%
Clock%%(PickedHour%%, 0, 0) = 0
END IF
PickedHour%% = PickedCard%% MOD 13
IF PickedHour%% = 0 THEN
PickedHour%% = 12
ELSEIF PickedHour%% = 12 THEN
PickedHour%% = 0
END IF
Orient1! = Phi!(PickedHour%%)
PickedUp%% = True
DoPickUp%% = False
ELSEIF PickedUp%% THEN
IF SQR((Positions!(4, PickedHour%%, 0, 4) - XM%) * (Positions!(4, PickedHour%%, 0, 4) - XM%) + (Positions!(4, PickedHour%%, 1, 4) - YM%) * (Positions!(4, PickedHour%%, 1, 4) - YM%)) < 40 THEN
IF NOT CanPutDown%% THEN RedValid%% = True
Orient! = Orient1!
ELSEIF SQR((Positions!(4, OldHour%%, 0, 4) - XM%) * (Positions!(4, OldHour%%, 0, 4) - XM%) + (Positions!(4, OldHour%%, 1, 4) - YM%) * (Positions!(4, OldHour%%, 1, 4) - YM%)) < 40 THEN
Orient! = Orient0!
ELSE
Orient! = 0
END IF
IF CanPutDown%% THEN
CanPutDown%% = False
PickedUp%% = False
HangOn%% = True
IF PickedHour%% = 12 THEN
Clock%%(PickedHour%%, 1, 0) = PickedCard%%
Clock%%(PickedHour%%, 1, 1) = True
ELSE
Clock%%(PickedHour%%, 0, 0) = PickedCard%%
Clock%%(PickedHour%%, 0, 1) = True
END IF
PickedCard%% = 0
IF Clock%%(12, 4, 1) AND Clock%%(12, 1, 0) <> 0 THEN 'Game Finished
IsComplete%% = True
Control(NewGameBT).Disabled = False
Control(NewGameBT).Hidden = False
SetFocus NewGameBT
GotOut%% = True
M%% = 0
WHILE M%% <= 11 AND GotOut%%
IF NOT Clock%%(M%%, 4, 1) THEN GotOut%% = False
M%% = M%% + 1
WEND
END IF
IF NOT IsComplete%% THEN TurnOver%% = True
END IF
END IF
END IF
__UI_DoEvents
WEND
END SUB
SUB Shuffle (Pack%%()) 'Fisher Yates or Knuth shuffle
FOR S%% = 51 TO 1 STEP -1
R%% = INT(RND * S%%) '+ 1
SWAP Pack%%(R%%), Pack%%(S%%)
NEXT S%%
END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

35
examples/ClockPatience/Clock Patience.frm Normal file
View file

@ -0,0 +1,35 @@
': This form was generated by
': InForm - GUI library for QB64 - v1.5
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "ClockPatience", 800, 800, 0, 0, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Clock Patience"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
Control(__UI_NewID).BackColor = _RGB32(0, 141, 0)
Control(__UI_NewID).HasBorder = False
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ExitBT", 80, 23, 710, 768, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Exit"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "NewGameBT", 80, 23, 710, 736, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "New Game"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
END SUB
SUB __UI_AssignIDs
ClockPatience = __UI_GetID("ClockPatience")
ExitBT = __UI_GetID("ExitBT")
NewGameBT = __UI_GetID("NewGameBT")
END SUB

BIN
examples/ClockPatience/Clock1.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 490 KiB

BIN
examples/ClockPatience/QB64bee.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 3.9 KiB

BIN
examples/ClockPatience/clubs.ico Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 66 KiB

BIN
examples/ClockPatience/cyberbit.ttf Normal file
View file

Binary file not shown.

BIN
examples/ClockPatience/pack of cards.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 1.8 MiB

BIN
examples/DuckShoot/22handgun.mp3 Normal file
View file

Binary file not shown.

1137
examples/DuckShoot/Duck Shoot.bas Normal file
View file

File diff suppressed because it is too large Load diff

277
examples/DuckShoot/Duck Shoot.frm Normal file
View file

@ -0,0 +1,277 @@
': This form was generated by
': InForm - GUI library for QB64 - v1.5
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "DuckShoot", 1240, 800, 0, 0, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Duck Shoot"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
Control(__UI_NewID).HasBorder = False
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "OptionsFR", 120, 160, 1120, 640, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Value = 4
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "GameLevelFR", 100, 174, 1130, 454, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Game Level"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Value = 6
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "AudioFR", 100, 80, 1130, 360, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Audio"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Value = 2
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "SetKeysFR", 177, 109, 510, 325, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Set Keys"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Value = 4
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "LeftHandKeysFR", 150, 180, 510, 456, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Left Hand Keys"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Value = 5
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "RightHandKeysFR", 140, 150, 763, 456, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Right Hand Keys"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Value = 4
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "SelectKeyFR", 164, 80, 763, 325, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Select Key"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Value = 3
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ExitBT", 80, 23, 20, 120, __UI_GetID("OptionsFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Exit"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ResetBT", 80, 23, 20, 85, __UI_GetID("OptionsFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Reset"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "SetKeysBT", 80, 23, 20, 15, __UI_GetID("OptionsFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Set Keys"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level1RB", 80, 23, 12, 15, __UI_GetID("GameLevelFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Level 1"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Value = -1
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level2RB", 80, 23, 12, 40, __UI_GetID("GameLevelFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Level 2"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level3RB", 80, 23, 12, 65, __UI_GetID("GameLevelFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Level 3"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level4RB", 80, 23, 12, 90, __UI_GetID("GameLevelFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Level 4"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level5RB", 80, 23, 12, 115, __UI_GetID("GameLevelFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Level 5"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "Level6RB", 80, 23, 12, 140, __UI_GetID("GameLevelFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Level 6"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "AudioOffRB", 80, 23, 12, 15, __UI_GetID("AudioFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Audio Off"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "AudioOnRB", 80, 23, 12, 40, __UI_GetID("AudioFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Audio On"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Value = -1
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "RestartLevelBT", 80, 23, 20, 50, __UI_GetID("OptionsFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Restart Level"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "SetLeftHandKeysRB", 134, 23, 15, 15, __UI_GetID("SetKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Set Left Hand Keys"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Value = -1
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "SetRightHandKeysRB", 134, 23, 15, 45, __UI_GetID("SetKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Set Right Hand Keys"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FarSightUpRB", 100, 23, 15, 15, __UI_GetID("RightHandKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Far Sight Up"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Value = -1
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FarSightLeftRB", 100, 23, 15, 45, __UI_GetID("RightHandKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Far Sight Left"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FarSightRightRB", 110, 23, 15, 75, __UI_GetID("RightHandKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Far Sight Right"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FarSightDownRB", 110, 23, 15, 105, __UI_GetID("RightHandKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Far Sight Down"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "NearSightUpRB", 110, 23, 15, 15, __UI_GetID("LeftHandKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Near Sight Up"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Value = -1
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "NearSightLeftRB", 110, 23, 15, 45, __UI_GetID("LeftHandKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Near Sight Left"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "NearSightRightRB", 120, 23, 15, 75, __UI_GetID("LeftHandKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Near Sight Right"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "NearSightDownRB", 120, 23, 15, 105, __UI_GetID("LeftHandKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Near Sight Down"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "FireRB", 60, 23, 15, 135, __UI_GetID("LeftHandKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Fire"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_DropdownList, "SelectKeyDD", 60, 23, 15, 45, __UI_GetID("SelectKeyFR"))
__UI_RegisterResult = 0
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 14)
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Label, "SelectKeyLB", 140, 23, 15, 15, __UI_GetID("SelectKeyFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Select Key (Currently w):"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Button, "DoneBT", 50, 23, 110, 75, __UI_GetID("SetKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Done"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "SetBT", 50, 23, 98, 45, __UI_GetID("SelectKeyFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Set"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "DefaultBT", 70, 23, 20, 75, __UI_GetID("SetKeysFR"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Default"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
END SUB
SUB __UI_AssignIDs
DuckShoot = __UI_GetID("DuckShoot")
OptionsFR = __UI_GetID("OptionsFR")
GameLevelFR = __UI_GetID("GameLevelFR")
AudioFR = __UI_GetID("AudioFR")
SetKeysFR = __UI_GetID("SetKeysFR")
LeftHandKeysFR = __UI_GetID("LeftHandKeysFR")
RightHandKeysFR = __UI_GetID("RightHandKeysFR")
SelectKeyFR = __UI_GetID("SelectKeyFR")
ExitBT = __UI_GetID("ExitBT")
ResetBT = __UI_GetID("ResetBT")
SetKeysBT = __UI_GetID("SetKeysBT")
Level1RB = __UI_GetID("Level1RB")
Level2RB = __UI_GetID("Level2RB")
Level3RB = __UI_GetID("Level3RB")
Level4RB = __UI_GetID("Level4RB")
Level5RB = __UI_GetID("Level5RB")
Level6RB = __UI_GetID("Level6RB")
AudioOffRB = __UI_GetID("AudioOffRB")
AudioOnRB = __UI_GetID("AudioOnRB")
RestartLevelBT = __UI_GetID("RestartLevelBT")
SetLeftHandKeysRB = __UI_GetID("SetLeftHandKeysRB")
SetRightHandKeysRB = __UI_GetID("SetRightHandKeysRB")
FarSightUpRB = __UI_GetID("FarSightUpRB")
FarSightLeftRB = __UI_GetID("FarSightLeftRB")
FarSightRightRB = __UI_GetID("FarSightRightRB")
FarSightDownRB = __UI_GetID("FarSightDownRB")
NearSightUpRB = __UI_GetID("NearSightUpRB")
NearSightLeftRB = __UI_GetID("NearSightLeftRB")
NearSightRightRB = __UI_GetID("NearSightRightRB")
NearSightDownRB = __UI_GetID("NearSightDownRB")
FireRB = __UI_GetID("FireRB")
SelectKeyDD = __UI_GetID("SelectKeyDD")
SelectKeyLB = __UI_GetID("SelectKeyLB")
DoneBT = __UI_GetID("DoneBT")
SetBT = __UI_GetID("SetBT")
DefaultBT = __UI_GetID("DefaultBT")
END SUB

BIN
examples/DuckShoot/OptionsFR.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 4.5 KiB

BIN
examples/DuckShoot/curtains.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 746 KiB

BIN
examples/DuckShoot/cyberbit.ttf Normal file
View file

Binary file not shown.

10
examples/DuckShoot/ducks.cfg Normal file
View file

@ -0,0 +1,10 @@
119
115
97
100
112
46
108
39
101
2

BIN
examples/DuckShoot/fallover1.mp3 Normal file
View file

Binary file not shown.

BIN
examples/DuckShoot/fanfare.mp3 Normal file
View file

Binary file not shown.

BIN
examples/DuckShoot/funfair.mp3 Normal file
View file

Binary file not shown.

BIN
examples/DuckShoot/helloducky.ico Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 41 KiB

BIN
examples/DuckShoot/medalimg.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 82 KiB

BIN
examples/DuckShoot/pigeon1.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 128 KiB

BIN
examples/DuckShoot/spiral.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 2.4 MiB

BIN
examples/DuckShoot/tada.mp3 Normal file
View file

Binary file not shown.

BIN
examples/DuckShoot/target.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 8.6 KiB

426
examples/Fahrenheit-Celsius/Fahrenheit-Celsius.bas Normal file
View file

@ -0,0 +1,426 @@
': Fahrenheit-Celsius Converter by Qwerkey 16/05/20
': Images: pngimg.com
': This program uses
': InForm - GUI library for QB64 - v1.1
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
$ASSERTS
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED FahrenheitToCelsius AS LONG
DIM SHARED ScaleFrame AS LONG
DIM SHARED FahrenheitPBox AS LONG
DIM SHARED CelsiusPBox AS LONG
DIM SHARED DispPB AS LONG
DIM SHARED BodyTempRB AS LONG
DIM SHARED RoomTempRB AS LONG
DIM SHARED FahrenheitTB AS LONG
DIM SHARED CelsiusTB AS LONG
DIM SHARED FahrenheitLB AS LONG
DIM SHARED CelsiusLB AS LONG
DIM SHARED FixTextBoxesTS AS LONG
DIM SHARED FixTextBoxesLB AS LONG
DIM SHARED ExitBT AS LONG
DIM SHARED PicUpdate%%, FSetTemp!, CSetTemp!
DIM SHARED InFahrenheit%%, InCelsius%%, TClicked%%, TempT!
CONST FPos% = 12, CPos% = 31, YPos% = 20, TFPos% = 28, TCPos% = 47, TYPos% = 38, ScaleMin% = 668
CONST TT% = 38, TB% = 668, FL% = 82, FR% = 106, CL% = 321, CR% = 345
': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Fahrenheit-Celsius.frm'
': Functions: ----------------------------------------------------------------------
FUNCTION FTOC! (T!, Deg%%)
IF Deg%% THEN
FTOC! = (T! - 32) * 5 / 9
ELSE
FTOC! = (T! * 9 / 5) + 32
END IF
END FUNCTION
FUNCTION OnePlace! (Qty!)
OnePlace! = CINT(10 * Qty!) / 10
END FUNCTION
FUNCTION IText$ (J!)
__IText$ = LTRIM$(STR$(J!))
IText$ = __IText$
IF LEFT$(__IText$, 1) = "." THEN
IText$ = "0" + __IText$
ELSEIF LEFT$(__IText$, 2) = "-." THEN
IText$ = "-0." + RIGHT$(__IText$, LEN(__IText$) - 2)
END IF
END FUNCTION
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
END SUB
SUB __UI_OnLoad
_SCREENMOVE 120, 5
END SUB
SUB __UI_BeforeUpdateDisplay
'This event occurs at approximately 30 frames per second.
'You can change the update frequency by calling SetFrameRate DesiredRate%
STATIC InitDone%%, FThermometer&, TBase&, FLiquid&, CThermometer&, CLiquid&
STATIC FT%, FB%, FS%, CT%, CB%, CS%, FTMax%, CTMax%, TD%, FTMin%, CTMin%, OldScale%%
STATIC Pics&(), TRange!()
IF NOT InitDone%% THEN
': Everything (except events) is done in the __UI_BeforeUpdateDisplay SUB
': All initiations, image loading & manipulations are done once here
InitDone%% = True
DIM Pics&(1, 4), TRange!(1, 3)
': Read temperature Ranges
RESTORE temp_range
FOR I1%% = 0 TO 1
FOR J1%% = 0 TO 3
READ TRange!(I1%%, J1%%)
NEXT J1%%
NEXT I1%%
': Load Images
FOR J1%% = 0 TO 4
Pics&(0, J1%%) = _LOADIMAGE("temp" + IText$(J1%%) + ".png", 32)
_ASSERT Pics&(0, J1%%) < -1, "Failed to load temp" + IText$(J1%%) + ".png"
Pics&(1, J1%%) = _LOADIMAGE("temp1" + IText$(J1%%) + ".png", 32)
_ASSERT Pics&(1, J1%%) < -1, "Failed to load temp1" + IText$(J1%%) + ".png"
NEXT J1%%
': _MEM processing to convert red into green for Celsius thermometer
DIM CMem AS _MEM, COff AS _OFFSET
FThermometer& = _LOADIMAGE("thermo.png", 32)
_ASSERT FThermometer& < -1, "Failed to load thermo.png"
TBase& = _LOADIMAGE("tbase.png", 32)
_ASSERT TBase& < -1, "Failed to load tbase.png"
FLiquid& = _LOADIMAGE("rbase.png", 32)
_ASSERT FLiquid& < -1, "Failed to load rbase.png"
CThermometer& = _LOADIMAGE("thermo.png", 32)
_ASSERT CThermometer& < -1, "Failed to load thermo.png"
CLiquid& = _LOADIMAGE("rbase.png", 32)
_ASSERT CLiquid& < -1, "Failed to load rbase.png"
CMem = _MEMIMAGE(CThermometer&)
COff = 0
WHILE COff < CMem.SIZE
B1~%% = _MEMGET(CMem, CMem.OFFSET + COff + 1, _UNSIGNED _BYTE) 'Green
B2~%% = _MEMGET(CMem, CMem.OFFSET + COff + 2, _UNSIGNED _BYTE) 'Red
IF _MEMGET(CMem, CMem.OFFSET + COff + 3, _UNSIGNED _BYTE) <> 0 THEN 'Alpha
IF B2~%% / B1~%% > 1.5 THEN
_MEMPUT CMem, CMem.OFFSET + COff + 1, B2~%% AS _UNSIGNED _BYTE 'Green
_MEMPUT CMem, CMem.OFFSET + COff + 2, B1~%% AS _UNSIGNED _BYTE 'Red
END IF
END IF
COff = COff + 4
WEND
_MEMFREE CMem
CMem = _MEMIMAGE(CLiquid&)
COff = 0
WHILE COff < CMem.SIZE
B1~%% = _MEMGET(CMem, CMem.OFFSET + COff + 1, _UNSIGNED _BYTE) 'Green
B2~%% = _MEMGET(CMem, CMem.OFFSET + COff + 2, _UNSIGNED _BYTE) 'Red
IF _MEMGET(CMem, CMem.OFFSET + COff + 3, _UNSIGNED _BYTE) <> 0 THEN 'Alpha
IF B2~%% / B1~%% > 1.5 THEN
_MEMPUT CMem, CMem.OFFSET + COff + 1, B2~%% AS _UNSIGNED _BYTE 'Green
_MEMPUT CMem, CMem.OFFSET + COff + 2, B1~%% AS _UNSIGNED _BYTE 'Red
END IF
END IF
COff = COff + 4
WEND
_MEMFREE CMem
': Display thermometer images in picture boxes
': All images are software (,32)
BeginDraw FahrenheitPBox
'Drawing code goes here
_PUTIMAGE (FPos%, YPos%), FThermometer&
COLOR _RGB32(0, 0, 0), _RGB32(235, 233, 237)
_PRINTSTRING (72, 20), CHR$(248) + "F"
EndDraw FahrenheitPBox
BeginDraw CelsiusPBox
'Drawing code goes here
_PUTIMAGE (CPos%, YPos%), CThermometer&
COLOR _RGB32(0, 0, 0), _RGB32(235, 233, 237)
_PRINTSTRING (10, 20), CHR$(248) + "C"
EndDraw CelsiusPBox
END IF
': New Scales
IF Control(BodyTempRB).Value <> OldScale%% THEN
OldScale%% = Control(BodyTempRB).Value
IF OldScale%% THEN
': Body Temperature Scales
FSetTemp! = 98.4
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, True))
Text(FahrenheitTB) = IText$(FSetTemp!)
Text(CelsiusTB) = IText$(CSetTemp!)
FT% = 44
FB% = 644
FS% = 5
CT% = 50
CB% = 610
CS% = 7
FTMax% = 106
CTMax% = 42
TD% = 10
FTMin% = FTMax% - (FB% - FT%) / (FS% * TD%)
CTMin% = CTMax% - (CB% - CT%) / (CS% * TD%)
ELSE
': Room Temperature Scales
FT% = 70
FB% = 590
FS% = 2
CT% = 60
CB% = 620
CS% = 4
FTMax% = 220
CTMax% = 100
TD% = 1
FTMin% = FTMax% - (FB% - FT%) / (FS% * TD%)
CTMin% = CTMax% - (CB% - CT%) / (CS% * TD%)
END IF
': Draw Scales
BeginDraw FahrenheitPBox
LINE (60, TT% - 1)-(100, TB% - 1), _RGB32(235, 233, 237), BF
LINE (62, FT%)-(62, FB% + 1), _RGB32(0, 0, 0)
LINE (63, FT%)-(63, FB% + 1), _RGB32(0, 0, 0)
FOR N% = 0 TO (FB% - FT%) / FS%
LINE (62, FT% + N% * FS%)-(67, FT% + N% * FS%), _RGB32(0, 0, 0)
IF N% \ 5 = N% / 5 THEN
LINE (62, FT% + N% * FS%)-(70, FT% + N% * FS%), _RGB32(0, 0, 0)
IF N% \ 10 = N% / 10 THEN
LINE (62, FT% + 1 + N% * FS%)-(70, FT% + 1 + N% * FS%), _RGB32(0, 0, 0)
_PRINTSTRING (72, FT% - 6 + N% * FS%), IText$(FTMax% - N% / TD%)
END IF
END IF
NEXT N%
EndDraw FahrenheitPBox
BeginDraw CelsiusPBox
LINE (0, TT% - 1)-(39, TB% - 1), _RGB32(235, 233, 237), BF
LINE (38, CT%)-(38, CB% + 1), _RGB32(0, 0, 0)
LINE (37, CT%)-(37, CB% + 1), _RGB32(0, 0, 0)
FOR N% = 0 TO (CB% - CT%) / CS%
LINE (33, CT% + N% * CS%)-(38, CT% + N% * CS%), _RGB32(0, 0, 0)
IF N% \ 5 = N% / 5 THEN
LINE (30, CT% + N% * CS%)-(38, CT% + N% * CS%), _RGB32(0, 0, 0)
IF N% \ 10 = N% / 10 THEN
LINE (30, CT% + 1 + N% * CS%)-(38, CT% + 1 + N% * CS%), _RGB32(0, 0, 0)
M% = CTMax% - N% / TD%
MS$ = IText$(M%)
IF M% > 0 AND M% < 100 THEN
MS$ = " " + MS$
ELSEIF M% = 0 THEN
MS$ = " " + MS$
END IF
_PRINTSTRING (4, CT% - 6 + N% * CS%), MS$
END IF
END IF
NEXT N%
EndDraw CelsiusPBox
PicUpdate%% = True
END IF
': Poll Mouse
LM% = __UI_MouseLeft
TM% = __UI_MouseTop
': Look for position inside thermometer tubes and check Click
IF LM% > 70 + TFPos% AND LM% < 70 + TFPos% + 24 AND TM% > FT% AND TM% < FB% THEN
InFahrenheit%% = True
TempT! = OnePlace!(FTMax% + ((TM% - FT%) * (FTMin% - FTMax%) / (FB% - FT%)))
IF NOT TClicked%% THEN Text(FahrenheitTB) = IText$(TempT!)
ELSEIF LM% > 290 + TCPos% AND LM% < 290 + TCPos% + 24 AND TM% > CT% AND TM% < CB% THEN
InCelsius%% = True
TempT! = OnePlace!(CTMax% + (TM% - CT%) * (CTMin% - CTMax%) / (CB% - CT%))
IF NOT TClicked%% THEN Text(CelsiusTB) = IText$(TempT!)
ELSE
IF InFahrenheit%% AND NOT TClicked%% THEN
Text(FahrenheitTB) = IText$(FSetTemp!)
ELSEIF InCelsius%% AND NOT TClicked%% THEN
Text(CelsiusTB) = IText$(CSetTemp!)
END IF
InFahrenheit%% = False
InCelsius%% = False
IF TClicked%% THEN TClicked%% = False
END IF
': Update thermometers
IF PicUpdate%% THEN
PicUpdate%% = False
YF% = FT% + (FSetTemp! - FTMax%) * (FB% - FT%) / (FTMin% - FTMax%)
YC% = CT% + (CSetTemp! - CTMax%) * (CB% - CT%) / (CTMin% - CTMax%)
BeginDraw FahrenheitPBox
_PUTIMAGE (TFPos%, TYPos%), TBase&
IF YF% >= FT% AND YF% <= FB% THEN _PUTIMAGE (TFPos%, YF%)-(TFPos% + 24, ScaleMin%), FLiquid&, , (0, 0)-(24, ScaleMin% - YF%)
EndDraw FahrenheitPBox
BeginDraw CelsiusPBox
_PUTIMAGE (TCPos%, TYPos%), TBase&
IF YC% >= CT% AND YC% <= CB% THEN _PUTIMAGE (TCPos%, YC%)-(TCPos% + 24, ScaleMin%), CLiquid&, , (0, 0)-(24, ScaleMin% - YC%)
EndDraw CelsiusPBox
': If temperature outside thermometer scale do not display liquid column
IF YF% < FT% OR YF% > FB% THEN YF% = ScaleMin%
IF YC% < CT% OR YC% > CB% THEN YC% = ScaleMin%
': If fixed text boxes, set at default
IF Control(FixTextBoxesTS).Value THEN
YF% = 396
YC% = 396
END IF
Control(FahrenheitTB).Top = YF% - 8
Control(CelsiusTB).Top = YC% - 8
Control(FahrenheitLB).Top = YF% - 8 - 23
Control(CelsiusLB).Top = YC% - 8 - 23
': Display Image dependent upon temperature range
BeginDraw DispPB
LINE (0, 0)-(119, 199), _RGB32(235, 233, 237), BF
IF Control(BodyTempRB).Value THEN
SELECT CASE FSetTemp!
CASE IS < TRange!(0, 0)
_PUTIMAGE , Pics&(0, 0)
CASE TRange!(0, 0) TO TRange!(0, 1)
_PUTIMAGE , Pics&(0, 1)
CASE TRange!(0, 1) TO TRange!(0, 2)
_PUTIMAGE , Pics&(0, 2)
CASE TRange!(0, 2) TO TRange!(0, 3)
_PUTIMAGE , Pics&(0, 3)
CASE IS > TRange!(0, 3)
_PUTIMAGE , Pics&(0, 4)
END SELECT
ELSE
SELECT CASE CSetTemp!
CASE IS < TRange!(1, 0)
_PUTIMAGE , Pics&(1, 0)
CASE TRange!(1, 0) TO TRange!(1, 1)
_PUTIMAGE , Pics&(1, 1)
CASE TRange!(1, 1) TO TRange!(1, 2)
_PUTIMAGE , Pics&(1, 2)
CASE TRange!(1, 2) TO TRange!(1, 3)
_PUTIMAGE , Pics&(1, 3)
CASE IS > TRange!(1, 3)
_PUTIMAGE , Pics&(1, 4)
END SELECT
END IF
EndDraw DispPB
END IF
temp_range:
DATA 96.4,97.4,99.4,100.4
DATA -10,10,30,50
END SUB
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 FahrenheitToCelsius
CASE ScaleFrame
CASE DispPB
CASE BodyTempRB
CASE RoomTempRB
CASE FahrenheitTB
CASE CelsiusTB
CASE FahrenheitLB
CASE CelsiusLB
CASE FixTextBoxesLB
CASE FahrenheitPBox
': Check for click in thermometer columns
IF InFahrenheit%% AND NOT TClicked%% THEN
TClicked%% = True
FSetTemp! = OnePlace!(TempT!)
Text(FahrenheitTB) = IText$(FSetTemp!)
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, True))
Text(CelsiusTB) = IText$(CSetTemp!)
PicUpdate%% = True
END IF
CASE CelsiusPBox
': Check for click in thermometer columns
IF InCelsius%% AND NOT TClicked%% THEN
TClicked%% = True
CSetTemp! = OnePlace!(TempT!)
Text(CelsiusTB) = IText$(CSetTemp!)
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, False))
Text(FahrenheitTB) = IText$(FSetTemp!)
PicUpdate%% = True
END IF
CASE FixTextBoxesTS
': Check for Toggle Switch Click
PicUpdate%% = True
CASE ExitBT
': Click Exit Button
SYSTEM
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
END SUB
SUB __UI_MouseLeave (id AS LONG)
END SUB
SUB __UI_FocusIn (id AS LONG)
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.
END SUB
SUB __UI_MouseDown (id AS LONG)
END SUB
SUB __UI_MouseUp (id AS LONG)
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
IF __UI_KeyHit = 27 THEN 'Esc key (only responds after a Click event has happened)
SYSTEM
ELSEIF __UI_KeyHit = 13 THEN 'CR
SELECT CASE id
CASE BodyTempRB
CASE RoomTempRB
CASE FixTextBoxesTS
CASE FahrenheitTB
': Update Fahrenheit temperature & convert
FSetTemp! = OnePlace!(VAL(Text(FahrenheitTB)))
Text(FahrenheitTB) = IText$(FSetTemp!)
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, True))
Text(CelsiusTB) = IText$(CSetTemp!)
PicUpdate%% = True
CASE CelsiusTB
': Update Celsius temperature & convert
CSetTemp! = OnePlace!(VAL(Text(CelsiusTB)))
Text(CelsiusTB) = IText$(CSetTemp!)
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, False))
Text(FahrenheitTB) = IText$(FSetTemp!)
PicUpdate%% = True
CASE ExitBT
SYSTEM 'Does this condition ever get met?
END SELECT
END IF
END SUB
SUB __UI_TextChanged (id AS LONG)
END SUB
SUB __UI_ValueChanged (id AS LONG)
END SUB
SUB __UI_FormResized
END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

121
examples/Fahrenheit-Celsius/Fahrenheit-Celsius.frm Normal file
View file

@ -0,0 +1,121 @@
': This form was generated by
': InForm - GUI library for QB64 - v1.5
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "FahrenheitToCelsius", 460, 750, 0, 0, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Fahrenheit To Celsius"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
Control(__UI_NewID).HasBorder = False
__UI_NewID = __UI_NewControl(__UI_Type_Frame, "ScaleFrame", 110, 90, 175, 75, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Scale"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Value = 2
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "FahrenheitPBox", 100, 750, 70, 0, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "CelsiusPBox", 100, 750, 290, 0, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "DispPB", 120, 120, 170, 320, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "BodyTempRB", 90, 23, 10, 16, __UI_GetID("ScaleFrame"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "BodyT emp"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Value = -1
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "RoomTempRB", 90, 23, 10, 46, __UI_GetID("ScaleFrame"))
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Room Temp"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "FahrenheitTB", 60, 23, 5, 388, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "CelsiusTB", 60, 23, 395, 388, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Label, "FahrenheitLB", 60, 23, 5, 365, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Fahrenheit"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
Control(__UI_NewID).Value = -1
__UI_NewID = __UI_NewControl(__UI_Type_Label, "CelsiusLB", 60, 22, 395, 365, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Celsius"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_ToggleSwitch, "FixTextBoxesTS", 40, 17, 210, 600, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Label, "FixTextBoxesLB", 90, 23, 185, 570, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Fix Text Boxes"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Button, "ExitBT", 80, 23, 190, 714, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Exit"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
END SUB
SUB __UI_AssignIDs
FahrenheitToCelsius = __UI_GetID("FahrenheitToCelsius")
ScaleFrame = __UI_GetID("ScaleFrame")
FahrenheitPBox = __UI_GetID("FahrenheitPBox")
CelsiusPBox = __UI_GetID("CelsiusPBox")
DispPB = __UI_GetID("DispPB")
BodyTempRB = __UI_GetID("BodyTempRB")
RoomTempRB = __UI_GetID("RoomTempRB")
FahrenheitTB = __UI_GetID("FahrenheitTB")
CelsiusTB = __UI_GetID("CelsiusTB")
FahrenheitLB = __UI_GetID("FahrenheitLB")
CelsiusLB = __UI_GetID("CelsiusLB")
FixTextBoxesTS = __UI_GetID("FixTextBoxesTS")
FixTextBoxesLB = __UI_GetID("FixTextBoxesLB")
ExitBT = __UI_GetID("ExitBT")
END SUB

BIN
examples/Fahrenheit-Celsius/rbase.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 2.3 KiB

BIN
examples/Fahrenheit-Celsius/tbase.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 4.8 KiB

BIN
examples/Fahrenheit-Celsius/temp0.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 7 KiB

BIN
examples/Fahrenheit-Celsius/temp1.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 6.3 KiB

BIN
examples/Fahrenheit-Celsius/temp10.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 37 KiB

BIN
examples/Fahrenheit-Celsius/temp11.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 41 KiB

BIN
examples/Fahrenheit-Celsius/temp12.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 47 KiB

BIN
examples/Fahrenheit-Celsius/temp13.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 44 KiB

BIN
examples/Fahrenheit-Celsius/temp14.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 25 KiB

BIN
examples/Fahrenheit-Celsius/temp2.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 7.4 KiB

BIN
examples/Fahrenheit-Celsius/temp3.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 7.1 KiB

BIN
examples/Fahrenheit-Celsius/temp4.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 7.1 KiB

BIN
examples/Fahrenheit-Celsius/thermo.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 14 KiB

424
examples/Fireworks2/Fireworks.bas Normal file
View file

@ -0,0 +1,424 @@
': This program uses
': InForm - GUI library for QB64 - v1.0
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
'Improved fireworks:
' - Particles now leave a trail behind
' - Round explosions (sin/cos been used...)
' - Explosion sound effect.
OPTION _EXPLICIT
TYPE Vector
x AS SINGLE
y AS SINGLE
END TYPE
TYPE Particle
Pos AS Vector
Vel AS Vector
Acc AS Vector
Visible AS _BYTE
Exploded AS _BYTE
ExplosionStep AS _BYTE
ExplosionMax AS _BYTE
Color AS _UNSIGNED LONG
Size AS _BYTE
END TYPE
REDIM SHARED Firework(1 TO 1) AS Particle
REDIM SHARED Boom(1 TO UBOUND(Firework) * 2, 1) AS Particle
DIM SHARED Trail(1 TO 20000) AS Particle
DIM SHARED StartPointLimit AS SINGLE, InitialVel AS SINGLE
DIM SHARED Gravity AS Vector, Pause AS _BYTE, distant AS LONG
InitialVel = -30
Gravity.y = .8
distant = _SNDOPEN("distant.wav")
RANDOMIZE TIMER
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED BabyYoureAFirework AS LONG
DIM SHARED Canvas AS LONG
DIM SHARED MaxFireworksLB AS LONG
DIM SHARED MaxFireworksTrackBar AS LONG
DIM SHARED MaxParticlesLB AS LONG
DIM SHARED MaxParticlesTrackBar AS LONG
DIM SHARED ShowTextCB AS LONG
DIM SHARED YourTextHereTB AS LONG
DIM SHARED HappyNewYearLB AS LONG
': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Fireworks.frm'
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
END SUB
SUB __UI_OnLoad
_TITLE "Baby, you're a firework"
StartPointLimit = Control(Canvas).Height / 3
Control(MaxFireworksTrackBar).Value = 20
Control(MaxParticlesTrackBar).Value = 150
ToolTip(MaxFireworksTrackBar) = "20"
ToolTip(MaxParticlesTrackBar) = "150"
REDIM _PRESERVE Firework(1 TO Control(MaxFireworksTrackBar).Value) AS Particle
REDIM _PRESERVE Boom(1 TO UBOUND(Firework) * 2, Control(MaxParticlesTrackBar).Value) AS Particle
END SUB
SUB __UI_BeforeUpdateDisplay
STATIC JustExploded AS _BYTE
STATIC t AS INTEGER, Initial AS _BYTE, InitialX AS INTEGER, lastInitial#
DIM AS LONG j, i, a
DIM AS _UNSIGNED LONG thisColor
_DEST Control(Canvas).HelperCanvas
IF JustExploded THEN
JustExploded = False
CLS , _RGB32(0, 0, 50)
ELSE
CLS
END IF
IF _CEIL(RND * 20) < 2 OR (Initial = False AND TIMER - lastInitial# > .1) THEN
'Create a new particle
FOR j = 1 TO UBOUND(Firework)
IF Firework(j).Visible = False THEN
Firework(j).Vel.y = InitialVel
Firework(j).Vel.x = 3 - _CEIL(RND * 6)
IF Initial = True THEN
Firework(j).Pos.x = _CEIL(RND * Control(Canvas).Width)
ELSE
Firework(j).Pos.x = InitialX * (Control(Canvas).Width / 15)
InitialX = InitialX + 1
lastInitial# = TIMER
IF InitialX > 15 THEN Initial = True
END IF
Firework(j).Pos.y = Control(Canvas).Height + _CEIL(RND * StartPointLimit)
Firework(j).Visible = True
Firework(j).Exploded = False
Firework(j).ExplosionStep = 0
Firework(j).Size = _CEIL(RND * 2)
IF Firework(j).Size = 1 THEN
Firework(j).ExplosionMax = 9 + _CEIL(RND * 41)
ELSE
Firework(j).ExplosionMax = 9 + _CEIL(RND * 71)
END IF
Firework(j).ExplosionMax = 20 '0
EXIT FOR
END IF
NEXT j
END IF
'Show trail
FOR i = 1 TO UBOUND(Trail)
IF NOT Pause THEN Trail(i).Color = Darken(Trail(i).Color, 70)
IF Trail(i).Size = 1 THEN
PSET (Trail(i).Pos.x, Trail(i).Pos.y), Trail(i).Color
ELSE
PSET (Trail(i).Pos.x, Trail(i).Pos.y), Trail(i).Color
PSET (Trail(i).Pos.x - 1, Trail(i).Pos.y), Trail(i).Color
PSET (Trail(i).Pos.x + 1, Trail(i).Pos.y), Trail(i).Color
PSET (Trail(i).Pos.x, Trail(i).Pos.y - 1), Trail(i).Color
PSET (Trail(i).Pos.x, Trail(i).Pos.y + 1), Trail(i).Color
END IF
NEXT i
'Update and show particles
FOR i = 1 TO UBOUND(Firework)
'Update trail particles
IF Firework(i).Visible = True AND Firework(i).Exploded = False AND NOT Pause THEN
t = t + 1: IF t > UBOUND(Trail) THEN t = 1
Trail(t).Pos.x = Firework(i).Pos.x
Trail(t).Pos.y = Firework(i).Pos.y
Trail(t).Color = _RGB32(255, 255, 255)
'New position
Firework(i).Vel.y = Firework(i).Vel.y + Gravity.y
Firework(i).Pos.y = Firework(i).Pos.y + Firework(i).Vel.y
Firework(i).Pos.x = Firework(i).Pos.x + Firework(i).Vel.x
END IF
'Explode the particle if it reaches max height
IF Firework(i).Vel.y > 0 THEN
IF Firework(i).Exploded = False THEN
Firework(i).Exploded = True
JustExploded = True
IF Firework(1).Size = 1 THEN
IF distant THEN _SNDPLAYCOPY distant, .5
ELSE
IF distant THEN _SNDPLAYCOPY distant, 1
END IF
thisColor~& = _RGB32(_CEIL(RND * 255), _CEIL(RND * 255), _CEIL(RND * 255))
a = 0
FOR j = 1 TO UBOUND(Boom, 2)
Boom(i, j).Pos.x = Firework(i).Pos.x
Boom(i, j).Pos.y = Firework(i).Pos.y
Boom(i, j).Vel.y = SIN(a) * (RND * 10)
Boom(i, j).Vel.x = COS(a) * (RND * 10)
a = a + 1
Boom(i, j).Color = thisColor~&
Boom(i * 2, j).Pos.x = Firework(i).Pos.x + 5
Boom(i * 2, j).Pos.y = Firework(i).Pos.y + 5
Boom(i * 2, j).Vel.y = Boom(i, j).Vel.y
Boom(i * 2, j).Vel.x = Boom(i, j).Vel.x
a = a + 1
Boom(i * 2, j).Color = thisColor~&
NEXT
END IF
END IF
'Show particle
IF Firework(i).Exploded = False THEN
IF Firework(i).Size = 1 THEN
PSET (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
ELSE
PSET (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
PSET (Firework(i).Pos.x - 1, Firework(i).Pos.y), _RGB32(255, 255, 255)
PSET (Firework(i).Pos.x + 1, Firework(i).Pos.y), _RGB32(255, 255, 255)
PSET (Firework(i).Pos.x, Firework(i).Pos.y - 1), _RGB32(255, 255, 255)
PSET (Firework(i).Pos.x, Firework(i).Pos.y + 1), _RGB32(255, 255, 255)
END IF
ELSEIF Firework(i).Visible THEN
IF NOT Pause THEN Firework(i).ExplosionStep = Firework(i).ExplosionStep + 1
FOR j = 1 TO UBOUND(Boom, 2)
IF Firework(i).Size = 1 THEN
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y), Boom(i, j).Color
ELSE
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
PSET (Boom(i, j).Pos.x - 1, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
PSET (Boom(i, j).Pos.x + 1, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y - 1), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y + 1), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
END IF
IF NOT Pause THEN
t = t + 1: IF t > UBOUND(Trail) THEN t = 1
Trail(t).Pos.x = Boom(i, j).Pos.x
Trail(t).Pos.y = Boom(i, j).Pos.y
Trail(t).Size = Boom(i, j).Size
Trail(t).Color = Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
t = t + 1: IF t > UBOUND(Trail) THEN t = 1
Trail(t).Pos.x = Boom(i * 2, j).Pos.x
Trail(t).Pos.y = Boom(i * 2, j).Pos.y
Trail(t).Size = Boom(i * 2, j).Size
Trail(t).Color = Darken(Boom(i * 2, j).Color, 150)
Boom(i, j).Vel.y = Boom(i, j).Vel.y + Gravity.y / 10
Boom(i, j).Pos.x = Boom(i, j).Pos.x + Boom(i, j).Vel.x '+ Firework(i).Vel.x
Boom(i, j).Pos.y = Boom(i, j).Pos.y + Boom(i, j).Vel.y
Boom(i * 2, j).Vel.y = Boom(i * 2, j).Vel.y + Gravity.y / 10
Boom(i * 2, j).Pos.x = Boom(i * 2, j).Pos.x + Boom(i * 2, j).Vel.x '+ Firework(i).Vel.x
Boom(i * 2, j).Pos.y = Boom(i * 2, j).Pos.y + Boom(i * 2, j).Vel.y
END IF
NEXT
IF Firework(i).ExplosionStep > Firework(i).ExplosionMax THEN Firework(i).Visible = False
END IF
NEXT
Control(HappyNewYearLB).Hidden = NOT Control(ShowTextCB).Value
_DEST 0
Control(Canvas).PreviousValue = 0
END SUB
SUB __UI_BeforeUnload
END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE BabyYoureAFirework
CASE Canvas
Pause = NOT Pause
IF Pause THEN
Caption(HappyNewYearLB) = "PAUSED"
ELSE
Caption(HappyNewYearLB) = Text(YourTextHereTB)
END IF
CASE MaxFireworksLB
CASE MaxFireworksTrackBar
CASE MaxParticlesLB
CASE MaxParticlesTrackBar
CASE ShowTextCB
CASE YourTextHereTB
CASE HappyNewYearLB
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
SELECT CASE id
CASE BabyYoureAFirework
CASE Canvas
CASE MaxFireworksLB
CASE MaxFireworksTrackBar
CASE MaxParticlesLB
CASE MaxParticlesTrackBar
CASE ShowTextCB
CASE YourTextHereTB
CASE HappyNewYearLB
END SELECT
END SUB
SUB __UI_MouseLeave (id AS LONG)
SELECT CASE id
CASE BabyYoureAFirework
CASE Canvas
CASE MaxFireworksLB
CASE MaxFireworksTrackBar
CASE MaxParticlesLB
CASE MaxParticlesTrackBar
CASE ShowTextCB
CASE YourTextHereTB
CASE HappyNewYearLB
END SELECT
END SUB
SUB __UI_FocusIn (id AS LONG)
SELECT CASE id
CASE MaxFireworksTrackBar
CASE MaxParticlesTrackBar
CASE ShowTextCB
CASE YourTextHereTB
END SELECT
END SUB
SUB __UI_FocusOut (id AS LONG)
SELECT CASE id
CASE MaxFireworksTrackBar
CASE MaxParticlesTrackBar
CASE ShowTextCB
CASE YourTextHereTB
END SELECT
END SUB
SUB __UI_MouseDown (id AS LONG)
SELECT CASE id
CASE BabyYoureAFirework
CASE Canvas
CASE MaxFireworksLB
CASE MaxFireworksTrackBar
CASE MaxParticlesLB
CASE MaxParticlesTrackBar
CASE ShowTextCB
CASE YourTextHereTB
CASE HappyNewYearLB
END SELECT
END SUB
SUB __UI_MouseUp (id AS LONG)
SELECT CASE id
CASE BabyYoureAFirework
CASE Canvas
CASE MaxFireworksLB
CASE MaxFireworksTrackBar
CASE MaxParticlesLB
CASE MaxParticlesTrackBar
CASE ShowTextCB
CASE YourTextHereTB
CASE HappyNewYearLB
END SELECT
END SUB
SUB __UI_KeyPress (id AS LONG)
SELECT CASE id
CASE MaxFireworksTrackBar
CASE MaxParticlesTrackBar
CASE ShowTextCB
CASE YourTextHereTB
END SELECT
END SUB
SUB __UI_TextChanged (id AS LONG)
SELECT CASE id
CASE YourTextHereTB
Caption(HappyNewYearLB) = Text(YourTextHereTB)
END SELECT
END SUB
SUB __UI_ValueChanged (id AS LONG)
Control(id).Value = INT(Control(id).Value)
SELECT CASE id
CASE ShowTextCB
CASE MaxFireworksTrackBar
REDIM _PRESERVE Firework(1 TO Control(MaxFireworksTrackBar).Value) AS Particle
ToolTip(id) = STR$(Control(MaxFireworksTrackBar).Value)
CASE MaxParticlesTrackBar
REDIM _PRESERVE Boom(1 TO UBOUND(Firework) * 2, Control(MaxParticlesTrackBar).Value) AS Particle
ToolTip(id) = STR$(Control(MaxParticlesTrackBar).Value)
END SELECT
END SUB
SUB __UI_FormResized
END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

33
examples/Fireworks2Inform/Fireworks.frm → examples/Fireworks2/Fireworks.frm
View file

@ -1,65 +1,84 @@
': This form was generated by
': InForm - GUI library for QB64 - Beta version 8
': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - @fellippeheitor
': InForm - GUI library for QB64 - v1.5
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
DIM __UI_NewID AS LONG
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "Fireworks", 810, 663, 0, 0, 0)
Caption(__UI_NewID) = "Baby, you're a firework"
__UI_NewID = __UI_NewControl(__UI_Type_Form, "BabyYoureAFirework", 810, 663, 0, 0, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Baby, you're a firework"
Control(__UI_NewID).Font = SetFont("arial.ttf?InForm/resources/NotoMono-Regular.ttf", 12)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CenteredWindow = True
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "Canvas", 800, 600, 5, 5, 0)
SetCaption __UI_NewID, "Your text here"
__UI_RegisterResult = 0
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Label, "MaxFireworksLB", 86, 23, 5, 612, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Max fireworks:"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_TrackBar, "MaxFireworksTrackBar", 120, 40, 95, 612, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Min = 1
Control(__UI_NewID).Max = 20
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).Interval = 1
__UI_NewID = __UI_NewControl(__UI_Type_Label, "MaxParticlesLB", 86, 23, 235, 612, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Max particles:"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_TrackBar, "MaxParticlesTrackBar", 250, 40, 325, 612, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Min = 1
Control(__UI_NewID).Max = 150
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).Interval = 30
__UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "ShowTextCB", 87, 23, 590, 620, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Show text:"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Value = -1
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "YourTextHereTB", 129, 23, 676, 620, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Your text here"
Text(__UI_NewID) = "Happy New Year!"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Label, "HappyNewYearLB", 800, 78, 5, 527, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Happy New Year!"
Control(__UI_NewID).Font = SetFont("cyberbit.ttf?times.ttf?arial.ttf?InForm/resources/NotoMono-Regular.ttf", 48)
Control(__UI_NewID).ForeColor = _RGB32(255, 255, 255)
Control(__UI_NewID).BackStyle = __UI_Transparent
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
END SUB
SUB __UI_AssignIDs
Fireworks = __UI_GetID("Fireworks")
BabyYoureAFirework = __UI_GetID("BabyYoureAFirework")
Canvas = __UI_GetID("Canvas")
MaxFireworksLB = __UI_GetID("MaxFireworksLB")
MaxFireworksTrackBar = __UI_GetID("MaxFireworksTrackBar")

0
examples/Fireworks2Inform/distant.wav → examples/Fireworks2/distant.wav
View file

422
examples/Fireworks2Inform/Fireworks.bas
View file

@ -1,422 +0,0 @@
': This program uses
': InForm - GUI library for QB64 - v1.0
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
'Improved fireworks:
' - Particles now leave a trail behind
' - Round explosions (sin/cos been used...)
' - Explosion sound effect.
Option _Explicit
Type Vector
x As Single
y As Single
End Type
Type Particle
Pos As Vector
Vel As Vector
Acc As Vector
Visible As _Byte
Exploded As _Byte
ExplosionStep As _Byte
ExplosionMax As _Byte
Color As _Unsigned Long
Size As _Byte
End Type
ReDim Shared Firework(1 To 1) As Particle
ReDim Shared Boom(1 To UBound(Firework) * 2, 1) As Particle
Dim Shared Trail(1 To 20000) As Particle
Dim Shared StartPointLimit As Single, InitialVel As Single
Dim Shared Gravity As Vector, Pause As _Byte, distant As Long
InitialVel = -30
Gravity.y = .8
distant = _SndOpen("distant.wav")
Randomize Timer
': Controls' IDs: ------------------------------------------------------------------
Dim Shared Fireworks As Long
Dim Shared Canvas As Long
Dim Shared MaxFireworksLB As Long
Dim Shared MaxFireworksTrackBar As Long
Dim Shared MaxParticlesLB As Long
Dim Shared MaxParticlesTrackBar As Long
Dim Shared ShowTextCB As Long
Dim Shared YourTextHereTB As Long
Dim Shared HappyNewYearLB As Long
': External modules: ---------------------------------------------------------------
'$INCLUDE:'InForm\InForm.bi'
'$INCLUDE:'InForm\xp.uitheme'
'$INCLUDE:'Fireworks.frm'
': Event procedures: ---------------------------------------------------------------
Sub __UI_BeforeInit
End Sub
Sub __UI_OnLoad
_Title "Baby, you're a firework"
StartPointLimit = Control(Canvas).Height / 3
Control(MaxFireworksTrackBar).Value = 20
Control(MaxParticlesTrackBar).Value = 150
ToolTip(MaxFireworksTrackBar) = "20"
ToolTip(MaxParticlesTrackBar) = "150"
ReDim _Preserve Firework(1 To Control(MaxFireworksTrackBar).Value) As Particle
ReDim _Preserve Boom(1 To UBound(Firework) * 2, Control(MaxParticlesTrackBar).Value) As Particle
End Sub
Sub __UI_BeforeUpdateDisplay
Static JustExploded As _Byte
Static t As Integer, Initial As _Byte, InitialX As Integer, lastInitial#
Dim As Long j, i, a
Dim As _Unsigned Long thisColor
_Dest Control(Canvas).HelperCanvas
If JustExploded Then
JustExploded = False
Cls , _RGB32(0, 0, 50)
Else
Cls
End If
If _Ceil(Rnd * 20) < 2 Or (Initial = False And Timer - lastInitial# > .1) Then
'Create a new particle
For j = 1 To UBound(Firework)
If Firework(j).Visible = False Then
Firework(j).Vel.y = InitialVel
Firework(j).Vel.x = 3 - _Ceil(Rnd * 6)
If Initial = True Then
Firework(j).Pos.x = _Ceil(Rnd * Control(Canvas).Width)
Else
Firework(j).Pos.x = InitialX * (Control(Canvas).Width / 15)
InitialX = InitialX + 1
lastInitial# = Timer
If InitialX > 15 Then Initial = True
End If
Firework(j).Pos.y = Control(Canvas).Height + _Ceil(Rnd * StartPointLimit)
Firework(j).Visible = True
Firework(j).Exploded = False
Firework(j).ExplosionStep = 0
Firework(j).Size = _Ceil(Rnd * 2)
If Firework(j).Size = 1 Then
Firework(j).ExplosionMax = 9 + _Ceil(Rnd * 41)
Else
Firework(j).ExplosionMax = 9 + _Ceil(Rnd * 71)
End If
Firework(j).ExplosionMax = 20 '0
Exit For
End If
Next j
End If
'Show trail
For i = 1 To UBound(Trail)
If Not Pause Then Trail(i).Color = Darken(Trail(i).Color, 70)
If Trail(i).Size = 1 Then
PSet (Trail(i).Pos.x, Trail(i).Pos.y), Trail(i).Color
Else
PSet (Trail(i).Pos.x, Trail(i).Pos.y), Trail(i).Color
PSet (Trail(i).Pos.x - 1, Trail(i).Pos.y), Trail(i).Color
PSet (Trail(i).Pos.x + 1, Trail(i).Pos.y), Trail(i).Color
PSet (Trail(i).Pos.x, Trail(i).Pos.y - 1), Trail(i).Color
PSet (Trail(i).Pos.x, Trail(i).Pos.y + 1), Trail(i).Color
End If
Next i
'Update and show particles
For i = 1 To UBound(Firework)
'Update trail particles
If Firework(i).Visible = True And Firework(i).Exploded = False And Not Pause Then
t = t + 1: If t > UBound(Trail) Then t = 1
Trail(t).Pos.x = Firework(i).Pos.x
Trail(t).Pos.y = Firework(i).Pos.y
Trail(t).Color = _RGB32(255, 255, 255)
'New position
Firework(i).Vel.y = Firework(i).Vel.y + Gravity.y
Firework(i).Pos.y = Firework(i).Pos.y + Firework(i).Vel.y
Firework(i).Pos.x = Firework(i).Pos.x + Firework(i).Vel.x
End If
'Explode the particle if it reaches max height
If Firework(i).Vel.y > 0 Then
If Firework(i).Exploded = False Then
Firework(i).Exploded = True
JustExploded = True
If Firework(1).Size = 1 Then
If distant Then _SndPlayCopy distant, .5
Else
If distant Then _SndPlayCopy distant, 1
End If
thisColor~& = _RGB32(_Ceil(Rnd * 255), _Ceil(Rnd * 255), _Ceil(Rnd * 255))
a = 0
For j = 1 To UBound(Boom, 2)
Boom(i, j).Pos.x = Firework(i).Pos.x
Boom(i, j).Pos.y = Firework(i).Pos.y
Boom(i, j).Vel.y = Sin(a) * (Rnd * 10)
Boom(i, j).Vel.x = Cos(a) * (Rnd * 10)
a = a + 1
Boom(i, j).Color = thisColor~&
Boom(i * 2, j).Pos.x = Firework(i).Pos.x + 5
Boom(i * 2, j).Pos.y = Firework(i).Pos.y + 5
Boom(i * 2, j).Vel.y = Boom(i, j).Vel.y
Boom(i * 2, j).Vel.x = Boom(i, j).Vel.x
a = a + 1
Boom(i * 2, j).Color = thisColor~&
Next
End If
End If
'Show particle
If Firework(i).Exploded = False Then
If Firework(i).Size = 1 Then
PSet (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
Else
PSet (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
PSet (Firework(i).Pos.x - 1, Firework(i).Pos.y), _RGB32(255, 255, 255)
PSet (Firework(i).Pos.x + 1, Firework(i).Pos.y), _RGB32(255, 255, 255)
PSet (Firework(i).Pos.x, Firework(i).Pos.y - 1), _RGB32(255, 255, 255)
PSet (Firework(i).Pos.x, Firework(i).Pos.y + 1), _RGB32(255, 255, 255)
End If
ElseIf Firework(i).Visible Then
If Not Pause Then Firework(i).ExplosionStep = Firework(i).ExplosionStep + 1
For j = 1 To UBound(Boom, 2)
If Firework(i).Size = 1 Then
PSet (Boom(i, j).Pos.x, Boom(i, j).Pos.y), Boom(i, j).Color
Else
PSet (Boom(i, j).Pos.x, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
PSet (Boom(i, j).Pos.x - 1, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
PSet (Boom(i, j).Pos.x + 1, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
PSet (Boom(i, j).Pos.x, Boom(i, j).Pos.y - 1), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
PSet (Boom(i, j).Pos.x, Boom(i, j).Pos.y + 1), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
End If
If Not Pause Then
t = t + 1: If t > UBound(Trail) Then t = 1
Trail(t).Pos.x = Boom(i, j).Pos.x
Trail(t).Pos.y = Boom(i, j).Pos.y
Trail(t).Size = Boom(i, j).Size
Trail(t).Color = Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
t = t + 1: If t > UBound(Trail) Then t = 1
Trail(t).Pos.x = Boom(i * 2, j).Pos.x
Trail(t).Pos.y = Boom(i * 2, j).Pos.y
Trail(t).Size = Boom(i * 2, j).Size
Trail(t).Color = Darken(Boom(i * 2, j).Color, 150)
Boom(i, j).Vel.y = Boom(i, j).Vel.y + Gravity.y / 10
Boom(i, j).Pos.x = Boom(i, j).Pos.x + Boom(i, j).Vel.x '+ Firework(i).Vel.x
Boom(i, j).Pos.y = Boom(i, j).Pos.y + Boom(i, j).Vel.y
Boom(i * 2, j).Vel.y = Boom(i * 2, j).Vel.y + Gravity.y / 10
Boom(i * 2, j).Pos.x = Boom(i * 2, j).Pos.x + Boom(i * 2, j).Vel.x '+ Firework(i).Vel.x
Boom(i * 2, j).Pos.y = Boom(i * 2, j).Pos.y + Boom(i * 2, j).Vel.y
End If
Next
If Firework(i).ExplosionStep > Firework(i).ExplosionMax Then Firework(i).Visible = False
End If
Next
Control(HappyNewYearLB).Hidden = Not Control(ShowTextCB).Value
_Dest 0
Control(Canvas).PreviousValue = 0
End Sub
Sub __UI_BeforeUnload
End Sub
Sub __UI_Click (id As Long)
Select Case id
Case Fireworks
Case Canvas
Pause = Not Pause
If Pause Then
Caption(HappyNewYearLB) = "PAUSED"
Else
Caption(HappyNewYearLB) = Text(YourTextHereTB)
End If
Case MaxFireworksLB
Case MaxFireworksTrackBar
Case MaxParticlesLB
Case MaxParticlesTrackBar
Case ShowTextCB
Case YourTextHereTB
Case HappyNewYearLB
End Select
End Sub
Sub __UI_MouseEnter (id As Long)
Select Case id
Case Fireworks
Case Canvas
Case MaxFireworksLB
Case MaxFireworksTrackBar
Case MaxParticlesLB
Case MaxParticlesTrackBar
Case ShowTextCB
Case YourTextHereTB
Case HappyNewYearLB
End Select
End Sub
Sub __UI_MouseLeave (id As Long)
Select Case id
Case Fireworks
Case Canvas
Case MaxFireworksLB
Case MaxFireworksTrackBar
Case MaxParticlesLB
Case MaxParticlesTrackBar
Case ShowTextCB
Case YourTextHereTB
Case HappyNewYearLB
End Select
End Sub
Sub __UI_FocusIn (id As Long)
Select Case id
Case MaxFireworksTrackBar
Case MaxParticlesTrackBar
Case ShowTextCB
Case YourTextHereTB
End Select
End Sub
Sub __UI_FocusOut (id As Long)
Select Case id
Case MaxFireworksTrackBar
Case MaxParticlesTrackBar
Case ShowTextCB
Case YourTextHereTB
End Select
End Sub
Sub __UI_MouseDown (id As Long)
Select Case id
Case Fireworks
Case Canvas
Case MaxFireworksLB
Case MaxFireworksTrackBar
Case MaxParticlesLB
Case MaxParticlesTrackBar
Case ShowTextCB
Case YourTextHereTB
Case HappyNewYearLB
End Select
End Sub
Sub __UI_MouseUp (id As Long)
Select Case id
Case Fireworks
Case Canvas
Case MaxFireworksLB
Case MaxFireworksTrackBar
Case MaxParticlesLB
Case MaxParticlesTrackBar
Case ShowTextCB
Case YourTextHereTB
Case HappyNewYearLB
End Select
End Sub
Sub __UI_KeyPress (id As Long)
Select Case id
Case MaxFireworksTrackBar
Case MaxParticlesTrackBar
Case ShowTextCB
Case YourTextHereTB
End Select
End Sub
Sub __UI_TextChanged (id As Long)
Select Case id
Case YourTextHereTB
Caption(HappyNewYearLB) = Text(YourTextHereTB)
End Select
End Sub
Sub __UI_ValueChanged (id As Long)
Control(id).Value = Int(Control(id).Value)
Select Case id
Case MaxFireworksTrackBar
ReDim _Preserve Firework(1 To Control(MaxFireworksTrackBar).Value) As Particle
ToolTip(id) = Str$(Control(MaxFireworksTrackBar).Value)
Case MaxParticlesTrackBar
ReDim _Preserve Boom(1 To UBound(Firework) * 2, Control(MaxParticlesTrackBar).Value) As Particle
ToolTip(id) = Str$(Control(MaxParticlesTrackBar).Value)
End Select
End Sub
Sub __UI_FormResized
End Sub
'$INCLUDE:'InForm\InForm.ui'

344
examples/Fireworks2Inform/InForm/InForm.bi
View file

@ -1,344 +0,0 @@
'InForm - GUI library for QB64
'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
'
$If VERSION < 3.8 Then
$Error This requires the latest version of QB64-PE from https://github.com/QB64-Phoenix-Edition/QB64pe/releases
$End If
DECLARE LIBRARY
FUNCTION __UI_GetPID ALIAS getpid ()
END DECLARE
DECLARE CUSTOMTYPE LIBRARY
SUB __UI_MemCopy ALIAS memcpy (BYVAL dest AS _OFFSET, BYVAL source AS _OFFSET, BYVAL bytes AS LONG)
END DECLARE
$IF WIN THEN
DECLARE LIBRARY
FUNCTION GetSystemMetrics& (BYVAL WhichMetric&)
END DECLARE
CONST __UI_SM_SWAPBUTTON = 23
$END IF
$SCREENHIDE
_CONTROLCHR OFF
TYPE __UI_ControlTYPE
ID AS LONG
ParentID AS LONG
PreviousParentID AS LONG
ContextMenuID AS LONG
Type AS INTEGER
Name AS STRING * 40
ParentName AS STRING * 40
SubMenu AS _BYTE
MenuPanelID AS LONG
SourceControl AS LONG
Top AS INTEGER
Left AS INTEGER
Width AS INTEGER
Height AS INTEGER
Canvas AS LONG
HelperCanvas AS LONG
TransparentColor AS _UNSIGNED LONG
Stretch AS _BYTE
PreviousStretch AS _BYTE
Font AS INTEGER
PreviousFont AS INTEGER
BackColor AS _UNSIGNED LONG
ForeColor AS _UNSIGNED LONG
SelectedForeColor AS _UNSIGNED LONG
SelectedBackColor AS _UNSIGNED LONG
BackStyle AS _BYTE
HasBorder AS _BYTE
BorderSize AS INTEGER
Padding AS INTEGER
Encoding AS LONG
Align AS _BYTE
PrevAlign AS _BYTE
VAlign AS _BYTE
PrevVAlign AS _BYTE
BorderColor AS _UNSIGNED LONG
Value AS _FLOAT
PreviousValue AS _FLOAT
Min AS _FLOAT
PrevMin AS _FLOAT
Max AS _FLOAT
PrevMax AS _FLOAT
Interval AS _FLOAT
PrevInterval AS _FLOAT
MinInterval AS _FLOAT
PrevMinInterval AS _FLOAT
HotKey AS INTEGER
HotKeyOffset AS INTEGER
HotKeyPosition AS INTEGER
ShowPercentage AS _BYTE
AutoScroll AS _BYTE
AutoSize AS _BYTE
InputViewStart AS LONG
PreviousInputViewStart AS LONG
LastVisibleItem AS INTEGER
ItemHeight AS INTEGER
HasVScrollbar AS _BYTE
VScrollbarButton2Top AS INTEGER
HoveringVScrollbarButton AS _BYTE
ThumbHeight AS INTEGER
ThumbTop AS INTEGER
VScrollbarRatio AS SINGLE
Cursor AS LONG
PasswordField AS _BYTE
PrevCursor AS LONG
FieldArea AS LONG
PreviousFieldArea AS LONG
TextIsSelected AS _BYTE
BypassSelectOnFocus AS _BYTE
Multiline AS _BYTE
NumericOnly AS _BYTE
FirstVisibleLine AS LONG
PrevFirstVisibleLine AS LONG
CurrentLine AS LONG
PrevCurrentLine AS LONG
VisibleCursor AS LONG
PrevVisibleCursor AS LONG
ControlIsSelected AS _BYTE
LeftOffsetFromFirstSelected AS INTEGER
TopOffsetFromFirstSelected AS INTEGER
SelectionLength AS LONG
SelectionStart AS LONG
WordWrap AS _BYTE
CanResize AS _BYTE
CanHaveFocus AS _BYTE
Disabled AS _BYTE
Hidden AS _BYTE
PreviouslyHidden AS _BYTE
CenteredWindow AS _BYTE
ControlState AS _BYTE
ChildrenRedrawn AS _BYTE
FocusState AS LONG
LastChange AS SINGLE
Redraw AS _BYTE
BulletStyle AS _BYTE
MenuItemGroup AS INTEGER
KeyCombo AS LONG
BoundTo AS LONG
BoundProperty AS LONG
END TYPE
TYPE __UI_Types
Name AS STRING * 16
Count AS LONG
TurnsInto AS INTEGER
DefaultHeight AS INTEGER
MinimumHeight AS INTEGER
DefaultWidth AS INTEGER
MinimumWidth AS INTEGER
RestrictResize AS _BYTE
END TYPE
TYPE __UI_ThemeImagesType
FileName AS STRING * 32
Handle AS LONG
END TYPE
TYPE __UI_WordWrapHistoryType
StringSlot AS LONG
Width AS INTEGER
LongestLine AS INTEGER
Font AS LONG
TotalLines AS INTEGER
END TYPE
TYPE __UI_KeyCombos
Combo AS STRING * 14 ' "CTRL+SHIFT+F12"
FriendlyCombo AS STRING * 14 ' "Ctrl+Shift+F12"
ControlID AS LONG
END TYPE
REDIM SHARED Caption(0 TO 100) AS STRING
REDIM SHARED __UI_TempCaptions(0 TO 100) AS STRING
REDIM SHARED Text(0 TO 100) AS STRING
REDIM SHARED __UI_TempTexts(0 TO 100) AS STRING
REDIM SHARED Mask(0 TO 100) AS STRING
REDIM SHARED __UI_TempMask(0 TO 100) AS STRING
REDIM SHARED ToolTip(0 TO 100) AS STRING
REDIM SHARED __UI_TempTips(0 TO 100) AS STRING
REDIM SHARED Control(0 TO 100) AS __UI_ControlTYPE
REDIM SHARED ControlDrawOrder(0) AS LONG
REDIM SHARED __UI_ThemeImages(0 TO 100) AS __UI_ThemeImagesType
REDIM SHARED __UI_WordWrapHistoryTexts(0 TO 100) AS STRING
REDIM SHARED __UI_WordWrapHistoryResults(0 TO 100) AS STRING
REDIM SHARED __UI_WordWrapHistory(0 TO 100) AS __UI_WordWrapHistoryType
REDIM SHARED __UI_ThisLineChars(0) AS LONG, __UI_FocusedTextBoxChars(0) AS LONG
REDIM SHARED __UI_ActiveMenu(0 TO 100) AS LONG, __UI_ParentMenu(0 TO 100) AS LONG
REDIM SHARED __UI_KeyCombo(0 TO 100) AS __UI_KeyCombos
DIM SHARED __UI_TotalKeyCombos AS LONG, __UI_BypassKeyCombos AS _BYTE
DIM SHARED table1252$(0 TO 255), table437$(0 TO 255)
DIM SHARED __UI_MouseLeft AS INTEGER, __UI_MouseTop AS INTEGER
DIM SHARED __UI_MouseWheel AS INTEGER, __UI_MouseButtonsSwap AS _BYTE
DIM SHARED __UI_PrevMouseLeft AS INTEGER, __UI_PrevMouseTop AS INTEGER
DIM SHARED __UI_MouseButton1 AS _BYTE, __UI_MouseButton2 AS _BYTE
DIM SHARED __UI_MouseIsDown AS _BYTE, __UI_MouseDownOnID AS LONG
DIM SHARED __UI_Mouse2IsDown AS _BYTE, __UI_Mouse2DownOnID AS LONG
DIM SHARED __UI_PreviousMouseDownOnID AS LONG
DIM SHARED __UI_KeyIsDown AS _BYTE, __UI_KeyDownOnID AS LONG
DIM SHARED __UI_ShiftIsDown AS _BYTE, __UI_CtrlIsDown AS _BYTE
DIM SHARED __UI_AltIsDown AS _BYTE, __UI_ShowHotKeys AS _BYTE, __UI_AltCombo$
DIM SHARED __UI_LastMouseClick AS SINGLE, __UI_MouseDownOnScrollbar AS SINGLE
DIM SHARED __UI_DragX AS INTEGER, __UI_DragY AS INTEGER
DIM SHARED __UI_DefaultButtonID AS LONG
DIM SHARED __UI_KeyHit AS LONG, __UI_KeepFocus AS _BYTE
DIM SHARED __UI_Focus AS LONG, __UI_PreviousFocus AS LONG, __UI_KeyboardFocus AS _BYTE
DIM SHARED __UI_HoveringID AS LONG, __UI_LastHoveringID AS LONG, __UI_BelowHoveringID AS LONG
DIM SHARED __UI_IsDragging AS _BYTE, __UI_DraggingID AS LONG
DIM SHARED __UI_IsResizing AS _BYTE, __UI_ResizingID AS LONG
DIM SHARED __UI_ResizeHandleHover AS _BYTE
DIM SHARED __UI_IsSelectingText AS _BYTE, __UI_IsSelectingTextOnID AS LONG
DIM SHARED __UI_SelectedText AS STRING, __UI_SelectionLength AS LONG
DIM SHARED __UI_StateHasChanged AS _BYTE
DIM SHARED __UI_DraggingThumb AS _BYTE, __UI_ThumbDragTop AS INTEGER
DIM SHARED __UI_DraggingThumbOnID AS LONG
DIM SHARED __UI_HasInput AS _BYTE, __UI_ProcessInputTimer AS SINGLE
DIM SHARED __UI_UnloadSignal AS _BYTE, __UI_HasResized AS _BYTE
DIM SHARED __UI_ExitTriggered AS _BYTE
DIM SHARED __UI_Loaded AS _BYTE
DIM SHARED __UI_EventsTimer AS INTEGER, __UI_RefreshTimer AS INTEGER
DIM SHARED __UI_ActiveDropdownList AS LONG, __UI_ParentDropdownList AS LONG
DIM SHARED __UI_TotalActiveMenus AS LONG, __UI_ActiveMenuIsContextMenu AS _BYTE
DIM SHARED __UI_SubMenuDelay AS SINGLE, __UI_HoveringSubMenu AS _BYTE
DIM SHARED __UI_TopMenuBarItem AS LONG
DIM SHARED __UI_ActiveTipID AS LONG, __UI_TipTimer AS SINGLE, __UI_PreviousTipID AS LONG
DIM SHARED __UI_ActiveTipTop AS INTEGER, __UI_ActiveTipLeft AS INTEGER
DIM SHARED __UI_FormID AS LONG, __UI_HasMenuBar AS LONG
DIM SHARED __UI_ScrollbarWidth AS INTEGER, __UI_ScrollbarButtonHeight AS INTEGER
DIM SHARED __UI_MenuBarOffset AS INTEGER, __UI_MenuItemOffset AS INTEGER
DIM SHARED __UI_NewMenuBarTextLeft AS INTEGER, __UI_DefaultCaptionIndent AS INTEGER
DIM SHARED __UI_ForceRedraw AS _BYTE, __UI_AutoRefresh AS _BYTE
DIM SHARED __UI_CurrentTitle AS STRING
DIM SHARED __UI_DesignMode AS _BYTE, __UI_FirstSelectedID AS LONG
DIM SHARED __UI_WaitMessage AS STRING, __UI_TotalSelectedControls AS LONG
DIM SHARED __UI_WaitMessageHandle AS LONG, __UI_EditorMode AS _BYTE
DIM SHARED __UI_LastRenderedCharCount AS LONG
DIM SHARED __UI_SelectionRectangleTop AS INTEGER, __UI_SelectionRectangleLeft AS INTEGER
DIM SHARED __UI_SelectionRectangle AS _BYTE
DIM SHARED __UI_CantShowContextMenu AS _BYTE, __UI_ShowPositionAndSize AS _BYTE
DIM SHARED __UI_ShowInvisibleControls AS _BYTE, __UI_Snapped AS _BYTE
DIM SHARED __UI_SnappedByProximityX AS _BYTE, __UI_SnappedByProximityY AS _BYTE
DIM SHARED __UI_SnappedX AS INTEGER, __UI_SnappedY AS INTEGER
DIM SHARED __UI_SnappedXID AS LONG, __UI_SnappedYID AS LONG
DIM SHARED __UI_SnapLines AS _BYTE, __UI_SnapDistance AS INTEGER, __UI_SnapDistanceFromForm AS INTEGER
DIM SHARED __UI_FrameRate AS SINGLE, __UI_Font8Offset AS INTEGER, __UI_Font16Offset AS INTEGER
DIM SHARED __UI_ClipboardCheck$, __UI_MenuBarOffsetV AS INTEGER
DIM SHARED __UI_KeepScreenHidden AS _BYTE, __UI_MaxBorderSize AS INTEGER
DIM SHARED __UI_InternalContextMenus AS LONG, __UI_DidClick AS _BYTE
DIM SHARED __UI_ContextMenuSourceID AS LONG
DIM SHARED __UI_FKey(1 TO 12) AS LONG
'Control types: -----------------------------------------------
DIM SHARED __UI_Type(0 TO 18) AS __UI_Types
__UI_Type(__UI_Type_Form).Name = "Form"
__UI_Type(__UI_Type_Frame).Name = "Frame"
__UI_Type(__UI_Type_Frame).DefaultWidth = 230
__UI_Type(__UI_Type_Frame).DefaultHeight = 150
__UI_Type(__UI_Type_Button).Name = "Button"
__UI_Type(__UI_Type_Button).DefaultWidth = 80
__UI_Type(__UI_Type_Button).DefaultHeight = 23
__UI_Type(__UI_Type_Label).Name = "Label"
__UI_Type(__UI_Type_Label).DefaultWidth = 150
__UI_Type(__UI_Type_Label).DefaultHeight = 23
__UI_Type(__UI_Type_CheckBox).Name = "CheckBox"
__UI_Type(__UI_Type_CheckBox).DefaultWidth = 150
__UI_Type(__UI_Type_CheckBox).DefaultHeight = 23
__UI_Type(__UI_Type_CheckBox).TurnsInto = __UI_Type_ToggleSwitch
__UI_Type(__UI_Type_RadioButton).Name = "RadioButton"
__UI_Type(__UI_Type_RadioButton).DefaultWidth = 150
__UI_Type(__UI_Type_RadioButton).DefaultHeight = 23
__UI_Type(__UI_Type_TextBox).Name = "TextBox"
__UI_Type(__UI_Type_TextBox).DefaultWidth = 120
__UI_Type(__UI_Type_TextBox).DefaultHeight = 23
__UI_Type(__UI_Type_ProgressBar).Name = "ProgressBar"
__UI_Type(__UI_Type_ProgressBar).DefaultWidth = 300
__UI_Type(__UI_Type_ProgressBar).DefaultHeight = 23
__UI_Type(__UI_Type_ListBox).Name = "ListBox"
__UI_Type(__UI_Type_ListBox).DefaultWidth = 200
__UI_Type(__UI_Type_ListBox).DefaultHeight = 200
__UI_Type(__UI_Type_ListBox).TurnsInto = __UI_Type_DropdownList
__UI_Type(__UI_Type_DropdownList).Name = "DropdownList"
__UI_Type(__UI_Type_DropdownList).DefaultWidth = 200
__UI_Type(__UI_Type_DropdownList).DefaultHeight = 23
__UI_Type(__UI_Type_DropdownList).TurnsInto = __UI_Type_ListBox
__UI_Type(__UI_Type_MenuBar).Name = "MenuBar"
__UI_Type(__UI_Type_MenuBar).TurnsInto = __UI_Type_ContextMenu
__UI_Type(__UI_Type_MenuBar).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_MenuItem).Name = "MenuItem"
__UI_Type(__UI_Type_MenuItem).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_MenuPanel).Name = "MenuPanel"
__UI_Type(__UI_Type_PictureBox).Name = "PictureBox"
__UI_Type(__UI_Type_PictureBox).DefaultWidth = 230
__UI_Type(__UI_Type_PictureBox).DefaultHeight = 150
__UI_Type(__UI_Type_TrackBar).Name = "TrackBar"
__UI_Type(__UI_Type_TrackBar).DefaultWidth = 300
__UI_Type(__UI_Type_TrackBar).DefaultHeight = 40
__UI_Type(__UI_Type_TrackBar).MinimumHeight = 30
__UI_Type(__UI_Type_TrackBar).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_ContextMenu).Name = "ContextMenu"
__UI_Type(__UI_Type_ContextMenu).TurnsInto = __UI_Type_MenuBar
__UI_Type(__UI_Type_ContextMenu).RestrictResize = __UI_CantResize
__UI_Type(__UI_Type_ContextMenu).DefaultWidth = 22
__UI_Type(__UI_Type_ContextMenu).DefaultHeight = 22
__UI_Type(__UI_Type_Font).Name = "Font"
__UI_Type(__UI_Type_ToggleSwitch).Name = "ToggleSwitch"
__UI_Type(__UI_Type_ToggleSwitch).DefaultWidth = 40
__UI_Type(__UI_Type_ToggleSwitch).DefaultHeight = 17
__UI_Type(__UI_Type_ToggleSwitch).TurnsInto = __UI_Type_CheckBox
__UI_Type(__UI_Type_ToggleSwitch).RestrictResize = __UI_CantResize
'--------------------------------------------------------------
__UI_RestoreFKeys
CONST False = 0, True = Not False
'$INCLUDE:'InFormVersion.bas'
__UI_SubMenuDelay = .4
__UI_SnapDistance = 5
__UI_SnapDistanceFromForm = 10
__UI_MaxBorderSize = 10
__UI_Font8Offset = 5
__UI_Font16Offset = 3
__UI_ClipboardCheck$ = "InForm" + STRING$(2, 10) + "BEGIN CONTROL DATA" + CHR$(10) + STRING$(60, 45) + CHR$(10)
__UI_ThemeSetup
__UI_InternalMenus
__UI_LoadForm
__UI_Init
'Main loop
DO
_LIMIT 1
LOOP
SYSTEM
__UI_ErrorHandler:
RESUME NEXT

8697
examples/Fireworks2Inform/InForm/InForm.ui
View file

File diff suppressed because it is too large Load diff

7
examples/Fireworks2Inform/InForm/InFormVersion.bas
View file

@ -1,7 +0,0 @@
'Starting with v1.0, __UI_VersionNumber is actually the current build.
CONST __UI_Version = "v1.5"
CONST __UI_VersionNumber = 1
CONST __UI_VersionIsBeta = 1
CONST __UI_CopyrightSpan = "2016-2023"

1144
examples/Fireworks2Inform/InForm/xp.uitheme
View file

File diff suppressed because it is too large Load diff

13
InForm/extensions/gifplaySample.bas → examples/GIFPlaySample/gifplaySample.bas
View file

@ -11,11 +11,9 @@ DIM SHARED LoadBT AS LONG
DIM SHARED PlayBT AS LONG
': External modules: ---------------------------------------------------------------
'$INCLUDE:'gifplay.bi'
'$INCLUDE:'..\InForm.bi'
'$INCLUDE:'..\xp.uitheme'
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'../../InForm/extensions/gifplay.bi'
'$INCLUDE:'gifplaySample.frm'
'$INCLUDE:'gifplay.bm'
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
@ -35,6 +33,8 @@ END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE gifplaySample
CASE LoadBT
'file 'globe.gif' comes from:
'https://en.wikipedia.org/wiki/GIF#/media/File:Rotating_earth_(large).gif
@ -94,5 +94,6 @@ END SUB
SUB __UI_FormResized
END SUB
'$INCLUDE:'..\InForm.ui'
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/extensions/gifplay.bm'

19
InForm/extensions/gifplaySample.frm → examples/GIFPlaySample/gifplaySample.frm
View file

@ -1,31 +1,37 @@
': This form was generated by
': InForm - GUI library for QB64 - Beta version 9
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': InForm - GUI library for QB64 - v1.5
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
DIM __UI_NewID AS LONG
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "gifplaySample", 300, 281, 0, 0, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "gifplay Sample"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).Font = SetFont("arial.ttf", 12)
Control(__UI_NewID).HasBorder = False
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox1", 230, 230, 36, 12, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Button, "LoadBT", 123, 23, 36, 247, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Load globe.gif"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "PlayBT", 80, 23, 186, 247, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Play"
Control(__UI_NewID).Stretch = False
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
END SUB
@ -36,4 +42,3 @@ SUB __UI_AssignIDs
LoadBT = __UI_GetID("LoadBT")
PlayBT = __UI_GetID("PlayBT")
END SUB

0
InForm/extensions/globe.gif → examples/GIFPlaySample/globe.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.4 MiB

After

Width:  |  Height:  |  Size: 1.4 MiB

BIN
examples/GravitationSimulation/DownArrow.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 1.3 KiB

3887
examples/GravitationSimulation/GravitationSimulation.bas Normal file
View file

File diff suppressed because it is too large Load diff

1451
examples/GravitationSimulation/GravitationSimulation.frm Normal file
View file

File diff suppressed because it is too large Load diff

BIN
examples/GravitationSimulation/Jupiter.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 127 KiB

BIN
examples/GravitationSimulation/Mars.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 122 KiB

BIN
examples/GravitationSimulation/Mercury.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 164 KiB

BIN
examples/GravitationSimulation/Neptune.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 114 KiB

BIN
examples/GravitationSimulation/Pluto.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 178 KiB

BIN
examples/GravitationSimulation/Saturn.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 33 KiB

BIN
examples/GravitationSimulation/The Earth.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 132 KiB

BIN
examples/GravitationSimulation/The Moon.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 113 KiB

BIN
examples/GravitationSimulation/The Sun.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 126 KiB

BIN
examples/GravitationSimulation/UpArrow.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
examples/GravitationSimulation/Uranus.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 38 KiB

BIN
examples/GravitationSimulation/Venus.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 132 KiB

382
examples/GravitationSimulation/democode.bas Normal file
View file

@ -0,0 +1,382 @@
SUB DemoRoutine
STATIC ByJupiter%%, DemoText$(), N%, T$
IF N% = 0 THEN
DIM DemoText$(27)
OPEN "demodat.dat" FOR INPUT AS #1
WHILE NOT EOF(1)
INPUT #1, DemoText$(N%)
N% = N% + 1
WEND
CLOSE #1
END IF
SELECT CASE NoCycles&
CASE 10000
T$ = DemoText$(0)
Caption(DemoLabel1LB) = T$
Breadth% = LEN(T$)
ByJupiter%% = 0
CALL ToDisp((Galaxy#(ByJupiter%%, 1)), (Galaxy#(ByJupiter%%, 2)), (Galaxy#(ByJupiter%%, 3)), U%, V%, C2%%)
Control(DemoLabel1LB).Width = 9.2 * Breadth%
Control(DemoLabel1LB).Left = U% - 4.6 * Breadth%
Control(DemoLabel1LB).Top = V% + 20
Control(DemoLabel1LB).Hidden = False
CASE 12000
PlanetAnim%% = ByJupiter%%
CASE 25000
Control(DemoLabel1LB).Hidden = True
CASE 30000
T$ = DemoText$(1)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel1LB).Top = 120
Control(DemoLabel1LB).Hidden = False
CASE 32000
ByJupiter%% = 1
PlanetAnim%% = ByJupiter%%
CASE 45000
ByJupiter%% = 2
CALL ToDisp((Galaxy#(ByJupiter%%, 1)), (Galaxy#(ByJupiter%%, 2)), (Galaxy#(ByJupiter%%, 3)), U%, V%, C2%%)
T$ = DemoText$(2)
Breadth% = LEN(T$)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * Breadth%
Control(DemoLabel2LB).Left = U% - 4.6 * Breadth%
Control(DemoLabel2LB).Top = V% + 20
Control(DemoLabel2LB).Hidden = False
CASE 47500
Control(DemoLabel1LB).Hidden = True
PlanetAnim%% = ByJupiter%%
CASE 60000
Control(DemoLabel2LB).Hidden = True
CASE 65000
T$ = DemoText$(3)
UpArrow%% = True
ArrowTop% = 68: ArrowLeft% = 970
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = ArrowLeft% - 9.2 * LEN(T$)
Control(DemoLabel1LB).Top = ArrowTop%
Control(DemoLabel1LB).Hidden = False
CASE 67500
CALL Zoomer((False))
Control(ZoomOutCB).Value = True
CASE 67700
Control(ZoomOutCB).Value = False
CASE 70000
CALL Zoomer((False))
Control(ZoomOutCB).Value = True
CASE 70200
Control(ZoomOutCB).Value = False
CASE 72500
CALL Zoomer((False))
Control(ZoomOutCB).Value = True
CASE 72700
Control(ZoomOutCB).Value = False
CASE 75000
Control(DemoLabel1LB).Hidden = True
EndArrow%% = True
CASE 77500
T$ = DemoText$(4)
Caption(DemoLabel1LB) = T$
ByJupiter%% = 3
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel1LB).Top = 100
Control(DemoLabel1LB).Hidden = False
CASE 82500
PlanetAnim%% = ByJupiter%%
CASE 97500
ByJupiter%% = 10
CALL ToDisp((Galaxy#(ByJupiter%%, 1)), (Galaxy#(ByJupiter%%, 2)), (Galaxy#(ByJupiter%%, 3)), U%, V%, C2%%)
T$ = DemoText$(5)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel2LB).Top = 140
Control(DemoLabel2LB).Hidden = False
PlanetAnim%% = ByJupiter%%
CASE 110000
ByJupiter%% = 3
CALL ToDisp((Galaxy#(ByJupiter%%, 1)), (Galaxy#(ByJupiter%%, 2)), (Galaxy#(ByJupiter%%, 3)), U%, V%, C2%%)
Control(DemoLabel2LB).Hidden = True
T$ = DemoText$(6)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (U% - 4.6 * LEN(T$))
Control(DemoLabel1LB).Top = V% + 20
CASE 117500
Control(DemoLabel1LB).Hidden = True
CASE 120000
ByJupiter%% = 4
CALL ToDisp((Galaxy#(ByJupiter%%, 1)), (Galaxy#(ByJupiter%%, 2)), (Galaxy#(ByJupiter%%, 3)), U%, V%, C2%%)
T$ = DemoText$(7)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (U% - 4.6 * LEN(T$))
Control(DemoLabel1LB).Top = V% + 20
Control(DemoLabel1LB).Hidden = False
CASE 122500
PlanetAnim%% = ByJupiter%%
CASE 130000
Control(DemoLabel1LB).Hidden = True
CASE 132500
T$ = DemoText$(8)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel1LB).Top = 100
Control(DemoLabel1LB).Hidden = False
T$ = DemoText$(9)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel2LB).Top = 140
Control(DemoLabel2LB).Hidden = False
CASE 140000
T$ = DemoText$(10)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel2LB).Top = 140
Control(DemoLabel2LB).Hidden = False
CASE 147500
Control(DemoLabel1LB).Hidden = True
Control(DemoLabel2LB).Hidden = True
CASE 152500
T$ = DemoText$(11)
Caption(DemoLabel1LB) = T$
UpArrow%% = True
ArrowTop% = 84: ArrowLeft% = 520
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = ArrowLeft% + 32
Control(DemoLabel1LB).Top = ArrowTop%
Control(DemoLabel1LB).Hidden = False
CASE 155000
Text(StepTimeMinTB) = "5": Text(StepTimeSecTB) = "0"
CALL SetStep
CASE 162500
Control(DemoLabel1LB).Hidden = True
EndArrow%% = True
CASE 175000
T$ = DemoText$(12)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel1LB).Top = 180
Control(DemoLabel1LB).Hidden = False
CASE 190000
UpArrow%% = True
ArrowTop% = 100: ArrowLeft% = 1200
T$ = DemoText$(13)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = ArrowLeft% - 9.2 * LEN(T$)
Control(DemoLabel2LB).Top = ArrowTop%
Control(DemoLabel2LB).Hidden = False
CASE 195000
ViewingAngle! = -0.25*_PI
Control(ViewingTrackBar).Value = ViewingAngle! * 180 / _PI
CASE 197500
EndArrow%% = True
Control(DemoLabel2LB).Hidden = True
CASE 200000
ViewingAngle! = -0.5*_PI
Control(ViewingTrackBar).Value = ViewingAngle! * 180 / _PI
UpArrow%% = True
ArrowTop% = 100: ArrowLeft% = 1150
Control(DemoLabel2LB).Left = ArrowLeft% - 9.2 * LEN(T$)
Control(DemoLabel2LB).Top = ArrowTop%
Control(DemoLabel2LB).Hidden = False
CASE 205000
Control(DemoLabel1LB).Hidden = True
Control(DemoLabel2LB).Hidden = True
EndArrow%% = True
CASE 207500
T$ = DemoText$(14)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel1LB).Top = 600
Control(DemoLabel1LB).Hidden = False
CASE 237500
Control(DemoLabel1LB).Hidden = True
CASE 250000
T$ = DemoText$(15)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel1LB).Top = 140
Control(DemoLabel1LB).Hidden = False
CASE 255000
ViewingAngle! = -.1570787
Control(ViewingTrackBar).Value = ViewingAngle! * 180 / _PI
CALL Zoomer((False))
Zoom! = 5.960449E+08
CASE 262500
ByJupiter%% = 5
CALL ToDisp((Galaxy#(ByJupiter%%, 1)), (Galaxy#(ByJupiter%%, 2)), (Galaxy#(ByJupiter%%, 3)), U%, V%, C2%%)
T$ = DemoText$(16)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (U% - 4.6 * LEN(T$))
Control(DemoLabel1LB).Top = V% + 20
CASE 265000
PlanetAnim%% = ByJupiter%%
CASE 275000
Control(DemoLabel1LB).Hidden = True
CASE 280000
T$ = DemoText$(17)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel1LB).Top = 140
Control(DemoLabel1LB).Hidden = False
Text(StepTimeMinTB) = "2": Text(StepTimeSecTB) = "0"
CALL SetStep
CASE 285000
DownArrow%% = True
ArrowTop% = 730: ArrowLeft% = 210
T$ = DemoText$(18)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = ArrowLeft% - 4.6 * LEN(T$) + 16
Control(DemoLabel2LB).Top = ArrowTop% - 32
Control(DemoLabel2LB).Hidden = False
CASE 290000
Trace%% = False
Caption(TraceBT) = "Trace"
CASE 297500
EndArrow%% = True
Control(DemoLabel1LB).Hidden = True
Control(DemoLabel2LB).Hidden = True
CASE 302500
DownArrow%% = True
ArrowTop% = 730: ArrowLeft% = 210
T$ = DemoText$(19)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = ArrowLeft% - 4.6 * LEN(T$) + 16
Control(DemoLabel2LB).Top = ArrowTop% - 32
Control(DemoLabel2LB).Hidden = False
CASE 305000
Trace%% = True
Caption(TraceBT) = "Spot"
CASE 310000
EndArrow%% = True
Control(DemoLabel2LB).Hidden = True
Text(StepTimeMinTB) = "5": Text(StepTimeSecTB) = "0"
CALL SetStep
CASE 330000
UpArrow%% = True
ArrowTop% = 84: ArrowLeft% = 620
T$ = DemoText$(20)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = ArrowLeft% + 32
Control(DemoLabel2LB).Top = ArrowTop%
Control(DemoLabel2LB).Hidden = False
CASE 332500
EFrameClick%% = True
Caption(EnergyLB) = "Bodies"
Text(EnergyTB) = MakeText$(NoBodiesLess1% + 1)
CASE 350000
EndArrow%% = True
Control(DemoLabel2LB).Hidden = True
CASE 360000
T$ = DemoText$(21)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel1LB).Top = 140
Control(DemoLabel1LB).Hidden = False
CASE 366596
ByJupiter%% = 11
PlanetAnim%% = ByJupiter%%
CASE 376596
'The Earth
Galaxy#(3, 3) = -36171689178.6047
Galaxy#(3, 1) = -147845249378.241
Galaxy#(3, 2) = -4877316.79803054
Galaxy#(3, 6) = 28470.366606139
Galaxy#(3, 4) = -7204.9068182243
Galaxy#(3, 5) = 1.0117834275
'The Moon
Galaxy#(10, 3) = -35958075763.303
Galaxy#(10, 1) = -147502805517.55
Galaxy#(10, 2) = -12243921.1369571
Galaxy#(10, 6) = 27655.4229032262
Galaxy#(10, 4) = -6672.4762717713
Galaxy#(10, 5) = -86.5562299173
Text(StepTimeMinTB) = "0": Text(StepTimeSecTB) = "1"
CALL SetStep
NoBodiesLess1% = 11
CASE 377500
T$ = DemoText$(22)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel2LB).Top = 140
Control(DemoLabel2LB).Hidden = False
T$ = DemoText$(23)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% - 9.2 * LEN(T$)) / 2
Control(DemoLabel1LB).Top = 180
Control(DemoLabel1LB).Hidden = False
CASE 390000
Text(StepTimeMinTB) = "0": Text(StepTimeSecTB) = "8"
CALL SetStep
CASE 397500
Text(StepTimeMinTB) = "0": Text(StepTimeSecTB) = "30"
CALL SetStep
Control(DemoLabel1LB).Hidden = True
Control(DemoLabel2LB).Hidden = True
CASE 405000
Text(StepTimeHrTB) = "0": Text(StepTimeMinTB) = "30": Text(StepTimeSecTB) = "0"
CALL SetStep
CASE 480000
DownArrow%% = True
ArrowTop% = 730: ArrowLeft% = 270
T$ = DemoText$(24)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = ArrowLeft% - 4.6 * LEN(T$) + 16
Control(DemoLabel2LB).Top = ArrowTop% - 32
Control(DemoLabel2LB).Hidden = False
CASE 485000
Wipe%% = True
CASE 488500
Control(DemoLabel2LB).Hidden = True
EndArrow%% = True
CASE 555000
ByJupiter%% = 5
CALL ToDisp((Galaxy#(ByJupiter%%, 1)), (Galaxy#(ByJupiter%%, 2)), (Galaxy#(ByJupiter%%, 3)), U%, V%, C2%%)
T$ = DemoText$(25)
Caption(DemoLabel2LB) = T$
Control(DemoLabel2LB).Width = 9.2 * LEN(T$)
Control(DemoLabel2LB).Left = (Uscreen% / 2) + 200
Control(DemoLabel2LB).Top = V% + 30
Control(DemoLabel2LB).Hidden = False
CASE 567500
Control(DemoLabel2LB).Hidden = True
CASE 575000
ByJupiter%% = 6
CALL ToDisp((Galaxy#(ByJupiter%%, 1)), (Galaxy#(ByJupiter%%, 2)), (Galaxy#(ByJupiter%%, 3)), U%, V%, C2%%)
T$ = DemoText$(26)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = U% - 4.6 * LEN(T$)
Control(DemoLabel1LB).Top = V% + 20
Control(DemoLabel1LB).Hidden = False
CASE 582500
Control(DemoLabel1LB).Hidden = True
CASE 612500
T$ = DemoText$(27)
Caption(DemoLabel1LB) = T$
Control(DemoLabel1LB).Width = 9.2 * LEN(T$)
Control(DemoLabel1LB).Left = (Uscreen% / 2) - 4.6 * LEN(T$)
Control(DemoLabel1LB).Top = (Vscreen% / 2) - 16
Control(DemoLabel1LB).Hidden = False
END SELECT
END SUB

28
examples/GravitationSimulation/demodat.dat Normal file
View file

@ -0,0 +1,28 @@
"Here is the Sun at the Centre of the Solar System"
" We are Zoomed into Mercury ... "
" ... And Venus "
" Now Let's Zoom Out "
" Now We See The Earth... "
" and The Moon "
" The Earth and Moon Circle Each Other Closely "
" And This Is Mars "
" The Size of the Objects On Screen "
" Is Not Dependent Upon Actual Body Size, But "
" Depends Upon How Far Away They Are "
" Now Speed Up The Display By Increasing The Step Time "
"It Looks As If Venus Moves Close to the Path of The Earth"
" But If We Change Orientation "
" We Can See The Orbits Quite Clearly "
" Now Let's Zoom Out Again and Change Orientation "
" Here's Jupiter "
" Display Can Be Switched From Tracks ... "
" To Spots "
" And Back to Tracks "
" Change from Energy to Bodies "
" Now The Earth Launches a Satellite "
" We Need to Temporarily Decrease Step Time "
" To Successfully Launch the Satellite "
" Clear The Display "
" Jupiter Swings The Satellite Out of Its Normal Orbit "
" Saturn "
" Thank You for Enduring This Demonstration "

BIN
examples/GravitationSimulation/newton.ico Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 44 KiB

BIN
examples/GravitationSimulation/pop.mp3 Normal file
View file

Binary file not shown.

BIN
examples/GravitationSimulation/satellite2.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 36 KiB

240
examples/InFormPaint/InFormPaint.bas Normal file
View file

@ -0,0 +1,240 @@
': This program was generated by
': InForm - GUI system for QB64 - Beta version 6
': Fellippe Heitor, 2016/2018 - fellippe@qb64.org - @fellippeheitor
'-----------------------------------------------------------
OPTION _EXPLICIT
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED InFormPaint AS LONG
DIM SHARED PictureBox1 AS LONG
DIM SHARED CircleBT AS LONG
DIM SHARED SquareBT AS LONG
DIM SHARED SquareFilledBT AS LONG
DIM SHARED CopyBT AS LONG
DIM SHARED Drawing AS _BYTE, Tool AS _UNSIGNED _BYTE
': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'InFormPaint.frm'
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
END SUB
SUB __UI_OnLoad
DIM prevDest AS LONG
prevDest = _DEST
Control(CircleBT).HelperCanvas = _NEWIMAGE(30, 30, 32)
_DEST Control(CircleBT).HelperCanvas
CIRCLE (_WIDTH / 2, _HEIGHT / 2), 12, _RGB32(0, 0, 0)
Text(CircleBT) = "."
Control(SquareBT).HelperCanvas = _NEWIMAGE(30, 30, 32)
_DEST Control(SquareBT).HelperCanvas
LINE (3, 3)-STEP(24, 24), _RGB32(0, 0, 0), B
Text(SquareBT) = "."
Control(SquareFilledBT).HelperCanvas = _NEWIMAGE(30, 30, 32)
_DEST Control(SquareFilledBT).HelperCanvas
LINE (3, 3)-STEP(24, 24), _RGB32(0, 0, 0), BF
Text(SquareFilledBT) = "."
Control(CopyBT).HelperCanvas = _NEWIMAGE(30, 30, 32)
_DEST Control(CopyBT).HelperCanvas
LINE (3, 3)-STEP(15, 15), _RGB32(0, 0, 0), B
LINE (7, 7)-STEP(15, 15), _RGB32(0, 0, 0), B
Text(CopyBT) = "."
_DEST prevDest
BeginDraw PictureBox1
CLS , _RGB32(255, 255, 255)
EndDraw PictureBox1
END SUB
SUB __UI_BeforeUpdateDisplay
STATIC TempImage AS LONG
DIM prevDest AS LONG
IF TempImage = 0 THEN
TempImage = _COPYIMAGE(Control(PictureBox1).HelperCanvas)
END IF
prevDest = _DEST
IF Drawing THEN
_DEST TempImage
SELECT CASE Tool
CASE 1
CIRCLE (__UI_MouseLeft - Control(PictureBox1).Left, __UI_MouseTop - Control(PictureBox1).Top), 30, _RGB32(0, 0, 0)
CASE 2
LINE (__UI_MouseLeft - Control(PictureBox1).Left - 10, __UI_MouseTop - Control(PictureBox1).Top - 10)-STEP(20, 20), _RGB32(0, 0, 0), B
CASE 3
LINE (__UI_MouseLeft - Control(PictureBox1).Left - 10, __UI_MouseTop - Control(PictureBox1).Top - 10)-STEP(20, 20), _RGB32(0, 0, 0), BF
END SELECT
_DEST prevDest
END IF
BeginDraw PictureBox1
_PUTIMAGE (0, 0), TempImage
IF NOT Drawing THEN
SELECT CASE Tool
CASE 1
CIRCLE (__UI_MouseLeft - Control(PictureBox1).Left, __UI_MouseTop - Control(PictureBox1).Top), 30, _RGB32(0, 0, 0)
CASE 2
LINE (__UI_MouseLeft - Control(PictureBox1).Left - 10, __UI_MouseTop - Control(PictureBox1).Top - 10)-STEP(20, 20), _RGB32(0, 0, 0), B
CASE 3
LINE (__UI_MouseLeft - Control(PictureBox1).Left - 10, __UI_MouseTop - Control(PictureBox1).Top - 10)-STEP(20, 20), _RGB32(0, 0, 0), BF
END SELECT
END IF
EndDraw PictureBox1
END SUB
SUB __UI_BeforeUnload
END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE InFormPaint
CASE PictureBox1
CASE CircleBT
Tool = 1
CASE SquareBT
Tool = 2
CASE SquareFilledBT
Tool = 3
CASE CopyBT
_CLIPBOARDIMAGE = Control(PictureBox1).HelperCanvas
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
SELECT CASE id
CASE InFormPaint
CASE PictureBox1
CASE CircleBT
CASE SquareBT
CASE SquareFilledBT
CASE CopyBT
END SELECT
END SUB
SUB __UI_MouseLeave (id AS LONG)
SELECT CASE id
CASE InFormPaint
CASE PictureBox1
CASE CircleBT
CASE SquareBT
CASE SquareFilledBT
CASE CopyBT
END SELECT
END SUB
SUB __UI_FocusIn (id AS LONG)
SELECT CASE id
CASE CircleBT
CASE SquareBT
CASE SquareFilledBT
CASE CopyBT
END SELECT
END SUB
SUB __UI_FocusOut (id AS LONG)
SELECT CASE id
CASE CircleBT
CASE SquareBT
CASE SquareFilledBT
CASE CopyBT
END SELECT
END SUB
SUB __UI_MouseDown (id AS LONG)
SELECT CASE id
CASE InFormPaint
CASE PictureBox1
Drawing = True
CASE CircleBT
CASE SquareBT
CASE SquareFilledBT
CASE CopyBT
END SELECT
END SUB
SUB __UI_MouseUp (id AS LONG)
Drawing = False
SELECT CASE id
CASE InFormPaint
CASE PictureBox1
CASE CircleBT
CASE SquareBT
CASE SquareFilledBT
CASE CopyBT
END SELECT
END SUB
SUB __UI_KeyPress (id AS LONG)
SELECT CASE id
CASE CircleBT
CASE SquareBT
CASE SquareFilledBT
CASE CopyBT
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/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

56
examples/InFormPaint/InFormPaint.frm Normal file
View file

@ -0,0 +1,56 @@
': This form was generated by
': InForm - GUI library for QB64 - v1.5
': Fellippe Heitor, 2016-2023 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
$RESIZE:ON
DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
__UI_NewID = __UI_NewControl(__UI_Type_Form, "InFormPaint", 721, 300, 0, 0, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "InFormPaint"
Control(__UI_NewID).Font = SetFont("arial.ttf", 12)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanResize = True
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "PictureBox1", 635, 301, 86, 0, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CircleBT", 32, 32, 8, 8, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "SquareBT", 32, 32, 47, 8, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "SquareFilledBT", 32, 32, 8, 46, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CopyBT", 32, 32, 8, 188, 0)
__UI_RegisterResult = 0
ToolTip(__UI_NewID) = "Copy image to clipboard"
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
END SUB
SUB __UI_AssignIDs
InFormPaint = __UI_GetID("InFormPaint")
PictureBox1 = __UI_GetID("PictureBox1")
CircleBT = __UI_GetID("CircleBT")
SquareBT = __UI_GetID("SquareBT")
SquareFilledBT = __UI_GetID("SquareFilledBT")
CopyBT = __UI_GetID("CopyBT")
END SUB

344
examples/InFormTicTacToe/InForm/InForm.bi
View file

@ -1,344 +0,0 @@
'InForm - GUI library for QB64
'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
'
$If VERSION < 3.8 Then
$Error This requires the latest version of QB64-PE from https://github.com/QB64-Phoenix-Edition/QB64pe/releases
$End If
DECLARE LIBRARY
FUNCTION __UI_GetPID ALIAS getpid ()
END DECLARE
DECLARE CUSTOMTYPE LIBRARY
SUB __UI_MemCopy ALIAS memcpy (BYVAL dest AS _OFFSET, BYVAL source AS _OFFSET, BYVAL bytes AS LONG)
END DECLARE
$IF WIN THEN
DECLARE LIBRARY
FUNCTION GetSystemMetrics& (BYVAL WhichMetric&)
END DECLARE
CONST __UI_SM_SWAPBUTTON = 23
$END IF
$SCREENHIDE
_CONTROLCHR OFF
TYPE __UI_ControlTYPE
ID AS LONG
ParentID AS LONG
PreviousParentID AS LONG
ContextMenuID AS LONG
Type AS INTEGER
Name AS STRING * 40
ParentName AS STRING * 40
SubMenu AS _BYTE
MenuPanelID AS LONG
SourceControl AS LONG
Top AS INTEGER
Left AS INTEGER
Width AS INTEGER
Height AS INTEGER
Canvas AS LONG
HelperCanvas AS LONG
TransparentColor AS _UNSIGNED LONG
Stretch AS _BYTE
PreviousStretch AS _BYTE
Font AS INTEGER
PreviousFont AS INTEGER
BackColor AS _UNSIGNED LONG
ForeColor AS _UNSIGNED LONG
SelectedForeColor AS _UNSIGNED LONG
SelectedBackColor AS _UNSIGNED LONG
BackStyle AS _BYTE
HasBorder AS _BYTE
BorderSize AS INTEGER
Padding AS INTEGER
Encoding AS LONG
Align AS _BYTE
PrevAlign AS _BYTE
VAlign AS _BYTE
PrevVAlign AS _BYTE
BorderColor AS _UNSIGNED LONG
Value AS _FLOAT
PreviousValue AS _FLOAT
Min AS _FLOAT
PrevMin AS _FLOAT
Max AS _FLOAT
PrevMax AS _FLOAT
Interval AS _FLOAT
PrevInterval AS _FLOAT
MinInterval AS _FLOAT
PrevMinInterval AS _FLOAT
HotKey AS INTEGER
HotKeyOffset AS INTEGER
HotKeyPosition AS INTEGER
ShowPercentage AS _BYTE
AutoScroll AS _BYTE
AutoSize AS _BYTE
InputViewStart AS LONG
PreviousInputViewStart AS LONG
LastVisibleItem AS INTEGER
ItemHeight AS INTEGER
HasVScrollbar AS _BYTE
VScrollbarButton2Top AS INTEGER
HoveringVScrollbarButton AS _BYTE
ThumbHeight AS INTEGER
ThumbTop AS INTEGER
VScrollbarRatio AS SINGLE
Cursor AS LONG
PasswordField AS _BYTE
PrevCursor AS LONG
FieldArea AS LONG
PreviousFieldArea AS LONG
TextIsSelected AS _BYTE
BypassSelectOnFocus AS _BYTE
Multiline AS _BYTE
NumericOnly AS _BYTE
FirstVisibleLine AS LONG
PrevFirstVisibleLine AS LONG
CurrentLine AS LONG
PrevCurrentLine AS LONG
VisibleCursor AS LONG
PrevVisibleCursor AS LONG
ControlIsSelected AS _BYTE
LeftOffsetFromFirstSelected AS INTEGER
TopOffsetFromFirstSelected AS INTEGER
SelectionLength AS LONG
SelectionStart AS LONG
WordWrap AS _BYTE
CanResize AS _BYTE
CanHaveFocus AS _BYTE
Disabled AS _BYTE
Hidden AS _BYTE
PreviouslyHidden AS _BYTE
CenteredWindow AS _BYTE
ControlState AS _BYTE
ChildrenRedrawn AS _BYTE
FocusState AS LONG
LastChange AS SINGLE
Redraw AS _BYTE
BulletStyle AS _BYTE
MenuItemGroup AS INTEGER
KeyCombo AS LONG
BoundTo AS LONG
BoundProperty AS LONG
END TYPE
TYPE __UI_Types
Name AS STRING * 16
Count AS LONG
TurnsInto AS INTEGER
DefaultHeight AS INTEGER
MinimumHeight AS INTEGER
DefaultWidth AS INTEGER
MinimumWidth AS INTEGER
RestrictResize AS _BYTE
END TYPE
TYPE __UI_ThemeImagesType
FileName AS STRING * 32
Handle AS LONG
END TYPE
TYPE __UI_WordWrapHistoryType
StringSlot AS LONG
Width AS INTEGER
LongestLine AS INTEGER
Font AS LONG
TotalLines AS INTEGER
END TYPE
TYPE __UI_KeyCombos
Combo AS STRING * 14 ' "CTRL+SHIFT+F12"
FriendlyCombo AS STRING * 14 ' "Ctrl+Shift+F12"
ControlID AS LONG
END TYPE
REDIM SHARED Caption(0 TO 100) AS STRING
REDIM SHARED __UI_TempCaptions(0 TO 100) AS STRING
REDIM SHARED Text(0 TO 100) AS STRING
REDIM SHARED __UI_TempTexts(0 TO 100) AS STRING
REDIM SHARED Mask(0 TO 100) AS STRING
REDIM SHARED __UI_TempMask(0 TO 100) AS STRING
REDIM SHARED ToolTip(0 TO 100) AS STRING
REDIM SHARED __UI_TempTips(0 TO 100) AS STRING
REDIM SHARED Control(0 TO 100) AS __UI_ControlTYPE
REDIM SHARED ControlDrawOrder(0) AS LONG
REDIM SHARED __UI_ThemeImages(0 TO 100) AS __UI_ThemeImagesType
REDIM SHARED __UI_WordWrapHistoryTexts(0 TO 100) AS STRING
REDIM SHARED __UI_WordWrapHistoryResults(0 TO 100) AS STRING
REDIM SHARED __UI_WordWrapHistory(0 TO 100) AS __UI_WordWrapHistoryType
REDIM SHARED __UI_ThisLineChars(0) AS LONG, __UI_FocusedTextBoxChars(0) AS LONG
REDIM SHARED __UI_ActiveMenu(0 TO 100) AS LONG, __UI_ParentMenu(0 TO 100) AS LONG
REDIM SHARED __UI_KeyCombo(0 TO 100) AS __UI_KeyCombos
DIM SHARED __UI_TotalKeyCombos AS LONG, __UI_BypassKeyCombos AS _BYTE
DIM SHARED table1252$(0 TO 255), table437$(0 TO 255)
DIM SHARED __UI_MouseLeft AS INTEGER, __UI_MouseTop AS INTEGER
DIM SHARED __UI_MouseWheel AS INTEGER, __UI_MouseButtonsSwap AS _BYTE
DIM SHARED __UI_PrevMouseLeft AS INTEGER, __UI_PrevMouseTop AS INTEGER
DIM SHARED __UI_MouseButton1 AS _BYTE, __UI_MouseButton2 AS _BYTE
DIM SHARED __UI_MouseIsDown AS _BYTE, __UI_MouseDownOnID AS LONG
DIM SHARED __UI_Mouse2IsDown AS _BYTE, __UI_Mouse2DownOnID AS LONG
DIM SHARED __UI_PreviousMouseDownOnID AS LONG
DIM SHARED __UI_KeyIsDown AS _BYTE, __UI_KeyDownOnID AS LONG
DIM SHARED __UI_ShiftIsDown AS _BYTE, __UI_CtrlIsDown AS _BYTE
DIM SHARED __UI_AltIsDown AS _BYTE, __UI_ShowHotKeys AS _BYTE, __UI_AltCombo$
DIM SHARED __UI_LastMouseClick AS SINGLE, __UI_MouseDownOnScrollbar AS SINGLE
DIM SHARED __UI_DragX AS INTEGER, __UI_DragY AS INTEGER
DIM SHARED __UI_DefaultButtonID AS LONG
DIM SHARED __UI_KeyHit AS LONG, __UI_KeepFocus AS _BYTE
DIM SHARED __UI_Focus AS LONG, __UI_PreviousFocus AS LONG, __UI_KeyboardFocus AS _BYTE
DIM SHARED __UI_HoveringID AS LONG, __UI_LastHoveringID AS LONG, __UI_BelowHoveringID AS LONG
DIM SHARED __UI_IsDragging AS _BYTE, __UI_DraggingID AS LONG
DIM SHARED __UI_IsResizing AS _BYTE, __UI_ResizingID AS LONG
DIM SHARED __UI_ResizeHandleHover AS _BYTE
DIM SHARED __UI_IsSelectingText AS _BYTE, __UI_IsSelectingTextOnID AS LONG
DIM SHARED __UI_SelectedText AS STRING, __UI_SelectionLength AS LONG
DIM SHARED __UI_StateHasChanged AS _BYTE
DIM SHARED __UI_DraggingThumb AS _BYTE, __UI_ThumbDragTop AS INTEGER
DIM SHARED __UI_DraggingThumbOnID AS LONG
DIM SHARED __UI_HasInput AS _BYTE, __UI_ProcessInputTimer AS SINGLE
DIM SHARED __UI_UnloadSignal AS _BYTE, __UI_HasResized AS _BYTE
DIM SHARED __UI_ExitTriggered AS _BYTE
DIM SHARED __UI_Loaded AS _BYTE
DIM SHARED __UI_EventsTimer AS INTEGER, __UI_RefreshTimer AS INTEGER
DIM SHARED __UI_ActiveDropdownList AS LONG, __UI_ParentDropdownList AS LONG
DIM SHARED __UI_TotalActiveMenus AS LONG, __UI_ActiveMenuIsContextMenu AS _BYTE
DIM SHARED __UI_SubMenuDelay AS SINGLE, __UI_HoveringSubMenu AS _BYTE
DIM SHARED __UI_TopMenuBarItem AS LONG
DIM SHARED __UI_ActiveTipID AS LONG, __UI_TipTimer AS SINGLE, __UI_PreviousTipID AS LONG
DIM SHARED __UI_ActiveTipTop AS INTEGER, __UI_ActiveTipLeft AS INTEGER
DIM SHARED __UI_FormID AS LONG, __UI_HasMenuBar AS LONG
DIM SHARED __UI_ScrollbarWidth AS INTEGER, __UI_ScrollbarButtonHeight AS INTEGER
DIM SHARED __UI_MenuBarOffset AS INTEGER, __UI_MenuItemOffset AS INTEGER
DIM SHARED __UI_NewMenuBarTextLeft AS INTEGER, __UI_DefaultCaptionIndent AS INTEGER
DIM SHARED __UI_ForceRedraw AS _BYTE, __UI_AutoRefresh AS _BYTE
DIM SHARED __UI_CurrentTitle AS STRING
DIM SHARED __UI_DesignMode AS _BYTE, __UI_FirstSelectedID AS LONG
DIM SHARED __UI_WaitMessage AS STRING, __UI_TotalSelectedControls AS LONG
DIM SHARED __UI_WaitMessageHandle AS LONG, __UI_EditorMode AS _BYTE
DIM SHARED __UI_LastRenderedCharCount AS LONG
DIM SHARED __UI_SelectionRectangleTop AS INTEGER, __UI_SelectionRectangleLeft AS INTEGER
DIM SHARED __UI_SelectionRectangle AS _BYTE
DIM SHARED __UI_CantShowContextMenu AS _BYTE, __UI_ShowPositionAndSize AS _BYTE
DIM SHARED __UI_ShowInvisibleControls AS _BYTE, __UI_Snapped AS _BYTE
DIM SHARED __UI_SnappedByProximityX AS _BYTE, __UI_SnappedByProximityY AS _BYTE
DIM SHARED __UI_SnappedX AS INTEGER, __UI_SnappedY AS INTEGER
DIM SHARED __UI_SnappedXID AS LONG, __UI_SnappedYID AS LONG
DIM SHARED __UI_SnapLines AS _BYTE, __UI_SnapDistance AS INTEGER, __UI_SnapDistanceFromForm AS INTEGER
DIM SHARED __UI_FrameRate AS SINGLE, __UI_Font8Offset AS INTEGER, __UI_Font16Offset AS INTEGER
DIM SHARED __UI_ClipboardCheck$, __UI_MenuBarOffsetV AS INTEGER
DIM SHARED __UI_KeepScreenHidden AS _BYTE, __UI_MaxBorderSize AS INTEGER
DIM SHARED __UI_InternalContextMenus AS LONG, __UI_DidClick AS _BYTE
DIM SHARED __UI_ContextMenuSourceID AS LONG
DIM SHARED __UI_FKey(1 TO 12) AS LONG
'Control types: -----------------------------------------------
DIM SHARED __UI_Type(0 TO 18) AS __UI_Types
__UI_Type(__UI_Type_Form).Name = "Form"
__UI_Type(__UI_Type_Frame).Name = "Frame"
__UI_Type(__UI_Type_Frame).DefaultWidth = 230
__UI_Type(__UI_Type_Frame).DefaultHeight = 150
__UI_Type(__UI_Type_Button).Name = "Button"
__UI_Type(__UI_Type_Button).DefaultWidth = 80
__UI_Type(__UI_Type_Button).DefaultHeight = 23
__UI_Type(__UI_Type_Label).Name = "Label"
__UI_Type(__UI_Type_Label).DefaultWidth = 150
__UI_Type(__UI_Type_Label).DefaultHeight = 23
__UI_Type(__UI_Type_CheckBox).Name = "CheckBox"
__UI_Type(__UI_Type_CheckBox).DefaultWidth = 150
__UI_Type(__UI_Type_CheckBox).DefaultHeight = 23
__UI_Type(__UI_Type_CheckBox).TurnsInto = __UI_Type_ToggleSwitch
__UI_Type(__UI_Type_RadioButton).Name = "RadioButton"
__UI_Type(__UI_Type_RadioButton).DefaultWidth = 150
__UI_Type(__UI_Type_RadioButton).DefaultHeight = 23
__UI_Type(__UI_Type_TextBox).Name = "TextBox"
__UI_Type(__UI_Type_TextBox).DefaultWidth = 120
__UI_Type(__UI_Type_TextBox).DefaultHeight = 23
__UI_Type(__UI_Type_ProgressBar).Name = "ProgressBar"
__UI_Type(__UI_Type_ProgressBar).DefaultWidth = 300
__UI_Type(__UI_Type_ProgressBar).DefaultHeight = 23
__UI_Type(__UI_Type_ListBox).Name = "ListBox"
__UI_Type(__UI_Type_ListBox).DefaultWidth = 200
__UI_Type(__UI_Type_ListBox).DefaultHeight = 200
__UI_Type(__UI_Type_ListBox).TurnsInto = __UI_Type_DropdownList
__UI_Type(__UI_Type_DropdownList).Name = "DropdownList"
__UI_Type(__UI_Type_DropdownList).DefaultWidth = 200
__UI_Type(__UI_Type_DropdownList).DefaultHeight = 23
__UI_Type(__UI_Type_DropdownList).TurnsInto = __UI_Type_ListBox
__UI_Type(__UI_Type_MenuBar).Name = "MenuBar"
__UI_Type(__UI_Type_MenuBar).TurnsInto = __UI_Type_ContextMenu
__UI_Type(__UI_Type_MenuBar).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_MenuItem).Name = "MenuItem"
__UI_Type(__UI_Type_MenuItem).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_MenuPanel).Name = "MenuPanel"
__UI_Type(__UI_Type_PictureBox).Name = "PictureBox"
__UI_Type(__UI_Type_PictureBox).DefaultWidth = 230
__UI_Type(__UI_Type_PictureBox).DefaultHeight = 150
__UI_Type(__UI_Type_TrackBar).Name = "TrackBar"
__UI_Type(__UI_Type_TrackBar).DefaultWidth = 300
__UI_Type(__UI_Type_TrackBar).DefaultHeight = 40
__UI_Type(__UI_Type_TrackBar).MinimumHeight = 30
__UI_Type(__UI_Type_TrackBar).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_ContextMenu).Name = "ContextMenu"
__UI_Type(__UI_Type_ContextMenu).TurnsInto = __UI_Type_MenuBar
__UI_Type(__UI_Type_ContextMenu).RestrictResize = __UI_CantResize
__UI_Type(__UI_Type_ContextMenu).DefaultWidth = 22
__UI_Type(__UI_Type_ContextMenu).DefaultHeight = 22
__UI_Type(__UI_Type_Font).Name = "Font"
__UI_Type(__UI_Type_ToggleSwitch).Name = "ToggleSwitch"
__UI_Type(__UI_Type_ToggleSwitch).DefaultWidth = 40
__UI_Type(__UI_Type_ToggleSwitch).DefaultHeight = 17
__UI_Type(__UI_Type_ToggleSwitch).TurnsInto = __UI_Type_CheckBox
__UI_Type(__UI_Type_ToggleSwitch).RestrictResize = __UI_CantResize
'--------------------------------------------------------------
__UI_RestoreFKeys
CONST False = 0, True = Not False
'$INCLUDE:'InFormVersion.bas'
__UI_SubMenuDelay = .4
__UI_SnapDistance = 5
__UI_SnapDistanceFromForm = 10
__UI_MaxBorderSize = 10
__UI_Font8Offset = 5
__UI_Font16Offset = 3
__UI_ClipboardCheck$ = "InForm" + STRING$(2, 10) + "BEGIN CONTROL DATA" + CHR$(10) + STRING$(60, 45) + CHR$(10)
__UI_ThemeSetup
__UI_InternalMenus
__UI_LoadForm
__UI_Init
'Main loop
DO
_LIMIT 1
LOOP
SYSTEM
__UI_ErrorHandler:
RESUME NEXT

8697
examples/InFormTicTacToe/InForm/InForm.ui
View file

File diff suppressed because it is too large Load diff

7
examples/InFormTicTacToe/InForm/InFormVersion.bas
View file

@ -1,7 +0,0 @@
'Starting with v1.0, __UI_VersionNumber is actually the current build.
CONST __UI_Version = "v1.5"
CONST __UI_VersionNumber = 1
CONST __UI_VersionIsBeta = 1
CONST __UI_CopyrightSpan = "2016-2023"

1144
examples/InFormTicTacToe/InForm/xp.uitheme
View file

File diff suppressed because it is too large Load diff

270
examples/InFormTicTacToe/TicTacToe.bas
View file

@ -1,270 +0,0 @@
': This program uses
': InForm - GUI library for QB64 - v1.0
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
Option _Explicit
Dim Shared ThisTurn As _Byte
': Controls' IDs: ------------------------------------------------------------------
Dim Shared TicTacToe As Long
Dim Shared Button1 As Long
Dim Shared Button2 As Long
Dim Shared Button3 As Long
Dim Shared Button4 As Long
Dim Shared BUtton5 As Long
Dim Shared Button6 As Long
Dim Shared Button7 As Long
Dim Shared Button8 As Long
Dim Shared Button9 As Long
': External modules: ---------------------------------------------------------------
'$INCLUDE:'InForm\InForm.bi'
'$INCLUDE:'TicTacToe.frm'
': Custom functions: ---------------------------------------------------------------
Sub MessageBox (message As String, caption As String, icon As String)
_Delay 0.2 ' delay a bit to allow InFrom to draw and refresh all comtrols before the modal dialog box takes over
_MessageBox caption, message, icon
End Sub
': Event procedures: ---------------------------------------------------------------
Sub __UI_BeforeInit
End Sub
Sub __UI_OnLoad
ThisTurn = 1
End Sub
Sub __UI_BeforeUpdateDisplay
End Sub
Sub __UI_BeforeUnload
End Sub
Sub __UI_Click (id As Long)
If Control(id).Type = __UI_Type_Button Then
If Control(id).Value = 0 Then
Control(id).Value = ThisTurn
If ThisTurn = 1 Then Caption(id) = "X": ThisTurn = 2 Else Caption(id) = "O": ThisTurn = 1
CheckVictory
End If
End If
End Sub
Sub CheckVictory
Dim Winner As _Byte
If Control(Button1).Value = Control(Button2).Value And Control(Button2).Value = Control(Button3).Value Then
Winner = Control(Button1).Value
ElseIf Control(Button4).Value = Control(BUtton5).Value And Control(BUtton5).Value = Control(Button6).Value Then
Winner = Control(Button4).Value
ElseIf Control(Button7).Value = Control(Button8).Value And Control(Button8).Value = Control(Button9).Value Then
Winner = Control(Button7).Value
ElseIf Control(Button1).Value = Control(Button4).Value And Control(Button4).Value = Control(Button7).Value Then
Winner = Control(Button1).Value
ElseIf Control(Button2).Value = Control(BUtton5).Value And Control(BUtton5).Value = Control(Button8).Value Then
Winner = Control(Button2).Value
ElseIf Control(Button3).Value = Control(Button6).Value And Control(Button6).Value = Control(Button9).Value Then
Winner = Control(Button3).Value
ElseIf Control(Button1).Value = Control(BUtton5).Value And Control(BUtton5).Value = Control(Button9).Value Then
Winner = Control(Button1).Value
ElseIf Control(Button7).Value = Control(BUtton5).Value And Control(BUtton5).Value = Control(Button3).Value Then
Winner = Control(Button7).Value
End If
If Winner > 0 Then
MessageBox "Player" + Str$(Winner) + " won!", "Tic Tac Toe", "info"
System
End If
End Sub
Sub __UI_MouseEnter (id As Long)
Select Case id
Case TicTacToe
Case Button1
Case Button2
Case Button3
Case Button4
Case BUtton5
Case Button6
Case Button7
Case Button8
Case Button9
End Select
End Sub
Sub __UI_MouseLeave (id As Long)
Select Case id
Case TicTacToe
Case Button1
Case Button2
Case Button3
Case Button4
Case BUtton5
Case Button6
Case Button7
Case Button8
Case Button9
End Select
End Sub
Sub __UI_FocusIn (id As Long)
Select Case id
Case Button1
Case Button2
Case Button3
Case Button4
Case BUtton5
Case Button6
Case Button7
Case Button8
Case Button9
End Select
End Sub
Sub __UI_FocusOut (id As Long)
Select Case id
Case Button1
Case Button2
Case Button3
Case Button4
Case BUtton5
Case Button6
Case Button7
Case Button8
Case Button9
End Select
End Sub
Sub __UI_MouseDown (id As Long)
Select Case id
Case TicTacToe
Case Button1
Case Button2
Case Button3
Case Button4
Case BUtton5
Case Button6
Case Button7
Case Button8
Case Button9
End Select
End Sub
Sub __UI_MouseUp (id As Long)
Select Case id
Case TicTacToe
Case Button1
Case Button2
Case Button3
Case Button4
Case BUtton5
Case Button6
Case Button7
Case Button8
Case Button9
End Select
End Sub
Sub __UI_KeyPress (id As Long)
Select Case id
Case Button1
Case Button2
Case Button3
Case Button4
Case BUtton5
Case Button6
Case Button7
Case Button8
Case Button9
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\InForm.ui'
'$INCLUDE:'InForm\xp.uitheme'

344
examples/InFormTicTacToe2/InForm/InForm.bi
View file

@ -1,344 +0,0 @@
'InForm - GUI library for QB64
'Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
'
$If VERSION < 3.8 Then
$Error This requires the latest version of QB64-PE from https://github.com/QB64-Phoenix-Edition/QB64pe/releases
$End If
DECLARE LIBRARY
FUNCTION __UI_GetPID ALIAS getpid ()
END DECLARE
DECLARE CUSTOMTYPE LIBRARY
SUB __UI_MemCopy ALIAS memcpy (BYVAL dest AS _OFFSET, BYVAL source AS _OFFSET, BYVAL bytes AS LONG)
END DECLARE
$IF WIN THEN
DECLARE LIBRARY
FUNCTION GetSystemMetrics& (BYVAL WhichMetric&)
END DECLARE
CONST __UI_SM_SWAPBUTTON = 23
$END IF
$SCREENHIDE
_CONTROLCHR OFF
TYPE __UI_ControlTYPE
ID AS LONG
ParentID AS LONG
PreviousParentID AS LONG
ContextMenuID AS LONG
Type AS INTEGER
Name AS STRING * 40
ParentName AS STRING * 40
SubMenu AS _BYTE
MenuPanelID AS LONG
SourceControl AS LONG
Top AS INTEGER
Left AS INTEGER
Width AS INTEGER
Height AS INTEGER
Canvas AS LONG
HelperCanvas AS LONG
TransparentColor AS _UNSIGNED LONG
Stretch AS _BYTE
PreviousStretch AS _BYTE
Font AS INTEGER
PreviousFont AS INTEGER
BackColor AS _UNSIGNED LONG
ForeColor AS _UNSIGNED LONG
SelectedForeColor AS _UNSIGNED LONG
SelectedBackColor AS _UNSIGNED LONG
BackStyle AS _BYTE
HasBorder AS _BYTE
BorderSize AS INTEGER
Padding AS INTEGER
Encoding AS LONG
Align AS _BYTE
PrevAlign AS _BYTE
VAlign AS _BYTE
PrevVAlign AS _BYTE
BorderColor AS _UNSIGNED LONG
Value AS _FLOAT
PreviousValue AS _FLOAT
Min AS _FLOAT
PrevMin AS _FLOAT
Max AS _FLOAT
PrevMax AS _FLOAT
Interval AS _FLOAT
PrevInterval AS _FLOAT
MinInterval AS _FLOAT
PrevMinInterval AS _FLOAT
HotKey AS INTEGER
HotKeyOffset AS INTEGER
HotKeyPosition AS INTEGER
ShowPercentage AS _BYTE
AutoScroll AS _BYTE
AutoSize AS _BYTE
InputViewStart AS LONG
PreviousInputViewStart AS LONG
LastVisibleItem AS INTEGER
ItemHeight AS INTEGER
HasVScrollbar AS _BYTE
VScrollbarButton2Top AS INTEGER
HoveringVScrollbarButton AS _BYTE
ThumbHeight AS INTEGER
ThumbTop AS INTEGER
VScrollbarRatio AS SINGLE
Cursor AS LONG
PasswordField AS _BYTE
PrevCursor AS LONG
FieldArea AS LONG
PreviousFieldArea AS LONG
TextIsSelected AS _BYTE
BypassSelectOnFocus AS _BYTE
Multiline AS _BYTE
NumericOnly AS _BYTE
FirstVisibleLine AS LONG
PrevFirstVisibleLine AS LONG
CurrentLine AS LONG
PrevCurrentLine AS LONG
VisibleCursor AS LONG
PrevVisibleCursor AS LONG
ControlIsSelected AS _BYTE
LeftOffsetFromFirstSelected AS INTEGER
TopOffsetFromFirstSelected AS INTEGER
SelectionLength AS LONG
SelectionStart AS LONG
WordWrap AS _BYTE
CanResize AS _BYTE
CanHaveFocus AS _BYTE
Disabled AS _BYTE
Hidden AS _BYTE
PreviouslyHidden AS _BYTE
CenteredWindow AS _BYTE
ControlState AS _BYTE
ChildrenRedrawn AS _BYTE
FocusState AS LONG
LastChange AS SINGLE
Redraw AS _BYTE
BulletStyle AS _BYTE
MenuItemGroup AS INTEGER
KeyCombo AS LONG
BoundTo AS LONG
BoundProperty AS LONG
END TYPE
TYPE __UI_Types
Name AS STRING * 16
Count AS LONG
TurnsInto AS INTEGER
DefaultHeight AS INTEGER
MinimumHeight AS INTEGER
DefaultWidth AS INTEGER
MinimumWidth AS INTEGER
RestrictResize AS _BYTE
END TYPE
TYPE __UI_ThemeImagesType
FileName AS STRING * 32
Handle AS LONG
END TYPE
TYPE __UI_WordWrapHistoryType
StringSlot AS LONG
Width AS INTEGER
LongestLine AS INTEGER
Font AS LONG
TotalLines AS INTEGER
END TYPE
TYPE __UI_KeyCombos
Combo AS STRING * 14 ' "CTRL+SHIFT+F12"
FriendlyCombo AS STRING * 14 ' "Ctrl+Shift+F12"
ControlID AS LONG
END TYPE
REDIM SHARED Caption(0 TO 100) AS STRING
REDIM SHARED __UI_TempCaptions(0 TO 100) AS STRING
REDIM SHARED Text(0 TO 100) AS STRING
REDIM SHARED __UI_TempTexts(0 TO 100) AS STRING
REDIM SHARED Mask(0 TO 100) AS STRING
REDIM SHARED __UI_TempMask(0 TO 100) AS STRING
REDIM SHARED ToolTip(0 TO 100) AS STRING
REDIM SHARED __UI_TempTips(0 TO 100) AS STRING
REDIM SHARED Control(0 TO 100) AS __UI_ControlTYPE
REDIM SHARED ControlDrawOrder(0) AS LONG
REDIM SHARED __UI_ThemeImages(0 TO 100) AS __UI_ThemeImagesType
REDIM SHARED __UI_WordWrapHistoryTexts(0 TO 100) AS STRING
REDIM SHARED __UI_WordWrapHistoryResults(0 TO 100) AS STRING
REDIM SHARED __UI_WordWrapHistory(0 TO 100) AS __UI_WordWrapHistoryType
REDIM SHARED __UI_ThisLineChars(0) AS LONG, __UI_FocusedTextBoxChars(0) AS LONG
REDIM SHARED __UI_ActiveMenu(0 TO 100) AS LONG, __UI_ParentMenu(0 TO 100) AS LONG
REDIM SHARED __UI_KeyCombo(0 TO 100) AS __UI_KeyCombos
DIM SHARED __UI_TotalKeyCombos AS LONG, __UI_BypassKeyCombos AS _BYTE
DIM SHARED table1252$(0 TO 255), table437$(0 TO 255)
DIM SHARED __UI_MouseLeft AS INTEGER, __UI_MouseTop AS INTEGER
DIM SHARED __UI_MouseWheel AS INTEGER, __UI_MouseButtonsSwap AS _BYTE
DIM SHARED __UI_PrevMouseLeft AS INTEGER, __UI_PrevMouseTop AS INTEGER
DIM SHARED __UI_MouseButton1 AS _BYTE, __UI_MouseButton2 AS _BYTE
DIM SHARED __UI_MouseIsDown AS _BYTE, __UI_MouseDownOnID AS LONG
DIM SHARED __UI_Mouse2IsDown AS _BYTE, __UI_Mouse2DownOnID AS LONG
DIM SHARED __UI_PreviousMouseDownOnID AS LONG
DIM SHARED __UI_KeyIsDown AS _BYTE, __UI_KeyDownOnID AS LONG
DIM SHARED __UI_ShiftIsDown AS _BYTE, __UI_CtrlIsDown AS _BYTE
DIM SHARED __UI_AltIsDown AS _BYTE, __UI_ShowHotKeys AS _BYTE, __UI_AltCombo$
DIM SHARED __UI_LastMouseClick AS SINGLE, __UI_MouseDownOnScrollbar AS SINGLE
DIM SHARED __UI_DragX AS INTEGER, __UI_DragY AS INTEGER
DIM SHARED __UI_DefaultButtonID AS LONG
DIM SHARED __UI_KeyHit AS LONG, __UI_KeepFocus AS _BYTE
DIM SHARED __UI_Focus AS LONG, __UI_PreviousFocus AS LONG, __UI_KeyboardFocus AS _BYTE
DIM SHARED __UI_HoveringID AS LONG, __UI_LastHoveringID AS LONG, __UI_BelowHoveringID AS LONG
DIM SHARED __UI_IsDragging AS _BYTE, __UI_DraggingID AS LONG
DIM SHARED __UI_IsResizing AS _BYTE, __UI_ResizingID AS LONG
DIM SHARED __UI_ResizeHandleHover AS _BYTE
DIM SHARED __UI_IsSelectingText AS _BYTE, __UI_IsSelectingTextOnID AS LONG
DIM SHARED __UI_SelectedText AS STRING, __UI_SelectionLength AS LONG
DIM SHARED __UI_StateHasChanged AS _BYTE
DIM SHARED __UI_DraggingThumb AS _BYTE, __UI_ThumbDragTop AS INTEGER
DIM SHARED __UI_DraggingThumbOnID AS LONG
DIM SHARED __UI_HasInput AS _BYTE, __UI_ProcessInputTimer AS SINGLE
DIM SHARED __UI_UnloadSignal AS _BYTE, __UI_HasResized AS _BYTE
DIM SHARED __UI_ExitTriggered AS _BYTE
DIM SHARED __UI_Loaded AS _BYTE
DIM SHARED __UI_EventsTimer AS INTEGER, __UI_RefreshTimer AS INTEGER
DIM SHARED __UI_ActiveDropdownList AS LONG, __UI_ParentDropdownList AS LONG
DIM SHARED __UI_TotalActiveMenus AS LONG, __UI_ActiveMenuIsContextMenu AS _BYTE
DIM SHARED __UI_SubMenuDelay AS SINGLE, __UI_HoveringSubMenu AS _BYTE
DIM SHARED __UI_TopMenuBarItem AS LONG
DIM SHARED __UI_ActiveTipID AS LONG, __UI_TipTimer AS SINGLE, __UI_PreviousTipID AS LONG
DIM SHARED __UI_ActiveTipTop AS INTEGER, __UI_ActiveTipLeft AS INTEGER
DIM SHARED __UI_FormID AS LONG, __UI_HasMenuBar AS LONG
DIM SHARED __UI_ScrollbarWidth AS INTEGER, __UI_ScrollbarButtonHeight AS INTEGER
DIM SHARED __UI_MenuBarOffset AS INTEGER, __UI_MenuItemOffset AS INTEGER
DIM SHARED __UI_NewMenuBarTextLeft AS INTEGER, __UI_DefaultCaptionIndent AS INTEGER
DIM SHARED __UI_ForceRedraw AS _BYTE, __UI_AutoRefresh AS _BYTE
DIM SHARED __UI_CurrentTitle AS STRING
DIM SHARED __UI_DesignMode AS _BYTE, __UI_FirstSelectedID AS LONG
DIM SHARED __UI_WaitMessage AS STRING, __UI_TotalSelectedControls AS LONG
DIM SHARED __UI_WaitMessageHandle AS LONG, __UI_EditorMode AS _BYTE
DIM SHARED __UI_LastRenderedCharCount AS LONG
DIM SHARED __UI_SelectionRectangleTop AS INTEGER, __UI_SelectionRectangleLeft AS INTEGER
DIM SHARED __UI_SelectionRectangle AS _BYTE
DIM SHARED __UI_CantShowContextMenu AS _BYTE, __UI_ShowPositionAndSize AS _BYTE
DIM SHARED __UI_ShowInvisibleControls AS _BYTE, __UI_Snapped AS _BYTE
DIM SHARED __UI_SnappedByProximityX AS _BYTE, __UI_SnappedByProximityY AS _BYTE
DIM SHARED __UI_SnappedX AS INTEGER, __UI_SnappedY AS INTEGER
DIM SHARED __UI_SnappedXID AS LONG, __UI_SnappedYID AS LONG
DIM SHARED __UI_SnapLines AS _BYTE, __UI_SnapDistance AS INTEGER, __UI_SnapDistanceFromForm AS INTEGER
DIM SHARED __UI_FrameRate AS SINGLE, __UI_Font8Offset AS INTEGER, __UI_Font16Offset AS INTEGER
DIM SHARED __UI_ClipboardCheck$, __UI_MenuBarOffsetV AS INTEGER
DIM SHARED __UI_KeepScreenHidden AS _BYTE, __UI_MaxBorderSize AS INTEGER
DIM SHARED __UI_InternalContextMenus AS LONG, __UI_DidClick AS _BYTE
DIM SHARED __UI_ContextMenuSourceID AS LONG
DIM SHARED __UI_FKey(1 TO 12) AS LONG
'Control types: -----------------------------------------------
DIM SHARED __UI_Type(0 TO 18) AS __UI_Types
__UI_Type(__UI_Type_Form).Name = "Form"
__UI_Type(__UI_Type_Frame).Name = "Frame"
__UI_Type(__UI_Type_Frame).DefaultWidth = 230
__UI_Type(__UI_Type_Frame).DefaultHeight = 150
__UI_Type(__UI_Type_Button).Name = "Button"
__UI_Type(__UI_Type_Button).DefaultWidth = 80
__UI_Type(__UI_Type_Button).DefaultHeight = 23
__UI_Type(__UI_Type_Label).Name = "Label"
__UI_Type(__UI_Type_Label).DefaultWidth = 150
__UI_Type(__UI_Type_Label).DefaultHeight = 23
__UI_Type(__UI_Type_CheckBox).Name = "CheckBox"
__UI_Type(__UI_Type_CheckBox).DefaultWidth = 150
__UI_Type(__UI_Type_CheckBox).DefaultHeight = 23
__UI_Type(__UI_Type_CheckBox).TurnsInto = __UI_Type_ToggleSwitch
__UI_Type(__UI_Type_RadioButton).Name = "RadioButton"
__UI_Type(__UI_Type_RadioButton).DefaultWidth = 150
__UI_Type(__UI_Type_RadioButton).DefaultHeight = 23
__UI_Type(__UI_Type_TextBox).Name = "TextBox"
__UI_Type(__UI_Type_TextBox).DefaultWidth = 120
__UI_Type(__UI_Type_TextBox).DefaultHeight = 23
__UI_Type(__UI_Type_ProgressBar).Name = "ProgressBar"
__UI_Type(__UI_Type_ProgressBar).DefaultWidth = 300
__UI_Type(__UI_Type_ProgressBar).DefaultHeight = 23
__UI_Type(__UI_Type_ListBox).Name = "ListBox"
__UI_Type(__UI_Type_ListBox).DefaultWidth = 200
__UI_Type(__UI_Type_ListBox).DefaultHeight = 200
__UI_Type(__UI_Type_ListBox).TurnsInto = __UI_Type_DropdownList
__UI_Type(__UI_Type_DropdownList).Name = "DropdownList"
__UI_Type(__UI_Type_DropdownList).DefaultWidth = 200
__UI_Type(__UI_Type_DropdownList).DefaultHeight = 23
__UI_Type(__UI_Type_DropdownList).TurnsInto = __UI_Type_ListBox
__UI_Type(__UI_Type_MenuBar).Name = "MenuBar"
__UI_Type(__UI_Type_MenuBar).TurnsInto = __UI_Type_ContextMenu
__UI_Type(__UI_Type_MenuBar).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_MenuItem).Name = "MenuItem"
__UI_Type(__UI_Type_MenuItem).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_MenuPanel).Name = "MenuPanel"
__UI_Type(__UI_Type_PictureBox).Name = "PictureBox"
__UI_Type(__UI_Type_PictureBox).DefaultWidth = 230
__UI_Type(__UI_Type_PictureBox).DefaultHeight = 150
__UI_Type(__UI_Type_TrackBar).Name = "TrackBar"
__UI_Type(__UI_Type_TrackBar).DefaultWidth = 300
__UI_Type(__UI_Type_TrackBar).DefaultHeight = 40
__UI_Type(__UI_Type_TrackBar).MinimumHeight = 30
__UI_Type(__UI_Type_TrackBar).RestrictResize = __UI_CantResizeV
__UI_Type(__UI_Type_ContextMenu).Name = "ContextMenu"
__UI_Type(__UI_Type_ContextMenu).TurnsInto = __UI_Type_MenuBar
__UI_Type(__UI_Type_ContextMenu).RestrictResize = __UI_CantResize
__UI_Type(__UI_Type_ContextMenu).DefaultWidth = 22
__UI_Type(__UI_Type_ContextMenu).DefaultHeight = 22
__UI_Type(__UI_Type_Font).Name = "Font"
__UI_Type(__UI_Type_ToggleSwitch).Name = "ToggleSwitch"
__UI_Type(__UI_Type_ToggleSwitch).DefaultWidth = 40
__UI_Type(__UI_Type_ToggleSwitch).DefaultHeight = 17
__UI_Type(__UI_Type_ToggleSwitch).TurnsInto = __UI_Type_CheckBox
__UI_Type(__UI_Type_ToggleSwitch).RestrictResize = __UI_CantResize
'--------------------------------------------------------------
__UI_RestoreFKeys
CONST False = 0, True = Not False
'$INCLUDE:'InFormVersion.bas'
__UI_SubMenuDelay = .4
__UI_SnapDistance = 5
__UI_SnapDistanceFromForm = 10
__UI_MaxBorderSize = 10
__UI_Font8Offset = 5
__UI_Font16Offset = 3
__UI_ClipboardCheck$ = "InForm" + STRING$(2, 10) + "BEGIN CONTROL DATA" + CHR$(10) + STRING$(60, 45) + CHR$(10)
__UI_ThemeSetup
__UI_InternalMenus
__UI_LoadForm
__UI_Init
'Main loop
DO
_LIMIT 1
LOOP
SYSTEM
__UI_ErrorHandler:
RESUME NEXT

8697
examples/InFormTicTacToe2/InForm/InForm.ui
View file

File diff suppressed because it is too large Load diff

7
examples/InFormTicTacToe2/InForm/InFormVersion.bas
View file

@ -1,7 +0,0 @@
'Starting with v1.0, __UI_VersionNumber is actually the current build.
CONST __UI_Version = "v1.5"
CONST __UI_VersionNumber = 1
CONST __UI_VersionIsBeta = 1
CONST __UI_CopyrightSpan = "2016-2023"

Some files were not shown because too many files have changed in this diff Show more