Please feel free to use, ignore, laugh at or whatever you wish.
No claims for freedom from bugs, originality, style or anything... it went together in a hurry to meet a need.
Rev2 - 10th September 2008: Allows TAB and RETURN keys to be used for selection.
Rev3 - 14th April 2009: Many bugs removed, now allows Icons and Images to be displayed along with prompts.
Code: Select all
Procedure.w OptionRequester(XPos.w,YPos.w,Title$,Buttons$,MaxButtonW.w=100, hImage.l=0) ;- A GFA style Configurable MessageRequester()
; ==========================================================================
; Function : An alternative to MessageRequester() that allows multiple user defined buttons
; Displays title and optional instructions from Title$. Separate fields with '|'
; Displays a button for each of the options in Buttons$, use '|' separators
; Returns index of button in string 'Buttons$', else...
; Returns 0 if close window 'X' or ESC are pressed.
; Returns negative number if PB failure detected.
; Saves the calling Window's number and re-instates window focus on exit.
; Centres in User's Window/Screen if XPos and YPos are both zero.
; Safe if no caller window.
; Shows all of a long title even when the buttons are short.
; Uses multi row buttons to allw more words
; Displays Icons or Images
; Inputs : 'X' and 'Y' position. Set both to 0 use Window or Screen centre
; Title with optional extension to provide instructions. Use '|' separators
; Button texts with '|' separators. Buttons can be multi-line.
; Optional user specified maximum button width.
; Optional user specified icon/image.
; Return : Button index, base 1, else zero to indicate ESC etc.
; (c)R J Leman 2008, 2009.
; Licence: Do as you like. No warranty of any type.
; ========================================================================
Static SponFont
; Save the number of the calling window.
KeepActiveWindow.l = GetActiveWindow() ; -1 If None
; Specify the font to be used.
If SponFont = 0
SponFont = LoadFont(#PB_Any,"system fixed",10)
EndIf
; Find the number of fields in the title
; Example: Title|Prompt1|Prompt2|Prompt3
NumPrompts.w = CountString(Title$,"|")
;{- Include Icon/Image
ImageX.w = 0 ; Defaults...
ImageY.w = 0
ImageW.w = 0
ImageH.w = 0
; If an Image is specified...
If hImage.l
; If image ID is in range of Windows Icon Handles...
; get the Icon and draw it in an image
If hImage.l >= #IDI_APPLICATION And hImage.l <= #IDI_WINLOGO
mImage.l = CreateImage(#PB_Any,32,32)
StartDrawing(ImageOutput(mImage.l))
FillArea(2,2,#Blue,GetSysColor_(#COLOR_MENU))
DrawImage(LoadIcon_(0, hImage.l),0,0,32,32)
StopDrawing()
hImage.l = mImage.l
EndIf
ImageX.w = 5
ImageY.w = 5
ImageH.w = ImageHeight(hImage.l)
ImageW.w = ImageWidth(hImage.l)
EndIf
;}
; Find number of buttons and width of widest.
; Also, find the button height to allow multi word prompts. (Must have spaces between words.)
NumButs.w = CountString(Buttons$,"|") + 1 ; Count fields
ButW.w = 0 ; Init button width
ButHt.w = 1 ; One row of text
MaxPromptLen.w = 0
MyWin.l = OpenWindow(#PB_Any,1,1,1,1,"",#PB_Window_Invisible) ; Needed for TextWidth() to work
If MyWin.l
If StartDrawing(WindowOutput(MyWin.l))
;{- Find button height for multi rows of text
DrawingFont(FontID(SponFont))
ButHMax.w = 1 ; Default to one row of characters on the button
SpaceWidth.w = TextWidth(" ")/4
For n.w = 1 To NumButs.w ; For each button...
;- Find how many ROWS are needed for this button...
k$ = (Trim(StringField(Buttons$,n.w,"|"))) ; Extract a button's text
ButHt.w = 1 ; There must be a first row.
LeftP.w = 1 ; Start at beginning of button text...
EndP.w = Len(k$) ; Character length of button text
PixLineLen.w = 0
m.w = 0 ; Width of widest row of text, so far.
Repeat ; For each word in the button prompt
RightP.w = FindString(k$," ",LeftP.w) ; Find position of end of word as defined by following space
If RightP.w = 0 ; No position found,
RightP.w = EndP.w + 1 ; so end of word is end of string.
EndIf
Word$ = Mid(k$, LeftP.w, RightP.w - LeftP.w) ; Isolate the word
PixWordWidth.w = TextWidth(Word$ ) + SpaceWidth.w ; Find pixel length + allowance for space
If PixLineLen + PixWordWidth > MaxButtonW-10 ; If adding next word would overflow the button width...
ButHt + 1 ; add another row.
PixLineLen = PixWordWidth + SpaceWidth.w ; Start next row with width of word that would have bust previous row.
Else
PixLineLen + PixWordWidth ; Add word width onto button width
PixLineLen + SpaceWidth ; and a space.
EndIf
If PixLineLen > m.w : m.w = PixLineLen : EndIf ; Keep the widest row.
LeftP.w = RightP + 1
Until LeftP.w >= EndP.w
;- Keep largest number of rows
If ButHt.w > ButHMax.w
ButHMax.w = ButHt.w
EndIf
;- Force a minimum button width
If m.w < 10
m.w = 10
EndIf
;- Keep largest button width
If m.w > ButW.w ; Keep widest button.
ButW.w = m.w + 10
EndIf
Next
;}
;{- Find width of widest prompt... if any.
If NumPrompts.w
For n.w = 2 To NumPrompts.w + 1
k$ = StringField(Title$,n.w,"|")
m.w = TextWidth(k$)
If m.w>MaxPromptLen.w
MaxPromptLen.w = m.w
EndIf
Next
EndIf
;}
PromptHt.w = TextHeight("Ay")
TitleW.w = TextWidth(StringField(Title$,1,"|"))
TitleW.w +(TitleW.w >> 4) + 36 ; Need to find how to get this properly... bold font?
StopDrawing()
Else
ProcedureReturn (-2) ; Graphic error, cannot start drawing
EndIf
CloseWindow(MyWin.l)
Else
ProcedureReturn -1 ; Graphic error, cannot open window
EndIf
ButHMax.w * PromptHt.w
ButHMax.w + 8
;- Calculate window width
w.w = (NumButs.w * ButW.w) + ((NumButs.w - 1) * 5) ; Width of buttons + spaces
WinW.w = w.w
; Correct window width if required for long title
If TitleW.w > WinW.w
WinW.w = TitleW.w
EndIf
; If image plus prompts are wider than window then increase width
If (ImageW.w + MaxPromptLen.w) > WinW.w
WinW.w = ImageW.w + MaxPromptLen.w
EndIf
; If image and prompt both exist then we need an extra margin
If ImageW.w And MaxPromptLen.w
WinW.w + 5
EndIf
; Always a margin left and right
WinW.w + 5 + 5
;- Calculate position of left button
But0X.w = (WinW.w - w.w)/2
;- Calculate window height and Y position for buttons
; Number of prompt rows * text height
WinH.w = (NumPrompts.w * PromptHt.w)
ButY.w = 5
; If image is higher than prompts then use larger of the two
If ImageH.w > WinH.w
WinH.w = ImageH.w
EndIf
; If image or prompts exist then we need an extra margin
; and buttons move down
If WinH.w
WinH.w + 5
ButY.w + WinH.w
EndIf
; Add height of buttons plus margin to window height
WinH.w + 5 + ButHMax.w + 5
;{- Open window for user input
; Work out co-ords of visible Window
WinFlag.l = #PB_Window_TitleBar | #PB_Window_SystemMenu
If (XPos.w=0) And (YPos.w=0) And (KeepActiveWindow.l<>-1) ; If no position and called from a window...
WinFlag.l | #PB_Window_WindowCentered ; centre in current window
OR_Win = OpenWindow(#PB_Any, XPos.w, YPos.w, WinW.w, WinH.w, StringField(Title$,1,"|"),WinFlag.l,WindowID(KeepActiveWindow))
ElseIf (KeepActiveWindow.l<>-1)
OR_Win = OpenWindow(#PB_Any, XPos.w, YPos.w, WinW.w, WinH.w, StringField(Title$,1,"|"),WinFlag.l)
Else
WinFlag.l | #PB_Window_ScreenCentered
OR_Win = OpenWindow(#PB_Any, XPos.w, YPos.w, WinW.w, WinH.w, StringField(Title$,1,"|"),WinFlag.l)
EndIf
If OR_Win = 0
ProcedureReturn -3 :
EndIf
StickyWindow(OR_Win,1) ; Stay on top
AddKeyboardShortcut(OR_Win, #PB_Shortcut_Escape, 100) ; ESC hot key for exit
AddKeyboardShortcut(OR_Win, #PB_Shortcut_Return, 101) ; Return hot key for exit
;}
;- Draw optional Image
If hImage.l ; If Image was specified,
If NumPrompts.w = 0 ; and no prompts specified
ImageX.w =(WinW.w - ImageW.w)/2 ; X position for image is in centre of window
EndIf
ImageGadget(#PB_Any,ImageX,ImageY,0,0,ImageID(hImage.l)) ;Put image in window
EndIf
;{- Draw prompts
x.w = 5 ; Left offset of prompt
If ImageW ; If an image is present...
x.w + ImageW.w + 5 ; Prompts start to it's right, plus and extraf margin
EndIf
y.w = 5 ; Vertical position of first prompt
For n.w = 2 To NumPrompts.w + 1
l.l = TextGadget(#PB_Any,x.w,y.w,WinW.w-10,PromptHt.w,StringField(Title$,n.w,"|"))
SetGadgetFont(l.l,FontID(SponFont))
y.w + PromptHt.w
Next
;}
;{- Draw buttons
; Calculate Y position of buttons
If hImage.l ; If Image used
If y.w < (ImageY + ImageH.w) ; and Image is larger than the text...
y.w = ImageY + ImageH.w
EndIf
y.w + 5
EndIf
x.w = But0X.w ; X Offset of first button
ButNum.w = 6001
For n.w = 1 To NumButs.w ; For each button...
k$ = StringField(Buttons$,n.w,"|")
If k$="" : k$=" " : EndIf ; Swap null string to a space
ButtonGadget(ButNum.w,x.w,ButY.w,ButW.w,ButHMax.w,k$,#PB_Button_MultiLine); draw it...
SetGadgetFont(ButNum.w,FontID(SponFont))
ButNum.w + 1
x.w + ButW.w + 5 ; Adjust left margin
Next
SetActiveGadget(6001)
While WindowEvent() : Wend ; Ensure refresh
;}
;{- Local event manager
Repeat ; Start...
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
If EventWindow() = OR_Win
k.w = 0
Break
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 100 ; ESC key
k.w = 0
Break
Case 101 ; Return key
k.w = GetActiveGadget() - 6000
Break
EndSelect
Case #PB_Event_Gadget
k.w = EventGadget() - 6000 ; Return button index
If (k.w > 0) And (k.w =< NumButs.w)
Break
EndIf
EndSelect
ForEver
;}
;{- Return focus to calling window
If (KeepActiveWindow.l > 0)
SetActiveWindow(KeepActiveWindow.l)
EndIf
;}
; Close Window
RemoveKeyboardShortcut(OR_Win,#PB_Shortcut_All) ; Kill hot keys
CloseWindow(OR_Win)
ProcedureReturn k.w ; Cancel / Key index or negative for internal error
EndProcedure
; ===================================================================================================================
; Tests for MessageRequester
; ==========================
OpenWindow(42,10,10,1000,500,"Test")
Button = ButtonGadget(#PB_Any,20,380,150,50,"Next test")
Text = StringGadget(#PB_Any,20,340,150,25,"Option")
Quit = #False
Test = 0
; Enable one of the following...
; ==============================
; QImage.l = 0
; QImage.l = LoadImage(#PB_Any,"C:\MEMSWORK\SLIDESHO\truck.bmp")
; ResizeImage(QImage,200,150) ; Yes, can be a big image!
; QImage.l = CreateImage(#PB_Any,100,75)
; StartDrawing(ImageOutput(QImage.l))
; FillArea(2,2,#Blue,#Red)
; StopDrawing()
QImage.l = #IDI_EXCLAMATION
; #IDI_HAND ;X - Stop sign icon
; #IDI_QUESTION ;? - Question-mark icon
; #IDI_EXCLAMATION ;! - Exclamation Point icon
; #IDI_ASTERISK ;i - Letter "i" in a circle
; #IDI_WINLOGO ;Windows Logo icon
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
If EventGadget() = Button
Select Test
Case 0 : j = OptionRequester(00,00,"Window Centred|Testy|test|test|test|almost last|last","Tom|Dick|Harry||Use very very very tall buttons here. For Grommit|a|b|c|d",80,QImage.l)
Case 1 : j = OptionRequester(00,00,"One-row buttons if all prompts are short|Do this|Do that|Do the other","Tom|Dick|Harry||Short |a|b|c|d",50,QImage.l)
Case 2 : j = OptionRequester(100,100,"Instructions are optional","T|Dick|Harry||Short |a|b|c|d",50,QImage.l)
Case 3 : j = OptionRequester(100,100,"Long titles and short buttons I","ii",70,QImage.l)
Case 4 : j = OptionRequester(100,100,"Long titles and short buttons II","ii|i|i",70,QImage.l)
Case 5 : j = OptionRequester(100,100,"Long titles and short buttons III","ii|i|iiiiiiii",70,QImage.l)
Case 6 : j = OptionRequester(100,100,"Lots of buttons|Click the number of cabbages you need","1|2|3|4|5|6|7|8|9|10|11|12|13|14",70,QImage.l)
Case 7 : j = OptionRequester(100,100,"Choose a Cow","Ermintrude|Nelly|Jane",100,QImage.l)
Case 8 : j = OptionRequester(100,100,"","Ermintrude|Nelly|Jane",100,QImage.l)
Case 9 : j = OptionRequester(100,100,"Test|A long prompt associated with but a single button","OK",100,QImage.l)
Default
End
EndSelect
SetGadgetText(Text,"Chosen option = "+Str(j))
Test + 1
EndIf
EndSelect
ForEver
