Alternative to MessageRequester()
Posted: Tue Sep 09, 2008 12:28 pm
Here is a utility I wrote that offers an alternative to MessageRequester() and is along the style of a GFA Basic (RIP old friend) command I used to use a lot.
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.
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
