This requester is supposed to be simple enough that it can be easily modified. It uses only the PB constants, for input/output, and is supposed to be the size and appearance of the PB requester (less the graphic). May only work on a Mac.
[attention] I have discovered that Windows handles line feeds differently than Mac. On the Mac a line feed is #CR$ and on Windows it is #CRLF$ so the word wrap will not work as written.
Code: Select all
EnableExplicit
; simple message requester with timer function (any platform)
;has timer and default keys that are 'blue'
;has word-wrap
; -size is limited in title To a few lines And (maybe) a dozen lines in the message
;return key activates default button
;only accepts PureBasic MessageRequester constants
; #PB_MessageRequester_Ok
; #PB_MessageRequester_YesNo
; #PB_MessageRequester_YesNoCancel
;procedure returns PureBasic Constants
; #PB_MessageRequester_Yes ; =6
; #PB_MessageRequester_No ; =7
; #PB_MessageRequester_Cancel ; =2
;if you adjust fonts, you may need to adjust font width & height as needed
; -fonts are smaller on the Mac than on Windows
Procedure MessageTimer(title.s, message.s, timeOut.i = 0, mbFlag.i = #PB_MessageRequester_Ok, defaultButton.i = 1)
;version 3 requires pb 5.10b3 1/11/12
Protected cnt,chars,x,text$ ; re-useable variables
Protected fontName.s = "Arial", fontSize.i = 12 ; =message size (Title is +4 bigger)
Protected mbQuit,timerInc,response,defaultButtonText$
Protected wndWidth = 320,wndHeight=200,wndcolor=$EEEEEE
Protected borderwidth,fontwidth,fieldheight,fieldwidth,textwidth,lines
Protected buttonWidth = 80, buttonHeight = 25
Protected buttonleft,buttoncenter, buttonright
Enumeration #PB_Compiler_EnumerationValue ; be careful using this if you define your (ie) gadget constants in some other way than enumeration
#MsgWnd ; otherwise just start the enumeration above all your other constants (like 1000)
#TitleFont
#MessageFont
#TitleField
#MessageField
#OKButton
#NoButton
#CancelButton
#Timer
#ReturnKey
EndEnumeration
If title = "" : title = "Msessage" : EndIf
OpenWindow(#MsgWnd, 0, 0, wndwidth, wndHeight,"", #PB_Window_ScreenCentered|#PB_Window_TitleBar); | #PB_Window_SystemMenu) ; | #PB_Window_Invisible)
SetWindowColor(#MsgWnd,wndColor)
AddKeyboardShortcut(#MsgWnd, #PB_Shortcut_Return, #ReturnKey)
borderwidth=20
LoadFont(#TitleFont,fontname,fontsize+4);,#PB_Font_Bold)
EditorGadget(#TitleField,borderwidth,10,wndwidth-borderwidth-borderwidth,25,#PB_Editor_WordWrap)
SetGadgetAttribute(#TitleField,#PB_Editor_WordWrap,#True) ; EditorGadget word-wrap not working on Mac
SetGadgetFont(#TitleField,FontID(#TitleFont))
SetGadgetColor(#TitleField,#PB_Gadget_BackColor,wndcolor)
;figure how many lines need to resize this string gadget
fontwidth=7 : fieldheight=20 : fieldwidth=GadgetWidth(#TitleField) : textwidth=Len(Title)*fontwidth : lines=(textwidth/fieldwidth)+1
ResizeGadget(#TitleField,#PB_Ignore,#PB_Ignore,#PB_Ignore,fieldheight*lines)
SetGadgetText(#TitleField,Title)
LoadFont(#MessageFont,fontname,fontsize);,#PB_Font_Bold)
EditorGadget(#MessageField,borderwidth,10+GadgetHeight(#TitleField)+10,wndwidth-borderwidth-borderwidth,25,#PB_Editor_WordWrap)
SetGadgetAttribute(#MessageField,#PB_Editor_WordWrap,#True) ; EditorGadget word-wrap not working on Mac
SetGadgetFont(#MessageField,FontID(#MessageFont)) ; EditorGadget word-wrap not working
SetGadgetColor(#MessageField,#PB_Gadget_BackColor,wndcolor)
;figure how many lines need to resize this string gadget
fontwidth=6 : fieldheight=16 : fieldwidth=GadgetWidth(#MessageField)
chars=fieldwidth/fontwidth : textwidth=Len(Message)*fontwidth
lines=0 : cnt=0 ; cnt = number of chars in this line
For x=1 To Len(Message) ; count lines
cnt+1
If Mid(Message,x,1)=#CR$ : cnt=0 : lines+1 : EndIf
If cnt=chars Or x=Len(Message) : lines+1 : cnt=0 : EndIf
Next
ResizeGadget(#MessageField,#PB_Ignore,#PB_Ignore,#PB_Ignore,fieldheight*lines)
SetGadgetText(#MessageField,Message)
wndHeight=10+GadgetHeight(#TitleField)+10+GadgetHeight(#MessageField)+10+25+10
ResizeWindow(#MsgWnd,#PB_Ignore,#PB_Ignore,#PB_Ignore,wndHeight)
fieldwidth=(wndWidth-(buttonwidth*3))/4 ; width between the three buttons and the edges (or 3 buttons 4 spaces)
buttonleft=fieldwidth
buttoncenter=fieldwidth+buttonwidth+fieldwidth
buttonright =fieldwidth+buttonwidth+fieldwidth+buttonwidth+fieldwidth
Select mbFlag
Case #PB_MessageRequester_Ok
;buttons=1
ButtonGadget(#OKButton,buttonright,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"OK",#PB_Button_Default)
defaultButton=#OKButton : defaultButtonText$="OK"
Case #PB_MessageRequester_YesNo
;buttons = 2
If defaultButton=1
ButtonGadget(#OKButton,buttoncenter,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"Yes",#PB_Button_Default)
defaultButton=#OKButton : defaultButtonText$="Yes"
Else
ButtonGadget(#OKButton,buttoncenter,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"Yes")
EndIf
If defaultButton=2
ButtonGadget(#NoButton,buttonright,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"No",#PB_Button_Default)
defaultButton=#NoButton : defaultButtonText$="No"
Else
ButtonGadget(#NoButton,buttonright,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"No")
EndIf
Case #PB_MessageRequester_YesNoCancel
;buttons = 3
If defaultButton=1
ButtonGadget(#OKButton,buttonLeft,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"Yes",#PB_Button_Default)
defaultButton=#OKButton : defaultButtonText$="Yes"
Else
ButtonGadget(#OKButton,buttonLeft,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"Yes")
EndIf
If defaultButton=2
ButtonGadget(#NoButton,buttoncenter,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"No",#PB_Button_Default)
defaultButton=#NoButton : defaultButtonText$="No"
Else
ButtonGadget(#NoButton,buttoncenter,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"No")
EndIf
If defaultButton=3
ButtonGadget(#CancelButton,buttonright,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"Cancel",#PB_Button_Default)
defaultButton=#CancelButton : defaultButtonText$="Cancel"
Else
ButtonGadget(#CancelButton,buttonright,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"Cancel")
EndIf
Default
mbFlag=#PB_MessageRequester_Ok ; wrong value input
ButtonGadget(#OKButton,buttonright,wndheight-10-buttonHeight,buttonwidth,buttonHeight,"OK",#PB_Button_Default) ; same as above
defaultButton=#OKButton : defaultButtonText$="OK"
EndSelect
If timeOut
timeOut * 1000
AddWindowTimer(#MsgWnd, #Timer, 1000)
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_Menu
Select EventMenu()
Case #ReturnKey ; gives default button
mbQuit = defaultButton
EndSelect
Case #PB_Event_CloseWindow
mbQuit = 1
Case #PB_Event_Gadget
Select EventGadget()
Case #OKButton, #NoButton, #CancelButton
Select EventType()
Case #PB_EventType_LeftClick
mbQuit=EventGadget()
EndSelect
EndSelect
Case #PB_Event_Timer
Select EventTimer()
Case #Timer
timerInc + 1000
text$=GetGadgetText(defaultbutton)
SetGadgetText(defaultButton, defaultButtonText$ + " (" + Str((timeOut - timerInc) / 1000) + ")")
If timerInc >= timeOut
RemoveWindowTimer(#MsgWnd, #Timer)
mbQuit = defaultButton
EndIf
EndSelect
EndSelect
Until mbQuit
Select mbQuit
Case #OKButton
response = #PB_MessageRequester_Yes ; =6
Case #NoButton
response = #PB_MessageRequester_No ; =7
Case #CancelButton
response = #PB_MessageRequester_Cancel ; =2
EndSelect
CloseWindow(#msgWnd)
ProcedureReturn response
EndProcedure
; --------- testing code -----------
Define response,text$
; ; simplest requester
MessageTimer("Title area...","This is the simplest requester with timer",5)
;multi-line message with #CR$ s
For response=1 To 5
text$+Str(response)+". This is line of long text will scroll."
If response<5 : text$+#CR$ : EndIf
Next
response=MessageTimer("Title that is very long. Title that is very long. Title that is very long.",Text$,0,#PB_MessageRequester_YesNo,2)
;;message has #CR$ in text
response=MessageTimer("Title a bit longer...","Message is a long line of text with"+#CR$+"two"+#CR$+"line feeds.",7,#PB_MessageRequester_YesNoCancel,3)
text$="from Wikipedia: PureBasic is a commercially distributed procedural computer programming language And integrated development environment based on BASIC And developed by Fantaisie Software For Windows 32/64-bit, Linux 32/64-bit, And Mac OS X. An Amiga version is available, although it has been discontinued And released As open source. The first public release of PureBasic For Windows was on December 17, 2000. It has been continually updated since. PureBasic has a unique lifetime license model."
response=MessageTimer("Title a bit longer...",text$,0,#PB_MessageRequester_YesNoCancel,2)
Select response
Case #PB_MessageRequester_Yes ; =6
Debug "Selected = #PB_MessageRequester_Yes ("+Str(#PB_MessageRequester_Yes)+")"
Case #PB_MessageRequester_No ; =7
Debug "Selected = #PB_MessageRequester_No ("+Str(#PB_MessageRequester_No)+")"
Case #PB_MessageRequester_Cancel ; =2
Debug "Selected = #PB_MessageRequester_Cancel ("+Str(#PB_MessageRequester_Cancel)+")"
EndSelect
; ;original PureBasic to compare to
; MessageRequester("Original PureBasic requester...",text$)