PureBasic Forums - English

Code: Select all

EnableExplicit
; simple message requester with timer function that is supposed to look like the PureBasic version but without the icon
; - only runs on Mac because it uses #CR$ and Windows uses #CRLF$

;default keys are 'blue'
;word-wrap size is limited in title To a few lines And (maybe) a dozen lines in the message
; - see EditorGadget version in 'Tips & Tricks'
;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 change the font/size you may need to adjust the font width and font height variables

Procedure MessageTimer(title.s, message.s, timeOut.i = 0, mbFlag.i = #PB_MessageRequester_Ok, defaultButton.i = 1)
    ;version 2
    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)
        StringGadget(#TitleField,borderwidth,10,wndwidth-borderwidth-borderwidth,25,"",#PB_String_BorderLess)
            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)
            ; put text in new gadet size
            chars=fieldwidth/fontwidth
            x=0 : cnt=0 : text$=""
            For x=1 To Len(Title) ; fill text$ for stringgadget
                If Mid(Title,x,1)=#CR$ : text$+Mid(Title,x-cnt,cnt) : cnt=0 : EndIf
                cnt+1
                If cnt=chars
                    While Mid(Title,x-chars+cnt,1)<>" " ; backup for word-wrap
                        cnt-1
                    Wend
                    text$+Mid(Title,x-chars,cnt)+#CR$ : cnt=chars-cnt
                EndIf
                If x=Len(Title)
                    If cnt>0 : text$+Right(Title,cnt) : EndIf
                EndIf
            Next
            SetGadgetText(#TitleField,text$)

        LoadFont(#MessageFont,fontname,fontsize);,#PB_Font_Bold)
        StringGadget(#MessageField,borderwidth,10+GadgetHeight(#TitleField)+10,wndwidth-borderwidth-borderwidth,25,"",#PB_String_BorderLess)
            SetGadgetFont(#MessageField,FontID(#MessageFont))
            SetGadgetColor(#MessageField,#PB_Gadget_BackColor,wndcolor)
            ;figure how many lines need to resize this string gadget
            fontwidth=6 : fieldheight=20 : 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)
            ; put text in new gadet size
            x=0 : cnt=0 : text$=""
            For x=1 To Len(Message) ; fill text$ for stringgadget
                If Mid(Message,x,1)=#CR$ : text$+Mid(Message,x-cnt,cnt) : cnt=0 : EndIf
                cnt+1
                If cnt=chars
                    While Mid(Message,x-chars+cnt,1)<>" " ; backup for word-wrap
                        cnt-1
                    Wend
                    text$+Mid(Message,x-chars,cnt)+#CR$ : cnt=chars-cnt
                EndIf
                If x=Len(Message)
                    If cnt>0 : text$+Right(Message,cnt) : EndIf
                EndIf
            Next
            SetGadgetText(#MessageField,text$)
            
        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

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$)