mirror of
https://github.com/FellippeHeitor/InForm.git
synced 2025-01-14 19:49:33 +00:00
Update GIFPlayer to not throw errors when bad Ids are passed
This commit is contained in:
Samuel Gomes
parent
08121bfb4f
commit
db355486c1
44 changed files with 2104 additions and 2007 deletions
File diff suppressed because it is too large
Load diff
|
|
@ -817,9 +817,11 @@ SUB __UI_LoadForm
|
|||
__UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBindBT", 80, 23, 341, 220, __UI_GetID("SetControlBinding"))
|
||||
SetCaption __UI_NewID, "Cancel"
|
||||
Control(__UI_NewID).CanHaveFocus = True
|
||||
|
||||
END SUB
|
||||
|
||||
SUB __UI_AssignIDs
|
||||
|
||||
UiEditor = __UI_GetID("UiEditor")
|
||||
StatusBar = __UI_GetID("StatusBar")
|
||||
FileMenu = __UI_GetID("FileMenu")
|
||||
|
|
@ -1005,4 +1007,5 @@ SUB __UI_AssignIDs
|
|||
TargetPropertyList = __UI_GetID("TargetPropertyList")
|
||||
BindBT = __UI_GetID("BindBT")
|
||||
CancelBindBT = __UI_GetID("CancelBindBT")
|
||||
|
||||
END SUB
|
||||
|
|
|
|||
|
|
@ -83,8 +83,11 @@ __UI_ClearColor ContextMenuIcon, 0, 0
|
|||
'$INCLUDE:'extensions/GIFPlay.bi'
|
||||
'$INCLUDE:'extensions/MessageBox.bi'
|
||||
'$INCLUDE:'InForm.bi'
|
||||
'$INCLUDE:'xp.uitheme'
|
||||
'$INCLUDE:'UiEditorPreview.frm'
|
||||
'$INCLUDE:'xp.uitheme'
|
||||
'$INCLUDE:'InForm.ui'
|
||||
'$INCLUDE:'extensions/GIFPlay.bas'
|
||||
'$INCLUDE:'extensions/MessageBox.bas'
|
||||
|
||||
'Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_Click (id AS LONG)
|
||||
|
|
@ -386,7 +389,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
IF EditorWasActive = FALSE THEN
|
||||
'Preview was launched by user
|
||||
_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
|
||||
IF _FILEEXISTS("InForm/UiEditorPreview.frmbin") THEN KILL "InForm/UiEditorPreview.frmbin"
|
||||
SYSTEM
|
||||
|
|
@ -1694,7 +1697,7 @@ SUB __UI_OnLoad
|
|||
IF VAL(HostPort) < 60000 THEN
|
||||
ForceQuit:
|
||||
_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
|
||||
END IF
|
||||
|
||||
|
|
@ -3046,8 +3049,8 @@ SUB LoadPreviewText
|
|||
DummyText$ = nextParameter(b$) 'discard first parameter
|
||||
DummyText$ = nextParameter(b$)
|
||||
LoadImage Control(TempValue), DummyText$
|
||||
ELSEIF LEFT$(b$, 30) = "__UI_RegisterResult = OpenGif(" THEN
|
||||
IF LogFileLoad THEN PRINT #LogFileNum, "OPENGIF"
|
||||
ELSEIF LEFT$(b$, 30) = "__UI_RegisterResult = GIF_LoadFromFile(" THEN
|
||||
IF LogFileLoad THEN PRINT #LogFileNum, "GIF_LOADFROMFILE"
|
||||
'Gif extension
|
||||
DIM RegisterResult AS _BYTE
|
||||
DummyText$ = nextParameter(b$) 'discard first parameter
|
||||
|
|
@ -3062,9 +3065,9 @@ SUB LoadPreviewText
|
|||
Control(TempValue).HelperCanvas = _NEWIMAGE(GIF_GetWidth(TempValue), GIF_GetHeight(TempValue), 32)
|
||||
GIF_Draw TempValue
|
||||
ELSE
|
||||
MessageBox DummyText$ + " is not a GIF file!", "", MsgBox_Exclamation
|
||||
MessageBox DummyText$ + " is not a GIF file!", _TITLE$, MsgBox_Exclamation
|
||||
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"
|
||||
'Auto-play gif
|
||||
AutoPlayGif(TempValue) = TRUE
|
||||
|
|
@ -3150,10 +3153,8 @@ END SUB
|
|||
|
||||
SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$)
|
||||
IF LCASE$(RIGHT$(fileName$, 4)) = ".gif" THEN
|
||||
DIM tryGif AS _BYTE
|
||||
GIF_Free This.ID
|
||||
tryGif = GIF_LoadFromFile(This.ID, fileName$)
|
||||
IF tryGif THEN
|
||||
IF GIF_LoadFromFile(This.ID, fileName$) THEN
|
||||
IF GIF_GetTotalFrames(This.ID) = 1 THEN
|
||||
GIF_Free This.ID
|
||||
ELSE
|
||||
|
|
@ -3167,7 +3168,7 @@ SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$)
|
|||
EXIT SUB
|
||||
END IF
|
||||
ELSE
|
||||
MessageBox fileName$ + " is not a GIF file!", "", MSGBOX_EXCLAMATION
|
||||
MessageBox fileName$ + " is not a GIF file!", _TITLE$, MsgBox_Exclamation
|
||||
END IF
|
||||
END IF
|
||||
GIF_Free This.ID
|
||||
|
|
@ -3999,7 +4000,3 @@ FUNCTION LoadEditorImage& (FileName$)
|
|||
|
||||
LoadEditorImage& = TempImage
|
||||
END FUNCTION
|
||||
|
||||
'$INCLUDE:'extensions/GIFPlay.bas'
|
||||
'$INCLUDE:'extensions/MessageBox.bas'
|
||||
'$INCLUDE:'InForm.ui'
|
||||
|
|
|
|||
|
|
@ -2,7 +2,9 @@
|
|||
': InForm - GUI library for QB64 - Beta version 9
|
||||
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
'-----------------------------------------------------------
|
||||
|
||||
SUB __UI_LoadForm
|
||||
|
||||
DIM __UI_NewID AS LONG
|
||||
|
||||
$RESIZE:ON
|
||||
|
|
@ -14,4 +16,3 @@ END SUB
|
|||
SUB __UI_AssignIDs
|
||||
|
||||
END SUB
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
***Adapted for use with InForm's PictureBox controls by @FellippeHeitor***
|
||||
|
||||
***Fixed, refactored and enhanced by @a740g***
|
||||
***By [a740g](https://github.com/a740g)***
|
||||
|
||||
## Usage instructions
|
||||
|
||||
Your form must contain a PictureBox control that'll serve as a container for
|
||||
the GIF file you'll load with this library.
|
||||
You can use the Library either standalone or with InForm-PE.
|
||||
|
||||
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:
|
||||
### Standalone
|
||||
|
||||
```vb
|
||||
' 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
|
||||
': External modules: --------------------------------
|
||||
'$INCLUDE:'InForm\extensions\GIFPlay.bi'
|
||||
'$INCLUDE:'InForm\InForm.ui'
|
||||
'$INCLUDE:'InForm\xp.uitheme'
|
||||
'$INCLUDE:'InForm/extensions/GIFPlay.bi'
|
||||
'$INCLUDE:'InForm/InForm.ui'
|
||||
'$INCLUDE:'InForm/xp.uitheme'
|
||||
'$INCLUDE:'gifplaySample.frm'
|
||||
'$INCLUDE:'InForm\extensions\GIFPlay.bm'
|
||||
'$INCLUDE:'InForm/extensions/GIFPlay.bas'
|
||||
```
|
||||
|
||||
## API
|
||||
|
||||
```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
|
||||
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
|
||||
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
|
||||
FUNCTION GIF_IsPlaying%% (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)
|
||||
FUNCTION GIF_GetWidth~& (Id AS LONG)
|
||||
```
|
||||
|
||||
Returns the width of the GIF in pixels.
|
||||
|
||||
```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.
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
InForm - GUI library for QB64
|
||||
Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||||
https://github.com/FellippeHeitor/InForm
|
||||
|
||||
-----------------------------------------------------------
|
||||
Below is the binary format for exchange of controls data. It is
|
||||
used for UiEditorPreview.frmbin, which is read/written to by both
|
||||
|
|
|
|||
|
|
@ -16,7 +16,6 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
|
||||
'DEFLNG A-Z
|
||||
'OPTION _EXPLICIT
|
||||
'CONST FALSE = 0, TRUE = NOT FALSE
|
||||
|
||||
'CONST GIF_ID = 1
|
||||
|
||||
|
|
@ -94,6 +93,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayFrame() AS __GIFPlayFrameType
|
||||
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
|
||||
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
|
||||
|
||||
|
|
@ -108,7 +110,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
END IF
|
||||
|
||||
' 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
|
||||
IF __GIF_FirstFreeFrame > __GIFPlay(idx).frame THEN __GIF_FirstFreeFrame = __GIFPlay(idx).frame
|
||||
|
|
@ -130,7 +132,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
END IF
|
||||
|
||||
' 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
|
||||
HashTable_Remove __GIFPlayHashTable(), Id
|
||||
|
|
@ -142,7 +144,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetWidth = _WIDTH(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).image)
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -151,7 +155,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetHeight = _HEIGHT(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).image)
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -160,7 +166,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetFrameNumber = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frameNumber
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -169,7 +177,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetTotalFrames = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frameCount
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -178,10 +188,12 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
|
||||
|
||||
__GIFPlay(idx).isPlaying = TRUE
|
||||
__GIFPlay(idx).isPlaying = __GIF_TRUE
|
||||
__GIFPlay(idx).lastTick = __GIF_GetTicks
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
|
|
@ -190,7 +202,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
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
|
||||
|
||||
|
||||
|
|
@ -199,12 +213,14 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
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).frameNumber = 0
|
||||
__GIFPlay(idx).loopCounter = 0
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
|
|
@ -213,7 +229,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_IsPlaying = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -223,6 +241,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
$IF INFORM_BI = DEFINED THEN
|
||||
BeginDraw ID
|
||||
$END IF
|
||||
|
|
@ -248,6 +267,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
$IF INFORM_BI = DEFINED THEN
|
||||
EndDraw ID
|
||||
$END IF
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
|
|
@ -260,14 +280,17 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
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
|
||||
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
|
||||
|
||||
' Always return the rendered image handle (since this does not change during the GIFs lifetime)
|
||||
GIF_GetFrame = __GIFPlay(idx).image
|
||||
|
||||
' Exit if we are paused
|
||||
IF NOT __GIFPlay(idx).isPlaying THEN EXIT FUNCTION
|
||||
' Exit if we are paused or not ready
|
||||
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
|
||||
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
|
||||
' Copy back the saved image and unset the flag
|
||||
_PUTIMAGE , __GIFPlay(idx).savedImage, __GIFPlay(idx).image
|
||||
__GIFPlay(idx).hasSavedImage = FALSE
|
||||
__GIFPlay(idx).hasSavedImage = __GIF_FALSE
|
||||
END IF
|
||||
|
||||
' 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 __GIFPlayFrame(__GIFPlay(idx).frame).disposalMethod = 3 THEN
|
||||
_PUTIMAGE , __GIFPlay(idx).image, __GIFPlay(idx).savedImage
|
||||
__GIFPlay(idx).hasSavedImage = TRUE
|
||||
__GIFPlay(idx).hasSavedImage = __GIF_TRUE
|
||||
END IF
|
||||
|
||||
' 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 __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetTotalDuration = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).duration
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -348,7 +373,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
SHARED __GIFPlayFrame() AS __GIFPlayFrameType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_GetFrameDuration = __GIFPlayFrame(__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).frame).duration
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -357,7 +384,9 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).loops = loops
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
|
|
@ -366,18 +395,22 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).overlayEnabled = isEnabled
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
||||
' Returns TRUE if a GIF with Id is loaded
|
||||
FUNCTION GIF_IsLoaded%% (Id AS LONG)
|
||||
$CHECKING:OFF
|
||||
SHARED __GIFPlayHashTable() AS HashTableType
|
||||
SHARED __GIFPlay() AS __GIFPlayType
|
||||
|
||||
IF HashTable_IsKeyPresent(__GIFPlayHashTable(), Id) THEN
|
||||
GIF_IsLoaded = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isReady
|
||||
END IF
|
||||
$CHECKING:ON
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -540,7 +573,7 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
prev = code
|
||||
LOOP
|
||||
|
||||
__GIF_DecodeLZW = TRUE
|
||||
__GIF_DecodeLZW = __GIF_TRUE
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -596,24 +629,24 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
' No free GIF slots?
|
||||
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
|
||||
|
||||
' Reset some stuff
|
||||
__GIFPlay(idx).isReady = FALSE
|
||||
__GIFPlay(idx).isReady = __GIF_FALSE
|
||||
__GIFPlay(idx).firstFrame = -1
|
||||
__GIFPlay(idx).lastFrame = -1
|
||||
__GIFPlay(idx).frame = -1
|
||||
__GIFPlay(idx).frameCount = 0
|
||||
__GIFPlay(idx).frameNumber = 0
|
||||
__GIFPlay(idx).isPlaying = FALSE
|
||||
__GIFPlay(idx).isPlaying = __GIF_FALSE
|
||||
__GIFPlay(idx).loops = 0
|
||||
__GIFPlay(idx).loopCounter = 0
|
||||
__GIFPlay(idx).duration = 0
|
||||
__GIFPlay(idx).lastTick = 0
|
||||
__GIFPlay(idx).lastFrameRendered = -1
|
||||
__GIFPlay(idx).hasSavedImage = FALSE
|
||||
__GIFPlay(idx).overlayEnabled = TRUE
|
||||
__GIFPlay(idx).hasSavedImage = __GIF_FALSE
|
||||
__GIFPlay(idx).overlayEnabled = __GIF_TRUE
|
||||
|
||||
' Get width and height
|
||||
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
|
||||
|
||||
' Occupy the slot
|
||||
__GIFPlayFrame(frameIdx).isUsed = TRUE
|
||||
__GIFPlayFrame(frameIdx).isUsed = __GIF_TRUE
|
||||
|
||||
' Read frame size and offset
|
||||
__GIFPlayFrame(frameIdx).L = StringFile_ReadInteger(sf)
|
||||
|
|
@ -786,14 +819,14 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
|
|||
|
||||
'__GIF_PrintDebugInfo idx
|
||||
|
||||
' Render the first frame and then pause
|
||||
__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
|
||||
__GIFPlay(idx).isReady = __GIF_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
|
||||
|
||||
gif_load_error:
|
||||
|
|
|
|||
|
|
@ -9,6 +9,8 @@ $IF GIFPLAY_BI = UNDEFINED THEN
|
|||
'$INCLUDE:'HashTable.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
|
||||
TYPE __GIFPlayType
|
||||
isUsed AS _BYTE ' is this slot being used (this is only here to assist slot allocation)
|
||||
|
|
|
|||
|
|
@ -11,6 +11,9 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
|
|||
'-------------------------------------------------------------------------------------------------------------------
|
||||
' Test code for debugging the library
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
'DEFLNG A-Z
|
||||
'OPTION _EXPLICIT
|
||||
|
||||
'REDIM MyHashTable(0 TO 0) AS HashTableType
|
||||
|
||||
'CONST TEST_LB = 1
|
||||
|
|
@ -168,7 +171,9 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
|
|||
|
||||
' Return TRUE if k is available in the hash table
|
||||
FUNCTION HashTable_IsKeyPresent%% (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
|
||||
$CHECKING:OFF
|
||||
HashTable_IsKeyPresent = (__HashTable_GetLookupIndex(hashTable(), k) >= 0)
|
||||
$CHECKING:ON
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
@ -177,7 +182,7 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
|
|||
DIM idx AS LONG: idx = __HashTable_GetLookupIndex(hashTable(), k)
|
||||
|
||||
IF idx >= 0 THEN
|
||||
hashTable(idx).U = FALSE
|
||||
hashTable(idx).U = __HASHTABLE_FALSE
|
||||
ELSE
|
||||
ERROR 9
|
||||
END IF
|
||||
|
|
@ -189,7 +194,7 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
|
|||
DIM idx AS LONG: idx = __HashTable_GetInsertIndex(hashTable(), k)
|
||||
|
||||
IF idx >= 0 THEN
|
||||
hashTable(idx).U = TRUE
|
||||
hashTable(idx).U = __HASHTABLE_TRUE
|
||||
hashTable(idx).K = k
|
||||
hashTable(idx).V = v
|
||||
ELSE
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
$IF HASHTABLE_BI = UNDEFINED THEN
|
||||
$LET HASHTABLE_BI = TRUE
|
||||
|
||||
CONST __HASHTABLE_FALSE%% = 0%%, __HASHTABLE_TRUE%% = NOT __HASHTABLE_FALSE
|
||||
CONST __HASHTABLE_KEY_EXISTS& = -1&
|
||||
CONST __HASHTABLE_KEY_UNAVAILABLE& = -2&
|
||||
|
||||
|
|
|
|||
|
|
@ -11,6 +11,8 @@ $IF STRINGFILE_BAS = UNDEFINED THEN
|
|||
'-------------------------------------------------------------------------------------------------------------------
|
||||
' Test code for debugging the library
|
||||
'-------------------------------------------------------------------------------------------------------------------
|
||||
'DEFLNG A-Z
|
||||
'OPTION _EXPLICIT
|
||||
'WIDTH , 80
|
||||
'DIM sf AS StringFileType
|
||||
'StringFile_Create sf, "This_is_a_test_buffer."
|
||||
|
|
@ -97,7 +99,7 @@ $IF STRINGFILE_BAS = UNDEFINED THEN
|
|||
stringFile.cursor = 0
|
||||
CLOSE fh
|
||||
|
||||
StringFile_Load = TRUE
|
||||
StringFile_Load = __STRINGFILE_TRUE
|
||||
END IF
|
||||
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)
|
||||
CLOSE fh
|
||||
|
||||
StringFile_Save = TRUE
|
||||
StringFile_Save = __STRINGFILE_TRUE
|
||||
END FUNCTION
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -6,6 +6,8 @@
|
|||
$IF STRINGFILE_BI = UNDEFINED THEN
|
||||
$LET STRINGFILE_BI = TRUE
|
||||
|
||||
CONST __STRINGFILE_FALSE%% = 0%%, __STRINGFILE_TRUE%% = NOT __STRINGFILE_FALSE
|
||||
|
||||
' Simplified QB64-only memory-file
|
||||
TYPE StringFileType
|
||||
buffer AS STRING
|
||||
|
|
|
|||
|
|
@ -4,21 +4,20 @@
|
|||
': https://github.com/FellippeHeitor/InForm
|
||||
'-----------------------------------------------------------
|
||||
|
||||
$VERSIONINFO:CompanyName=SpriggsySpriggs
|
||||
$VERSIONINFO:FileDescription=Converts a binary file into an INCLUDE-able
|
||||
$VERSIONINFO:LegalCopyright=(c) 2019-2020 SpriggsySpriggs
|
||||
$VERSIONINFO:ProductName=BIN2INCLUDE
|
||||
$VERSIONINFO:InternalName=BIN2INCLUDE
|
||||
$VERSIONINFO:OriginalFilename=BIN2INCLUDE.exe
|
||||
$VERSIONINFO:Web=https://github.com/a740g/QB64-Museum/tree/main/SpriggsySpriggs/Bin2Include
|
||||
$VERSIONINFO:Comments=QB64-PE and InForm-PE port by a740g
|
||||
$VERSIONINFO:CompanyName='SpriggsySpriggs'
|
||||
$VERSIONINFO:FileDescription='Converts a binary file into an INCLUDE-able'
|
||||
$VERSIONINFO:LegalCopyright='(c) 2019-2020 SpriggsySpriggs'
|
||||
$VERSIONINFO:ProductName='BIN2INCLUDE'
|
||||
$VERSIONINFO:InternalName='BIN2INCLUDE'
|
||||
$VERSIONINFO:OriginalFilename='BIN2INCLUDE.exe'
|
||||
$VERSIONINFO:Web='https://github.com/a740g/QB64-Museum/tree/main/SpriggsySpriggs/Bin2Include'
|
||||
$VERSIONINFO:Comments='QB64-PE and InForm-PE port by a740g'
|
||||
$VERSIONINFO:FILEVERSION#=2,6,0,0
|
||||
$VERSIONINFO:PRODUCTVERSION#=2,6,0,0
|
||||
|
||||
OPTION _EXPLICIT
|
||||
|
||||
$EXEICON:'./BIN2INCLUDE.ico'
|
||||
_TITLE "BIN2INCLUDE"
|
||||
|
||||
': Controls' IDs: ------------------------------------------------------------------
|
||||
DIM SHARED BIN2INCLUDE AS LONG
|
||||
|
|
@ -34,22 +33,21 @@ DIM SHARED PIC2MEMRB AS LONG
|
|||
DIM SHARED ResetBT AS LONG
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'BIN2INCLUDE.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
||||
': Custom procedures: --------------------------------------------------------------
|
||||
SUB MessageBox (message AS STRING, caption AS STRING, icon AS STRING)
|
||||
_DELAY 0.2 ' delay a bit to allow InFrom to draw and refresh all comtrols before the modal dialog box takes over
|
||||
_MESSAGEBOX caption, message, icon
|
||||
END SUB
|
||||
|
||||
FUNCTION checkExt%% (OFile$)
|
||||
IF UCASE$(RIGHT$(OFile$, 4)) <> ".BMP" AND UCASE$(RIGHT$(OFile$, 4)) <> ".JPG" _
|
||||
AND UCASE$(RIGHT$(OFile$, 4)) <> ".PNG" AND UCASE$(RIGHT$(OFile$, 5)) <> ".JPEG" _
|
||||
AND UCASE$(RIGHT$(OFile$, 4)) <> ".GIF" THEN
|
||||
checkExt = False
|
||||
checkExt = FALSE
|
||||
ELSE
|
||||
checkExt = True
|
||||
checkExt = TRUE
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
|
@ -184,10 +182,10 @@ SUB bin2bas (IN$, OUT$)
|
|||
ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$
|
||||
Text(SelectedFileTB) = ""
|
||||
Text(OutputFileTB) = ""
|
||||
Control(CONVERTBT).Disabled = True
|
||||
Control(OpenBT).Disabled = True
|
||||
Control(BIN2BASRB).Value = False
|
||||
Control(PIC2MEMRB).Value = False
|
||||
Control(CONVERTBT).Disabled = TRUE
|
||||
Control(OpenBT).Disabled = TRUE
|
||||
Control(BIN2BASRB).Value = FALSE
|
||||
Control(PIC2MEMRB).Value = FALSE
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
|
@ -295,10 +293,10 @@ SUB pic2mem (IN$, OUT$)
|
|||
ToolTip(ListBox1) = TIME$ + ": File exported to " + OUT$
|
||||
Text(SelectedFileTB) = ""
|
||||
Text(OutputFileTB) = ""
|
||||
Control(CONVERTBT).Disabled = True
|
||||
Control(OpenBT).Disabled = True
|
||||
Control(BIN2BASRB).Value = False
|
||||
Control(PIC2MEMRB).Value = False
|
||||
Control(CONVERTBT).Disabled = TRUE
|
||||
Control(OpenBT).Disabled = TRUE
|
||||
Control(BIN2BASRB).Value = FALSE
|
||||
Control(PIC2MEMRB).Value = FALSE
|
||||
END SUB
|
||||
|
||||
FUNCTION __opensmall&
|
||||
|
|
@ -516,7 +514,7 @@ SUB __UI_OnLoad
|
|||
Control(CONVERTBT).HelperCanvas = __convert&
|
||||
Control(ResetBT).HelperCanvas = __reset&
|
||||
Control(ClearLogBT).HelperCanvas = __deletesmall&
|
||||
Control(OpenBT).Disabled = True
|
||||
Control(OpenBT).Disabled = TRUE
|
||||
SetFrameRate 60
|
||||
_ACCEPTFILEDROP
|
||||
AddItem ListBox1, "Open a file above or drag and drop."
|
||||
|
|
@ -529,20 +527,20 @@ SUB __UI_BeforeUpdateDisplay
|
|||
IF _TOTALDROPPEDFILES THEN
|
||||
DIM drop$: drop$ = _DROPPEDFILE
|
||||
IF _FILEEXISTS(drop$) THEN
|
||||
IF NOT checkExt(drop$) AND Control(PIC2MEMRB).Value = False THEN
|
||||
Control(BIN2BASRB).Value = True
|
||||
Control(PIC2MEMRB).Disabled = True
|
||||
IF NOT checkExt(drop$) AND Control(PIC2MEMRB).Value = FALSE THEN
|
||||
Control(BIN2BASRB).Value = TRUE
|
||||
Control(PIC2MEMRB).Disabled = TRUE
|
||||
Text(SelectedFileTB) = drop$
|
||||
Text(OutputFileTB) = drop$ + ".BM"
|
||||
Control(CONVERTBT).Disabled = False
|
||||
ELSEIF checkExt(drop$) AND Control(PIC2MEMRB).Value = True THEN
|
||||
Control(BIN2BASRB).Disabled = True
|
||||
Control(CONVERTBT).Disabled = FALSE
|
||||
ELSEIF checkExt(drop$) AND Control(PIC2MEMRB).Value = TRUE THEN
|
||||
Control(BIN2BASRB).Disabled = TRUE
|
||||
Text(SelectedFileTB) = drop$
|
||||
Text(OutputFileTB) = drop$ + ".MEM"
|
||||
Control(CONVERTBT).Disabled = False
|
||||
ELSEIF checkExt(drop$) = 0 AND Control(PIC2MEMRB).Value = True THEN
|
||||
MessageBox "Unsupported file type for PIC2MEM", _TITLE$, "warning"
|
||||
Control(BIN2BASRB).Disabled = False
|
||||
Control(CONVERTBT).Disabled = FALSE
|
||||
ELSEIF checkExt(drop$) = 0 AND Control(PIC2MEMRB).Value = TRUE THEN
|
||||
MessageBox "Unsupported file type for PIC2MEM", Caption(BIN2INCLUDE), MsgBox_Critical
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
|
|
@ -556,48 +554,48 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE BIN2INCLUDE
|
||||
CASE SelectedFileTB
|
||||
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
|
||||
DIM oFile$: oFile$ = _OPENFILEDIALOG$(_TITLE$)
|
||||
Control(PIC2MEMRB).Disabled = True
|
||||
ELSEIF Control(PIC2MEMRB).Value = True THEN
|
||||
DIM oFile$: oFile$ = _OPENFILEDIALOG$(Caption(BIN2INCLUDE) + ": Open")
|
||||
Control(PIC2MEMRB).Disabled = TRUE
|
||||
ELSEIF Control(PIC2MEMRB).Value = TRUE THEN
|
||||
_DELAY 0.2 ' delay a bit to allow InFrom to draw and refresh all comtrols before the modal dialog box takes over
|
||||
oFile$ = _OPENFILEDIALOG$(_TITLE$, , "*.BMP|*.bmp|*.JPG|*.jpg|*.JPEG|*.jpeg|*.PNG|*.png|*.GIF|*.gif", "Supported image files")
|
||||
Control(BIN2BASRB).Disabled = True
|
||||
oFile$ = _OPENFILEDIALOG$(Caption(BIN2INCLUDE) + ": Open", , "*.BMP|*.bmp|*.JPG|*.jpg|*.JPEG|*.jpeg|*.PNG|*.png|*.GIF|*.gif", "Supported image files")
|
||||
Control(BIN2BASRB).Disabled = TRUE
|
||||
END IF
|
||||
IF oFile$ <> "" THEN
|
||||
IF checkExt(oFile$) = 0 AND Control(PIC2MEMRB).Value = True THEN
|
||||
MessageBox "Unsupported file type for PIC2MEM", _TITLE$, "warning"
|
||||
Control(BIN2BASRB).Disabled = False
|
||||
ELSEIF checkExt(oFile$) AND Control(PIC2MEMRB).Value = True THEN
|
||||
Control(CONVERTBT).Disabled = False
|
||||
IF checkExt(oFile$) = 0 AND Control(PIC2MEMRB).Value = TRUE THEN
|
||||
MessageBox "Unsupported file type for PIC2MEM", Caption(BIN2INCLUDE), MsgBox_Critical
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
ELSEIF checkExt(oFile$) AND Control(PIC2MEMRB).Value = TRUE THEN
|
||||
Control(CONVERTBT).Disabled = FALSE
|
||||
Text(SelectedFileTB) = oFile$
|
||||
Text(OutputFileTB) = oFile$ + ".MEM"
|
||||
ELSE
|
||||
Control(CONVERTBT).Disabled = False
|
||||
Control(CONVERTBT).Disabled = FALSE
|
||||
Text(SelectedFileTB) = oFile$
|
||||
Text(OutputFileTB) = oFile$ + ".BM"
|
||||
END IF
|
||||
ELSE
|
||||
Text(SelectedFileTB) = ""
|
||||
Text(OutputFileTB) = ""
|
||||
Control(BIN2BASRB).Disabled = False
|
||||
Control(PIC2MEMRB).Disabled = False
|
||||
Control(CONVERTBT).Disabled = True
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
Control(PIC2MEMRB).Disabled = FALSE
|
||||
Control(CONVERTBT).Disabled = TRUE
|
||||
END IF
|
||||
CASE CONVERTBT
|
||||
IF Control(BIN2BASRB).Value = True THEN
|
||||
_TITLE _TITLE$ + " - WORKING..."
|
||||
IF Control(BIN2BASRB).Value = TRUE THEN
|
||||
Caption(BIN2INCLUDE) = Caption(BIN2INCLUDE) + " - WORKING..."
|
||||
bin2bas Text(SelectedFileTB), Text(OutputFileTB)
|
||||
Control(PIC2MEMRB).Disabled = False
|
||||
_TITLE "BIN2INCLUDE"
|
||||
ELSEIF Control(PIC2MEMRB).Value = True THEN
|
||||
_TITLE _TITLE$ + " - WORKING..."
|
||||
Control(PIC2MEMRB).Disabled = FALSE
|
||||
Caption(BIN2INCLUDE) = "BIN2INCLUDE"
|
||||
ELSEIF Control(PIC2MEMRB).Value = TRUE THEN
|
||||
Caption(BIN2INCLUDE) = Caption(BIN2INCLUDE) + " - WORKING..."
|
||||
pic2mem Text(SelectedFileTB), Text(OutputFileTB)
|
||||
Control(BIN2BASRB).Disabled = False
|
||||
_TITLE "BIN2INCLUDE"
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
Caption(BIN2INCLUDE) = "BIN2INCLUDE"
|
||||
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
|
||||
CASE OutputFileTB
|
||||
CASE ListBox1
|
||||
|
|
@ -611,9 +609,9 @@ END SUB
|
|||
SUB ResetScreen
|
||||
Text(SelectedFileTB) = ""
|
||||
Text(OutputFileTB) = ""
|
||||
Control(BIN2BASRB).Disabled = False
|
||||
Control(PIC2MEMRB).Disabled = False
|
||||
Control(CONVERTBT).Disabled = True
|
||||
Control(BIN2BASRB).Disabled = FALSE
|
||||
Control(PIC2MEMRB).Disabled = FALSE
|
||||
Control(CONVERTBT).Disabled = TRUE
|
||||
ToolTip(ListBox1) = ""
|
||||
END SUB
|
||||
|
||||
|
|
@ -708,16 +706,13 @@ SUB __UI_ValueChanged (id AS LONG)
|
|||
SELECT CASE id
|
||||
CASE ListBox1
|
||||
CASE BIN2BASRB
|
||||
Control(OpenBT).Disabled = False
|
||||
Control(OpenBT).Disabled = FALSE
|
||||
_TITLE "BIN2INCLUDE - BIN2BAS"
|
||||
CASE PIC2MEMRB
|
||||
Control(OpenBT).Disabled = False
|
||||
Control(OpenBT).Disabled = FALSE
|
||||
_TITLE "BIN2INCLUDE - PIC2MEM"
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
': ||__|||__|||__|||__|||__|||__|||__|||__|||__|||__||
|
||||
': |/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|/__\|
|
||||
':
|
||||
': QB64 Calculator V1.0
|
||||
': QB64 Calculator V1.1
|
||||
': Terry Ritchie - 08/29/18
|
||||
':
|
||||
': 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
|
||||
|
||||
': External modules: --------------------------------------------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Calculator.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
||||
': Program procedures: ------------------------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -134,7 +138,7 @@ SUB UPDATEOPERAND (n$) '
|
|||
|
||||
IF resetoperand THEN ' new operand input?
|
||||
operand$ = "" ' yes, reset operand
|
||||
resetoperand = False ' reset trigger
|
||||
resetoperand = FALSE ' reset trigger
|
||||
END IF
|
||||
IF n$ = "." THEN ' adding decimal point?
|
||||
IF INSTR(operand$, ".") = 0 THEN ' yes, already a decimal point?
|
||||
|
|
@ -192,7 +196,7 @@ SUB COMMITOPERAND () '
|
|||
END IF
|
||||
operand1 = VAL(operand$) ' move current total to previous value
|
||||
previousoperator = operator ' move current operator to previous operator
|
||||
resetoperand = True ' trigger an operand reset
|
||||
resetoperand = TRUE ' trigger an operand reset
|
||||
|
||||
END SUB
|
||||
|
||||
|
|
@ -270,7 +274,7 @@ SUB ADDHISTORY (h$) '
|
|||
'------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
IF nohistory THEN
|
||||
nohistory = False
|
||||
nohistory = FALSE
|
||||
ELSE
|
||||
history$ = history$ + h$
|
||||
END IF
|
||||
|
|
@ -341,20 +345,20 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE butMR ' memory recall clicked
|
||||
IF memory THEN ' memory available?
|
||||
operand$ = CLEAN$(memory) ' Yes, make it the current operand
|
||||
resetoperand = True ' trigger an operand reset
|
||||
resetoperand = TRUE ' trigger an operand reset
|
||||
END IF
|
||||
|
||||
CASE butMS ' memory store clicked
|
||||
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
|
||||
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
|
||||
memory = memory - VAL(operand$) ' subtract current operand from memory
|
||||
resetoperand = True ' trigger an operand reset
|
||||
resetoperand = TRUE ' trigger an operand reset
|
||||
|
||||
': clear buttons: -----------------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -380,7 +384,7 @@ SUB __UI_Click (id AS LONG)
|
|||
IF VAL(operand$) THEN ' dividing by zero?
|
||||
|
||||
ADDHISTORY (operator$(previousoperator) + "Reciproc(" + operand$ + ")")
|
||||
nohistory = True ' skip operand history next time
|
||||
nohistory = TRUE ' skip operand history next time
|
||||
operator = EQUATE
|
||||
|
||||
operand$ = CLEAN$(1 / VAL(operand$)) ' no, calculate reciprocate
|
||||
|
|
@ -388,13 +392,13 @@ SUB __UI_Click (id AS LONG)
|
|||
ALERT ' get user's attention
|
||||
operand$ = "Can't divide by zero!" ' report error to user
|
||||
END IF
|
||||
resetoperand = True ' trigger an operand reset
|
||||
resetoperand = TRUE ' trigger an operand reset
|
||||
|
||||
CASE butSQR ' square root clicked
|
||||
IF VAL(operand$) >= 0 THEN ' positive value?
|
||||
|
||||
ADDHISTORY (operator$(previousoperator) + "SQRT(" + operand$ + ")")
|
||||
nohistory = True ' skip operand history next time
|
||||
nohistory = TRUE ' skip operand history next time
|
||||
operator = EQUATE
|
||||
|
||||
operand$ = CLEAN$(SQR(VAL(operand$))) ' yes, calculate square root
|
||||
|
|
@ -402,11 +406,11 @@ SUB __UI_Click (id AS LONG)
|
|||
ALERT ' get user's attention
|
||||
operand$ = "Invalid input!" ' nice try buddy
|
||||
END IF
|
||||
resetoperand = True ' trigger an operand reset
|
||||
resetoperand = TRUE ' trigger an operand reset
|
||||
|
||||
CASE butPercent ' percent clicked
|
||||
operand$ = CLEAN$(operand1 * VAL(operand$) / 100) ' calculate percentage of previous operand
|
||||
resetoperand = True
|
||||
resetoperand = TRUE
|
||||
|
||||
CASE butSign ' sign clicked
|
||||
IF VAL(operand$) THEN ' value equal to zero?
|
||||
|
|
@ -493,7 +497,7 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE mnuPaste
|
||||
|
||||
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
|
||||
|
||||
|
|
@ -1028,6 +1032,3 @@ END SUB
|
|||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -18,6 +18,8 @@ DIM AS SINGLE CenterX, CenterY, Radius, MaxRadius
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'ClickTheVoid.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -177,6 +179,3 @@ END SUB
|
|||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -22,11 +22,13 @@ REDIM SHARED Clock%%(12, 4, 2)
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Clock Patience.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
$EXEICON:'.\clubs.ico'
|
||||
DoPatience%% = False
|
||||
DoPatience%% = FALSE
|
||||
Anime1%% = 31
|
||||
Anime2%% = 43
|
||||
'Set Data
|
||||
|
|
@ -203,7 +205,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
'You can change the update frequency by calling SetFrameRate DesiredRate%
|
||||
STATIC Count%, InitDone%%, Grandad&, XStart%, YStart%
|
||||
IF NOT InitDone%% THEN
|
||||
InitDone%% = True
|
||||
InitDone%% = TRUE
|
||||
XStart% = -120
|
||||
YStart% = 0
|
||||
Grandad& = _LOADIMAGE("Clock1.png", 33)
|
||||
|
|
@ -299,9 +301,9 @@ SUB __UI_BeforeUpdateDisplay
|
|||
END IF
|
||||
Anime1%% = Anime1%% + 1
|
||||
IF Anime1%% = 31 THEN
|
||||
TurnOver%% = False
|
||||
TurnOver%% = FALSE
|
||||
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
|
||||
ELSEIF Anime2%% < 43 THEN
|
||||
'Display Tucking-in
|
||||
|
|
@ -373,7 +375,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
END IF
|
||||
END IF
|
||||
Anime2%% = Anime2%% + 1
|
||||
IF Anime2%% = 43 THEN CanPutDown%% = True
|
||||
IF Anime2%% = 43 THEN CanPutDown%% = TRUE
|
||||
ELSEIF PickedUp%% THEN
|
||||
'Display picked-up card
|
||||
IF __UI_MouseLeft > 680 AND __UI_MouseTop > 738 THEN
|
||||
|
|
@ -475,7 +477,7 @@ SUB __UI_Click (id AS LONG)
|
|||
SELECT CASE id
|
||||
CASE ClockPatience
|
||||
IF GreenValid%% THEN
|
||||
DoPickUp%% = True
|
||||
DoPickUp%% = TRUE
|
||||
ELSEIF RedValid%% THEN
|
||||
Anime2%% = 0
|
||||
END IF
|
||||
|
|
@ -483,13 +485,13 @@ SUB __UI_Click (id AS LONG)
|
|||
SYSTEM
|
||||
CASE NewGameBT
|
||||
IF NOT DoPatience%% THEN
|
||||
Control(NewGameBT).Disabled = True
|
||||
Control(NewGameBT).Hidden = True
|
||||
Control(NewGameBT).Disabled = TRUE
|
||||
Control(NewGameBT).Hidden = TRUE
|
||||
Caption(NewGameBT) = "New Game"
|
||||
SetFocus ExitBT
|
||||
CALL Patience
|
||||
ELSE
|
||||
DoPatience%% = False
|
||||
DoPatience%% = FALSE
|
||||
Caption(NewGameBT) = "Deal"
|
||||
END IF
|
||||
END SELECT
|
||||
|
|
@ -537,7 +539,7 @@ END SUB
|
|||
|
||||
SUB Patience
|
||||
RANDOMIZE (TIMER)
|
||||
BadDeal%% = True
|
||||
BadDeal%% = TRUE
|
||||
WHILE BadDeal%%
|
||||
REDIM Clock%%(12, 4, 2)
|
||||
CALL Shuffle(Cards%%())
|
||||
|
|
@ -547,33 +549,33 @@ SUB Patience
|
|||
R%% = N%% MOD 13
|
||||
Clock%%(R%%, S%% + 1, 2) = Cards%%(N%%)
|
||||
NEXT N%%
|
||||
BadDeal%% = False
|
||||
BadDeal%% = FALSE
|
||||
FOR M%% = 0 TO 12 'Cards are in S 1 to 4
|
||||
IF Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 2, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 3, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 4, 2) MOD 13 THEN BadDeal%% = True
|
||||
IF Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 2, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 3, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 4, 2) MOD 13 THEN BadDeal%% = TRUE
|
||||
NEXT M%%
|
||||
WEND
|
||||
Stock%% = 52
|
||||
Anime1%% = 31
|
||||
Anime2%% = 43
|
||||
TurnOver%% = True
|
||||
DoPickUp%% = False
|
||||
PickedUp%% = False
|
||||
TurnOver%% = TRUE
|
||||
DoPickUp%% = FALSE
|
||||
PickedUp%% = FALSE
|
||||
PickedCard%% = 0
|
||||
PickedHour%% = 12
|
||||
CanPutDown%% = False
|
||||
IsComplete%% = False
|
||||
DoPatience%% = True
|
||||
HangOn%% = True
|
||||
CanPutDown%% = FALSE
|
||||
IsComplete%% = FALSE
|
||||
DoPatience%% = TRUE
|
||||
HangOn%% = TRUE
|
||||
HangStop%% = 50
|
||||
HCount%% = 0
|
||||
WHILE DoPatience%%
|
||||
_LIMIT 60
|
||||
GreenValid%% = False
|
||||
RedValid%% = False
|
||||
GreenValid%% = FALSE
|
||||
RedValid%% = FALSE
|
||||
IF Stock%% = 0 AND HangOn%% THEN
|
||||
HCount%% = HCount%% + 1
|
||||
IF HCount%% = HangStop%% THEN
|
||||
HangOn%% = False
|
||||
HangOn%% = FALSE
|
||||
HCount%% = 0
|
||||
HangStop%% = 20
|
||||
END IF
|
||||
|
|
@ -589,7 +591,7 @@ SUB Patience
|
|||
OldHour%% = PickedHour%%
|
||||
Anime1%% = 0
|
||||
ELSEIF NOT DoPickUp%% AND NOT PickedUp%% THEN
|
||||
IF SQR((Positions!(4, PickedHour%%, 0, 4) - XM%) * (Positions!(4, PickedHour%%, 0, 4) - XM%) + (Positions!(4, PickedHour%%, 1, 4) - YM%) * (Positions!(4, PickedHour%%, 1, 4) - YM%)) < 40 THEN GreenValid%% = True
|
||||
IF SQR((Positions!(4, PickedHour%%, 0, 4) - XM%) * (Positions!(4, PickedHour%%, 0, 4) - XM%) + (Positions!(4, PickedHour%%, 1, 4) - YM%) * (Positions!(4, PickedHour%%, 1, 4) - YM%)) < 40 THEN GreenValid%% = TRUE
|
||||
ELSEIF DoPickUp%% THEN
|
||||
IF PickedHour%% = 12 THEN
|
||||
FOR R%% = 4 TO 2 STEP -1
|
||||
|
|
@ -611,11 +613,11 @@ SUB Patience
|
|||
PickedHour%% = 0
|
||||
END IF
|
||||
Orient1! = Phi!(PickedHour%%)
|
||||
PickedUp%% = True
|
||||
DoPickUp%% = False
|
||||
PickedUp%% = TRUE
|
||||
DoPickUp%% = FALSE
|
||||
ELSEIF PickedUp%% THEN
|
||||
IF SQR((Positions!(4, PickedHour%%, 0, 4) - XM%) * (Positions!(4, PickedHour%%, 0, 4) - XM%) + (Positions!(4, PickedHour%%, 1, 4) - YM%) * (Positions!(4, PickedHour%%, 1, 4) - YM%)) < 40 THEN
|
||||
IF NOT CanPutDown%% THEN RedValid%% = True
|
||||
IF NOT CanPutDown%% THEN RedValid%% = TRUE
|
||||
Orient! = Orient1!
|
||||
ELSEIF SQR((Positions!(4, OldHour%%, 0, 4) - XM%) * (Positions!(4, OldHour%%, 0, 4) - XM%) + (Positions!(4, OldHour%%, 1, 4) - YM%) * (Positions!(4, OldHour%%, 1, 4) - YM%)) < 40 THEN
|
||||
Orient! = Orient0!
|
||||
|
|
@ -623,30 +625,30 @@ SUB Patience
|
|||
Orient! = 0
|
||||
END IF
|
||||
IF CanPutDown%% THEN
|
||||
CanPutDown%% = False
|
||||
PickedUp%% = False
|
||||
HangOn%% = True
|
||||
CanPutDown%% = FALSE
|
||||
PickedUp%% = FALSE
|
||||
HangOn%% = TRUE
|
||||
IF PickedHour%% = 12 THEN
|
||||
Clock%%(PickedHour%%, 1, 0) = PickedCard%%
|
||||
Clock%%(PickedHour%%, 1, 1) = True
|
||||
Clock%%(PickedHour%%, 1, 1) = TRUE
|
||||
ELSE
|
||||
Clock%%(PickedHour%%, 0, 0) = PickedCard%%
|
||||
Clock%%(PickedHour%%, 0, 1) = True
|
||||
Clock%%(PickedHour%%, 0, 1) = TRUE
|
||||
END IF
|
||||
PickedCard%% = 0
|
||||
IF Clock%%(12, 4, 1) AND Clock%%(12, 1, 0) <> 0 THEN 'Game Finished
|
||||
IsComplete%% = True
|
||||
Control(NewGameBT).Disabled = False
|
||||
Control(NewGameBT).Hidden = False
|
||||
IsComplete%% = TRUE
|
||||
Control(NewGameBT).Disabled = FALSE
|
||||
Control(NewGameBT).Hidden = FALSE
|
||||
SetFocus NewGameBT
|
||||
GotOut%% = True
|
||||
GotOut%% = TRUE
|
||||
M%% = 0
|
||||
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
|
||||
WEND
|
||||
END IF
|
||||
IF NOT IsComplete%% THEN TurnOver%% = True
|
||||
IF NOT IsComplete%% THEN TurnOver%% = TRUE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
|
|
@ -660,6 +662,3 @@ SUB Shuffle (Pack%%()) 'Fisher Yates or Knuth shuffle
|
|||
SWAP Pack%%(R%%), Pack%%(S%%)
|
||||
NEXT S%%
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -60,6 +60,8 @@ DIM SHARED SpiralAngle!, KeysList$, XF!, YF!, XN!, YN!, XGun!, YGun!
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Duck Shoot.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures & Functions: ---------------------------------------------------
|
||||
|
||||
|
|
@ -74,9 +76,9 @@ END FUNCTION
|
|||
|
||||
SUB __UI_BeforeInit
|
||||
$EXEICON:'.\helloducky.ico'
|
||||
AtGameStart%% = True
|
||||
StartGame%% = True
|
||||
SideBarIn%% = True
|
||||
AtGameStart%% = TRUE
|
||||
StartGame%% = TRUE
|
||||
SideBarIn%% = TRUE
|
||||
KeysList$ = "abcdefghijklmnopqrstuvwxyz#',./;[\]"
|
||||
'Parameters!() Data Input
|
||||
RESTORE level_data
|
||||
|
|
@ -110,9 +112,9 @@ SUB __UI_BeforeInit
|
|||
END IF
|
||||
GameLevel%% = ReachedLevel%%
|
||||
IF ReachedLevel%% = 7 THEN
|
||||
SideBarFlag%% = True
|
||||
SideBarFlag%% = TRUE
|
||||
ELSE
|
||||
SideBarFlag%% = False
|
||||
SideBarFlag%% = FALSE
|
||||
END IF
|
||||
AllTheFunoftheFair& = _SNDOPEN("funfair.mp3")
|
||||
_SNDLOOP AllTheFunoftheFair&
|
||||
|
|
@ -171,14 +173,14 @@ SUB __UI_OnLoad
|
|||
Control(LeftHandKeysFR).Top = 400
|
||||
Control(RightHandKeysFR).Left = GoldX% + 30
|
||||
Control(RightHandKeysFR).Top = 400
|
||||
CALL DispSetKeys((True))
|
||||
CALL DispLHKeys((True))
|
||||
CALL DispRHKeys((True))
|
||||
Control(GameLevelFR).Disabled = True
|
||||
CALL ButtonLock((True))
|
||||
Control(AudioOnRB).Disabled = False
|
||||
Control(AudioOffRB).Disabled = False
|
||||
Control(ResetBT).Disabled = False
|
||||
CALL DispSetKeys((TRUE))
|
||||
CALL DispLHKeys((TRUE))
|
||||
CALL DispRHKeys((TRUE))
|
||||
Control(GameLevelFR).Disabled = TRUE
|
||||
CALL ButtonLock((TRUE))
|
||||
Control(AudioOnRB).Disabled = FALSE
|
||||
Control(AudioOffRB).Disabled = FALSE
|
||||
Control(ResetBT).Disabled = FALSE
|
||||
Caption(ResetBT) = "Start"
|
||||
SetFocus ResetBT
|
||||
CALL WriteList(0)
|
||||
|
|
@ -203,7 +205,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
STATIC Slug&, WonLevel&, ImReady&, DispLevel&, ShotsTot&, Success&, Award&, GoldenShot&
|
||||
STATIC Targ1&, Pigeon&, Quacker&
|
||||
IF NOT HereAgain%% THEN 'Load Images
|
||||
HereAgain%% = True
|
||||
HereAgain%% = TRUE
|
||||
SideBar% = 1120
|
||||
XErr%% = -2
|
||||
DIM Numerals&(10)
|
||||
|
|
@ -366,7 +368,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
Pigeon& = _LOADIMAGE("pigeon1.png", 32)
|
||||
END IF
|
||||
IF QuackInit%% THEN
|
||||
QuackInit%% = False
|
||||
QuackInit%% = FALSE
|
||||
TempImg& = _NEWIMAGE(2 * HalfWidth% + 1, 2 * HalfHeight% + 1, 32)
|
||||
_DEST TempImg&
|
||||
_PUTIMAGE , Pigeon&
|
||||
|
|
@ -516,27 +518,27 @@ SUB __UI_BeforeUpdateDisplay
|
|||
Control(AudioFR).Left = Control(AudioFR).Left - 5
|
||||
Control(OptionsFR).Left = Control(OptionsFR).Left - 5
|
||||
IF SideBar% = 1120 THEN
|
||||
SideBarIn%% = True
|
||||
Control(GameLevelFR).Disabled = False
|
||||
Control(AudioFR).Disabled = False
|
||||
Control(OptionsFR).Disabled = False
|
||||
Control(ExitBT).Disabled = False
|
||||
Control(AudioOnRB).Disabled = False
|
||||
Control(AudioOffRB).Disabled = False
|
||||
IF NOT SideBarFlag%% THEN CALL ButtonLock((False))
|
||||
SideBarIn%% = TRUE
|
||||
Control(GameLevelFR).Disabled = FALSE
|
||||
Control(AudioFR).Disabled = FALSE
|
||||
Control(OptionsFR).Disabled = FALSE
|
||||
Control(ExitBT).Disabled = FALSE
|
||||
Control(AudioOnRB).Disabled = FALSE
|
||||
Control(AudioOffRB).Disabled = FALSE
|
||||
IF NOT SideBarFlag%% THEN CALL ButtonLock((FALSE))
|
||||
END IF
|
||||
END IF
|
||||
ELSE
|
||||
IF SideBar% < XScreen% THEN
|
||||
IF SideBar% = 1120 THEN
|
||||
SideBarIn%% = False
|
||||
Control(GameLevelFR).Disabled = True
|
||||
Control(AudioFR).Disabled = True
|
||||
Control(OptionsFR).Disabled = True
|
||||
Control(ExitBT).Disabled = True
|
||||
Control(AudioOnRB).Disabled = True
|
||||
Control(AudioOffRB).Disabled = True
|
||||
CALL ButtonLock((True))
|
||||
SideBarIn%% = FALSE
|
||||
Control(GameLevelFR).Disabled = TRUE
|
||||
Control(AudioFR).Disabled = TRUE
|
||||
Control(OptionsFR).Disabled = TRUE
|
||||
Control(ExitBT).Disabled = TRUE
|
||||
Control(AudioOnRB).Disabled = TRUE
|
||||
Control(AudioOffRB).Disabled = TRUE
|
||||
CALL ButtonLock((TRUE))
|
||||
END IF
|
||||
SideBar% = SideBar% + 5
|
||||
Control(GameLevelFR).Left = Control(GameLevelFR).Left + 5
|
||||
|
|
@ -574,27 +576,27 @@ SUB __UI_Click (id AS LONG)
|
|||
IF HaveSet%% THEN CALL WeAreDone
|
||||
SYSTEM
|
||||
ELSE
|
||||
Dux%% = False
|
||||
StartGame%% = False
|
||||
Dux%% = FALSE
|
||||
StartGame%% = FALSE
|
||||
END IF
|
||||
CASE ResetBT
|
||||
IF AtGameStart%% THEN
|
||||
AtGameStart%% = False
|
||||
AtGameStart%% = FALSE
|
||||
Caption(ResetBT) = "Reset"
|
||||
Control(GameLevelFR).Disabled = False
|
||||
Control(AudioFR).Disabled = False
|
||||
Control(AudioOnRB).Disabled = False
|
||||
Control(AudioOffRB).Disabled = False
|
||||
Control(SetKeysBT).Disabled = True
|
||||
CALL ButtonLock((False))
|
||||
Ready%% = True
|
||||
Control(GameLevelFR).Disabled = FALSE
|
||||
Control(AudioFR).Disabled = FALSE
|
||||
Control(AudioOnRB).Disabled = FALSE
|
||||
Control(AudioOffRB).Disabled = FALSE
|
||||
Control(SetKeysBT).Disabled = TRUE
|
||||
CALL ButtonLock((FALSE))
|
||||
Ready%% = TRUE
|
||||
CALL MadameZora
|
||||
ELSE
|
||||
'Reset to level 1 & reset parameters
|
||||
Dux%% = False
|
||||
Dux%% = FALSE
|
||||
ReachedLevel%% = 1
|
||||
GameLevel%% = ReachedLevel%%
|
||||
Control(Level6RB).Disabled = True
|
||||
Control(Level6RB).Disabled = TRUE
|
||||
SetRadioButtonValue Level1RB
|
||||
END IF
|
||||
CASE RestartLevelBT
|
||||
|
|
@ -606,58 +608,58 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE Level1RB
|
||||
IF GameLevel%% <> 1 THEN
|
||||
GameLevel%% = 1
|
||||
Dux%% = False
|
||||
Dux%% = FALSE
|
||||
END IF
|
||||
CASE Level2RB
|
||||
IF GameLevel%% <> 2 THEN
|
||||
GameLevel%% = 2
|
||||
Dux%% = False
|
||||
Dux%% = FALSE
|
||||
END IF
|
||||
CASE Level3RB
|
||||
IF GameLevel%% <> 3 THEN
|
||||
GameLevel%% = 3
|
||||
Dux%% = False
|
||||
Dux%% = FALSE
|
||||
END IF
|
||||
CASE Level4RB
|
||||
IF GameLevel%% <> 4 THEN
|
||||
GameLevel%% = 4
|
||||
Dux%% = False
|
||||
Dux%% = FALSE
|
||||
END IF
|
||||
CASE Level5RB
|
||||
IF GameLevel%% <> 5 THEN
|
||||
GameLevel%% = 5
|
||||
Dux%% = False
|
||||
Dux%% = FALSE
|
||||
END IF
|
||||
CASE Level6RB
|
||||
IF GameLevel%% <> 6 THEN
|
||||
GameLevel%% = 6
|
||||
Dux%% = False
|
||||
Dux%% = FALSE
|
||||
END IF
|
||||
CASE AudioOffRB
|
||||
_SNDSTOP AllTheFunoftheFair&
|
||||
CASE AudioOnRB
|
||||
_SNDLOOP AllTheFunoftheFair&
|
||||
CASE SetKeysBT
|
||||
Control(ResetBT).Disabled = True
|
||||
Control(SetKeysBT).Disabled = True
|
||||
CALL DispSetKeys((False))
|
||||
CALL DispLHKeys((False))
|
||||
CALL DispRHKeys((True))
|
||||
Control(ResetBT).Disabled = TRUE
|
||||
Control(SetKeysBT).Disabled = TRUE
|
||||
CALL DispSetKeys((FALSE))
|
||||
CALL DispLHKeys((FALSE))
|
||||
CALL DispRHKeys((TRUE))
|
||||
CASE DoneBT
|
||||
CALL DispSetKeys((True))
|
||||
CALL DispLHKeys((True))
|
||||
CALL DispRHKeys((True))
|
||||
Control(ResetBT).Disabled = False
|
||||
Control(SetKeysBT).Disabled = False
|
||||
CALL DispSetKeys((TRUE))
|
||||
CALL DispLHKeys((TRUE))
|
||||
CALL DispRHKeys((TRUE))
|
||||
Control(ResetBT).Disabled = FALSE
|
||||
Control(SetKeysBT).Disabled = FALSE
|
||||
SetFocus ResetBT
|
||||
CASE SetLeftHandKeysRB
|
||||
CALL DispLHKeys((False))
|
||||
CALL DispRHKeys((True))
|
||||
CALL DispLHKeys((FALSE))
|
||||
CALL DispRHKeys((TRUE))
|
||||
SetRadioButtonValue NearSightUpRB
|
||||
CALL KeyList(0)
|
||||
CASE SetRightHandKeysRB
|
||||
CALL DispLHKeys((True))
|
||||
CALL DispRHKeys((False))
|
||||
CALL DispLHKeys((TRUE))
|
||||
CALL DispRHKeys((FALSE))
|
||||
SetRadioButtonValue FarSightUpRB
|
||||
CALL KeyList(4)
|
||||
CASE NearSightUpRB
|
||||
|
|
@ -681,7 +683,7 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE SetBT
|
||||
TheItem%% = Control(SelectKeyDD).Value
|
||||
IF TheItem%% > 0 THEN
|
||||
HaveSet%% = True
|
||||
HaveSet%% = TRUE
|
||||
IF Control(SetLeftHandKeysRB).Value THEN
|
||||
IF Control(NearSightUpRB).Value THEN
|
||||
KeyCode%(0) = ASC(GetItem$(SelectKeyDD, TheItem%%))
|
||||
|
|
@ -759,9 +761,9 @@ SUB ButtonLock (OnOff%%)
|
|||
Control(Level4RB).Disabled = OnOff%%
|
||||
Control(Level5RB).Disabled = OnOff%%
|
||||
IF OnOff%% THEN
|
||||
Control(Level6RB).Disabled = True
|
||||
Control(Level6RB).Disabled = TRUE
|
||||
ELSEIF GameLevel%% = 6 OR GameLevel%% = 7 THEN
|
||||
Control(Level6RB).Disabled = False
|
||||
Control(Level6RB).Disabled = FALSE
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
|
|
@ -860,11 +862,11 @@ SUB MadameZora
|
|||
XNprev! = XNDev!
|
||||
YNprev! = YNDev!
|
||||
FireCount% = CanFire%
|
||||
Fired%% = False
|
||||
Fired%% = FALSE
|
||||
NoShots% = 0
|
||||
DuckCount% = 0
|
||||
WhatLevel% = AtNextLevel%
|
||||
Dux%% = True
|
||||
Dux%% = TRUE
|
||||
WHILE Dux%%
|
||||
_LIMIT FrameRate%
|
||||
IF Parameters!(GameLevel%%, 15) > 0 THEN 'Rotate Spiral
|
||||
|
|
@ -943,47 +945,47 @@ SUB MadameZora
|
|||
XNprev! = XNDev!
|
||||
IF XUp%% THEN
|
||||
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
|
||||
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
|
||||
IF O0Up%% THEN
|
||||
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
|
||||
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
|
||||
YNDev! = Y0! * SIN(Omega1! * Count1%)
|
||||
YNDelta! = YNDev! - YNprev!
|
||||
YNprev! = YNDev!
|
||||
IF YUp%% THEN
|
||||
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
|
||||
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
|
||||
IF O1Up%% THEN
|
||||
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
|
||||
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
|
||||
ELSE
|
||||
IF AwardAnim% = 0 THEN _SNDPLAYFILE "fanfare.mp3"
|
||||
IF AwardAnim% < 4 * 192 THEN
|
||||
AwardAnim% = AwardAnim% + 1
|
||||
ELSEIF SideBarFlag%% THEN
|
||||
IF SideBarIn%% THEN CALL ButtonLock((False))
|
||||
SideBarFlag%% = False
|
||||
IF SideBarIn%% THEN CALL ButtonLock((FALSE))
|
||||
SideBarFlag%% = FALSE
|
||||
END IF
|
||||
END IF
|
||||
IF _KEYDOWN(27) THEN
|
||||
Dux%% = False
|
||||
StartGame%% = False
|
||||
Dux%% = FALSE
|
||||
StartGame%% = FALSE
|
||||
ELSEIF GameLevel%% <= 6 AND Ready%% THEN
|
||||
IF _KEYDOWN(KeyCode%(0)) THEN YN! = YN! - PosStep! 'Up (Default w)
|
||||
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)
|
||||
_SNDPLAYFILE "22handgun.mp3"
|
||||
FireCount% = 0
|
||||
Fired%% = True
|
||||
Fired%% = TRUE
|
||||
ZGun! = 0
|
||||
XGun! = XF!
|
||||
YGun! = YF!
|
||||
|
|
@ -1048,11 +1050,11 @@ SUB MadameZora
|
|||
NoShots% = 0
|
||||
DuckCount% = 0
|
||||
WhatLevel% = 0
|
||||
Ready%% = False
|
||||
Control(AudioFR).Disabled = True
|
||||
Control(GameLevelFR).Disabled = True
|
||||
CALL ButtonLock((True))
|
||||
SideBarFlag%% = True
|
||||
Ready%% = FALSE
|
||||
Control(AudioFR).Disabled = TRUE
|
||||
Control(GameLevelFR).Disabled = TRUE
|
||||
CALL ButtonLock((TRUE))
|
||||
SideBarFlag%% = TRUE
|
||||
END IF
|
||||
N%% = 6
|
||||
ELSE
|
||||
|
|
@ -1063,7 +1065,7 @@ SUB MadameZora
|
|||
END IF
|
||||
WEND
|
||||
END IF
|
||||
Fired%% = False
|
||||
Fired%% = FALSE
|
||||
END IF
|
||||
END IF
|
||||
IF WhatLevel% < AtNextLevel% THEN
|
||||
|
|
@ -1085,13 +1087,13 @@ SUB MadameZora
|
|||
ReachedLevel%% = ReachedLevel%% + 1
|
||||
ELSE
|
||||
ReachedLevel%% = 7
|
||||
Control(Level6RB).Disabled = False
|
||||
Control(Level6RB).Disabled = FALSE
|
||||
END IF
|
||||
GameLevel%% = ReachedLevel%%
|
||||
CALL InitParams(X0Step!, Y0Step!, O0Step!, O1Step!, Omega!, X0!, Omega0!, Y0!, Omega1!)
|
||||
Ready%% = True
|
||||
IF SideBarIn%% THEN CALL ButtonLock((False))
|
||||
SideBarFlag%% = False
|
||||
Ready%% = TRUE
|
||||
IF SideBarIn%% THEN CALL ButtonLock((FALSE))
|
||||
SideBarFlag%% = FALSE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
|
|
@ -1109,7 +1111,7 @@ SUB Rotor (XIn!, YIn!, XOut!, YOut!, Theta!)
|
|||
END SUB
|
||||
|
||||
SUB InitParams (X00Step!, Y00Step!, O00Step!, O10Step!, Mega!, X00!, Omega00!, Y00!, Omega10!)
|
||||
QuackInit%% = True
|
||||
QuackInit%% = TRUE
|
||||
X00Step! = (Parameters!(GameLevel%%, 7) - Parameters!(GameLevel%%, 8)) / (15 * FrameRate%)
|
||||
Y00Step! = (Parameters!(GameLevel%%, 11) - Parameters!(GameLevel%%, 12)) / (15 * FrameRate%)
|
||||
O00Step! = (Parameters!(GameLevel%%, 9) - Parameters!(GameLevel%%, 10)) / (30 * FrameRate%)
|
||||
|
|
@ -1132,6 +1134,3 @@ SUB WeAreDone
|
|||
PRINT #1, ReachedLevel%%
|
||||
CLOSE #1
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -32,6 +32,8 @@ CONST TT% = 38, TB% = 668, FL% = 82, FR% = 106, CL% = 321, CR% = 345
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Fahrenheit-Celsius.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Functions: ----------------------------------------------------------------------
|
||||
FUNCTION FTOC! (T!, Deg%%)
|
||||
|
|
@ -74,7 +76,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
IF NOT InitDone%% THEN
|
||||
': Everything (except events) is done in the __UI_BeforeUpdateDisplay SUB
|
||||
': All initiations, image loading & manipulations are done once here
|
||||
InitDone%% = True
|
||||
InitDone%% = TRUE
|
||||
DIM Pics&(1, 4), TRange!(1, 3)
|
||||
': Read temperature Ranges
|
||||
RESTORE temp_range
|
||||
|
|
@ -151,7 +153,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
IF OldScale%% THEN
|
||||
': Body Temperature Scales
|
||||
FSetTemp! = 98.4
|
||||
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, True))
|
||||
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE))
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
FT% = 44
|
||||
|
|
@ -217,18 +219,18 @@ SUB __UI_BeforeUpdateDisplay
|
|||
END IF
|
||||
NEXT N%
|
||||
EndDraw CelsiusPBox
|
||||
PicUpdate%% = True
|
||||
PicUpdate%% = TRUE
|
||||
END IF
|
||||
': Poll Mouse
|
||||
LM% = __UI_MouseLeft
|
||||
TM% = __UI_MouseTop
|
||||
': Look for position inside thermometer tubes and check Click
|
||||
IF LM% > 70 + TFPos% AND LM% < 70 + TFPos% + 24 AND TM% > FT% AND TM% < FB% THEN
|
||||
InFahrenheit%% = True
|
||||
InFahrenheit%% = TRUE
|
||||
TempT! = OnePlace!(FTMax% + ((TM% - FT%) * (FTMin% - FTMax%) / (FB% - FT%)))
|
||||
IF NOT TClicked%% THEN Text(FahrenheitTB) = IText$(TempT!)
|
||||
ELSEIF LM% > 290 + TCPos% AND LM% < 290 + TCPos% + 24 AND TM% > CT% AND TM% < CB% THEN
|
||||
InCelsius%% = True
|
||||
InCelsius%% = TRUE
|
||||
TempT! = OnePlace!(CTMax% + (TM% - CT%) * (CTMin% - CTMax%) / (CB% - CT%))
|
||||
IF NOT TClicked%% THEN Text(CelsiusTB) = IText$(TempT!)
|
||||
ELSE
|
||||
|
|
@ -237,13 +239,13 @@ SUB __UI_BeforeUpdateDisplay
|
|||
ELSEIF InCelsius%% AND NOT TClicked%% THEN
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
END IF
|
||||
InFahrenheit%% = False
|
||||
InCelsius%% = False
|
||||
IF TClicked%% THEN TClicked%% = False
|
||||
InFahrenheit%% = FALSE
|
||||
InCelsius%% = FALSE
|
||||
IF TClicked%% THEN TClicked%% = FALSE
|
||||
END IF
|
||||
': Update thermometers
|
||||
IF PicUpdate%% THEN
|
||||
PicUpdate%% = False
|
||||
PicUpdate%% = FALSE
|
||||
YF% = FT% + (FSetTemp! - FTMax%) * (FB% - FT%) / (FTMin% - FTMax%)
|
||||
YC% = CT% + (CSetTemp! - CTMax%) * (CB% - CT%) / (CTMin% - CTMax%)
|
||||
BeginDraw FahrenheitPBox
|
||||
|
|
@ -334,26 +336,26 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE FahrenheitPBox
|
||||
': Check for click in thermometer columns
|
||||
IF InFahrenheit%% AND NOT TClicked%% THEN
|
||||
TClicked%% = True
|
||||
TClicked%% = TRUE
|
||||
FSetTemp! = OnePlace!(TempT!)
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, True))
|
||||
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE))
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
PicUpdate%% = True
|
||||
PicUpdate%% = TRUE
|
||||
END IF
|
||||
CASE CelsiusPBox
|
||||
': Check for click in thermometer columns
|
||||
IF InCelsius%% AND NOT TClicked%% THEN
|
||||
TClicked%% = True
|
||||
TClicked%% = TRUE
|
||||
CSetTemp! = OnePlace!(TempT!)
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, False))
|
||||
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, FALSE))
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
PicUpdate%% = True
|
||||
PicUpdate%% = TRUE
|
||||
END IF
|
||||
CASE FixTextBoxesTS
|
||||
': Check for Toggle Switch Click
|
||||
PicUpdate%% = True
|
||||
PicUpdate%% = TRUE
|
||||
CASE ExitBT
|
||||
': Click Exit Button
|
||||
SYSTEM
|
||||
|
|
@ -397,16 +399,16 @@ SUB __UI_KeyPress (id AS LONG)
|
|||
': Update Fahrenheit temperature & convert
|
||||
FSetTemp! = OnePlace!(VAL(Text(FahrenheitTB)))
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, True))
|
||||
CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE))
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
PicUpdate%% = True
|
||||
PicUpdate%% = TRUE
|
||||
CASE CelsiusTB
|
||||
': Update Celsius temperature & convert
|
||||
CSetTemp! = OnePlace!(VAL(Text(CelsiusTB)))
|
||||
Text(CelsiusTB) = IText$(CSetTemp!)
|
||||
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, False))
|
||||
FSetTemp! = OnePlace!(FTOC!(CSetTemp!, FALSE))
|
||||
Text(FahrenheitTB) = IText$(FSetTemp!)
|
||||
PicUpdate%% = True
|
||||
PicUpdate%% = TRUE
|
||||
CASE ExitBT
|
||||
SYSTEM 'Does this condition ever get met?
|
||||
END SELECT
|
||||
|
|
@ -421,6 +423,3 @@ END SUB
|
|||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -55,6 +55,8 @@ DIM SHARED HappyNewYearLB AS LONG
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Fireworks.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -82,28 +84,28 @@ SUB __UI_BeforeUpdateDisplay
|
|||
_DEST Control(Canvas).HelperCanvas
|
||||
|
||||
IF JustExploded THEN
|
||||
JustExploded = False
|
||||
JustExploded = FALSE
|
||||
CLS , _RGB32(0, 0, 50)
|
||||
ELSE
|
||||
CLS
|
||||
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
|
||||
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.x = 3 - _CEIL(RND * 6)
|
||||
IF Initial = True THEN
|
||||
IF Initial = TRUE THEN
|
||||
Firework(j).Pos.x = _CEIL(RND * Control(Canvas).Width)
|
||||
ELSE
|
||||
Firework(j).Pos.x = InitialX * (Control(Canvas).Width / 15)
|
||||
InitialX = InitialX + 1
|
||||
lastInitial# = TIMER
|
||||
IF InitialX > 15 THEN Initial = True
|
||||
IF InitialX > 15 THEN Initial = TRUE
|
||||
END IF
|
||||
Firework(j).Pos.y = Control(Canvas).Height + _CEIL(RND * StartPointLimit)
|
||||
Firework(j).Visible = True
|
||||
Firework(j).Exploded = False
|
||||
Firework(j).Visible = TRUE
|
||||
Firework(j).Exploded = FALSE
|
||||
Firework(j).ExplosionStep = 0
|
||||
Firework(j).Size = _CEIL(RND * 2)
|
||||
IF Firework(j).Size = 1 THEN
|
||||
|
|
@ -135,7 +137,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
FOR i = 1 TO UBOUND(Firework)
|
||||
'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
|
||||
Trail(t).Pos.x = Firework(i).Pos.x
|
||||
Trail(t).Pos.y = Firework(i).Pos.y
|
||||
|
|
@ -149,9 +151,9 @@ SUB __UI_BeforeUpdateDisplay
|
|||
|
||||
'Explode the particle if it reaches max height
|
||||
IF Firework(i).Vel.y > 0 THEN
|
||||
IF Firework(i).Exploded = False THEN
|
||||
Firework(i).Exploded = True
|
||||
JustExploded = True
|
||||
IF Firework(i).Exploded = FALSE THEN
|
||||
Firework(i).Exploded = TRUE
|
||||
JustExploded = TRUE
|
||||
|
||||
IF Firework(1).Size = 1 THEN
|
||||
IF distant THEN _SNDPLAYCOPY distant, .5
|
||||
|
|
@ -180,7 +182,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
END IF
|
||||
|
||||
'Show particle
|
||||
IF Firework(i).Exploded = False THEN
|
||||
IF Firework(i).Exploded = FALSE THEN
|
||||
IF Firework(i).Size = 1 THEN
|
||||
PSET (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
|
||||
ELSE
|
||||
|
|
@ -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
|
||||
END IF
|
||||
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
|
||||
NEXT
|
||||
|
||||
|
|
@ -419,6 +421,3 @@ END SUB
|
|||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -19,6 +19,10 @@ DIM SHARED PlayBT AS LONG
|
|||
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'GIFPlaySample.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
'$INCLUDE:'../../InForm/extensions/GIFPlay.bas'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -29,7 +33,7 @@ SUB __UI_OnLoad
|
|||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
IF GIF_IsLoaded(PictureBox1) THEN GIF_Draw PictureBox1
|
||||
GIF_Draw PictureBox1
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
|
|
@ -107,8 +111,3 @@ END SUB
|
|||
|
||||
SUB __UI_FormResized
|
||||
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
|
|
@ -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
|
||||
29
examples/GravitationSimulation/mbpfile.dat
Normal file
29
examples/GravitationSimulation/mbpfile.dat
Normal 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
|
||||
|
|
@ -18,6 +18,8 @@ DIM SHARED Drawing AS _BYTE, Tool AS _UNSIGNED _BYTE
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'InFormPaint.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -179,7 +181,7 @@ SUB __UI_MouseDown (id AS LONG)
|
|||
CASE InFormPaint
|
||||
|
||||
CASE PictureBox1
|
||||
Drawing = True
|
||||
Drawing = TRUE
|
||||
CASE CircleBT
|
||||
|
||||
CASE SquareBT
|
||||
|
|
@ -192,7 +194,7 @@ SUB __UI_MouseDown (id AS LONG)
|
|||
END SUB
|
||||
|
||||
SUB __UI_MouseUp (id AS LONG)
|
||||
Drawing = False
|
||||
Drawing = FALSE
|
||||
SELECT CASE id
|
||||
CASE InFormPaint
|
||||
|
||||
|
|
@ -235,6 +237,3 @@ END SUB
|
|||
SUB __UI_FormResized
|
||||
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -36,6 +36,8 @@ DIM SHARED ClickCount%, Vertices%(3, 1), A#, B#, C#, XMouse%, YMouse%
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Inside-Outside Triangle.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Functions: ---------------------------------------------------------------------
|
||||
FUNCTION SideLength# (X1#, Y1#, X2#, Y2#)
|
||||
|
|
@ -51,18 +53,18 @@ END FUNCTION
|
|||
FUNCTION AtCorner%%
|
||||
'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
|
||||
AtCorner%% = True
|
||||
AtCorner%% = TRUE
|
||||
ELSE
|
||||
AtCorner%% = False
|
||||
AtCorner%% = FALSE
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION InPicture%%
|
||||
'True if cursor is in PictureBox1
|
||||
IF XMouse% > 0 AND XMouse% < 650 AND YMouse% > 0 AND YMouse% < 540 THEN
|
||||
InPicture%% = True
|
||||
InPicture%% = TRUE
|
||||
ELSE
|
||||
InPicture%% = False
|
||||
InPicture%% = FALSE
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
|
|
@ -79,7 +81,7 @@ SUB __UI_BeforeInit
|
|||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
Control(InsideOutsideLB).Hidden = True
|
||||
Control(InsideOutsideLB).Hidden = TRUE
|
||||
BeginDraw PictureBox1
|
||||
'Drawing code goes here
|
||||
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
|
||||
|
|
@ -206,7 +208,7 @@ SUB __UI_Click (id AS LONG)
|
|||
EndDraw PictureBox1
|
||||
Caption(Click1LB) = "Move Cursor"
|
||||
Caption(Click2LB) = "Around"
|
||||
Control(InsideOutsideLB).Hidden = False
|
||||
Control(InsideOutsideLB).Hidden = FALSE
|
||||
'Triangle Side Lengths
|
||||
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))
|
||||
|
|
@ -227,7 +229,7 @@ SUB __UI_Click (id AS LONG)
|
|||
Caption(Y2LB) = ""
|
||||
Caption(X3LB) = ""
|
||||
Caption(Y3LB) = ""
|
||||
Control(InsideOutsideLB).Hidden = True
|
||||
Control(InsideOutsideLB).Hidden = TRUE
|
||||
Caption(Click1LB) = "Click To Set"
|
||||
Caption(Click2LB) = "Vertex 1"
|
||||
END SELECT
|
||||
|
|
@ -266,6 +268,3 @@ END SUB
|
|||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -48,6 +48,8 @@ DIM SHARED pbScene AS LONG
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Lander1.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -101,8 +103,8 @@ SUB __UI_BeforeUpdateDisplay
|
|||
END IF
|
||||
ELSE
|
||||
'actvate restart
|
||||
Control(bRestart).Hidden = False
|
||||
Control(bRestart).Disabled = False
|
||||
Control(bRestart).Hidden = FALSE
|
||||
Control(bRestart).Disabled = FALSE
|
||||
END IF 'if no message about ending landing
|
||||
|
||||
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
|
||||
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
|
||||
Control(bRestart).Hidden = True
|
||||
Control(bRestart).Disabled = True
|
||||
Control(bRestart).Hidden = TRUE
|
||||
Control(bRestart).Disabled = TRUE
|
||||
|
||||
END SUB
|
||||
|
||||
|
|
@ -523,6 +525,3 @@ SUB makeTerra
|
|||
END IF
|
||||
NEXT
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -65,6 +65,8 @@ DIM SHARED pbScene AS LONG
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Lander2.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -123,8 +125,8 @@ SUB __UI_BeforeUpdateDisplay
|
|||
END IF
|
||||
ELSE
|
||||
'actvate restart
|
||||
Control(bRestart).Hidden = False
|
||||
Control(bRestart).Disabled = False
|
||||
Control(bRestart).Hidden = FALSE
|
||||
Control(bRestart).Disabled = FALSE
|
||||
END IF 'if no message about ending landing
|
||||
|
||||
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
|
||||
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
|
||||
Control(bRestart).Hidden = True
|
||||
Control(bRestart).Disabled = True
|
||||
Control(bRestart).Hidden = TRUE
|
||||
Control(bRestart).Disabled = TRUE
|
||||
END SUB
|
||||
|
||||
'================================================ from Lander 2018-06-04
|
||||
|
|
@ -586,6 +588,3 @@ FUNCTION dec2$ (rn)
|
|||
dec2$ = s$ + ".00"
|
||||
END IF
|
||||
END FUNCTION
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -33,11 +33,53 @@ CONST XOrigin% = 40, YOrigin% = 40, YHalfTile% = 30, XHalfTile% = 20, FrameRate%
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'QB64Mahjong.frm'
|
||||
'$INCLUDE:'MakeBaize.bas'
|
||||
'$INCLUDE:'QB64Logo.bas'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': 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&)
|
||||
HardwareImage& = _COPYIMAGE(ImageName&, 33)
|
||||
_FREEIMAGE ImageName&
|
||||
|
|
@ -50,48 +92,48 @@ END FUNCTION
|
|||
SUB __UI_BeforeInit
|
||||
RANDOMIZE (TIMER)
|
||||
$EXEICON:'.\QB64Mahjong.ico'
|
||||
Innit%% = True
|
||||
Innit%% = TRUE
|
||||
'Set Positions Template
|
||||
FOR S%% = 4 TO 11 '64
|
||||
FOR R%% = 1 TO 8
|
||||
Template`(1, S%%, R%%) = True
|
||||
Template`(1, S%%, R%%) = TRUE
|
||||
NEXT R%%
|
||||
NEXT S%%
|
||||
FOR S%% = 2 TO 3 '8
|
||||
FOR R%% = 1 TO 8 STEP 7
|
||||
Template`(1, S%%, R%%) = True
|
||||
Template`(1, S%% + 10, R%%) = True
|
||||
Template`(1, S%%, R%%) = TRUE
|
||||
Template`(1, S%% + 10, R%%) = TRUE
|
||||
NEXT R%%
|
||||
NEXT S%%
|
||||
FOR S%% = 3 TO 12 STEP 9 '8
|
||||
FOR R%% = 3 TO 6
|
||||
Template`(1, S%%, R%%) = True
|
||||
Template`(1, S%%, R%%) = TRUE
|
||||
NEXT R%%
|
||||
NEXT S%%
|
||||
FOR S%% = 2 TO 13 STEP 11 '4
|
||||
FOR R%% = 4 TO 5
|
||||
Template`(1, S%%, R%%) = True
|
||||
Template`(1, S%%, R%%) = TRUE
|
||||
NEXT R%%
|
||||
NEXT S%%
|
||||
FOR S%% = 5 TO 10 '36
|
||||
FOR R%% = 2 TO 7
|
||||
Template`(2, S%%, R%%) = True
|
||||
Template`(2, S%%, R%%) = TRUE
|
||||
NEXT R%%
|
||||
NEXT S%%
|
||||
FOR S%% = 6 TO 9 '16
|
||||
FOR R%% = 3 TO 6
|
||||
Template`(3, S%%, R%%) = True
|
||||
Template`(3, S%%, R%%) = TRUE
|
||||
NEXT R%%
|
||||
NEXT S%%
|
||||
FOR S%% = 7 TO 8 '4
|
||||
FOR R%% = 4 TO 5
|
||||
Template`(4, S%%, R%%) = True
|
||||
Template`(4, S%%, R%%) = TRUE
|
||||
NEXT R%%
|
||||
NEXT S%%
|
||||
Template`(1, 1, 4) = True '4 'FIO 4.5 really
|
||||
Template`(1, 14, 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`(1, 1, 4) = TRUE '4 'FIO 4.5 really
|
||||
Template`(1, 14, 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
|
||||
'Images - all images are hardware accelerated
|
||||
'Most images are used only in __UI_BeforeUpdateDisplay and therefore could be local and static
|
||||
'But images are Shared instead
|
||||
|
|
@ -219,13 +261,13 @@ SUB __UI_BeforeInit
|
|||
TilePic%%(N%) = S%% + 38
|
||||
NEXT N%
|
||||
'Load data
|
||||
FromSave%% = False
|
||||
FromSave%% = FALSE
|
||||
IF _FILEEXISTS("mahjong.cfg") THEN
|
||||
OPEN "mahjong.cfg" FOR INPUT AS #1
|
||||
INPUT #1, HighScore%
|
||||
INPUT #1, TilesRem%
|
||||
IF TilesRem% <> 144 THEN
|
||||
FromSave%% = True
|
||||
FromSave%% = TRUE
|
||||
'Input saved data
|
||||
INPUT #1, Score%
|
||||
INPUT #1, Counter&
|
||||
|
|
@ -251,16 +293,16 @@ END SUB
|
|||
SUB __UI_OnLoad
|
||||
_SCREENMOVE 100, 50
|
||||
Caption(ExitBT) = "Start"
|
||||
Control(ScoreLB).Hidden = True
|
||||
Control(ScoringLB).Hidden = True
|
||||
Control(HighScoreLB).Hidden = True
|
||||
Control(HighScoringLB).Hidden = True
|
||||
Control(NumberOfTilesLB).Hidden = True
|
||||
Control(TilesRemainingLB).Hidden = True
|
||||
Control(NewGameBT).Disabled = True
|
||||
Control(SaveGameBT).Disabled = True
|
||||
Control(UndoBT).Disabled = True
|
||||
Control(StillBT).Disabled = True
|
||||
Control(ScoreLB).Hidden = TRUE
|
||||
Control(ScoringLB).Hidden = TRUE
|
||||
Control(HighScoreLB).Hidden = TRUE
|
||||
Control(HighScoringLB).Hidden = TRUE
|
||||
Control(NumberOfTilesLB).Hidden = TRUE
|
||||
Control(TilesRemainingLB).Hidden = TRUE
|
||||
Control(NewGameBT).Disabled = TRUE
|
||||
Control(SaveGameBT).Disabled = TRUE
|
||||
Control(UndoBT).Disabled = TRUE
|
||||
Control(StillBT).Disabled = TRUE
|
||||
SetFrameRate FrameRate%
|
||||
SetFocus ExitBT
|
||||
END SUB
|
||||
|
|
@ -274,7 +316,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
ELSEIF TilesRem% <> 0 THEN
|
||||
'Display In-Play Tiles and Look for Mouse Hover/Select/Match
|
||||
NoHov% = 0
|
||||
Matches%% = False
|
||||
Matches%% = FALSE
|
||||
MatchCount% = 0
|
||||
'Layer 1R
|
||||
FOR S%% = 15 TO 14 STEP -1
|
||||
|
|
@ -335,7 +377,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
IF MatchCount% > 1 THEN
|
||||
MatchIndex% = 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
|
||||
WEND
|
||||
END IF
|
||||
|
|
@ -362,7 +404,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
IF MatchCount% > 1 THEN
|
||||
MatchIndex% = 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
|
||||
WEND
|
||||
END IF
|
||||
|
|
@ -388,7 +430,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
IF MatchCount% > 1 THEN
|
||||
MatchIndex% = 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
|
||||
WEND
|
||||
END IF
|
||||
|
|
@ -404,7 +446,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
END IF
|
||||
END IF
|
||||
_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 SUB
|
||||
|
||||
|
|
@ -436,7 +478,7 @@ SUB __UI_Click (id AS LONG)
|
|||
IF NoSel% = 0 THEN
|
||||
'First Tile Selected
|
||||
NoSel% = NoHov%
|
||||
Control(UndoBT).Disabled = False
|
||||
Control(UndoBT).Disabled = FALSE
|
||||
ELSE
|
||||
'Second Tile Selected
|
||||
IF NoSel% <> NoHov% THEN
|
||||
|
|
@ -463,16 +505,16 @@ SUB __UI_Click (id AS LONG)
|
|||
Score% = Score% + 3
|
||||
Caption(TilesRemainingLB) = SetText$(TilesRem%)
|
||||
Caption(ScoringLB) = SetText$(Score%)
|
||||
Control(NewGameBT).Disabled = False
|
||||
Control(NewGameBT).Disabled = FALSE
|
||||
IF TilesRem% > 0 THEN
|
||||
Control(SaveGameBT).Disabled = False
|
||||
Control(UndoBT).Disabled = False
|
||||
Control(SaveGameBT).Disabled = FALSE
|
||||
Control(UndoBT).Disabled = FALSE
|
||||
ELSE
|
||||
Control(SaveGameBT).Disabled = True
|
||||
Control(UndoBT).Disabled = True
|
||||
Control(SaveGameBT).Disabled = TRUE
|
||||
Control(UndoBT).Disabled = TRUE
|
||||
Caption(Label1LB) = "Congratulations"
|
||||
Control(Label1LB).Hidden = False
|
||||
Control(StillBT).Disabled = True
|
||||
Control(Label1LB).Hidden = FALSE
|
||||
Control(StillBT).Disabled = TRUE
|
||||
END IF
|
||||
IF ImType%%(NoSel%) = PrevType%% THEN
|
||||
Score% = Score% + 6
|
||||
|
|
@ -484,7 +526,7 @@ SUB __UI_Click (id AS LONG)
|
|||
END IF
|
||||
END IF
|
||||
NoSel% = 0
|
||||
IF TilesRem% = 144 THEN Control(UndoBT).Disabled = True
|
||||
IF TilesRem% = 144 THEN Control(UndoBT).Disabled = TRUE
|
||||
END IF
|
||||
END IF
|
||||
CASE UndoBT
|
||||
|
|
@ -512,43 +554,43 @@ SUB __UI_Click (id AS LONG)
|
|||
Caption(TilesRemainingLB) = SetText$(TilesRem%)
|
||||
Caption(ScoringLB) = SetText$(Score%)
|
||||
IF TilesRem% < 144 THEN
|
||||
Control(SaveGameBT).Disabled = False
|
||||
Control(SaveGameBT).Disabled = FALSE
|
||||
ELSE
|
||||
Control(SaveGameBT).Disabled = True
|
||||
Control(SaveGameBT).Disabled = TRUE
|
||||
END IF
|
||||
PrevType%% = ImType%%(TileSave%(72 - (TilesRem% / 2), 1))
|
||||
IF ImType%%(One%) = PrevType%% THEN
|
||||
Score% = Score% - 6
|
||||
Caption(ScoringLB) = SetText$(Score%)
|
||||
END IF
|
||||
MatchesNone%% = False
|
||||
Control(Label1LB).Hidden = True
|
||||
CanUndo%% = False
|
||||
MatchesNone%% = FALSE
|
||||
Control(Label1LB).Hidden = TRUE
|
||||
CanUndo%% = FALSE
|
||||
END IF
|
||||
NoSel% = 0 ' Undo also removes selection
|
||||
IF TilesRem% = 144 THEN Control(UndoBT).Disabled = True
|
||||
IF TilesRem% = 144 THEN Control(UndoBT).Disabled = TRUE
|
||||
END IF
|
||||
CASE ExitBT
|
||||
IF Innit%% THEN
|
||||
CALL DoMahjong
|
||||
ELSE
|
||||
MahPlay%% = False
|
||||
Innit%% = True
|
||||
MahPlay%% = FALSE
|
||||
Innit%% = TRUE
|
||||
TilesRem% = 144 ' Prevents Save at Exit
|
||||
END IF
|
||||
CASE NewGameBT
|
||||
MahPlay%% = False
|
||||
MahPlay%% = FALSE
|
||||
CASE SaveGameBT
|
||||
MahPlay%% = False
|
||||
Innit%% = True
|
||||
MahPlay%% = FALSE
|
||||
Innit%% = TRUE
|
||||
IF TilesRem% = 0 THEN TilesRem% = 144 ' Prevents Save at Exit
|
||||
CASE StillBT
|
||||
IF WorldStop%% THEN
|
||||
Caption(StillBT) = "Still"
|
||||
WorldStop%% = False
|
||||
WorldStop%% = FALSE
|
||||
ELSE
|
||||
Caption(StillBT) = "Spin"
|
||||
WorldStop%% = True
|
||||
WorldStop%% = TRUE
|
||||
END IF
|
||||
END SELECT
|
||||
END SUB
|
||||
|
|
@ -590,13 +632,13 @@ END SUB
|
|||
SUB DoMahjong
|
||||
_SNDPLAYFILE "chrysanthemum.ogg", 4, 0.6
|
||||
Caption(ExitBT) = "Exit"
|
||||
Control(ScoreLB).Hidden = False
|
||||
Control(ScoringLB).Hidden = False
|
||||
Control(HighScoreLB).Hidden = False
|
||||
Control(HighScoringLB).Hidden = False
|
||||
Control(NumberOfTilesLB).Hidden = False
|
||||
Control(TilesRemainingLB).Hidden = False
|
||||
Innit%% = False
|
||||
Control(ScoreLB).Hidden = FALSE
|
||||
Control(ScoringLB).Hidden = FALSE
|
||||
Control(HighScoreLB).Hidden = FALSE
|
||||
Control(HighScoringLB).Hidden = FALSE
|
||||
Control(NumberOfTilesLB).Hidden = FALSE
|
||||
Control(TilesRemainingLB).Hidden = FALSE
|
||||
Innit%% = FALSE
|
||||
WHILE NOT Innit%%
|
||||
'Initial Values
|
||||
IF NOT FromSave%% THEN
|
||||
|
|
@ -610,7 +652,7 @@ SUB DoMahjong
|
|||
NEXT U%%
|
||||
'Randomly Fill Grid
|
||||
FOR N% = 1 TO 144
|
||||
Empty%% = True
|
||||
Empty%% = TRUE
|
||||
WHILE Empty%%
|
||||
URnd%% = 1 + INT(15 * RND)
|
||||
VRnd%% = 1 + INT(8 * RND)
|
||||
|
|
@ -620,7 +662,7 @@ SUB DoMahjong
|
|||
ImPos%%(N%, 0) = WRnd%%
|
||||
ImPos%%(N%, 1) = URnd%%
|
||||
ImPos%%(N%, 2) = VRnd%%
|
||||
Empty%% = False
|
||||
Empty%% = FALSE
|
||||
END IF
|
||||
WEND
|
||||
NEXT N%
|
||||
|
|
@ -634,28 +676,28 @@ SUB DoMahjong
|
|||
Counter& = 0
|
||||
PrevType%% = 0
|
||||
END IF
|
||||
MahPlay%% = True
|
||||
MahPlay%% = TRUE
|
||||
NoSel% = 0
|
||||
NoHov% = 0
|
||||
MatchesNone%% = False
|
||||
MatchBeeped%% = False
|
||||
MatchesNone%% = FALSE
|
||||
MatchBeeped%% = FALSE
|
||||
ECount%% = 0
|
||||
EIndex%% = 0
|
||||
BCount%% = 0
|
||||
Blink%% = True
|
||||
CanUndo%% = True
|
||||
Blink%% = TRUE
|
||||
CanUndo%% = TRUE
|
||||
UCount%% = 0
|
||||
WorldStop%% = False
|
||||
Control(NewGameBT).Disabled = True
|
||||
Control(SaveGameBT).Disabled = True
|
||||
Control(StillBT).Disabled = False
|
||||
WorldStop%% = FALSE
|
||||
Control(NewGameBT).Disabled = TRUE
|
||||
Control(SaveGameBT).Disabled = TRUE
|
||||
Control(StillBT).Disabled = FALSE
|
||||
IF FromSave%% THEN
|
||||
FromSave%% = False
|
||||
Control(UndoBT).Disabled = False
|
||||
FromSave%% = FALSE
|
||||
Control(UndoBT).Disabled = FALSE
|
||||
ELSE
|
||||
Control(UndoBT).Disabled = True
|
||||
Control(UndoBT).Disabled = TRUE
|
||||
END IF
|
||||
Control(Label1LB).Hidden = True
|
||||
Control(Label1LB).Hidden = TRUE
|
||||
Caption(Label1LB) = "No Matches Available"
|
||||
Caption(ScoringLB) = SetText$(Score%)
|
||||
Caption(HighScoringLB) = SetText$(HighScore%)
|
||||
|
|
@ -666,11 +708,11 @@ SUB DoMahjong
|
|||
IF MatchesNone%% THEN
|
||||
IF NOT MatchBeeped%% THEN
|
||||
_SNDPLAYFILE "NoMatch.ogg", 3, 0.8
|
||||
MatchBeeped%% = True
|
||||
Control(Label1LB).Hidden = False
|
||||
MatchBeeped%% = TRUE
|
||||
Control(Label1LB).Hidden = FALSE
|
||||
END IF
|
||||
ELSE
|
||||
MatchBeeped%% = False
|
||||
MatchBeeped%% = FALSE
|
||||
END IF
|
||||
IF WorldStop%% THEN
|
||||
EIndex%% = 8
|
||||
|
|
@ -685,14 +727,14 @@ SUB DoMahjong
|
|||
BCount%% = BCount%% + 1
|
||||
IF Blink%% AND BCount%% = 40 THEN
|
||||
BCount%% = 0
|
||||
Blink%% = False
|
||||
Blink%% = FALSE
|
||||
ELSEIF NOT Blink%% AND BCount%% = 10 THEN
|
||||
BCount%% = 0
|
||||
Blink%% = True
|
||||
Blink%% = TRUE
|
||||
END IF
|
||||
IF NOT CanUndo%% THEN UCount%% = UCount%% + 1
|
||||
IF UCount%% = 32 THEN
|
||||
CanUndo%% = True
|
||||
CanUndo%% = TRUE
|
||||
UCount%% = 0
|
||||
END IF
|
||||
'Following is to adjust score for time in game
|
||||
|
|
@ -708,8 +750,8 @@ SUB DoMahjong
|
|||
k1$ = INKEY$
|
||||
IF k1$ <> "" THEN
|
||||
IF ASC(k1$) = 27 THEN
|
||||
MahPlay%% = False
|
||||
Innit%% = True
|
||||
MahPlay%% = FALSE
|
||||
Innit%% = TRUE
|
||||
TilesRem% = 144
|
||||
END IF
|
||||
END IF
|
||||
|
|
@ -754,6 +796,3 @@ SUB DoMahjong
|
|||
CLOSE #1
|
||||
SYSTEM
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -28,6 +28,8 @@ DIM SHARED ma&
|
|||
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'MasterMindGuessTheSequence.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -38,25 +40,25 @@ SUB __UI_OnLoad
|
|||
RANDOMIZE TIMER
|
||||
MaxSequence = 4
|
||||
Caption(SecretSequenceLB) = STR$(MaxSequence) + " Digits"
|
||||
Control(SecretSequenceLB).Disabled = True
|
||||
Control(ListBox1).Disabled = True
|
||||
Control(WriteSequenceToTestTB).Disabled = True
|
||||
Control(TestSequenceBT).Disabled = True
|
||||
Control(SecretSequenceLB).Disabled = TRUE
|
||||
Control(ListBox1).Disabled = TRUE
|
||||
Control(WriteSequenceToTestTB).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"
|
||||
Control(HelpLB).Hidden = True
|
||||
Control(HelpLB).Disabled = True
|
||||
Control(HelpLB).WordWrap = True
|
||||
Control(HelpLB).Hidden = TRUE
|
||||
Control(HelpLB).Disabled = TRUE
|
||||
Control(HelpLB).WordWrap = TRUE
|
||||
Control(TrackBar1).Value = 4
|
||||
Control(TrackBar1).HasBorder = True
|
||||
Control(TrackBar1).HasBorder = TRUE
|
||||
Control(TrackBar1).BorderColor = _RGB32(0, 255, 127)
|
||||
Caption(TrackBar1) = LTRIM$(STR$(MaxSequence))
|
||||
Control(TrackBar1).ForeColor = _RGB32(0, 0, 255)
|
||||
Control(TrackBar1).Disabled = True
|
||||
Control(TrackBar1).Disabled = TRUE
|
||||
Caption(RadioButton1) = "Tutor"
|
||||
Control(RadioButton1).Disabled = True
|
||||
Control(RadioButton1).Disabled = TRUE
|
||||
Caption(TrackBar1LB) = LTRIM$(STR$(MaxSequence))
|
||||
ma& = _SNDOPEN("mozart_-_Turkish_March_in_Bb.mid")
|
||||
Control(MusicCB).Disabled = True
|
||||
Control(MusicCB).Disabled = TRUE
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
|
|
@ -74,13 +76,13 @@ SUB VictorY
|
|||
BEEP
|
||||
Caption(StartBT) = "Start"
|
||||
ResetList ListBox1
|
||||
Control(SecretSequenceLB).Disabled = True
|
||||
Control(ListBox1).Disabled = True
|
||||
Control(WriteSequenceToTestTB).Disabled = True
|
||||
Control(TestSequenceBT).Disabled = True
|
||||
Control(SecretSequenceLB).Disabled = TRUE
|
||||
Control(ListBox1).Disabled = TRUE
|
||||
Control(WriteSequenceToTestTB).Disabled = TRUE
|
||||
Control(TestSequenceBT).Disabled = TRUE
|
||||
Caption(SecretSequenceLB) = ""
|
||||
Text(SecretSequenceLB) = ""
|
||||
Control(RadioButton1).Value = False
|
||||
Control(RadioButton1).Value = FALSE
|
||||
END SUB
|
||||
|
||||
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 INSTR(1, visto, z) = 0 THEN IF b = a THEN ResulT = ResulT + "X" ELSE ResulT = ResulT + "O"
|
||||
ELSE
|
||||
IF Control(RadioButton1).Value = True THEN ResulT = ResulT + "-"
|
||||
IF Control(RadioButton1).Value = TRUE THEN ResulT = ResulT + "-"
|
||||
END IF
|
||||
visto = visto + z
|
||||
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
|
||||
Text(WriteSequenceToTestTB) = ""
|
||||
ResulT = " "
|
||||
|
|
@ -143,49 +145,49 @@ SUB __UI_Click (id AS LONG)
|
|||
Caption(SecretSequenceLB) = LTRIM$(STR$(MaxSequence)) + " Digits"
|
||||
END IF
|
||||
CASE HelpBT
|
||||
Control(HelpLB).Hidden = False
|
||||
Control(HelpLB).Disabled = False
|
||||
Control(HelpLB).Hidden = FALSE
|
||||
Control(HelpLB).Disabled = FALSE
|
||||
|
||||
|
||||
CASE StartBT
|
||||
IF Caption(StartBT) = "Start" THEN
|
||||
Caption(StartBT) = "Reset"
|
||||
Control(SecretSequenceLB).Disabled = False
|
||||
Control(ListBox1).Disabled = False
|
||||
Control(SecretSequenceLB).Disabled = FALSE
|
||||
Control(ListBox1).Disabled = FALSE
|
||||
Text(WriteSequenceToTestTB) = ""
|
||||
Control(WriteSequenceToTestTB).Disabled = False
|
||||
Control(TestSequenceBT).Disabled = False
|
||||
Control(WriteSequenceToTestTB).Disabled = FALSE
|
||||
Control(TestSequenceBT).Disabled = FALSE
|
||||
CreateListToCheck
|
||||
Caption(SecretSequenceLB) = STR$(MaxSequence) + " Digits" 'Text(SecretSequenceLB) ' debug statement
|
||||
|
||||
ELSE
|
||||
Caption(StartBT) = "Start"
|
||||
ResetList ListBox1
|
||||
Control(SecretSequenceLB).Disabled = True
|
||||
Control(SecretSequenceLB).Disabled = TRUE
|
||||
Text(WriteSequenceToTestTB) = ""
|
||||
Control(ListBox1).Disabled = True
|
||||
Control(WriteSequenceToTestTB).Disabled = True
|
||||
Control(TestSequenceBT).Disabled = True
|
||||
Control(ListBox1).Disabled = TRUE
|
||||
Control(WriteSequenceToTestTB).Disabled = TRUE
|
||||
Control(TestSequenceBT).Disabled = TRUE
|
||||
Caption(SecretSequenceLB) = STR$(MaxSequence) + " Digits"
|
||||
Text(SecretSequenceLB) = ""
|
||||
Control(RadioButton1).Value = False
|
||||
Control(RadioButton1).Value = FALSE
|
||||
END IF
|
||||
CASE OptionsBT
|
||||
IF Control(TrackBar1).Disabled = True THEN
|
||||
Control(TrackBar1).Disabled = False
|
||||
Control(RadioButton1).Disabled = False
|
||||
IF ma& = 0 THEN Control(MusicCB).Disabled = True ELSE Control(MusicCB).Disabled = False
|
||||
IF Control(TrackBar1).Disabled = TRUE THEN
|
||||
Control(TrackBar1).Disabled = FALSE
|
||||
Control(RadioButton1).Disabled = FALSE
|
||||
IF ma& = 0 THEN Control(MusicCB).Disabled = TRUE ELSE Control(MusicCB).Disabled = FALSE
|
||||
ELSE
|
||||
Control(TrackBar1).Disabled = True
|
||||
Control(RadioButton1).Disabled = True
|
||||
Control(MusicCB).Disabled = True
|
||||
Control(TrackBar1).Disabled = TRUE
|
||||
Control(RadioButton1).Disabled = TRUE
|
||||
Control(MusicCB).Disabled = TRUE
|
||||
END IF
|
||||
|
||||
CASE QuitBT
|
||||
SYSTEM
|
||||
CASE HelpLB
|
||||
Control(HelpLB).Hidden = True
|
||||
Control(HelpLB).Disabled = True
|
||||
Control(HelpLB).Hidden = TRUE
|
||||
Control(HelpLB).Disabled = TRUE
|
||||
CASE TrackBar1
|
||||
END SELECT
|
||||
__UI_Focus = WriteSequenceToTestTB
|
||||
|
|
@ -427,12 +429,9 @@ SUB __UI_ValueChanged (id AS LONG)
|
|||
ToolTip(TrackBar1) = LTRIM$(STR$(MaxSequence))
|
||||
Caption(TrackBar1LB) = LTRIM$(STR$(MaxSequence))
|
||||
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 SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -32,6 +32,8 @@ REDIM SHARED Motion`(10, 6, 2), Choisi`(10, 6), Grid%%(10, 6)
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Pelmanism.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures & Functions: ---------------------------------------------------------------
|
||||
FUNCTION MakeHardware& (Img&)
|
||||
|
|
@ -73,7 +75,7 @@ SUB __UI_BeforeInit
|
|||
NEXT N%%
|
||||
CLOSE #1
|
||||
END IF
|
||||
DoNewGame` = False
|
||||
DoNewGame` = FALSE
|
||||
|
||||
game_data:
|
||||
DATA 4,4
|
||||
|
|
@ -108,7 +110,7 @@ SUB __UI_BeforeUpdateDisplay
|
|||
_PUTIMAGE (107 * (HorizPos%% - 1) + 7, 107 * (VertPos%% - 1) + 7), Images&(Grid%%(HorizPos%%, VertPos%%)) 'Fronts
|
||||
PCount%% = PCount%% + 1
|
||||
IF PCount%% = 40 THEN
|
||||
Paused` = False
|
||||
Paused` = FALSE
|
||||
PCount%% = 0
|
||||
END IF
|
||||
ELSE
|
||||
|
|
@ -124,16 +126,16 @@ SUB __UI_BeforeUpdateDisplay
|
|||
FlipCount%% = FlipCount%% + 2
|
||||
IF FlipCount%% = 100 THEN
|
||||
FlipCount%% = 0
|
||||
Motion`(HorizPos%%, VertPos%%, 2) = False
|
||||
Motion`(HorizPos%%, VertPos%%, 0) = False
|
||||
Motion`(HorizPos%%, VertPos%%, 2) = FALSE
|
||||
Motion`(HorizPos%%, VertPos%%, 0) = FALSE
|
||||
IF HorizPos%% = FirstH%% AND VertPos%% = FirstV%% THEN
|
||||
FrameRate% = 40
|
||||
SetFrameRate FrameRate%
|
||||
Flipping` = False
|
||||
TurningBack` = False
|
||||
Flipping` = FALSE
|
||||
TurningBack` = FALSE
|
||||
FirstV%% = 50
|
||||
ELSE
|
||||
Motion`(FirstH%%, FirstV%%, 2) = True
|
||||
Motion`(FirstH%%, FirstV%%, 2) = TRUE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
|
|
@ -151,22 +153,22 @@ SUB __UI_BeforeUpdateDisplay
|
|||
FlipCount%% = FlipCount%% + 2
|
||||
IF FlipCount%% = 100 THEN
|
||||
FlipCount%% = 0
|
||||
Flipping` = False
|
||||
Motion`(HorizPos%%, VertPos%%, 1) = False
|
||||
Motion`(HorizPos%%, VertPos%%, 0) = True
|
||||
Flipping` = FALSE
|
||||
Motion`(HorizPos%%, VertPos%%, 1) = FALSE
|
||||
Motion`(HorizPos%%, VertPos%%, 0) = TRUE
|
||||
IF FirstGo` THEN
|
||||
FirstGo` = False
|
||||
FirstGo` = FALSE
|
||||
ELSE
|
||||
FirstGo` = True
|
||||
FirstGo` = TRUE
|
||||
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`(FirstH%%, FirstV%%) = True
|
||||
Choisi`(HorizPos%%, VertPos%%) = TRUE 'Registers that that grid position cannot be clicked any more
|
||||
Choisi`(FirstH%%, FirstV%%) = TRUE
|
||||
NoRemaining%% = NoRemaining%% - 2
|
||||
IF NoRemaining%% = 0 THEN
|
||||
'Tah-dah sound (completed)
|
||||
IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("fanfare.mp3")
|
||||
Control(PairingsCompletedLB).Disabled = False
|
||||
Control(PairingsCompletedLB).Hidden = False
|
||||
Control(PairingsCompletedLB).Disabled = FALSE
|
||||
Control(PairingsCompletedLB).Hidden = FALSE
|
||||
ELSE
|
||||
'Ching sound (match)
|
||||
IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("match3.mp3")
|
||||
|
|
@ -175,10 +177,10 @@ SUB __UI_BeforeUpdateDisplay
|
|||
'Initiate sequential turn back
|
||||
FrameRate% = 60
|
||||
SetFrameRate FrameRate%
|
||||
Motion`(HorizPos%%, VertPos%%, 2) = True
|
||||
Flipping` = True
|
||||
TurningBack` = True
|
||||
Paused` = True
|
||||
Motion`(HorizPos%%, VertPos%%, 2) = TRUE
|
||||
Flipping` = TRUE
|
||||
TurningBack` = TRUE
|
||||
Paused` = TRUE
|
||||
PCount%% = 0
|
||||
IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("nomatch1.mp3"), , 0.2
|
||||
END IF
|
||||
|
|
@ -235,8 +237,8 @@ SUB __UI_Click (id AS LONG)
|
|||
IF Choisi`(HorizPos%%, VertPos%%) OR (FirstH%% = HorizPos%% AND FirstV%% = VertPos%%) THEN
|
||||
'Do nothing
|
||||
ELSE
|
||||
Motion`(HorizPos%%, VertPos%%, 1) = True 'Set this cell turning
|
||||
Flipping` = True
|
||||
Motion`(HorizPos%%, VertPos%%, 1) = TRUE 'Set this cell turning
|
||||
Flipping` = TRUE
|
||||
IF FirstGo` THEN
|
||||
FirstH%% = HorizPos%%
|
||||
FirstV%% = VertPos%%
|
||||
|
|
@ -245,13 +247,13 @@ SUB __UI_Click (id AS LONG)
|
|||
END IF
|
||||
CASE ExitBT
|
||||
IF InPlay` THEN
|
||||
InPlay` = False
|
||||
InPlay` = FALSE
|
||||
ELSE
|
||||
CALL Finale
|
||||
END IF
|
||||
CASE NewGameBT
|
||||
DoNewGame` = True
|
||||
InPlay` = False
|
||||
DoNewGame` = TRUE
|
||||
InPlay` = FALSE
|
||||
CASE OneBT
|
||||
Level%% = 0
|
||||
CALL MakePairs
|
||||
|
|
@ -299,32 +301,32 @@ SUB __UI_FormResized
|
|||
END SUB
|
||||
|
||||
SUB NouveauJeu
|
||||
DoNewGame` = False
|
||||
DoNewGame` = FALSE
|
||||
_DELAY 0.1
|
||||
FrameRate% = 40
|
||||
SetFrameRate FrameRate%
|
||||
Control(__UI_FormID).Width = 310
|
||||
Control(__UI_FormID).Height = 360
|
||||
Control(PelmanismLB).Disabled = False
|
||||
Control(PelmanismLB).Hidden = False
|
||||
Control(SetSkillLevelLB).Disabled = False
|
||||
Control(SetSkillLevelLB).Hidden = False
|
||||
Control(OneBT).Disabled = False
|
||||
Control(OneBT).Hidden = False
|
||||
Control(TwoBT).Disabled = False
|
||||
Control(TwoBT).Hidden = False
|
||||
Control(ThreeBT).Disabled = False
|
||||
Control(ThreeBT).Hidden = False
|
||||
Control(NewGameBT).Disabled = True
|
||||
Control(NewGameBT).Hidden = True
|
||||
Control(AudioFM).Disabled = True
|
||||
Control(AudioFM).Hidden = True
|
||||
Control(BestScoreLB).Disabled = True
|
||||
Control(BestScoreLB).Hidden = True
|
||||
Control(ScoreLB).Disabled = True
|
||||
Control(ScoreLB).Hidden = True
|
||||
Control(PairingsCompletedLB).Disabled = True
|
||||
Control(PairingsCompletedLB).Hidden = True
|
||||
Control(PelmanismLB).Disabled = FALSE
|
||||
Control(PelmanismLB).Hidden = FALSE
|
||||
Control(SetSkillLevelLB).Disabled = FALSE
|
||||
Control(SetSkillLevelLB).Hidden = FALSE
|
||||
Control(OneBT).Disabled = FALSE
|
||||
Control(OneBT).Hidden = FALSE
|
||||
Control(TwoBT).Disabled = FALSE
|
||||
Control(TwoBT).Hidden = FALSE
|
||||
Control(ThreeBT).Disabled = FALSE
|
||||
Control(ThreeBT).Hidden = FALSE
|
||||
Control(NewGameBT).Disabled = TRUE
|
||||
Control(NewGameBT).Hidden = TRUE
|
||||
Control(AudioFM).Disabled = TRUE
|
||||
Control(AudioFM).Hidden = TRUE
|
||||
Control(BestScoreLB).Disabled = TRUE
|
||||
Control(BestScoreLB).Hidden = TRUE
|
||||
Control(ScoreLB).Disabled = TRUE
|
||||
Control(ScoreLB).Hidden = TRUE
|
||||
Control(PairingsCompletedLB).Disabled = TRUE
|
||||
Control(PairingsCompletedLB).Hidden = TRUE
|
||||
Control(ExitBT).Left = Control(__UI_FormID).Width - 96
|
||||
Control(ExitBT).Top = Control(__UI_FormID).Height - 39
|
||||
SetFocus ExitBT
|
||||
|
|
@ -351,46 +353,46 @@ SUB Finale
|
|||
END SUB
|
||||
|
||||
SUB MakePairs
|
||||
InPlay` = True
|
||||
InPlay` = TRUE
|
||||
Score% = 0
|
||||
NoRemaining%% = GameLevel%%(Level%%, 0) * GameLevel%%(Level%%, 1)
|
||||
NoPairs%% = 0
|
||||
FirstV%% = 50
|
||||
ValidMouse` = False
|
||||
Flipping` = False
|
||||
TurningBack` = False
|
||||
ValidMouse` = FALSE
|
||||
Flipping` = FALSE
|
||||
TurningBack` = FALSE
|
||||
FlipCount%% = 0
|
||||
Paused` = False
|
||||
Paused` = FALSE
|
||||
PCount%% = 0
|
||||
FirstGo` = True
|
||||
FirstGo` = TRUE
|
||||
REDIM Motion`(10, 6, 2), Choisi`(10, 6), Grid%%(10, 6)
|
||||
REDIM Selected%%(30)
|
||||
RANDOMIZE (TIMER)
|
||||
WHILE NoRemaining%% > 0
|
||||
Vacant` = False
|
||||
Vacant` = FALSE
|
||||
WHILE NOT Vacant`
|
||||
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
|
||||
NewPair` = False
|
||||
NewPair` = FALSE
|
||||
WHILE NOT NewPair`
|
||||
PairNo%% = 1 + INT(NoObjectsLess1%% * RND)
|
||||
PairsExists` = False
|
||||
PairsExists` = FALSE
|
||||
N%% = 1
|
||||
WHILE NOT PairsExists` AND N%% <= NoPairs%%
|
||||
IF PairNo%% = Selected%%(N%%) THEN PairsExists` = True
|
||||
IF PairNo%% = Selected%%(N%%) THEN PairsExists` = TRUE
|
||||
N%% = N%% + 1
|
||||
WEND
|
||||
IF NOT PairsExists` THEN NewPair` = True
|
||||
IF NOT PairsExists` THEN NewPair` = TRUE
|
||||
WEND
|
||||
NoPairs%% = NoPairs%% + 1
|
||||
Selected%%(NoPairs%%) = PairNo%%
|
||||
Grid%%(HorizPos%%, VertPos%%) = PairNo%%
|
||||
Vacant` = False
|
||||
Vacant` = FALSE
|
||||
WHILE NOT Vacant`
|
||||
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
|
||||
Selected%%(NoPairs%%) = PairNo%%
|
||||
Grid%%(HorizPos%%, VertPos%%) = PairNo%%
|
||||
|
|
@ -408,24 +410,24 @@ SUB MakePairs
|
|||
Control(BestScoreLB).Left = Control(__UI_FormID).Width - 178
|
||||
Control(ScoreLB).Left = Control(__UI_FormID).Width - 178
|
||||
Control(PairingsCompletedLB).Left = Control(__UI_FormID).Width - 138
|
||||
Control(PelmanismLB).Disabled = True
|
||||
Control(PelmanismLB).Hidden = True
|
||||
Control(SetSkillLevelLB).Disabled = True
|
||||
Control(SetSkillLevelLB).Hidden = True
|
||||
Control(OneBT).Disabled = True
|
||||
Control(OneBT).Hidden = True
|
||||
Control(TwoBT).Disabled = True
|
||||
Control(TwoBT).Hidden = True
|
||||
Control(ThreeBT).Disabled = True
|
||||
Control(ThreeBT).Hidden = True
|
||||
Control(NewGameBT).Disabled = False
|
||||
Control(NewGameBT).Hidden = False
|
||||
Control(AudioFM).Disabled = False
|
||||
Control(AudioFM).Hidden = False
|
||||
Control(BestScoreLB).Disabled = False
|
||||
Control(BestScoreLB).Hidden = False
|
||||
Control(ScoreLB).Disabled = False
|
||||
Control(ScoreLB).Hidden = False
|
||||
Control(PelmanismLB).Disabled = TRUE
|
||||
Control(PelmanismLB).Hidden = TRUE
|
||||
Control(SetSkillLevelLB).Disabled = TRUE
|
||||
Control(SetSkillLevelLB).Hidden = TRUE
|
||||
Control(OneBT).Disabled = TRUE
|
||||
Control(OneBT).Hidden = TRUE
|
||||
Control(TwoBT).Disabled = TRUE
|
||||
Control(TwoBT).Hidden = TRUE
|
||||
Control(ThreeBT).Disabled = TRUE
|
||||
Control(ThreeBT).Hidden = TRUE
|
||||
Control(NewGameBT).Disabled = FALSE
|
||||
Control(NewGameBT).Hidden = FALSE
|
||||
Control(AudioFM).Disabled = FALSE
|
||||
Control(AudioFM).Hidden = FALSE
|
||||
Control(BestScoreLB).Disabled = FALSE
|
||||
Control(BestScoreLB).Hidden = FALSE
|
||||
Control(ScoreLB).Disabled = FALSE
|
||||
Control(ScoreLB).Hidden = FALSE
|
||||
IF BestScore%(Level%%) <> 0 THEN
|
||||
Caption(BestScoreLB) = "Best Score:" + STR$(BestScore%(Level%%))
|
||||
ELSE
|
||||
|
|
@ -456,15 +458,15 @@ SUB MakePairs
|
|||
WHILE InPlay`
|
||||
_LIMIT 2 * FrameRate%
|
||||
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 NOT Flipping` THEN ValidMouse` = True
|
||||
IF NOT Flipping` THEN ValidMouse` = TRUE
|
||||
XX%% = (XMouse% - 7) \ 107
|
||||
YY%% = (YMouse% - 7) \ 107
|
||||
END IF
|
||||
K$ = INKEY$
|
||||
IF K$ <> "" THEN
|
||||
IF ASC(K$) = 27 THEN InPlay` = False
|
||||
IF ASC(K$) = 27 THEN InPlay` = FALSE
|
||||
END IF
|
||||
K$ = ""
|
||||
__UI_DoEvents
|
||||
|
|
@ -476,6 +478,3 @@ SUB MakePairs
|
|||
CALL Finale
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -22,6 +22,8 @@ DIM SHARED Horiz%%, Vert%%, InPlay`, Level%%, MoveIt%%, ValidSquare`
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'PictureGrid.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures & Functions: ---------------------------------------------------------------
|
||||
FUNCTION MakeHardware& (Img&)
|
||||
|
|
@ -43,7 +45,7 @@ SUB __UI_BeforeInit
|
|||
READ Portraits$(N%%)
|
||||
NEXT N%%
|
||||
FrameRate% = 30
|
||||
InPlay` = False
|
||||
InPlay` = FALSE
|
||||
|
||||
game_data:
|
||||
DATA 2,3
|
||||
|
|
@ -53,8 +55,8 @@ SUB __UI_BeforeInit
|
|||
END SUB
|
||||
|
||||
SUB __UI_OnLoad
|
||||
Control(NewGameBT).Disabled = True
|
||||
Control(NewGameBT).Hidden = True
|
||||
Control(NewGameBT).Disabled = TRUE
|
||||
Control(NewGameBT).Hidden = TRUE
|
||||
CALL JeuNouveau
|
||||
SetFrameRate FrameRate%
|
||||
END SUB
|
||||
|
|
@ -130,7 +132,7 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE ExitBT
|
||||
SYSTEM
|
||||
CASE NewGameBT
|
||||
InPlay` = False
|
||||
InPlay` = FALSE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
|
|
@ -171,18 +173,18 @@ END SUB
|
|||
SUB JeuNouveau
|
||||
Control(__UI_FormID).Width = 310
|
||||
Control(__UI_FormID).Height = 360
|
||||
Control(PictureGridLB).Disabled = False
|
||||
Control(PictureGridLB).Hidden = False
|
||||
Control(SetSkillLevelLB).Disabled = False
|
||||
Control(SetSkillLevelLB).Hidden = False
|
||||
Control(OneBT).Disabled = False
|
||||
Control(OneBT).Hidden = False
|
||||
Control(TwoBT).Disabled = False
|
||||
Control(TwoBT).Hidden = False
|
||||
Control(ThreeBT).Disabled = False
|
||||
Control(ThreeBT).Hidden = False
|
||||
Control(NewGameBT).Disabled = True
|
||||
Control(NewGameBT).Hidden = True
|
||||
Control(PictureGridLB).Disabled = FALSE
|
||||
Control(PictureGridLB).Hidden = FALSE
|
||||
Control(SetSkillLevelLB).Disabled = FALSE
|
||||
Control(SetSkillLevelLB).Hidden = FALSE
|
||||
Control(OneBT).Disabled = FALSE
|
||||
Control(OneBT).Hidden = FALSE
|
||||
Control(TwoBT).Disabled = FALSE
|
||||
Control(TwoBT).Hidden = FALSE
|
||||
Control(ThreeBT).Disabled = FALSE
|
||||
Control(ThreeBT).Hidden = FALSE
|
||||
Control(NewGameBT).Disabled = TRUE
|
||||
Control(NewGameBT).Hidden = TRUE
|
||||
Control(ExitBT).Top = Control(__UI_FormID).Height - 39
|
||||
Control(ExitBT).Left = Control(__UI_FormID).Width - 96
|
||||
SetFocus ExitBT
|
||||
|
|
@ -191,16 +193,16 @@ END SUB
|
|||
SUB Slider
|
||||
Control(__UI_FormID).Width = (2 * ScreenWidth%) + 10
|
||||
Control(__UI_FormID).Height = ScreenHeight%
|
||||
Control(PictureGridLB).Disabled = True
|
||||
Control(PictureGridLB).Hidden = True
|
||||
Control(SetSkillLevelLB).Disabled = True
|
||||
Control(SetSkillLevelLB).Hidden = True
|
||||
Control(OneBT).Disabled = True
|
||||
Control(OneBT).Hidden = True
|
||||
Control(TwoBT).Disabled = True
|
||||
Control(TwoBT).Hidden = True
|
||||
Control(ThreeBT).Disabled = True
|
||||
Control(ThreeBT).Hidden = True
|
||||
Control(PictureGridLB).Disabled = TRUE
|
||||
Control(PictureGridLB).Hidden = TRUE
|
||||
Control(SetSkillLevelLB).Disabled = TRUE
|
||||
Control(SetSkillLevelLB).Hidden = TRUE
|
||||
Control(OneBT).Disabled = TRUE
|
||||
Control(OneBT).Hidden = TRUE
|
||||
Control(TwoBT).Disabled = TRUE
|
||||
Control(TwoBT).Hidden = TRUE
|
||||
Control(ThreeBT).Disabled = TRUE
|
||||
Control(ThreeBT).Hidden = TRUE
|
||||
Control(ExitBT).Top = Control(__UI_FormID).Height - 39
|
||||
Control(ExitBT).Left = Control(__UI_FormID).Width - 96
|
||||
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 (1, 1)-(ScreenWidth% / RowCol%%(Level%%, 0) - 5, ScreenHeight%% / RowCol%%(Level%%, 1) - 5), , B
|
||||
Highlight& = MakeHardware&(TempImg&)
|
||||
ValidSquare` = False
|
||||
InPlay` = True
|
||||
IsComplete` = False
|
||||
ValidSquare` = FALSE
|
||||
InPlay` = TRUE
|
||||
IsComplete` = FALSE
|
||||
WHILE InPlay`
|
||||
_LIMIT 2 * FrameRate%
|
||||
XMouse% = __UI_MouseLeft
|
||||
YMouse% = __UI_MouseTop
|
||||
ValidSquare` = False
|
||||
ValidSquare` = FALSE
|
||||
IF NOT IsComplete` THEN
|
||||
Horiz%% = 1 + ((XMouse% - 3) \ (ScreenWidth% / RowCol%%(Level%%, 0)))
|
||||
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 Grid%%(Horiz%% + 1, Vert%%) = 0 AND Horiz%% + 1 <= RowCol%%(Level%%, 0) THEN
|
||||
MoveIt%% = 1
|
||||
ValidSquare` = True
|
||||
ValidSquare` = TRUE
|
||||
ELSEIF Grid%%(Horiz%%, Vert%% + 1) = 0 AND Vert%% + 1 <= RowCol%%(Level%%, 1) THEN
|
||||
MoveIt%% = 2
|
||||
ValidSquare` = True
|
||||
ValidSquare` = TRUE
|
||||
ELSEIF Grid%%(Horiz%% - 1, Vert%%) = 0 AND Horiz%% - 1 > 0 THEN
|
||||
MoveIt%% = 3
|
||||
ValidSquare` = True
|
||||
ValidSquare` = TRUE
|
||||
ELSEIF Grid%%(Horiz%%, Vert%% - 1) = 0 AND Vert%% - 1 > 0 THEN
|
||||
MoveIt%% = 4
|
||||
ValidSquare` = True
|
||||
ValidSquare` = TRUE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
AllCorrect` = True
|
||||
AllCorrect` = TRUE
|
||||
N%% = 1: M%% = 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
|
||||
AllCorrect` = False
|
||||
AllCorrect` = FALSE
|
||||
ELSE
|
||||
M%% = M%% + 1
|
||||
IF M%% > RowCol%%(Level%%, 1) THEN
|
||||
|
|
@ -298,9 +300,9 @@ SUB Slider
|
|||
WEND
|
||||
IF AllCorrect` THEN
|
||||
_SNDPLAYFILE ("fanfare.mp3")
|
||||
Control(NewGameBT).Disabled = False
|
||||
Control(NewGameBT).Hidden = False
|
||||
IsComplete` = True
|
||||
Control(NewGameBT).Disabled = FALSE
|
||||
Control(NewGameBT).Hidden = FALSE
|
||||
IsComplete` = TRUE
|
||||
SetFocus NewGameBT
|
||||
END IF
|
||||
END IF
|
||||
|
|
@ -311,10 +313,7 @@ SUB Slider
|
|||
K$ = ""
|
||||
__UI_DoEvents
|
||||
WEND
|
||||
ValidSquare` = False
|
||||
ValidSquare` = FALSE
|
||||
_FREEIMAGE Highlight&
|
||||
CALL JeuNouveau
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -49,6 +49,8 @@ DIM SHARED PlayBT AS LONG
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'PlayFX.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Custom procedures: --------------------------------------------------------------
|
||||
FUNCTION IsDifferentWaveform%% (w1 AS WaveformType, w2 AS WaveformType)
|
||||
|
|
@ -69,7 +71,7 @@ SUB SetConfigControls (id AS LONG, curCtrl AS LONG)
|
|||
END SUB
|
||||
|
||||
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).note = 42 ' half-way through the scale
|
||||
Waveform(id).length = 4 ' quarter
|
||||
|
|
@ -594,7 +596,7 @@ SUB __UI_ValueChanged (id AS LONG)
|
|||
|
||||
IF IsDifferentWaveform(temp, Waveform(currentWaveform)) THEN
|
||||
Waveform(currentWaveform) = temp
|
||||
Waveform(currentWaveform).active = True
|
||||
Waveform(currentWaveform).active = TRUE
|
||||
END IF
|
||||
|
||||
MakePlayString
|
||||
|
|
@ -604,6 +606,3 @@ END SUB
|
|||
SUB __UI_FormResized
|
||||
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -28,6 +28,9 @@ DIM SHARED assetslizardpngPX AS LONG
|
|||
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'RockHandScissor.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -39,10 +42,10 @@ SUB __UI_OnLoad
|
|||
Caption(LB) = "0000"
|
||||
PlayerChoose = 0
|
||||
RANDOMIZE TIMER
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = True ' hide help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = True
|
||||
Control(Frame2).Hidden = True ' hide frame2
|
||||
Control(Frame2).Disabled = True
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = TRUE ' hide help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = TRUE
|
||||
Control(Frame2).Hidden = TRUE ' hide frame2
|
||||
Control(Frame2).Disabled = TRUE
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUpdateDisplay
|
||||
|
|
@ -75,62 +78,62 @@ SUB __UI_Click (id AS LONG)
|
|||
|
||||
CASE assetscartajpegPX
|
||||
' user chooses to play paper
|
||||
Control(assetssassojpegPX).Disabled = True ' hide images of rock and scissor
|
||||
Control(assetsforbicepngPX).Disabled = True
|
||||
Control(assetsspokpngPX).Disabled = True
|
||||
Control(assetslizardpngPX).Disabled = True
|
||||
Control(assetssassojpegPX).Hidden = True
|
||||
Control(assetsforbicepngPX).Hidden = True
|
||||
Control(assetsspokpngPX).Hidden = True
|
||||
Control(assetslizardpngPX).Hidden = True
|
||||
Control(assetsRPSLS_helpjpgPX).Disabled = True ' hide AI's choice
|
||||
Control(assetsRPSLS_helpjpgPX).Hidden = True
|
||||
Control(assetssassojpegPX).Disabled = TRUE ' hide images of rock and scissor
|
||||
Control(assetsforbicepngPX).Disabled = TRUE
|
||||
Control(assetsspokpngPX).Disabled = TRUE
|
||||
Control(assetslizardpngPX).Disabled = TRUE
|
||||
Control(assetssassojpegPX).Hidden = TRUE
|
||||
Control(assetsforbicepngPX).Hidden = TRUE
|
||||
Control(assetsspokpngPX).Hidden = TRUE
|
||||
Control(assetslizardpngPX).Hidden = TRUE
|
||||
Control(assetsRPSLS_helpjpgPX).Disabled = TRUE ' hide AI's choice
|
||||
Control(assetsRPSLS_helpjpgPX).Hidden = TRUE
|
||||
playAI paper
|
||||
CASE assetssassojpegPX
|
||||
' user chooses to play rock
|
||||
Control(assetscartajpegPX).Disabled = True ' hide paper and scissor
|
||||
Control(assetsforbicepngPX).Disabled = True
|
||||
Control(assetsspokpngPX).Disabled = True
|
||||
Control(assetslizardpngPX).Disabled = True
|
||||
Control(assetsspokpngPX).Hidden = True
|
||||
Control(assetslizardpngPX).Hidden = True
|
||||
Control(assetscartajpegPX).Hidden = True
|
||||
Control(assetsforbicepngPX).Hidden = True
|
||||
Control(assetsRPSLS_helpjpgPX).Disabled = True ' hide AI's choice
|
||||
Control(assetsRPSLS_helpjpgPX).Hidden = True
|
||||
Control(assetscartajpegPX).Disabled = TRUE ' hide paper and scissor
|
||||
Control(assetsforbicepngPX).Disabled = TRUE
|
||||
Control(assetsspokpngPX).Disabled = TRUE
|
||||
Control(assetslizardpngPX).Disabled = TRUE
|
||||
Control(assetsspokpngPX).Hidden = TRUE
|
||||
Control(assetslizardpngPX).Hidden = TRUE
|
||||
Control(assetscartajpegPX).Hidden = TRUE
|
||||
Control(assetsforbicepngPX).Hidden = TRUE
|
||||
Control(assetsRPSLS_helpjpgPX).Disabled = TRUE ' hide AI's choice
|
||||
Control(assetsRPSLS_helpjpgPX).Hidden = TRUE
|
||||
playAI rock
|
||||
CASE assetsforbicepngPX
|
||||
'user chooses to play scissor
|
||||
Control(assetssassojpegPX).Disabled = True ' hide rock and paper
|
||||
Control(assetscartajpegPX).Disabled = True
|
||||
Control(assetsspokpngPX).Disabled = True
|
||||
Control(assetslizardpngPX).Disabled = True
|
||||
Control(assetsspokpngPX).Hidden = True
|
||||
Control(assetslizardpngPX).Hidden = True
|
||||
Control(assetssassojpegPX).Hidden = True
|
||||
Control(assetscartajpegPX).Hidden = True
|
||||
Control(assetsRPSLS_helpjpgPX).Disabled = True ' hide AI's choice
|
||||
Control(assetsRPSLS_helpjpgPX).Hidden = True
|
||||
Control(assetssassojpegPX).Disabled = TRUE ' hide rock and paper
|
||||
Control(assetscartajpegPX).Disabled = TRUE
|
||||
Control(assetsspokpngPX).Disabled = TRUE
|
||||
Control(assetslizardpngPX).Disabled = TRUE
|
||||
Control(assetsspokpngPX).Hidden = TRUE
|
||||
Control(assetslizardpngPX).Hidden = TRUE
|
||||
Control(assetssassojpegPX).Hidden = TRUE
|
||||
Control(assetscartajpegPX).Hidden = TRUE
|
||||
Control(assetsRPSLS_helpjpgPX).Disabled = TRUE ' hide AI's choice
|
||||
Control(assetsRPSLS_helpjpgPX).Hidden = TRUE
|
||||
playAI scissor
|
||||
CASE assetsspokpngPX
|
||||
Control(assetssassojpegPX).Disabled = True ' hide rock and paper
|
||||
Control(assetscartajpegPX).Disabled = True
|
||||
Control(assetsforbicepngPX).Disabled = True
|
||||
Control(assetslizardpngPX).Disabled = True
|
||||
Control(assetsforbicepngPX).Hidden = True
|
||||
Control(assetslizardpngPX).Hidden = True
|
||||
Control(assetssassojpegPX).Hidden = True
|
||||
Control(assetscartajpegPX).Hidden = True
|
||||
Control(assetssassojpegPX).Disabled = TRUE ' hide rock and paper
|
||||
Control(assetscartajpegPX).Disabled = TRUE
|
||||
Control(assetsforbicepngPX).Disabled = TRUE
|
||||
Control(assetslizardpngPX).Disabled = TRUE
|
||||
Control(assetsforbicepngPX).Hidden = TRUE
|
||||
Control(assetslizardpngPX).Hidden = TRUE
|
||||
Control(assetssassojpegPX).Hidden = TRUE
|
||||
Control(assetscartajpegPX).Hidden = TRUE
|
||||
playAI spok
|
||||
CASE assetslizardpngPX
|
||||
Control(assetssassojpegPX).Disabled = True ' hide rock and paper
|
||||
Control(assetscartajpegPX).Disabled = True
|
||||
Control(assetsspokpngPX).Disabled = True
|
||||
Control(assetsforbicepngPX).Disabled = True
|
||||
Control(assetsspokpngPX).Hidden = True
|
||||
Control(assetsforbicepngPX).Hidden = True
|
||||
Control(assetssassojpegPX).Hidden = True
|
||||
Control(assetscartajpegPX).Hidden = True
|
||||
Control(assetssassojpegPX).Disabled = TRUE ' hide rock and paper
|
||||
Control(assetscartajpegPX).Disabled = TRUE
|
||||
Control(assetsspokpngPX).Disabled = TRUE
|
||||
Control(assetsforbicepngPX).Disabled = TRUE
|
||||
Control(assetsspokpngPX).Hidden = TRUE
|
||||
Control(assetsforbicepngPX).Hidden = TRUE
|
||||
Control(assetssassojpegPX).Hidden = TRUE
|
||||
Control(assetscartajpegPX).Hidden = TRUE
|
||||
playAI lizard
|
||||
CASE RockHandScissor
|
||||
|
||||
|
|
@ -139,68 +142,68 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE Frame1
|
||||
|
||||
CASE StartBT
|
||||
Control(HelpBT).Disabled = True
|
||||
Control(Frame2).Hidden = False ' show frame2
|
||||
Control(Frame2).Disabled = False
|
||||
Control(assetssassojpegPX).Disabled = False ' show and activate 3 image buttons for user
|
||||
Control(assetsforbicepngPX).Disabled = False
|
||||
Control(assetscartajpegPX).Disabled = False
|
||||
Control(assetsspokpngPX).Disabled = False
|
||||
Control(assetslizardpngPX).Disabled = False
|
||||
Control(assetssassojpegPX).Hidden = False
|
||||
Control(assetsforbicepngPX).Hidden = False
|
||||
Control(assetscartajpegPX).Hidden = False
|
||||
Control(assetsspokpngPX).Hidden = False
|
||||
Control(assetslizardpngPX).Hidden = False
|
||||
Control(HelpBT).Disabled = TRUE
|
||||
Control(Frame2).Hidden = FALSE ' show frame2
|
||||
Control(Frame2).Disabled = FALSE
|
||||
Control(assetssassojpegPX).Disabled = FALSE ' show and activate 3 image buttons for user
|
||||
Control(assetsforbicepngPX).Disabled = FALSE
|
||||
Control(assetscartajpegPX).Disabled = FALSE
|
||||
Control(assetsspokpngPX).Disabled = FALSE
|
||||
Control(assetslizardpngPX).Disabled = FALSE
|
||||
Control(assetssassojpegPX).Hidden = FALSE
|
||||
Control(assetsforbicepngPX).Hidden = FALSE
|
||||
Control(assetscartajpegPX).Hidden = FALSE
|
||||
Control(assetsspokpngPX).Hidden = FALSE
|
||||
Control(assetslizardpngPX).Hidden = FALSE
|
||||
|
||||
Control(assetsRPSLS_helpjpgPX).Hidden = True ' hide help/AI image
|
||||
Control(assetsRPSLS_helpjpgPX).Disabled = True
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = True ' hide help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = True
|
||||
Control(assetsRPSLS_helpjpgPX).Hidden = TRUE ' hide help/AI image
|
||||
Control(assetsRPSLS_helpjpgPX).Disabled = TRUE
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = TRUE ' hide help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = TRUE
|
||||
|
||||
CASE ExitBT
|
||||
SYSTEM ' exit from program
|
||||
CASE HelpBT
|
||||
|
||||
IF Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = False THEN
|
||||
IF Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = FALSE THEN
|
||||
' here we reactivate the game
|
||||
Control(StartBT).Disabled = False
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = True ' hide help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = True
|
||||
Control(StartBT).Disabled = FALSE
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = TRUE ' hide help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = TRUE
|
||||
Caption(ChooseYourMoveAndWaitAIsOneLB) = "Choose your move and wait AI's one"
|
||||
Control(Frame2).Hidden = True ' hide frame2
|
||||
Control(Frame2).Disabled = True
|
||||
Control(assetssassojpegPX).Disabled = False ' activate 5 image button for user
|
||||
Control(assetsforbicepngPX).Disabled = False
|
||||
Control(assetscartajpegPX).Disabled = False
|
||||
Control(assetsspokpngPX).Disabled = False
|
||||
Control(assetslizardpngPX).Disabled = False
|
||||
Control(assetssassojpegPX).Hidden = False
|
||||
Control(assetsforbicepngPX).Hidden = False
|
||||
Control(assetscartajpegPX).Hidden = False
|
||||
Control(assetsspokpngPX).Hidden = False
|
||||
Control(assetslizardpngPX).Hidden = False
|
||||
Control(Frame2).Hidden = TRUE ' hide frame2
|
||||
Control(Frame2).Disabled = TRUE
|
||||
Control(assetssassojpegPX).Disabled = FALSE ' activate 5 image button for user
|
||||
Control(assetsforbicepngPX).Disabled = FALSE
|
||||
Control(assetscartajpegPX).Disabled = FALSE
|
||||
Control(assetsspokpngPX).Disabled = FALSE
|
||||
Control(assetslizardpngPX).Disabled = FALSE
|
||||
Control(assetssassojpegPX).Hidden = FALSE
|
||||
Control(assetsforbicepngPX).Hidden = FALSE
|
||||
Control(assetscartajpegPX).Hidden = FALSE
|
||||
Control(assetsspokpngPX).Hidden = FALSE
|
||||
Control(assetslizardpngPX).Hidden = FALSE
|
||||
|
||||
ELSE
|
||||
' 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"
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = False ' show help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = False
|
||||
Control(assetssassojpegPX).Disabled = True ' hide 5 image button for user
|
||||
Control(assetsforbicepngPX).Disabled = True
|
||||
Control(assetscartajpegPX).Disabled = True
|
||||
Control(assetsspokpngPX).Disabled = True
|
||||
Control(assetslizardpngPX).Disabled = True
|
||||
Control(assetssassojpegPX).Hidden = True
|
||||
Control(assetsforbicepngPX).Hidden = True
|
||||
Control(assetscartajpegPX).Hidden = True
|
||||
Control(assetsspokpngPX).Hidden = True
|
||||
Control(assetslizardpngPX).Hidden = True
|
||||
Control(Frame2).Hidden = False 'show frame2
|
||||
Control(Frame2).Disabled = False
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = FALSE ' show help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = FALSE
|
||||
Control(assetssassojpegPX).Disabled = TRUE ' hide 5 image button for user
|
||||
Control(assetsforbicepngPX).Disabled = TRUE
|
||||
Control(assetscartajpegPX).Disabled = TRUE
|
||||
Control(assetsspokpngPX).Disabled = TRUE
|
||||
Control(assetslizardpngPX).Disabled = TRUE
|
||||
Control(assetssassojpegPX).Hidden = TRUE
|
||||
Control(assetsforbicepngPX).Hidden = TRUE
|
||||
Control(assetscartajpegPX).Hidden = TRUE
|
||||
Control(assetsspokpngPX).Hidden = TRUE
|
||||
Control(assetslizardpngPX).Hidden = TRUE
|
||||
Control(Frame2).Hidden = FALSE 'show frame2
|
||||
Control(Frame2).Disabled = FALSE
|
||||
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
|
||||
CASE LB
|
||||
|
||||
|
|
@ -212,27 +215,27 @@ SUB __UI_Click (id AS LONG)
|
|||
END SUB
|
||||
|
||||
SUB restoreGame
|
||||
Control(assetssassojpegPX).Disabled = False 'activate 5 image buttons for user
|
||||
Control(assetsforbicepngPX).Disabled = False
|
||||
Control(assetscartajpegPX).Disabled = False
|
||||
Control(assetsspokpngPX).Disabled = False
|
||||
Control(assetslizardpngPX).Disabled = False
|
||||
Control(assetsspokpngPX).Hidden = False
|
||||
Control(assetslizardpngPX).Hidden = False
|
||||
Control(assetssassojpegPX).Hidden = False
|
||||
Control(assetsforbicepngPX).Hidden = False
|
||||
Control(assetscartajpegPX).Hidden = False
|
||||
Control(HelpBT).Disabled = False ' activate help button
|
||||
Control(assetsRPSLS_helpjpgPX).Redraw = True ' force to show AI's choice
|
||||
Control(assetssassojpegPX).Disabled = FALSE 'activate 5 image buttons for user
|
||||
Control(assetsforbicepngPX).Disabled = FALSE
|
||||
Control(assetscartajpegPX).Disabled = FALSE
|
||||
Control(assetsspokpngPX).Disabled = FALSE
|
||||
Control(assetslizardpngPX).Disabled = FALSE
|
||||
Control(assetsspokpngPX).Hidden = FALSE
|
||||
Control(assetslizardpngPX).Hidden = FALSE
|
||||
Control(assetssassojpegPX).Hidden = FALSE
|
||||
Control(assetsforbicepngPX).Hidden = FALSE
|
||||
Control(assetscartajpegPX).Hidden = FALSE
|
||||
Control(HelpBT).Disabled = FALSE ' activate help button
|
||||
Control(assetsRPSLS_helpjpgPX).Redraw = TRUE ' force to show AI's choice
|
||||
PlayerChoose = 0 ' reset the chooser game
|
||||
END SUB
|
||||
|
||||
SUB results (result AS INTEGER)
|
||||
'here there is the output sound + images for user
|
||||
' and adjourn score of game
|
||||
Control(assetsRPSLS_helpjpgPX).Hidden = False ' show image of ai's choice
|
||||
Control(assetsRPSLS_helpjpgPX).Disabled = False
|
||||
Control(assetsRPSLS_helpjpgPX).Redraw = True ' force to 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).Redraw = TRUE ' force to show image of ai's choice
|
||||
SELECT CASE result
|
||||
CASE wins
|
||||
Caption(LB) = STR$(VAL(Caption(LB)) + 10)
|
||||
|
|
@ -244,16 +247,16 @@ SUB results (result AS INTEGER)
|
|||
Caption(LB) = STR$(VAL(Caption(LB)) - 10)
|
||||
Caption(ChooseYourMoveAndWaitAIsOneLB) = " YOU LOOSE!! "
|
||||
END SELECT
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = False 'show result as text in helplabel
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = False
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = FALSE 'show result as text in helplabel
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = FALSE
|
||||
END SUB
|
||||
|
||||
SUB playAI (choose AS INTEGER)
|
||||
PlayerChoose = 1 ' the user has made his choice
|
||||
DIM choosen AS INTEGER
|
||||
choosen = INT(RND * 5) + 1 ' ai chooses
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = True ' hide help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = True
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Hidden = TRUE ' hide help label
|
||||
Control(ChooseYourMoveAndWaitAIsOneLB).Disabled = TRUE
|
||||
LoadImage Control(assetsRPSLS_helpjpgPX), "" ' reset to null image of ai's choice
|
||||
|
||||
SELECT CASE choosen
|
||||
|
|
@ -583,6 +586,3 @@ END SUB
|
|||
SUB __UI_FormResized
|
||||
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -21,6 +21,8 @@ DIM SHARED elapsed AS SINGLE
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Stopwatch.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -73,15 +75,15 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE StartBT
|
||||
IF Running THEN
|
||||
Caption(id) = "Start"
|
||||
Running = False
|
||||
Control(StopBT).Disabled = False
|
||||
Control(LapBT).Disabled = True
|
||||
Running = FALSE
|
||||
Control(StopBT).Disabled = FALSE
|
||||
Control(LapBT).Disabled = TRUE
|
||||
ELSE
|
||||
Caption(id) = "Pause"
|
||||
start = TIMER - elapsed
|
||||
Running = True
|
||||
Control(StopBT).Disabled = True
|
||||
Control(LapBT).Disabled = False
|
||||
Running = TRUE
|
||||
Control(StopBT).Disabled = TRUE
|
||||
Control(LapBT).Disabled = FALSE
|
||||
END IF
|
||||
CASE LapBT
|
||||
AddItem ListBox1, Caption(TimeLB)
|
||||
|
|
@ -219,6 +221,3 @@ END SUB
|
|||
SUB __UI_FormResized
|
||||
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
' 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
|
||||
': InForm - GUI library for QB64 - v1.0
|
||||
|
|
@ -28,6 +28,8 @@ DIM SHARED lbEnd AS LONG
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'TextFetch.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
' --- DIRENTRY STUFF ---
|
||||
|
||||
|
|
@ -59,7 +61,7 @@ SUB loadText
|
|||
FOR i = VAL(Caption(lbStart)) TO VAL(Caption(lbEnd))
|
||||
b$ = 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
|
||||
_CLIPBOARD$ = clip$
|
||||
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 AS LONG dirCount, fileCount, flags, fileSize
|
||||
DIM entryName AS STRING
|
||||
DIM entryName AS STRING, ext AS STRING
|
||||
|
||||
IF open_dir(dirName) THEN
|
||||
DO
|
||||
entryName = read_dir(flags, fileSize)
|
||||
IF entryName <> "" THEN
|
||||
IF LEN(entryName) <> 0 THEN
|
||||
SELECT CASE flags
|
||||
CASE 1
|
||||
IF dirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(0 TO UBOUND(DirList) + RESIZE_BLOCK_SIZE) AS STRING
|
||||
DirList(dirCount) = entryName
|
||||
dirCount = dirCount + 1
|
||||
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
|
||||
FileList(fileCount) = entryName
|
||||
fileCount = fileCount + 1
|
||||
END SELECT
|
||||
END SELECT
|
||||
END IF
|
||||
LOOP UNTIL entryName = ""
|
||||
LOOP UNTIL LEN(entryName) = 0
|
||||
close_dir
|
||||
END IF
|
||||
|
||||
|
|
@ -441,6 +448,3 @@ END SUB
|
|||
SUB __UI_FormResized
|
||||
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -15,8 +15,11 @@ DIM SHARED ContextMenu1Copy AS LONG
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'ThemePreview.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
|
||||
SUB __UI_BeforeInit
|
||||
|
||||
END SUB
|
||||
|
|
@ -147,13 +150,10 @@ SUB __UI_ValueChanged (id AS LONG)
|
|||
CASE DropdownList1
|
||||
_FREEIMAGE Control(PictureBox1).HelperCanvas
|
||||
Control(PictureBox1).HelperCanvas = _COPYIMAGE(__UI_LoadThemeImage(GetItem$(DropdownList1, Control(DropdownList1).Value)))
|
||||
Control(PictureBox1).Redraw = True
|
||||
Control(PictureBox1).Redraw = TRUE
|
||||
END SELECT
|
||||
END SUB
|
||||
|
||||
SUB __UI_FormResized
|
||||
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -21,9 +21,12 @@ DIM SHARED Button8 AS LONG
|
|||
DIM SHARED Button9 AS LONG
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'TicTacToe.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -260,7 +263,3 @@ END SUB
|
|||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
|
|
|||
|
|
@ -21,9 +21,12 @@ DIM SHARED Button8 AS LONG
|
|||
DIM SHARED Button9 AS LONG
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'TicTacToe2.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -179,7 +182,3 @@ END SUB
|
|||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
|
|
|||
|
|
@ -48,9 +48,13 @@ DATA 254,36541,652,12587,23698741,98523,458,56974,685
|
|||
FOR M%% = 1 TO noCells%%: READ TrackWord$(M%%): NEXT M%%
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'Trackword.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
||||
|
||||
FUNCTION snake2word$ (snakey$)
|
||||
' Use the dim shared theWord$ to translate snake number string to letters
|
||||
|
|
@ -69,14 +73,14 @@ END FUNCTION
|
|||
|
||||
FUNCTION Located%% (S2$)
|
||||
'Proven to work in all circustances
|
||||
__Located%% = False
|
||||
__Located%% = FALSE
|
||||
P0& = 1
|
||||
P100& = Entries&
|
||||
|
||||
WHILE P0& <= P100& AND NOT __Located%%
|
||||
P50& = INT((P0& + P100&) / 2)
|
||||
IF S2$ = words$(P50&) THEN
|
||||
__Located%% = True
|
||||
__Located%% = TRUE
|
||||
ELSEIF S2$ > words$(P50&) THEN
|
||||
P0& = P50& + 1
|
||||
ELSE
|
||||
|
|
@ -87,7 +91,6 @@ FUNCTION Located%% (S2$)
|
|||
Located = __Located%%
|
||||
END FUNCTION
|
||||
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
'Trackword Confiuration File
|
||||
|
|
@ -170,12 +173,12 @@ SUB __UI_Click (id AS LONG)
|
|||
'Search for 9-letter word & place in grid
|
||||
OPEN "dictionary.rnd" FOR RANDOM AS #1 LEN = 9
|
||||
FIELD #1, 9 AS Lex$
|
||||
NineLetters` = False
|
||||
NineLetters` = FALSE
|
||||
WHILE NOT NineLetters`
|
||||
Sel& = INT(Entries& * RND) + 1
|
||||
GET #1, Sel&
|
||||
OutWord$ = RTRIM$(Lex$)
|
||||
IF LEN(OutWord$) = 9 THEN NineLetters` = True
|
||||
IF LEN(OutWord$) = 9 THEN NineLetters` = TRUE
|
||||
WEND
|
||||
CLOSE #1
|
||||
theWord$ = "*********"
|
||||
|
|
@ -221,60 +224,60 @@ SUB __UI_Click (id AS LONG)
|
|||
Caption(WordsFoundLB) = "Words Found"
|
||||
NoAnswers% = 0
|
||||
NoNineLetters% = 0
|
||||
FullWord` = True
|
||||
FullWord` = TRUE
|
||||
IF Text(TextBox1) = "" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox1
|
||||
ELSEIF Text(TextBox1) < "A" OR Text(TextBox1) > "Z" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox1
|
||||
ELSEIF Text(TextBox2) = "" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox2
|
||||
ELSEIF Text(TextBox2) < "A" OR Text(TextBox2) > "Z" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox2
|
||||
ELSEIF Text(TextBox3) = "" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox3
|
||||
ELSEIF Text(TextBox3) < "A" OR Text(TextBox3) > "Z" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox3
|
||||
ELSEIF Text(TextBox4) = "" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox4
|
||||
ELSEIF Text(TextBox4) < "A" OR Text(TextBox4) > "Z" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox4
|
||||
ELSEIF Text(TextBox5) = "" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox5
|
||||
ELSEIF Text(TextBox5) < "A" OR Text(TextBox5) > "Z" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox5
|
||||
ELSEIF Text(TextBox6) = "" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox6
|
||||
ELSEIF Text(TextBox6) < "A" OR Text(TextBox6) > "Z" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox6
|
||||
ELSEIF Text(TextBox7) = "" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox7
|
||||
ELSEIF Text(TextBox7) < "A" OR Text(TextBox7) > "Z" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox7
|
||||
ELSEIF Text(TextBox8) = "" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox8
|
||||
ELSEIF Text(TextBox8) < "A" OR Text(TextBox8) > "Z" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox8
|
||||
ELSEIF Text(TextBox9) = "" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox9
|
||||
ELSEIF Text(TextBox9) < "A" OR Text(TextBox9) > "Z" THEN
|
||||
FullWord` = False
|
||||
FullWord` = FALSE
|
||||
SetFocus TextBox9
|
||||
END IF
|
||||
IF FullWord` THEN
|
||||
|
|
@ -300,11 +303,11 @@ SUB __UI_Click (id AS LONG)
|
|||
FOR M%% = 0 TO 1
|
||||
IF Located%%(S1$(M%%)) THEN
|
||||
IF NoAnswers% > 0 THEN
|
||||
Present` = False
|
||||
Present` = FALSE
|
||||
Index% = 0
|
||||
WHILE (NOT Present`) AND Index% <= NoAnswers%
|
||||
GET #1, Index% + 1
|
||||
IF RTRIM$(TWord$) = S1$(M%%) THEN Present` = True
|
||||
IF RTRIM$(TWord$) = S1$(M%%) THEN Present` = TRUE
|
||||
Index% = Index% + 1
|
||||
WEND
|
||||
IF NOT Present` THEN
|
||||
|
|
@ -325,9 +328,9 @@ SUB __UI_Click (id AS LONG)
|
|||
WHILE Jump% <= NoAnswers%: Jump% = Jump% * 2: WEND
|
||||
WHILE Jump% > 1
|
||||
Jump% = (Jump% - 1) \ 2
|
||||
Finished` = False
|
||||
Finished` = FALSE
|
||||
WHILE NOT Finished`
|
||||
Finished` = True
|
||||
Finished` = TRUE
|
||||
FOR Upper% = 1 TO NoAnswers% - Jump%
|
||||
Lower% = Upper% + Jump%
|
||||
GET #1, Upper%: UWord$ = TWord$
|
||||
|
|
@ -337,7 +340,7 @@ SUB __UI_Click (id AS LONG)
|
|||
PUT #1, Lower%
|
||||
LSET TWord$ = LWord$
|
||||
PUT #1, Upper%
|
||||
Finished` = False
|
||||
Finished` = FALSE
|
||||
END IF
|
||||
NEXT Upper%
|
||||
WEND
|
||||
|
|
@ -457,7 +460,3 @@ END SUB
|
|||
|
||||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
|
|
|||
|
|
@ -38,6 +38,8 @@ DIM SHARED Word(1 TO 22) AS LONG
|
|||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'WordClock.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -190,12 +192,12 @@ END SUB
|
|||
|
||||
SUB switchOn (this AS LONG)
|
||||
Control(this).ForeColor = _RGB32(111, 205, 0)
|
||||
Control(this).Redraw = True
|
||||
Control(this).Redraw = TRUE
|
||||
END SUB
|
||||
|
||||
SUB switchOff (this AS LONG)
|
||||
Control(this).ForeColor = _RGB32(0, 39, 0)
|
||||
Control(this).Redraw = True
|
||||
Control(this).Redraw = TRUE
|
||||
END SUB
|
||||
|
||||
SUB __UI_BeforeUnload
|
||||
|
|
@ -491,6 +493,3 @@ END SUB
|
|||
SUB __UI_FormResized
|
||||
|
||||
END SUB
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
|
|
|
|||
|
|
@ -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
|
||||
'-----------------------------------------------------------------------------------
|
||||
' PROGRAM: ebacCalculator.bas
|
||||
|
|
@ -73,12 +71,13 @@ DIM SHARED AS SINGLE B, OZ, Wt, EBAC
|
|||
DIM SHARED AS STRING helpcontents, prt_text
|
||||
|
||||
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'ebacCalculator.frm'
|
||||
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -95,7 +94,7 @@ SUB __UI_OnLoad
|
|||
I = 0
|
||||
Bdl = 1.055
|
||||
OZ = .5
|
||||
SOBER = False: legalToDrive = False
|
||||
SOBER = FALSE: legalToDrive = FALSE
|
||||
HELPFile = "EBACHelp.txt"
|
||||
displayDisclaimer
|
||||
|
||||
|
|
@ -148,8 +147,8 @@ SUB __UI_Click (id AS LONG)
|
|||
CASE AGREEBT
|
||||
Answer = MessageBox("Do you want to perform another calculation? ", "", MsgBox_YesNo + MsgBox_Question)
|
||||
IF Answer = MsgBox_Yes THEN
|
||||
Control(AgreeCB).Value = False
|
||||
Control(AGREEBT).Disabled = True
|
||||
Control(AgreeCB).Value = FALSE
|
||||
Control(AGREEBT).Disabled = TRUE
|
||||
ELSE
|
||||
Answer = MessageBox("Thank You for using EBAC Calculator. Please Don't Drink and Drive.", "", MsgBox_Ok + MsgBox_Information)
|
||||
SYSTEM
|
||||
|
|
@ -159,7 +158,7 @@ SUB __UI_Click (id AS LONG)
|
|||
ResetForm
|
||||
|
||||
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)
|
||||
EXIT SUB
|
||||
END IF
|
||||
|
|
@ -167,7 +166,7 @@ SUB __UI_Click (id AS LONG)
|
|||
Wt = Control(WeightTB).Value
|
||||
T = Control(TimeTB).Value
|
||||
calcEBAC
|
||||
Control(QUITBT).Disabled = True
|
||||
Control(QUITBT).Disabled = TRUE
|
||||
ResetList displayResults
|
||||
Text(displayResults) = prt_text
|
||||
|
||||
|
|
@ -227,16 +226,16 @@ SUB __UI_TextChanged (id AS LONG)
|
|||
SELECT CASE id
|
||||
|
||||
CASE WeightTB
|
||||
Control(AgreeCB).Value = False
|
||||
Control(AGREEBT).Disabled = True
|
||||
Control(AgreeCB).Value = FALSE
|
||||
Control(AGREEBT).Disabled = TRUE
|
||||
|
||||
CASE nbrDrinksTB
|
||||
Control(AgreeCB).Value = False
|
||||
Control(AGREEBT).Disabled = True
|
||||
Control(AgreeCB).Value = FALSE
|
||||
Control(AGREEBT).Disabled = TRUE
|
||||
|
||||
CASE TimeTB
|
||||
Control(AgreeCB).Value = False
|
||||
Control(AGREEBT).Disabled = True
|
||||
Control(AgreeCB).Value = FALSE
|
||||
Control(AGREEBT).Disabled = TRUE
|
||||
|
||||
END SELECT
|
||||
END SUB
|
||||
|
|
@ -247,20 +246,20 @@ SUB __UI_ValueChanged (id AS LONG)
|
|||
CASE displayResults
|
||||
|
||||
CASE maleRB
|
||||
Control(AgreeCB).Value = False
|
||||
Control(AGREEBT).Disabled = True
|
||||
Control(AgreeCB).Value = FALSE
|
||||
Control(AGREEBT).Disabled = TRUE
|
||||
|
||||
CASE femaleRB
|
||||
Control(AgreeCB).Value = False
|
||||
Control(AGREEBT).Disabled = True
|
||||
Control(AgreeCB).Value = FALSE
|
||||
Control(AGREEBT).Disabled = TRUE
|
||||
|
||||
CASE AgreeCB
|
||||
IF Control(AgreeCB).Value = True THEN
|
||||
Control(AGREEBT).Disabled = False
|
||||
Control(QUITBT).Disabled = False
|
||||
IF Control(AgreeCB).Value = TRUE THEN
|
||||
Control(AGREEBT).Disabled = FALSE
|
||||
Control(QUITBT).Disabled = FALSE
|
||||
ELSE
|
||||
Control(AGREEBT).Disabled = True
|
||||
Control(QUITBT).Disabled = True
|
||||
Control(AGREEBT).Disabled = TRUE
|
||||
Control(QUITBT).Disabled = TRUE
|
||||
END IF
|
||||
|
||||
END SELECT
|
||||
|
|
@ -312,10 +311,10 @@ SUB ResetForm
|
|||
Control(nbrDrinksTB).Value = 0
|
||||
Control(WeightTB).Value = 0
|
||||
Control(TimeTB).Value = 0
|
||||
Control(AgreeCB).Value = False
|
||||
Control(AGREEBT).Disabled = True
|
||||
Control(maleRB).Value = False
|
||||
Control(femaleRB).Value = False
|
||||
Control(AgreeCB).Value = FALSE
|
||||
Control(AGREEBT).Disabled = TRUE
|
||||
Control(maleRB).Value = FALSE
|
||||
Control(femaleRB).Value = FALSE
|
||||
ResetList displayResults
|
||||
Sex = ""
|
||||
END SUB
|
||||
|
|
@ -326,7 +325,7 @@ SUB calcEBAC
|
|||
' *** Convert Drinks into Fluid Ounces of EtOH (Pure Alcohol).
|
||||
' *** A is number of drinks. 1 drink is about .6 FLoz of alcohol
|
||||
FLoz = A * OZ
|
||||
legalToDrive = False
|
||||
legalToDrive = FALSE
|
||||
|
||||
'-----------------------------------------------------
|
||||
' *** Set/calculate EBAC values based on Sex
|
||||
|
|
@ -427,10 +426,10 @@ SUB calcEBAC
|
|||
'*** - When user will be less than .08
|
||||
'*** - How long it will take to become completely sober
|
||||
IF EBAC > .08 THEN
|
||||
SOBER = False
|
||||
SOBER = FALSE
|
||||
CEBAC = EBAC
|
||||
st = T
|
||||
DO UNTIL SOBER = True
|
||||
DO UNTIL SOBER = TRUE
|
||||
T = T + 1
|
||||
IF CEBAC > .0799 THEN I = I + 1
|
||||
|
||||
|
|
@ -443,16 +442,16 @@ SUB calcEBAC
|
|||
CEBAC = 9.86 * FLoz / Wt - B * T
|
||||
END SELECT
|
||||
|
||||
IF legalToDrive = False THEN
|
||||
IF legalToDrive = FALSE 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)
|
||||
legalToDrive = True
|
||||
legalToDrive = TRUE
|
||||
END IF
|
||||
END IF
|
||||
|
||||
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."
|
||||
SOBER = True
|
||||
SOBER = TRUE
|
||||
END IF
|
||||
LOOP
|
||||
END IF
|
||||
|
|
@ -476,7 +475,3 @@ FUNCTION strFormat$ (text AS STRING, template AS STRING)
|
|||
_DEST d: _SOURCE s
|
||||
_FREEIMAGE n
|
||||
END FUNCTION
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
|
|
|||
|
|
@ -20,9 +20,12 @@ DIM SHARED AS STRING contents, originalcontents
|
|||
|
||||
|
||||
': External modules: ---------------------------------------------------------------
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
|
||||
'$INCLUDE:'../../InForm/InForm.bi'
|
||||
'$INCLUDE:'wordSearch.frm'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
||||
': Event procedures: ---------------------------------------------------------------
|
||||
SUB __UI_BeforeInit
|
||||
|
|
@ -35,15 +38,15 @@ SUB __UI_BeforeUpdateDisplay
|
|||
'This event occurs at approximately 30 frames per second.
|
||||
'You can change the update frequency by calling SetFrameRate DesiredRate%
|
||||
IF _FILEEXISTS(Text(FileTB)) THEN
|
||||
Control(LoadBT).Disabled = False
|
||||
Control(LoadBT).Disabled = FALSE
|
||||
ELSE
|
||||
Control(LoadBT).Disabled = True
|
||||
Control(LoadBT).Disabled = TRUE
|
||||
END IF
|
||||
|
||||
IF LEN(Text(WordTB)) > 0 THEN
|
||||
Control(SearchBT).Disabled = False
|
||||
Control(SearchBT).Disabled = FALSE
|
||||
ELSE
|
||||
Control(SearchBT).Disabled = True
|
||||
Control(SearchBT).Disabled = TRUE
|
||||
END IF
|
||||
|
||||
END SUB
|
||||
|
|
@ -146,10 +149,8 @@ END SUB
|
|||
SUB __UI_FormResized
|
||||
END SUB
|
||||
|
||||
|
||||
': User modules: ---------------------------------------------------------------
|
||||
|
||||
|
||||
FUNCTION strFormat$ (text AS STRING, template AS STRING)
|
||||
'-----------------------------------------------------------------------------
|
||||
' *** Return a formatted string to a variable
|
||||
|
|
@ -166,7 +167,3 @@ FUNCTION strFormat$ (text AS STRING, template AS STRING)
|
|||
_DEST d: _SOURCE s
|
||||
_FREEIMAGE n
|
||||
END FUNCTION
|
||||
|
||||
'$INCLUDE:'../../InForm/InForm.ui'
|
||||
'$INCLUDE:'../../InForm/xp.uitheme'
|
||||
'$INCLUDE:'../../InForm/extensions/MessageBox.bas'
|
||||
|
|
|
|||
Loading…
Reference in a new issue