1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2025-01-15 03:49:56 +00:00

Update GIFPlayer to not throw errors when bad Ids are passed

This commit is contained in:
Samuel Gomes 2023-12-01 03:12:40 +05:30
parent 08121bfb4f
commit db355486c1
44 changed files with 2104 additions and 2007 deletions

File diff suppressed because it is too large Load diff

View file

@ -817,9 +817,11 @@ SUB __UI_LoadForm
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBindBT", 80, 23, 341, 220, __UI_GetID("SetControlBinding")) __UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBindBT", 80, 23, 341, 220, __UI_GetID("SetControlBinding"))
SetCaption __UI_NewID, "Cancel" SetCaption __UI_NewID, "Cancel"
Control(__UI_NewID).CanHaveFocus = True Control(__UI_NewID).CanHaveFocus = True
END SUB END SUB
SUB __UI_AssignIDs SUB __UI_AssignIDs
UiEditor = __UI_GetID("UiEditor") UiEditor = __UI_GetID("UiEditor")
StatusBar = __UI_GetID("StatusBar") StatusBar = __UI_GetID("StatusBar")
FileMenu = __UI_GetID("FileMenu") FileMenu = __UI_GetID("FileMenu")
@ -1005,4 +1007,5 @@ SUB __UI_AssignIDs
TargetPropertyList = __UI_GetID("TargetPropertyList") TargetPropertyList = __UI_GetID("TargetPropertyList")
BindBT = __UI_GetID("BindBT") BindBT = __UI_GetID("BindBT")
CancelBindBT = __UI_GetID("CancelBindBT") CancelBindBT = __UI_GetID("CancelBindBT")
END SUB END SUB

View file

@ -83,8 +83,11 @@ __UI_ClearColor ContextMenuIcon, 0, 0
'$INCLUDE:'extensions/GIFPlay.bi' '$INCLUDE:'extensions/GIFPlay.bi'
'$INCLUDE:'extensions/MessageBox.bi' '$INCLUDE:'extensions/MessageBox.bi'
'$INCLUDE:'InForm.bi' '$INCLUDE:'InForm.bi'
'$INCLUDE:'xp.uitheme'
'$INCLUDE:'UiEditorPreview.frm' '$INCLUDE:'UiEditorPreview.frm'
'$INCLUDE:'xp.uitheme'
'$INCLUDE:'InForm.ui'
'$INCLUDE:'extensions/GIFPlay.bas'
'$INCLUDE:'extensions/MessageBox.bas'
'Event procedures: --------------------------------------------------------------- 'Event procedures: ---------------------------------------------------------------
SUB __UI_Click (id AS LONG) SUB __UI_Click (id AS LONG)
@ -386,7 +389,7 @@ SUB __UI_BeforeUpdateDisplay
IF EditorWasActive = FALSE THEN IF EditorWasActive = FALSE THEN
'Preview was launched by user 'Preview was launched by user
_SCREENHIDE _SCREENHIDE
_DELAY 0.2: _MESSAGEBOX "InForm Preview", "__UI_BeforeUpdateDisplay: InForm Designer is not running. Please run the main program.", "error" MessageBox "__UI_BeforeUpdateDisplay: InForm Designer is not running. Please run the main program.", _TITLE$, MsgBox_Critical
END IF END IF
IF _FILEEXISTS("InForm/UiEditorPreview.frmbin") THEN KILL "InForm/UiEditorPreview.frmbin" IF _FILEEXISTS("InForm/UiEditorPreview.frmbin") THEN KILL "InForm/UiEditorPreview.frmbin"
SYSTEM SYSTEM
@ -1694,7 +1697,7 @@ SUB __UI_OnLoad
IF VAL(HostPort) < 60000 THEN IF VAL(HostPort) < 60000 THEN
ForceQuit: ForceQuit:
_SCREENHIDE _SCREENHIDE
_DELAY 0.2: _MESSAGEBOX "InForm Preview", "__UI_OnLoad: InForm Designer is not running. Please run the main program.", "error" MessageBox "__UI_OnLoad: InForm Designer is not running. Please run the main program.", _TITLE$, MsgBox_Critical
SYSTEM SYSTEM
END IF END IF
@ -3046,8 +3049,8 @@ SUB LoadPreviewText
DummyText$ = nextParameter(b$) 'discard first parameter DummyText$ = nextParameter(b$) 'discard first parameter
DummyText$ = nextParameter(b$) DummyText$ = nextParameter(b$)
LoadImage Control(TempValue), DummyText$ LoadImage Control(TempValue), DummyText$
ELSEIF LEFT$(b$, 30) = "__UI_RegisterResult = OpenGif(" THEN ELSEIF LEFT$(b$, 30) = "__UI_RegisterResult = GIF_LoadFromFile(" THEN
IF LogFileLoad THEN PRINT #LogFileNum, "OPENGIF" IF LogFileLoad THEN PRINT #LogFileNum, "GIF_LOADFROMFILE"
'Gif extension 'Gif extension
DIM RegisterResult AS _BYTE DIM RegisterResult AS _BYTE
DummyText$ = nextParameter(b$) 'discard first parameter DummyText$ = nextParameter(b$) 'discard first parameter
@ -3062,9 +3065,9 @@ SUB LoadPreviewText
Control(TempValue).HelperCanvas = _NEWIMAGE(GIF_GetWidth(TempValue), GIF_GetHeight(TempValue), 32) Control(TempValue).HelperCanvas = _NEWIMAGE(GIF_GetWidth(TempValue), GIF_GetHeight(TempValue), 32)
GIF_Draw TempValue GIF_Draw TempValue
ELSE ELSE
MessageBox DummyText$ + " is not a GIF file!", "", MsgBox_Exclamation MessageBox DummyText$ + " is not a GIF file!", _TITLE$, MsgBox_Exclamation
END IF END IF
ELSEIF b$ = "IF __UI_RegisterResult THEN PlayGif __UI_NewID" OR LEFT$(b$, 8) = "PlayGif " THEN ELSEIF b$ = "IF __UI_RegisterResult THEN GIF_Play __UI_NewID" OR LEFT$(b$, 9) = "GIF_Play " THEN
IF LogFileLoad THEN PRINT #LogFileNum, "AUTOPLAY GIF" IF LogFileLoad THEN PRINT #LogFileNum, "AUTOPLAY GIF"
'Auto-play gif 'Auto-play gif
AutoPlayGif(TempValue) = TRUE AutoPlayGif(TempValue) = TRUE
@ -3150,10 +3153,8 @@ END SUB
SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$) SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$)
IF LCASE$(RIGHT$(fileName$, 4)) = ".gif" THEN IF LCASE$(RIGHT$(fileName$, 4)) = ".gif" THEN
DIM tryGif AS _BYTE
GIF_Free This.ID GIF_Free This.ID
tryGif = GIF_LoadFromFile(This.ID, fileName$) IF GIF_LoadFromFile(This.ID, fileName$) THEN
IF tryGif THEN
IF GIF_GetTotalFrames(This.ID) = 1 THEN IF GIF_GetTotalFrames(This.ID) = 1 THEN
GIF_Free This.ID GIF_Free This.ID
ELSE ELSE
@ -3167,7 +3168,7 @@ SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$)
EXIT SUB EXIT SUB
END IF END IF
ELSE ELSE
MessageBox fileName$ + " is not a GIF file!", "", MSGBOX_EXCLAMATION MessageBox fileName$ + " is not a GIF file!", _TITLE$, MsgBox_Exclamation
END IF END IF
END IF END IF
GIF_Free This.ID GIF_Free This.ID
@ -3999,7 +4000,3 @@ FUNCTION LoadEditorImage& (FileName$)
LoadEditorImage& = TempImage LoadEditorImage& = TempImage
END FUNCTION END FUNCTION
'$INCLUDE:'extensions/GIFPlay.bas'
'$INCLUDE:'extensions/MessageBox.bas'
'$INCLUDE:'InForm.ui'

View file

@ -2,16 +2,17 @@
': InForm - GUI library for QB64 - Beta version 9 ': InForm - GUI library for QB64 - Beta version 9
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor ': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
'----------------------------------------------------------- '-----------------------------------------------------------
SUB __UI_LoadForm SUB __UI_LoadForm
DIM __UI_NewID AS LONG DIM __UI_NewID AS LONG
$RESIZE:ON $RESIZE:ON
__UI_NewID = __UI_NewControl(__UI_Type_Form, "Form1", 300, 300, 0, 0,0) __UI_NewID = __UI_NewControl(__UI_Type_Form, "Form1", 300, 300, 0, 0, 0)
END SUB END SUB
SUB __UI_AssignIDs SUB __UI_AssignIDs
END SUB END SUB

View file

@ -1,82 +1,132 @@
# Animated GIF Decoder # Animated GIF Player Library
***By Zom-B*** ([QB64-PE Wiki](https://qb64phoenix.com/qb64wiki/index.php/GIF_Images)) ***By [a740g](https://github.com/a740g)***
***Adapted for use with InForm's PictureBox controls by @FellippeHeitor***
***Fixed, refactored and enhanced by @a740g***
## Usage instructions ## Usage instructions
Your form must contain a PictureBox control that'll serve as a container for You can use the Library either standalone or with InForm-PE.
the GIF file you'll load with this library.
In the **External modules section** of the .bas file generated by InForm, ### Standalone
`$INCLUDE` both `GIFPlay.bi` and `GIFPlay.bas`. The first must come before the
line that includes `InForm.ui` and the second must come after that, as in ```vb
the sample below: ' At the top of your code include GIFPlay.bi
'$INCLUDE:'GIFPlay.bi'
' Your code here...
' At the bottom of your code include GIFPlay.bas
'$INCLUDE:'GIFPlay.bas'
```
### With InForm-PE
Your form must contain a PictureBox control that'll serve as a container for the GIF file you'll load with this library.
In the **External modules section** of the .bas file generated by InForm, `$INCLUDE` both `GIFPlay.bi` and `GIFPlay.bas`.
The first must come ***before*** the line that includes `InForm.ui` and the second must come after that, as in the sample below:
```vb ```vb
': External modules: -------------------------------- ': External modules: --------------------------------
'$INCLUDE:'InForm\extensions\GIFPlay.bi' '$INCLUDE:'InForm/extensions/GIFPlay.bi'
'$INCLUDE:'InForm\InForm.ui' '$INCLUDE:'InForm/InForm.ui'
'$INCLUDE:'InForm\xp.uitheme' '$INCLUDE:'InForm/xp.uitheme'
'$INCLUDE:'gifplaySample.frm' '$INCLUDE:'gifplaySample.frm'
'$INCLUDE:'InForm\extensions\GIFPlay.bm' '$INCLUDE:'InForm/extensions/GIFPlay.bas'
``` ```
## API ## API
```vb ```vb
FUNCTION GIF_Open%% (ID AS LONG, fileName AS STRING) FUNCTION GIF_LoadFromFile%% (Id AS LONG, fileName AS STRING)
FUNCTION GIF_LoadFromMemory%% (Id AS LONG, buffer AS STRING)
``` ```
GIF_Open is a function that takes a PictureBox control ID and a GIF file name and returns True if loading the animation is successful. GIF_LoadFromFile is a function that takes a PictureBox control ID (or any unique ID) and a GIF file name and returns True if loading the animation is successful.
GIF_LoadFromMemory does the same. However, it loads the animation from a STRING buffer.
```vb ```vb
FUNCTION GIF_GetTotalFrames~& (ID AS LONG) SUB GIF_Free (Id AS LONG)
``` ```
GIF_GetTotalFrames returns the total number of frames in a loaded gif. If not an animated GIF, returns 1. Frees resources used by the GIF file loaded previously using GIF_LoadFromFile or GIF_LoadFromMemory.
```vb ```vb
SUB GIF_Update(ID AS LONG) FUNCTION GIF_IsLoaded%% (Id AS LONG)
``` ```
GIF_Update must be called from within the __UI_BeforeUpdateDisplay event. That's where the frames will be updated in your PictureBox control. Returns True if GIF file is completly loaded and ready for use.
```vb ```vb
FUNCTION GIF_IsPlaying%% (ID AS LONG) FUNCTION GIF_GetWidth~& (Id AS LONG)
```
Returns True is the PictureBox control contains a GIF that's currently being played.
```vb
SUB GIF_Play(ID AS LONG), SUB GIF_Pause(ID AS LONG), SUB GIF_Stop(ID AS LONGD)
```
Starts, pauses or stops playback of a GIF file loaded into the specified PictureBox control.
```vb
SUB GIF_Close(ID AS LONG)
```
Closes the GIF file loaded in the specified PictureBox control and frees the memory used by the frame data buffer attached to it.
```vb
FUNCTION GIF_GetGeight~% (ID AS LONG)
```
Returns the height of the GIF in pixels.
```vb
FUNCTION GIF_GetWidth~% (ID AS LONG)
``` ```
Returns the width of the GIF in pixels. Returns the width of the GIF in pixels.
```vb ```vb
SUB GIF_HideOverlay (ID AS LONG) FUNCTION GIF_GetHeight~& (Id AS LONG)
```
Returns the height of the GIF in pixels.
```vb
FUNCTION GIF_GetFrameNumber~& (Id AS LONG)
```
Returns the number of currently playing frame.
```vb
FUNCTION GIF_GetTotalFrames~& (Id AS LONG)
```
Returns the total number of frames in a loaded GIF. If not an animated GIF, it returns 1.
```vb
FUNCTION GIF_IsPlaying%% (Id AS LONG)
```
Returns True if a GIF is currently being played.
```vb
SUB GIF_Play (Id AS LONG)
SUB GIF_Pause (Id AS LONG)
SUB GIF_Stop (Id AS LONG)
```
Starts, pauses or stops playback of a loaded GIF file.
```vb
FUNCTION GIF_GetTotalDuration~&& (Id AS LONG)
```
Returns the total runtime of the animation in ms.
```vb
FUNCTION GIF_GetFrameDuration~&& (Id AS LONG)
```
Returns the total runtime of the current frame in ms.
```vb
SUB GIF_SetLoop (Id AS LONG, loops AS LONG)
```
Set the looping behavior, where < 0 means play once, 0 means loop forever and +n means loop n times.
```vb
SUB GIF_Draw (Id AS LONG)
```
Draws the current frame on a destination surface @ (0, 0) (stretching the frame if needed).
GIF_Draw must be called from within the __UI_BeforeUpdateDisplay event. That's where the frames will be updated in your PictureBox control.
```vb
FUNCTION GIF_GetFrame& (Id AS LONG)
```
Returns the current rendered frame image to be played. Playback is time sensitive so frames may be skipped or the last frame may be returned.
Use this if you want to do your own rendering. Do not free the image. The library will do that when it is no longer needed.
```vb
SUB GIF_EnableOverlay (Id AS LONG, isEnabled AS _BYTE)
``` ```
Hides the **GIF** overlay image when the GIF is not playing or paused. Hides the **GIF** overlay image when the GIF is not playing or paused.

View file

@ -1,6 +1,7 @@
InForm - GUI library for QB64 InForm - GUI library for QB64
Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
https://github.com/FellippeHeitor/InForm https://github.com/FellippeHeitor/InForm
----------------------------------------------------------- -----------------------------------------------------------
Below is the binary format for exchange of controls data. It is Below is the binary format for exchange of controls data. It is
used for UiEditorPreview.frmbin, which is read/written to by both used for UiEditorPreview.frmbin, which is read/written to by both

View file

@ -16,7 +16,6 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
'DEFLNG A-Z 'DEFLNG A-Z
'OPTION _EXPLICIT 'OPTION _EXPLICIT
'CONST FALSE = 0, TRUE = NOT FALSE
'CONST GIF_ID = 1 'CONST GIF_ID = 1
@ -94,6 +93,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayFrame() AS __GIFPlayFrameType SHARED __GIFPlayFrame() AS __GIFPlayFrameType
SHARED __GIF_FirstFreeFrame AS LONG SHARED __GIF_FirstFreeFrame AS LONG
' Nothing to do if Id is invalid
IF NOT HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN EXIT SUB
' Get the slot we need to free ' Get the slot we need to free
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id) DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
@ -108,7 +110,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
END IF END IF
' Mark the frame slot as unused so that it can be reused ' Mark the frame slot as unused so that it can be reused
__GIFPlayFrame(__GIFPlay(idx).frame).isUsed = FALSE __GIFPlayFrame(__GIFPlay(idx).frame).isUsed = __GIF_FALSE
' Note the lowest free frame ' Note the lowest free frame
IF __GIF_FirstFreeFrame > __GIFPlay(idx).frame THEN __GIF_FirstFreeFrame = __GIFPlay(idx).frame IF __GIF_FirstFreeFrame > __GIFPlay(idx).frame THEN __GIF_FirstFreeFrame = __GIFPlay(idx).frame
@ -130,7 +132,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
END IF END IF
' Finally mark the GIF slot as unused so that it can be reused ' Finally mark the GIF slot as unused so that it can be reused
__GIFPlay(idx).isUsed = FALSE __GIFPlay(idx).isUsed = __GIF_FALSE
' Remove Id from the hash table ' Remove Id from the hash table
HashTable_Remove __GIFPlayHashTable(), Id HashTable_Remove __GIFPlayHashTable(), Id
@ -142,7 +144,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
GIF_GetWidth = _WIDTH(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).image) GIF_GetWidth = _WIDTH(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).image)
END IF
END FUNCTION END FUNCTION
@ -151,7 +155,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
GIF_GetHeight = _HEIGHT(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).image) GIF_GetHeight = _HEIGHT(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).image)
END IF
END FUNCTION END FUNCTION
@ -160,7 +166,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
GIF_GetFrameNumber = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frameNumber GIF_GetFrameNumber = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frameNumber
END IF
END FUNCTION END FUNCTION
@ -169,7 +177,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
GIF_GetTotalFrames = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frameCount GIF_GetTotalFrames = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frameCount
END IF
END FUNCTION END FUNCTION
@ -178,10 +188,12 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id) DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
__GIFPlay(idx).isPlaying = TRUE __GIFPlay(idx).isPlaying = __GIF_TRUE
__GIFPlay(idx).lastTick = __GIF_GetTicks __GIFPlay(idx).lastTick = __GIF_GetTicks
END IF
END SUB END SUB
@ -190,7 +202,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying = FALSE IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying = __GIF_FALSE
END IF
END SUB END SUB
@ -199,12 +213,14 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id) DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
__GIFPlay(idx).isPlaying = FALSE __GIFPlay(idx).isPlaying = __GIF_FALSE
__GIFPlay(idx).frame = __GIFPlay(idx).firstFrame __GIFPlay(idx).frame = __GIFPlay(idx).firstFrame
__GIFPlay(idx).frameNumber = 0 __GIFPlay(idx).frameNumber = 0
__GIFPlay(idx).loopCounter = 0 __GIFPlay(idx).loopCounter = 0
END IF
END SUB END SUB
@ -213,7 +229,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
GIF_IsPlaying = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying GIF_IsPlaying = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying
END IF
END FUNCTION END FUNCTION
@ -223,6 +241,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
$IF INFORM_BI = DEFINED THEN $IF INFORM_BI = DEFINED THEN
BeginDraw ID BeginDraw ID
$END IF $END IF
@ -248,6 +267,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
$IF INFORM_BI = DEFINED THEN $IF INFORM_BI = DEFINED THEN
EndDraw ID EndDraw ID
$END IF $END IF
END IF
END SUB END SUB
@ -260,14 +280,17 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
SHARED __GIFPlayFrame() AS __GIFPlayFrameType SHARED __GIFPlayFrame() AS __GIFPlayFrameType
' Exit if Id is not valid
IF NOT HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN EXIT FUNCTION
' Cache the GIF index because we'll be using this a lot ' Cache the GIF index because we'll be using this a lot
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id) DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
' Always return the rendered image handle (since this does not change during the GIFs lifetime) ' Always return the rendered image handle (since this does not change during the GIFs lifetime)
GIF_GetFrame = __GIFPlay(idx).image GIF_GetFrame = __GIFPlay(idx).image
' Exit if we are paused ' Exit if we are paused or not ready
IF NOT __GIFPlay(idx).isPlaying THEN EXIT FUNCTION IF NOT __GIFPlay(idx).isPlaying OR NOT __GIFPlay(idx).isReady THEN EXIT FUNCTION
' Exit if we finished a single or the specified number of loops ' Exit if we finished a single or the specified number of loops
IF __GIFPlay(idx).loops <> 0 AND (__GIFPlay(idx).loopCounter < 0 OR __GIFPlay(idx).loopCounter >= __GIFPlay(idx).loops) THEN EXIT FUNCTION IF __GIFPlay(idx).loops <> 0 AND (__GIFPlay(idx).loopCounter < 0 OR __GIFPlay(idx).loopCounter >= __GIFPlay(idx).loops) THEN EXIT FUNCTION
@ -315,7 +338,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
IF __GIFPlay(idx).hasSavedImage THEN IF __GIFPlay(idx).hasSavedImage THEN
' Copy back the saved image and unset the flag ' Copy back the saved image and unset the flag
_PUTIMAGE , __GIFPlay(idx).savedImage, __GIFPlay(idx).image _PUTIMAGE , __GIFPlay(idx).savedImage, __GIFPlay(idx).image
__GIFPlay(idx).hasSavedImage = FALSE __GIFPlay(idx).hasSavedImage = __GIF_FALSE
END IF END IF
' All other disposal methods do not require any action ' All other disposal methods do not require any action
@ -325,7 +348,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
' If the current frame's disposal method is 3 (restore to previous) then save the current rendered frame and set the flag ' If the current frame's disposal method is 3 (restore to previous) then save the current rendered frame and set the flag
IF __GIFPlayFrame(__GIFPlay(idx).frame).disposalMethod = 3 THEN IF __GIFPlayFrame(__GIFPlay(idx).frame).disposalMethod = 3 THEN
_PUTIMAGE , __GIFPlay(idx).image, __GIFPlay(idx).savedImage _PUTIMAGE , __GIFPlay(idx).image, __GIFPlay(idx).savedImage
__GIFPlay(idx).hasSavedImage = TRUE __GIFPlay(idx).hasSavedImage = __GIF_TRUE
END IF END IF
' Render the frame at the correct (x, y) offset on the final image ' Render the frame at the correct (x, y) offset on the final image
@ -338,7 +361,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
GIF_GetTotalDuration = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).duration GIF_GetTotalDuration = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).duration
END IF
END FUNCTION END FUNCTION
@ -348,7 +373,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
SHARED __GIFPlayFrame() AS __GIFPlayFrameType SHARED __GIFPlayFrame() AS __GIFPlayFrameType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
GIF_GetFrameDuration = __GIFPlayFrame(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frame).duration GIF_GetFrameDuration = __GIFPlayFrame(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frame).duration
END IF
END FUNCTION END FUNCTION
@ -357,7 +384,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).loops = loops __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).loops = loops
END IF
END SUB END SUB
@ -366,18 +395,22 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).overlayEnabled = isEnabled __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).overlayEnabled = isEnabled
END IF
END SUB END SUB
' Returns TRUE if a GIF with Id is loaded ' Returns TRUE if a GIF with Id is loaded
FUNCTION GIF_IsLoaded%% (Id AS LONG) FUNCTION GIF_IsLoaded%% (Id AS LONG)
$CHECKING:OFF
SHARED __GIFPlayHashTable() AS HashTableType SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType SHARED __GIFPlay() AS __GIFPlayType
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
GIF_IsLoaded = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isReady GIF_IsLoaded = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isReady
END IF END IF
$CHECKING:ON
END FUNCTION END FUNCTION
@ -540,7 +573,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
prev = code prev = code
LOOP LOOP
__GIF_DecodeLZW = TRUE __GIF_DecodeLZW = __GIF_TRUE
END FUNCTION END FUNCTION
@ -596,24 +629,24 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
' No free GIF slots? ' No free GIF slots?
IF idx > UBOUND(__GIFPlay) THEN REDIM _PRESERVE __GIFPlay(0 TO idx) AS __GIFPlayType IF idx > UBOUND(__GIFPlay) THEN REDIM _PRESERVE __GIFPlay(0 TO idx) AS __GIFPlayType
__GIFPlay(idx).isUsed = TRUE ' occupy the slot __GIFPlay(idx).isUsed = __GIF_TRUE ' occupy the slot
HashTable_InsertLong __GIFPlayHashTable(), Id, idx ' add it to the hash table HashTable_InsertLong __GIFPlayHashTable(), Id, idx ' add it to the hash table
' Reset some stuff ' Reset some stuff
__GIFPlay(idx).isReady = FALSE __GIFPlay(idx).isReady = __GIF_FALSE
__GIFPlay(idx).firstFrame = -1 __GIFPlay(idx).firstFrame = -1
__GIFPlay(idx).lastFrame = -1 __GIFPlay(idx).lastFrame = -1
__GIFPlay(idx).frame = -1 __GIFPlay(idx).frame = -1
__GIFPlay(idx).frameCount = 0 __GIFPlay(idx).frameCount = 0
__GIFPlay(idx).frameNumber = 0 __GIFPlay(idx).frameNumber = 0
__GIFPlay(idx).isPlaying = FALSE __GIFPlay(idx).isPlaying = __GIF_FALSE
__GIFPlay(idx).loops = 0 __GIFPlay(idx).loops = 0
__GIFPlay(idx).loopCounter = 0 __GIFPlay(idx).loopCounter = 0
__GIFPlay(idx).duration = 0 __GIFPlay(idx).duration = 0
__GIFPlay(idx).lastTick = 0 __GIFPlay(idx).lastTick = 0
__GIFPlay(idx).lastFrameRendered = -1 __GIFPlay(idx).lastFrameRendered = -1
__GIFPlay(idx).hasSavedImage = FALSE __GIFPlay(idx).hasSavedImage = __GIF_FALSE
__GIFPlay(idx).overlayEnabled = TRUE __GIFPlay(idx).overlayEnabled = __GIF_TRUE
' Get width and height ' Get width and height
DIM W AS _UNSIGNED INTEGER: W = StringFile_ReadInteger(sf) DIM W AS _UNSIGNED INTEGER: W = StringFile_ReadInteger(sf)
@ -669,7 +702,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
IF frameIdx > UBOUND(__GIFPlayFrame) THEN REDIM _PRESERVE __GIFPlayFrame(0 TO frameIdx) AS __GIFPlayFrameType IF frameIdx > UBOUND(__GIFPlayFrame) THEN REDIM _PRESERVE __GIFPlayFrame(0 TO frameIdx) AS __GIFPlayFrameType
' Occupy the slot ' Occupy the slot
__GIFPlayFrame(frameIdx).isUsed = TRUE __GIFPlayFrame(frameIdx).isUsed = __GIF_TRUE
' Read frame size and offset ' Read frame size and offset
__GIFPlayFrame(frameIdx).L = StringFile_ReadInteger(sf) __GIFPlayFrame(frameIdx).L = StringFile_ReadInteger(sf)
@ -786,14 +819,14 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
'__GIF_PrintDebugInfo idx '__GIF_PrintDebugInfo idx
' Render the first frame and then pause __GIFPlay(idx).isReady = __GIF_TRUE ' set the ready flag
__GIFPlay(idx).isPlaying = TRUE
__GIFPlay(idx).lastTick = __GIF_GetTicks
DIM dummy AS LONG: dummy = GIF_GetFrame(Id)
__GIFPlay(idx).isPlaying = FALSE
__GIFPlay(idx).isReady = TRUE ' set the ready flag
__GIF_Load = TRUE ' Render the first frame and then stop
GIF_Play Id
DIM dummy AS LONG: dummy = GIF_GetFrame(Id)
GIF_Stop Id
__GIF_Load = __GIF_TRUE
EXIT FUNCTION EXIT FUNCTION
gif_load_error: gif_load_error:

View file

@ -9,6 +9,8 @@ $IF GIFPLAY_BI = UNDEFINED THEN
'$INCLUDE:'HashTable.bi' '$INCLUDE:'HashTable.bi'
'$INCLUDE:'StringFile.bi' '$INCLUDE:'StringFile.bi'
CONST __GIF_FALSE%% = 0%%, __GIF_TRUE%% = NOT __GIF_FALSE
' This is the master animation type that holds info about a complete animation ' This is the master animation type that holds info about a complete animation
TYPE __GIFPlayType TYPE __GIFPlayType
isUsed AS _BYTE ' is this slot being used (this is only here to assist slot allocation) isUsed AS _BYTE ' is this slot being used (this is only here to assist slot allocation)

View file

@ -11,6 +11,9 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
'------------------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------------------
' Test code for debugging the library ' Test code for debugging the library
'------------------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------------------
'DEFLNG A-Z
'OPTION _EXPLICIT
'REDIM MyHashTable(0 TO 0) AS HashTableType 'REDIM MyHashTable(0 TO 0) AS HashTableType
'CONST TEST_LB = 1 'CONST TEST_LB = 1
@ -168,7 +171,9 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
' Return TRUE if k is available in the hash table ' Return TRUE if k is available in the hash table
FUNCTION HashTable_IsKeyPresent%% (hashTable() AS HashTableType, k AS _UNSIGNED LONG) FUNCTION HashTable_IsKeyPresent%% (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
$CHECKING:OFF
HashTable_IsKeyPresent = (__HashTable_GetLookupIndex(hashTable(), k) >= 0) HashTable_IsKeyPresent = (__HashTable_GetLookupIndex(hashTable(), k) >= 0)
$CHECKING:ON
END FUNCTION END FUNCTION
@ -177,7 +182,7 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
DIM idx AS LONG: idx = __HashTable_GetLookupIndex(hashTable(), k) DIM idx AS LONG: idx = __HashTable_GetLookupIndex(hashTable(), k)
IF idx >= 0 THEN IF idx >= 0 THEN
hashTable(idx).U = FALSE hashTable(idx).U = __HASHTABLE_FALSE
ELSE ELSE
ERROR 9 ERROR 9
END IF END IF
@ -189,7 +194,7 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
DIM idx AS LONG: idx = __HashTable_GetInsertIndex(hashTable(), k) DIM idx AS LONG: idx = __HashTable_GetInsertIndex(hashTable(), k)
IF idx >= 0 THEN IF idx >= 0 THEN
hashTable(idx).U = TRUE hashTable(idx).U = __HASHTABLE_TRUE
hashTable(idx).K = k hashTable(idx).K = k
hashTable(idx).V = v hashTable(idx).V = v
ELSE ELSE

View file

@ -6,6 +6,7 @@
$IF HASHTABLE_BI = UNDEFINED THEN $IF HASHTABLE_BI = UNDEFINED THEN
$LET HASHTABLE_BI = TRUE $LET HASHTABLE_BI = TRUE
CONST __HASHTABLE_FALSE%% = 0%%, __HASHTABLE_TRUE%% = NOT __HASHTABLE_FALSE
CONST __HASHTABLE_KEY_EXISTS& = -1& CONST __HASHTABLE_KEY_EXISTS& = -1&
CONST __HASHTABLE_KEY_UNAVAILABLE& = -2& CONST __HASHTABLE_KEY_UNAVAILABLE& = -2&

View file

@ -11,6 +11,8 @@ $IF STRINGFILE_BAS = UNDEFINED THEN
'------------------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------------------
' Test code for debugging the library ' Test code for debugging the library
'------------------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------------------
'DEFLNG A-Z
'OPTION _EXPLICIT
'WIDTH , 80 'WIDTH , 80
'DIM sf AS StringFileType 'DIM sf AS StringFileType
'StringFile_Create sf, "This_is_a_test_buffer." 'StringFile_Create sf, "This_is_a_test_buffer."
@ -97,7 +99,7 @@ $IF STRINGFILE_BAS = UNDEFINED THEN
stringFile.cursor = 0 stringFile.cursor = 0
CLOSE fh CLOSE fh
StringFile_Load = TRUE StringFile_Load = __STRINGFILE_TRUE
END IF END IF
END FUNCTION END FUNCTION
@ -113,7 +115,7 @@ $IF STRINGFILE_BAS = UNDEFINED THEN
PRINT #fh, stringFile.buffer; ' write the buffer to the file (works regardless of the file being opened in text mode) PRINT #fh, stringFile.buffer; ' write the buffer to the file (works regardless of the file being opened in text mode)
CLOSE fh CLOSE fh
StringFile_Save = TRUE StringFile_Save = __STRINGFILE_TRUE
END FUNCTION END FUNCTION

View file

@ -6,6 +6,8 @@
$IF STRINGFILE_BI = UNDEFINED THEN $IF STRINGFILE_BI = UNDEFINED THEN
$LET STRINGFILE_BI = TRUE $LET STRINGFILE_BI = TRUE
CONST __STRINGFILE_FALSE%% = 0%%, __STRINGFILE_TRUE%% = NOT __STRINGFILE_FALSE
' Simplified QB64-only memory-file ' Simplified QB64-only memory-file
TYPE StringFileType TYPE StringFileType
buffer AS STRING buffer AS STRING

View file

@ -4,21 +4,20 @@
': https://github.com/FellippeHeitor/InForm ': https://github.com/FellippeHeitor/InForm
'----------------------------------------------------------- '-----------------------------------------------------------
$VERSIONINFO:CompanyName=SpriggsySpriggs $VERSIONINFO:CompanyName='SpriggsySpriggs'
$VERSIONINFO:FileDescription=Converts a binary file into an INCLUDE-able $VERSIONINFO:FileDescription='Converts a binary file into an INCLUDE-able'
$VERSIONINFO:LegalCopyright=(c) 2019-2020 SpriggsySpriggs $VERSIONINFO:LegalCopyright='(c) 2019-2020 SpriggsySpriggs'
$VERSIONINFO:ProductName=BIN2INCLUDE $VERSIONINFO:ProductName='BIN2INCLUDE'
$VERSIONINFO:InternalName=BIN2INCLUDE $VERSIONINFO:InternalName='BIN2INCLUDE'
$VERSIONINFO:OriginalFilename=BIN2INCLUDE.exe $VERSIONINFO:OriginalFilename='BIN2INCLUDE.exe'
$VERSIONINFO:Web=https://github.com/a740g/QB64-Museum/tree/main/SpriggsySpriggs/Bin2Include $VERSIONINFO:Web='https://github.com/a740g/QB64-Museum/tree/main/SpriggsySpriggs/Bin2Include'
$VERSIONINFO:Comments=QB64-PE and InForm-PE port by a740g $VERSIONINFO:Comments='QB64-PE and InForm-PE port by a740g'
$VERSIONINFO:FILEVERSION#=2,6,0,0 $VERSIONINFO:FILEVERSION#=2,6,0,0
$VERSIONINFO:PRODUCTVERSION#=2,6,0,0 $VERSIONINFO:PRODUCTVERSION#=2,6,0,0
OPTION _EXPLICIT OPTION _EXPLICIT
$EXEICON:'./BIN2INCLUDE.ico' $EXEICON:'./BIN2INCLUDE.ico'
_TITLE "BIN2INCLUDE"
': Controls' IDs: ------------------------------------------------------------------ ': Controls' IDs: ------------------------------------------------------------------
DIM SHARED BIN2INCLUDE AS LONG DIM SHARED BIN2INCLUDE AS LONG
@ -34,22 +33,21 @@ DIM SHARED PIC2MEMRB AS LONG
DIM SHARED ResetBT AS LONG DIM SHARED ResetBT AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'BIN2INCLUDE.frm' '$INCLUDE:'BIN2INCLUDE.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
': Custom procedures: -------------------------------------------------------------- ': 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$) FUNCTION checkExt%% (OFile$)
IF UCASE$(RIGHT$(OFile$, 4)) <> ".BMP" AND UCASE$(RIGHT$(OFile$, 4)) <> ".JPG" _ 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)) <> ".PNG" AND UCASE$(RIGHT$(OFile$, 5)) <> ".JPEG" _
AND UCASE$(RIGHT$(OFile$, 4)) <> ".GIF" THEN AND UCASE$(RIGHT$(OFile$, 4)) <> ".GIF" THEN
checkExt = False checkExt = FALSE
ELSE ELSE
checkExt = True checkExt = TRUE
END IF END IF
END FUNCTION END FUNCTION
@ -184,10 +182,10 @@ SUB bin2bas (IN$, OUT$)
ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$ ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$
Text(SelectedFileTB) = "" Text(SelectedFileTB) = ""
Text(OutputFileTB) = "" Text(OutputFileTB) = ""
Control(CONVERTBT).Disabled = True Control(CONVERTBT).Disabled = TRUE
Control(OpenBT).Disabled = True Control(OpenBT).Disabled = TRUE
Control(BIN2BASRB).Value = False Control(BIN2BASRB).Value = FALSE
Control(PIC2MEMRB).Value = False Control(PIC2MEMRB).Value = FALSE
END IF END IF
END SUB END SUB
@ -295,10 +293,10 @@ SUB pic2mem (IN$, OUT$)
ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$ ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$
Text(SelectedFileTB) = "" Text(SelectedFileTB) = ""
Text(OutputFileTB) = "" Text(OutputFileTB) = ""
Control(CONVERTBT).Disabled = True Control(CONVERTBT).Disabled = TRUE
Control(OpenBT).Disabled = True Control(OpenBT).Disabled = TRUE
Control(BIN2BASRB).Value = False Control(BIN2BASRB).Value = FALSE
Control(PIC2MEMRB).Value = False Control(PIC2MEMRB).Value = FALSE
END SUB END SUB
FUNCTION __opensmall& FUNCTION __opensmall&
@ -516,7 +514,7 @@ SUB __UI_OnLoad
Control(CONVERTBT).HelperCanvas = __convert& Control(CONVERTBT).HelperCanvas = __convert&
Control(ResetBT).HelperCanvas = __reset& Control(ResetBT).HelperCanvas = __reset&
Control(ClearLogBT).HelperCanvas = __deletesmall& Control(ClearLogBT).HelperCanvas = __deletesmall&
Control(OpenBT).Disabled = True Control(OpenBT).Disabled = TRUE
SetFrameRate 60 SetFrameRate 60
_ACCEPTFILEDROP _ACCEPTFILEDROP
AddItem ListBox1, "Open a file above or drag and drop." AddItem ListBox1, "Open a file above or drag and drop."
@ -529,20 +527,20 @@ SUB __UI_BeforeUpdateDisplay
IF _TOTALDROPPEDFILES THEN IF _TOTALDROPPEDFILES THEN
DIM drop$: drop$ = _DROPPEDFILE DIM drop$: drop$ = _DROPPEDFILE
IF _FILEEXISTS(drop$) THEN IF _FILEEXISTS(drop$) THEN
IF NOT checkExt(drop$) AND Control(PIC2MEMRB).Value = False THEN IF NOT checkExt(drop$) AND Control(PIC2MEMRB).Value = FALSE THEN
Control(BIN2BASRB).Value = True Control(BIN2BASRB).Value = TRUE
Control(PIC2MEMRB).Disabled = True Control(PIC2MEMRB).Disabled = TRUE
Text(SelectedFileTB) = drop$ Text(SelectedFileTB) = drop$
Text(OutputFileTB) = drop$ + ".BM" Text(OutputFileTB) = drop$ + ".BM"
Control(CONVERTBT).Disabled = False Control(CONVERTBT).Disabled = FALSE
ELSEIF checkExt(drop$) AND Control(PIC2MEMRB).Value = True THEN ELSEIF checkExt(drop$) AND Control(PIC2MEMRB).Value = TRUE THEN
Control(BIN2BASRB).Disabled = True Control(BIN2BASRB).Disabled = TRUE
Text(SelectedFileTB) = drop$ Text(SelectedFileTB) = drop$
Text(OutputFileTB) = drop$ + ".MEM" Text(OutputFileTB) = drop$ + ".MEM"
Control(CONVERTBT).Disabled = False Control(CONVERTBT).Disabled = FALSE
ELSEIF checkExt(drop$) = 0 AND Control(PIC2MEMRB).Value = True THEN ELSEIF checkExt(drop$) = 0 AND Control(PIC2MEMRB).Value = TRUE THEN
MessageBox "Unsupported file type for PIC2MEM", _TITLE$, "warning" MessageBox "Unsupported file type for PIC2MEM", Caption(BIN2INCLUDE), MsgBox_Critical
Control(BIN2BASRB).Disabled = False Control(BIN2BASRB).Disabled = FALSE
END IF END IF
END IF END IF
END IF END IF
@ -556,48 +554,48 @@ SUB __UI_Click (id AS LONG)
CASE BIN2INCLUDE CASE BIN2INCLUDE
CASE SelectedFileTB CASE SelectedFileTB
CASE OpenBT CASE OpenBT
IF Control(BIN2BASRB).Value = True THEN 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 _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$) DIM oFile$: oFile$ = _OPENFILEDIALOG$(Caption(BIN2INCLUDE) + ": Open")
Control(PIC2MEMRB).Disabled = True Control(PIC2MEMRB).Disabled = TRUE
ELSEIF Control(PIC2MEMRB).Value = True THEN 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 _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") oFile$ = _OPENFILEDIALOG$(Caption(BIN2INCLUDE) + ": Open", , "*.BMP|*.bmp|*.JPG|*.jpg|*.JPEG|*.jpeg|*.PNG|*.png|*.GIF|*.gif", "Supported image files")
Control(BIN2BASRB).Disabled = True Control(BIN2BASRB).Disabled = TRUE
END IF END IF
IF oFile$ <> "" THEN IF oFile$ <> "" THEN
IF checkExt(oFile$) = 0 AND Control(PIC2MEMRB).Value = True THEN IF checkExt(oFile$) = 0 AND Control(PIC2MEMRB).Value = TRUE THEN
MessageBox "Unsupported file type for PIC2MEM", _TITLE$, "warning" MessageBox "Unsupported file type for PIC2MEM", Caption(BIN2INCLUDE), MsgBox_Critical
Control(BIN2BASRB).Disabled = False Control(BIN2BASRB).Disabled = FALSE
ELSEIF checkExt(oFile$) AND Control(PIC2MEMRB).Value = True THEN ELSEIF checkExt(oFile$) AND Control(PIC2MEMRB).Value = TRUE THEN
Control(CONVERTBT).Disabled = False Control(CONVERTBT).Disabled = FALSE
Text(SelectedFileTB) = oFile$ Text(SelectedFileTB) = oFile$
Text(OutputFileTB) = oFile$ + ".MEM" Text(OutputFileTB) = oFile$ + ".MEM"
ELSE ELSE
Control(CONVERTBT).Disabled = False Control(CONVERTBT).Disabled = FALSE
Text(SelectedFileTB) = oFile$ Text(SelectedFileTB) = oFile$
Text(OutputFileTB) = oFile$ + ".BM" Text(OutputFileTB) = oFile$ + ".BM"
END IF END IF
ELSE ELSE
Text(SelectedFileTB) = "" Text(SelectedFileTB) = ""
Text(OutputFileTB) = "" Text(OutputFileTB) = ""
Control(BIN2BASRB).Disabled = False Control(BIN2BASRB).Disabled = FALSE
Control(PIC2MEMRB).Disabled = False Control(PIC2MEMRB).Disabled = FALSE
Control(CONVERTBT).Disabled = True Control(CONVERTBT).Disabled = TRUE
END IF END IF
CASE CONVERTBT CASE CONVERTBT
IF Control(BIN2BASRB).Value = True THEN IF Control(BIN2BASRB).Value = TRUE THEN
_TITLE _TITLE$ + " - WORKING..." Caption(BIN2INCLUDE) = Caption(BIN2INCLUDE) + " - WORKING..."
bin2bas Text(SelectedFileTB), Text(OutputFileTB) bin2bas Text(SelectedFileTB), Text(OutputFileTB)
Control(PIC2MEMRB).Disabled = False Control(PIC2MEMRB).Disabled = FALSE
_TITLE "BIN2INCLUDE" Caption(BIN2INCLUDE) = "BIN2INCLUDE"
ELSEIF Control(PIC2MEMRB).Value = True THEN ELSEIF Control(PIC2MEMRB).Value = TRUE THEN
_TITLE _TITLE$ + " - WORKING..." Caption(BIN2INCLUDE) = Caption(BIN2INCLUDE) + " - WORKING..."
pic2mem Text(SelectedFileTB), Text(OutputFileTB) pic2mem Text(SelectedFileTB), Text(OutputFileTB)
Control(BIN2BASRB).Disabled = False Control(BIN2BASRB).Disabled = FALSE
_TITLE "BIN2INCLUDE" Caption(BIN2INCLUDE) = "BIN2INCLUDE"
ELSE ELSE
MessageBox "Select an option BIN2BAS or PIC2MEM first.", _TITLE$, "error" MessageBox "Select an option BIN2BAS or PIC2MEM first.", Caption(BIN2INCLUDE), MsgBox_Exclamation
END IF END IF
CASE OutputFileTB CASE OutputFileTB
CASE ListBox1 CASE ListBox1
@ -611,9 +609,9 @@ END SUB
SUB ResetScreen SUB ResetScreen
Text(SelectedFileTB) = "" Text(SelectedFileTB) = ""
Text(OutputFileTB) = "" Text(OutputFileTB) = ""
Control(BIN2BASRB).Disabled = False Control(BIN2BASRB).Disabled = FALSE
Control(PIC2MEMRB).Disabled = False Control(PIC2MEMRB).Disabled = FALSE
Control(CONVERTBT).Disabled = True Control(CONVERTBT).Disabled = TRUE
ToolTip(ListBox1) = "" ToolTip(ListBox1) = ""
END SUB END SUB
@ -708,16 +706,13 @@ SUB __UI_ValueChanged (id AS LONG)
SELECT CASE id SELECT CASE id
CASE ListBox1 CASE ListBox1
CASE BIN2BASRB CASE BIN2BASRB
Control(OpenBT).Disabled = False Control(OpenBT).Disabled = FALSE
_TITLE "BIN2INCLUDE - BIN2BAS" _TITLE "BIN2INCLUDE - BIN2BAS"
CASE PIC2MEMRB CASE PIC2MEMRB
Control(OpenBT).Disabled = False Control(OpenBT).Disabled = FALSE
_TITLE "BIN2INCLUDE - PIC2MEM" _TITLE "BIN2INCLUDE - PIC2MEM"
END SELECT END SELECT
END SUB END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -3,7 +3,7 @@
': ||__|||__|||__|||__|||__|||__|||__|||__|||__|||__|| ': ||__|||__|||__|||__|||__|||__|||__|||__|||__|||__||
': |/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\| ': |/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|
': ':
': QB64 Calculator V1.0 ': QB64 Calculator V1.1
': Terry Ritchie - 08/29/18 ': Terry Ritchie - 08/29/18
': ':
': Built as a clone of the Windows 7 standard calculator ': Built as a clone of the Windows 7 standard calculator
@ -80,8 +80,12 @@ DIM SHARED memory AS DOUBLE ' value stored in memory
DIM SHARED nohistory AS INTEGER DIM SHARED nohistory AS INTEGER
': External modules: -------------------------------------------------------------------------------------------------- ': External modules: --------------------------------------------------------------------------------------------------
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Calculator.frm' '$INCLUDE:'Calculator.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
': Program procedures: ------------------------------------------------------------------------------------------------ ': Program procedures: ------------------------------------------------------------------------------------------------
@ -134,7 +138,7 @@ SUB UPDATEOPERAND (n$) '
IF resetoperand THEN ' new operand input? IF resetoperand THEN ' new operand input?
operand$ = "" ' yes, reset operand operand$ = "" ' yes, reset operand
resetoperand = False ' reset trigger resetoperand = FALSE ' reset trigger
END IF END IF
IF n$ = "." THEN ' adding decimal point? IF n$ = "." THEN ' adding decimal point?
IF INSTR(operand$, ".") = 0 THEN ' yes, already a decimal point? IF INSTR(operand$, ".") = 0 THEN ' yes, already a decimal point?
@ -192,7 +196,7 @@ SUB COMMITOPERAND () '
END IF END IF
operand1 = VAL(operand$) ' move current total to previous value operand1 = VAL(operand$) ' move current total to previous value
previousoperator = operator ' move current operator to previous operator previousoperator = operator ' move current operator to previous operator
resetoperand = True ' trigger an operand reset resetoperand = TRUE ' trigger an operand reset
END SUB END SUB
@ -270,7 +274,7 @@ SUB ADDHISTORY (h$) '
'------------------------------------------------------------------------------------------------------------------ '------------------------------------------------------------------------------------------------------------------
IF nohistory THEN IF nohistory THEN
nohistory = False nohistory = FALSE
ELSE ELSE
history$ = history$ + h$ history$ = history$ + h$
END IF END IF
@ -341,20 +345,20 @@ SUB __UI_Click (id AS LONG)
CASE butMR ' memory recall clicked CASE butMR ' memory recall clicked
IF memory THEN ' memory available? IF memory THEN ' memory available?
operand$ = CLEAN$(memory) ' Yes, make it the current operand operand$ = CLEAN$(memory) ' Yes, make it the current operand
resetoperand = True ' trigger an operand reset resetoperand = TRUE ' trigger an operand reset
END IF END IF
CASE butMS ' memory store clicked CASE butMS ' memory store clicked
memory = VAL(operand$) ' overwrite memory with current operand memory = VAL(operand$) ' overwrite memory with current operand
resetoperand = True ' trigger an operand reset resetoperand = TRUE ' trigger an operand reset
CASE butMplus ' memory addition clicked CASE butMplus ' memory addition clicked
memory = memory + VAL(operand$) ' add current operand to memory memory = memory + VAL(operand$) ' add current operand to memory
resetoperand = True ' trigger an operand reset resetoperand = TRUE ' trigger an operand reset
CASE butMminus ' memory subtraction clicked CASE butMminus ' memory subtraction clicked
memory = memory - VAL(operand$) ' subtract current operand from memory memory = memory - VAL(operand$) ' subtract current operand from memory
resetoperand = True ' trigger an operand reset resetoperand = TRUE ' trigger an operand reset
': clear buttons: ----------------------------------------------------------------------------------------- ': clear buttons: -----------------------------------------------------------------------------------------
@ -380,7 +384,7 @@ SUB __UI_Click (id AS LONG)
IF VAL(operand$) THEN ' dividing by zero? IF VAL(operand$) THEN ' dividing by zero?
ADDHISTORY (operator$(previousoperator) + "Reciproc(" + operand$ + ")") ADDHISTORY (operator$(previousoperator) + "Reciproc(" + operand$ + ")")
nohistory = True ' skip operand history next time nohistory = TRUE ' skip operand history next time
operator = EQUATE operator = EQUATE
operand$ = CLEAN$(1 / VAL(operand$)) ' no, calculate reciprocate operand$ = CLEAN$(1 / VAL(operand$)) ' no, calculate reciprocate
@ -388,13 +392,13 @@ SUB __UI_Click (id AS LONG)
ALERT ' get user's attention ALERT ' get user's attention
operand$ = "Can't divide by zero!" ' report error to user operand$ = "Can't divide by zero!" ' report error to user
END IF END IF
resetoperand = True ' trigger an operand reset resetoperand = TRUE ' trigger an operand reset
CASE butSQR ' square root clicked CASE butSQR ' square root clicked
IF VAL(operand$) >= 0 THEN ' positive value? IF VAL(operand$) >= 0 THEN ' positive value?
ADDHISTORY (operator$(previousoperator) + "SQRT(" + operand$ + ")") ADDHISTORY (operator$(previousoperator) + "SQRT(" + operand$ + ")")
nohistory = True ' skip operand history next time nohistory = TRUE ' skip operand history next time
operator = EQUATE operator = EQUATE
operand$ = CLEAN$(SQR(VAL(operand$))) ' yes, calculate square root operand$ = CLEAN$(SQR(VAL(operand$))) ' yes, calculate square root
@ -402,11 +406,11 @@ SUB __UI_Click (id AS LONG)
ALERT ' get user's attention ALERT ' get user's attention
operand$ = "Invalid input!" ' nice try buddy operand$ = "Invalid input!" ' nice try buddy
END IF END IF
resetoperand = True ' trigger an operand reset resetoperand = TRUE ' trigger an operand reset
CASE butPercent ' percent clicked CASE butPercent ' percent clicked
operand$ = CLEAN$(operand1 * VAL(operand$) / 100) ' calculate percentage of previous operand operand$ = CLEAN$(operand1 * VAL(operand$) / 100) ' calculate percentage of previous operand
resetoperand = True resetoperand = TRUE
CASE butSign ' sign clicked CASE butSign ' sign clicked
IF VAL(operand$) THEN ' value equal to zero? IF VAL(operand$) THEN ' value equal to zero?
@ -493,7 +497,7 @@ SUB __UI_Click (id AS LONG)
CASE mnuPaste CASE mnuPaste
CASE mnuAbout CASE mnuAbout
_DELAY 0.2: _MESSAGEBOX "Calculator", "InForm Calculator 1.0", "info" MessageBox "InForm Calculator v1.1" + STRING$(2, 10) + "Terry Ritchie - 08/29/18", Caption(Calculator), MsgBox_Information
CASE lblAnswer CASE lblAnswer
@ -1028,6 +1032,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -18,6 +18,8 @@ DIM AS SINGLE CenterX, CenterY, Radius, MaxRadius
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'ClickTheVoid.frm' '$INCLUDE:'ClickTheVoid.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -177,6 +179,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -22,11 +22,13 @@ REDIM SHARED Clock%%(12, 4, 2)
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Clock Patience.frm' '$INCLUDE:'Clock Patience.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
$EXEICON:'.\clubs.ico' $EXEICON:'.\clubs.ico'
DoPatience%% = False DoPatience%% = FALSE
Anime1%% = 31 Anime1%% = 31
Anime2%% = 43 Anime2%% = 43
'Set Data 'Set Data
@ -203,7 +205,7 @@ SUB __UI_BeforeUpdateDisplay
'You can change the update frequency by calling SetFrameRate DesiredRate% 'You can change the update frequency by calling SetFrameRate DesiredRate%
STATIC Count%, InitDone%%, Grandad&, XStart%, YStart% STATIC Count%, InitDone%%, Grandad&, XStart%, YStart%
IF NOT InitDone%% THEN IF NOT InitDone%% THEN
InitDone%% = True InitDone%% = TRUE
XStart% = -120 XStart% = -120
YStart% = 0 YStart% = 0
Grandad& = _LOADIMAGE("Clock1.png", 33) Grandad& = _LOADIMAGE("Clock1.png", 33)
@ -299,9 +301,9 @@ SUB __UI_BeforeUpdateDisplay
END IF END IF
Anime1%% = Anime1%% + 1 Anime1%% = Anime1%% + 1
IF Anime1%% = 31 THEN IF Anime1%% = 31 THEN
TurnOver%% = False TurnOver%% = FALSE
Clock%%(PickedHour%%, 4, 0) = PickedCard%% Clock%%(PickedHour%%, 4, 0) = PickedCard%%
Clock%%(PickedHour%%, 4, 1) = True 'Temporary until picked up Clock%%(PickedHour%%, 4, 1) = TRUE 'Temporary until picked up
END IF END IF
ELSEIF Anime2%% < 43 THEN ELSEIF Anime2%% < 43 THEN
'Display Tucking-in 'Display Tucking-in
@ -373,7 +375,7 @@ SUB __UI_BeforeUpdateDisplay
END IF END IF
END IF END IF
Anime2%% = Anime2%% + 1 Anime2%% = Anime2%% + 1
IF Anime2%% = 43 THEN CanPutDown%% = True IF Anime2%% = 43 THEN CanPutDown%% = TRUE
ELSEIF PickedUp%% THEN ELSEIF PickedUp%% THEN
'Display picked-up card 'Display picked-up card
IF __UI_MouseLeft > 680 AND __UI_MouseTop > 738 THEN IF __UI_MouseLeft > 680 AND __UI_MouseTop > 738 THEN
@ -475,7 +477,7 @@ SUB __UI_Click (id AS LONG)
SELECT CASE id SELECT CASE id
CASE ClockPatience CASE ClockPatience
IF GreenValid%% THEN IF GreenValid%% THEN
DoPickUp%% = True DoPickUp%% = TRUE
ELSEIF RedValid%% THEN ELSEIF RedValid%% THEN
Anime2%% = 0 Anime2%% = 0
END IF END IF
@ -483,13 +485,13 @@ SUB __UI_Click (id AS LONG)
SYSTEM SYSTEM
CASE NewGameBT CASE NewGameBT
IF NOT DoPatience%% THEN IF NOT DoPatience%% THEN
Control(NewGameBT).Disabled = True Control(NewGameBT).Disabled = TRUE
Control(NewGameBT).Hidden = True Control(NewGameBT).Hidden = TRUE
Caption(NewGameBT) = "New Game" Caption(NewGameBT) = "New Game"
SetFocus ExitBT SetFocus ExitBT
CALL Patience CALL Patience
ELSE ELSE
DoPatience%% = False DoPatience%% = FALSE
Caption(NewGameBT) = "Deal" Caption(NewGameBT) = "Deal"
END IF END IF
END SELECT END SELECT
@ -537,7 +539,7 @@ END SUB
SUB Patience SUB Patience
RANDOMIZE (TIMER) RANDOMIZE (TIMER)
BadDeal%% = True BadDeal%% = TRUE
WHILE BadDeal%% WHILE BadDeal%%
REDIM Clock%%(12, 4, 2) REDIM Clock%%(12, 4, 2)
CALL Shuffle(Cards%%()) CALL Shuffle(Cards%%())
@ -547,33 +549,33 @@ SUB Patience
R%% = N%% MOD 13 R%% = N%% MOD 13
Clock%%(R%%, S%% + 1, 2) = Cards%%(N%%) Clock%%(R%%, S%% + 1, 2) = Cards%%(N%%)
NEXT N%% NEXT N%%
BadDeal%% = False BadDeal%% = FALSE
FOR M%% = 0 TO 12 'Cards are in S 1 to 4 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 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%% NEXT M%%
WEND WEND
Stock%% = 52 Stock%% = 52
Anime1%% = 31 Anime1%% = 31
Anime2%% = 43 Anime2%% = 43
TurnOver%% = True TurnOver%% = TRUE
DoPickUp%% = False DoPickUp%% = FALSE
PickedUp%% = False PickedUp%% = FALSE
PickedCard%% = 0 PickedCard%% = 0
PickedHour%% = 12 PickedHour%% = 12
CanPutDown%% = False CanPutDown%% = FALSE
IsComplete%% = False IsComplete%% = FALSE
DoPatience%% = True DoPatience%% = TRUE
HangOn%% = True HangOn%% = TRUE
HangStop%% = 50 HangStop%% = 50
HCount%% = 0 HCount%% = 0
WHILE DoPatience%% WHILE DoPatience%%
_LIMIT 60 _LIMIT 60
GreenValid%% = False GreenValid%% = FALSE
RedValid%% = False RedValid%% = FALSE
IF Stock%% = 0 AND HangOn%% THEN IF Stock%% = 0 AND HangOn%% THEN
HCount%% = HCount%% + 1 HCount%% = HCount%% + 1
IF HCount%% = HangStop%% THEN IF HCount%% = HangStop%% THEN
HangOn%% = False HangOn%% = FALSE
HCount%% = 0 HCount%% = 0
HangStop%% = 20 HangStop%% = 20
END IF END IF
@ -589,7 +591,7 @@ SUB Patience
OldHour%% = PickedHour%% OldHour%% = PickedHour%%
Anime1%% = 0 Anime1%% = 0
ELSEIF NOT DoPickUp%% AND NOT PickedUp%% THEN 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 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 ELSEIF DoPickUp%% THEN
IF PickedHour%% = 12 THEN IF PickedHour%% = 12 THEN
FOR R%% = 4 TO 2 STEP -1 FOR R%% = 4 TO 2 STEP -1
@ -611,11 +613,11 @@ SUB Patience
PickedHour%% = 0 PickedHour%% = 0
END IF END IF
Orient1! = Phi!(PickedHour%%) Orient1! = Phi!(PickedHour%%)
PickedUp%% = True PickedUp%% = TRUE
DoPickUp%% = False DoPickUp%% = FALSE
ELSEIF PickedUp%% THEN 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 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 IF NOT CanPutDown%% THEN RedValid%% = TRUE
Orient! = Orient1! 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 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! Orient! = Orient0!
@ -623,30 +625,30 @@ SUB Patience
Orient! = 0 Orient! = 0
END IF END IF
IF CanPutDown%% THEN IF CanPutDown%% THEN
CanPutDown%% = False CanPutDown%% = FALSE
PickedUp%% = False PickedUp%% = FALSE
HangOn%% = True HangOn%% = TRUE
IF PickedHour%% = 12 THEN IF PickedHour%% = 12 THEN
Clock%%(PickedHour%%, 1, 0) = PickedCard%% Clock%%(PickedHour%%, 1, 0) = PickedCard%%
Clock%%(PickedHour%%, 1, 1) = True Clock%%(PickedHour%%, 1, 1) = TRUE
ELSE ELSE
Clock%%(PickedHour%%, 0, 0) = PickedCard%% Clock%%(PickedHour%%, 0, 0) = PickedCard%%
Clock%%(PickedHour%%, 0, 1) = True Clock%%(PickedHour%%, 0, 1) = TRUE
END IF END IF
PickedCard%% = 0 PickedCard%% = 0
IF Clock%%(12, 4, 1) AND Clock%%(12, 1, 0) <> 0 THEN 'Game Finished IF Clock%%(12, 4, 1) AND Clock%%(12, 1, 0) <> 0 THEN 'Game Finished
IsComplete%% = True IsComplete%% = TRUE
Control(NewGameBT).Disabled = False Control(NewGameBT).Disabled = FALSE
Control(NewGameBT).Hidden = False Control(NewGameBT).Hidden = FALSE
SetFocus NewGameBT SetFocus NewGameBT
GotOut%% = True GotOut%% = TRUE
M%% = 0 M%% = 0
WHILE M%% <= 11 AND GotOut%% WHILE M%% <= 11 AND GotOut%%
IF NOT Clock%%(M%%, 4, 1) THEN GotOut%% = False IF NOT Clock%%(M%%, 4, 1) THEN GotOut%% = FALSE
M%% = M%% + 1 M%% = M%% + 1
WEND WEND
END IF END IF
IF NOT IsComplete%% THEN TurnOver%% = True IF NOT IsComplete%% THEN TurnOver%% = TRUE
END IF END IF
END IF END IF
END IF END IF
@ -660,6 +662,3 @@ SUB Shuffle (Pack%%()) 'Fisher Yates or Knuth shuffle
SWAP Pack%%(R%%), Pack%%(S%%) SWAP Pack%%(R%%), Pack%%(S%%)
NEXT S%% NEXT S%%
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -60,6 +60,8 @@ DIM SHARED SpiralAngle!, KeysList$, XF!, YF!, XN!, YN!, XGun!, YGun!
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Duck Shoot.frm' '$INCLUDE:'Duck Shoot.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures & Functions: --------------------------------------------------- ': Event procedures & Functions: ---------------------------------------------------
@ -74,9 +76,9 @@ END FUNCTION
SUB __UI_BeforeInit SUB __UI_BeforeInit
$EXEICON:'.\helloducky.ico' $EXEICON:'.\helloducky.ico'
AtGameStart%% = True AtGameStart%% = TRUE
StartGame%% = True StartGame%% = TRUE
SideBarIn%% = True SideBarIn%% = TRUE
KeysList$ = "abcdefghijklmnopqrstuvwxyz#',./;[\]" KeysList$ = "abcdefghijklmnopqrstuvwxyz#',./;[\]"
'Parameters!() Data Input 'Parameters!() Data Input
RESTORE level_data RESTORE level_data
@ -110,9 +112,9 @@ SUB __UI_BeforeInit
END IF END IF
GameLevel%% = ReachedLevel%% GameLevel%% = ReachedLevel%%
IF ReachedLevel%% = 7 THEN IF ReachedLevel%% = 7 THEN
SideBarFlag%% = True SideBarFlag%% = TRUE
ELSE ELSE
SideBarFlag%% = False SideBarFlag%% = FALSE
END IF END IF
AllTheFunoftheFair& = _SNDOPEN("funfair.mp3") AllTheFunoftheFair& = _SNDOPEN("funfair.mp3")
_SNDLOOP AllTheFunoftheFair& _SNDLOOP AllTheFunoftheFair&
@ -171,14 +173,14 @@ SUB __UI_OnLoad
Control(LeftHandKeysFR).Top = 400 Control(LeftHandKeysFR).Top = 400
Control(RightHandKeysFR).Left = GoldX% + 30 Control(RightHandKeysFR).Left = GoldX% + 30
Control(RightHandKeysFR).Top = 400 Control(RightHandKeysFR).Top = 400
CALL DispSetKeys((True)) CALL DispSetKeys((TRUE))
CALL DispLHKeys((True)) CALL DispLHKeys((TRUE))
CALL DispRHKeys((True)) CALL DispRHKeys((TRUE))
Control(GameLevelFR).Disabled = True Control(GameLevelFR).Disabled = TRUE
CALL ButtonLock((True)) CALL ButtonLock((TRUE))
Control(AudioOnRB).Disabled = False Control(AudioOnRB).Disabled = FALSE
Control(AudioOffRB).Disabled = False Control(AudioOffRB).Disabled = FALSE
Control(ResetBT).Disabled = False Control(ResetBT).Disabled = FALSE
Caption(ResetBT) = "Start" Caption(ResetBT) = "Start"
SetFocus ResetBT SetFocus ResetBT
CALL WriteList(0) CALL WriteList(0)
@ -203,7 +205,7 @@ SUB __UI_BeforeUpdateDisplay
STATIC Slug&, WonLevel&, ImReady&, DispLevel&, ShotsTot&, Success&, Award&, GoldenShot& STATIC Slug&, WonLevel&, ImReady&, DispLevel&, ShotsTot&, Success&, Award&, GoldenShot&
STATIC Targ1&, Pigeon&, Quacker& STATIC Targ1&, Pigeon&, Quacker&
IF NOT HereAgain%% THEN 'Load Images IF NOT HereAgain%% THEN 'Load Images
HereAgain%% = True HereAgain%% = TRUE
SideBar% = 1120 SideBar% = 1120
XErr%% = -2 XErr%% = -2
DIM Numerals&(10) DIM Numerals&(10)
@ -366,7 +368,7 @@ SUB __UI_BeforeUpdateDisplay
Pigeon& = _LOADIMAGE("pigeon1.png", 32) Pigeon& = _LOADIMAGE("pigeon1.png", 32)
END IF END IF
IF QuackInit%% THEN IF QuackInit%% THEN
QuackInit%% = False QuackInit%% = FALSE
TempImg& = _NEWIMAGE(2 * HalfWidth% + 1, 2 * HalfHeight% + 1, 32) TempImg& = _NEWIMAGE(2 * HalfWidth% + 1, 2 * HalfHeight% + 1, 32)
_DEST TempImg& _DEST TempImg&
_PUTIMAGE , Pigeon& _PUTIMAGE , Pigeon&
@ -516,27 +518,27 @@ SUB __UI_BeforeUpdateDisplay
Control(AudioFR).Left = Control(AudioFR).Left - 5 Control(AudioFR).Left = Control(AudioFR).Left - 5
Control(OptionsFR).Left = Control(OptionsFR).Left - 5 Control(OptionsFR).Left = Control(OptionsFR).Left - 5
IF SideBar% = 1120 THEN IF SideBar% = 1120 THEN
SideBarIn%% = True SideBarIn%% = TRUE
Control(GameLevelFR).Disabled = False Control(GameLevelFR).Disabled = FALSE
Control(AudioFR).Disabled = False Control(AudioFR).Disabled = FALSE
Control(OptionsFR).Disabled = False Control(OptionsFR).Disabled = FALSE
Control(ExitBT).Disabled = False Control(ExitBT).Disabled = FALSE
Control(AudioOnRB).Disabled = False Control(AudioOnRB).Disabled = FALSE
Control(AudioOffRB).Disabled = False Control(AudioOffRB).Disabled = FALSE
IF NOT SideBarFlag%% THEN CALL ButtonLock((False)) IF NOT SideBarFlag%% THEN CALL ButtonLock((FALSE))
END IF END IF
END IF END IF
ELSE ELSE
IF SideBar% < XScreen% THEN IF SideBar% < XScreen% THEN
IF SideBar% = 1120 THEN IF SideBar% = 1120 THEN
SideBarIn%% = False SideBarIn%% = FALSE
Control(GameLevelFR).Disabled = True Control(GameLevelFR).Disabled = TRUE
Control(AudioFR).Disabled = True Control(AudioFR).Disabled = TRUE
Control(OptionsFR).Disabled = True Control(OptionsFR).Disabled = TRUE
Control(ExitBT).Disabled = True Control(ExitBT).Disabled = TRUE
Control(AudioOnRB).Disabled = True Control(AudioOnRB).Disabled = TRUE
Control(AudioOffRB).Disabled = True Control(AudioOffRB).Disabled = TRUE
CALL ButtonLock((True)) CALL ButtonLock((TRUE))
END IF END IF
SideBar% = SideBar% + 5 SideBar% = SideBar% + 5
Control(GameLevelFR).Left = Control(GameLevelFR).Left + 5 Control(GameLevelFR).Left = Control(GameLevelFR).Left + 5
@ -574,27 +576,27 @@ SUB __UI_Click (id AS LONG)
IF HaveSet%% THEN CALL WeAreDone IF HaveSet%% THEN CALL WeAreDone
SYSTEM SYSTEM
ELSE ELSE
Dux%% = False Dux%% = FALSE
StartGame%% = False StartGame%% = FALSE
END IF END IF
CASE ResetBT CASE ResetBT
IF AtGameStart%% THEN IF AtGameStart%% THEN
AtGameStart%% = False AtGameStart%% = FALSE
Caption(ResetBT) = "Reset" Caption(ResetBT) = "Reset"
Control(GameLevelFR).Disabled = False Control(GameLevelFR).Disabled = FALSE
Control(AudioFR).Disabled = False Control(AudioFR).Disabled = FALSE
Control(AudioOnRB).Disabled = False Control(AudioOnRB).Disabled = FALSE
Control(AudioOffRB).Disabled = False Control(AudioOffRB).Disabled = FALSE
Control(SetKeysBT).Disabled = True Control(SetKeysBT).Disabled = TRUE
CALL ButtonLock((False)) CALL ButtonLock((FALSE))
Ready%% = True Ready%% = TRUE
CALL MadameZora CALL MadameZora
ELSE ELSE
'Reset to level 1 & reset parameters 'Reset to level 1 & reset parameters
Dux%% = False Dux%% = FALSE
ReachedLevel%% = 1 ReachedLevel%% = 1
GameLevel%% = ReachedLevel%% GameLevel%% = ReachedLevel%%
Control(Level6RB).Disabled = True Control(Level6RB).Disabled = TRUE
SetRadioButtonValue Level1RB SetRadioButtonValue Level1RB
END IF END IF
CASE RestartLevelBT CASE RestartLevelBT
@ -606,58 +608,58 @@ SUB __UI_Click (id AS LONG)
CASE Level1RB CASE Level1RB
IF GameLevel%% <> 1 THEN IF GameLevel%% <> 1 THEN
GameLevel%% = 1 GameLevel%% = 1
Dux%% = False Dux%% = FALSE
END IF END IF
CASE Level2RB CASE Level2RB
IF GameLevel%% <> 2 THEN IF GameLevel%% <> 2 THEN
GameLevel%% = 2 GameLevel%% = 2
Dux%% = False Dux%% = FALSE
END IF END IF
CASE Level3RB CASE Level3RB
IF GameLevel%% <> 3 THEN IF GameLevel%% <> 3 THEN
GameLevel%% = 3 GameLevel%% = 3
Dux%% = False Dux%% = FALSE
END IF END IF
CASE Level4RB CASE Level4RB
IF GameLevel%% <> 4 THEN IF GameLevel%% <> 4 THEN
GameLevel%% = 4 GameLevel%% = 4
Dux%% = False Dux%% = FALSE
END IF END IF
CASE Level5RB CASE Level5RB
IF GameLevel%% <> 5 THEN IF GameLevel%% <> 5 THEN
GameLevel%% = 5 GameLevel%% = 5
Dux%% = False Dux%% = FALSE
END IF END IF
CASE Level6RB CASE Level6RB
IF GameLevel%% <> 6 THEN IF GameLevel%% <> 6 THEN
GameLevel%% = 6 GameLevel%% = 6
Dux%% = False Dux%% = FALSE
END IF END IF
CASE AudioOffRB CASE AudioOffRB
_SNDSTOP AllTheFunoftheFair& _SNDSTOP AllTheFunoftheFair&
CASE AudioOnRB CASE AudioOnRB
_SNDLOOP AllTheFunoftheFair& _SNDLOOP AllTheFunoftheFair&
CASE SetKeysBT CASE SetKeysBT
Control(ResetBT).Disabled = True Control(ResetBT).Disabled = TRUE
Control(SetKeysBT).Disabled = True Control(SetKeysBT).Disabled = TRUE
CALL DispSetKeys((False)) CALL DispSetKeys((FALSE))
CALL DispLHKeys((False)) CALL DispLHKeys((FALSE))
CALL DispRHKeys((True)) CALL DispRHKeys((TRUE))
CASE DoneBT CASE DoneBT
CALL DispSetKeys((True)) CALL DispSetKeys((TRUE))
CALL DispLHKeys((True)) CALL DispLHKeys((TRUE))
CALL DispRHKeys((True)) CALL DispRHKeys((TRUE))
Control(ResetBT).Disabled = False Control(ResetBT).Disabled = FALSE
Control(SetKeysBT).Disabled = False Control(SetKeysBT).Disabled = FALSE
SetFocus ResetBT SetFocus ResetBT
CASE SetLeftHandKeysRB CASE SetLeftHandKeysRB
CALL DispLHKeys((False)) CALL DispLHKeys((FALSE))
CALL DispRHKeys((True)) CALL DispRHKeys((TRUE))
SetRadioButtonValue NearSightUpRB SetRadioButtonValue NearSightUpRB
CALL KeyList(0) CALL KeyList(0)
CASE SetRightHandKeysRB CASE SetRightHandKeysRB
CALL DispLHKeys((True)) CALL DispLHKeys((TRUE))
CALL DispRHKeys((False)) CALL DispRHKeys((FALSE))
SetRadioButtonValue FarSightUpRB SetRadioButtonValue FarSightUpRB
CALL KeyList(4) CALL KeyList(4)
CASE NearSightUpRB CASE NearSightUpRB
@ -681,7 +683,7 @@ SUB __UI_Click (id AS LONG)
CASE SetBT CASE SetBT
TheItem%% = Control(SelectKeyDD).Value TheItem%% = Control(SelectKeyDD).Value
IF TheItem%% > 0 THEN IF TheItem%% > 0 THEN
HaveSet%% = True HaveSet%% = TRUE
IF Control(SetLeftHandKeysRB).Value THEN IF Control(SetLeftHandKeysRB).Value THEN
IF Control(NearSightUpRB).Value THEN IF Control(NearSightUpRB).Value THEN
KeyCode%(0) = ASC(GetItem$(SelectKeyDD, TheItem%%)) KeyCode%(0) = ASC(GetItem$(SelectKeyDD, TheItem%%))
@ -759,9 +761,9 @@ SUB ButtonLock (OnOff%%)
Control(Level4RB).Disabled = OnOff%% Control(Level4RB).Disabled = OnOff%%
Control(Level5RB).Disabled = OnOff%% Control(Level5RB).Disabled = OnOff%%
IF OnOff%% THEN IF OnOff%% THEN
Control(Level6RB).Disabled = True Control(Level6RB).Disabled = TRUE
ELSEIF GameLevel%% = 6 OR GameLevel%% = 7 THEN ELSEIF GameLevel%% = 6 OR GameLevel%% = 7 THEN
Control(Level6RB).Disabled = False Control(Level6RB).Disabled = FALSE
END IF END IF
END SUB END SUB
@ -860,11 +862,11 @@ SUB MadameZora
XNprev! = XNDev! XNprev! = XNDev!
YNprev! = YNDev! YNprev! = YNDev!
FireCount% = CanFire% FireCount% = CanFire%
Fired%% = False Fired%% = FALSE
NoShots% = 0 NoShots% = 0
DuckCount% = 0 DuckCount% = 0
WhatLevel% = AtNextLevel% WhatLevel% = AtNextLevel%
Dux%% = True Dux%% = TRUE
WHILE Dux%% WHILE Dux%%
_LIMIT FrameRate% _LIMIT FrameRate%
IF Parameters!(GameLevel%%, 15) > 0 THEN 'Rotate Spiral IF Parameters!(GameLevel%%, 15) > 0 THEN 'Rotate Spiral
@ -943,47 +945,47 @@ SUB MadameZora
XNprev! = XNDev! XNprev! = XNDev!
IF XUp%% THEN IF XUp%% THEN
X0! = X0! + X0Step! X0! = X0! + X0Step!
IF RND > TRand! OR X0! > Parameters!(GameLevel%%, 7) THEN XUp%% = False IF RND > TRand! OR X0! > Parameters!(GameLevel%%, 7) THEN XUp%% = FALSE
ELSE ELSE
X0! = X0! - X0Step! X0! = X0! - X0Step!
IF RND > TRand! OR X0! < Parameters!(GameLevel%%, 8) THEN XUp%% = True IF RND > TRand! OR X0! < Parameters!(GameLevel%%, 8) THEN XUp%% = TRUE
END IF END IF
IF O0Up%% THEN IF O0Up%% THEN
Omega0! = Omega0! + O0Step! Omega0! = Omega0! + O0Step!
IF RND > TRand! OR Omega0! > Parameters!(GameLevel%%, 9) THEN O0Up%% = False IF RND > TRand! OR Omega0! > Parameters!(GameLevel%%, 9) THEN O0Up%% = FALSE
ELSE ELSE
Omega0! = Omega0! - O0Step! Omega0! = Omega0! - O0Step!
IF RND > TRand! OR Omega0! < Parameters!(GameLevel%%, 10) THEN O0Up%% = True IF RND > TRand! OR Omega0! < Parameters!(GameLevel%%, 10) THEN O0Up%% = TRUE
END IF END IF
YNDev! = Y0! * SIN(Omega1! * Count1%) YNDev! = Y0! * SIN(Omega1! * Count1%)
YNDelta! = YNDev! - YNprev! YNDelta! = YNDev! - YNprev!
YNprev! = YNDev! YNprev! = YNDev!
IF YUp%% THEN IF YUp%% THEN
Y0! = Y0! + Y0Step! Y0! = Y0! + Y0Step!
IF RND > TRand! OR Y0! > Parameters!(GameLevel%%, 11) THEN YUp%% = False IF RND > TRand! OR Y0! > Parameters!(GameLevel%%, 11) THEN YUp%% = FALSE
ELSE ELSE
Y0! = Y0! - Y0Step! Y0! = Y0! - Y0Step!
IF RND > TRand! OR Y0! < Parameters!(GameLevel%%, 12) THEN YUp%% = True IF RND > TRand! OR Y0! < Parameters!(GameLevel%%, 12) THEN YUp%% = TRUE
END IF END IF
IF O1Up%% THEN IF O1Up%% THEN
Omega1! = Omega1! + O1Step! Omega1! = Omega1! + O1Step!
IF RND > TRand! OR Omega1! > Parameters!(GameLevel%%, 13) THEN O1Up%% = False IF RND > TRand! OR Omega1! > Parameters!(GameLevel%%, 13) THEN O1Up%% = FALSE
ELSE ELSE
Omega1! = Omega1! - O1Step! Omega1! = Omega1! - O1Step!
IF RND > TRand! OR Omega1! < Parameters!(GameLevel%%, 14) THEN O1Up%% = True IF RND > TRand! OR Omega1! < Parameters!(GameLevel%%, 14) THEN O1Up%% = TRUE
END IF END IF
ELSE ELSE
IF AwardAnim% = 0 THEN _SNDPLAYFILE "fanfare.mp3" IF AwardAnim% = 0 THEN _SNDPLAYFILE "fanfare.mp3"
IF AwardAnim% < 4 * 192 THEN IF AwardAnim% < 4 * 192 THEN
AwardAnim% = AwardAnim% + 1 AwardAnim% = AwardAnim% + 1
ELSEIF SideBarFlag%% THEN ELSEIF SideBarFlag%% THEN
IF SideBarIn%% THEN CALL ButtonLock((False)) IF SideBarIn%% THEN CALL ButtonLock((FALSE))
SideBarFlag%% = False SideBarFlag%% = FALSE
END IF END IF
END IF END IF
IF _KEYDOWN(27) THEN IF _KEYDOWN(27) THEN
Dux%% = False Dux%% = FALSE
StartGame%% = False StartGame%% = FALSE
ELSEIF GameLevel%% <= 6 AND Ready%% THEN ELSEIF GameLevel%% <= 6 AND Ready%% THEN
IF _KEYDOWN(KeyCode%(0)) THEN YN! = YN! - PosStep! 'Up (Default w) IF _KEYDOWN(KeyCode%(0)) THEN YN! = YN! - PosStep! 'Up (Default w)
IF _KEYDOWN(KeyCode%(1)) THEN YN! = YN! + PosStep! 'Down (Default z) IF _KEYDOWN(KeyCode%(1)) THEN YN! = YN! + PosStep! 'Down (Default z)
@ -996,7 +998,7 @@ SUB MadameZora
IF _KEYDOWN(KeyCode%(8)) AND FireCount% = CanFire% THEN 'Fire (Default s) IF _KEYDOWN(KeyCode%(8)) AND FireCount% = CanFire% THEN 'Fire (Default s)
_SNDPLAYFILE "22handgun.mp3" _SNDPLAYFILE "22handgun.mp3"
FireCount% = 0 FireCount% = 0
Fired%% = True Fired%% = TRUE
ZGun! = 0 ZGun! = 0
XGun! = XF! XGun! = XF!
YGun! = YF! YGun! = YF!
@ -1048,11 +1050,11 @@ SUB MadameZora
NoShots% = 0 NoShots% = 0
DuckCount% = 0 DuckCount% = 0
WhatLevel% = 0 WhatLevel% = 0
Ready%% = False Ready%% = FALSE
Control(AudioFR).Disabled = True Control(AudioFR).Disabled = TRUE
Control(GameLevelFR).Disabled = True Control(GameLevelFR).Disabled = TRUE
CALL ButtonLock((True)) CALL ButtonLock((TRUE))
SideBarFlag%% = True SideBarFlag%% = TRUE
END IF END IF
N%% = 6 N%% = 6
ELSE ELSE
@ -1063,7 +1065,7 @@ SUB MadameZora
END IF END IF
WEND WEND
END IF END IF
Fired%% = False Fired%% = FALSE
END IF END IF
END IF END IF
IF WhatLevel% < AtNextLevel% THEN IF WhatLevel% < AtNextLevel% THEN
@ -1085,13 +1087,13 @@ SUB MadameZora
ReachedLevel%% = ReachedLevel%% + 1 ReachedLevel%% = ReachedLevel%% + 1
ELSE ELSE
ReachedLevel%% = 7 ReachedLevel%% = 7
Control(Level6RB).Disabled = False Control(Level6RB).Disabled = FALSE
END IF END IF
GameLevel%% = ReachedLevel%% GameLevel%% = ReachedLevel%%
CALL InitParams(X0Step!, Y0Step!, O0Step!, O1Step!, Omega!, X0!, Omega0!, Y0!, Omega1!) CALL InitParams(X0Step!, Y0Step!, O0Step!, O1Step!, Omega!, X0!, Omega0!, Y0!, Omega1!)
Ready%% = True Ready%% = TRUE
IF SideBarIn%% THEN CALL ButtonLock((False)) IF SideBarIn%% THEN CALL ButtonLock((FALSE))
SideBarFlag%% = False SideBarFlag%% = FALSE
END IF END IF
END IF END IF
END IF END IF
@ -1109,7 +1111,7 @@ SUB Rotor (XIn!, YIn!, XOut!, YOut!, Theta!)
END SUB END SUB
SUB InitParams (X00Step!, Y00Step!, O00Step!, O10Step!, Mega!, X00!, Omega00!, Y00!, Omega10!) SUB InitParams (X00Step!, Y00Step!, O00Step!, O10Step!, Mega!, X00!, Omega00!, Y00!, Omega10!)
QuackInit%% = True QuackInit%% = TRUE
X00Step! = (Parameters!(GameLevel%%, 7) - Parameters!(GameLevel%%, 8)) / (15 * FrameRate%) X00Step! = (Parameters!(GameLevel%%, 7) - Parameters!(GameLevel%%, 8)) / (15 * FrameRate%)
Y00Step! = (Parameters!(GameLevel%%, 11) - Parameters!(GameLevel%%, 12)) / (15 * FrameRate%) Y00Step! = (Parameters!(GameLevel%%, 11) - Parameters!(GameLevel%%, 12)) / (15 * FrameRate%)
O00Step! = (Parameters!(GameLevel%%, 9) - Parameters!(GameLevel%%, 10)) / (30 * FrameRate%) O00Step! = (Parameters!(GameLevel%%, 9) - Parameters!(GameLevel%%, 10)) / (30 * FrameRate%)
@ -1132,6 +1134,3 @@ SUB WeAreDone
PRINT #1, ReachedLevel%% PRINT #1, ReachedLevel%%
CLOSE #1 CLOSE #1
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -32,6 +32,8 @@ CONST TT% = 38, TB% = 668, FL% = 82, FR% = 106, CL% = 321, CR% = 345
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Fahrenheit-Celsius.frm' '$INCLUDE:'Fahrenheit-Celsius.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Functions: ---------------------------------------------------------------------- ': Functions: ----------------------------------------------------------------------
FUNCTION FTOC! (T!, Deg%%) FUNCTION FTOC! (T!, Deg%%)
@ -74,7 +76,7 @@ SUB __UI_BeforeUpdateDisplay
IF NOT InitDone%% THEN IF NOT InitDone%% THEN
': Everything (except events) is done in the __UI_BeforeUpdateDisplay SUB ': Everything (except events) is done in the __UI_BeforeUpdateDisplay SUB
': All initiations, image loading & manipulations are done once here ': All initiations, image loading & manipulations are done once here
InitDone%% = True InitDone%% = TRUE
DIM Pics&(1, 4), TRange!(1, 3) DIM Pics&(1, 4), TRange!(1, 3)
': Read temperature Ranges ': Read temperature Ranges
RESTORE temp_range RESTORE temp_range
@ -151,7 +153,7 @@ SUB __UI_BeforeUpdateDisplay
IF OldScale%% THEN IF OldScale%% THEN
': Body Temperature Scales ': Body Temperature Scales
FSetTemp! = 98.4 FSetTemp! = 98.4
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, True)) CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE))
Text(FahrenheitTB) = IText$(FSetTemp!) Text(FahrenheitTB) = IText$(FSetTemp!)
Text(CelsiusTB) = IText$(CSetTemp!) Text(CelsiusTB) = IText$(CSetTemp!)
FT% = 44 FT% = 44
@ -217,18 +219,18 @@ SUB __UI_BeforeUpdateDisplay
END IF END IF
NEXT N% NEXT N%
EndDraw CelsiusPBox EndDraw CelsiusPBox
PicUpdate%% = True PicUpdate%% = TRUE
END IF END IF
': Poll Mouse ': Poll Mouse
LM% = __UI_MouseLeft LM% = __UI_MouseLeft
TM% = __UI_MouseTop TM% = __UI_MouseTop
': Look for position inside thermometer tubes and check Click ': 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 IF LM% > 70 + TFPos% AND LM% < 70 + TFPos% + 24 AND TM% > FT% AND TM% < FB% THEN
InFahrenheit%% = True InFahrenheit%% = TRUE
TempT! = OnePlace!(FTMax% + ((TM% - FT%) * (FTMin% - FTMax%) / (FB% - FT%))) TempT! = OnePlace!(FTMax% + ((TM% - FT%) * (FTMin% - FTMax%) / (FB% - FT%)))
IF NOT TClicked%% THEN Text(FahrenheitTB) = IText$(TempT!) IF NOT TClicked%% THEN Text(FahrenheitTB) = IText$(TempT!)
ELSEIF LM% > 290 + TCPos% AND LM% < 290 + TCPos% + 24 AND TM% > CT% AND TM% < CB% THEN ELSEIF LM% > 290 + TCPos% AND LM% < 290 + TCPos% + 24 AND TM% > CT% AND TM% < CB% THEN
InCelsius%% = True InCelsius%% = TRUE
TempT! = OnePlace!(CTMax% + (TM% - CT%) * (CTMin% - CTMax%) / (CB% - CT%)) TempT! = OnePlace!(CTMax% + (TM% - CT%) * (CTMin% - CTMax%) / (CB% - CT%))
IF NOT TClicked%% THEN Text(CelsiusTB) = IText$(TempT!) IF NOT TClicked%% THEN Text(CelsiusTB) = IText$(TempT!)
ELSE ELSE
@ -237,13 +239,13 @@ SUB __UI_BeforeUpdateDisplay
ELSEIF InCelsius%% AND NOT TClicked%% THEN ELSEIF InCelsius%% AND NOT TClicked%% THEN
Text(CelsiusTB) = IText$(CSetTemp!) Text(CelsiusTB) = IText$(CSetTemp!)
END IF END IF
InFahrenheit%% = False InFahrenheit%% = FALSE
InCelsius%% = False InCelsius%% = FALSE
IF TClicked%% THEN TClicked%% = False IF TClicked%% THEN TClicked%% = FALSE
END IF END IF
': Update thermometers ': Update thermometers
IF PicUpdate%% THEN IF PicUpdate%% THEN
PicUpdate%% = False PicUpdate%% = FALSE
YF% = FT% + (FSetTemp! - FTMax%) * (FB% - FT%) / (FTMin% - FTMax%) YF% = FT% + (FSetTemp! - FTMax%) * (FB% - FT%) / (FTMin% - FTMax%)
YC% = CT% + (CSetTemp! - CTMax%) * (CB% - CT%) / (CTMin% - CTMax%) YC% = CT% + (CSetTemp! - CTMax%) * (CB% - CT%) / (CTMin% - CTMax%)
BeginDraw FahrenheitPBox BeginDraw FahrenheitPBox
@ -334,26 +336,26 @@ SUB __UI_Click (id AS LONG)
CASE FahrenheitPBox CASE FahrenheitPBox
': Check for click in thermometer columns ': Check for click in thermometer columns
IF InFahrenheit%% AND NOT TClicked%% THEN IF InFahrenheit%% AND NOT TClicked%% THEN
TClicked%% = True TClicked%% = TRUE
FSetTemp! = OnePlace!(TempT!) FSetTemp! = OnePlace!(TempT!)
Text(FahrenheitTB) = IText$(FSetTemp!) Text(FahrenheitTB) = IText$(FSetTemp!)
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, True)) CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE))
Text(CelsiusTB) = IText$(CSetTemp!) Text(CelsiusTB) = IText$(CSetTemp!)
PicUpdate%% = True PicUpdate%% = TRUE
END IF END IF
CASE CelsiusPBox CASE CelsiusPBox
': Check for click in thermometer columns ': Check for click in thermometer columns
IF InCelsius%% AND NOT TClicked%% THEN IF InCelsius%% AND NOT TClicked%% THEN
TClicked%% = True TClicked%% = TRUE
CSetTemp! = OnePlace!(TempT!) CSetTemp! = OnePlace!(TempT!)
Text(CelsiusTB) = IText$(CSetTemp!) Text(CelsiusTB) = IText$(CSetTemp!)
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, False)) FSetTemp! = OnePlace!(FTOC!(CSetTemp!, FALSE))
Text(FahrenheitTB) = IText$(FSetTemp!) Text(FahrenheitTB) = IText$(FSetTemp!)
PicUpdate%% = True PicUpdate%% = TRUE
END IF END IF
CASE FixTextBoxesTS CASE FixTextBoxesTS
': Check for Toggle Switch Click ': Check for Toggle Switch Click
PicUpdate%% = True PicUpdate%% = TRUE
CASE ExitBT CASE ExitBT
': Click Exit Button ': Click Exit Button
SYSTEM SYSTEM
@ -397,16 +399,16 @@ SUB __UI_KeyPress (id AS LONG)
': Update Fahrenheit temperature & convert ': Update Fahrenheit temperature & convert
FSetTemp! = OnePlace!(VAL(Text(FahrenheitTB))) FSetTemp! = OnePlace!(VAL(Text(FahrenheitTB)))
Text(FahrenheitTB) = IText$(FSetTemp!) Text(FahrenheitTB) = IText$(FSetTemp!)
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, True)) CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE))
Text(CelsiusTB) = IText$(CSetTemp!) Text(CelsiusTB) = IText$(CSetTemp!)
PicUpdate%% = True PicUpdate%% = TRUE
CASE CelsiusTB CASE CelsiusTB
': Update Celsius temperature & convert ': Update Celsius temperature & convert
CSetTemp! = OnePlace!(VAL(Text(CelsiusTB))) CSetTemp! = OnePlace!(VAL(Text(CelsiusTB)))
Text(CelsiusTB) = IText$(CSetTemp!) Text(CelsiusTB) = IText$(CSetTemp!)
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, False)) FSetTemp! = OnePlace!(FTOC!(CSetTemp!, FALSE))
Text(FahrenheitTB) = IText$(FSetTemp!) Text(FahrenheitTB) = IText$(FSetTemp!)
PicUpdate%% = True PicUpdate%% = TRUE
CASE ExitBT CASE ExitBT
SYSTEM 'Does this condition ever get met? SYSTEM 'Does this condition ever get met?
END SELECT END SELECT
@ -421,6 +423,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -55,6 +55,8 @@ DIM SHARED HappyNewYearLB AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Fireworks.frm' '$INCLUDE:'Fireworks.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -82,28 +84,28 @@ SUB __UI_BeforeUpdateDisplay
_DEST Control(Canvas).HelperCanvas _DEST Control(Canvas).HelperCanvas
IF JustExploded THEN IF JustExploded THEN
JustExploded = False JustExploded = FALSE
CLS , _RGB32(0, 0, 50) CLS , _RGB32(0, 0, 50)
ELSE ELSE
CLS CLS
END IF END IF
IF _CEIL(RND * 20) < 2 OR (Initial = False AND TIMER - lastInitial# > .1) THEN IF _CEIL(RND * 20) < 2 OR (Initial = FALSE AND TIMER - lastInitial# > .1) THEN
'Create a new particle 'Create a new particle
FOR j = 1 TO UBOUND(Firework) FOR j = 1 TO UBOUND(Firework)
IF Firework(j).Visible = False THEN IF Firework(j).Visible = FALSE THEN
Firework(j).Vel.y = InitialVel Firework(j).Vel.y = InitialVel
Firework(j).Vel.x = 3 - _CEIL(RND * 6) Firework(j).Vel.x = 3 - _CEIL(RND * 6)
IF Initial = True THEN IF Initial = TRUE THEN
Firework(j).Pos.x = _CEIL(RND * Control(Canvas).Width) Firework(j).Pos.x = _CEIL(RND * Control(Canvas).Width)
ELSE ELSE
Firework(j).Pos.x = InitialX * (Control(Canvas).Width / 15) Firework(j).Pos.x = InitialX * (Control(Canvas).Width / 15)
InitialX = InitialX + 1 InitialX = InitialX + 1
lastInitial# = TIMER lastInitial# = TIMER
IF InitialX > 15 THEN Initial = True IF InitialX > 15 THEN Initial = TRUE
END IF END IF
Firework(j).Pos.y = Control(Canvas).Height + _CEIL(RND * StartPointLimit) Firework(j).Pos.y = Control(Canvas).Height + _CEIL(RND * StartPointLimit)
Firework(j).Visible = True Firework(j).Visible = TRUE
Firework(j).Exploded = False Firework(j).Exploded = FALSE
Firework(j).ExplosionStep = 0 Firework(j).ExplosionStep = 0
Firework(j).Size = _CEIL(RND * 2) Firework(j).Size = _CEIL(RND * 2)
IF Firework(j).Size = 1 THEN IF Firework(j).Size = 1 THEN
@ -135,7 +137,7 @@ SUB __UI_BeforeUpdateDisplay
FOR i = 1 TO UBOUND(Firework) FOR i = 1 TO UBOUND(Firework)
'Update trail particles 'Update trail particles
IF Firework(i).Visible = True AND Firework(i).Exploded = False AND NOT Pause THEN IF Firework(i).Visible = TRUE AND Firework(i).Exploded = FALSE AND NOT Pause THEN
t = t + 1: IF t > UBOUND(Trail) THEN t = 1 t = t + 1: IF t > UBOUND(Trail) THEN t = 1
Trail(t).Pos.x = Firework(i).Pos.x Trail(t).Pos.x = Firework(i).Pos.x
Trail(t).Pos.y = Firework(i).Pos.y Trail(t).Pos.y = Firework(i).Pos.y
@ -149,9 +151,9 @@ SUB __UI_BeforeUpdateDisplay
'Explode the particle if it reaches max height 'Explode the particle if it reaches max height
IF Firework(i).Vel.y > 0 THEN IF Firework(i).Vel.y > 0 THEN
IF Firework(i).Exploded = False THEN IF Firework(i).Exploded = FALSE THEN
Firework(i).Exploded = True Firework(i).Exploded = TRUE
JustExploded = True JustExploded = TRUE
IF Firework(1).Size = 1 THEN IF Firework(1).Size = 1 THEN
IF distant THEN _SNDPLAYCOPY distant, .5 IF distant THEN _SNDPLAYCOPY distant, .5
@ -180,7 +182,7 @@ SUB __UI_BeforeUpdateDisplay
END IF END IF
'Show particle 'Show particle
IF Firework(i).Exploded = False THEN IF Firework(i).Exploded = FALSE THEN
IF Firework(i).Size = 1 THEN IF Firework(i).Size = 1 THEN
PSET (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255) PSET (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
ELSE ELSE
@ -223,7 +225,7 @@ SUB __UI_BeforeUpdateDisplay
Boom(i * 2, j).Pos.y = Boom(i * 2, j).Pos.y + Boom(i * 2, j).Vel.y Boom(i * 2, j).Pos.y = Boom(i * 2, j).Pos.y + Boom(i * 2, j).Vel.y
END IF END IF
NEXT NEXT
IF Firework(i).ExplosionStep > Firework(i).ExplosionMax THEN Firework(i).Visible = False IF Firework(i).ExplosionStep > Firework(i).ExplosionMax THEN Firework(i).Visible = FALSE
END IF END IF
NEXT NEXT
@ -419,6 +421,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -19,6 +19,10 @@ DIM SHARED PlayBT AS LONG
'$INCLUDE:'../../InForm/extensions/MessageBox.bi' '$INCLUDE:'../../InForm/extensions/MessageBox.bi'
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'GIFPlaySample.frm' '$INCLUDE:'GIFPlaySample.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
'$INCLUDE:'../../InForm/extensions/GIFPlay.bas'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -29,7 +33,7 @@ SUB __UI_OnLoad
END SUB END SUB
SUB __UI_BeforeUpdateDisplay SUB __UI_BeforeUpdateDisplay
IF GIF_IsLoaded(PictureBox1) THEN GIF_Draw PictureBox1 GIF_Draw PictureBox1
END SUB END SUB
SUB __UI_BeforeUnload SUB __UI_BeforeUnload
@ -107,8 +111,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
'$INCLUDE:'../../InForm/extensions/GIFPlay.bas'

File diff suppressed because it is too large Load diff

View file

@ -1,382 +0,0 @@
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

View file

@ -0,0 +1,29 @@
0
"0","0","1"
-1,"10","0","100000"
"6.67385E-11",2.510229E+09,-.3141593
11,-1982.498,0,0,2,197,35
1.98892D+30,-538112567.9604666,7554644.765577328,-203908116.6669675,-2.182986623531264,-.1699657074401263,10.58818131181605
4294967040
3.5845D+23,2913692676.691906,-4491945046.856153,51963799784.24772,50780.22626750105,5309.274762828416,-12621.22994526021
4290495994
4.8988D+24,74660982775.91447,-3434904765.842053,77466308620.96271,25015.64117526715,1756.261709035665,-24454.79802384456
4294944050
5.9742D+24,146359866670.5584,-8353162.337369423,-7912268509.88724,-1665.711632745332,-.6323813803871251,-30239.86026616674
4278190335
6.419100000000001D+23,62518461530.17378,-3600758543.826663,201236142398.6484,25192.87653521406,682.4686084282313,-6301.380168221991
4294901760
1.8991D+27,762001772781.053,-4343017366.68526,51737153688.81822,1491.761978109104,289.0814483316457,-13203.96418049961
4294948545
5.6862D+26,-1434061926970.846,7356245877.587486,441046873016.8041,2817.186463746964,-395.6302362011992,8710.806660861765
4289506476
8.6805D+25,830292864092.963,36810149734.84278,-2606128867877.125,-6810.711799016078,2.233224410383157,-2118.5830394381
4288267494
1.0248D+26,3512387767526.288,-136111326071.126,2745584180772.603,3381.292095379543,29.6772130680539,-4314.67657982337
4282477025
1.195D+22,-2380653450174.495,-1360804141670.56,5539260856667.617,3600.274092990303,-1129.957079122482,2546.122658332953
4292571283
7.36D+22,146130629258.681,-30212781.12577476,-8202035433.0457,-2453.879695271887,78.2732571637534,-29535.01082635417
4292664512
8.7D+17,770565889837.0925,-7921398567.083032,56078165347.58346,-856.6449606877907,-1045.108334373004,-10518.4469484654
4284119160

View file

@ -18,6 +18,8 @@ DIM SHARED Drawing AS _BYTE, Tool AS _UNSIGNED _BYTE
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'InFormPaint.frm' '$INCLUDE:'InFormPaint.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -179,7 +181,7 @@ SUB __UI_MouseDown (id AS LONG)
CASE InFormPaint CASE InFormPaint
CASE PictureBox1 CASE PictureBox1
Drawing = True Drawing = TRUE
CASE CircleBT CASE CircleBT
CASE SquareBT CASE SquareBT
@ -192,7 +194,7 @@ SUB __UI_MouseDown (id AS LONG)
END SUB END SUB
SUB __UI_MouseUp (id AS LONG) SUB __UI_MouseUp (id AS LONG)
Drawing = False Drawing = FALSE
SELECT CASE id SELECT CASE id
CASE InFormPaint CASE InFormPaint
@ -235,6 +237,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -36,6 +36,8 @@ DIM SHARED ClickCount%, Vertices%(3, 1), A#, B#, C#, XMouse%, YMouse%
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Inside-Outside Triangle.frm' '$INCLUDE:'Inside-Outside Triangle.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Functions: --------------------------------------------------------------------- ': Functions: ---------------------------------------------------------------------
FUNCTION SideLength# (X1#, Y1#, X2#, Y2#) FUNCTION SideLength# (X1#, Y1#, X2#, Y2#)
@ -51,18 +53,18 @@ END FUNCTION
FUNCTION AtCorner%% FUNCTION AtCorner%%
'This function avoids trig divide by zero difficulty at triangle corners 'This function avoids trig divide by zero difficulty at triangle corners
IF (Vertices%(3, 0) = Vertices%(0, 0) AND Vertices%(3, 1) = Vertices%(0, 1)) OR (Vertices%(3, 0) = Vertices%(1, 0) AND Vertices%(3, 1) = Vertices%(1, 1)) OR (Vertices%(3, 0) = Vertices%(2, 0) AND Vertices%(3, 1) = Vertices%(2, 1)) THEN IF (Vertices%(3, 0) = Vertices%(0, 0) AND Vertices%(3, 1) = Vertices%(0, 1)) OR (Vertices%(3, 0) = Vertices%(1, 0) AND Vertices%(3, 1) = Vertices%(1, 1)) OR (Vertices%(3, 0) = Vertices%(2, 0) AND Vertices%(3, 1) = Vertices%(2, 1)) THEN
AtCorner%% = True AtCorner%% = TRUE
ELSE ELSE
AtCorner%% = False AtCorner%% = FALSE
END IF END IF
END FUNCTION END FUNCTION
FUNCTION InPicture%% FUNCTION InPicture%%
'True if cursor is in PictureBox1 'True if cursor is in PictureBox1
IF XMouse% > 0 AND XMouse% < 650 AND YMouse% > 0 AND YMouse% < 540 THEN IF XMouse% > 0 AND XMouse% < 650 AND YMouse% > 0 AND YMouse% < 540 THEN
InPicture%% = True InPicture%% = TRUE
ELSE ELSE
InPicture%% = False InPicture%% = FALSE
END IF END IF
END FUNCTION END FUNCTION
@ -79,7 +81,7 @@ SUB __UI_BeforeInit
END SUB END SUB
SUB __UI_OnLoad SUB __UI_OnLoad
Control(InsideOutsideLB).Hidden = True Control(InsideOutsideLB).Hidden = TRUE
BeginDraw PictureBox1 BeginDraw PictureBox1
'Drawing code goes here 'Drawing code goes here
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255) COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
@ -206,7 +208,7 @@ SUB __UI_Click (id AS LONG)
EndDraw PictureBox1 EndDraw PictureBox1
Caption(Click1LB) = "Move Cursor" Caption(Click1LB) = "Move Cursor"
Caption(Click2LB) = "Around" Caption(Click2LB) = "Around"
Control(InsideOutsideLB).Hidden = False Control(InsideOutsideLB).Hidden = FALSE
'Triangle Side Lengths 'Triangle Side Lengths
A# = SideLength#(Vertices%(0, 0), Vertices%(0, 1), Vertices%(2, 0), Vertices%(2, 1)) A# = SideLength#(Vertices%(0, 0), Vertices%(0, 1), Vertices%(2, 0), Vertices%(2, 1))
B# = SideLength#(Vertices%(1, 0), Vertices%(1, 1), Vertices%(0, 0), Vertices%(0, 1)) B# = SideLength#(Vertices%(1, 0), Vertices%(1, 1), Vertices%(0, 0), Vertices%(0, 1))
@ -227,7 +229,7 @@ SUB __UI_Click (id AS LONG)
Caption(Y2LB) = "" Caption(Y2LB) = ""
Caption(X3LB) = "" Caption(X3LB) = ""
Caption(Y3LB) = "" Caption(Y3LB) = ""
Control(InsideOutsideLB).Hidden = True Control(InsideOutsideLB).Hidden = TRUE
Caption(Click1LB) = "Click To Set" Caption(Click1LB) = "Click To Set"
Caption(Click2LB) = "Vertex 1" Caption(Click2LB) = "Vertex 1"
END SELECT END SELECT
@ -266,6 +268,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -48,6 +48,8 @@ DIM SHARED pbScene AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Lander1.frm' '$INCLUDE:'Lander1.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -101,8 +103,8 @@ SUB __UI_BeforeUpdateDisplay
END IF END IF
ELSE ELSE
'actvate restart 'actvate restart
Control(bRestart).Hidden = False Control(bRestart).Hidden = FALSE
Control(bRestart).Disabled = False Control(bRestart).Disabled = FALSE
END IF 'if no message about ending landing END IF 'if no message about ending landing
END SUB END SUB
@ -325,8 +327,8 @@ SUB initialize
dy = speed * SIN(d2r * vda) 'this is the vertical y change on screen due to speed and angle dy = speed * SIN(d2r * vda) 'this is the vertical y change on screen due to speed and angle
dg = .01 'this is the constant acceleration gravity applies to the vehicle dg = .01 'this is the constant acceleration gravity applies to the vehicle
dat = .5 'this is burst of acceleration a thrust or reverse thrust will apply to speed and angle dat = .5 'this is burst of acceleration a thrust or reverse thrust will apply to speed and angle
Control(bRestart).Hidden = True Control(bRestart).Hidden = TRUE
Control(bRestart).Disabled = True Control(bRestart).Disabled = TRUE
END SUB END SUB
@ -523,6 +525,3 @@ SUB makeTerra
END IF END IF
NEXT NEXT
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -65,6 +65,8 @@ DIM SHARED pbScene AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Lander2.frm' '$INCLUDE:'Lander2.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -123,8 +125,8 @@ SUB __UI_BeforeUpdateDisplay
END IF END IF
ELSE ELSE
'actvate restart 'actvate restart
Control(bRestart).Hidden = False Control(bRestart).Hidden = FALSE
Control(bRestart).Disabled = False Control(bRestart).Disabled = FALSE
END IF 'if no message about ending landing END IF 'if no message about ending landing
END SUB END SUB
@ -365,8 +367,8 @@ SUB initialize
dy = speed * SIN(d2r * vda) 'this is the vertical y change on screen due to speed and angle dy = speed * SIN(d2r * vda) 'this is the vertical y change on screen due to speed and angle
dg = .01 'this is the constant acceleration gravity applies to the vehicle dg = .01 'this is the constant acceleration gravity applies to the vehicle
dat = .5 'this is burst of acceleration a thrust or reverse thrust will apply to speed and angle dat = .5 'this is burst of acceleration a thrust or reverse thrust will apply to speed and angle
Control(bRestart).Hidden = True Control(bRestart).Hidden = TRUE
Control(bRestart).Disabled = True Control(bRestart).Disabled = TRUE
END SUB END SUB
'================================================ from Lander 2018-06-04 '================================================ from Lander 2018-06-04
@ -586,6 +588,3 @@ FUNCTION dec2$ (rn)
dec2$ = s$ + ".00" dec2$ = s$ + ".00"
END IF END IF
END FUNCTION END FUNCTION
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -1,13 +0,0 @@
'Baize Background for Mahjong
SUB MakeBaize (Baize&)
Baize& = _NEWIMAGE(ScreenX%, ScreenY%, 32)
_DEST Baize&
FOR N% = 0 TO ScreenX% - 1
FOR M% = 0 TO ScreenY% - 1
PSET (N%, M%), _RGB(0, 35 * RND, 150 + (50 * (1 - RND)))
NEXT M%
NEXT N%
CALL QB64Logo(0, 502)
CALL QB64Logo(500, 502)
END SUB

View file

@ -1,29 +0,0 @@
'QB64 Logo
SUB QB64Logo (xQB, yQB)
'Q
LINE (xQB + 12, yQB + 12)-(xQB + 36, yQB + 84), _RGB(0, 188, 252), BF
LINE (xQB + 12, yQB + 12)-(xQB + 87, yQB + 25), _RGB(0, 188, 252), BF
LINE (xQB + 12, yQB + 71)-(xQB + 87, yQB + 84), _RGB(0, 188, 252), BF
LINE (xQB + 69, yQB + 12)-(xQB + 87, yQB + 84), _RGB(0, 188, 252), BF
LINE (xQB + 36, yQB + 71)-(xQB + 63, yQB + 99), _RGB(0, 188, 252), BF
LINE (xQB + 63, yQB + 38)-(xQB + 87, yQB + 84), _RGB(0, 188, 252), BF
'B
LINE (xQB + 108, yQB + 12)-(xQB + 188, yQB + 25), _RGB(1, 124, 253), BF
LINE (xQB + 108, yQB + 12)-(xQB + 132, yQB + 84), _RGB(1, 124, 253), BF
LINE (xQB + 108, yQB + 72)-(xQB + 188, yQB + 84), _RGB(1, 124, 253), BF
LINE (xQB + 164, yQB + 12)-(xQB + 177, yQB + 84), _RGB(1, 124, 253), BF
LINE (xQB + 164, yQB + 12)-(xQB + 188, yQB + 39), _RGB(1, 124, 253), BF
LINE (xQB + 164, yQB + 59)-(xQB + 188, yQB + 84), _RGB(1, 124, 253), BF
LINE (xQB + 108, yQB + 39)-(xQB + 177, yQB + 57), _RGB(1, 124, 253), BF
'6
LINE (xQB + 12, yQB + 112)-(xQB + 94, yQB + 125), _RGB(254, 189, 3), BF
LINE (xQB + 12, yQB + 112)-(xQB + 36, yQB + 185), _RGB(254, 189, 3), BF
LINE (xQB + 12, yQB + 171)-(xQB + 94, yQB + 185), _RGB(254, 189, 3), BF
LINE (xQB + 12, yQB + 144)-(xQB + 94, yQB + 158), _RGB(254, 189, 3), BF
LINE (xQB + 68, yQB + 144)-(xQB + 94, yQB + 185), _RGB(254, 189, 3), BF
'4
LINE (xQB + 108, yQB + 112)-(xQB + 131, yQB + 158), _RGB(252, 124, 0), BF
LINE (xQB + 108, yQB + 138)-(xQB + 188, yQB + 158), _RGB(252, 124, 0), BF
LINE (xQB + 163, yQB + 112)-(xQB + 188, yQB + 185), _RGB(252, 124, 0), BF
END SUB

View file

@ -33,11 +33,53 @@ CONST XOrigin% = 40, YOrigin% = 40, YHalfTile% = 30, XHalfTile% = 20, FrameRate%
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'QB64Mahjong.frm' '$INCLUDE:'QB64Mahjong.frm'
'$INCLUDE:'MakeBaize.bas' '$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'QB64Logo.bas' '$INCLUDE:'../../InForm/InForm.ui'
': Event procedures & Functions: --------------------------------------------------- ': Event procedures & Functions: ---------------------------------------------------
'QB64 Logo
SUB QB64Logo (xQB, yQB)
'Q
LINE (xQB + 12, yQB + 12)-(xQB + 36, yQB + 84), _RGB(0, 188, 252), BF
LINE (xQB + 12, yQB + 12)-(xQB + 87, yQB + 25), _RGB(0, 188, 252), BF
LINE (xQB + 12, yQB + 71)-(xQB + 87, yQB + 84), _RGB(0, 188, 252), BF
LINE (xQB + 69, yQB + 12)-(xQB + 87, yQB + 84), _RGB(0, 188, 252), BF
LINE (xQB + 36, yQB + 71)-(xQB + 63, yQB + 99), _RGB(0, 188, 252), BF
LINE (xQB + 63, yQB + 38)-(xQB + 87, yQB + 84), _RGB(0, 188, 252), BF
'B
LINE (xQB + 108, yQB + 12)-(xQB + 188, yQB + 25), _RGB(1, 124, 253), BF
LINE (xQB + 108, yQB + 12)-(xQB + 132, yQB + 84), _RGB(1, 124, 253), BF
LINE (xQB + 108, yQB + 72)-(xQB + 188, yQB + 84), _RGB(1, 124, 253), BF
LINE (xQB + 164, yQB + 12)-(xQB + 177, yQB + 84), _RGB(1, 124, 253), BF
LINE (xQB + 164, yQB + 12)-(xQB + 188, yQB + 39), _RGB(1, 124, 253), BF
LINE (xQB + 164, yQB + 59)-(xQB + 188, yQB + 84), _RGB(1, 124, 253), BF
LINE (xQB + 108, yQB + 39)-(xQB + 177, yQB + 57), _RGB(1, 124, 253), BF
'6
LINE (xQB + 12, yQB + 112)-(xQB + 94, yQB + 125), _RGB(254, 189, 3), BF
LINE (xQB + 12, yQB + 112)-(xQB + 36, yQB + 185), _RGB(254, 189, 3), BF
LINE (xQB + 12, yQB + 171)-(xQB + 94, yQB + 185), _RGB(254, 189, 3), BF
LINE (xQB + 12, yQB + 144)-(xQB + 94, yQB + 158), _RGB(254, 189, 3), BF
LINE (xQB + 68, yQB + 144)-(xQB + 94, yQB + 185), _RGB(254, 189, 3), BF
'4
LINE (xQB + 108, yQB + 112)-(xQB + 131, yQB + 158), _RGB(252, 124, 0), BF
LINE (xQB + 108, yQB + 138)-(xQB + 188, yQB + 158), _RGB(252, 124, 0), BF
LINE (xQB + 163, yQB + 112)-(xQB + 188, yQB + 185), _RGB(252, 124, 0), BF
END SUB
'Baize Background for Mahjong
SUB MakeBaize (Baize&)
Baize& = _NEWIMAGE(ScreenX%, ScreenY%, 32)
_DEST Baize&
FOR N% = 0 TO ScreenX% - 1
FOR M% = 0 TO ScreenY% - 1
PSET (N%, M%), _RGB(0, 35 * RND, 150 + (50 * (1 - RND)))
NEXT M%
NEXT N%
CALL QB64Logo(0, 502)
CALL QB64Logo(500, 502)
END SUB
FUNCTION HardwareImage& (ImageName&) FUNCTION HardwareImage& (ImageName&)
HardwareImage& = _COPYIMAGE(ImageName&, 33) HardwareImage& = _COPYIMAGE(ImageName&, 33)
_FREEIMAGE ImageName& _FREEIMAGE ImageName&
@ -50,48 +92,48 @@ END FUNCTION
SUB __UI_BeforeInit SUB __UI_BeforeInit
RANDOMIZE (TIMER) RANDOMIZE (TIMER)
$EXEICON:'.\QB64Mahjong.ico' $EXEICON:'.\QB64Mahjong.ico'
Innit%% = True Innit%% = TRUE
'Set Positions Template 'Set Positions Template
FOR S%% = 4 TO 11 '64 FOR S%% = 4 TO 11 '64
FOR R%% = 1 TO 8 FOR R%% = 1 TO 8
Template`(1, S%%, R%%) = True Template`(1, S%%, R%%) = TRUE
NEXT R%% NEXT R%%
NEXT S%% NEXT S%%
FOR S%% = 2 TO 3 '8 FOR S%% = 2 TO 3 '8
FOR R%% = 1 TO 8 STEP 7 FOR R%% = 1 TO 8 STEP 7
Template`(1, S%%, R%%) = True Template`(1, S%%, R%%) = TRUE
Template`(1, S%% + 10, R%%) = True Template`(1, S%% + 10, R%%) = TRUE
NEXT R%% NEXT R%%
NEXT S%% NEXT S%%
FOR S%% = 3 TO 12 STEP 9 '8 FOR S%% = 3 TO 12 STEP 9 '8
FOR R%% = 3 TO 6 FOR R%% = 3 TO 6
Template`(1, S%%, R%%) = True Template`(1, S%%, R%%) = TRUE
NEXT R%% NEXT R%%
NEXT S%% NEXT S%%
FOR S%% = 2 TO 13 STEP 11 '4 FOR S%% = 2 TO 13 STEP 11 '4
FOR R%% = 4 TO 5 FOR R%% = 4 TO 5
Template`(1, S%%, R%%) = True Template`(1, S%%, R%%) = TRUE
NEXT R%% NEXT R%%
NEXT S%% NEXT S%%
FOR S%% = 5 TO 10 '36 FOR S%% = 5 TO 10 '36
FOR R%% = 2 TO 7 FOR R%% = 2 TO 7
Template`(2, S%%, R%%) = True Template`(2, S%%, R%%) = TRUE
NEXT R%% NEXT R%%
NEXT S%% NEXT S%%
FOR S%% = 6 TO 9 '16 FOR S%% = 6 TO 9 '16
FOR R%% = 3 TO 6 FOR R%% = 3 TO 6
Template`(3, S%%, R%%) = True Template`(3, S%%, R%%) = TRUE
NEXT R%% NEXT R%%
NEXT S%% NEXT S%%
FOR S%% = 7 TO 8 '4 FOR S%% = 7 TO 8 '4
FOR R%% = 4 TO 5 FOR R%% = 4 TO 5
Template`(4, S%%, R%%) = True Template`(4, S%%, R%%) = TRUE
NEXT R%% NEXT R%%
NEXT S%% NEXT S%%
Template`(1, 1, 4) = True '4 'FIO 4.5 really Template`(1, 1, 4) = TRUE '4 'FIO 4.5 really
Template`(1, 14, 4) = True 'FIO 4.5 really Template`(1, 14, 4) = TRUE 'FIO 4.5 really
Template`(1, 15, 4) = True 'FIO 4.5 really Template`(1, 15, 4) = TRUE 'FIO 4.5 really
Template`(5, 7, 4) = True 'FIO 7.5, 4.5 really Template`(5, 7, 4) = TRUE 'FIO 7.5, 4.5 really
'Images - all images are hardware accelerated 'Images - all images are hardware accelerated
'Most images are used only in __UI_BeforeUpdateDisplay and therefore could be local and static 'Most images are used only in __UI_BeforeUpdateDisplay and therefore could be local and static
'But images are Shared instead 'But images are Shared instead
@ -219,13 +261,13 @@ SUB __UI_BeforeInit
TilePic%%(N%) = S%% + 38 TilePic%%(N%) = S%% + 38
NEXT N% NEXT N%
'Load data 'Load data
FromSave%% = False FromSave%% = FALSE
IF _FILEEXISTS("mahjong.cfg") THEN IF _FILEEXISTS("mahjong.cfg") THEN
OPEN "mahjong.cfg" FOR INPUT AS #1 OPEN "mahjong.cfg" FOR INPUT AS #1
INPUT #1, HighScore% INPUT #1, HighScore%
INPUT #1, TilesRem% INPUT #1, TilesRem%
IF TilesRem% <> 144 THEN IF TilesRem% <> 144 THEN
FromSave%% = True FromSave%% = TRUE
'Input saved data 'Input saved data
INPUT #1, Score% INPUT #1, Score%
INPUT #1, Counter& INPUT #1, Counter&
@ -251,16 +293,16 @@ END SUB
SUB __UI_OnLoad SUB __UI_OnLoad
_SCREENMOVE 100, 50 _SCREENMOVE 100, 50
Caption(ExitBT) = "Start" Caption(ExitBT) = "Start"
Control(ScoreLB).Hidden = True Control(ScoreLB).Hidden = TRUE
Control(ScoringLB).Hidden = True Control(ScoringLB).Hidden = TRUE
Control(HighScoreLB).Hidden = True Control(HighScoreLB).Hidden = TRUE
Control(HighScoringLB).Hidden = True Control(HighScoringLB).Hidden = TRUE
Control(NumberOfTilesLB).Hidden = True Control(NumberOfTilesLB).Hidden = TRUE
Control(TilesRemainingLB).Hidden = True Control(TilesRemainingLB).Hidden = TRUE
Control(NewGameBT).Disabled = True Control(NewGameBT).Disabled = TRUE
Control(SaveGameBT).Disabled = True Control(SaveGameBT).Disabled = TRUE
Control(UndoBT).Disabled = True Control(UndoBT).Disabled = TRUE
Control(StillBT).Disabled = True Control(StillBT).Disabled = TRUE
SetFrameRate FrameRate% SetFrameRate FrameRate%
SetFocus ExitBT SetFocus ExitBT
END SUB END SUB
@ -274,7 +316,7 @@ SUB __UI_BeforeUpdateDisplay
ELSEIF TilesRem% <> 0 THEN ELSEIF TilesRem% <> 0 THEN
'Display In-Play Tiles and Look for Mouse Hover/Select/Match 'Display In-Play Tiles and Look for Mouse Hover/Select/Match
NoHov% = 0 NoHov% = 0
Matches%% = False Matches%% = FALSE
MatchCount% = 0 MatchCount% = 0
'Layer 1R 'Layer 1R
FOR S%% = 15 TO 14 STEP -1 FOR S%% = 15 TO 14 STEP -1
@ -335,7 +377,7 @@ SUB __UI_BeforeUpdateDisplay
IF MatchCount% > 1 THEN IF MatchCount% > 1 THEN
MatchIndex% = 1 MatchIndex% = 1
WHILE NOT Matches%% AND MatchIndex% <= MatchCount% - 1 WHILE NOT Matches%% AND MatchIndex% <= MatchCount% - 1
IF ImType%%(M%) = MatchComp%%(MatchIndex%) THEN Matches%% = True IF ImType%%(M%) = MatchComp%%(MatchIndex%) THEN Matches%% = TRUE
MatchIndex% = MatchIndex% + 1 MatchIndex% = MatchIndex% + 1
WEND WEND
END IF END IF
@ -362,7 +404,7 @@ SUB __UI_BeforeUpdateDisplay
IF MatchCount% > 1 THEN IF MatchCount% > 1 THEN
MatchIndex% = 1 MatchIndex% = 1
WHILE NOT Matches%% AND MatchIndex% <= MatchCount% - 1 WHILE NOT Matches%% AND MatchIndex% <= MatchCount% - 1
IF ImType%%(M%) = MatchComp%%(MatchIndex%) THEN Matches%% = True IF ImType%%(M%) = MatchComp%%(MatchIndex%) THEN Matches%% = TRUE
MatchIndex% = MatchIndex% + 1 MatchIndex% = MatchIndex% + 1
WEND WEND
END IF END IF
@ -388,7 +430,7 @@ SUB __UI_BeforeUpdateDisplay
IF MatchCount% > 1 THEN IF MatchCount% > 1 THEN
MatchIndex% = 1 MatchIndex% = 1
WHILE NOT Matches%% AND MatchIndex% <= MatchCount% - 1 WHILE NOT Matches%% AND MatchIndex% <= MatchCount% - 1
IF ImType%%(M%) = MatchComp%%(MatchIndex%) THEN Matches%% = True IF ImType%%(M%) = MatchComp%%(MatchIndex%) THEN Matches%% = TRUE
MatchIndex% = MatchIndex% + 1 MatchIndex% = MatchIndex% + 1
WEND WEND
END IF END IF
@ -404,7 +446,7 @@ SUB __UI_BeforeUpdateDisplay
END IF END IF
END IF END IF
_PUTIMAGE (197 - 1, 110 - 1), Borders& _PUTIMAGE (197 - 1, 110 - 1), Borders&
IF NOT Matches%% AND MahPlay%% THEN MatchesNone%% = True IF NOT Matches%% AND MahPlay%% THEN MatchesNone%% = TRUE
END IF END IF
END SUB END SUB
@ -436,7 +478,7 @@ SUB __UI_Click (id AS LONG)
IF NoSel% = 0 THEN IF NoSel% = 0 THEN
'First Tile Selected 'First Tile Selected
NoSel% = NoHov% NoSel% = NoHov%
Control(UndoBT).Disabled = False Control(UndoBT).Disabled = FALSE
ELSE ELSE
'Second Tile Selected 'Second Tile Selected
IF NoSel% <> NoHov% THEN IF NoSel% <> NoHov% THEN
@ -463,16 +505,16 @@ SUB __UI_Click (id AS LONG)
Score% = Score% + 3 Score% = Score% + 3
Caption(TilesRemainingLB) = SetText$(TilesRem%) Caption(TilesRemainingLB) = SetText$(TilesRem%)
Caption(ScoringLB) = SetText$(Score%) Caption(ScoringLB) = SetText$(Score%)
Control(NewGameBT).Disabled = False Control(NewGameBT).Disabled = FALSE
IF TilesRem% > 0 THEN IF TilesRem% > 0 THEN
Control(SaveGameBT).Disabled = False Control(SaveGameBT).Disabled = FALSE
Control(UndoBT).Disabled = False Control(UndoBT).Disabled = FALSE
ELSE ELSE
Control(SaveGameBT).Disabled = True Control(SaveGameBT).Disabled = TRUE
Control(UndoBT).Disabled = True Control(UndoBT).Disabled = TRUE
Caption(Label1LB) = "Congratulations" Caption(Label1LB) = "Congratulations"
Control(Label1LB).Hidden = False Control(Label1LB).Hidden = FALSE
Control(StillBT).Disabled = True Control(StillBT).Disabled = TRUE
END IF END IF
IF ImType%%(NoSel%) = PrevType%% THEN IF ImType%%(NoSel%) = PrevType%% THEN
Score% = Score% + 6 Score% = Score% + 6
@ -484,7 +526,7 @@ SUB __UI_Click (id AS LONG)
END IF END IF
END IF END IF
NoSel% = 0 NoSel% = 0
IF TilesRem% = 144 THEN Control(UndoBT).Disabled = True IF TilesRem% = 144 THEN Control(UndoBT).Disabled = TRUE
END IF END IF
END IF END IF
CASE UndoBT CASE UndoBT
@ -512,43 +554,43 @@ SUB __UI_Click (id AS LONG)
Caption(TilesRemainingLB) = SetText$(TilesRem%) Caption(TilesRemainingLB) = SetText$(TilesRem%)
Caption(ScoringLB) = SetText$(Score%) Caption(ScoringLB) = SetText$(Score%)
IF TilesRem% < 144 THEN IF TilesRem% < 144 THEN
Control(SaveGameBT).Disabled = False Control(SaveGameBT).Disabled = FALSE
ELSE ELSE
Control(SaveGameBT).Disabled = True Control(SaveGameBT).Disabled = TRUE
END IF END IF
PrevType%% = ImType%%(TileSave%(72 - (TilesRem% / 2), 1)) PrevType%% = ImType%%(TileSave%(72 - (TilesRem% / 2), 1))
IF ImType%%(One%) = PrevType%% THEN IF ImType%%(One%) = PrevType%% THEN
Score% = Score% - 6 Score% = Score% - 6
Caption(ScoringLB) = SetText$(Score%) Caption(ScoringLB) = SetText$(Score%)
END IF END IF
MatchesNone%% = False MatchesNone%% = FALSE
Control(Label1LB).Hidden = True Control(Label1LB).Hidden = TRUE
CanUndo%% = False CanUndo%% = FALSE
END IF END IF
NoSel% = 0 ' Undo also removes selection NoSel% = 0 ' Undo also removes selection
IF TilesRem% = 144 THEN Control(UndoBT).Disabled = True IF TilesRem% = 144 THEN Control(UndoBT).Disabled = TRUE
END IF END IF
CASE ExitBT CASE ExitBT
IF Innit%% THEN IF Innit%% THEN
CALL DoMahjong CALL DoMahjong
ELSE ELSE
MahPlay%% = False MahPlay%% = FALSE
Innit%% = True Innit%% = TRUE
TilesRem% = 144 ' Prevents Save at Exit TilesRem% = 144 ' Prevents Save at Exit
END IF END IF
CASE NewGameBT CASE NewGameBT
MahPlay%% = False MahPlay%% = FALSE
CASE SaveGameBT CASE SaveGameBT
MahPlay%% = False MahPlay%% = FALSE
Innit%% = True Innit%% = TRUE
IF TilesRem% = 0 THEN TilesRem% = 144 ' Prevents Save at Exit IF TilesRem% = 0 THEN TilesRem% = 144 ' Prevents Save at Exit
CASE StillBT CASE StillBT
IF WorldStop%% THEN IF WorldStop%% THEN
Caption(StillBT) = "Still" Caption(StillBT) = "Still"
WorldStop%% = False WorldStop%% = FALSE
ELSE ELSE
Caption(StillBT) = "Spin" Caption(StillBT) = "Spin"
WorldStop%% = True WorldStop%% = TRUE
END IF END IF
END SELECT END SELECT
END SUB END SUB
@ -590,13 +632,13 @@ END SUB
SUB DoMahjong SUB DoMahjong
_SNDPLAYFILE "chrysanthemum.ogg", 4, 0.6 _SNDPLAYFILE "chrysanthemum.ogg", 4, 0.6
Caption(ExitBT) = "Exit" Caption(ExitBT) = "Exit"
Control(ScoreLB).Hidden = False Control(ScoreLB).Hidden = FALSE
Control(ScoringLB).Hidden = False Control(ScoringLB).Hidden = FALSE
Control(HighScoreLB).Hidden = False Control(HighScoreLB).Hidden = FALSE
Control(HighScoringLB).Hidden = False Control(HighScoringLB).Hidden = FALSE
Control(NumberOfTilesLB).Hidden = False Control(NumberOfTilesLB).Hidden = FALSE
Control(TilesRemainingLB).Hidden = False Control(TilesRemainingLB).Hidden = FALSE
Innit%% = False Innit%% = FALSE
WHILE NOT Innit%% WHILE NOT Innit%%
'Initial Values 'Initial Values
IF NOT FromSave%% THEN IF NOT FromSave%% THEN
@ -610,7 +652,7 @@ SUB DoMahjong
NEXT U%% NEXT U%%
'Randomly Fill Grid 'Randomly Fill Grid
FOR N% = 1 TO 144 FOR N% = 1 TO 144
Empty%% = True Empty%% = TRUE
WHILE Empty%% WHILE Empty%%
URnd%% = 1 + INT(15 * RND) URnd%% = 1 + INT(15 * RND)
VRnd%% = 1 + INT(8 * RND) VRnd%% = 1 + INT(8 * RND)
@ -620,7 +662,7 @@ SUB DoMahjong
ImPos%%(N%, 0) = WRnd%% ImPos%%(N%, 0) = WRnd%%
ImPos%%(N%, 1) = URnd%% ImPos%%(N%, 1) = URnd%%
ImPos%%(N%, 2) = VRnd%% ImPos%%(N%, 2) = VRnd%%
Empty%% = False Empty%% = FALSE
END IF END IF
WEND WEND
NEXT N% NEXT N%
@ -634,28 +676,28 @@ SUB DoMahjong
Counter& = 0 Counter& = 0
PrevType%% = 0 PrevType%% = 0
END IF END IF
MahPlay%% = True MahPlay%% = TRUE
NoSel% = 0 NoSel% = 0
NoHov% = 0 NoHov% = 0
MatchesNone%% = False MatchesNone%% = FALSE
MatchBeeped%% = False MatchBeeped%% = FALSE
ECount%% = 0 ECount%% = 0
EIndex%% = 0 EIndex%% = 0
BCount%% = 0 BCount%% = 0
Blink%% = True Blink%% = TRUE
CanUndo%% = True CanUndo%% = TRUE
UCount%% = 0 UCount%% = 0
WorldStop%% = False WorldStop%% = FALSE
Control(NewGameBT).Disabled = True Control(NewGameBT).Disabled = TRUE
Control(SaveGameBT).Disabled = True Control(SaveGameBT).Disabled = TRUE
Control(StillBT).Disabled = False Control(StillBT).Disabled = FALSE
IF FromSave%% THEN IF FromSave%% THEN
FromSave%% = False FromSave%% = FALSE
Control(UndoBT).Disabled = False Control(UndoBT).Disabled = FALSE
ELSE ELSE
Control(UndoBT).Disabled = True Control(UndoBT).Disabled = TRUE
END IF END IF
Control(Label1LB).Hidden = True Control(Label1LB).Hidden = TRUE
Caption(Label1LB) = "No Matches Available" Caption(Label1LB) = "No Matches Available"
Caption(ScoringLB) = SetText$(Score%) Caption(ScoringLB) = SetText$(Score%)
Caption(HighScoringLB) = SetText$(HighScore%) Caption(HighScoringLB) = SetText$(HighScore%)
@ -666,11 +708,11 @@ SUB DoMahjong
IF MatchesNone%% THEN IF MatchesNone%% THEN
IF NOT MatchBeeped%% THEN IF NOT MatchBeeped%% THEN
_SNDPLAYFILE "NoMatch.ogg", 3, 0.8 _SNDPLAYFILE "NoMatch.ogg", 3, 0.8
MatchBeeped%% = True MatchBeeped%% = TRUE
Control(Label1LB).Hidden = False Control(Label1LB).Hidden = FALSE
END IF END IF
ELSE ELSE
MatchBeeped%% = False MatchBeeped%% = FALSE
END IF END IF
IF WorldStop%% THEN IF WorldStop%% THEN
EIndex%% = 8 EIndex%% = 8
@ -685,14 +727,14 @@ SUB DoMahjong
BCount%% = BCount%% + 1 BCount%% = BCount%% + 1
IF Blink%% AND BCount%% = 40 THEN IF Blink%% AND BCount%% = 40 THEN
BCount%% = 0 BCount%% = 0
Blink%% = False Blink%% = FALSE
ELSEIF NOT Blink%% AND BCount%% = 10 THEN ELSEIF NOT Blink%% AND BCount%% = 10 THEN
BCount%% = 0 BCount%% = 0
Blink%% = True Blink%% = TRUE
END IF END IF
IF NOT CanUndo%% THEN UCount%% = UCount%% + 1 IF NOT CanUndo%% THEN UCount%% = UCount%% + 1
IF UCount%% = 32 THEN IF UCount%% = 32 THEN
CanUndo%% = True CanUndo%% = TRUE
UCount%% = 0 UCount%% = 0
END IF END IF
'Following is to adjust score for time in game 'Following is to adjust score for time in game
@ -708,8 +750,8 @@ SUB DoMahjong
k1$ = INKEY$ k1$ = INKEY$
IF k1$ <> "" THEN IF k1$ <> "" THEN
IF ASC(k1$) = 27 THEN IF ASC(k1$) = 27 THEN
MahPlay%% = False MahPlay%% = FALSE
Innit%% = True Innit%% = TRUE
TilesRem% = 144 TilesRem% = 144
END IF END IF
END IF END IF
@ -754,6 +796,3 @@ SUB DoMahjong
CLOSE #1 CLOSE #1
SYSTEM SYSTEM
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -28,6 +28,8 @@ DIM SHARED ma&
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'MasterMindGuessTheSequence.frm' '$INCLUDE:'MasterMindGuessTheSequence.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -38,25 +40,25 @@ SUB __UI_OnLoad
RANDOMIZE TIMER RANDOMIZE TIMER
MaxSequence = 4 MaxSequence = 4
Caption(SecretSequenceLB) = STR$(MaxSequence) + " Digits" Caption(SecretSequenceLB) = STR$(MaxSequence) + " Digits"
Control(SecretSequenceLB).Disabled = True Control(SecretSequenceLB).Disabled = TRUE
Control(ListBox1).Disabled = True Control(ListBox1).Disabled = TRUE
Control(WriteSequenceToTestTB).Disabled = True Control(WriteSequenceToTestTB).Disabled = TRUE
Control(TestSequenceBT).Disabled = True Control(TestSequenceBT).Disabled = TRUE
Caption(HelpLB) = "Help:" + CHR$(10) + " Options: set difficult of game, Tutor, Music " + CHR$(10) + " Help: this info" + CHR$(10) + " Quit:exit program" + CHR$(10) + " Start: begin the game" + CHR$(10) + " Reset: restart the game" + CHR$(10) + " HOW TO PLAY: click Start, type sequence, press Enter/click Test sequence" Caption(HelpLB) = "Help:" + CHR$(10) + " Options: set difficult of game, Tutor, Music " + CHR$(10) + " Help: this info" + CHR$(10) + " Quit:exit program" + CHR$(10) + " Start: begin the game" + CHR$(10) + " Reset: restart the game" + CHR$(10) + " HOW TO PLAY: click Start, type sequence, press Enter/click Test sequence"
Control(HelpLB).Hidden = True Control(HelpLB).Hidden = TRUE
Control(HelpLB).Disabled = True Control(HelpLB).Disabled = TRUE
Control(HelpLB).WordWrap = True Control(HelpLB).WordWrap = TRUE
Control(TrackBar1).Value = 4 Control(TrackBar1).Value = 4
Control(TrackBar1).HasBorder = True Control(TrackBar1).HasBorder = TRUE
Control(TrackBar1).BorderColor = _RGB32(0, 255, 127) Control(TrackBar1).BorderColor = _RGB32(0, 255, 127)
Caption(TrackBar1) = LTRIM$(STR$(MaxSequence)) Caption(TrackBar1) = LTRIM$(STR$(MaxSequence))
Control(TrackBar1).ForeColor = _RGB32(0, 0, 255) Control(TrackBar1).ForeColor = _RGB32(0, 0, 255)
Control(TrackBar1).Disabled = True Control(TrackBar1).Disabled = TRUE
Caption(RadioButton1) = "Tutor" Caption(RadioButton1) = "Tutor"
Control(RadioButton1).Disabled = True Control(RadioButton1).Disabled = TRUE
Caption(TrackBar1LB) = LTRIM$(STR$(MaxSequence)) Caption(TrackBar1LB) = LTRIM$(STR$(MaxSequence))
ma& = _SNDOPEN("mozart_-_Turkish_March_in_Bb.mid") ma& = _SNDOPEN("mozart_-_Turkish_March_in_Bb.mid")
Control(MusicCB).Disabled = True Control(MusicCB).Disabled = TRUE
END SUB END SUB
SUB __UI_BeforeUpdateDisplay SUB __UI_BeforeUpdateDisplay
@ -74,13 +76,13 @@ SUB VictorY
BEEP BEEP
Caption(StartBT) = "Start" Caption(StartBT) = "Start"
ResetList ListBox1 ResetList ListBox1
Control(SecretSequenceLB).Disabled = True Control(SecretSequenceLB).Disabled = TRUE
Control(ListBox1).Disabled = True Control(ListBox1).Disabled = TRUE
Control(WriteSequenceToTestTB).Disabled = True Control(WriteSequenceToTestTB).Disabled = TRUE
Control(TestSequenceBT).Disabled = True Control(TestSequenceBT).Disabled = TRUE
Caption(SecretSequenceLB) = "" Caption(SecretSequenceLB) = ""
Text(SecretSequenceLB) = "" Text(SecretSequenceLB) = ""
Control(RadioButton1).Value = False Control(RadioButton1).Value = FALSE
END SUB END SUB
SUB CheckInput (stringa AS STRING) SUB CheckInput (stringa AS STRING)
@ -105,11 +107,11 @@ SUB CheckInput (stringa AS STRING)
' if position of z in stringa is the same in Text(secretSequenceLB) we get X otherwise we get O z is in Text(secretSequenceLB) but in different position ' if position of z in stringa is the same in Text(secretSequenceLB) we get X otherwise we get O z is in Text(secretSequenceLB) but in different position
IF INSTR(1, visto, z) = 0 THEN IF b = a THEN ResulT = ResulT + "X" ELSE ResulT = ResulT + "O" IF INSTR(1, visto, z) = 0 THEN IF b = a THEN ResulT = ResulT + "X" ELSE ResulT = ResulT + "O"
ELSE ELSE
IF Control(RadioButton1).Value = True THEN ResulT = ResulT + "-" IF Control(RadioButton1).Value = TRUE THEN ResulT = ResulT + "-"
END IF END IF
visto = visto + z visto = visto + z
NEXT NEXT
IF Control(RadioButton1).Value = False THEN IF LEN(ResulT) < MaxSequence THEN ResulT = ResulT + STRING$(MaxSequence - LEN(ResulT) + 1, "_") ' or ,"?") or ,"<22>") IF Control(RadioButton1).Value = FALSE THEN IF LEN(ResulT) < MaxSequence THEN ResulT = ResulT + STRING$(MaxSequence - LEN(ResulT) + 1, "_") ' or ,"?") or ,"<22>")
AddItem ListBox1, stringa + "--> " + ResulT AddItem ListBox1, stringa + "--> " + ResulT
Text(WriteSequenceToTestTB) = "" Text(WriteSequenceToTestTB) = ""
ResulT = " " ResulT = " "
@ -143,49 +145,49 @@ SUB __UI_Click (id AS LONG)
Caption(SecretSequenceLB) = LTRIM$(STR$(MaxSequence)) + " Digits" Caption(SecretSequenceLB) = LTRIM$(STR$(MaxSequence)) + " Digits"
END IF END IF
CASE HelpBT CASE HelpBT
Control(HelpLB).Hidden = False Control(HelpLB).Hidden = FALSE
Control(HelpLB).Disabled = False Control(HelpLB).Disabled = FALSE
CASE StartBT CASE StartBT
IF Caption(StartBT) = "Start" THEN IF Caption(StartBT) = "Start" THEN
Caption(StartBT) = "Reset" Caption(StartBT) = "Reset"
Control(SecretSequenceLB).Disabled = False Control(SecretSequenceLB).Disabled = FALSE
Control(ListBox1).Disabled = False Control(ListBox1).Disabled = FALSE
Text(WriteSequenceToTestTB) = "" Text(WriteSequenceToTestTB) = ""
Control(WriteSequenceToTestTB).Disabled = False Control(WriteSequenceToTestTB).Disabled = FALSE
Control(TestSequenceBT).Disabled = False Control(TestSequenceBT).Disabled = FALSE
CreateListToCheck CreateListToCheck
Caption(SecretSequenceLB) = STR$(MaxSequence) + " Digits" 'Text(SecretSequenceLB) ' debug statement Caption(SecretSequenceLB) = STR$(MaxSequence) + " Digits" 'Text(SecretSequenceLB) ' debug statement
ELSE ELSE
Caption(StartBT) = "Start" Caption(StartBT) = "Start"
ResetList ListBox1 ResetList ListBox1
Control(SecretSequenceLB).Disabled = True Control(SecretSequenceLB).Disabled = TRUE
Text(WriteSequenceToTestTB) = "" Text(WriteSequenceToTestTB) = ""
Control(ListBox1).Disabled = True Control(ListBox1).Disabled = TRUE
Control(WriteSequenceToTestTB).Disabled = True Control(WriteSequenceToTestTB).Disabled = TRUE
Control(TestSequenceBT).Disabled = True Control(TestSequenceBT).Disabled = TRUE
Caption(SecretSequenceLB) = STR$(MaxSequence) + " Digits" Caption(SecretSequenceLB) = STR$(MaxSequence) + " Digits"
Text(SecretSequenceLB) = "" Text(SecretSequenceLB) = ""
Control(RadioButton1).Value = False Control(RadioButton1).Value = FALSE
END IF END IF
CASE OptionsBT CASE OptionsBT
IF Control(TrackBar1).Disabled = True THEN IF Control(TrackBar1).Disabled = TRUE THEN
Control(TrackBar1).Disabled = False Control(TrackBar1).Disabled = FALSE
Control(RadioButton1).Disabled = False Control(RadioButton1).Disabled = FALSE
IF ma& = 0 THEN Control(MusicCB).Disabled = True ELSE Control(MusicCB).Disabled = False IF ma& = 0 THEN Control(MusicCB).Disabled = TRUE ELSE Control(MusicCB).Disabled = FALSE
ELSE ELSE
Control(TrackBar1).Disabled = True Control(TrackBar1).Disabled = TRUE
Control(RadioButton1).Disabled = True Control(RadioButton1).Disabled = TRUE
Control(MusicCB).Disabled = True Control(MusicCB).Disabled = TRUE
END IF END IF
CASE QuitBT CASE QuitBT
SYSTEM SYSTEM
CASE HelpLB CASE HelpLB
Control(HelpLB).Hidden = True Control(HelpLB).Hidden = TRUE
Control(HelpLB).Disabled = True Control(HelpLB).Disabled = TRUE
CASE TrackBar1 CASE TrackBar1
END SELECT END SELECT
__UI_Focus = WriteSequenceToTestTB __UI_Focus = WriteSequenceToTestTB
@ -427,12 +429,9 @@ SUB __UI_ValueChanged (id AS LONG)
ToolTip(TrackBar1) = LTRIM$(STR$(MaxSequence)) ToolTip(TrackBar1) = LTRIM$(STR$(MaxSequence))
Caption(TrackBar1LB) = LTRIM$(STR$(MaxSequence)) Caption(TrackBar1LB) = LTRIM$(STR$(MaxSequence))
CASE MusicCB CASE MusicCB
IF Control(MusicCB).Value = True THEN _SNDLOOP ma& ELSE _SNDSTOP ma& IF Control(MusicCB).Value = TRUE THEN _SNDLOOP ma& ELSE _SNDSTOP ma&
END SELECT END SELECT
END SUB END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -32,6 +32,8 @@ REDIM SHARED Motion`(10, 6, 2), Choisi`(10, 6), Grid%%(10, 6)
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Pelmanism.frm' '$INCLUDE:'Pelmanism.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures & Functions: --------------------------------------------------------------- ': Event procedures & Functions: ---------------------------------------------------------------
FUNCTION MakeHardware& (Img&) FUNCTION MakeHardware& (Img&)
@ -73,7 +75,7 @@ SUB __UI_BeforeInit
NEXT N%% NEXT N%%
CLOSE #1 CLOSE #1
END IF END IF
DoNewGame` = False DoNewGame` = FALSE
game_data: game_data:
DATA 4,4 DATA 4,4
@ -108,7 +110,7 @@ SUB __UI_BeforeUpdateDisplay
_PUTIMAGE (107 * (HorizPos%% - 1) + 7, 107 * (VertPos%% - 1) + 7), Images&(Grid%%(HorizPos%%, VertPos%%)) 'Fronts _PUTIMAGE (107 * (HorizPos%% - 1) + 7, 107 * (VertPos%% - 1) + 7), Images&(Grid%%(HorizPos%%, VertPos%%)) 'Fronts
PCount%% = PCount%% + 1 PCount%% = PCount%% + 1
IF PCount%% = 40 THEN IF PCount%% = 40 THEN
Paused` = False Paused` = FALSE
PCount%% = 0 PCount%% = 0
END IF END IF
ELSE ELSE
@ -124,16 +126,16 @@ SUB __UI_BeforeUpdateDisplay
FlipCount%% = FlipCount%% + 2 FlipCount%% = FlipCount%% + 2
IF FlipCount%% = 100 THEN IF FlipCount%% = 100 THEN
FlipCount%% = 0 FlipCount%% = 0
Motion`(HorizPos%%, VertPos%%, 2) = False Motion`(HorizPos%%, VertPos%%, 2) = FALSE
Motion`(HorizPos%%, VertPos%%, 0) = False Motion`(HorizPos%%, VertPos%%, 0) = FALSE
IF HorizPos%% = FirstH%% AND VertPos%% = FirstV%% THEN IF HorizPos%% = FirstH%% AND VertPos%% = FirstV%% THEN
FrameRate% = 40 FrameRate% = 40
SetFrameRate FrameRate% SetFrameRate FrameRate%
Flipping` = False Flipping` = FALSE
TurningBack` = False TurningBack` = FALSE
FirstV%% = 50 FirstV%% = 50
ELSE ELSE
Motion`(FirstH%%, FirstV%%, 2) = True Motion`(FirstH%%, FirstV%%, 2) = TRUE
END IF END IF
END IF END IF
END IF END IF
@ -151,22 +153,22 @@ SUB __UI_BeforeUpdateDisplay
FlipCount%% = FlipCount%% + 2 FlipCount%% = FlipCount%% + 2
IF FlipCount%% = 100 THEN IF FlipCount%% = 100 THEN
FlipCount%% = 0 FlipCount%% = 0
Flipping` = False Flipping` = FALSE
Motion`(HorizPos%%, VertPos%%, 1) = False Motion`(HorizPos%%, VertPos%%, 1) = FALSE
Motion`(HorizPos%%, VertPos%%, 0) = True Motion`(HorizPos%%, VertPos%%, 0) = TRUE
IF FirstGo` THEN IF FirstGo` THEN
FirstGo` = False FirstGo` = FALSE
ELSE ELSE
FirstGo` = True FirstGo` = TRUE
IF Grid%%(HorizPos%%, VertPos%%) = Grid%%(FirstH%%, FirstV%%) THEN 'Matched pair IF Grid%%(HorizPos%%, VertPos%%) = Grid%%(FirstH%%, FirstV%%) THEN 'Matched pair
Choisi`(HorizPos%%, VertPos%%) = True 'Registers that that grid position cannot be clicked any more Choisi`(HorizPos%%, VertPos%%) = TRUE 'Registers that that grid position cannot be clicked any more
Choisi`(FirstH%%, FirstV%%) = True Choisi`(FirstH%%, FirstV%%) = TRUE
NoRemaining%% = NoRemaining%% - 2 NoRemaining%% = NoRemaining%% - 2
IF NoRemaining%% = 0 THEN IF NoRemaining%% = 0 THEN
'Tah-dah sound (completed) 'Tah-dah sound (completed)
IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("fanfare.mp3") IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("fanfare.mp3")
Control(PairingsCompletedLB).Disabled = False Control(PairingsCompletedLB).Disabled = FALSE
Control(PairingsCompletedLB).Hidden = False Control(PairingsCompletedLB).Hidden = FALSE
ELSE ELSE
'Ching sound (match) 'Ching sound (match)
IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("match3.mp3") IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("match3.mp3")
@ -175,10 +177,10 @@ SUB __UI_BeforeUpdateDisplay
'Initiate sequential turn back 'Initiate sequential turn back
FrameRate% = 60 FrameRate% = 60
SetFrameRate FrameRate% SetFrameRate FrameRate%
Motion`(HorizPos%%, VertPos%%, 2) = True Motion`(HorizPos%%, VertPos%%, 2) = TRUE
Flipping` = True Flipping` = TRUE
TurningBack` = True TurningBack` = TRUE
Paused` = True Paused` = TRUE
PCount%% = 0 PCount%% = 0
IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("nomatch1.mp3"), , 0.2 IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("nomatch1.mp3"), , 0.2
END IF END IF
@ -235,8 +237,8 @@ SUB __UI_Click (id AS LONG)
IF Choisi`(HorizPos%%, VertPos%%) OR (FirstH%% = HorizPos%% AND FirstV%% = VertPos%%) THEN IF Choisi`(HorizPos%%, VertPos%%) OR (FirstH%% = HorizPos%% AND FirstV%% = VertPos%%) THEN
'Do nothing 'Do nothing
ELSE ELSE
Motion`(HorizPos%%, VertPos%%, 1) = True 'Set this cell turning Motion`(HorizPos%%, VertPos%%, 1) = TRUE 'Set this cell turning
Flipping` = True Flipping` = TRUE
IF FirstGo` THEN IF FirstGo` THEN
FirstH%% = HorizPos%% FirstH%% = HorizPos%%
FirstV%% = VertPos%% FirstV%% = VertPos%%
@ -245,13 +247,13 @@ SUB __UI_Click (id AS LONG)
END IF END IF
CASE ExitBT CASE ExitBT
IF InPlay` THEN IF InPlay` THEN
InPlay` = False InPlay` = FALSE
ELSE ELSE
CALL Finale CALL Finale
END IF END IF
CASE NewGameBT CASE NewGameBT
DoNewGame` = True DoNewGame` = TRUE
InPlay` = False InPlay` = FALSE
CASE OneBT CASE OneBT
Level%% = 0 Level%% = 0
CALL MakePairs CALL MakePairs
@ -299,32 +301,32 @@ SUB __UI_FormResized
END SUB END SUB
SUB NouveauJeu SUB NouveauJeu
DoNewGame` = False DoNewGame` = FALSE
_DELAY 0.1 _DELAY 0.1
FrameRate% = 40 FrameRate% = 40
SetFrameRate FrameRate% SetFrameRate FrameRate%
Control(__UI_FormID).Width = 310 Control(__UI_FormID).Width = 310
Control(__UI_FormID).Height = 360 Control(__UI_FormID).Height = 360
Control(PelmanismLB).Disabled = False Control(PelmanismLB).Disabled = FALSE
Control(PelmanismLB).Hidden = False Control(PelmanismLB).Hidden = FALSE
Control(SetSkillLevelLB).Disabled = False Control(SetSkillLevelLB).Disabled = FALSE
Control(SetSkillLevelLB).Hidden = False Control(SetSkillLevelLB).Hidden = FALSE
Control(OneBT).Disabled = False Control(OneBT).Disabled = FALSE
Control(OneBT).Hidden = False Control(OneBT).Hidden = FALSE
Control(TwoBT).Disabled = False Control(TwoBT).Disabled = FALSE
Control(TwoBT).Hidden = False Control(TwoBT).Hidden = FALSE
Control(ThreeBT).Disabled = False Control(ThreeBT).Disabled = FALSE
Control(ThreeBT).Hidden = False Control(ThreeBT).Hidden = FALSE
Control(NewGameBT).Disabled = True Control(NewGameBT).Disabled = TRUE
Control(NewGameBT).Hidden = True Control(NewGameBT).Hidden = TRUE
Control(AudioFM).Disabled = True Control(AudioFM).Disabled = TRUE
Control(AudioFM).Hidden = True Control(AudioFM).Hidden = TRUE
Control(BestScoreLB).Disabled = True Control(BestScoreLB).Disabled = TRUE
Control(BestScoreLB).Hidden = True Control(BestScoreLB).Hidden = TRUE
Control(ScoreLB).Disabled = True Control(ScoreLB).Disabled = TRUE
Control(ScoreLB).Hidden = True Control(ScoreLB).Hidden = TRUE
Control(PairingsCompletedLB).Disabled = True Control(PairingsCompletedLB).Disabled = TRUE
Control(PairingsCompletedLB).Hidden = True Control(PairingsCompletedLB).Hidden = TRUE
Control(ExitBT).Left = Control(__UI_FormID).Width - 96 Control(ExitBT).Left = Control(__UI_FormID).Width - 96
Control(ExitBT).Top = Control(__UI_FormID).Height - 39 Control(ExitBT).Top = Control(__UI_FormID).Height - 39
SetFocus ExitBT SetFocus ExitBT
@ -351,46 +353,46 @@ SUB Finale
END SUB END SUB
SUB MakePairs SUB MakePairs
InPlay` = True InPlay` = TRUE
Score% = 0 Score% = 0
NoRemaining%% = GameLevel%%(Level%%, 0) * GameLevel%%(Level%%, 1) NoRemaining%% = GameLevel%%(Level%%, 0) * GameLevel%%(Level%%, 1)
NoPairs%% = 0 NoPairs%% = 0
FirstV%% = 50 FirstV%% = 50
ValidMouse` = False ValidMouse` = FALSE
Flipping` = False Flipping` = FALSE
TurningBack` = False TurningBack` = FALSE
FlipCount%% = 0 FlipCount%% = 0
Paused` = False Paused` = FALSE
PCount%% = 0 PCount%% = 0
FirstGo` = True FirstGo` = TRUE
REDIM Motion`(10, 6, 2), Choisi`(10, 6), Grid%%(10, 6) REDIM Motion`(10, 6, 2), Choisi`(10, 6), Grid%%(10, 6)
REDIM Selected%%(30) REDIM Selected%%(30)
RANDOMIZE (TIMER) RANDOMIZE (TIMER)
WHILE NoRemaining%% > 0 WHILE NoRemaining%% > 0
Vacant` = False Vacant` = FALSE
WHILE NOT Vacant` WHILE NOT Vacant`
HorizPos%% = 1 + INT(GameLevel%%(Level%%, 0) * RND) HorizPos%% = 1 + INT(GameLevel%%(Level%%, 0) * RND)
VertPos%% = 1 + INT(GameLevel%%(Level%%, 1) * RND) VertPos%% = 1 + INT(GameLevel%%(Level%%, 1) * RND)
IF Grid%%(HorizPos%%, VertPos%%) = 0 THEN Vacant` = True IF Grid%%(HorizPos%%, VertPos%%) = 0 THEN Vacant` = TRUE
WEND WEND
NewPair` = False NewPair` = FALSE
WHILE NOT NewPair` WHILE NOT NewPair`
PairNo%% = 1 + INT(NoObjectsLess1%% * RND) PairNo%% = 1 + INT(NoObjectsLess1%% * RND)
PairsExists` = False PairsExists` = FALSE
N%% = 1 N%% = 1
WHILE NOT PairsExists` AND N%% <= NoPairs%% WHILE NOT PairsExists` AND N%% <= NoPairs%%
IF PairNo%% = Selected%%(N%%) THEN PairsExists` = True IF PairNo%% = Selected%%(N%%) THEN PairsExists` = TRUE
N%% = N%% + 1 N%% = N%% + 1
WEND WEND
IF NOT PairsExists` THEN NewPair` = True IF NOT PairsExists` THEN NewPair` = TRUE
WEND WEND
NoPairs%% = NoPairs%% + 1 NoPairs%% = NoPairs%% + 1
Selected%%(NoPairs%%) = PairNo%% Selected%%(NoPairs%%) = PairNo%%
Grid%%(HorizPos%%, VertPos%%) = PairNo%% Grid%%(HorizPos%%, VertPos%%) = PairNo%%
Vacant` = False Vacant` = FALSE
WHILE NOT Vacant` WHILE NOT Vacant`
HorizPos%% = 1 + INT(GameLevel%%(Level%%, 0) * RND): VertPos%% = 1 + INT(GameLevel%%(Level%%, 1) * RND) HorizPos%% = 1 + INT(GameLevel%%(Level%%, 0) * RND): VertPos%% = 1 + INT(GameLevel%%(Level%%, 1) * RND)
IF Grid%%(HorizPos%%, VertPos%%) = 0 THEN Vacant` = True IF Grid%%(HorizPos%%, VertPos%%) = 0 THEN Vacant` = TRUE
WEND WEND
Selected%%(NoPairs%%) = PairNo%% Selected%%(NoPairs%%) = PairNo%%
Grid%%(HorizPos%%, VertPos%%) = PairNo%% Grid%%(HorizPos%%, VertPos%%) = PairNo%%
@ -408,24 +410,24 @@ SUB MakePairs
Control(BestScoreLB).Left = Control(__UI_FormID).Width - 178 Control(BestScoreLB).Left = Control(__UI_FormID).Width - 178
Control(ScoreLB).Left = Control(__UI_FormID).Width - 178 Control(ScoreLB).Left = Control(__UI_FormID).Width - 178
Control(PairingsCompletedLB).Left = Control(__UI_FormID).Width - 138 Control(PairingsCompletedLB).Left = Control(__UI_FormID).Width - 138
Control(PelmanismLB).Disabled = True Control(PelmanismLB).Disabled = TRUE
Control(PelmanismLB).Hidden = True Control(PelmanismLB).Hidden = TRUE
Control(SetSkillLevelLB).Disabled = True Control(SetSkillLevelLB).Disabled = TRUE
Control(SetSkillLevelLB).Hidden = True Control(SetSkillLevelLB).Hidden = TRUE
Control(OneBT).Disabled = True Control(OneBT).Disabled = TRUE
Control(OneBT).Hidden = True Control(OneBT).Hidden = TRUE
Control(TwoBT).Disabled = True Control(TwoBT).Disabled = TRUE
Control(TwoBT).Hidden = True Control(TwoBT).Hidden = TRUE
Control(ThreeBT).Disabled = True Control(ThreeBT).Disabled = TRUE
Control(ThreeBT).Hidden = True Control(ThreeBT).Hidden = TRUE
Control(NewGameBT).Disabled = False Control(NewGameBT).Disabled = FALSE
Control(NewGameBT).Hidden = False Control(NewGameBT).Hidden = FALSE
Control(AudioFM).Disabled = False Control(AudioFM).Disabled = FALSE
Control(AudioFM).Hidden = False Control(AudioFM).Hidden = FALSE
Control(BestScoreLB).Disabled = False Control(BestScoreLB).Disabled = FALSE
Control(BestScoreLB).Hidden = False Control(BestScoreLB).Hidden = FALSE
Control(ScoreLB).Disabled = False Control(ScoreLB).Disabled = FALSE
Control(ScoreLB).Hidden = False Control(ScoreLB).Hidden = FALSE
IF BestScore%(Level%%) <> 0 THEN IF BestScore%(Level%%) <> 0 THEN
Caption(BestScoreLB) = "Best Score:" + STR$(BestScore%(Level%%)) Caption(BestScoreLB) = "Best Score:" + STR$(BestScore%(Level%%))
ELSE ELSE
@ -456,15 +458,15 @@ SUB MakePairs
WHILE InPlay` WHILE InPlay`
_LIMIT 2 * FrameRate% _LIMIT 2 * FrameRate%
XMouse% = __UI_MouseLeft: YMouse% = __UI_MouseTop XMouse% = __UI_MouseLeft: YMouse% = __UI_MouseTop
ValidMouse` = False ValidMouse` = FALSE
IF XMouse% > 7 AND XMouse% < (GameLevel%%(Level%%, 0)) * 107 AND YMouse% > 7 AND YMouse% < (GameLevel%%(Level%%, 1)) * 107 THEN IF XMouse% > 7 AND XMouse% < (GameLevel%%(Level%%, 0)) * 107 AND YMouse% > 7 AND YMouse% < (GameLevel%%(Level%%, 1)) * 107 THEN
IF NOT Flipping` THEN ValidMouse` = True IF NOT Flipping` THEN ValidMouse` = TRUE
XX%% = (XMouse% - 7) \ 107 XX%% = (XMouse% - 7) \ 107
YY%% = (YMouse% - 7) \ 107 YY%% = (YMouse% - 7) \ 107
END IF END IF
K$ = INKEY$ K$ = INKEY$
IF K$ <> "" THEN IF K$ <> "" THEN
IF ASC(K$) = 27 THEN InPlay` = False IF ASC(K$) = 27 THEN InPlay` = FALSE
END IF END IF
K$ = "" K$ = ""
__UI_DoEvents __UI_DoEvents
@ -476,6 +478,3 @@ SUB MakePairs
CALL Finale CALL Finale
END IF END IF
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -22,6 +22,8 @@ DIM SHARED Horiz%%, Vert%%, InPlay`, Level%%, MoveIt%%, ValidSquare`
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'PictureGrid.frm' '$INCLUDE:'PictureGrid.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures & Functions: --------------------------------------------------------------- ': Event procedures & Functions: ---------------------------------------------------------------
FUNCTION MakeHardware& (Img&) FUNCTION MakeHardware& (Img&)
@ -43,7 +45,7 @@ SUB __UI_BeforeInit
READ Portraits$(N%%) READ Portraits$(N%%)
NEXT N%% NEXT N%%
FrameRate% = 30 FrameRate% = 30
InPlay` = False InPlay` = FALSE
game_data: game_data:
DATA 2,3 DATA 2,3
@ -53,8 +55,8 @@ SUB __UI_BeforeInit
END SUB END SUB
SUB __UI_OnLoad SUB __UI_OnLoad
Control(NewGameBT).Disabled = True Control(NewGameBT).Disabled = TRUE
Control(NewGameBT).Hidden = True Control(NewGameBT).Hidden = TRUE
CALL JeuNouveau CALL JeuNouveau
SetFrameRate FrameRate% SetFrameRate FrameRate%
END SUB END SUB
@ -130,7 +132,7 @@ SUB __UI_Click (id AS LONG)
CASE ExitBT CASE ExitBT
SYSTEM SYSTEM
CASE NewGameBT CASE NewGameBT
InPlay` = False InPlay` = FALSE
END SELECT END SELECT
END SUB END SUB
@ -171,18 +173,18 @@ END SUB
SUB JeuNouveau SUB JeuNouveau
Control(__UI_FormID).Width = 310 Control(__UI_FormID).Width = 310
Control(__UI_FormID).Height = 360 Control(__UI_FormID).Height = 360
Control(PictureGridLB).Disabled = False Control(PictureGridLB).Disabled = FALSE
Control(PictureGridLB).Hidden = False Control(PictureGridLB).Hidden = FALSE
Control(SetSkillLevelLB).Disabled = False Control(SetSkillLevelLB).Disabled = FALSE
Control(SetSkillLevelLB).Hidden = False Control(SetSkillLevelLB).Hidden = FALSE
Control(OneBT).Disabled = False Control(OneBT).Disabled = FALSE
Control(OneBT).Hidden = False Control(OneBT).Hidden = FALSE
Control(TwoBT).Disabled = False Control(TwoBT).Disabled = FALSE
Control(TwoBT).Hidden = False Control(TwoBT).Hidden = FALSE
Control(ThreeBT).Disabled = False Control(ThreeBT).Disabled = FALSE
Control(ThreeBT).Hidden = False Control(ThreeBT).Hidden = FALSE
Control(NewGameBT).Disabled = True Control(NewGameBT).Disabled = TRUE
Control(NewGameBT).Hidden = True Control(NewGameBT).Hidden = TRUE
Control(ExitBT).Top = Control(__UI_FormID).Height - 39 Control(ExitBT).Top = Control(__UI_FormID).Height - 39
Control(ExitBT).Left = Control(__UI_FormID).Width - 96 Control(ExitBT).Left = Control(__UI_FormID).Width - 96
SetFocus ExitBT SetFocus ExitBT
@ -191,16 +193,16 @@ END SUB
SUB Slider SUB Slider
Control(__UI_FormID).Width = (2 * ScreenWidth%) + 10 Control(__UI_FormID).Width = (2 * ScreenWidth%) + 10
Control(__UI_FormID).Height = ScreenHeight% Control(__UI_FormID).Height = ScreenHeight%
Control(PictureGridLB).Disabled = True Control(PictureGridLB).Disabled = TRUE
Control(PictureGridLB).Hidden = True Control(PictureGridLB).Hidden = TRUE
Control(SetSkillLevelLB).Disabled = True Control(SetSkillLevelLB).Disabled = TRUE
Control(SetSkillLevelLB).Hidden = True Control(SetSkillLevelLB).Hidden = TRUE
Control(OneBT).Disabled = True Control(OneBT).Disabled = TRUE
Control(OneBT).Hidden = True Control(OneBT).Hidden = TRUE
Control(TwoBT).Disabled = True Control(TwoBT).Disabled = TRUE
Control(TwoBT).Hidden = True Control(TwoBT).Hidden = TRUE
Control(ThreeBT).Disabled = True Control(ThreeBT).Disabled = TRUE
Control(ThreeBT).Hidden = True Control(ThreeBT).Hidden = TRUE
Control(ExitBT).Top = Control(__UI_FormID).Height - 39 Control(ExitBT).Top = Control(__UI_FormID).Height - 39
Control(ExitBT).Left = Control(__UI_FormID).Width - 96 Control(ExitBT).Left = Control(__UI_FormID).Width - 96
Control(NewGameBT).Top = Control(__UI_FormID).Height - 73 Control(NewGameBT).Top = Control(__UI_FormID).Height - 73
@ -251,14 +253,14 @@ SUB Slider
LINE (0, 0)-(ScreenWidth% / RowCol%%(Level%%, 0) - 4, ScreenHeight%% / RowCol%%(Level%%, 1) - 4), , B LINE (0, 0)-(ScreenWidth% / RowCol%%(Level%%, 0) - 4, ScreenHeight%% / RowCol%%(Level%%, 1) - 4), , B
LINE (1, 1)-(ScreenWidth% / RowCol%%(Level%%, 0) - 5, ScreenHeight%% / RowCol%%(Level%%, 1) - 5), , B LINE (1, 1)-(ScreenWidth% / RowCol%%(Level%%, 0) - 5, ScreenHeight%% / RowCol%%(Level%%, 1) - 5), , B
Highlight& = MakeHardware&(TempImg&) Highlight& = MakeHardware&(TempImg&)
ValidSquare` = False ValidSquare` = FALSE
InPlay` = True InPlay` = TRUE
IsComplete` = False IsComplete` = FALSE
WHILE InPlay` WHILE InPlay`
_LIMIT 2 * FrameRate% _LIMIT 2 * FrameRate%
XMouse% = __UI_MouseLeft XMouse% = __UI_MouseLeft
YMouse% = __UI_MouseTop YMouse% = __UI_MouseTop
ValidSquare` = False ValidSquare` = FALSE
IF NOT IsComplete` THEN IF NOT IsComplete` THEN
Horiz%% = 1 + ((XMouse% - 3) \ (ScreenWidth% / RowCol%%(Level%%, 0))) Horiz%% = 1 + ((XMouse% - 3) \ (ScreenWidth% / RowCol%%(Level%%, 0)))
Vert%% = 1 + ((YMouse% - 3) \ (ScreenHeight%% / RowCol%%(Level%%, 1))) Vert%% = 1 + ((YMouse% - 3) \ (ScreenHeight%% / RowCol%%(Level%%, 1)))
@ -269,25 +271,25 @@ SUB Slider
IF ModHoriz% < ScreenWidth% / RowCol%%(Level%%, 0) - 6 AND ModVert% < ScreenHeight%% / RowCol%%(Level%%, 1) - 6 THEN IF ModHoriz% < ScreenWidth% / RowCol%%(Level%%, 0) - 6 AND ModVert% < ScreenHeight%% / RowCol%%(Level%%, 1) - 6 THEN
IF Grid%%(Horiz%% + 1, Vert%%) = 0 AND Horiz%% + 1 <= RowCol%%(Level%%, 0) THEN IF Grid%%(Horiz%% + 1, Vert%%) = 0 AND Horiz%% + 1 <= RowCol%%(Level%%, 0) THEN
MoveIt%% = 1 MoveIt%% = 1
ValidSquare` = True ValidSquare` = TRUE
ELSEIF Grid%%(Horiz%%, Vert%% + 1) = 0 AND Vert%% + 1 <= RowCol%%(Level%%, 1) THEN ELSEIF Grid%%(Horiz%%, Vert%% + 1) = 0 AND Vert%% + 1 <= RowCol%%(Level%%, 1) THEN
MoveIt%% = 2 MoveIt%% = 2
ValidSquare` = True ValidSquare` = TRUE
ELSEIF Grid%%(Horiz%% - 1, Vert%%) = 0 AND Horiz%% - 1 > 0 THEN ELSEIF Grid%%(Horiz%% - 1, Vert%%) = 0 AND Horiz%% - 1 > 0 THEN
MoveIt%% = 3 MoveIt%% = 3
ValidSquare` = True ValidSquare` = TRUE
ELSEIF Grid%%(Horiz%%, Vert%% - 1) = 0 AND Vert%% - 1 > 0 THEN ELSEIF Grid%%(Horiz%%, Vert%% - 1) = 0 AND Vert%% - 1 > 0 THEN
MoveIt%% = 4 MoveIt%% = 4
ValidSquare` = True ValidSquare` = TRUE
END IF END IF
END IF END IF
END IF END IF
END IF END IF
AllCorrect` = True AllCorrect` = TRUE
N%% = 1: M%% = 1 N%% = 1: M%% = 1
WHILE AllCorrect` AND (M%% + RowCol%%(Level%%, 1) * (N%% - 1)) < RowCol%%(Level%%, 0) * RowCol%%(Level%%, 1) WHILE AllCorrect` AND (M%% + RowCol%%(Level%%, 1) * (N%% - 1)) < RowCol%%(Level%%, 0) * RowCol%%(Level%%, 1)
IF Grid%%(N%%, M%%) <> M%% + RowCol%%(Level%%, 1) * (N%% - 1) THEN IF Grid%%(N%%, M%%) <> M%% + RowCol%%(Level%%, 1) * (N%% - 1) THEN
AllCorrect` = False AllCorrect` = FALSE
ELSE ELSE
M%% = M%% + 1 M%% = M%% + 1
IF M%% > RowCol%%(Level%%, 1) THEN IF M%% > RowCol%%(Level%%, 1) THEN
@ -298,9 +300,9 @@ SUB Slider
WEND WEND
IF AllCorrect` THEN IF AllCorrect` THEN
_SNDPLAYFILE ("fanfare.mp3") _SNDPLAYFILE ("fanfare.mp3")
Control(NewGameBT).Disabled = False Control(NewGameBT).Disabled = FALSE
Control(NewGameBT).Hidden = False Control(NewGameBT).Hidden = FALSE
IsComplete` = True IsComplete` = TRUE
SetFocus NewGameBT SetFocus NewGameBT
END IF END IF
END IF END IF
@ -311,10 +313,7 @@ SUB Slider
K$ = "" K$ = ""
__UI_DoEvents __UI_DoEvents
WEND WEND
ValidSquare` = False ValidSquare` = FALSE
_FREEIMAGE Highlight& _FREEIMAGE Highlight&
CALL JeuNouveau CALL JeuNouveau
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -49,6 +49,8 @@ DIM SHARED PlayBT AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'PlayFX.frm' '$INCLUDE:'PlayFX.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Custom procedures: -------------------------------------------------------------- ': Custom procedures: --------------------------------------------------------------
FUNCTION IsDifferentWaveform%% (w1 AS WaveformType, w2 AS WaveformType) FUNCTION IsDifferentWaveform%% (w1 AS WaveformType, w2 AS WaveformType)
@ -69,7 +71,7 @@ SUB SetConfigControls (id AS LONG, curCtrl AS LONG)
END SUB END SUB
SUB ClearWaveform (id AS LONG) SUB ClearWaveform (id AS LONG)
Waveform(id).active = False ' set not in use Waveform(id).active = FALSE ' set not in use
Waveform(id).waveform = 3 ' triangle Waveform(id).waveform = 3 ' triangle
Waveform(id).note = 42 ' half-way through the scale Waveform(id).note = 42 ' half-way through the scale
Waveform(id).length = 4 ' quarter Waveform(id).length = 4 ' quarter
@ -594,7 +596,7 @@ SUB __UI_ValueChanged (id AS LONG)
IF IsDifferentWaveform(temp, Waveform(currentWaveform)) THEN IF IsDifferentWaveform(temp, Waveform(currentWaveform)) THEN
Waveform(currentWaveform) = temp Waveform(currentWaveform) = temp
Waveform(currentWaveform).active = True Waveform(currentWaveform).active = TRUE
END IF END IF
MakePlayString MakePlayString
@ -604,6 +606,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -28,6 +28,9 @@ DIM SHARED assetslizardpngPX AS LONG
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'RockHandScissor.frm' '$INCLUDE:'RockHandScissor.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -39,10 +42,10 @@ SUB __UI_OnLoad
Caption(LB) = "0000" Caption(LB) = "0000"
PlayerChoose = 0 PlayerChoose = 0
RANDOMIZE TIMER RANDOMIZE TIMER
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = True ' hide help label Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = TRUE ' hide help label
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = True Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = TRUE
Control(Frame2).Hidden = True ' hide frame2 Control(Frame2).Hidden = TRUE ' hide frame2
Control(Frame2).Disabled = True Control(Frame2).Disabled = TRUE
END SUB END SUB
SUB __UI_BeforeUpdateDisplay SUB __UI_BeforeUpdateDisplay
@ -75,62 +78,62 @@ SUB __UI_Click (id AS LONG)
CASE assetscartajpegPX CASE assetscartajpegPX
' user chooses to play paper ' user chooses to play paper
Control(assetssassojpegPX).Disabled = True ' hide images of rock and scissor Control(assetssassojpegPX).Disabled = TRUE ' hide images of rock and scissor
Control(assetsforbicepngPX).Disabled = True Control(assetsforbicepngPX).Disabled = TRUE
Control(assetsspokpngPX).Disabled = True Control(assetsspokpngPX).Disabled = TRUE
Control(assetslizardpngPX).Disabled = True Control(assetslizardpngPX).Disabled = TRUE
Control(assetssassojpegPX).Hidden = True Control(assetssassojpegPX).Hidden = TRUE
Control(assetsforbicepngPX).Hidden = True Control(assetsforbicepngPX).Hidden = TRUE
Control(assetsspokpngPX).Hidden = True Control(assetsspokpngPX).Hidden = TRUE
Control(assetslizardpngPX).Hidden = True Control(assetslizardpngPX).Hidden = TRUE
Control(assetsRPSLS_helpjpgPX).Disabled = True ' hide AI's choice Control(assetsRPSLS_helpjpgPX).Disabled = TRUE ' hide AI's choice
Control(assetsRPSLS_helpjpgPX).Hidden = True Control(assetsRPSLS_helpjpgPX).Hidden = TRUE
playAI paper playAI paper
CASE assetssassojpegPX CASE assetssassojpegPX
' user chooses to play rock ' user chooses to play rock
Control(assetscartajpegPX).Disabled = True ' hide paper and scissor Control(assetscartajpegPX).Disabled = TRUE ' hide paper and scissor
Control(assetsforbicepngPX).Disabled = True Control(assetsforbicepngPX).Disabled = TRUE
Control(assetsspokpngPX).Disabled = True Control(assetsspokpngPX).Disabled = TRUE
Control(assetslizardpngPX).Disabled = True Control(assetslizardpngPX).Disabled = TRUE
Control(assetsspokpngPX).Hidden = True Control(assetsspokpngPX).Hidden = TRUE
Control(assetslizardpngPX).Hidden = True Control(assetslizardpngPX).Hidden = TRUE
Control(assetscartajpegPX).Hidden = True Control(assetscartajpegPX).Hidden = TRUE
Control(assetsforbicepngPX).Hidden = True Control(assetsforbicepngPX).Hidden = TRUE
Control(assetsRPSLS_helpjpgPX).Disabled = True ' hide AI's choice Control(assetsRPSLS_helpjpgPX).Disabled = TRUE ' hide AI's choice
Control(assetsRPSLS_helpjpgPX).Hidden = True Control(assetsRPSLS_helpjpgPX).Hidden = TRUE
playAI rock playAI rock
CASE assetsforbicepngPX CASE assetsforbicepngPX
'user chooses to play scissor 'user chooses to play scissor
Control(assetssassojpegPX).Disabled = True ' hide rock and paper Control(assetssassojpegPX).Disabled = TRUE ' hide rock and paper
Control(assetscartajpegPX).Disabled = True Control(assetscartajpegPX).Disabled = TRUE
Control(assetsspokpngPX).Disabled = True Control(assetsspokpngPX).Disabled = TRUE
Control(assetslizardpngPX).Disabled = True Control(assetslizardpngPX).Disabled = TRUE
Control(assetsspokpngPX).Hidden = True Control(assetsspokpngPX).Hidden = TRUE
Control(assetslizardpngPX).Hidden = True Control(assetslizardpngPX).Hidden = TRUE
Control(assetssassojpegPX).Hidden = True Control(assetssassojpegPX).Hidden = TRUE
Control(assetscartajpegPX).Hidden = True Control(assetscartajpegPX).Hidden = TRUE
Control(assetsRPSLS_helpjpgPX).Disabled = True ' hide AI's choice Control(assetsRPSLS_helpjpgPX).Disabled = TRUE ' hide AI's choice
Control(assetsRPSLS_helpjpgPX).Hidden = True Control(assetsRPSLS_helpjpgPX).Hidden = TRUE
playAI scissor playAI scissor
CASE assetsspokpngPX CASE assetsspokpngPX
Control(assetssassojpegPX).Disabled = True ' hide rock and paper Control(assetssassojpegPX).Disabled = TRUE ' hide rock and paper
Control(assetscartajpegPX).Disabled = True Control(assetscartajpegPX).Disabled = TRUE
Control(assetsforbicepngPX).Disabled = True Control(assetsforbicepngPX).Disabled = TRUE
Control(assetslizardpngPX).Disabled = True Control(assetslizardpngPX).Disabled = TRUE
Control(assetsforbicepngPX).Hidden = True Control(assetsforbicepngPX).Hidden = TRUE
Control(assetslizardpngPX).Hidden = True Control(assetslizardpngPX).Hidden = TRUE
Control(assetssassojpegPX).Hidden = True Control(assetssassojpegPX).Hidden = TRUE
Control(assetscartajpegPX).Hidden = True Control(assetscartajpegPX).Hidden = TRUE
playAI spok playAI spok
CASE assetslizardpngPX CASE assetslizardpngPX
Control(assetssassojpegPX).Disabled = True ' hide rock and paper Control(assetssassojpegPX).Disabled = TRUE ' hide rock and paper
Control(assetscartajpegPX).Disabled = True Control(assetscartajpegPX).Disabled = TRUE
Control(assetsspokpngPX).Disabled = True Control(assetsspokpngPX).Disabled = TRUE
Control(assetsforbicepngPX).Disabled = True Control(assetsforbicepngPX).Disabled = TRUE
Control(assetsspokpngPX).Hidden = True Control(assetsspokpngPX).Hidden = TRUE
Control(assetsforbicepngPX).Hidden = True Control(assetsforbicepngPX).Hidden = TRUE
Control(assetssassojpegPX).Hidden = True Control(assetssassojpegPX).Hidden = TRUE
Control(assetscartajpegPX).Hidden = True Control(assetscartajpegPX).Hidden = TRUE
playAI lizard playAI lizard
CASE RockHandScissor CASE RockHandScissor
@ -139,68 +142,68 @@ SUB __UI_Click (id AS LONG)
CASE Frame1 CASE Frame1
CASE StartBT CASE StartBT
Control(HelpBT).Disabled = True Control(HelpBT).Disabled = TRUE
Control(Frame2).Hidden = False ' show frame2 Control(Frame2).Hidden = FALSE ' show frame2
Control(Frame2).Disabled = False Control(Frame2).Disabled = FALSE
Control(assetssassojpegPX).Disabled = False ' show and activate 3 image buttons for user Control(assetssassojpegPX).Disabled = FALSE ' show and activate 3 image buttons for user
Control(assetsforbicepngPX).Disabled = False Control(assetsforbicepngPX).Disabled = FALSE
Control(assetscartajpegPX).Disabled = False Control(assetscartajpegPX).Disabled = FALSE
Control(assetsspokpngPX).Disabled = False Control(assetsspokpngPX).Disabled = FALSE
Control(assetslizardpngPX).Disabled = False Control(assetslizardpngPX).Disabled = FALSE
Control(assetssassojpegPX).Hidden = False Control(assetssassojpegPX).Hidden = FALSE
Control(assetsforbicepngPX).Hidden = False Control(assetsforbicepngPX).Hidden = FALSE
Control(assetscartajpegPX).Hidden = False Control(assetscartajpegPX).Hidden = FALSE
Control(assetsspokpngPX).Hidden = False Control(assetsspokpngPX).Hidden = FALSE
Control(assetslizardpngPX).Hidden = False Control(assetslizardpngPX).Hidden = FALSE
Control(assetsRPSLS_helpjpgPX).Hidden = True ' hide help/AI image Control(assetsRPSLS_helpjpgPX).Hidden = TRUE ' hide help/AI image
Control(assetsRPSLS_helpjpgPX).Disabled = True Control(assetsRPSLS_helpjpgPX).Disabled = TRUE
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = True ' hide help label Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = TRUE ' hide help label
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = True Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = TRUE
CASE ExitBT CASE ExitBT
SYSTEM ' exit from program SYSTEM ' exit from program
CASE HelpBT CASE HelpBT
IF Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = False THEN IF Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = FALSE THEN
' here we reactivate the game ' here we reactivate the game
Control(StartBT).Disabled = False Control(StartBT).Disabled = FALSE
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = True ' hide help label Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = TRUE ' hide help label
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = True Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = TRUE
Caption(ChooseYourMoveAndWaitAIsOneLB) = "Choose your move and wait AI's one" Caption(ChooseYourMoveAndWaitAIsOneLB) = "Choose your move and wait AI's one"
Control(Frame2).Hidden = True ' hide frame2 Control(Frame2).Hidden = TRUE ' hide frame2
Control(Frame2).Disabled = True Control(Frame2).Disabled = TRUE
Control(assetssassojpegPX).Disabled = False ' activate 5 image button for user Control(assetssassojpegPX).Disabled = FALSE ' activate 5 image button for user
Control(assetsforbicepngPX).Disabled = False Control(assetsforbicepngPX).Disabled = FALSE
Control(assetscartajpegPX).Disabled = False Control(assetscartajpegPX).Disabled = FALSE
Control(assetsspokpngPX).Disabled = False Control(assetsspokpngPX).Disabled = FALSE
Control(assetslizardpngPX).Disabled = False Control(assetslizardpngPX).Disabled = FALSE
Control(assetssassojpegPX).Hidden = False Control(assetssassojpegPX).Hidden = FALSE
Control(assetsforbicepngPX).Hidden = False Control(assetsforbicepngPX).Hidden = FALSE
Control(assetscartajpegPX).Hidden = False Control(assetscartajpegPX).Hidden = FALSE
Control(assetsspokpngPX).Hidden = False Control(assetsspokpngPX).Hidden = FALSE
Control(assetslizardpngPX).Hidden = False Control(assetslizardpngPX).Hidden = FALSE
ELSE ELSE
' here we show the help ' here we show the help
Control(StartBT).Disabled = True 'disable help button Control(StartBT).Disabled = TRUE 'disable help button
Caption(ChooseYourMoveAndWaitAIsOneLB) = "Choose your move and wait AI's one" Caption(ChooseYourMoveAndWaitAIsOneLB) = "Choose your move and wait AI's one"
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = False ' show help label Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = FALSE ' show help label
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = False Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = FALSE
Control(assetssassojpegPX).Disabled = True ' hide 5 image button for user Control(assetssassojpegPX).Disabled = TRUE ' hide 5 image button for user
Control(assetsforbicepngPX).Disabled = True Control(assetsforbicepngPX).Disabled = TRUE
Control(assetscartajpegPX).Disabled = True Control(assetscartajpegPX).Disabled = TRUE
Control(assetsspokpngPX).Disabled = True Control(assetsspokpngPX).Disabled = TRUE
Control(assetslizardpngPX).Disabled = True Control(assetslizardpngPX).Disabled = TRUE
Control(assetssassojpegPX).Hidden = True Control(assetssassojpegPX).Hidden = TRUE
Control(assetsforbicepngPX).Hidden = True Control(assetsforbicepngPX).Hidden = TRUE
Control(assetscartajpegPX).Hidden = True Control(assetscartajpegPX).Hidden = TRUE
Control(assetsspokpngPX).Hidden = True Control(assetsspokpngPX).Hidden = TRUE
Control(assetslizardpngPX).Hidden = True Control(assetslizardpngPX).Hidden = TRUE
Control(Frame2).Hidden = False 'show frame2 Control(Frame2).Hidden = FALSE 'show frame2
Control(Frame2).Disabled = False Control(Frame2).Disabled = FALSE
LoadImage Control(assetsRPSLS_helpjpgPX), "assets\RPSLS_help.jpg" ' load and show help picture LoadImage Control(assetsRPSLS_helpjpgPX), "assets\RPSLS_help.jpg" ' load and show help picture
Control(assetsRPSLS_helpjpgPX).Redraw = True Control(assetsRPSLS_helpjpgPX).Redraw = TRUE
END IF END IF
CASE LB CASE LB
@ -212,27 +215,27 @@ SUB __UI_Click (id AS LONG)
END SUB END SUB
SUB restoreGame SUB restoreGame
Control(assetssassojpegPX).Disabled = False 'activate 5 image buttons for user Control(assetssassojpegPX).Disabled = FALSE 'activate 5 image buttons for user
Control(assetsforbicepngPX).Disabled = False Control(assetsforbicepngPX).Disabled = FALSE
Control(assetscartajpegPX).Disabled = False Control(assetscartajpegPX).Disabled = FALSE
Control(assetsspokpngPX).Disabled = False Control(assetsspokpngPX).Disabled = FALSE
Control(assetslizardpngPX).Disabled = False Control(assetslizardpngPX).Disabled = FALSE
Control(assetsspokpngPX).Hidden = False Control(assetsspokpngPX).Hidden = FALSE
Control(assetslizardpngPX).Hidden = False Control(assetslizardpngPX).Hidden = FALSE
Control(assetssassojpegPX).Hidden = False Control(assetssassojpegPX).Hidden = FALSE
Control(assetsforbicepngPX).Hidden = False Control(assetsforbicepngPX).Hidden = FALSE
Control(assetscartajpegPX).Hidden = False Control(assetscartajpegPX).Hidden = FALSE
Control(HelpBT).Disabled = False ' activate help button Control(HelpBT).Disabled = FALSE ' activate help button
Control(assetsRPSLS_helpjpgPX).Redraw = True ' force to show AI's choice Control(assetsRPSLS_helpjpgPX).Redraw = TRUE ' force to show AI's choice
PlayerChoose = 0 ' reset the chooser game PlayerChoose = 0 ' reset the chooser game
END SUB END SUB
SUB results (result AS INTEGER) SUB results (result AS INTEGER)
'here there is the output sound + images for user 'here there is the output sound + images for user
' and adjourn score of game ' and adjourn score of game
Control(assetsRPSLS_helpjpgPX).Hidden = False ' show image of ai's choice Control(assetsRPSLS_helpjpgPX).Hidden = FALSE ' show image of ai's choice
Control(assetsRPSLS_helpjpgPX).Disabled = False Control(assetsRPSLS_helpjpgPX).Disabled = FALSE
Control(assetsRPSLS_helpjpgPX).Redraw = True ' force to show image of ai's choice Control(assetsRPSLS_helpjpgPX).Redraw = TRUE ' force to show image of ai's choice
SELECT CASE result SELECT CASE result
CASE wins CASE wins
Caption(LB) = STR$(VAL(Caption(LB)) + 10) Caption(LB) = STR$(VAL(Caption(LB)) + 10)
@ -244,16 +247,16 @@ SUB results (result AS INTEGER)
Caption(LB) = STR$(VAL(Caption(LB)) - 10) Caption(LB) = STR$(VAL(Caption(LB)) - 10)
Caption(ChooseYourMoveAndWaitAIsOneLB) = " YOU LOOSE!! " Caption(ChooseYourMoveAndWaitAIsOneLB) = " YOU LOOSE!! "
END SELECT END SELECT
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = False 'show result as text in helplabel Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = FALSE 'show result as text in helplabel
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = False Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = FALSE
END SUB END SUB
SUB playAI (choose AS INTEGER) SUB playAI (choose AS INTEGER)
PlayerChoose = 1 ' the user has made his choice PlayerChoose = 1 ' the user has made his choice
DIM choosen AS INTEGER DIM choosen AS INTEGER
choosen = INT(RND * 5) + 1 ' ai chooses choosen = INT(RND * 5) + 1 ' ai chooses
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = True ' hide help label Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = TRUE ' hide help label
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = True Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = TRUE
LoadImage Control(assetsRPSLS_helpjpgPX), "" ' reset to null image of ai's choice LoadImage Control(assetsRPSLS_helpjpgPX), "" ' reset to null image of ai's choice
SELECT CASE choosen SELECT CASE choosen
@ -583,6 +586,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -21,6 +21,8 @@ DIM SHARED elapsed AS SINGLE
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Stopwatch.frm' '$INCLUDE:'Stopwatch.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -73,15 +75,15 @@ SUB __UI_Click (id AS LONG)
CASE StartBT CASE StartBT
IF Running THEN IF Running THEN
Caption(id) = "Start" Caption(id) = "Start"
Running = False Running = FALSE
Control(StopBT).Disabled = False Control(StopBT).Disabled = FALSE
Control(LapBT).Disabled = True Control(LapBT).Disabled = TRUE
ELSE ELSE
Caption(id) = "Pause" Caption(id) = "Pause"
start = TIMER - elapsed start = TIMER - elapsed
Running = True Running = TRUE
Control(StopBT).Disabled = True Control(StopBT).Disabled = TRUE
Control(LapBT).Disabled = False Control(LapBT).Disabled = FALSE
END IF END IF
CASE LapBT CASE LapBT
AddItem ListBox1, Caption(TimeLB) AddItem ListBox1, Caption(TimeLB)
@ -219,6 +221,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -1,5 +1,5 @@
' Text Fetch.bas started b+ 2019-11-12 from other work with Dirs and Files loading ' Text Fetch.bas started b+ 2019-11-12 from other work with Dirs and Files loading
' Changes and updates by a740g (24-June-2023). Also simplified direntry.h ' Changes and updates by a740g (1-Dec-2023). Also simplified direntry.h
' '
': This program uses ': This program uses
': InForm - GUI library for QB64 - v1.0 ': InForm - GUI library for QB64 - v1.0
@ -28,6 +28,8 @@ DIM SHARED lbEnd AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'TextFetch.frm' '$INCLUDE:'TextFetch.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
' --- DIRENTRY STUFF --- ' --- DIRENTRY STUFF ---
@ -59,7 +61,7 @@ SUB loadText
FOR i = VAL(Caption(lbStart)) TO VAL(Caption(lbEnd)) FOR i = VAL(Caption(lbStart)) TO VAL(Caption(lbEnd))
b$ = GetItem$(ListFile, i) b$ = GetItem$(ListFile, i)
AddItem ListTxt, GetItem$(ListFile, i) AddItem ListTxt, GetItem$(ListFile, i)
IF clip$ = "" THEN clip$ = b$ ELSE clip$ = clip$ + CHR$(13) + CHR$(10) + b$ IF LEN(clip$) = 0 THEN clip$ = b$ ELSE clip$ = clip$ + CHR$(13) + CHR$(10) + b$
NEXT NEXT
_CLIPBOARD$ = clip$ _CLIPBOARD$ = clip$
Caption(lbTxt) = "Selected Text (in Clipboard):" Caption(lbTxt) = "Selected Text (in Clipboard):"
@ -93,24 +95,29 @@ FUNCTION GetCurDirLists& (DirList() AS STRING, FileList() AS STRING)
DIM dirName AS STRING: dirName = _CWD$ ' we'll enumerate the current directory contents DIM dirName AS STRING: dirName = _CWD$ ' we'll enumerate the current directory contents
DIM AS LONG dirCount, fileCount, flags, fileSize DIM AS LONG dirCount, fileCount, flags, fileSize
DIM entryName AS STRING DIM entryName AS STRING, ext AS STRING
IF open_dir(dirName) THEN IF open_dir(dirName) THEN
DO DO
entryName = read_dir(flags, fileSize) entryName = read_dir(flags, fileSize)
IF entryName <> "" THEN IF LEN(entryName) <> 0 THEN
SELECT CASE flags SELECT CASE flags
CASE 1 CASE 1
IF dirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(0 TO UBOUND(DirList) + RESIZE_BLOCK_SIZE) AS STRING IF dirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(0 TO UBOUND(DirList) + RESIZE_BLOCK_SIZE) AS STRING
DirList(dirCount) = entryName DirList(dirCount) = entryName
dirCount = dirCount + 1 dirCount = dirCount + 1
CASE 2 CASE 2
ext = LCASE$(MID$(entryName, 1 + _INSTRREV(entryName, ".")))
SELECT CASE ext
CASE "", "txt", "log", "md", "lst", "bas", "bi", "bm", "frm", "vb", "cls", "c", "cpp", "h", "cc", "cxx", "c++", "hh", "hpp", "hxx", "h++", "cppm", "ixx"
IF fileCount > UBOUND(FileList) THEN REDIM _PRESERVE FileList(0 TO UBOUND(FileList) + RESIZE_BLOCK_SIZE) AS STRING IF fileCount > UBOUND(FileList) THEN REDIM _PRESERVE FileList(0 TO UBOUND(FileList) + RESIZE_BLOCK_SIZE) AS STRING
FileList(fileCount) = entryName FileList(fileCount) = entryName
fileCount = fileCount + 1 fileCount = fileCount + 1
END SELECT END SELECT
END SELECT
END IF END IF
LOOP UNTIL entryName = "" LOOP UNTIL LEN(entryName) = 0
close_dir close_dir
END IF END IF
@ -441,6 +448,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -15,8 +15,11 @@ DIM SHARED ContextMenu1Copy AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'ThemePreview.frm' '$INCLUDE:'ThemePreview.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
END SUB END SUB
@ -147,13 +150,10 @@ SUB __UI_ValueChanged (id AS LONG)
CASE DropdownList1 CASE DropdownList1
_FREEIMAGE Control(PictureBox1).HelperCanvas _FREEIMAGE Control(PictureBox1).HelperCanvas
Control(PictureBox1).HelperCanvas = _COPYIMAGE(__UI_LoadThemeImage(GetItem$(DropdownList1, Control(DropdownList1).Value))) Control(PictureBox1).HelperCanvas = _COPYIMAGE(__UI_LoadThemeImage(GetItem$(DropdownList1, Control(DropdownList1).Value)))
Control(PictureBox1).Redraw = True Control(PictureBox1).Redraw = TRUE
END SELECT END SELECT
END SUB END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -21,9 +21,12 @@ DIM SHARED Button8 AS LONG
DIM SHARED Button9 AS LONG DIM SHARED Button9 AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'../../InForm/extensions/MessageBox.bi' '$INCLUDE:'../../InForm/extensions/MessageBox.bi'
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'TicTacToe.frm' '$INCLUDE:'TicTacToe.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -260,7 +263,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'

View file

@ -21,9 +21,12 @@ DIM SHARED Button8 AS LONG
DIM SHARED Button9 AS LONG DIM SHARED Button9 AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'../../InForm/extensions/MessageBox.bi' '$INCLUDE:'../../InForm/extensions/MessageBox.bi'
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'TicTacToe2.frm' '$INCLUDE:'TicTacToe2.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -179,7 +182,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'

View file

@ -48,9 +48,13 @@ DATA 254,36541,652,12587,23698741,98523,458,56974,685
FOR M%% = 1 TO noCells%%: READ TrackWord$(M%%): NEXT M%% FOR M%% = 1 TO noCells%%: READ TrackWord$(M%%): NEXT M%%
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'../../InForm/extensions/MessageBox.bi' '$INCLUDE:'../../InForm/extensions/MessageBox.bi'
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'Trackword.frm' '$INCLUDE:'Trackword.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
FUNCTION snake2word$ (snakey$) FUNCTION snake2word$ (snakey$)
' Use the dim shared theWord$ to translate snake number string to letters ' Use the dim shared theWord$ to translate snake number string to letters
@ -69,14 +73,14 @@ END FUNCTION
FUNCTION Located%% (S2$) FUNCTION Located%% (S2$)
'Proven to work in all circustances 'Proven to work in all circustances
__Located%% = False __Located%% = FALSE
P0& = 1 P0& = 1
P100& = Entries& P100& = Entries&
WHILE P0& <= P100& AND NOT __Located%% WHILE P0& <= P100& AND NOT __Located%%
P50& = INT((P0& + P100&) / 2) P50& = INT((P0& + P100&) / 2)
IF S2$ = words$(P50&) THEN IF S2$ = words$(P50&) THEN
__Located%% = True __Located%% = TRUE
ELSEIF S2$ > words$(P50&) THEN ELSEIF S2$ > words$(P50&) THEN
P0& = P50& + 1 P0& = P50& + 1
ELSE ELSE
@ -87,7 +91,6 @@ FUNCTION Located%% (S2$)
Located = __Located%% Located = __Located%%
END FUNCTION END FUNCTION
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
'Trackword Confiuration File 'Trackword Confiuration File
@ -170,12 +173,12 @@ SUB __UI_Click (id AS LONG)
'Search for 9-letter word & place in grid 'Search for 9-letter word & place in grid
OPEN "dictionary.rnd" FOR RANDOM AS #1 LEN = 9 OPEN "dictionary.rnd" FOR RANDOM AS #1 LEN = 9
FIELD #1, 9 AS Lex$ FIELD #1, 9 AS Lex$
NineLetters` = False NineLetters` = FALSE
WHILE NOT NineLetters` WHILE NOT NineLetters`
Sel& = INT(Entries& * RND) + 1 Sel& = INT(Entries& * RND) + 1
GET #1, Sel& GET #1, Sel&
OutWord$ = RTRIM$(Lex$) OutWord$ = RTRIM$(Lex$)
IF LEN(OutWord$) = 9 THEN NineLetters` = True IF LEN(OutWord$) = 9 THEN NineLetters` = TRUE
WEND WEND
CLOSE #1 CLOSE #1
theWord$ = "*********" theWord$ = "*********"
@ -221,60 +224,60 @@ SUB __UI_Click (id AS LONG)
Caption(WordsFoundLB) = "Words Found" Caption(WordsFoundLB) = "Words Found"
NoAnswers% = 0 NoAnswers% = 0
NoNineLetters% = 0 NoNineLetters% = 0
FullWord` = True FullWord` = TRUE
IF Text(TextBox1) = "" THEN IF Text(TextBox1) = "" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox1 SetFocus TextBox1
ELSEIF Text(TextBox1) < "A" OR Text(TextBox1) > "Z" THEN ELSEIF Text(TextBox1) < "A" OR Text(TextBox1) > "Z" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox1 SetFocus TextBox1
ELSEIF Text(TextBox2) = "" THEN ELSEIF Text(TextBox2) = "" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox2 SetFocus TextBox2
ELSEIF Text(TextBox2) < "A" OR Text(TextBox2) > "Z" THEN ELSEIF Text(TextBox2) < "A" OR Text(TextBox2) > "Z" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox2 SetFocus TextBox2
ELSEIF Text(TextBox3) = "" THEN ELSEIF Text(TextBox3) = "" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox3 SetFocus TextBox3
ELSEIF Text(TextBox3) < "A" OR Text(TextBox3) > "Z" THEN ELSEIF Text(TextBox3) < "A" OR Text(TextBox3) > "Z" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox3 SetFocus TextBox3
ELSEIF Text(TextBox4) = "" THEN ELSEIF Text(TextBox4) = "" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox4 SetFocus TextBox4
ELSEIF Text(TextBox4) < "A" OR Text(TextBox4) > "Z" THEN ELSEIF Text(TextBox4) < "A" OR Text(TextBox4) > "Z" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox4 SetFocus TextBox4
ELSEIF Text(TextBox5) = "" THEN ELSEIF Text(TextBox5) = "" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox5 SetFocus TextBox5
ELSEIF Text(TextBox5) < "A" OR Text(TextBox5) > "Z" THEN ELSEIF Text(TextBox5) < "A" OR Text(TextBox5) > "Z" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox5 SetFocus TextBox5
ELSEIF Text(TextBox6) = "" THEN ELSEIF Text(TextBox6) = "" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox6 SetFocus TextBox6
ELSEIF Text(TextBox6) < "A" OR Text(TextBox6) > "Z" THEN ELSEIF Text(TextBox6) < "A" OR Text(TextBox6) > "Z" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox6 SetFocus TextBox6
ELSEIF Text(TextBox7) = "" THEN ELSEIF Text(TextBox7) = "" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox7 SetFocus TextBox7
ELSEIF Text(TextBox7) < "A" OR Text(TextBox7) > "Z" THEN ELSEIF Text(TextBox7) < "A" OR Text(TextBox7) > "Z" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox7 SetFocus TextBox7
ELSEIF Text(TextBox8) = "" THEN ELSEIF Text(TextBox8) = "" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox8 SetFocus TextBox8
ELSEIF Text(TextBox8) < "A" OR Text(TextBox8) > "Z" THEN ELSEIF Text(TextBox8) < "A" OR Text(TextBox8) > "Z" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox8 SetFocus TextBox8
ELSEIF Text(TextBox9) = "" THEN ELSEIF Text(TextBox9) = "" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox9 SetFocus TextBox9
ELSEIF Text(TextBox9) < "A" OR Text(TextBox9) > "Z" THEN ELSEIF Text(TextBox9) < "A" OR Text(TextBox9) > "Z" THEN
FullWord` = False FullWord` = FALSE
SetFocus TextBox9 SetFocus TextBox9
END IF END IF
IF FullWord` THEN IF FullWord` THEN
@ -300,11 +303,11 @@ SUB __UI_Click (id AS LONG)
FOR M%% = 0 TO 1 FOR M%% = 0 TO 1
IF Located%%(S1$(M%%)) THEN IF Located%%(S1$(M%%)) THEN
IF NoAnswers% > 0 THEN IF NoAnswers% > 0 THEN
Present` = False Present` = FALSE
Index% = 0 Index% = 0
WHILE (NOT Present`) AND Index% <= NoAnswers% WHILE (NOT Present`) AND Index% <= NoAnswers%
GET #1, Index% + 1 GET #1, Index% + 1
IF RTRIM$(TWord$) = S1$(M%%) THEN Present` = True IF RTRIM$(TWord$) = S1$(M%%) THEN Present` = TRUE
Index% = Index% + 1 Index% = Index% + 1
WEND WEND
IF NOT Present` THEN IF NOT Present` THEN
@ -325,9 +328,9 @@ SUB __UI_Click (id AS LONG)
WHILE Jump% <= NoAnswers%: Jump% = Jump% * 2: WEND WHILE Jump% <= NoAnswers%: Jump% = Jump% * 2: WEND
WHILE Jump% > 1 WHILE Jump% > 1
Jump% = (Jump% - 1) \ 2 Jump% = (Jump% - 1) \ 2
Finished` = False Finished` = FALSE
WHILE NOT Finished` WHILE NOT Finished`
Finished` = True Finished` = TRUE
FOR Upper% = 1 TO NoAnswers% - Jump% FOR Upper% = 1 TO NoAnswers% - Jump%
Lower% = Upper% + Jump% Lower% = Upper% + Jump%
GET #1, Upper%: UWord$ = TWord$ GET #1, Upper%: UWord$ = TWord$
@ -337,7 +340,7 @@ SUB __UI_Click (id AS LONG)
PUT #1, Lower% PUT #1, Lower%
LSET TWord$ = LWord$ LSET TWord$ = LWord$
PUT #1, Upper% PUT #1, Upper%
Finished` = False Finished` = FALSE
END IF END IF
NEXT Upper% NEXT Upper%
WEND WEND
@ -457,7 +460,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'

View file

@ -38,6 +38,8 @@ DIM SHARED Word(1 TO 22) AS LONG
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'WordClock.frm' '$INCLUDE:'WordClock.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -190,12 +192,12 @@ END SUB
SUB switchOn (this AS LONG) SUB switchOn (this AS LONG)
Control(this).ForeColor = _RGB32(111, 205, 0) Control(this).ForeColor = _RGB32(111, 205, 0)
Control(this).Redraw = True Control(this).Redraw = TRUE
END SUB END SUB
SUB switchOff (this AS LONG) SUB switchOff (this AS LONG)
Control(this).ForeColor = _RGB32(0, 39, 0) Control(this).ForeColor = _RGB32(0, 39, 0)
Control(this).Redraw = True Control(this).Redraw = TRUE
END SUB END SUB
SUB __UI_BeforeUnload SUB __UI_BeforeUnload
@ -491,6 +493,3 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'

View file

@ -1,5 +1,3 @@
'$TITLE: ebacCalculator.bas Version 1.0 04/01/2021 - Last Update: 10/14/2021
_TITLE "Estimated Blood-Alcohol Content Calculator"
' ebacCalculator.bas Version 2.0 10/14/2021 ' ebacCalculator.bas Version 2.0 10/14/2021
'----------------------------------------------------------------------------------- '-----------------------------------------------------------------------------------
' PROGRAM: ebacCalculator.bas ' PROGRAM: ebacCalculator.bas
@ -73,12 +71,13 @@ DIM SHARED AS SINGLE B, OZ, Wt, EBAC
DIM SHARED AS STRING helpcontents, prt_text DIM SHARED AS STRING helpcontents, prt_text
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'../../InForm/extensions/MessageBox.bi' '$INCLUDE:'../../InForm/extensions/MessageBox.bi'
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'ebacCalculator.frm' '$INCLUDE:'ebacCalculator.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -95,7 +94,7 @@ SUB __UI_OnLoad
I = 0 I = 0
Bdl = 1.055 Bdl = 1.055
OZ = .5 OZ = .5
SOBER = False: legalToDrive = False SOBER = FALSE: legalToDrive = FALSE
HELPFile = "EBACHelp.txt" HELPFile = "EBACHelp.txt"
displayDisclaimer displayDisclaimer
@ -148,8 +147,8 @@ SUB __UI_Click (id AS LONG)
CASE AGREEBT CASE AGREEBT
Answer = MessageBox("Do you want to perform another calculation? ", "", MsgBox_YesNo + MsgBox_Question) Answer = MessageBox("Do you want to perform another calculation? ", "", MsgBox_YesNo + MsgBox_Question)
IF Answer = MsgBox_Yes THEN IF Answer = MsgBox_Yes THEN
Control(AgreeCB).Value = False Control(AgreeCB).Value = FALSE
Control(AGREEBT).Disabled = True Control(AGREEBT).Disabled = TRUE
ELSE ELSE
Answer = MessageBox("Thank You for using EBAC Calculator. Please Don't Drink and Drive.", "", MsgBox_Ok + MsgBox_Information) Answer = MessageBox("Thank You for using EBAC Calculator. Please Don't Drink and Drive.", "", MsgBox_Ok + MsgBox_Information)
SYSTEM SYSTEM
@ -159,7 +158,7 @@ SUB __UI_Click (id AS LONG)
ResetForm ResetForm
CASE OKBT CASE OKBT
IF Control(maleRB).Value = False AND Control(femaleRB).Value = False THEN IF Control(maleRB).Value = FALSE AND Control(femaleRB).Value = FALSE THEN
Answer = MessageBox("Invalid: You must select either M (male) or F (female). Please Correct.", "", MsgBox_Ok + MsgBox_Information) Answer = MessageBox("Invalid: You must select either M (male) or F (female). Please Correct.", "", MsgBox_Ok + MsgBox_Information)
EXIT SUB EXIT SUB
END IF END IF
@ -167,7 +166,7 @@ SUB __UI_Click (id AS LONG)
Wt = Control(WeightTB).Value Wt = Control(WeightTB).Value
T = Control(TimeTB).Value T = Control(TimeTB).Value
calcEBAC calcEBAC
Control(QUITBT).Disabled = True Control(QUITBT).Disabled = TRUE
ResetList displayResults ResetList displayResults
Text(displayResults) = prt_text Text(displayResults) = prt_text
@ -227,16 +226,16 @@ SUB __UI_TextChanged (id AS LONG)
SELECT CASE id SELECT CASE id
CASE WeightTB CASE WeightTB
Control(AgreeCB).Value = False Control(AgreeCB).Value = FALSE
Control(AGREEBT).Disabled = True Control(AGREEBT).Disabled = TRUE
CASE nbrDrinksTB CASE nbrDrinksTB
Control(AgreeCB).Value = False Control(AgreeCB).Value = FALSE
Control(AGREEBT).Disabled = True Control(AGREEBT).Disabled = TRUE
CASE TimeTB CASE TimeTB
Control(AgreeCB).Value = False Control(AgreeCB).Value = FALSE
Control(AGREEBT).Disabled = True Control(AGREEBT).Disabled = TRUE
END SELECT END SELECT
END SUB END SUB
@ -247,20 +246,20 @@ SUB __UI_ValueChanged (id AS LONG)
CASE displayResults CASE displayResults
CASE maleRB CASE maleRB
Control(AgreeCB).Value = False Control(AgreeCB).Value = FALSE
Control(AGREEBT).Disabled = True Control(AGREEBT).Disabled = TRUE
CASE femaleRB CASE femaleRB
Control(AgreeCB).Value = False Control(AgreeCB).Value = FALSE
Control(AGREEBT).Disabled = True Control(AGREEBT).Disabled = TRUE
CASE AgreeCB CASE AgreeCB
IF Control(AgreeCB).Value = True THEN IF Control(AgreeCB).Value = TRUE THEN
Control(AGREEBT).Disabled = False Control(AGREEBT).Disabled = FALSE
Control(QUITBT).Disabled = False Control(QUITBT).Disabled = FALSE
ELSE ELSE
Control(AGREEBT).Disabled = True Control(AGREEBT).Disabled = TRUE
Control(QUITBT).Disabled = True Control(QUITBT).Disabled = TRUE
END IF END IF
END SELECT END SELECT
@ -312,10 +311,10 @@ SUB ResetForm
Control(nbrDrinksTB).Value = 0 Control(nbrDrinksTB).Value = 0
Control(WeightTB).Value = 0 Control(WeightTB).Value = 0
Control(TimeTB).Value = 0 Control(TimeTB).Value = 0
Control(AgreeCB).Value = False Control(AgreeCB).Value = FALSE
Control(AGREEBT).Disabled = True Control(AGREEBT).Disabled = TRUE
Control(maleRB).Value = False Control(maleRB).Value = FALSE
Control(femaleRB).Value = False Control(femaleRB).Value = FALSE
ResetList displayResults ResetList displayResults
Sex = "" Sex = ""
END SUB END SUB
@ -326,7 +325,7 @@ SUB calcEBAC
' *** Convert Drinks into Fluid Ounces of EtOH (Pure Alcohol). ' *** Convert Drinks into Fluid Ounces of EtOH (Pure Alcohol).
' *** A is number of drinks. 1 drink is about .6 FLoz of alcohol ' *** A is number of drinks. 1 drink is about .6 FLoz of alcohol
FLoz = A * OZ FLoz = A * OZ
legalToDrive = False legalToDrive = FALSE
'----------------------------------------------------- '-----------------------------------------------------
' *** Set/calculate EBAC values based on Sex ' *** Set/calculate EBAC values based on Sex
@ -427,10 +426,10 @@ SUB calcEBAC
'*** - When user will be less than .08 '*** - When user will be less than .08
'*** - How long it will take to become completely sober '*** - How long it will take to become completely sober
IF EBAC > .08 THEN IF EBAC > .08 THEN
SOBER = False SOBER = FALSE
CEBAC = EBAC CEBAC = EBAC
st = T st = T
DO UNTIL SOBER = True DO UNTIL SOBER = TRUE
T = T + 1 T = T + 1
IF CEBAC > .0799 THEN I = I + 1 IF CEBAC > .0799 THEN I = I + 1
@ -443,16 +442,16 @@ SUB calcEBAC
CEBAC = 9.86 * FLoz / Wt - B * T CEBAC = 9.86 * FLoz / Wt - B * T
END SELECT END SELECT
IF legalToDrive = False THEN IF legalToDrive = FALSE THEN
IF CEBAC < .08 THEN IF CEBAC < .08 THEN
prt_text = prt_text + CHR$(10) + CHR$(10) + "It will take about " + strFormat$(STR$(I), "##") + " hours from your last drink to be able to drive." + CHR$(10) prt_text = prt_text + CHR$(10) + CHR$(10) + "It will take about " + strFormat$(STR$(I), "##") + " hours from your last drink to be able to drive." + CHR$(10)
legalToDrive = True legalToDrive = TRUE
END IF END IF
END IF END IF
IF CEBAC <= 0 THEN IF CEBAC <= 0 THEN
prt_text = prt_text + "It will take about " + strFormat$(STR$(T - st), "##") + " hours from your last drink to be completely sober." prt_text = prt_text + "It will take about " + strFormat$(STR$(T - st), "##") + " hours from your last drink to be completely sober."
SOBER = True SOBER = TRUE
END IF END IF
LOOP LOOP
END IF END IF
@ -476,7 +475,3 @@ FUNCTION strFormat$ (text AS STRING, template AS STRING)
_DEST d: _SOURCE s _DEST d: _SOURCE s
_FREEIMAGE n _FREEIMAGE n
END FUNCTION END FUNCTION
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'

View file

@ -20,9 +20,12 @@ DIM SHARED AS STRING contents, originalcontents
': External modules: --------------------------------------------------------------- ': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'../../InForm/extensions/MessageBox.bi' '$INCLUDE:'../../InForm/extensions/MessageBox.bi'
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'wordSearch.frm' '$INCLUDE:'wordSearch.frm'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
': Event procedures: --------------------------------------------------------------- ': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit SUB __UI_BeforeInit
@ -35,15 +38,15 @@ SUB __UI_BeforeUpdateDisplay
'This event occurs at approximately 30 frames per second. 'This event occurs at approximately 30 frames per second.
'You can change the update frequency by calling SetFrameRate DesiredRate% 'You can change the update frequency by calling SetFrameRate DesiredRate%
IF _FILEEXISTS(Text(FileTB)) THEN IF _FILEEXISTS(Text(FileTB)) THEN
Control(LoadBT).Disabled = False Control(LoadBT).Disabled = FALSE
ELSE ELSE
Control(LoadBT).Disabled = True Control(LoadBT).Disabled = TRUE
END IF END IF
IF LEN(Text(WordTB)) > 0 THEN IF LEN(Text(WordTB)) > 0 THEN
Control(SearchBT).Disabled = False Control(SearchBT).Disabled = FALSE
ELSE ELSE
Control(SearchBT).Disabled = True Control(SearchBT).Disabled = TRUE
END IF END IF
END SUB END SUB
@ -146,10 +149,8 @@ END SUB
SUB __UI_FormResized SUB __UI_FormResized
END SUB END SUB
': User modules: --------------------------------------------------------------- ': User modules: ---------------------------------------------------------------
FUNCTION strFormat$ (text AS STRING, template AS STRING) FUNCTION strFormat$ (text AS STRING, template AS STRING)
'----------------------------------------------------------------------------- '-----------------------------------------------------------------------------
' *** Return a formatted string to a variable ' *** Return a formatted string to a variable
@ -166,7 +167,3 @@ FUNCTION strFormat$ (text AS STRING, template AS STRING)
_DEST d: _SOURCE s _DEST d: _SOURCE s
_FREEIMAGE n _FREEIMAGE n
END FUNCTION END FUNCTION
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'