This is what I wrote a while back for my mouse management. I use this as a BI/BM file and have marked the code where to split. Simply call GetMouseInput and read the variables that are returned (there are quite a few - read the documentation in the code). It makes easy work of determining a click or double click as well as whether the user is dragging something with the mouse, and much more...
Also included is a graphics management routine I wrote to easily deal with putting images on the screen and knowing whether the user clicked on the image or is hovering over the image. There are also pre-defined scalable graphics too (left and right arrows, on/off switch, radio button, and hamburger).
Please accept that I am not the best programmer and I am sure that there are better ways to achieve the same results. Some of the text-graphics somehow got jumbled after pasting...
Also included is a graphics management routine I wrote to easily deal with putting images on the screen and knowing whether the user clicked on the image or is hovering over the image. There are also pre-defined scalable graphics too (left and right arrows, on/off switch, radio button, and hamburger).
Please accept that I am not the best programmer and I am sure that there are better ways to achieve the same results. Some of the text-graphics somehow got jumbled after pasting...
Code: (Select All)
$IncludeOnce
'Mouse related variables
Common Shared MouseEnabled% ' whether mouse operation is allowed (yes = true%)
Common Shared MouseDISabled%
Common Shared priorLbuttonPosition%, priorCbuttonPosition%, priorRbuttonPosition% ' stores PRIOR position of mouse button
Common Shared LdoubleClicked#, CdoubleClicked#, RdoubleClicked# ' did a double click occur? If yes then it equals time between press and release
Common Shared colorDepth%, color32% ' Used to tell whether we are using 32 bit color or not so that colors can be set properly
Dim Shared color256#(256) ' storage for 32 bit equivalent colors
Common Shared Ldragging%, Cdragging%, Rdragging% ' whether the mouse is being dragged at the current time
Common Shared LdragDrop%, LddstartROW%, LddstartCOL%, LddendROW%, LddendCOL% ' drag and drop - Left click
Common Shared CdragDrop%, CddstartROW%, CddstartCOL%, CddendROW%, CddendCOL% ' drag and drop - Center click
Common Shared RdragDrop%, RddstartROW%, RddstartCOL%, RddendROW%, RddendCOL% ' drag and drop - Right click
Common Shared tCURRENT%, tPRIOR% ' array pointer values to make reading formulas easier
Common Shared DoubleClickLength# ' MAX time for a double click to be considered valid
Dim Shared LpressedTIME#(2), CpressedTIME#(2), RpressedTIME#(2) ' when button was pressed: 1=NEWEST 2=PRIOR
Dim Shared LreleasedTIME#(2), CreleasedTIME#(2), RreleasedTIME#(2) ' when button was released: 1=NEWEST 2=PRIOR
Common Shared MouseLeftButton%, MouseCenterButton%, MouseRightButton% ' button position of last mouse scan (pressed = true%)
Common Shared ROW_Lpressed%, ROW_Lreleased%, COL_Lpressed%, COL_Lreleased%
Common Shared ROW_Cpressed%, ROW_Creleased%, COL_Cpressed%, COL_Creleased%
Common Shared ROW_Rpressed%, ROW_Rreleased%, COL_Rpressed%, COL_Rreleased%
Common Shared MouseWheel%, MouseX%, MouseY%, mouseROW%, mouseCOL%
Common Shared LbuttonReleased%, CbuttonReleased%, RbuttonReleased% ' these are set upon exiting GetMouseInput IF the mouse button had been pressed the last time
' we entered GetMouseInput and it was released THIS SESSION. It needs to be tested for every time
' after GetMouseInput because it will be reset every time to call GetMouseInput
'GFX variables
Common Shared gfxULrow%, gfxULcol%, gfxHeight%, gfxWidth%
'program is set up to 4 digits max (9999) but we are limiting here to 3 digits (999) to save processing time
Dim Shared gfxHandle$(999)
Dim Shared gfximage&(999) ' containers for image
Dim Shared gfxLocation%(999, 4) 'x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
'ignore the 'SkipNextLine comments - these are directives for a program I have that automatically creates BI/BM files from *.BAS programs
'SkipNextLine
Common Shared true%, false%, fore%, back%, clicks#
'skipnextline
Dim Shared tdir$(1000)
'skipnextline
true% = (1 = 1): false% = (1 = 0)
'skipnextline
'Below is where the .BI file would END if you want to break it up into BI/BM files
'ENDBI
'================================================
'----------- Place test code here -----------
'================================================
'Screen _NewImage(1500, 1000, 256): fore% = 106: back% = 30: Color fore%, back%: Cls
'Screen _NewImage(1500, 1000, 32): fore32# = 4278256590: back32# = 4291150038: Color fore32#, back32#: Cls
'_ScreenMove 300, 20
Cls
Locate 10, 10
Locate , 10: Print "Select To"
Locate , 10: Print "----- ------------------------------------------"
Locate , 10: Print " 1 ClickableGFX demo"
Locate , 10: Print " 2 Mouse routine demo"
Locate , 10: Print " ESC exit"
i$ = ""
While i$ <> "1" And i$ <> "2" And i$ <> Chr$(27)
i$ = InKey$
If i$ = "1" Then
Cls
Locate 5, 10: Print "This demo will first create 24 randomized .JPG files"
Locate , 10: Print "that will be used as the icons that you can hover over and click"
Locate , 10: Print "on to cycle through the images."
Locate , 10: Print ""
Locate , 10: Print "Things to note:"
Locate , 10: Print " 1st row on screen shows status if you are hovering over or have"
Locate , 10: Print " clicked on an image."
Locate , 10: Print ""
Locate , 10: Print " First screen has a single image. To the right and left of the"
Locate , 10: Print " image are clickable arrows. At the bottom of that image is a"
Locate , 10: Print " radio button and a switch. Click on the radio button and switch"
Locate , 10: Print " and notice the changes."
Locate , 10: Print ""
Locate , 10: Print "When you are finished, press Esc to move onto the"
Locate , 10: Print "next example."
Locate , 10: Print ""
Locate , 10: Print "press any key to start..."
i$ = "": While i$ = "": i$ = InKey$: _Limit 60: Wend
ClickingGFXsample
System
ElseIf i$ = "2" Then
Cls
MouseRoutineSample
System
ElseIf i$ = Chr$(27) Then
System
End If
Wend
System
'Below is where the .BM file would START if you want to break it up into BI/BM files
'STARTBM
Sub GetMouseInput
' Provides mouse management by returning status values in shared variables.
'
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Mouse Status ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' After calling GetMouseInput, the following variables are returned with data:
' MouseLeftButton% -1 if pressed at time of exit, 0 if not pressed
' MouseCenterButton% -1 if pressed at time of exit, 0 if not pressed
' MouseRightButton% -1 if pressed at time of exit, 0 if not pressed
' MouseWheel% 0 if no movement otherwise + number=UP - number=down
'
' MouseX% PIXEL coordinates of mouse pointer location - x axis
' MouseY% PIXEL coordinates of mouse pointer location - y axis
' mouseCOL% COLUMN screen coordinate of mouse pointer location
' mouseROW% ROW screen coordinate of mouse pointer location
'
'
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Mouse Clicks ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' These variables return the screen coordinates after a mouse click occurred:
'
' ROW_Lpressed%, ROW_Lreleased%, COL_Lpressed%, COL_Lreleased% - left button
' ROW_Cpressed%, ROW_Creleased%, COL_Cpressed%, COL_Creleased% - center botton
' ROW_Rpressed%, ROW_Rreleased%, COL_Rpressed%, COL_Rreleased% - right button
'
' NOTE: The above variables are never cleared/reset. They will store the same value until an
' event changes the data.
'
'
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Mouse Double Clicks ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' Variables below apply to the LAST click that was performed. If it was within time to be considered a
' double click then it will contain a value otherwise it will be 0. This value is NOT cleared until
' the next click is performed, and only then will it be cleared if that click exceeded the value
' for a double click. If you need these cleared after reading you will need to do it manually.
'
' LdoubleClicked# if double click occurred this=the time between 1st/2nd click - otherwise=0
' CdoubleClicked# if double click occurred this=the time between 1st/2nd click - otherwise=0
' RdoubleClicked# if double click occurred this=the time between 1st/2nd click - otherwise=0
'
' DoubleClickLength# This variable is SET (not returned) to the max time in seconds allowed
' between clicks for a double click to be considered valid.
' The default=.5 second if nothing has been set.
'
' Returning a time value rather than just a true/false gives you the flexibility to know exactly how long
' it took the user to perform the double click in case you want to perform additional actions based on
' different times between clicks.
'
' NOTE: LdoubleClicked#, CdoubleClicked#, and RdoubleClicked# will be reset the next time GetMouseInput is called.
' If you need this data, you MUST store the event variables before calling GetMouseInput again.
'
'
' These variables are used to calculate whether or not a double click has occurred by calculating the
' time different between events:
' LpressedTIME#(1) timer when left button was most recently PRESSED
' LpressedTIME#(2) value of above for PRIOR press of left button
'
' LreleasedTIME#(1) timer when left button was most recently RELEASED
' LreleasedTIME#(2) value of above for PRIOR release of left button
' CpressedTIME#(), CreleasedTIME#(), RpressedTIME#(), RreleasedTIME#() represent the same for the
' center and right buttons.
'
'
'
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Drag and Drop ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' When a user clicks the mouse button but releases the button at a different place on the screen
' valid drag and drop event has occured. While the mouse button is held down and the mouse is currently
' being moved (or has been moved and the button is still down) one of the variables below will be set
' to True% to indicate that dragging is currently happening:
'
' Ldragging% (LEFT) Cdragging% (CENTER) Rdragging% (RIGHT)
'
'
' Once the user releases the mouse button (after a drag and drop operation), one of the following
' variables will be set = true%:
'
' LdragDrop% (LEFT) CdragDrop% (CENTER) RdragDrop% (RIGHT)
'
' NOTE: Once LdragDrop%, CdragDrop%, or RdragDrop% is set True%, Ldragging%, Cdragging%, or Rdragging%
' will be set to False% since we are no longer dragging.
'
'
' Also, the corresponding variable will be set to identify the start/end locations of the
' drag/drop operation:
'
' LddstartROW% LddstartCOL% LddendROW% LddendCOL% (LEFT)
' CddstartROW% CddstartCOL% CddendROW% CddendCOL% (CENTER)
' RddstartROW% RddstartCOL% RddendROW% RddendCOL% (RIGHT)
'
' NOTE: The above variables will be reset the next time that GetMouseInput is called.
'
' Code Example:
' Screen _NewImage(800, 600, 256): fore% = 106: back% = 30: Color fore%, back%: Cls
' waitForDragDrop:
' MouseEnabled% = (1 = 1)
' GetMouseInput
' Locate 1, 1: Print "row="; mouseROW%; " col="; mouseCOL%; Space$(10)
' If LdragDrop% Then
' Print "The item was dragged from row "; LddstartROW%; " col "; LddstartCOL%
' Print "and was left at row "; LddendROW%; " col "; LddendCOL%
' Input "Press ENTER to continue...", pressEnter%
' Cls
' End If
' GoTo waitForDragDrop
'
'
'
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Integration with ClickableGFX ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' GetMouseInput automatically integrates with the images placed with ClickableGFX.
' AFTER GetMouseInput you can use the function ClickedImage%() to test whether the
' user clicked on am inage. ClickedImage%() will return the UNIQUE handle number of
' the image if a user clicked on it, otherwise it will return false%. The sent data
' to ClickedImage%() is L, C, or R (Left, Center, Right)
'
'
' ex:
' GetMouseInput
' if ClickedImage%("L") then Print "User LEFT clicked on "; gfxHandle$(ClickedImage%("L"))
' if ClickedImage%("C") then Print "User CENTER clicked on "; gfxHandle$(ClickedImage%("L"))
'
' This will display the name of the handle of the image that the user clicked.
'
' You can also test to see whether the mouse is hovering over an image with the
' HoverOverImage% function. HoverOverImage% will return the UNIQUE handle number of
' the user is hovering over an image otherwise it will return false%.
'
' GetMouseInput
' if HoverOverImage% then Print "User hovered over "; gfxHandle$(HoverOverImage%)
'
'The following are shared arrays that store the image location info
' gfxHandle$(9999) name of the image
' gfximage&(9999) image that is loaded into memory only if Keep is used
' gfxLocation%(9999, 4) x,1=UL Row x,2=UL Col x,3=width x,4=height
' (where array element number x = the handle number)
'
'
'
'
'
'
'
'If Not MouseEnabled% Then Exit Sub
If MouseDISabled% Then Exit Sub
'defaults
true% = (1 = 1)
false% = (1 = 0)
'reset MouseWheen% so that only current wheel events are returned
MouseWheel% = 0
If LdragDrop% Then
LdragDrop% = false%
Ldragging% = false%
LddstartROW% = 0
LddstartCOL% = 0
LddendROW% = 0
LddendCOL% = 0
ROW_Lpressed% = 0
COL_Lpressed% = 0
ROW_Lreleased% = 0
COL_Lreleased% = 0
End If
If CdragDrop% Then
CdragDrop% = false%
Cdragging% = false%
CddstartROW% = 0
CddstartCOL% = 0
CddendROW% = 0
CddendCOL% = 0
ROW_Cpressed% = 0
COL_Cpressed% = 0
ROW_Creleased% = 0
COL_Creleased% = 0
End If
If RdragDrop% Then
RdragDrop% = false%
Rdragging% = false%
RddstartROW% = 0
RddstartCOL% = 0
RddendROW% = 0
RddendCOL% = 0
ROW_Rpressed% = 0
COL_Rpressed% = 0
ROW_Rreleased% = 0
COL_Rreleased% = 0
End If
'reset each time through - will be set upon exit if drag/drop operation finished
imageClicked% = false%
tCURRENT% = 1: tPRIOR% = 2
If DoubleClickLength# = 0 Then DoubleClickLength# = .5 ' set default if nothing has been set
'flush old mouse events and return only most relevant mouse event (keeping all wheel events)
'While _MouseInput: MouseWheel% = MouseWheel% + _MouseWheel: Wend
While _MouseInput: MouseWheel% = MouseWheel% + _MouseWheel: Wend
'Get mouse data
MouseLeftButton% = _MouseButton(1)
MouseCenterButton% = _MouseButton(3)
MouseRightButton% = _MouseButton(2)
MouseWheel% = MouseWheel% + _MouseWheel
MouseX% = _MouseX 'location within window (Pixels)
MouseY% = _MouseY
mouseCOL% = _Round((MouseX% / _FontWidth) + .5)
mouseROW% = _Round((MouseY% / _FontHeight) + .75)
'don't allow mouse to go out of window
If mouseCOL% >= Int(_Width / _FontWidth) Then mouseCOL% = Int(_Width / _FontWidth)
If mouseROW% >= Int(_Height / _FontHeight) Then mouseROW% = Int(_Height / _FontHeight)
If mouseROW% < 1 Then mouseROW% = 1
If mouseCOL% < 1 Then mouseCOL% = 1
' >>>> FORMULAS <<<<<
' Length of Time button was DOWN (PRIOR button press) LreleasedTIME#(tPRIOR%) - LpressedTIME#(tPRIOR%)
' Length of Time button was DOWN (CURRENT button press) LreleasedTIME#(tCURRENT%) - LpressedTIME#(tCURRENT%)
' Length of time between 2 clicks LpressedTIME#(tCURRENT%) - LreleasedTIME#(tPRIOR%)
'----------------------------------------------
' --- LEFT mouse button ---
'----------------------------------------------
LbuttonReleased% = false%
LdoubleClicked# = false%
'check to see if L button position has changed position since last time through
If MouseLeftButton% <> priorLbuttonPosition% Then
clicks# = clicks# + 1
If MouseLeftButton% Then ' if LEFT button is PRESSED
LpressedTIME#(tPRIOR%) = LpressedTIME#(tCURRENT%)
LpressedTIME#(tCURRENT%) = Timer
ROW_Lpressed% = mouseROW%
COL_Lpressed% = mouseCOL%
ROW_Lreleased% = 0
COL_Lreleased% = 0
Else ' if LEFT button is RELEASED
LreleasedTIME#(tPRIOR%) = LreleasedTIME#(tCURRENT%)
LreleasedTIME#(tCURRENT%) = Timer
ROW_Lreleased% = mouseROW%
COL_Lreleased% = mouseCOL%
LbuttonReleased% = true%
Ldragging% = false%
End If
priorLbuttonPosition% = MouseLeftButton%
'did we have a double click?
If LpressedTIME#(tCURRENT%) - LreleasedTIME#(tPRIOR%) <= DoubleClickLength# Then
'If LpressedTIME#(tCURRENT%) - LpressedTIME#(tPRIOR%) <= DoubleClickLength# Then
LdoubleClicked# = LpressedTIME#(tCURRENT%) - LpressedTIME#(tPRIOR%)
'reset so that the next SINGLE mouse click will not trigger another double click (if pressed within DoubleClickLength#)
LpressedTIME#(tCURRENT%) = 0: LpressedTIME#(tPRIOR%) = 0
LreleasedTIME#(tCURRENT%) = 0: LreleasedTIME#(tPRIOR%) = 0
Else
LdoubleClicked# = false%
End If
End If
'----------------------------------------------
' --- CENTER mouse button ---
'----------------------------------------------
CbuttonReleased% = false%
CdoubleClicked# = false%
'check to see if L button position has changed position since last time through
If MouseCenterButton% <> priorCbuttonPosition% Then
If MouseCenterButton% Then
'if CENTER button was PRESSED
CpressedTIME#(tPRIOR%) = CpressedTIME#(tCURRENT%)
CpressedTIME#(tCURRENT%) = Timer
ROW_Cpressed% = mouseROW%
COL_Cpressed% = mouseCOL%
ROW_Creleased% = 0
COL_Creleased% = 0
Else
'if CENTER button was RELEASED
CreleasedTIME#(tPRIOR%) = CreleasedTIME#(tCURRENT%)
CreleasedTIME#(tCURRENT%) = Timer
ROW_Creleased% = mouseROW%
COL_Creleased% = mouseCOL%
CbuttonReleased% = true%
End If
priorCbuttonPosition% = MouseCenterButton%
'did we have a double click?
If CpressedTIME#(tCURRENT%) - CreleasedTIME#(tPRIOR%) < DoubleClickLength# Then
CdoubleClicked# = CpressedTIME#(tCURRENT%) - CreleasedTIME#(tPRIOR%)
'reset so that the next SINGLE mouse click will not trigger another double click (if pressed within DoubleClickLength#)
CpressedTIME#(tCURRENT%) = 0: CpressedTIME#(tPRIOR%) = 0
CreleasedTIME#(tCURRENT%) = 0: CreleasedTIME#(tPRIOR%) = 0
Else
CdoubleClicked# = false%
End If
End If
'----------------------------------------------
' --- RIGHT mouse button ---
'----------------------------------------------
RbuttonReleased% = false%
RdoubleClicked# = false%
'check to see if L button position has changed position since last time through
If MouseRightButton% <> priorRbuttonPosition% Then
If MouseRightButton% Then
'if RIGHT button was PRESSED
RpressedTIME#(tPRIOR%) = RpressedTIME#(tCURRENT%)
RpressedTIME#(tCURRENT%) = Timer
ROW_Rpressed% = mouseROW%
COL_Rpressed% = mouseCOL%
ROW_Rreleased% = 0
COL_Rreleased% = 0
Else
'if RIGHT button was RELEASED
RreleasedTIME#(tPRIOR%) = RreleasedTIME#(tCURRENT%)
RreleasedTIME#(tCURRENT%) = Timer
ROW_Rreleased% = mouseROW%
COL_Rreleased% = mouseCOL%
RbuttonReleased% = true%
End If
priorRbuttonPosition% = MouseRightButton%
'did we have a double click?
If RpressedTIME#(tCURRENT%) - RreleasedTIME#(tPRIOR%) < DoubleClickLength# Then
RdoubleClicked# = RpressedTIME#(tCURRENT%) - RreleasedTIME#(tPRIOR%)
'reset so that the next SINGLE mouse click will not trigger another double click (if pressed within DoubleClickLength#)
RpressedTIME#(tCURRENT%) = 0: RpressedTIME#(tPRIOR%) = 0
RreleasedTIME#(tCURRENT%) = 0: RreleasedTIME#(tPRIOR%) = 0
Else
RdoubleClicked# = false%
End If
End If
'-----------------------------------------------------------------------------------------------
' XXXXx XXXXx xXx xXXXx X X XXXXx XXXXx xXXXx XXXXx
' X X X X x x X XX X X X X X X X X X
' X X XXXX' XXXXX X XX XXX X X X XXX X X XXXX' X X XXXX'
' X X X X X X X X X X X X X X X X X X
' XXXX' X 'X X X 'XXX' X 'X XXXX' X 'X 'XXX' X
'-----------------------------------------------------------------------------------------------
'check before exiting if drag/drop operation was performed and is finished
' --------------------------------
' X XXXXX XXXXX XXXXX
' X X X X
' X XXX XXX X
' X X X X
' XXXX XXXXX X X
' --------------------------------
'----------------------------------------------------------------------
' Are we currently dragging the mouse with the LEFT button down ?
'----------------------------------------------------------------------
If ROW_Lpressed% > 0 And COL_Lpressed% > 0 Then ' button is currently pressed
If ROW_Lpressed% <> mouseROW% Or COL_Lpressed% <> mouseCOL% Then ' current mouse location has moved from original location where button was pressed
If ROW_Lpressed% <> ROW_Lreleased% Or COL_Lpressed% <> COL_Lreleased% Then ' press and release locations are different (ie NOT just a click/double click)
Ldragging% = true% '
End If '
Else
Ldragging% = false% ' will be reset to False% below if operation nas finished
End If
End If
'--------------------------------------------------
' Do we have a new LEFT button drag/drop event?
' (button was released after drag/drop)
'--------------------------------------------------
'FIRST: if ALL variables have a value then we have a click and a release
If ROW_Lpressed% * COL_Lpressed% * ROW_Lreleased% * COL_Lreleased% > 0 Then
'SECOND: was there movement of the mouse from click to release
If ROW_Lpressed% <> ROW_Lreleased% Or COL_Lpressed% <> COL_Lreleased% Then
'THIRD: Is this a NEW event (ie start/end row/column has changed from last drag/drop event)?
If LddstartROW% <> ROW_Lpressed% Or LddstartCOL% <> COL_Lpressed% Or LddendROW% <> ROW_Lreleased% Or LddendCOL% <> COL_Lreleased% Then
'iwgh then we have a drag/drop event and it is a new one. This will only be reported once. The next time that GetMouseInput is called
' this event is no longer reported
LdragDrop% = true%
LddstartROW% = ROW_Lpressed%
LddstartCOL% = COL_Lpressed%
LddendROW% = ROW_Lreleased%
LddendCOL% = COL_Lreleased%
Ldragging% = false% ' since button was released we are no longer dragging
End If
End If
Else
LdragDrop% = false%
End If
' ------------------------------------------------
' xXXXx XXXXX X X XXXXX XXXXX XXXXx
' X X X XX X X X X X
' X XXX X X X X XXX XXXX'
' X X X X X X X X X X
' 'XXX' XXXXX X 'X X XXXXX X 'X
' ------------------------------------------------
'----------------------------------------------------------------------
' Are we currently dragging the mouse with the CENTER button down ?
'----------------------------------------------------------------------
If ROW_Cpressed% > 0 And COL_Cpressed% > 0 Then ' button is currently pressed
If ROW_Cpressed% <> mouseROW% Or COL_Cpressed% <> mouseCOL% Then ' current mouse location has moved from original location where button was pressed
If ROW_Cpressed% <> ROW_Creleased% Or COL_Cpressed% <> COL_Creleased% Then ' press and release locations are different (ie NOT just a click/double click)
Cdragging% = true% '
End If '
Else
Cdragging% = false% ' will be reset to False% below if operation nas finished
End If
End If
'--------------------------------------------------
' Do we have a new CENTER button drag/drop event?
' (button was released after drag/drop)
'--------------------------------------------------
'FIRST: if ALL variables have a value then we have a click and a release
If ROW_Cpressed% * COL_Cpressed% * ROW_Creleased% * COL_Creleased% > 0 Then
'SECOND: was there movement of the mouse from click to release
If ROW_Cpressed% <> ROW_Creleased% Or COL_Cpressed% <> COL_Creleased% Then
'THIRD: Is this a NEW event (ie start/end row/column has changed from last drag/drop event)?
If CddstartROW% <> ROW_Cpressed% Or CddstartCOL% <> COL_Cpressed% Or CddendROW% <> ROW_Creleased% Or CddendCOL% <> COL_Creleased% Then
'iwgh then we have a drag/drop event and it is a new one. This will only be reported once. The next time that GetMouseInput is called
' this event is no longer reported
CdragDrop% = true%
CddstartROW% = ROW_Cpressed%
CddstartCOL% = COL_Cpressed%
CddendROW% = ROW_Creleased%
CddendCOL% = COL_Creleased%
Cdragging% = false% ' since button was released we are no longer dragging
End If
End If
Else
CdragDrop% = false%
End If
' ----------------------------------------
' XXXXx XXXXX xXXXx X X XXXXX
' X X X X X X X
' XXXX' X X XX XXXXX X
' X X X X X X X X
' X 'X XXXXX 'XXX' X X X
' ----------------------------------------
'----------------------------------------------------------------------
' Are we currently dragging the mouse with the RIGHT button down ?
'----------------------------------------------------------------------
If ROW_Rpressed% > 0 And COL_Rpressed% > 0 Then ' button is currently pressed
If ROW_Rpressed% <> mouseROW% Or COL_Rpressed% <> mouseCOL% Then ' current mouse location has moved from original location where button was pressed
If ROW_Rpressed% <> ROW_Rreleased% Or COL_Rpressed% <> COL_Rreleased% Then ' press and release locations are different (ie NOT just a click/double click)
Rdragging% = true% '
End If '
Else
Rdragging% = false% ' will be reset to False% below if operation nas finished
End If
End If
'--------------------------------------------------
' Do we have a new RIGHT button drag/drop event?
' (button was released after drag/drop)
'--------------------------------------------------
'FIRST: if ALL variables have a value then we have a click and a release
If ROW_Rpressed% * COL_Rpressed% * ROW_Rreleased% * COL_Rreleased% > 0 Then
'SECOND: was there movement of the mouse from click to release
If ROW_Rpressed% <> ROW_Rreleased% Or COL_Rpressed% <> COL_Rreleased% Then
'THIRD: Is this a NEW event (ie start/end row/column has changed from last drag/drop event)?
If RddstartROW% <> ROW_Rpressed% Or RddstartCOL% <> COL_Rpressed% Or RddendROW% <> ROW_Rreleased% Or RddendCOL% <> COL_Rreleased% Then
'iwgh then we have a drag/drop event and it is a new one. This will only be reported once. The next time that GetMouseInput is called
' this event is no longer reported
RdragDrop% = true%
RddstartROW% = ROW_Rpressed%
RddstartCOL% = COL_Rpressed%
RddendROW% = ROW_Rreleased%
RddendCOL% = COL_Rreleased%
Rdragging% = false% ' since button was released we are no longer dragging
End If
End If
Else
RdragDrop% = false%
End If
End Sub
Sub ClickableGFX (tcontrol$)
'Makes loading, unloading, resizing, and management of images easy. It also has a few
'pre-configured images that are resizeable. One of the biggest features is that this
'integrates with GetMouseInput to return that an image was clicked on.
'
'Usage: ClickableGFX (tcontrol$)
'
'tcontrol$ contains variables that control ClickableGFX (case insensitive)
'
' col=xx Upper-left column of where you want the graphic placed.
' row=xx Upper-left row of where you want the graphic placed.
' height=xx Height that you want displayed.
' width=xx Width that you want displayed.
'
'NOTE: The loaded graphic will be resized to fit within the specified height & width dimensions,
' and the aspect ratio is always maintained.
'
' handlenn=name Name and unique handle # for this image where:
' name is a description for clarity only & has no other use.
' nn is a UNIQUE number 1-99 and used to refer to this image.
'
' Imagefile= The full path and name of the image file to be loaded.
'
'
'NOTE: If you are using Grid= and do not include: col= row= height= width=
' then the grid will be centered on the screen.
' If you are not using the Grid= option then the variables
' col= row= height= width= MUST be set.'
'
'
'Loading a new image:
' When loading a new image from a file you must give all of the variables above.
' ex: ClickableGFX "col=55 row=77 height=450 width=475 handle5=NoPic Imagefile=C:\temp\No.JPG"
'
' places the image C:\temp\No.JPG on screen with the upper left location at
' col 55, row 77. It will be resized to 450 high x 475 wide. The name given to
' this handle is NoPic. The UNIQUE handle number that will always refer to it is 5.
' Note that Handle5=NoPic and handle05=nopic are identical.
' Leading zeros does not matter.
'
'
'Releasing a loaded image:
' If you have used the Keep option, you can release a loaded image by simply
' calling it with no other parameters:
'
' ex: ClickableGFX "handle5=NoPic"
'
' This will clear the image handle (if it was saved by Keep) and removes the
' ability for GetMouseInput to respond to clicks for it.
'
' ------------ IMPORTANT !!! ---------------
'IMPORTANT !!! Clearing the screen does not remove the location data of
'images on the screen. You will need to release the image as described
'above, otherwise GetMouseInput could return erroneous information about
'clicking on an image that was not there.
'
'If you reuse the UNIQUE image number, all information about the prior image
'will be replaced by the information about the new image.
' --------------------------------------------
'
'
'-------------------------
' >>> OPTIONS <<<
'-------------------------
'Keep Outline Box Clearall
'LeftArrow RightArrow Hamburger
'OnSwitch OffSwitch
'Grid=nnxnn@xx
'
'Keep
' If you include Keep in the control string then the image will NOT be removed from
' memory. By default every image is removed once it is displayed. This is to
' keep memory usage low. Be careful using Keep as you can easily deplete
' free memory very quickly.
'
' If you use Keep then you can redisplay the image that is still loaded by using
' the control string without having to leload it with Imagefile= again. This will
' make things a bit quicker since you are not waiting for the file to load. To load
' images that were loaded prior using Keep, just refer to the handle that was used
' to load the image (and don't use Imagefile=)
'
' ex:
' ClickableGFX "outline col=500 row=100 height=400 width=400 handle1=Food imagefile="c:\temp\food107.png keep"
' The above will display the image and leave it loaded into memory. When you
' need to redisplay the same image, recall it:
'
' ClickableGFX "outline col=400 row=75 height=200 width=200 handle1=Food"
' The above will take the image that was loaded earlier and display a smaller
' version of it at a different location.
'
'Outline
' If you include Outline in the control string then the image will have a small
' outlined box around the image in the color of the current foreground.
'
'Box
' If you include Box in the control string then a box the color of the current
' foreground will be drawn around the entire grid area
'
'Clearall
' If you include Clearall in the control string then all image data and handles
' will be erased. Rather than issue several command to erase location data
' (for example like when the screen is cleared), this is an easy way to reset
' everything.
' IMPORTANT NOTE: If this is included it has priority and nothing else on the
' command line is processed.
'
'
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Pre-configured Graphics ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'There are several common built-in pre-configured graphics for use with this routine.
' LeftArrow, RightArrow, Hamburger, OnSwitch, OffSwitch, OnButton, OffButton
'
' These graphics do not require a file, which makes placing these images onscreen
' fast and easy.
'
'Loading a pre-configured graphic:
' When using the pre-configured graphic, simply place it's name in the control
' string (no filename is used)
'
' ex:
' ClickableGFX "col=55 row=77 height=20 width=20 handle35=3Lines Hamburger"
'
' Everything is the same as when loading an image file except that the Imagefile=
' is replaced with the pre-configured graphic name: Leftarrow, Rightarrow, or Hamburger.
'
' SIZE: the size of the graphic is determined by the height= and width= values that are
' sent in the control string. Minimum sizes exist and if you go below that then
' the minim values will be loaded and the graphic will be displayed using these
' values.
'
' LEFTARROW and RIGHTARROW: These arrows are basically filled versions of < and >. These
' are useful for situations where the user can click to change values +/-. It is
' also useful when there are many pictures to scroll through - use the left/right so
' the user can click to scroll back and forth through the pictures.
'
' HAMBURGER: The hamburger is the 3 horizontal line graphic that you find on sites where
' you can click to open up options...similar to the gear graphic for settings
'
' ONSWITCH and OFFSWITCH: These are switches that the user can click on to change the
' ON or OFF status. The OnSwitch graphic has a green circle to indicate ON and the
' OffSwitch graphic has a red circle to indicate OFF status.
'
'
'Important !!!!!!
'There is a 'virtual pixel buffer' area that is automatically added to these pre-configured
'graphics for mouse clicks. This is so that you do not have to click exactly on the graphics
'for the mouseclick to be considered as clicking on the graphic.
'This setting is the varible pixelbuffer% that is loaded at the start of this routine and
'is default at 5 pixels.
'
'
'Grid=nnxnn@xx
' This will cause the graphic to be automatically RESIZED and placed at a specific
' position within an onscreen 'grid'. The grid is virtual as there are no lines
' drawn. The grid size and image placement are defined by the nnxnn@xx
'
' nnxnn - this is the size of the grid. You can have up to 99x99
' ex: 5x10 12x12 10x1 1x8
'
' @xx - this is the position within the grid where this image is to be placed.
' The position is determined as you read a book:
' left to right, carriage return, left to right, carriage return, etc.
'
'SAMPLE CODE:
' --- Using the entire screen for the grid ---
' ClickableGFX "grid=3x4@5 handle3=FastCar Imagefile=C:\testpics\79Camaro.JPG"
' places the image C:\testpics\79Camaro.JPG on the screen at a position
' relative to position 5 in the example grid below:
' ex: 1 2 3
' 4 5 6
' 7 8 9
' 10 11 12
'
' In the above sample, the entire screen is used as the grid and the images will be
' loaded in equal grid locations. The aspect ratio is maintained for resized images.
' Due to the resizing of images, it is possible that the right/left or top/bottom
' margins may not be equal.
'
'
' --- Using only PART of the screen for the grid ---
' You may want to limit the grid to a specific portion of the screen. This is
' achieved by adding location and size variables when using the Grid= option:
'
' ClickableGFX "grid=3x4@10 col=800 row=10 height=500 width=400 handle3=FastCar Imagefile=C:\testpics\79Camaro.JPG"
' creates a 500h x 400w(pixels) grid placed at col 800, row 10
' The image C:\testpics\79Camaro.JPG is placed on the screen at a position
' relative to position 10 in the example grid below:
' ex: 1 2 3
' 4 5 6
' 7 8 9
' 10 11 12
' Note: To create the requested grid size you MUST include all of:
' col= row= height= width= grid= handlexx= Imagefile=
'
'
'Is there a fast and easy way to fill the grid?
' YES!
'NOTE: The below sample assumes that image names with path are loaded into tdir$()
'
' 'Load pictures
' tdir$(1) = "c:\temp\snow.jpg"
' tdir$(2) = "c:\temp\stream.jpg"
' tdir$(3) = "c:\temp\rain.jpg"
' etc...
' tdir$(24) = "c:\temp\mountains.jpg"
'
' For x = 1 To 24
' p$ = _Trim$(Str$(x))
' ClickableGFX "grid=4x6@" + p$ + " col=800 row=10 height=500 width=400 Box Outline handle" + p$ + "=" + tdir$(x) + " Imagefile=C:\testpics\" + tdir$(x)
' Next x
'
' this creates a grid 4x6, 500h x 400w, at col 800, row 10
' images are all outlined with a foreground colored thin box
' the entire grid area is also outlined with a foreground colored thin box
' the handle names are handle1 thru handle24 and are placed at location 1-24.
'
' The handle name can be any alphanumeric value.
'
'
'Integration with GetMouseInput
' GetMouseInput automatically integrates with the images placed with ClickableGFX.
' AFTER GetMouseInput the function ClickedImage%() is used to test whether the
' user clicked on am inage. ClickedImage%() will return the UNIQUE handle number of
' the image if a user clicked on it, otherwise it will return false%. The sent data
' to ClickedImage%() is L, C, or R (Left, Center, Right)
'
' GetMouseInput
' if ClickedImage%("L") then Print "User clicked on "; gfxHandle$(ClickedImage%("L"))
'
' This will display the name of the handle of the image that the user clicked.
'
' You can also test to see whether the mouse is hovering over an image with the
' HoverOverImage% function. HoverOverImage% will return the UNIQUE handle number of
' image that the user is hovering over, otherwise it will return false%.
'
' GetMouseInput
' if HoverOverImage% then Print "User hovered over "; gfxHandle$(HoverOverImage%)
'
'The following are shared arrays that store the image location info
'gfxHandle$(9999) name of the image
'gfximage&(9999) image that is loaded into memory only if Keep is used
'gfxLocation%(9999, 4) x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
'
'
'
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ NOTES ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'Stacking:
' You can stack images and BOTH images CAN be recognized if you stack properly.
'
' Scenario: You want to create a program that allows you to scroll through pictures. This
' program will also have a On/Off switch displayed at the top of the picture that allows the
' user to click that will signify that this picture is to be deleted.
'
' Since both ClickedImage% and HoverOverImage% return the first handle that it encounters
' (starting at 1) you will want to put the OnSwitch/OffSwitch graphics at a lower handle
' number than the picture. Place the graphic on top of the picture.
'
' When using ClickedImage% and HoverOverImage% it will return the data when hovering over
' the picture, BUT since OnSwitch/OffSwitch has a lower handle number, it will be returned if
' the mouse pointer is over OnSwitch/OffSwitch, even though you are also over the picture.
'
' Neat, huh?
'
'
'
'If Not MouseEnabled% Then Exit Sub
If MouseDISabled% Then Exit Sub
'set defaults
gfxULrow% = 0
gfxULcol% = 0
gfxHeight% = 0
gfxWidth% = 0
gfxImageNum% = 0
gfxImageFile$ = ""
gfxPreConfigured$ = ""
pixelbuffer% = 5
gfxKeep% = false%
gfxGRIDview% = false%
numPicturesWide% = 0
numPicturesHigh% = 0
gridPlacement% = 0
thandle% = 0
gfxOutline% = false%
gfxBoxAroundGrid% = false%
gfxCLearAll% = false%
LookForMoreVars:
controlFound% = false%
'the leading and trailing spaces are so that we can test each word and invalidate partial words that could trigger it if this word is either at the end or the beginning
'an exmaple of this could be something like: ClickableGFX "col=55 row=77 height=20 width=20 handle35=Hamburger3 c:\temp\hambPIC.JPG"
'
'Above we are loading image c:\temp\hambPIC.JPG and naming the handle Hamburger. If we did not differentiate by requiring the leading/trailing spaces then the handle name
'of Hamburger3 would trigger the optional Hamburger setting...which would be incorrect.
'add a LEADING and a TRAILING space to tControl$
tcontrol$ = " " + _Trim$(tcontrol$) + " "
If Len(tcontrol$) > 0 Then
For x = Len(tcontrol$) To 1 Step -1
'step through 1 character at a time, from right to left, and look for keywords/variables - right-to-left makes sure that keywords are extracted properly
'---------------------------------
'----- Location and size
'---------------------------------
If UCase$(Mid$(tcontrol$, x, 4)) = "ROW=" Then
gfxULrow% = Val(Mid$(tcontrol$, x + 4))
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 4)) = "COL=" Then
gfxULcol% = Val(Mid$(tcontrol$, x + 4))
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 6)) = "WIDTH=" Then
gfxWidth% = Val(Mid$(tcontrol$, x + 6))
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 7)) = "HEIGHT=" Then
gfxHeight% = Val(Mid$(tcontrol$, x + 7))
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
'--------------------------------------
'----- filename of image (optional)
'--------------------------------------
ElseIf UCase$(Mid$(tcontrol$, x, 10)) = "IMAGEFILE=" Then
gfxImageFile$ = Mid$(tcontrol$, x + 10)
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
'---------------------------------
'----- Handle name and Handle #
'---------------------------------
ElseIf UCase$(Mid$(tcontrol$, x, 6)) = "HANDLE" Then
thandle% = 0
thandle$ = ""
'you can have up to 9999 handles (1-9999)
If Mid$(tcontrol$, x + 6 + 4, 1) = "=" Then ' HANDLExx= 2 digit number
If Val(Mid$(tcontrol$, x + 6, 4)) > 0 Then
thandle% = Val(Mid$(tcontrol$, x + 6, 4))
thandle$ = _Trim$(UCase$(Mid$(tcontrol$, x + 11)))
If thandle% < 1 Or thandle$ = "" Then thandle$ = "": thandle% = 0 ' force to be deleted later
End If
ElseIf Mid$(tcontrol$, x + 6 + 3, 1) = "=" Then ' HANDLExx= 2 digit number
If Val(Mid$(tcontrol$, x + 6, 3)) > 0 Then
thandle% = Val(Mid$(tcontrol$, x + 6, 3))
thandle$ = _Trim$(UCase$(Mid$(tcontrol$, x + 10)))
If thandle% < 1 Or thandle$ = "" Then thandle$ = "": thandle% = 0 ' force to be deleted later
End If
ElseIf Mid$(tcontrol$, x + 6 + 2, 1) = "=" Then ' HANDLExx= 2 digit number
If Val(Mid$(tcontrol$, x + 6, 2)) > 0 Then
thandle% = Val(Mid$(tcontrol$, x + 6, 2))
thandle$ = _Trim$(UCase$(Mid$(tcontrol$, x + 9)))
If thandle% < 1 Or thandle$ = "" Then thandle$ = "": thandle% = 0 ' force to be deleted later
End If
ElseIf Mid$(tcontrol$, x + 6 + 1, 1) = "=" Then ' HANDLEx= 1 digit number
If Val(Mid$(tcontrol$, x + 6, 1)) > 0 Then
thandle% = Val(Mid$(tcontrol$, x + 6, 1))
thandle$ = _Trim$(UCase$(Mid$(tcontrol$, x + 8)))
If thandle% < 1 Or thandle$ = "" Then thandle$ = "": thandle% = 0 ' force to be deleted later
End If
End If
'if handle was not assigned properly then delete the handle info and go back to checking
If thandle% < 1 Or thandle$ = "" Then
'no handle # was specified so DELETE current HANDLE data and try again
tcontrol$ = Left$(tcontrol$, x - 1)
'even though a control was NOT found we need to tell the routine to keep checking
controlFound% = true%
Exit For
End If
'iwgh then we have a handle AND we have a handle number assigned
gfxHandle$(thandle%) = thandle$
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
'--------------------------------------------------
'do we want to keep this graphic loaded in memory?
'--------------------------------------------------
ElseIf UCase$(Mid$(tcontrol$, x, 6)) = " KEEP " Then
gfxKeep% = true%
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
'--------------------------------------------------
'do we want to outline each image
'--------------------------------------------------
ElseIf UCase$(Mid$(tcontrol$, x, 9)) = " OUTLINE " Then
gfxOutline% = true%
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
'--------------------------------------------------
'do we want to reset EVERYTHING?
'--------------------------------------------------
ElseIf UCase$(Mid$(tcontrol$, x, 10)) = " CLEARALL " Then
gfxCLearAll% = true%
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
'--------------------------------------------------
'do we want to BOX the outside of the grid
'--------------------------------------------------
ElseIf UCase$(Mid$(tcontrol$, x, 5)) = " BOX " Then
gfxBoxAroundGrid% = true%
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
'--------------------------------------------------
'are we doing grid view?
'--------------------------------------------------
ElseIf UCase$(Mid$(tcontrol$, x, 6)) = " GRID=" Then
' ex: Grid=7x3@14
' create a grid of 7 wide x 3 high and place this pic @ position 14
t$ = Mid$(tcontrol$, x + 6) 'extract data AFTER =
a% = InStr(t$, "x")
If a% = 0 Then ' no x means we cannot do grid so delete this command and continue
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true% ' although we did NOT find a command, this forces up to keep looking for other commands
Exit For
End If
b% = InStr(t$, "@")
If b% = 0 Then ' no @ means we cannot do grid so delete this command and continue
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true% ' although we did NOT find a command, this forces up to keep looking for other commands
Exit For
End If
numPicturesWide% = Val(Left$(t$, a% - 1))
numPicturesHigh% = Val(Mid$(t$, a% + 1, b% - a% - 1))
gridPlacement% = Val(Mid$(t$, b% + 1))
totalPicturesOnScreen% = numPicturesWide% * numPicturesHigh%
'is either x or y invalid -OR- does the placement exceed number of positions?
If numPicturesWide% < 1 Or numPicturesHigh% < 1 Or gridPlacement% < 1 Or (gridPlacement% > totalPicturesOnScreen%) Then
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true% ' although we did NOT find a command, this forces up to keep looking for other commands
Exit For
End If
gfxGRIDview% = true%
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
'--------------------------------------------------
' pre-configured graphics
'--------------------------------------------------
ElseIf UCase$(Mid$(tcontrol$, x, 11)) = " LEFTARROW " Then
gfxPreConfigured$ = "LEFTARROW"
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 12)) = " RIGHTARROW " Then
gfxPreConfigured$ = "RIGHTARROW"
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 11)) = " HAMBURGER " Then
gfxPreConfigured$ = "HAMBURGER"
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 10)) = " ONBUTTON " Then
gfxPreConfigured$ = "ONBUTTON"
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 11)) = " OFFBUTTON " Then
gfxPreConfigured$ = "OFFBUTTON"
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 10)) = " ONSWITCH " Then
gfxPreConfigured$ = "ONSWITCH"
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 11)) = " OFFSWITCH " Then
gfxPreConfigured$ = "OFFSWITCH"
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 11)) = " OFFBUTTON " Then
gfxPreConfigured$ = "OFFBUTTON"
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
ElseIf UCase$(Mid$(tcontrol$, x, 10)) = " ONBUTTON " Then
gfxPreConfigured$ = "ONBUTTON"
tcontrol$ = Left$(tcontrol$, x - 1)
controlFound% = true%
Exit For
End If
Next x
End If
'loop until we have gone through the entire control string and all control parts have been deleted.
'if there is garbage in the string, then it will not be processed. Once we no longer have controlFound% = true% AND
'we are at the beginning we can stop processing because all keywords have been found
If Len(tcontrol$) > 0 And controlFound% GoTo LookForMoreVars
' iwgh then we are done extracting control variables
If gfxCLearAll% Then
For x = 1 To UBound(gfximage&)
If gfximage&(x) <> 0 And gfximage&(x) <> -1 Then
_FreeImage gfximage&(x)
End If
'now delete array data about this handle
ClearGFXdata (x)
gfxHandle$(x) = ""
Next x
Exit Sub
End If
'if no handle name or handle number was sent then exit
If thandle% = 0 Or gfxHandle$(thandle%) = "" GoTo DeleteHandleAndExit
'are we using GRID or a perconfigured graphic?
If gfxPreConfigured$ <> "" GoTo PreConfigured
If gfxGRIDview% GoTo GridView
'if handle was sent with nothing more then we are simply wanting to DELETE it
If gfxHandle$(thandle%) <> "" And (gfxULrow% = 0 Or gfxULcol% = 0) Then
GoTo DeleteHandleAndExit
End If
'------------------------------------------------------------------------------------------------------------------------------
' XXXXx XXXXX xXXXx XXXXx X xXx X X XXXXX XXXXx xXXXx Xx xX XXXXX XXXXX X XXXXX
' X X X X X X X x x X X X X X X X X 'X' X X X X X
' X X X 'XXXx XXXX' X XXXXX X XXX XXXX' X X X X XXX X X XXX
' X X X X X X X X X X X X X X X X X X X X
' XXXX' XXXXX 'XXX' X XXXX X X X X X 'X 'XXX' X X X XXXXX XXXX XXXXX
'------------------------------------------------------------------------------------------------------------------------------
'do we have all data to assign a handle?
If gfxHandle$(thandle%) <> "" Then 'And gfxHeight% > 0 And gfxWidth% > 0 Then
'was a file to load specified ?
If gfxImageFile$ <> "" Then
'YES file to load was specified
If _FileExists(gfxImageFile$) Then
'free image if it is currently loaded - this is a MUST to stop eating memory
UnloadGFXhandle thandle%: ClearGFXdata (thandle%)
gfximage&(thandle%) = _LoadImage(gfxImageFile$)
'Check if image load was successful (exit and delete if not)
If gfximage&(thandle%) = 0 Or gfximage&(thandle%) = -1 Then GoTo DeleteHandleAndExit ' unsuccessful load
'iwgh then the image was loaded successfully
'if a height and width was sent then FORCE image to fit within size
If gfxWidth% > 0 And gfxHeight% > 0 Then
'get size of current IMAGE
hPIC% = _Height(gfximage&(thandle%))
wPIC% = _Width(gfximage&(thandle%))
If hPIC% > 5 And wPIC% > 5 Then ' must be minimum 5 x 5
Hratio! = gfxHeight% / hPIC%
Wratio! = gfxWidth% / wPIC%
If Hratio! <= Wratio! Then
ratio! = Hratio!
Else
ratio! = Wratio!
End If
tWidthForThisPIC% = Int(ratio! * wPIC%) - 1
tHeightForThisPIC% = Int(ratio! * hPIC%) - 1
End If
End If
'if either height OR width was missing then default to full size
If gfxWidth% = 0 Or gfxHeight% = 0 Then
gfxWidth% = _Width(gfximage&(thandle%))
gfxHeight% = _Height(gfximage&(thandle%))
tWidthForThisPIC% = gfxWidth% - 1
tHeightForThisPIC% = gfxHeight% - 1
End If
'x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
'YES, we have enough data
gfxLocation%(thandle%, 1) = gfxULrow%
gfxLocation%(thandle%, 2) = gfxULcol%
gfxLocation%(thandle%, 3) = gfxWidth%
gfxLocation%(thandle%, 4) = gfxHeight%
_PutImage (gfxULcol%, gfxULrow%)-(gfxULcol% + tWidthForThisPIC%, gfxULrow% + tHeightForThisPIC%), gfximage&(thandle%)
If gfxOutline% Then Line (gfxLocation%(thandle%, 2), gfxLocation%(thandle%, 1))-(gfxLocation%(thandle%, 2) + gfxLocation%(thandle%, 3), gfxLocation%(thandle%, 1) + gfxLocation%(thandle%, 4)), , B
'unless explicity told to keep in memory, remove the image from memory
If Not gfxKeep% Then
UnloadGFXhandle thandle%
End If
Exit Sub
End If
Else
'no, file to load was NOT specified
'Check to make sure image is still loaded (exit and delete if not)
If gfximage&(thandle%) = 0 Or gfximage&(thandle%) = -1 GoTo DeleteHandleAndExit ' NOT still loaded
'iwgh then the image is still loaded
'if either height or width is missing then exit and delete
If gfxWidth% = 0 Or gfxHeight% = 0 GoTo DeleteHandleAndExit
'get size of current IMAGE
hPIC% = _Height(gfximage&(thandle%))
wPIC% = _Width(gfximage&(thandle%))
If hPIC% > 5 And wPIC% > 5 Then ' must be minimum 5 x 5
Hratio! = gfxHeight% / hPIC%
Wratio! = gfxWidth% / wPIC%
If Hratio! <= Wratio! Then
ratio! = Hratio!
Else
ratio! = Wratio!
End If
tWidthForThisPIC% = Int(ratio! * wPIC%) - 1
tHeightForThisPIC% = Int(ratio! * hPIC%) - 1
End If
End If
'if either height OR width was missing then default to full size
If gfxWidth% = 0 Or gfxHeight% = 0 Then
gfxWidth% = _Width(gfximage&(thandle%))
gfxHeight% = _Height(gfximage&(thandle%))
tWidthForThisPIC% = gfxWidth% - 1
tHeightForThisPIC% = gfxHeight% - 1
End If
'x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
'YES, we have enough data
gfxLocation%(thandle%, 1) = gfxULrow%
gfxLocation%(thandle%, 2) = gfxULcol%
gfxLocation%(thandle%, 3) = gfxWidth%
gfxLocation%(thandle%, 4) = gfxHeight%
_PutImage (gfxULcol%, gfxULrow%)-(gfxULcol% + tWidthForThisPIC%, gfxULrow% + tHeightForThisPIC%), gfximage&(thandle%)
'we do NOT clear the image since we are doing a _PutImage of an image that is already in memory
Else
'no, we do not have enough data so delete handle
GoTo DeleteHandleAndExit
End If
Exit Sub
'-----------------------------------------------------------------------
' xXXXx XXXXx XXXXX XXXXx X X XXXXX XXXXX X X
' X X X X X X X X X X X X
' X XX XXXX' X X X X X X XXX X X X
' X X X X X X X X X X X X xXx X
' 'XXX' X 'X XXXXX XXXX' X XXXXX XXXXX 'X' 'X'
'-----------------------------------------------------------------------
GridView:
'if placement exceeds defined grid limits then exit
If gridPlacement% > numPicturesWide% * numPicturesHigh% Then Exit Sub
If gfxBoxAroundGrid% Then Line (gfxULcol%, gfxULrow%)-(gfxULcol% + gfxWidth%, gfxULrow% + gfxHeight%), , B
'do we have all data to assign a handle?
If gfxHandle$(thandle%) <> "" Then 'And gfxHeight% > 0 And gfxWidth% > 0 Then
'was a file to load specified ?
If gfxImageFile$ <> "" Then
If _FileExists(gfxImageFile$) Then
'free image if it is currently loaded - this is a MUST to stop eating memory
UnloadGFXhandle thandle%: ClearGFXdata (thandle%)
'load image and make sure it loaded properly
gfximage&(thandle%) = _LoadImage(gfxImageFile$)
If gfximage&(thandle%) = 0 Or gfximage&(thandle%) = -1 GoTo DeleteHandleAndExit ' unsuccessful load - delete and exit
'iwgh then the image was loaded successfully
'if height, width AND row and col was sent then use this width and height to limit the area where we are to put the grid
If gfxWidth% > 0 And gfxHeight% > 0 And gfxULrow% > 0 And gfxULcol% > 0 Then
scrnH% = gfxHeight%
scrnW% = gfxWidth%
gfxULrowOFFSET% = gfxULrow%
gfxULcolOFFSET% = gfxULcol%
Else
'if no size restrictions were sent (row and col) then use the entire screen
scrnH% = _Height(0)
scrnW% = _Width(0)
gfxULrowOFFSET% = 0
gfxULcolOFFSET% = 0
End If
'get FULL size of current IMAGE
hPIC% = _Height(gfximage&(thandle%))
wPIC% = _Width(gfximage&(thandle%))
'get the number of spaces we need. Always 1 more than # of pictures ie: |m|P|m|P|m|
numSpacersWide% = numPicturesWide% + 1
numSpacersHigh% = numPicturesHigh% + 1
'HEIGHT - total pixels allowed for ALL spacers
H_totSpacerUsedPIXELS% = Int(scrnH% * .10) ' 10%
'HEIGHT - pixels used for each spacer
H_pixelsforEachSpacer% = Int(H_totSpacerUsedPIXELS% / numSpacersHigh%)
'HEIGHT - remaining pixels is for ALL pictures
H_whatIsLeftForPictures% = scrnH% - H_totSpacerUsedPIXELS%
'HEIGHT - pixels alloted for each picture
H_maxPictureSize% = Int(H_whatIsLeftForPictures% / (numPicturesHigh%))
'WIDTH - total pixels allowed for ALL spacers
W_totSpacerUsedPIXELS% = Int(scrnW% * .10) ' 10%
'WIDTH - pixels used for each spacer
W_pixelsforEachSpacer% = Int(W_totSpacerUsedPIXELS% / numSpacersWide%)
'WIDTH - remaining pixels is for ALL pictures
W_whatIsLeftForPictures% = scrnW% - W_totSpacerUsedPIXELS%
'WIDTH - pixels alloted for each picture
W_maxPictureSize% = Int(W_whatIsLeftForPictures% / numPicturesWide%)
'get size of current IMAGE
hPIC% = _Height(gfximage&(thandle%))
wPIC% = _Width(gfximage&(thandle%))
If hPIC% > 5 And wPIC% > 5 Then ' must be minimum 5 x 5
Hratio! = H_maxPictureSize% / hPIC%
Wratio! = W_maxPictureSize% / wPIC%
If Hratio! <= Wratio! Then
ratio! = Hratio!
Else
ratio! = Wratio!
End If
tWidthForThisPIC% = Int(ratio! * wPIC%) - 1
tHeightForThisPIC% = Int(ratio! * hPIC%) - 1
End If
'now put the graphic on the screen
rowUpDown% = Int((gridPlacement% - .1) / numPicturesWide%) + 1
colAcross% = gridPlacement% - ((rowUpDown% - 1) * numPicturesWide%)
gfxULrow% = (H_pixelsforEachSpacer% * (rowUpDown%) + ((rowUpDown% - 1) * H_maxPictureSize%))
gfxLRrow% = gfxULrow% + tHeightForThisPIC%
gfxULcol% = (W_pixelsforEachSpacer% * colAcross%) + ((colAcross% - 1) * W_maxPictureSize%)
gfxURcol% = gfxULcol% + tWidthForThisPIC%
'Store location data for GetMouseInput
'x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
gfxLocation%(thandle%, 1) = gfxULrow% + gfxULrowOFFSET%
gfxLocation%(thandle%, 2) = gfxULcol% + gfxULcolOFFSET%
gfxLocation%(thandle%, 3) = tWidthForThisPIC%
gfxLocation%(thandle%, 4) = tHeightForThisPIC%
' A B C C
_PutImage (gfxULcol% + gfxULcolOFFSET%, gfxULrow% + gfxULrowOFFSET%)-(gfxURcol% + gfxULcolOFFSET%, gfxLRrow% + gfxULrowOFFSET%), gfximage&(thandle%)
If gfxOutline% Then Line (gfxLocation%(thandle%, 2), gfxLocation%(thandle%, 1))-(gfxLocation%(thandle%, 2) + gfxLocation%(thandle%, 3), gfxLocation%(thandle%, 1) + gfxLocation%(thandle%, 4)), , B
'unless explicity told to keep in memory, remove the image from memory
If Not gfxKeep% Then
UnloadGFXhandle thandle%
End If
End If
End If
Else
'no, we do not have enough data so delete handle
GoTo DeleteHandleAndExit
End If
Exit Sub
'-------------------------------------------------------------------------------------------------------------------------------------
' XXXXx XXXXx XXXXX xXXXx xXXXx X X XXXXX XXXXX xXXXx xXXXx XXXXx xXx XXXXx X X XXXXX xXXXx xXXXx
' X X X X X X X X X XX X X X X X X X x x X X X X X X X X
' XXXX' XXXX' XXX X X X X X X XXX X X XX X XX XXXX' XXXXX XXXX' XXXXX X X 'XXXx
' X X X X X X X X X X X X X X X X X X X X X X X X X X X X
' X X 'X XXXXX 'XXX' 'XXX' X 'X X XXXXX 'XXX' 'XXX' X 'X X X X X X XXXXX 'XXX' 'XXX'
'-------------------------------------------------------------------------------------------------------------------------------------
PreConfigured:
pixelbuffer% = 0 'no pixelbuffer% for pre-configured buttons - will be reset next time through this routine
'iwgh then we have placement and size data but did not have a filename
'-------------------------------
' ON / Off switches
'-------------------------------
If Right$(gfxPreConfigured$, 6) = "SWITCH" Then ' both ON and OFF switch
'if we do not meet minimum size, then resize
'30W x 15H is minimum size. If not, make it a better size of 55W x 25H
If gfxWidth% < 30 Or gfxHeight% < 15 Then gfxWidth% = 55: gfxHeight% = 25
'outside box
Line (gfxULcol%, gfxULrow%)-(gfxULcol% + gfxWidth%, gfxULrow% + gfxHeight%), , BF
'outermost 'box' that is inside above box
Line (gfxULcol% + 1, gfxULrow% + 1)-(gfxULcol% + gfxWidth% - 1, gfxULrow% + gfxHeight% - 1), _BackgroundColor, B
Line (gfxULcol% + 2, gfxULrow% + 2)-(gfxULcol% + gfxWidth% - 2, gfxULrow% + gfxHeight% - 2), _BackgroundColor, B
'vertical divider line
a% = gfxULcol% + Int(gfxWidth% / 2)
tw% = Int(gfxWidth% / 50)
If tw% < 1 Then tw% = 1
If tw% > 2 Then tw% = 2
Line (a% - 1, gfxULrow% + 2)-(a% + tw%, gfxULrow% + gfxHeight% - tw%), _BackgroundColor, BF
'calculate for ON / OFF
tLEFTcol% = gfxULcol% + Int(gfxWidth% / 4)
tRIGHTcol% = gfxULcol% + (3 * (Int(gfxWidth% / 4)))
trow% = gfxULrow% + Int(gfxHeight% / 2)
If gfxPreConfigured$ = "ONSWITCH" Then
'ON
Paint (tLEFTcol%, trow%), auto256color#(15), _BackgroundColor 'left 1/2 box WHITE
Paint (tRIGHTcol%, trow%), auto256color#(19), _BackgroundColor 'right 1/2 box gray
r% = Int((gfxHeight% * .6) / 2)
Circle (tLEFTcol%, trow%), r%, auto256color#(0) ' black
Paint (tLEFTcol%, trow%), auto256color#(10), auto256color#(0) ' green
Else
'OFF
Paint (tRIGHTcol%, trow%), auto256color#(15), _BackgroundColor 'left 1/2 box GRAY
Paint (tLEFTcol%, trow%), auto256color#(19), _BackgroundColor 'right 1/2 box WHITE
r% = Int((gfxHeight% * .6) / 2)
Circle (tRIGHTcol%, trow%), r%, auto256color#(0) ' black
Paint (tRIGHTcol%, trow%), auto256color#(39), auto256color#(0) ' green
End If
GoTo donePreconfigured
'-------------------------------
' ON / Off buttons
'-------------------------------
ElseIf Right$(gfxPreConfigured$, 6) = "BUTTON" Then ' both ON and OFF bottons
'get largest of the values passed and make them equal
If gfxWidth% < gfxHeight% Then gfxWidth% = gfxHeight%
If gfxHeight% < gfxWidth% Then gfxHeight% = gfxWidth%
'if we do not meet minimum size, then resize
If gfxHeight% < 5 Then gfxHeight% = 10: gfxWidth% = 10
r% = Int(gfxHeight% / 2) ' /2 is because we are doing RADIUS, not diameter
'we need to OFFSET the button right and down since the row/col that was passed refers to the Upper left coordinates
tULcol% = gfxULcol% + r%
tULrow% = gfxULrow% + r%
If gfxPreConfigured$ = "OFFBUTTON" Then
'OFF Button - 2 black circles then 1 gray
CIRCLES tULcol%, tULrow%, r%, auto256color#(0), 0, 0, 0
CIRCLES tULcol%, tULrow%, r% - 1, auto256color#(0), 0, 0, 0
CIRCLES tULcol%, tULrow%, r% - 2, auto256color#(22), 0, 0, 0
Paint (tULcol%, tULrow%), auto256color#(15), auto256color#(22) ' White
Else
'ON button - 2 black circles then 1 White
CIRCLES tULcol%, tULrow%, r%, auto256color#(0), 0, 0, 0
CIRCLES tULcol%, tULrow%, r% - 1, auto256color#(0), 0, 0, 0
CIRCLES tULcol%, tULrow%, r% - 2, auto256color#(30), 0, 0, 0
Paint (tULcol%, tULrow%), auto256color#(18), auto256color#(30) ' gray
End If
GoTo donePreconfigured
'-------------------------------
' LEFT arrow
'-------------------------------
ElseIf gfxPreConfigured$ = "LEFTARROW" Then
tHalfH% = Int(gfxHeight% / 2)
' LINE (column1, row1) - (column2, row2), color, {B|BF}, style%
Line (gfxULcol%, gfxULrow% + tHalfH%)-(gfxULcol% + gfxWidth%, gfxULrow%) ' (left) tip of arrow to top of vertical line
Line -(gfxULcol% + gfxWidth%, gfxULrow% + gfxHeight%) ' vertical line
Line -(gfxULcol%, gfxULrow% + tHalfH%) ' bottom of vertical line to (left) tip of arrow
If gfxWidth% > 1 Then Paint (gfxULcol% + gfxWidth% - 1, gfxULrow% + tHalfH%)
'Now set LARGER area around graphic to be clickable area x,1=UL Row x,2=UL Col x,3=width x,4=height"
GoTo donePreconfigured
'-------------------------------
' RIGHT arrow
'-------------------------------
ElseIf gfxPreConfigured$ = "RIGHTARROW" Then
tHalfH% = Int(gfxHeight% / 2)
' LINE (column1, row1) - (column2, row2), color, {B|BF}, style%
Line (gfxULcol%, gfxULrow%)-(gfxULcol%, gfxULrow% + gfxHeight%) ' vertical line
Line -(gfxULcol% + gfxWidth%, gfxULrow% + tHalfH%)
Line -(gfxULcol%, gfxULrow%)
If gfxWidth% > 1 Then Paint (gfxULcol% + 1, gfxULrow% + tHalfH%)
'Now set LARGER area around graphic to be clickable area x,1=UL Row x,2=UL Col x,3=width x,4=height"
GoTo donePreconfigured
'-------------------------------
' Hamburger
'-------------------------------
ElseIf gfxPreConfigured$ = "HAMBURGER" Then
'default size is 16h x 20w if either row or col=0
If gfxHeight% = 0 Or gfxWidth% = 0 Then gfxHeight% = 16: gfxWidth% = 20
'allowable minimums
If gfxHeight% < 10 Then gfxHeight% = 10
If gfxWidth% < 10 Then gfxWidth% = 10
'default thickness
tHambLineThickness% = 0
If gfxHeight% > 5 Then tHambLineThickness% = 1
If gfxHeight% > 14 Then tHambLineThickness% = 2
If gfxHeight% > 70 Then tHambLineThickness% = 3
If gfxHeight% > 150 Then tHambLineThickness% = 4
tHambLineSpacing% = Int((gfxHeight% - tHambLineThickness%) / 2)
'draw hamburger
Line (gfxULcol%, gfxULrow%)-(gfxULcol% + gfxWidth%, gfxULrow% + tHambLineThickness%), , BF
Line (gfxULcol%, gfxULrow% + tHambLineSpacing%)-(gfxULcol% + gfxWidth%, gfxULrow% + tHambLineSpacing% + tHambLineThickness%), , BF
Line (gfxULcol%, gfxULrow% + tHambLineSpacing% + tHambLineSpacing%)-(gfxULcol% + gfxWidth%, gfxULrow% + tHambLineSpacing% + tHambLineSpacing% + tHambLineThickness%), , BF
'Now set LARGER area around graphic to be clickable area x,1=UL Row x,2=UL Col x,3=width x,4=height"
GoTo donePreconfigured
End If
donePreconfigured:
gfxLocation%(thandle%, 1) = gfxULrow% - pixelbuffer%
gfxLocation%(thandle%, 2) = gfxULcol% - pixelbuffer%
gfxLocation%(thandle%, 3) = gfxWidth% + (2 * pixelbuffer%)
gfxLocation%(thandle%, 4) = gfxHeight% + (2 * pixelbuffer%)
Exit Sub
DeleteHandleAndExit:
UnloadGFXhandle thandle%
ClearGFXdata (thandle%)
gfxHandle$(thandle%) = ""
Exit Sub
End Sub
Sub UnloadGFXhandle (tHandle%)
If gfximage&(tHandle%) <> 0 And gfximage&(tHandle%) <> -1 Then
_FreeImage gfximage&(tHandle%)
gfximage&(tHandle%) = 0
End If
End Sub
Sub ClearGFXdata (tHandle%)
'remove array data about this handle
gfxLocation%(tHandle%, 1) = 0
gfxLocation%(tHandle%, 2) = 0
gfxLocation%(tHandle%, 3) = 0
gfxLocation%(tHandle%, 4) = 0
End Sub
Function ClickedImage% (tButton$)
'This is a supporting routine for GetMouseInput that works with images placed by using
'ClickableGFX.
'
'Integration with ClickableGFX:
' GetMouseInput automatically integrates with the images placed with ClickableGFX.
' AFTER GetMouseInput the function ClickedImage%() is used to test whether the
' user clicked on am inage. ClickedImage%() will return the UNIQUE handle number of
' the image if a user clicked on it, otherwise it will return false%. The sent data
' to ClickedImage%() is L, C, or R (Left, Center, Right)
'
' GetMouseInput
' if ClickedImage%("L") then Print "User clicked on "; gfxHandle$(ClickedImage%("L"))
'
' This will display the name of the handle of the image that the user clicked.
'
' You can also test to see whether the mouse is hovering over an image with the
' HoverOverImage% function. HoverOverImage% will return the UNIQUE handle number of
' the user is hovering over an image otherwise it will return false%.
'
' GetMouseInput
' if HoverOverImage% then Print "User hovered over "; gfxHandle$(HoverOverImage%)
'
'The following are shared arrays that store the image location info
'gfxHandle$(9999) name of the image
'gfximage&(9999) image that is loaded into memory only if Keep is used
'gfxLocation%(9999, 4) x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
tButton$ = UCase$(Left$(_Trim$(tButton$), 1))
If tButton$ = "L" Then
If LbuttonReleased% Then
For img% = 1 To UBound(gfximage&)
If gfxHandle$(img%) <> "" Then
'x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
If MouseX% >= gfxLocation%(img%, 2) And MouseX% <= (gfxLocation%(img%, 2) + gfxLocation%(img%, 3) - 1) Then
If MouseY% >= gfxLocation%(img%, 1) And MouseY% <= (gfxLocation%(img%, 1) + gfxLocation%(img%, 4) - 1) Then
ClickedImage% = img%
Exit Function
End If
End If
End If
Next img%
End If
ElseIf tButton$ = "C" Then
If CbuttonReleased% Then
For img% = 1 To UBound(gfximage&)
If gfxHandle$(img%) <> "" Then
'x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
If MouseX% >= gfxLocation%(img%, 2) And MouseX% <= (gfxLocation%(img%, 2) + gfxLocation%(img%, 3) - 1) Then
If MouseY% >= gfxLocation%(img%, 1) And MouseY% <= (gfxLocation%(img%, 1) + gfxLocation%(img%, 4) - 1) Then
ClickedImage% = img%
Exit Function
End If
End If
End If
Next img%
End If
ElseIf tButton$ = "R" Then
If RbuttonReleased% Then
For img% = 1 To UBound(gfximage&)
If gfxHandle$(img%) <> "" Then
'x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
If MouseX% >= gfxLocation%(img%, 2) And MouseX% <= (gfxLocation%(img%, 2) + gfxLocation%(img%, 3) - 1) Then
If MouseY% >= gfxLocation%(img%, 1) And MouseY% <= (gfxLocation%(img%, 1) + gfxLocation%(img%, 4) - 1) Then
ClickedImage% = img%
Exit Function
End If
End If
End If
Next img%
End If
End If
ClickedImage% = false%
End Function
Function HoverOverImage%
'This is a supporting routine for GetMouseInput that works with images placed by using
'ClickableGFX.
'
'Integration with ClickableGFX:
' GetMouseInput automatically integrates with the images placed with ClickableGFX.
' AFTER GetMouseInput the function ClickedImage%() is used to test whether the
' user clicked on am inage. ClickedImage%() will return the UNIQUE handle number of
' the image if a user clicked on it, otherwise it will return false%. The sent data
' to ClickedImage%() is L, C, or R (Left, Center, Right)
'
' GetMouseInput
' if ClickedImage%("L") then Print "User clicked on "; gfxHandle$(ClickedImage%("L"))
'
' This will display the name of the handle of the image that the user clicked.
'
' You can also test to see whether the mouse is hovering over an image with the
' HoverOverImage% function. HoverOverImage% will return the UNIQUE handle number of
' the user is hovering over an image otherwise it will return false%.
'
' GetMouseInput
' if HoverOverImage% then Print "User hovered over "; gfxHandle$(HoverOverImage%)
'
'The following are shared arrays that store the image location info
'gfxHandle$(9999) name of the image
'gfximage&(9999) image that is loaded into memory only if Keep is used
'gfxLocation%(9999, 4) x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
For img% = 1 To UBound(gfximage&)
If gfxHandle$(img%) <> "" Then
'x,1=UL Row x,2=UL Col x,3=width x,4=height where the array element number x = the handle number (x, 1-3)
If MouseX% >= gfxLocation%(img%, 2) And MouseX% <= (gfxLocation%(img%, 2) + gfxLocation%(img%, 3) - 1) Then
If MouseY% >= gfxLocation%(img%, 1) And MouseY% <= (gfxLocation%(img%, 1) + gfxLocation%(img%, 4) - 1) Then
HoverOverImage% = img%
Exit Function
End If
End If
End If
Next img%
HoverOverImage% = false%
End Function
Sub MouseRoutineSample
'MouseEnabled% = true%
waitEvent% = false%
Screen _NewImage(1024, 800, 32): fore32# = 4278256590: back32# = 4291150038: Color fore32#, back32#: Cls
startTest:
'this is simply s sample routine to give results of what is available with the GetMouseInput sub
i$ = InKey$
If i$ = Chr$(27) Then System
If i$ <> "" Then
If Asc(i$) >= 32 Then
Locate 2, 20: Print i$; " "
End If
End If
If mouseROW% * mouseCOL% > 0 Then Locate mouseROW%, mouseCOL%: Print " "; ' erase
GetMouseInput
R = 1
R = R + 1: Locate R, 5: Print " MouseX%="; MouseX%; Space$(10)
R = R + 1: Locate R, 5: Print " MouseY%="; MouseY%; Space$(10)
R = R + 1: Locate R, 5: Print " mouseROW%="; mouseROW%; Space$(10)
R = R + 1: Locate R, 5: Print " mouseCOL%="; mouseCOL%; Space$(10)
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print " MouseLeftButton%="; MouseLeftButton%; Space$(10)
R = R + 1: Locate R, 5: Print " MouseCenterButton%="; MouseCenterButton%; Space$(10)
R = R + 1: Locate R, 5: Print " MouseRightButton%="; MouseRightButton%; Space$(10)
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print " total number of clicks"; clicks#
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print " CURRENT MouseWheel%="; MouseWheel%; Space$(10)
If MouseWheel% Then tmousewheel% = MouseWheel%
R = R + 1: Locate R, 5: Print " LAST MouseWheel%="; tmousewheel%; Space$(10)
R = R + 1: Locate R, 5: Print ""
If LdoubleClicked# + CdoubleClicked# + RdoubleClicked# > 0 Then
'we DO have a double click
R = R + 1: Locate R, 5: Print " LdoubleClicked#="; LdoubleClicked#; Space$(10): waitEvent% = true%
R = R + 1: Locate R, 5: Print " CdoubleClicked#="; CdoubleClicked#; Space$(10): waitEvent% = true%
R = R + 1: Locate R, 5: Print " RdoubleClicked#="; RdoubleClicked#; Space$(10): waitEvent% = true%
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print " DoubleClickLength#="; DoubleClickLength#; Space$(10)
R = R + 1: Locate R, 5: Print " imageClicked% ="; imageClicked%
Else
'we do NOT have a double click
R = R + 1: Locate R, 5: Print " LdoubleClicked#="; LdoubleClicked#; Space$(50)
R = R + 1: Locate R, 5: Print " CdoubleClicked#="; CdoubleClicked#; Space$(50)
R = R + 1: Locate R, 5: Print " RdoubleClicked#="; RdoubleClicked#; Space$(50)
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print " DoubleClickLength#="; DoubleClickLength#; Space$(10)
R = R + 1: Locate R, 5: Print " imageClicked% ="; imageClicked%
End If
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print "";
If Ldragging% Then
Print "LEFT dragging="; Timer; " "
ElseIf Cdragging% Then
Print "CENTER dragging="; Timer; " "
ElseIf Rdragging% Then
Print "RIGHT dragging="; Timer; " "
Else Print " "
End If
R = R + 1: Locate R, 5: Print "Drag and Drop: ";
If LdragDrop% Then
Print "LEFT button"
R = R + 1: Locate R, 30: Print "From row: "; LddstartROW%; " col: "; LddstartCOL%; Space$(10)
R = R + 1: Locate R, 30: Print " To row: "; LddendROW%; " col: "; LddendCOL%; Space$(10)
R = R + 1: Locate R, 5: Print ""
waitEvent% = true%
ElseIf CdragDrop% Then
Print "CENTER button"
R = R + 1: Locate R, 30: Print "From row: "; CddstartROW%; " col: "; CddstartCOL%; Space$(10)
R = R + 1: Locate R, 30: Print " To row: "; CddendROW%; " col: "; CddendCOL%; Space$(10)
R = R + 1: Locate R, 5: Print ""
waitEvent% = true%
ElseIf RdragDrop% Then
Print "RIGHT button"
R = R + 1: Locate R, 30: Print "From row: "; RddstartROW%; " col: "; RddstartCOL%; Space$(10)
R = R + 1: Locate R, 30: Print " To row: "; RddendROW%; " col: "; RddendCOL%; Space$(10)
R = R + 1: Locate R, 5: Print ""
waitEvent% = true%
Else
Print "none"; Space$(80)
R = R + 1: Locate R, 5: Print Space$(75)
R = R + 1: Locate R, 5: Print Space$(75)
R = R + 1: Locate R, 5: Print Space$(75)
End If
R = R + 1: Locate R, 5: Print ""
tR = R
R = R + 1: Locate R, 5: Print " Last LEFT click was @ row: "; ROW_Lpressed%, "col: "; COL_Lpressed%; Space$(10)
R = R + 1: Locate R, 5: Print " Last LEFT release was @ row: "; ROW_Lreleased%, "col: "; COL_Lreleased%; Space$(10)
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print " Last CENTER click was @ row: "; ROW_Cpressed%, "col: "; COL_Cpressed%; Space$(10)
R = R + 1: Locate R, 5: Print " Last CENTER release was @ row: "; ROW_Creleased%, "col: "; COL_Creleased%; Space$(10)
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print " Last RIGHT click was @ row: "; ROW_Rpressed%, "col: "; COL_Rpressed%; Space$(10)
R = R + 1: Locate R, 5: Print " Last RIGHT release was @ row: "; ROW_Rreleased%, "col: "; COL_Rreleased%; Space$(10)
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print " _Width="; _Width; " _FontWidth="; _FontWidth; " _Width/_FontWidth="; Int(_Width / _FontWidth)
R = R + 1: Locate R, 5: Print " _Height="; _Height; " _FontHeight="; _FontHeight; " _Height/_FontHeight="; Int(_Height / _FontHeight)
R = R + 1: Locate R, 5: Print ""
tR = tR + 1: Locate tR, 60: Print " newest LpressedTIME#(1)="; Int(LpressedTIME#(1)); " "; " oldest LpressedTIME#(2)="; Int(LpressedTIME#(2))
tR = tR + 1: Locate tR, 60: Print "newest LreleasedTIME#(1)="; Int(LreleasedTIME#(1)); " "; "oldest LreleasedTIME#(2)="; Int(LreleasedTIME#(2))
If waitEvent% = true% Then
Color back32#, fore32#
R = R + 1: Locate R, 7: Print " An event occurred that will be reset next time GetMouseInput is called. System has been paused so you can view it. "
R = R + 1: Locate R, 15: Print " Press any key to continue... "
i$ = "": While i$ = "": i$ = InKey$: _Limit 60: Wend
Color fore32#, back32#
R = R - 2: Locate R, 5: Print Space$(150)
R = R + 1: Locate R, 5: Print Space$(150)
waitEvent% = false%
End If
R = R + 1: Locate R, 5: Print ""
R = R + 1: Locate R, 5: Print ""
Locate mouseROW%, mouseCOL%: Print "X";
_Delay .01
GoTo startTest
End Sub
Sub ClickingGFXsample
For C = 1 To 8
Screen _NewImage(100, 100, 32): fore32# = Int(Rnd * (4291150038 - 1 + 1)) + 1: back32# = Int(Rnd * (4291150038 - 1 + 1)) + 1: Color fore32#, back32#: Cls
For x = 1 To 35
Circle (50, 50), x, Int(Rnd * (4291150038 - 1 + 1)) + 1
Next x
_SaveImage "circle" + _Trim$(Str$(C)) + ".JPG"
t = t + 1: tdir$(t) = "circle" + _Trim$(Str$(C)) + ".JPG"
Next C
For sq = 1 To 8
Screen _NewImage(100, 100, 32): fore32# = Int(Rnd * (4291150038 - 1 + 1)) + 1: back32# = Int(Rnd * (4291150038 - 1 + 1)) + 1: Color fore32#, back32#: Cls
For x = 1 To 35
Line (50 - x, 50 - x)-(50 + x, 50 + x), Int(Rnd * (4291150038 - 1 + 1)) + 1, B
Next x
_SaveImage "square" + _Trim$(Str$(sq)) + ".JPG"
t = t + 1: tdir$(t) = "square" + _Trim$(Str$(sq)) + ".JPG"
Next sq
For sqc = 1 To 8
Screen _NewImage(100, 100, 32): fore32# = Int(Rnd * (4291150038 - 1 + 1)) + 1: back32# = Int(Rnd * (4291150038 - 1 + 1)) + 1: Color fore32#, back32#: Cls
For x = 1 To 35
Line (50 - x, 50 - x)-(50 + x, 50 + x), Int(Rnd * (4291150038 - 1 + 1)) + 1, B
Circle (50, 50), x, Int(Rnd * (4291150038 - 1 + 1)) + 1
Next x
_SaveImage "squarecle" + _Trim$(Str$(sqc)) + ".JPG"
t = t + 1: tdir$(t) = "squarecle" + _Trim$(Str$(sqc)) + ".JPG"
Next sqc
Screen _NewImage(1500, 1000, 32): fore32# = 4278256590: back32# = 4291150038: Color fore32#, back32#: Cls
'defaults
true% = (1 = 1)
false% = (1 = 0)
currImage% = 1
tSwitchOn% = true%
tButtonOn% = false%
'MouseEnabled% = true%
startOver:
Locate 2, 100: Print "Image "; currImage%; ": "; tdir$(currImage%)
'display current image
ClickableGFX "outline col=500 row=50 height=800 width=800 handle994=CSC Imagefile=" + tdir$(currImage%)
'display left and right arrows
ClickableGFX "col=400 row=407 height=50 width=20 handle9=LArrow LeftArrow"
ClickableGFX "col=1400 row=407 height=50 width=20 handle10=RArrow RightArrow"
'display on/off switch
If tSwitchOn% Then
ClickableGFX "col=550 row=777 handle222=OFFS OffSwitch" 'only using large # 222 to show that we have lots of handles available (9999)
Else
ClickableGFX "col=550 row=777 handle222=ONS OnSwitch"
End If
'display radio button
If tButtonOn% Then
ClickableGFX "col=625 row=777 handle993=ONB height=20 OnButton" 'only using large # 993 to show that we have lots of handles available (9999)
Else
ClickableGFX "col=625 row=777 handle993=OFFB height=20 Offbutton"
End If
Locate 50, 25: Print "Note the clickable On/Off button --->"
Locate 55, 81: Print "^---- Note the clickable radio button"
Locate 3, 5: Print "Hover over image and note messages above"
Locate 4, 5: Print "Click on image and note messages above"
Locate 60, 20: Print "Press ESC after each demo to move onto the next Press C to clear variables for images (mouseover no longer has any effect)"
i$ = ""
While i$ <> Chr$(27)
_Limit 60
i$ = InKey$: If i$ = Chr$(27) Then Cls: GoTo next1
If UCase$(i$) = "C" Then ClickableGFX "clearall"
GetMouseInput
If ClickedImage%("L") Then Locate 1, 1: Print "CLICKED: "; gfxHandle$(ClickedImage%("L")); " handle "; ClickedImage%("L"); Space$(50)
If HoverOverImage% Then Locate 1, 50: Print "HOVER: "; gfxHandle$(HoverOverImage%); " handle "; HoverOverImage%; Space$(50) Else Locate 1, 1: Print Space$(100)
If ClickedImage%("L") = 222 Then ' did we click on/off switch?
If tSwitchOn% Then
tSwitchOn% = false%
GoTo startOver
Else
tSwitchOn% = true%
GoTo startOver
End If
End If
If ClickedImage%("L") = 993 Then ' did we click radio button?
If tButtonOn% Then
tButtonOn% = false%
'tSwitchOn% = false% 'this would make the switch turn off when the radio button is turned off
GoTo startOver
Else
tButtonOn% = true%
GoTo startOver
End If
End If
If ClickedImage%("L") = 9 Then ' did we click left arrow?
currImage% = currImage% - 1
If currImage% < 1 Then currImage% = 1
GoTo startOver
End If
If ClickedImage%("L") = 10 Then ' did we click right arrow?
currImage% = currImage% + 1
If currImage% > 24 Then currImage% = 24
GoTo startOver
End If
Wend
next1:
ClickableGFX "clearall"
For x = 1 To 24
p$ = _Trim$(Str$(x))
ClickableGFX "outline grid=4x6@" + p$ + " col=800 row=10 height=499 width=400 handle" + p$ + "=" + tdir$(x) + " Imagefile=" + tdir$(x)
Next x
Locate 3, 5: Print "Hover over image and note messages above"
Locate 4, 5: Print "Click on image and note messages above"
Locate 60, 20: Print "Press ESC after each demo to move onto the next Press C to clear variables for images (mouseover no longer has any effect)"
i$ = ""
While i$ <> Chr$(27)
i$ = InKey$: If i$ = Chr$(27) Then Cls: GoTo next2
If UCase$(i$) = "C" Then ClickableGFX "clearall"
GetMouseInput
If ClickedImage%("L") Then Locate 1, 1: Print "CLICKED: "; gfxHandle$(ClickedImage%("L")); " handle "; ClickedImage%("L"); Space$(50)
If HoverOverImage% Then Locate 1, 50: Print "HOVER: "; gfxHandle$(HoverOverImage%); " handle "; HoverOverImage%; Space$(50) Else Locate 1, 1: Print Space$(100)
Wend
next2:
ClickableGFX "clearall"
For x = 1 To 20
p$ = _Trim$(Str$(x))
ClickableGFX "outline grid=5x4@" + p$ + " handle" + p$ + "=" + tdir$(x) + " Imagefile=" + tdir$(x)
Next x
Locate 3, 5: Print "Hover over image and note messages above"
Locate 4, 5: Print "Click on image and note messages above"
Locate 60, 20: Print "Press ESC after each demo to move onto the next Press C to clear variables for images (mouseover no longer has any effect)"
i$ = ""
While i$ <> Chr$(27)
i$ = InKey$: If i$ = Chr$(27) Then Cls: GoTo next3
If UCase$(i$) = "C" Then ClickableGFX "clearall"
GetMouseInput
If ClickedImage%("L") Then Locate 1, 1: Print "CLICKED: "; gfxHandle$(ClickedImage%("L")); " handle "; ClickedImage%("L"); Space$(50)
If HoverOverImage% Then Locate 1, 50: Print "HOVER: "; gfxHandle$(HoverOverImage%); " handle "; HoverOverImage%; Space$(50) Else Locate 1, 1: Print Space$(100)
Wend
next3:
ClickableGFX "clearall"
For x = 1 To 12
p$ = _Trim$(Str$(x))
ClickableGFX "box outline grid=1x12@" + p$ + " col=1200 row=10 height=900 width=100 handle" + p$ + "=" + tdir$(x) + " Imagefile=" + tdir$(x)
Next x
Locate 3, 5: Print "Hover over image and note messages above"
Locate 4, 5: Print "Click on image and note messages above"
Locate 60, 20: Print "Press ESC to EXIT to system Press C to clear variables for images (mouseover no longer has any effect) and start over"
i$ = ""
While i$ = ""
i$ = InKey$
If i$ = Chr$(27) Then System
If UCase$(i$) = "C" Then ClickableGFX "clearall"
GetMouseInput
If ClickedImage%("L") Then Locate 1, 1: Print "CLICKED: "; gfxHandle$(ClickedImage%("L")); " handle "; ClickedImage%("L"); Space$(50)
If HoverOverImage% Then Locate 1, 50: Print "HOVER: "; gfxHandle$(HoverOverImage%); " handle "; HoverOverImage%; Space$(50) Else Locate 1, 1: Print Space$(100)
Wend
Cls
GoTo startOver
End Sub
'CIRCLE.BI
'** Below code was copied from: https://qb64.com/wiki/Alternative-circle-routine.html
'**
'** QB64 replacement CIRCLE command.
'**
'** The CIRCLE command in QB64 has a few issues:
'**
'** - radian end points are not calculate properly when creating arcs
'** - center line to radian end points do not close properly due to previous bug listed
'**
'** This circle command replacement works very similiarly to the native CIRCLE command:
'**
'** SYNTAX: CIRCLES x%, y%, radius!, color~&, start_radian!, end_radian!, aspect_ratio!
'**
'** x% - center X coordinate of circle
'** y% - center Y coordinate of circle
'** radius! - the radius of the circle
'** color~& - the circle's color
'** start_radian! - the radian on circle curcunference to begin drawing at
'** end_radian! - the radian on circle circumference to end drawing at
'** aspect_ratio! - the aspect ratio of the circle
'**
'** NOTE: unlike the native CIRCLE command, all arguments MUST be supplied. For example,
'** with the native command this will draw a perfect circle with the default color,
'** start radian, end radian and aspect ratio:
'**
'** CIRCLE (319, 239), 100
'**
'** To do the same thing with this replacement command you must supply everything:
'**
'** CIRCLES 319, 239, 100, _RGB32(255, 255, 255), 0, 0, 0
'**
'** ACKNOWLEGEMENTS: The FOR/NEXT step formula was was written by Codeguy for Unseen
'** Machine's Visual library EllipseXS command. Specifically:
'** MinStep! = 1 / (2 * 3.1415926535 * Radius!)
'**
'**
'** Includes performance tweaks made by SMcNeill on 02/02/13 - specifically removing a few redundant * -1
'** statements and converting the FOR/NEXT loop to a DO loop for a ~3% increase in performance.
'**
'** Corrected bug in which variables being passed in were being modified and passed back - 02/02/13
'**
Sub CIRCLES (cx%, cy%, r!, c~&, s!, e!, a!)
Dim s%, e%, nx%, ny%, xr!, yr!, st!, en!, asp! ' local variables used
st! = s! ' copy start radian to local variable
en! = e! ' copy end radian to local variable
asp! = a! ' copy aspect ratio to local variable
If asp! <= 0 Then asp! = 1 ' keep aspect ratio between 0 and 4
If asp! > 4 Then asp! = 4
If asp! < 1 Then xr! = r! * asp! * 4 Else xr! = r! ' calculate x/y radius based on aspect ratio
If asp! > 1 Then yr! = r! * asp! Else yr! = r!
If st! < 0 Then s% = -1: st! = -st! ' remember if line needs drawn from center to start radian
If en! < 0 Then e% = -1: en! = -en! ' remember if line needs drawn from center to end radian
If s% Then ' draw line from center to start radian?
nx% = cx% + xr! * Cos(st!) ' yes, compute starting point on circle's circumference
ny% = cy% + yr! * -Sin(st!)
Line (cx%, cy%)-(nx%, ny%), c~& ' draw line from center to radian
End If
If en! <= st! Then en! = en! + 6.2831852 ' come back around to proper location (draw counterclockwise)
stepp! = 0.159154945806 / r!
C! = st! ' cycle from start radian to end radian
Do
nx% = cx% + xr! * Cos(C!) ' compute next point on circle's circumfrerence
ny% = cy% + yr! * -Sin(C!)
PSet (nx%, ny%), c~& ' draw the point
C! = C! + stepp!
Loop Until C! >= en!
If e% Then Line -(cx%, cy%), c~& ' draw line from center to end radian if needed
End Sub
'below functions allow me to have my libraries be color depth agnostic which makes coding so much easier since I don't have to worry about it.
Function color256to32bit# (tcolor%)
'PSEUDO Converts 256 color to 32 bit. - this is STILL a work in progress
If color256#(1) = 0 Then ' only do once to save processing
color256#(0) = 4278190081
color256#(1) = 4278190248: color256#(2) = 4278233088: color256#(3) = 4278233256: color256#(4) = 4289200128: color256#(5) = 4289200296: color256#(6) = 4289221632: color256#(7) = 4289243304
color256#(8) = 4283716692: color256#(9) = 4283716860: color256#(10) = 4283759700: color256#(11) = 4283759868: color256#(12) = 4294726740: color256#(13) = 4294726908: color256#(14) = 4294769748
color256#(15) = 4294769916: color256#(16) = 4278190080: color256#(17) = 4279505940: color256#(18) = 4280295456: color256#(19) = 4281084972: color256#(20) = 4281874488: color256#(21) = 4282664004
color256#(22) = 4283453520: color256#(23) = 4284506208: color256#(24) = 4285558896: color256#(25) = 4286611584: color256#(26) = 4287664272: color256#(27) = 4288716960: color256#(28) = 4290032820
color256#(29) = 4291348680: color256#(30) = 4292927712: color256#(31) = 4294769916: color256#(32) = 4278190332: color256#(33) = 4282384636: color256#(34) = 4286316796: color256#(35) = 4290511100
color256#(36) = 4294705404: color256#(37) = 4294705340: color256#(38) = 4294705276: color256#(39) = 4294705216: color256#(40) = 4294705152: color256#(41) = 4294721536: color256#(42) = 4294736896
color256#(43) = 4294753280: color256#(44) = 4294769664: color256#(45) = 4290575360: color256#(46) = 4286381056: color256#(47) = 4282448896: color256#(48) = 4278254592: color256#(49) = 4278254656
color256#(50) = 4278254716: color256#(51) = 4278254780: color256#(52) = 4278254844: color256#(53) = 4278238460: color256#(54) = 4278222076: color256#(55) = 4278206716: color256#(56) = 4286348540
color256#(57) = 4288445692: color256#(58) = 4290542844: color256#(59) = 4292639996: color256#(60) = 4294737148: color256#(61) = 4294737116: color256#(62) = 4294737084: color256#(63) = 4294737052
color256#(64) = 4294737020: color256#(65) = 4294745212: color256#(66) = 4294753404: color256#(67) = 4294761596: color256#(68) = 4294769788: color256#(69) = 4292672636: color256#(70) = 4290575484
color256#(71) = 4288478332: color256#(72) = 4286381180: color256#(73) = 4286381212: color256#(74) = 4286381244: color256#(75) = 4286381276: color256#(76) = 4286381308: color256#(77) = 4286373116
color256#(78) = 4286364924: color256#(79) = 4286356732: color256#(80) = 4290032892: color256#(81) = 4291081468: color256#(82) = 4292392188: color256#(83) = 4293440764: color256#(84) = 4294751484
color256#(85) = 4294751464: color256#(86) = 4294751448: color256#(87) = 4294751428: color256#(88) = 4294751412: color256#(89) = 4294755508: color256#(90) = 4294760628: color256#(91) = 4294764724
color256#(92) = 4294769844: color256#(93) = 4293459124: color256#(94) = 4292410548: color256#(95) = 4291099828: color256#(96) = 4290051252: color256#(97) = 4290051268: color256#(98) = 4290051288
color256#(99) = 4290051304: color256#(100) = 4290051324: color256#(101) = 4290046204: color256#(102) = 4290042108: color256#(103) = 4290036988: color256#(104) = 4278190192: color256#(105) = 4280025200
color256#(106) = 4281860208: color256#(107) = 4283695216: color256#(108) = 4285530224: color256#(109) = 4285530196: color256#(110) = 4285530168: color256#(111) = 4285530140: color256#(112) = 4285530112
color256#(113) = 4285537280: color256#(114) = 4285544448: color256#(115) = 4285551616: color256#(116) = 4285558784: color256#(117) = 4283723776: color256#(118) = 4281888768: color256#(119) = 4280053760
color256#(120) = 4278218752: color256#(121) = 4278218780: color256#(122) = 4278218808: color256#(123) = 4278218836: color256#(124) = 4278218864: color256#(125) = 4278211696: color256#(126) = 4278204528
color256#(127) = 4278197360: color256#(128) = 4281874544: color256#(129) = 4282660976: color256#(130) = 4283709552: color256#(131) = 4284495984: color256#(132) = 4285544560: color256#(133) = 4285544544
color256#(134) = 4285544532: color256#(135) = 4285544516: color256#(136) = 4285544504: color256#(137) = 4285547576: color256#(138) = 4285551672: color256#(139) = 4285554744: color256#(140) = 4285558840
color256#(141) = 4284510264: color256#(142) = 4283723832: color256#(143) = 4282675256: color256#(144) = 4281888824: color256#(145) = 4281888836: color256#(146) = 4281888852: color256#(147) = 4281888864
color256#(148) = 4281888880: color256#(149) = 4281884784: color256#(150) = 4281881712: color256#(151) = 4281877616: color256#(152) = 4283453552: color256#(153) = 4283977840: color256#(154) = 4284502128
color256#(155) = 4285026416: color256#(156) = 4285550704: color256#(157) = 4285550696: color256#(158) = 4285550688: color256#(159) = 4285550680: color256#(160) = 4285550672: color256#(161) = 4285552720
color256#(162) = 4285554768: color256#(163) = 4285556816: color256#(164) = 4285558864: color256#(165) = 4285034576: color256#(166) = 4284510288: color256#(167) = 4283986000: color256#(168) = 4283461712
color256#(169) = 4283461720: color256#(170) = 4283461728: color256#(171) = 4283461736: color256#(172) = 4283461744: color256#(173) = 4283459696: color256#(174) = 4283457648: color256#(175) = 4283455600
color256#(176) = 4278190144: color256#(177) = 4279238720: color256#(178) = 4280287296: color256#(179) = 4281335872: color256#(180) = 4282384448: color256#(181) = 4282384432: color256#(182) = 4282384416
color256#(183) = 4282384400: color256#(184) = 4282384384: color256#(185) = 4282388480: color256#(186) = 4282392576: color256#(187) = 4282396672: color256#(188) = 4282400768: color256#(189) = 4281352192
color256#(190) = 4280303616: color256#(191) = 4279255040: color256#(192) = 4278206464: color256#(193) = 4278206480: color256#(194) = 4278206496: color256#(195) = 4278206512: color256#(196) = 4278206528
color256#(197) = 4278202432: color256#(198) = 4278198336: color256#(199) = 4278194240: color256#(200) = 4280295488: color256#(201) = 4280819776: color256#(202) = 4281344064: color256#(203) = 4281868352
color256#(204) = 4282392640: color256#(205) = 4282392632: color256#(206) = 4282392624: color256#(207) = 4282392616: color256#(208) = 4282392608: color256#(209) = 4282394656: color256#(210) = 4282396704
color256#(211) = 4282398752: color256#(212) = 4282400800: color256#(213) = 4281876512: color256#(214) = 4281352224: color256#(215) = 4280827936: color256#(216) = 4280303648: color256#(217) = 4280303656
color256#(218) = 4280303664: color256#(219) = 4280303672: color256#(220) = 4280303680: color256#(221) = 4280301632: color256#(222) = 4280299584: color256#(223) = 4280297536: color256#(224) = 4281084992
color256#(225) = 4281347136: color256#(226) = 4281609280: color256#(227) = 4282133568: color256#(228) = 4282395712: color256#(229) = 4282395708: color256#(230) = 4282395700: color256#(231) = 4282395696
color256#(232) = 4282395692: color256#(233) = 4282396716: color256#(234) = 4282397740: color256#(235) = 4282399788: color256#(236) = 4282400812: color256#(237) = 4282138668: color256#(238) = 4281614380
color256#(239) = 4281352236: color256#(240) = 4281090092: color256#(241) = 4281090096: color256#(242) = 4281090100: color256#(243) = 4281090108: color256#(244) = 4281090112: color256#(245) = 4281089088
color256#(246) = 4281087040: color256#(247) = 4281086016: color256#(248) = 4278190080: color256#(249) = 4278190080: color256#(250) = 4278190080: color256#(251) = 4278190080: color256#(252) = 4278190080
color256#(253) = 4278190080: color256#(254) = 4278190080: color256#(255) = 4278190080: color256#(256) = 4278190080
End If
If tcolor% < 0 Or tcolor% > 256 Then
color256to32bit# = 0
Exit Function
End If
color256to32bit# = color256#(tcolor%)
' found online
'Out &H3C7, r%
'r% = Inp(&H3C9)
'g% = Inp(&H3C9)
'b% = Inp(&H3C9)
End Function
Function auto256color# (Sent256%)
If GetColorDepth% = 32 Then
auto256color# = color256to32bit#(Sent256%)
Else
auto256color# = Sent256%
End If
End Function
Function GetColorDepth%
'Returns the current color scheme as 16, 256, or 32
'
' >>> there are no options for this routine <<< '
'
'Below was written by Steve McNeill of qb64phoenix.com and adapted
'Select Case _PixelSize
' Case 4: Locate 1, 1: Print "32-bit color";
' Case 1:
' cu = 0
' For j = 0 To 255
' If _PaletteColor(j) <> &HFF000000 Then cu = cu + 1
' Next
' Select Case cu
' Case Is <= 16: Locate 1, 1: Print "16 color image";
' Case Else: Locate 1, 1: Print "256 color image";
' End Select
'End Select
Select Case _PixelSize
Case 4
GetColorDepth% = 32
Exit Function
Case 1
cu = 0
For j = 0 To 255
If _PaletteColor(j) <> &HFF000000 Then cu = cu + 1
Next
Select Case cu
Case Is <= 16
GetColorDepth% = 16
Exit Function
Case Else
GetColorDepth% = 256
Exit Function
End Select
End Select
Exit Function
End Function
'1...5...10....5...20....5...30....5...40....5...50....5...60....5...70....5...80....5...90....5...00....5...10....5...20
'skipnextline
