Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Formatting the text in a messagebox
Message
 
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Environment versions
Visual FoxPro:
VFP 7 SP1
OS:
Windows XP
Database:
MS SQL Server
Miscellaneous
Thread ID:
00996674
Message ID:
00997158
Views:
35
>Hello everybody,
>
>is it possible to format the text in a messagebox ??
>
>Greetz,
>Hans

Hans Here the code of my function. If You want I can send it to You via eMail.
? GetMessage("This is a very long message, which You could put in the messageBox and it must split it to several different lines. This test not use a fonts",4+32,"Title")
? GetMessage("This is a very long message, which You could put in the messageBox and it must split it to several different lines. This test use a fonts",4+32,"Title","Arial", 12,"BI")



FUNCTION GetMessage(cMessage, nParameters, cTitle, msg_fontn, msg_fonts, msg_style)

   LOCAL oFormMessage
   LOCAL aTextMessage, nColElem, nMaxLen,;
         cFontName, nFontSize, cFontStyle,;
         nLenTitle, nLenMessage,;
         nFormWidth, nFormHeight, nFormTop, nFormLeft,;
         nIndention, nReturn,;
         nTextLeft, cNameLabel, cNameCmd,;
         nTypeButtons, cNameIcon,;
         nTypeDefault, aButtonName,;
         aButtonReturn, aButtonCount,;
         nWidthChar, nHeightChar,;
         nMinButtonWidth, nLenMax, nPos,;
         nIconWidth, nIconHeight,;
         nIconTop, nIconLeft,;
         nGroupButtonWidth, nButtonWidth,;
         nButtonHeight,;
         nGroupButtonTop, nButtonLeft,;
         nButtonOk, nButtonOkCancel,;
         nButtonAbortRetryIgnore,;
         nButtonYesNoCacel, nButtonYesNo,;
         nButtonRetryCancel,;
         oActiveForm, oActiveControl,;
         old_cursor, old_yield

   old_cursor     = SET("CURSOR")

   SET CURSOR OFF
   IF TYPE("_screen.ActiveForm") = "O" .AND. .NOT. ISNULL(_screen.ActiveForm)
      oActiveForm = _screen.ActiveForm
      IF TYPE("oActiveForm.ActiveControl") == "O"
         oActiveControl = oActiveForm.ActiveControl
      ENDIF
   ENDIF
   
   
   DIMENSION aTextMessage[1]
   oFormMessage = SYS(2015)

   nReturn = 0    && Êàêâî äà âðúùà

   nButtonOk               = 0      && Òèï íà áóòîíèòå
   nButtonOkCancel         = 1
   nButtonAbortRetryIgnore = 2
   nButtonYesNoCancel      = 3
   nButtonYesNo            = 4
   nButtonRetryCancel      = 5
   
   nIconStop               = 16     && Âèä íà èêîíàòà
   nIconQuestion           = 32
   nIconExclamation        = 48
   nIconInformation        = 64
   
   nDefaultFirst           = 0      && Êîé áóòîí äà å ïî ïîäðàçáèðàíå
   nDefaultSecond          = 256
   nDefaultThirth          = 512
   
   
   
   cFontName               = IIF(TYPE("msg_fontn") #"C", "Arial", msg_fontn) && Font name Default - Arial
   nFontSize               = IIF(TYPE("msg_fonts") # "N",     10, msg_fonts) && Font size - Default 10
   cFontStyle              = IIF(TYPE("msg_style") # "C",    "N", msg_style) && Font Style - Default Normal

   
   nWidthChar              = FontMetric(6,cFontName,nFontSize, cFontStyle)
   nHeightChar             = FontMetric(2,cFontName,nFontSize, cFontStyle)
   
   nIndention              = ROUND(nHeightChar/2,0)
   
   nMaxLen                 = 0   && Ìàêñèìàëíà ãîëåìèíà íà òåêñòà
   
   nMinButtonWidth         = 80
   
   nParameters             = IIF(TYPE("nParameters") # "N",0,nParameters)

   IF nParameters > nDefaultThirth+nIconInformation+nButtonYesNoCancel
      nParameters          = nDefaultThirth+nIconInformation+nButtonYesNoCancel
   ENDIF

   IF TYPE("cTitle") # "C"
      cTitle = IIF(TYPE("_screen.ActiveForm") = "O" .AND. .NOT.;
                   ISNULL(_screen.ActiveForm),_screen.ActiveForm.Caption,_screen.Caption)
   ENDIF
   
   nLenTitle = MAX(TxtWidth(cTitle,cFontName,nFontSize, cFontStyle),nMaxLen) * nWidthChar
   nColElem = GetStringArray(cMessage,@aTextMessage,@nMaxLen, nIndention, cFontName, nFontSize, cFontStyle)

   DIMENSION aParTextMessage[nColElem,2]
   FOR nPos = 1 TO nColElem
       aParTextMessage[nPos,1] = TxtWidth(aTextMessage[nPos],cFontName,nFontSize, cFontStyle)* nWidthChar
       aParTextMessage[nPos,2] = (nPos-1) * (nHeightChar+ROUND(nIndention/2,0)) + nIndention
   NEXT
   
   nLenMessage = 0
   IF nColElem > 1
      FOR  i = 1 TO nColElem
          nLenMessage = MAX(TxtWidth(aTextMessage[i],cFontName,nFontSize, cFontStyle), nLenMessage)
      NEXT    
   ELSE
      nLenMessage = TxtWidth(cMessage,cFontName,nFontSize, cFontStyle)
   ENDIF
  
   nLenMessage = nLenMessage * nWidthChar
   nTextHeight = (nHeightChar+ROUND(nIndention/2,0))*nColElem + nIndention

   DO CASE
      CASE nParameters >= nDefaultThirth && 3-ÿ áóòîí
           nTypeDefault = 3
           nParameters = nParameters - nDefaultThirth
      CASE nParameters >= nDefaultSecond && 2-ÿ áóòîí
           nTypeDefault = 2
           nParameters = nParameters - nDefaultSecond
   OTHERWISE
           nTypeDefault = 1
   ENDCASE
   
   DO CASE
      CASE nParameters >= nIconInformation
           cIconName = "PICTURES\Info.Ico"
           nParameters = nParameters - nIconInformation
      CASE nParameters >= nIconExclamation
           cIconName = "PICTURES\Exclam.Ico"
           nParameters = nParameters - nIconExclamation
      CASE nParameters >= nIconQuestion
           cIconName = "PICTURES\Question.Ico"
           nParameters = nParameters - nIconQuestion
      CASE nParameters >= nIconStop
           CIconName = "PICTURES\Stop.Ico"
           nParameters = nParameters - nIconStop
   OTHERWISE
           cIconName = "PICTURES\Stop.Ico"
   ENDCASE
   
   nIconWidth  = 32
   nIconHeight = 32
   nIconTop    = nIndention
   nIconLeft   = nIndention
   nTextLeft   = nIconWidth + nIndention * 2

   nButtonCount = 2
   DIMENSION aButtons[3,4]
   DO CASE
      CASE nParameters  >= nButtonRetryCancel
           aButtons[1,1] = "Retry"
           aButtons[1,2] = 4
           aButtons[2,1] = "Cancel"
           aButtons[2,2] = 2
      CASE nParameters  >= nButtonYesNo
           aButtons[1,1] = "Yes"
           aButtons[1,2] = 6
           aButtons[2,1] = "No"
           aButtons[2,2] = 7
      CASE nParameters  >= nButtonYesNoCancel
           nButtonCount  = 3
           aButtons[1,1] = "Yes"
           aButtons[1,2] = 6
           aButtons[2,1] = "No"
           aButtons[2,2] = 7
           aButtons[3,1] = "Cancel"
           aButtons[3,2] = 2
      CASE nParameters  >= nButtonAbortRetryIgnore
           nButtonCount  = 3
           aButtons[1,1] = "Cancel"
           aButtons[1,2] = 3
           aButtons[2,1] = "Retry"
           aButtons[2,2] = 4
           aButtons[3,1] = "Ignore"
           aButtons[3,2] = 5
      CASE nParameters  >= nButtonOkCancel
           aButtons[1,1] = "ÎÊ"
           aButtons[1,2] = 1
           aButtons[2,1] = "Cancel"
           aButtons[2,2] = 2
      CASE nParameters  >= nButtonOk
           nButtonCount  = 1
           aButtons[1,1] = "OK"
           aButtons[1,2] = 1
   ENDCASE
   IF nButtonCount < nTypeDefault
      nTypeDefault = 1
   ENDIF
   
   nLenMax = 0
   FOR nPos = 1 TO nButtonCount
       DO CASE
           CASE nPos = nTypeDefault
                aButtons[nPos,4] = 1
           CASE nPos > nTypeDefault
                aButtons[nPos,4] = nPos - nTypeDefault + 1
           CASE nPos < nTypeDefault
                aButtons[nPos,4] = nButtonCount + nPos - nTypeDefault + 1
       ENDCASE
       nLenMax = MAX(LEN(aButtons[nPos,1]),nLenMax)
   NEXT

   nButtonHeight = nHeightChar + nIndention * 2
   nButtonWidth  = nWidthChar*nLenMax
   IF nButtonWidth < nMinButtonWidth
      nButtonWidth = nMinButtonWidth
   ENDIF
   
   nGroupButtonWidth  = nButtonCount * nButtonWidth

   DO CASE
      CASE (nGroupButtonWidth) => (nLenTitle) .AND.;
           (nGroupButtonWidth) => (nLenMessage+nTextLeft)
           nFormWidth = nGroupButtonWidth
              
      CASE (nLenTitle) => (nGroupButtonWidth) .and.;
           (nLenTitle) => (nLenMessage+nTextLeft)
           nFormWidth = nLenTitle + 5
           
      CASE (nLenMessage+nTextLeft) => (nLenTitle) .AND.;
           (nLenMessage+nTextLeft) => (nGroupButtonWidth)
           nFormWidth = nLenMessage + nTextLeft  && + 5
   ENDCASE
   
   IF nTextHeight > nIconHeight + nIndention*2
      nFormHeight = nTextHeight + nIndention*3 + nButtonHeight
      nButtonTop  = nTextHeight + nIndention*2
   ELSE
      nFormHeight = nIconHeight + nIndention*4 + nButtonHeight
      nButtonTop  = nIconHeight + nIndention*3
   ENDIF
   
   nButtonLeft = ROUND((nFormWidth-nGroupButtonWidth)/2,0)
   FOR nPos = 1 TO nButtonCount
       aButtons[nPos,3] = nButtonLeft+(nPos-1)*(nButtonWidth+nIndention)
   NEXT
   
   nFormTop  = ROUND((_screen.Height-nFormHeight)/2,0)
   nFormLeft = ROUND((_screen.Width-nFormWidth)/2,0)
   
   _screen.MousePointer = 12
   
   &oFormMessage. = CreateObject("Form")
   SET TALK OFF
   WITH &oFormMessage.
        * .BackColor   = RGB(192,192,192)
        .BorderStyle = 2
        .Caption     = cTitle
        .Closable    = .f.
        .ControlBox  = .f.
        .ColorSource = 4
        .AlwaysOnTop = .t.
        .Height      = nFormHeight
        .Width       = nFormWidth+10
        .FontName    = cFontName
        .FontSize    = nFontSize
        .FontBold    = ("B" $ cFontStyle)
        .FontItalic  = ("I" $ cFontStyle)
        .Left        = nFormLeft
        .MaxButton   = .f.
        .MinButton   = .f.
        .Movable     = .t.
        .Top         = nFormTop
        .WindowType  = 1
   ENDWITH
   
   &oFormMessage..AddObject("imgIcon","Image")
   WITH &oFormMessage..imgIcon
        .BackStyle   = 1
        .ColorSource = 4
        .Height      = 32
        .Left        = 5
        .Picture     = cIconName
        .Top         = 5
        .Visible     = .t.
        .Width       = 32
   ENDWITH
   
   FOR nPos = 1 TO nColElem
       cNameLabel = "lbl" + ALLTRIM(STR(nPos))
       WITH &oFormMessage.
            .AddObject(cNameLabel,"Label")
            cNameLabel = "."+cNameLabel
            WITH &cNameLabel
                 * .BackColor = RGB(192,192,192)
                 .Caption    = aTextMessage[nPos]
                 .Height     = nHeightChar + 5
                 .FontName   = cFontName
                 .FontSize   = nFontSize
                 .FontBold   = "B" $ cFontStyle
                 .FontItalic = "I" $ cFontStyle
                 .Left       = nTextLeft
                 .Top        = aParTextMessage[nPos,2]
                 .Width      = aParTextMessage[nPos,1]
                 .Visible    = .t.
            ENDWITH
       ENDWITH
   NEXT
   
   FOR nPos = 1 TO nButtonCount
       cNameCmd = "cmdButtonMessage"+ALLTRIM(STR(nPos))
       WITH &oFormMessage.
            .AddObject(cNameCmd,"cmdButtonMessage")
            cNameCmd = "."+cNameCmd
            WITH &cNameCmd
                 .Caption       = aButtons[nPos,1]
                 .Height        = nButtonHeight
                 .FontName      = cFontName
                 .FontSize      = nFontSize
                 .FontBold   = "B" $ cFontStyle
                 .FontItalic = "I" $ cFontStyle
                 .Left          = aButtons[nPos,3]
                 .TabIndex      = aButtons[nPos,4]
                 .Top           = nButtonTop
                 .Width         = nButtonWidth
                 .nButton       = aButtons[nPos,2]
                 .Visible       = .t.
            ENDWITH
       ENDWITH
   NEXT
   
   DECLARE INTEGER FindWindow      IN WIN32API string  cNull, string cWinName
   DECLARE INTEGER SetActiveWindow IN WIN32API INTEGER hWnd
   DECLARE INTEGER GetClassName    IN WIN32API integer hWnd, string @cClass, integer nMaxBuffer

   old_clos = _screen.Closable
   _screen.Closable = .f.
   WITH &oFormMessage.
        .Show(1)
        nReturn = .Comment
        nReturn = &nReturn
        .Release()
   ENDWITH
   _screen.Closable = old_clos
   clear dlls
   _screen.MousePointer = 0
   IF TYPE("oActiveForm") = "O"
      cFontName = oActiveForm.Name
      IF TYPE(cFontName) # "U"
         ACTIVATE WINDOW &cFontName
      ENDIF
   ENDIF
   SET CURSOR &old_cursor

RETURN nReturn


DEFINE CLASS "cmdButtonMessage" AS "CommandButton"

    BackColor = RGB(192,192,192)
    Caption   = ""
    Height    = 10
    FontBold  = .f.
    Left      = 0
    TabIndex  = 0
    TerminateRead = .t.
    Top = 0
    Visible = .t.
    WIdth = 30
    nButton = 0
    PROCEDURE Click
        this.Parent.Comment = TRANSFORM(this.nButton)
        this.Parent.Hide()
    ENDPROC
    
ENDDEFINE


FUNCTION GetStringArray(cMessage, aArray, nMax, nIndention, cFontName, nFontSize, cFontStyle)

   LOCAL ret_val, n_at,n_part, m1, m_test, m_len, m_partm, m_len1

   cMessage = STRTRAN(cMessage,CHR(10),"")
   ret_val = 0
   n_at = AT(CHR(13),cMessage)
   DO WHILE n_at # 0
      n_part = LEFT(cMessage,n_at-1)
      m_test = n_part
      n_part = ""
      IF TxtWidth(n_part,msg_fontn,msg_fonts) > 100
         DO WHILE TxtWidth(n_part,msg_fontn,msg_fonts) > 100
            ret_val = ret_val + 1
            m_test  = "Rettt"+ALLTRIM(STR(ret_val))
            &m_test = LEFT(n_part,100)
            m_rat   =  RAT(" ",&m_test)
            IF m_rat # 0
               &m_test = LEFT(&m_test,m_rat)
               n_part = SUBSTR(n_part,m_rat+1)
            ELSE
               n_part = SUBSTR(n_part,101)
            ENDIF
            nMax = MAX(nMax,TxtWidth(n_part, cFontName, nFontSize, cFontStyle))        && LEN(&m_test))
         ENDDO
      ENDIF
      ret_val  = ret_val + 1
      m_test   = "Rettt"+ALLTRIM(STR(ret_val))
      &m_test  = n_part
      cMessage = SUBSTR(cMessage,n_at+1)
      n_at     = AT(CHR(13),cMessage)
      nMax     = MAX(nMax,TxtWidth(n_part, cFontName, nFontSize, cFontStyle))   && LEN(n_part))
   ENDDO
   n_part = cMessage
   m_test = n_part
   n_part = ""
   m1     = LEN(m_test)
   n_part = n_part + m_test
   m_test = SUBSTR(m_test, m1+1)

   IF TxtWidth(n_part, cFontName, nFontSize, cFontStyle) > 100
      DO WHILE TxtWidth(n_part, cFontName, nFontSize, cFontStyle) > 100
         ret_val = ret_val + 1
         m_test  = "Rettt"+ALLTRIM(STR(ret_val))
         &m_test = LEFT(n_part,100)
         m_rat   =  RAT(" ",&m_test)
         IF m_rat # 0
            &m_test = LEFT(&m_test,m_rat)
            n_part = SUBSTR(n_part,m_rat+1)
         ELSE
            n_part = SUBSTR(n_part,101)
         ENDIF
         nMax = MAX(nMax,TxtWidth(n_part, cFontName, nFontSize, cFontStyle))   && LEN(&m_test))
      ENDDO
   ENDIF
   ret_val = ret_val + 1
   m_test = "Rettt"+ALLTRIM(STR(ret_val))
   &m_test = n_part
   nMax = MAX(nMax,TxtWidth(n_part, cFontName, nFontSize, cFontStyle))  + nIndention
   DIMENSION aArray[ret_val]
   FOR nPos = 1 TO ret_val
       m_test = "Rettt"+ALLTRIM(STR(nPos))
       aArray[nPos] = &m_test
   NEXT

RETURN ret_val
Against Stupidity the Gods themselves Contend in Vain - Johann Christoph Friedrich von Schiller
The only thing normal about database guys is their tables.
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform