popup message box with 3 or 4 choices

[sandyrepope]

I'd like to have a popup box kinda like msgbox but something that will give the user 3 or 4 choices to choose from and an ok button when one of the choices has been selected. I've been through the help file but couldn't find what I need for this.

The problem is that I don't know if there is a feature that can do this. If someone could tell me what command to use, I think I could figure out how it use it (I think).

Thanks
Sandy

[ErosOlmi]

Sandy,

what do you mean with 3 or 4 choice? You mean checkbox or radiobutton?
In any case a custom dialog must be build and manage like a standard window.
Give me some more info and I will see to do an example.

Eros

[sandyrepope]

What I was thinking of was something like a list of options where the user can click on one and only one. Then the user would click on ok to accept his choice.

Like this list.

Pray
Contribute gold
Ignore
Desecrate

When the user clicks on one then only that one can be chosen. If one option is already chosen and another one is clicked on then the first one is deselected and the clicked on one is selected. Then the ok button is clicked.

I hope this gives you some idea of what I'm trying to ask about.

Thanks
Sandy

[ErosOlmi]

Sandy,

sory, I didn't had much time do add also comments but this can give you a good start.
Function is generic so you can re use in many places. Let me know.



uses "UI"

dim UserOptions as string
dim UserChoose as long

UserOptions = "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"
UserChoose = GetUserOptions(UserOptions)
msgbox 0, "User choice was " & UserChoose & $crlf & _
"Corresponding to: " & PARSE$(UserOptions, ",", UserChoose)


FUNCTION GetUserOptions(sOptions as string) as long
DIM Msg AS LONG
DIM wParam AS LONG
DIM lParam AS LONG
DIM hDlg AS DWORD
dim lResult as long
dim Counter as long
dim OptFirstID as long

local nOptions as long
local sOptionsArray() as string

nOptions = PARSE (sOptions, sOptionsArray, ",")

dim DialogHeight as long
DialogHeight = 20 * nOptions
dim yPos as long

DIALOG NEW 0, "OPTION control test", -1, -1, 150, DialogHeight, %WS_SYSMENU or %ds_center OR %WS_CAPTION TO hDlg

yPos = 6
OptFirstID = 100
for Counter = 1 to nOptions
CONTROL ADD OPTION, hDlg, OptFirstID + Counter, sOptionsArray(Counter), 10, ypos, 100, 14, %WS_TABSTOP or iif(Counter = 1, %WS_GROUP, 0)
yPos += 14
next

yPos += 14
CONTROL ADD BUTTON, hDlg, %IDOK, "OK", 25, yPos, 50, 14, %WS_TABSTOP

'---Set the initial state to OPTION button 3
'CONTROL SET OPTION hDlg, %OPT3, %OPT1, %OPT5

DIALOG SHOW MODELESS hDlg

'---Start the main message loop
WHILE IsWindow(hDlg)

'---Get the message and fill wParam and lParam
Msg = GetMessage(hDlg, wParam, lParam)
SELECT CASE Msg
CASE %WM_COMMAND

'---Test which control has been clicked
SELECT CASE wParam

'---A number was activated
CASE %IDOK
for Counter = 1 to nOptions
CONTROL GET CHECK hDlg, OptFirstID + Counter TO lResult
if lResult = 1 then function = Counter
next

exit while

END SELECT

CASE %WM_SYSCOMMAND

SELECT CASE wParam

CASE %SC_CLOSE
EXIT WHILE


END SELECT

CASE ELSE

END SELECT

WEND

DIALOG END hDlg


END FUNCTION

[sandyrepope]

ErosOlmi, That is exactly what I needed! I'll study your example so that I can understand just how it works.

Thanks
Sandy

[sandyrepope]

I feel that I need to apologize for what follows. I've been trying to use the example in my script but nothing seems to work. I've got it to go up to the place where the dialog end statement gets rid of the window. Then the rest of the script freezes and won't continue.

Can someone offer some advice about how to use the script above inside my script?

Thanks
Sandy

[sandyrepope]

Sorry, I forgot to include this so someone could see what I'm trying to do.

[Michael Hartlef]

Hi Sany,

besides to missing declarations of TYPE_WATER and COLOR_WATER I found that you used the same dialoghandler variable HDLG for the option dialog like for the main dialog. You have use a different one like HDLG2.

I attached the corrected script. I also ran inside this internal SELECT error one time. Problem to test your script is that the point where the option dialog shows up is hard to find. I added also a few more CASE ELSE to your selects. Also I changed the dialog handler variables and message variables from DWORD to LONG as I think that they could be negative values too.

[Michael Hartlef]

Yip, found the Internal error in type SELECT. Report code: SECA9000 error in line 713 again. This is something Eros should look at.

[Petr Schreiber]

Hi,

I am not able to replicate the problem, but I have found some issues in Mikes version of code:

%CR instead of $CR
Dungeon_Level_Change is not declared variable

Rest looks pretty interesting, I am curious how it will evolve.
Just one suggestion - when I am on staircase, 2 messageboxes appear and need me to reply.
What about just adding buttons to the dialog, which would be visible only when on stair case ( like "Up", "Down ") ?
Player would not be forced to click, he can decide only when he really wants to.


Bye,
Petr

[ErosOlmi]

Sandy,

your project seems very interesting. I didn't had time to go through all the code, sorry, but can you please make the suggested changes and post again?
It is important that every window and every window message pump has its own variables. Most important, every wiondo MUST have its own window handler.

A suggestion: make a function to manage the CASE "ALT" instead of inline code.

I've also found an IF without END IF that can bring other problems when parsing. See in CASE "FNT" there is a IF ...


RetCode = msgbox(0,"You've found a fountain with" + Color_Water + "!!!" + %cr + "Do you want a drink?", %mb_yesno)
if RetCode = %idyes then

... that has not corresponding END IF

Than post again your code and I will have a look again.

Ciao
Eros

[sandyrepope]

I'll see what I can do and get back about everything. One thing I guess I really need to do is to make a simple code script to show what I need help with instead of sending the whole script. It is a bit much. From now on I'll try to do that so getting help will be easier.

I do appreciate all the replies.

Thanks
Sandy

[sandyrepope]

In an attempt to keep all that other code from getting in the way I have made a short script to try to see how to use the multi option. This is what I mean:


USES "UI"
%EXITGAME = 1001

DIM hDlg, msg, wParam, lParam AS LONG
%STAY = 2000

'---Create a new dialog
DIALOG NEW 0, "DND", -1, -1, 515, 325, %WS_DLGFRAME OR %DS_CENTER OR %WS_CAPTION OR %WS_SYSMENU, _
0 TO hDlg
' display labels for position in level map
control add frame , hDlg, -1, "You are here...", 300, 5, 169, 163
CONTROL ADD BUTTON, hDlg, %EXITGAME, "Exit game" ,370, 285, 60, 15
control add button, hDlg, %STAY, "Stay", 380, 245, 20, 15

DIALOG SHOW MODELESS hDlg
WHILE IsWindow(hDlg)
'---Get the message and fill wParam and lParam
Msg = GetMessage(hDlg, wParam, lParam)

'---Now test the message
SELECT CASE Msg
CASE %WM_COMMAND
'---Test which control has been clicked
SELECT CASE wParam

CASE %EXITGAME
IF MSGBOX(hDlg, "Are you sure you want to exit the game ?", %MB_YESNO OR %MB_ICONQUESTION, "Question") = %IDYES THEN EXIT WHILE

case %STAY
CALL Pick_Option()
END SELECT

CASE %SC_CLOSE
EXIT WHILE
END SELECT

WEND

DIALOG END hDlg

function Pick_Option()

dim sOptions as string
dim UserChoose as long

sOptions = "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"

DIM Msg AS LONG
DIM wParam AS LONG
DIM lParam AS LONG
DIM hDlg2 AS DWORD
dim lResult as long
dim Counter as long
dim OptFirstID as long

local nOptions as long
local sOptionsArray() as string

nOptions = PARSE (sOptions, sOptionsArray, ",")

dim DialogHeight as long
DialogHeight = 20 * nOptions
dim yPos as long

DIALOG NEW hDlg, "OPTION control test", -1, -1, 150, DialogHeight, %WS_SYSMENU or %ds_center OR %WS_CAPTION TO hDlg2

yPos = 6
OptFirstID = 100
for Counter = 1 to nOptions

CONTROL ADD OPTION, hDlg2, OptFirstID + Counter, sOptionsArray(Counter), 10, ypos, 100, 14, %WS_TABSTOP or iif(Counter = 1, %WS_GROUP, 0)
yPos += 14
next
yPos += 14
CONTROL ADD BUTTON, hDlg2, %IDOK, "OK", 25, yPos, 50, 14, %WS_TABSTOP

'---Set the initial state to OPTION button 3
' CONTROL SET OPTION hDlg, %OPT3, %OPT1, %OPT5
control set option hDlg2, 101, 101, 108
DIALOG SHOW MODELESS hDlg2
'---Start the main message loop
WHILE IsWindow(hDlg2)

'---Get the message and fill wParam and lParam
Msg = GetMessage(hDlg2, wParam, lParam)
SELECT CASE Msg
CASE %WM_COMMAND

'---Test which control has been clicked
SELECT CASE wParam

'---A number was activated
CASE %IDOK
for Counter = 1 to nOptions
CONTROL GET CHECK hDlg2, OptFirstID + Counter TO lResult
if lResult = 1 then function = Counter
next

exit while

END SELECT

CASE %WM_SYSCOMMAND

SELECT CASE wParam

CASE %SC_CLOSE
EXIT WHILE


END SELECT

CASE ELSE

END SELECT

WEND

DIALOG END hDlg2

end function


For some reason it won't work and I can't figure out why. I run it from thinair and it when the main window opens I press the 'stay' button. This brings up the 2nd window with the options in it. I press the ok button and it fails. At first it was closing both windows at the same time. Then I began to get a message that thinbasic had a problem and needed to close.

I think I might be making some kind of simple mistake that I'm just not seeing. Could someone look at it for me?

I'm sorry if I'm driving everyone crazy with this.
Thanks
Sandy

[ErosOlmi]

Sandy,

do not say sorry. We need to thank you because you already found some weird problems that we were able to fix bringing thinBasic to a more stable level.

And I think the problem you are describing in a new real bug I'm trying to figure out.
It seems that when closing the second window, the first message pump get corrupted.
Every window created by UI module has a message queue from which scripts get messages and to which UI module add messages.
The first window queue stop working after the second window release its message queue.

I'm sorry but I need some time to find it.
I will give you back asap.

Thanks again.
Eros

[sandyrepope]

I need some time to find it.

Please take your time. A lot of these things take time to track down and fix. I still have plenty of other areas in my script that need a lot of work.

Thanks,
Sandy

[ErosOlmi]

Sandy,

I've found the problem but need some time to fix because it involve a lot of internal structures.
Problem is related to EXIT WHILE when inside multiple SELECT CASE level.

I have a work-around for your script to let it work.
Inside Pick_Option function add the following variable


dim found as long

Change WHILE loop from


WHILE IsWindow(hDlg2)

to


WHILE IsWindow(hDlg2) and found = %FALSE


Change %IDOK from


CASE %IDOK
for Counter = 1 to nOptions
CONTROL GET CHECK hDlg2, OptFirstID + Counter TO lResult
if lResult = 1 then function = Counter
next
exit while

to


CASE %IDOK
for Counter = 1 to nOptions
CONTROL GET CHECK hDlg2, OptFirstID + Counter TO lResult
if lResult = 1 then function = Counter
next
Found = %TRUE

This will avoid the EXIT WHILE

I will get you back when solved.

Thanks again
Eros

[ErosOlmi]

Pick_Option rewritten in order to avoid EXIT WHILE.



function Pick_Option()

dim sOptions as string "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"
dim UserChoose as long

DIM Msg AS LONG
DIM wParam AS LONG
DIM lParam AS LONG
DIM hDlg2 AS DWORD
dim lResult as long
dim Counter as long
dim OptFirstID as long

local nOptions as long
local sOptionsArray() as string

nOptions = PARSE (sOptions, sOptionsArray, ",")

dim DialogHeight as long
DialogHeight = 20 * nOptions
dim yPos as long

DIALOG NEW hdlg1, "OPTION control test", -1, -1, 150, DialogHeight, %WS_SYSMENU or %ds_center OR %WS_CAPTION TO hDlg2

yPos = 6
OptFirstID = 100
for Counter = 1 to nOptions

CONTROL ADD OPTION, hDlg2, OptFirstID + Counter, sOptionsArray(Counter), 10, ypos, 100, 14, %WS_TABSTOP or iif(Counter = 1, %WS_GROUP, 0)
yPos += 14
next
yPos += 14
CONTROL ADD BUTTON, hDlg2, %IDOK, "OK", 25, yPos, 50, 14, %WS_TABSTOP

'---Set the initial state to OPTION button 3
control set option hDlg2, 101, 101, 108
DIALOG SHOW MODELESS hDlg2
'---Start the main message loop
WHILE IsWindow(hDlg2)

'---Get the message and fill wParam and lParam
Msg = GetMessage(hDlg2, wParam, lParam)
console_writeline str$(hDlg2) & " " & Msg
SELECT CASE Msg
CASE %WM_COMMAND

'---Test which control has been clicked
SELECT CASE wParam

'---OK was pressed so now check which option is active
CASE %IDOK
for Counter = 1 to nOptions
CONTROL GET CHECK hDlg2, OptFirstID + Counter TO lResult
if lResult = 1 then function = Counter
next
DIALOG END hDlg2

END SELECT

CASE %WM_SYSCOMMAND

SELECT CASE wParam

CASE %SC_CLOSE
DIALOG END hDlg2
END SELECT

END SELECT

WEND

end function

[ErosOlmi]

Finally I think I have solved this bug.
I've redefined all internal WHILE/WEND structures. There was a bug in logic in special circumstances.

Fix will be present in next release.

Ciao
Eros

[sandyrepope]

Thanks for trying to make a work around but I'm afraid it doesn't want to work. I used copy and paste and when I tried to run it I got an error that I've never gotten before.

The error code is 18

'Unknown keyword'

in

dim sOptions as string "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"

token found: sOptions

If I made a mistake please feel free to let me know.


USES "UI"
%EXITGAME = 1001

DIM hDlg, msg, wParam, lParam AS LONG
%STAY = 2000

'---Create a new dialog
DIALOG NEW 0, "DND", -1, -1, 515, 325, %WS_DLGFRAME OR %DS_CENTER OR %WS_CAPTION OR %WS_SYSMENU, _
0 TO hDlg
' display labels for position in level map
control add frame , hDlg, -1, "You are here...", 300, 5, 169, 163
CONTROL ADD BUTTON, hDlg, %EXITGAME, "Exit game" ,370, 285, 60, 15
control add button, hDlg, %STAY, "Stay", 380, 245, 20, 15

DIALOG SHOW MODELESS hDlg
WHILE IsWindow(hDlg)
'---Get the message and fill wParam and lParam
Msg = GetMessage(hDlg, wParam, lParam)

'---Now test the message
SELECT CASE Msg
CASE %WM_COMMAND
'---Test which control has been clicked
SELECT CASE wParam

CASE %EXITGAME
IF MSGBOX(hDlg, "Are you sure you want to exit the game ?", %MB_YESNO OR %MB_ICONQUESTION, "Question") = %IDYES THEN EXIT WHILE

case %STAY
CALL Pick_Option()
END SELECT

CASE %SC_CLOSE
EXIT WHILE
END SELECT

WEND

DIALOG END hDlg

function Pick_Option()

dim sOptions as string "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"
dim UserChoose as long

DIM Msg AS LONG
DIM wParam AS LONG
DIM lParam AS LONG
DIM hDlg2 AS DWORD
dim lResult as long
dim Counter as long
dim OptFirstID as long

local nOptions as long
local sOptionsArray() as string

nOptions = PARSE (sOptions, sOptionsArray, ",")

dim DialogHeight as long
DialogHeight = 20 * nOptions
dim yPos as long

DIALOG NEW hdlg1, "OPTION control test", -1, -1, 150, DialogHeight, %WS_SYSMENU or %ds_center OR %WS_CAPTION TO hDlg2

yPos = 6
OptFirstID = 100
for Counter = 1 to nOptions

CONTROL ADD OPTION, hDlg2, OptFirstID + Counter, sOptionsArray(Counter), 10, ypos, 100, 14, %WS_TABSTOP or iif(Counter = 1, %WS_GROUP, 0)
yPos += 14
next
yPos += 14
CONTROL ADD BUTTON, hDlg2, %IDOK, "OK", 25, yPos, 50, 14, %WS_TABSTOP

'---Set the initial state to OPTION button 3
control set option hDlg2, 101, 101, 108
DIALOG SHOW MODELESS hDlg2
'---Start the main message loop
WHILE IsWindow(hDlg2)

'---Get the message and fill wParam and lParam
Msg = GetMessage(hDlg2, wParam, lParam)
console_writeline str$(hDlg2) & " " & Msg
SELECT CASE Msg
CASE %WM_COMMAND

'---Test which control has been clicked
SELECT CASE wParam

'---OK was pressed so now check which option is active
CASE %IDOK
for Counter = 1 to nOptions
CONTROL GET CHECK hDlg2, OptFirstID + Counter TO lResult
if lResult = 1 then function = Counter
next
DIALOG END hDlg2

END SELECT

CASE %WM_SYSCOMMAND

SELECT CASE wParam

CASE %SC_CLOSE
DIALOG END hDlg2
END SELECT

END SELECT

WEND

end function


Have you ever had this error before?
Thanks
Sandy

[sandyrepope]

I need to update my last reply. I've found that if I replace
dim sOptions as string "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"
with
dim sOptions as string
sOptions = "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"
it quits giving me that error.

I did it like this
uses "CONSOLE"
USES "UI"
%EXITGAME = 1001

DIM hDlg, msg, wParam, lParam AS LONG
%STAY = 2000

'---Create a new dialog
DIALOG NEW 0, "DND", -1, -1, 515, 325, %WS_DLGFRAME OR %DS_CENTER OR %WS_CAPTION OR %WS_SYSMENU, _
0 TO hDlg
' display labels for position in level map
control add frame , hDlg, -1, "You are here...", 300, 5, 169, 163
CONTROL ADD BUTTON, hDlg, %EXITGAME, "Exit game" ,370, 285, 60, 15
control add button, hDlg, %STAY, "Stay", 380, 245, 20, 15

DIALOG SHOW MODELESS hDlg
WHILE IsWindow(hDlg)
'---Get the message and fill wParam and lParam
Msg = GetMessage(hDlg, wParam, lParam)

'---Now test the message
SELECT CASE Msg
CASE %WM_COMMAND
'---Test which control has been clicked
SELECT CASE wParam

CASE %EXITGAME
IF MSGBOX(hDlg, "Are you sure you want to exit the game ?", %MB_YESNO OR %MB_ICONQUESTION, "Question") = %IDYES THEN EXIT WHILE

case %STAY
CALL Pick_Option()
END SELECT

CASE %SC_CLOSE
EXIT WHILE
END SELECT

WEND

DIALOG END hDlg

function Pick_Option()

' dim sOptions as string "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"
dim sOptions as string
sOptions = "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"

dim UserChoose as long

DIM Msg AS LONG
DIM wParam AS LONG
DIM lParam AS LONG
DIM hDlg2 AS DWORD
dim lResult as long
dim Counter as long
dim OptFirstID as long

local nOptions as long
local sOptionsArray() as string

nOptions = PARSE (sOptions, sOptionsArray, ",")

dim DialogHeight as long
DialogHeight = 20 * nOptions
dim yPos as long

DIALOG NEW hdlg2, "OPTION control test", -1, -1, 150, DialogHeight, %WS_SYSMENU or %ds_center OR %WS_CAPTION TO hDlg2

yPos = 6
OptFirstID = 100
for Counter = 1 to nOptions

CONTROL ADD OPTION, hDlg2, OptFirstID + Counter, sOptionsArray(Counter), 10, ypos, 100, 14, %WS_TABSTOP or iif(Counter = 1, %WS_GROUP, 0)
yPos += 14
next
yPos += 14
CONTROL ADD BUTTON, hDlg2, %IDOK, "OK", 25, yPos, 50, 14, %WS_TABSTOP

'---Set the initial state to OPTION button 3
control set option hDlg2, 101, 101, 108
DIALOG SHOW MODELESS hDlg2
'---Start the main message loop
WHILE IsWindow(hDlg2)

'---Get the message and fill wParam and lParam
Msg = GetMessage(hDlg2, wParam, lParam)
' console_writeline str$(hDlg2) & " " & Msg
SELECT CASE Msg
CASE %WM_COMMAND

'---Test which control has been clicked
SELECT CASE wParam

'---OK was pressed so now check which option is active
CASE %IDOK
for Counter = 1 to nOptions
CONTROL GET CHECK hDlg2, OptFirstID + Counter TO lResult
if lResult = 1 then function = Counter
next
DIALOG END hDlg2

END SELECT

CASE %WM_SYSCOMMAND

SELECT CASE wParam

CASE %SC_CLOSE
DIALOG END hDlg2
END SELECT

END SELECT

WEND

end function

I still haven't figured out why I was getting an error on the original line though.
Thanks
Sandy

[Michael Hartlef]

I need to update my last reply. I've found that if I replace

dim sOptions as string "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"

with

dim sOptions as string
sOptions = "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"

it quits giving me that error.

I still haven't figured out why I was getting an error on the original line though.
Thanks
Sandy



You were missing the equal sign after STRING.




dim sOptions as string = "Pray,Contribute gold,Ignore,Desecrate,bla bla 1, bla, bla 2, abla abla 3"




... should have worked I guess.

[ErosOlmi]

WHILE/WEND fix will be present in next preview release (other 1/2 days of work).

As Mike suggested, initial value assignement in DIM (http://www.thinbasic.com/public/products/thinBasic/help/html/dim.htm) statement is done using the keyword VALUE or by adding the equal sign.
So correct assignment examples are:


dim MyVAr as string
dim MyVar as string = "abcd"
dim MyVar as string value "abcd"
dim MyVar as string value = "abcd"


Ciao
Eros