Message Extended

HMG Samples and Enhancements

Moderator: Rathinagiri

Post Reply
User avatar
esgici
Posts: 4543
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Contact:

Message Extended

Post by esgici »

Hi to all

MsgExtended is Freevare HMG Message function.

Test program (MsgExtTest.prg) also demonstrate using
some handy HMG functions and commands.

All bug reports and suggestions are welcome.

Developed under Harbour Compiler and
MINIGUI - Harbour Win32 GUI library (HMG);
compiled and linked by MinGW.

Thanks to "Le Roy" Roberto Lopez.

All modules in the MsgExtended.prg and MExTest.prg
copyrighted : 2008 Bicahi Esgici <esgici@gmail.com>

Regards

esgici


Code: Select all

/*

  MINIGUI - Harbour Win32 GUI library Demo/Sample
 
  Copyright 2002-08 Roberto Lopez <harbourminigui@gmail.com>
 
  MsgExtTest.prg is a Freevare test program for MsgExtended() function.
  Also demonstrate using some handy HMG functions and commands.
  
  All bug reports and suggestions are welcome.
    
  Developed under Harbour Compiler and 
  MINIGUI - Harbour Win32 GUI library (HMG);
  compiled and linked by MinGW. 
  
  Thanks to "Le Roy" Roberto Lopez.
 
  All modules in the MsgExtended.prg and MExTest.prg 
  copyrighted : 2008 Bicahi Esgici <esgici@gmail.com>
 
  History :
  
     2008.08 : First Release
*/


#include <minigui.ch>

#define NTrim( n ) ( LTRIM( STR( n ) ) )

#translate ISNIL(  <xVal> ) => ( <xVal> == NIL )
#translate ISARRY( <xVal> ) => ( VALTYPE( <xVal> ) == "A" )
#translate ISCHAR( <xVal> ) => ( VALTYPE( <xVal> ) == "C" )
#translate ISNUMB( <xVal> ) => ( VALTYPE( <xVal> ) == "N" )

SET PROC TO "MsgExtended.prg" 

PROC Main()                               // Multiple message boxs for testing by sample

   LOCA nParam   :=  0,;
        c1Label  := "",;
        c1LblNam := "",;
        c1txbNam := ""

   SET DATE TO GERM
   SET CENT ON

   PRIV aParNames, aMsgSamples, aSamples

   MakSamples()

   DEFINE WINDOW frmMOptsTest ;
      AT     0,0 ;
      WIDTH  400 ;
      HEIGHT 450 ;
      MAIN       ;
      TITLE  "Tests for f.MsgExtended()"  ;
      ON INIT SetSmpVals( frmMOptsTest.cbxSamples.value )

      ON KEY ESCAPE ACTION frmMOptsTest.Release

      DEFINE COMBOBOX cbxSamples
         ROW 50
         COL 50
         WIDTH   200
         HEIGHT  180
         VALUE   5
         ON CHANGE SetSmpVals( this.value )
         ITEMS  aSamples

      END COMBOBOX // cbxSamples

      DEFINE FRAME fraSamples
          ROW 30
          COL 40
          CAPTION "  Samples "
          WIDTH 220
          HEIGHT 50
      END FRAME // fraSamples

      FOR nParam  := 1 TO LEN( aParNames )

         c1Label  := aParNames[ nParam ]
         c1LblNam := "lbl" + PADL( nParam, 2, "0" )

         DEFINE LABEL &c1LblNam
            ROW        103 + ( nParam - 1 ) * 30
            COL        45
            WIDTH      100
            VALUE      c1Label
            RIGHTALIGN .T.
         END LABEL // &c1LblNam

         c1txbNam := "txb" + PADL( nParam, 2, "0" )

         DEFINE TEXTBOX &c1txbNam
            ROW     100 + ( nParam - 1 ) * 30
            COL     150
            WIDTH   200
            HEIGHT  20
         END TEXTBOX // &c1txbNam

      NEXT nParam

      DEFINE BUTTON btnSampAply
         ROW 50
         COL 300
         WIDTH   40
         HEIGHT  20
         CAPTION 'Apply'
         ACTION  TstSamples( frmMOptsTest.cbxSamples.Value )
      END BUTTON // btnSampAply

      DEFINE FRAME fraParams
          ROW 85
          COL 40
          CAPTION "  Parameters  "
          WIDTH 320
          HEIGHT 315
      END FRAME // fraParams

   END WINDOW // frmMOptsTest

   CENTER WINDOW   frmMOptsTest
   ACTIVATE WINDOW frmMOptsTest

RETU // Main()

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.


PROC MakSamples()                         // Make sample datas for testing f.MsgExtended()

   LOCA nSample  := {},;
        a1MesLn  := {},;
        a1Option := {},;
        x1MesLn,;
        x1Option

   aSamples  := { "Without any parameter",;               //  1
                  "Without title",;                       //  2
                  "Without mesaj",;                       //  3
                  "Only mesaj",;                          //  4
                  "No mesaj, multiple options",;          //  5
                  "Simple message",;                      //  6
                  "Message with expressions - 1",;        //  7
                  "Famous Message",;                      //  8
                  "Two lines, two options",;              //  9
                  "Multiple Options",;                    // 10
                  "Single Line, multiple options",;       // 11
                  "Message with expressions - 2",;        // 12
                  "Different back color - 1",;            // 13
                  "Different back color - 2",;            // 14
                  "Different Font Size" }                 // 15

   aMsgSamples := { {},;                                                            //  1
                    { "Without Title" },;                                           //  2
                    {  , "Without mesaj" },;                                        //  3
                    { "Only one line message", "Only mesaj" },;                     //  4
                    { , "Column Selected", ;
                       {"Sort on this column","Hide Column","Ignore"} },;           //  5
                    { "This is message line", "Simple message", "Ok" },;            //  6
                    { DATE(), "Type is 'D'" },;                                     //  7
                    { "An undeterminable error occured",;                           //  8
                               "Famous Message",;
                               "Abort;;Retry;;Fail;;Ignore;;Cancel" },;
                    { { "Exit command requested",;                                  //  9
                               "Are you sure to quit ?" },;
                               "Two lines, two options",;
                             { "No, Continue",;
                               "Yes, Quit" } },;
                    { { "This file hase been modified.",;                           // 10
                                 "Save it before close ? " },;
                                 "Multiple Options",;
                               { "Save and Close",;
                                 "Close without save",;
                                 "Save, don't Close",;
                                 "Cancel Close Command" } },;
                    { { "Who is your favorite ?" },;                                // 11
                                 "Single Line, multiple options",;
                               { "Bart Simpson",;
                                 "Maradona" ,;
                                 "Don Quichote de La Mancha",;
                                 "C. Rice (Blackwitch)" ,;
                                 "G.W.Bush" } },;
                    { { "Today is:", DTOC(DATE()) + " " + CDOW(DATE()),;            // 12
                                  "90 day before is:",;
                                  DTOC(DATE() - 90) + " " + CDOW(DATE() - 90),;
                                  "2 * 2 = 4 is " + Any2Strg( 2 * 2 = 4 ),;
                                  "2 * 2 = 5 is " + Any2Strg( 2 * 2 = 5 ) },;
                                  "Message with expressions",;
                               { "Ok", "What is the matter?" } } }

   AADD( aMsgSamples, ACLONE( aMsgSamples[ 10 ] ) )                                 // 13
   aMsgSamples[ 13, 2 ] := "Different back color - 1"
   AADD( aMsgSamples[ 13 ], { 201, 215, 228 }  )  // grayed blue

   AADD( aMsgSamples, ACLONE( aMsgSamples[ 10 ] ) )                                 // 14
   aMsgSamples[ 14, 2 ] := "Different back color - 2"
   AADD( aMsgSamples[ 14 ], { 24, 240, 223 } )    // pastel turkuaz

   AADD( aMsgSamples, ACLONE( aMsgSamples[ 9 ] ) )                                  // 15
   aMsgSamples[ 15, 2 ] := "Different Font Size"
   AADD( aMsgSamples[ 15 ], NIL )  // Back color: default
   AADD( aMsgSamples[ 15 ], NIL )  // Message Font name: default
   AADD( aMsgSamples[ 15 ], 11 )   // Message Font Size
   AADD( aMsgSamples[ 15 ], NIL )  // Message Font color: default
   AADD( aMsgSamples[ 15 ], NIL )  // Opts. Font name: default
   AADD( aMsgSamples[ 15 ], 9)     // Opts. Font size
   AADD( aMsgSamples[ 15 ], { 0,8 } )    // Position


   FOR nSample := 1 TO LEN( aMsgSamples )

      IF !EMPTY( aMsgSamples[ nSample ] )

         x1MesLn  := aMsgSamples[ nSample, 1 ]

         IF !ISARRY( x1MesLn )                           // If isn't convert to array
            x1MesLn := { Any2Strg( x1MesLn )  }
         ENDIF

         a1MesLn := ParsArStr( x1MesLn  )                // CRLF Evaluation for Messages lines

         x1MesLn := ACLONE( a1MesLn )
         a1MesLn := {}

         a1MesLn := ParsArStr( x1MesLn, ";;" )        // Double Semicolon Evaluation for Messages lines

         aMsgSamples[ nSample, 1 ] := a1MesLn

      ENDIF !EMPTY( aMsgSamples[ nSample ]

      IF LEN( aMsgSamples[ nSample ] ) > 2

         x1Option := aMsgSamples[ nSample, 3 ]

         IF !ISARRY( x1Option )                           // If isn't convert to array
            x1Option := { Any2Strg( x1Option )  }
         ENDIF

         a1Option := ParsArStr( x1Option )                // CRLF Evaluation for Options

         x1Option := ACLONE( a1Option )
         a1Option := {}

         a1Option := ParsArStr( x1Option, ";;" )       // Double Semicolon Evaluation for Options

         aMsgSamples[ nSample, 3 ] := a1Option

      ENDIF LEN( aMsgSamples[ nSample ] ) > 2

   NEXT nSample

   aParNames := { "Message Lines",;           //  1
                  "Box Title",;               //  2
                  "Options",;                 //  3
                  "BackColor",;               //  4
                  "Msg. Font Name",;          //  5
                  "Msg. Font Size",;          //  6
                  "Msg. Font Color",;         //  7
                  "Opts. FontName",;          //  8
                  "Opts. Font Size",;         //  9
                  "Position" }                // 10


RETU // MakSamples()

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.



PROC SetSmpVals( ;                        // Set sample text box values           
              nSampleNo )

   LOCA aTstPars := aMsgSamples[ nSampleNo ]

   LOCA nParamCo  := LEN( aTstPars ),;
        nTxtBoxNo :=  0,;
        cTxtBxNam := '',;
        cTempStrg := '',;
        xTxtBxVal 
        
   FOR nTxtBoxNo := 1 TO LEN( aParNames )
      xTxtBxVal := IF( nTxtBoxNo <= nParamCo, aTstPars[ nTxtBoxNo ], "" )
      
      IF ISARRY( xTxtBxVal )
         cTempStrg := ''
         AEVAL( xTxtBxVal, { | x1, i1 | cTempStrg += IF( i1 > 1, IF( ISNUMB( x1 ), ",", ";;" ), "" ) + Any2Strg( x1 ) } )                
         xTxtBxVal := cTempStrg 
      ENDIF
      
      cTxtBxNam  := "txb" + STRZERO( nTxtBoxNo, 2 )
      
      SetProperty ( "frmMOptsTest", cTxtBxNam, "VALUE", Any2Strg( xTxtBxVal ) )
      
   NEXT nParamNo 

RETU // SetSmpVals()

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

PROC GetSmpVals( ;                        // Get sample text box values           
              nSampleNo )

   LOCA nParamCo  := LEN( aParNames ),;
        nTxtBoxNo :=  0,;
        cTxtBxNam := '',;
        aTemp     := {},;
        xTxtBxVal 
        
   FOR nTxtBoxNo := 1 TO nParamCo
   
      cTxtBxNam := "txb" + STRZERO( nTxtBoxNo, 2 )
      xTxtBxVal := GetProperty ( "frmMOptsTest", cTxtBxNam, "VALUE" )
      AADD( aTemp, xTxtBxVal )      
      
   NEXT nParamNo 
  
   aMsgSamples[ nSampleNo ] := aTemp
   
RETU // GetSmpVals()

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.
   

PROC TstSamples(;                         // Apply test for one sample
              nSampleNo )

   LOCA aTstPars  := {},;
        nParamCo  :=  0,;
        nParamNo  := 0,;
        cParName  := '',;
        nSelected :=  0,;
        cSelected := '',;
        nTxtBoxNo :=  0,;
        cTxtBxNam := '',;
        aOptions  := {},;
        xTxtBxVal 
        
   GetSmpVals( nSampleNo )

   aTstPars := aMsgSamples[ nSampleNo ]
   aOptions := ParsArStr( aTstPars[ 3 ], { CRLF, ";;" } )                
  
   nParamCo  := LEN( aTstPars )
        
   PRIV xParam1, xParam2, xParam3, xParam4, xParam5, xParam6, xParam7, xParam8, xParam9, xParam10

   FOR nParamNo := 1 TO nParamCo
      cParName  := "xParam" + NTrim( nParamNo )
      &cParname := aTstPars[ nParamNo ]
   NEXT nParamNo

   nSelected := MsgExtended( xParam1, xParam2, xParam3, xParam4, xParam5, xParam6, xParam7, xParam8, xParam9, xParam10 )
   
   IF nSelected < 1 
      cSelected := "Escaped"
   ELSEIF LEN( aOptions ) < 2
      cSelected := "Confirmed"
   ELSE
      cSelected := aOptions[ nSelected ] + CRLF + CRLF + "selected."
   ENDIF

   MsgInfo( cSelected, "RESULT" )

   frmMOptsTest.cbxSamples.SetFocus

RETU // TstSamples()

*  end of test prg

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.
   

Code: Select all

/*

  MINIGUI - Harbour Win32 GUI library Demo/Sample
 
  Copyright 2002-08 Roberto Lopez <harbourminigui@gmail.com>
 
  MsgExtended is Freevare HMG Message function. 
    
  Test program (MsgExtTest.prg) also demonstrate using
  some handy HMG functions and commands.
  
  All bug reports and suggestions are welcome.
    
  Developed under Harbour Compiler and 
  MINIGUI - Harbour Win32 GUI library (HMG);
  compiled and linked by MinGW. 
  
  Thanks to "Le Roy" Roberto Lopez.
 
  All modules in the MsgExtended.prg and MExTest.prg 
  copyrighted : 2008 Bicahi Esgici <esgici@gmail.com>
 
  History :
  
     2008.08 : First Release
*/

#include <minigui.ch>

#define NTrim( n ) ( LTRIM( STR( n ) ) )

#define Emp2Nil( x ) IF( ISCHAR( x ) .AND. EMPTY( ALLTRIM( x ) ), , x )

#translate ISNIL(  <xVal> ) => ( <xVal> == NIL )
#translate ISARRY( <xVal> ) => ( VALTYPE( <xVal> ) == "A" )
#translate ISCHAR( <xVal> ) => ( VALTYPE( <xVal> ) == "C" )
#translate ISNUMB( <xVal> ) => ( VALTYPE( <xVal> ) == "N" )

#xcommand DEFAULT <v1> TO <x1> [, <vn> TO <xn> ]                        ;
          =>                                                            ;
          IF <v1> == NIL ; <v1> := <x1> ; END                           ;
          [; IF <vn> == NIL ; <vn> := <xn> ; END ]
          

/*

   f.MsgExtended() : Message Extended 
   
   Author  : Bicahi Esgici

   Syntax  : MsgExtended( [ <acMsgLines> ],;                          
                          [ <xTitle> ],;
                          [ <acOptions> ],;
                          [ <anBackColor> ],;
                          [ <cFontNameM> ],;
                          [ <nFontSizeM> ],;
                          [ <anFontColorM> ],;
                          [ <cFontNameO> ],;
                          [ <nFontSizeO> ],;
                          [ <xPosition ] )       => <nResult>


   Parameters :

             All parameters are optional.

             <acMsgLines>   : Message Line(s); Char for single, array for multiple lines; default is ""
             <xTitle>       : Tittle for Message box; char; default is ""
             <acOptions>    : Options; Char for single, array for multiple options; default is ""
             <anBackColor>  : Back Color; num array; default is windows default
             <cFontNameM>   : Font Name for message line(s); char; default is windows default
             <nFontSizeM>   : Font Size for message line(s); numeric; default is windows default
             <anFontColorM> : Font Color message line(s);  num array; default is windows default
             <cFontNameO>   : Font Name for option(s); default is windows default
             <nFontSizeO>   : Font Size for option(s); default is windows default
             <aPosition>    : Position relative to the window / form

                              NIL/EMPTY : will be defaulted to : { 0, 0 }

                              Numeric : will be defaulted to : { <this number>, 0 }

                              Array :  may be included 1 to 3 elements :

                                  1° : relativity base: 1: Desktop, 0: parent window/form;  default : 0

                                  2° : If element count is 2, Position code:

                                          0 : Center
                                          1: Up left
                                          2: Up cent
                                          3: Up right
                                          4: Center left
                                          5: Center right
                                          6: Down left
                                          7: Down center
                                          8: Down right

                                          default : 0 ( Center )

                                        else, If element count is 3, this number will be treated as row number
                                              for upper left corner of message box AND

                                  3° Column number for upper left corner of message box

             All parameters may be given as strings (character type). In this case arrays elements may 
             be separated by CRLF or double semicolon (';;') for strings arrays and by comma (',') for
             numeric arrays. Expressions must be specified in their exact form.
             
             
   Return : <nResult> : Number of option selected;
                        When message box closed without selection ( Esc / Alt-F4 ), zero.

   History :
             2008.07 : First Release

*/

FUNC MsgExtended( ;                          // Message Extended
               acMsgLines,;  // Message Line(s)
               xTitle,;      // Tittle for Message box
               xOptions,;    // Options
               aBackColor,;  // Back Color
               cFontNameM,;  // Msg. Font Name
               nFontSizeM,;  // Msg. Font Size
               aFontColorM,; // Msg. Font Color
               cFontNameO,;  // Opt. Font Name
               nFontSizeO,;  // Opt. Font Size
               xPosition  )  // Position relative to the window / form

   LOCA aMsgLines := {},;   // Message Lines
        aOptions  := {},;   // Options
        nRVal     :=  0,;
        nLinNo    :=  0,;
        c1Line    := '',;
        nOpts     :=  0,;
        c1Optn    := '',;
        nMxLnLn   :=  0,;  // Max Line Len
        nOptnCo   :=  0,;  // Option Count
        cLblNam   := '',;  // Label Name
        cbtnNam   := '',;  // Button Name
        nButRow   :=  0,;
        nLnLnPx   :=  0    // Message Line Length in pixel

   LOCA nRelBase  :=  0,;
        nMsBxRow  :=  0,;
        nMsBxCol  :=  0,;
        nPosCode  :=  0,;
        cPosCode  := '',;
        nBaseRow  :=  0,;
        nBaseCol  :=  0,;
        nBasHeig  :=  0,;
        nBasWidt  :=  0
        
   LOCA nMLineCo  :=  0,;         // Messages line count
        nMBxHeig  :=  0,;
        nMBxWidt  :=  0,;
        nMxBtnLn  :=  0,;         // Max Button length (in pixel )
        nBtn1Len  :=  0,;
        nBtnTotL  :=  5
        
   LOCA nMFontSiz :=  0,;
        nOFontSiz :=  0,;
        lVertOpts := .F.        

   * * * * * * * * * * * * * * * * * * * * * * * * *
   *
   *  Defaulting parameters      
   *
   * * * * * * * * * * * * * * * * * * * * * * * * *

   acMsgLines  := Emp2Nil( acMsgLines )
   xTitle      := Emp2Nil( xTitle )    
   xOptions    := Emp2Nil( xOptions )   
   aBackColor  := Emp2Nil( aBackColor ) 
   cFontNameM  := Emp2Nil( cFontNameM )
   nFontSizeM  := Emp2Nil( nFontSizeM )
   aFontColorM := Emp2Nil( aFontColorM )
   cFontNameO  := Emp2Nil( cFontNameO )
   nFontSizeO  := Emp2Nil( nFontSizeO )
   xPosition   := Emp2Nil( xPosition ) 

   DEFAULT acMsgLines  TO  {""},;
           xTitle      TO  Any2Strg( xTitle ),;
           xOptions    TO  {" Ok "},;              // aBackColor  TO  { 201, 215, 228 },;  // 
           xPosition   TO  { 0, 0 }

   IF ISCHAR( aBackColor )
      aBackColor := ParsArStr( aBackColor , { CRLF, ',' } ) 
      IF LEN( aBackColor ) # 3
        aBackColor := NIL
      ELSE   
        AEVAL( aBackColor, { | c1, i1 | aBackColor[ i1 ] := VAL( c1 ) } )
      ENDIF   
   ENDIF
   
   IF ISCHAR( aFontColorM )
      aFontColorM := ParsArStr( aFontColorM , { CRLF, ',' } ) 
      IF LEN( aFontColorM ) # 3
         aFontColorM := NIL
      ELSE   
         AEVAL( aFontColorM, { | c1, i1 | aFontColorM[ i1 ] := VAL( c1 ) } )
      ENDIF   
   ENDIF
   
   IF ISCHAR( nFontSizeM )
      nFontSizeM := VAL( nFontSizeM )
   ENDIF
      
   IF ISCHAR( nFontSizeO )
      nFontSizeO := VAL( nFontSizeO )
   ENDIF

   IF ISNIL( cFontNameM ) .AND. !ISNIL( nFontSizeM )
      cFontNameM := "Arial"
   ENDIF
      
   IF ISNIL( cFontNameO ) .AND. !ISNIL( nFontSizeO )
      cFontNameO := "Arial"
   ENDIF
   
   nMFontSiz := MAX( MIN( IF( ISNIL( nFontSizeM ), 9, nFontSizeM ), 32 ), 8 )      
   nOFontSiz := MAX( MIN( IF( ISNIL( nFontSizeO ), 9, nFontSizeO ), 32 ), 8 )
   
   IF !ISNIL( nFontSizeM )     
      nFontSizeM := nMFontSiz 
   ENDIF   
   
   IF !ISNIL( nFontSizeO )     
      nFontSizeO := nOFontSiz 
   ENDIF   
   
   aMsgLines := ParsArStr( acMsgLines, { CRLF, ";;" } )                  // Message lines
   
   nMLineCo := LEN( aMsgLines )

   AEVAL( aMsgLines, { | c1 | nMxLnLn := MAX( nMxLnLn, LEN( c1 ) ) } )   // Max Line Legth of Messages lines

   nLnLnPx :=  nMxLnLn * nMFontSiz * .8                                  // Messages line length by pixel
   
   * * * * * * * * * * * * * * * * * * * * * * * * *
   *
   * Buttons ( Options )
   *
   * * * * * * * * * * * * * * * * * * * * * * * * *
   
   aOptions := ParsArStr( xOptions, { CRLF, ";;" } )                // Options

   nOptnCo :=  LEN( aOptions )                                      // Options (buttons) Count
   
   lVertOpts := ( EMPTY( aMsgLines ) .AND. nOptnCo > 1 )
   
   AEVAL( aOptions,  { | c1 |  nBtn1Len := nOFontSiz * LEN( c1 ) * .8 + 10,;
                               nMxBtnLn := MAX( nMxBtnLn, nBtn1Len ),; 
                               nBtnTotL += nBtn1Len } )
                               

   
   * * * * * * * * * * * * * * * * * * * * * * * * *
   *
   * Form metrics
   *
   * * * * * * * * * * * * * * * * * * * * * * * * *
      
   IF lVertOpts 
      nMBxHeig := 40 + ( nOptnCo * 4 * nOFontSiz ) 
      nMBxWidt := MAX( nMxBtnLn, 123 ) + 100 // !!! 123 : Min Window WIDTH !!!
   ELSE   
      nMBxHeig := 40 + ( nMLineCo * 4 * nMFontSiz ) + ( nOFontSiz * 6 )
      nMBxWidt := MAX( MAX( nBtnTotL, nLnLnPx ), 123 ) + 10 // !!! 123 : Min Window WIDTH !!!
   ENDIF lVertOpts 
   
   * * * * * * * * * * * * * * * * * * * * * * * * *
   *
   * Position of Message Box
   *
   * * * * * * * * * * * * * * * * * * * * * * * * *

   IF EMPTY( xPosition )
      xPosition := { 0, 0 }
   ENDIF
   
   IF ISCHAR( xPosition )
      xPosition := ParsArStr( xPosition, { CRLF, ',' } ) 
   ENDIF
   
   IF ISARRY( xPosition )
      AEVAL( xPosition, { | x1, i1 | xPosition[ i1 ] := IF( ISCHAR( x1 ), VAL( x1 ), 0 ) } )
   ELSE
      IF ISNUMB( xPosition )
         xPosition := { xPosition, 0 }
      ELSE   
         xPosition := { 0, 0 }
      ENDIF   
   ENDIF

   nRelBase := xPosition[ 1 ]
   
   IF nRelBase < 1     // Parent ( Caller of f.MsgExtended() form/window
      nBaseRow :=  ThisWindow.Row
      nBaseCol :=  ThisWindow.Col
      nBasHeig :=  ThisWindow.Height 
      nBasWidt :=  ThisWindow.Width
   ELSE                // Desktop 
      nBasHeig :=  GetDesktopHeight() 
      nBasWidt :=  GetDesktopWidth() 
   ENDIF nRelBase < 1      
   

   IF LEN( xPosition ) > 2
      nMsBxRow := nBaseRow + xPosition[ 2 ]
      nMsBxCol := nBaseCol + xPosition[ 3 ]
   ELSE
   
      nPosCode := xPosition[ 2 ]
      cPosCode := NTrim( nPosCode )
      
      IF cPosCode $ "123"             // Up line
         nMsBxRow :=  nBaseRow + 50
      ELSEIF cPosCode $ "678"         // Down lin
         nMsBxRow :=  nBasHeig - nMBxHeig - 10 + nBaseRow 
      ELSE                            // Center Line
         nMsBxRow :=  ( nBasHeig - nMBxHeig ) / 2 + nBaseRow 
      ENDIF

      IF cPosCode $ "146"             // Left Column
         nMsBxCol :=  nBaseCol + 10
      ELSEIF cPosCode $ "358"         // Rigth Column
         nMsBxCol :=  nBaseCol + nBasWidt / 3 * 2
      ELSE                            // Center Column
         nMsBxCol :=  ( nBasWidt - nMBxWidt ) / 2 + nBaseCol
      ENDIF

   ENDIF LEN( xPosition ) > 2

   DEFINE WINDOW frmMsgExtended ;
      AT     nMsBxRow, nMsBxCol ;
      WIDTH  nMBxWidt ;
      HEIGHT nMBxHeig ;
      TITLE  xTitle ;
      MODAL  ; //      NOSIZE ;
      NOSYSMENU ;
      BACKCOLOR aBackColor  // { 201, 215, 228 } { 24, 240, 223 }
      
      ON KEY ESCAPE ACTION frmMsgExtended.Release
      
      FOR nLinNo := 1 TO nMLineCo
         cLblNam := 'lbl_' + STRZERO( nLinNo, 2 )
         c1Line  := aMsgLines[ nLinNo ]
         DEFINE LABEL &cLblNam
            ROW       (nLinNo * 3 - 1 ) * nMFontSiz
            COL       0
            VALUE     c1Line
            WIDTH     nMBxWidt
            HEIGHT    nMFontSiz * 2
            FONTNAME  cFontNameM
            FONTSIZE  nFontSizeM
            BACKCOLOR aBackColor
            FONTCOLOR aFontColorM
            CENTERALIGN  .T.
         END LABEL
         
      NEXT nLinNo
   
      IF lVertOpts 
         nButRow  := nOFontSiz * 2
      ELSE
         nButRow := nMBxHeig - 40 - nOFontSiz * 3
      ENDIF lVertOpts 
      
      nBtnSpac := INT( ( nMBxWidt - nBtnTotL ) / ( nOptnCo + 1 ) )
      n1BtnCol := nBtnSpac
      
      FOR nOpts := 1 TO nOptnCo
      
         c1Optn   := aOptions[ nOpts ]
         cbtnNam  := 'btn_'  + STRZERO( nOpts, 2 )
         nBtnWidt := INT( nOFontSiz * ( LEN( c1Optn ) ) * .8 + 10 )         
         
         IF lVertOpts 
            n1BtnCol := ( nMBxWidt - nBtnWidt ) / 2
         ENDIF lVertOpts 
         
         DEFINE BUTTON &cbtnNam
            ROW         nButRow
            COL         n1BtnCol 
            CAPTION     c1Optn
            ACTION      { || nRVal := VAL( RIGHT( this.name, 2 ) ),  frmMsgExtended.Release }
            WIDTH       nBtnWidt        
            HEIGHT      nOFontSiz * 2 + 4
            FONTNAME    cFontNameO
            FONTSIZE    nFontSizeO
            CENTERALIGN .T.
         END BUTTON
         
         IF lVertOpts
            nButRow += nOFontSiz * 3
         ELSE          
            n1BtnCol += nBtnWidt + nBtnSpac
         ENDIF lVertOpts 
      
      NEXT nOpts

   END WINDOW // frmMsgExtended

   ACTIVATE WINDOW frmMsgExtended
   
   
RETU nRVal // MsgExtended()


*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.


/*

    f.Any2Strg() : Covert any type data to string

    Syntax       : Any2Strg( <xAny> ) -> <cString>

    Argument     : <xAny> : A value in any data type

    Return       : <cString> : String equivalent of <xAny>

    History      :

                   7.2006 : First Release

*/

FUNC Any2Strg( xAny )

   LOCA cRVal  := '???',;
        nType  :=  0,;
        aCases := { { "A", { | x | "{...}" } },;
                    { "B", { | x | "{||}" } },;
                    { "C", { | x | x }},;
                    { "M", { | x | x   } },;
                    { "D", { | x | DTOC( x ) } },;
                    { "L", { | x | IF( x,"True","False") } },;
                    { "N", { | x | NTrim( x )  } },;
                    { "O", { | x | ":Object:" } },;
                    { "U", { | x | "" } } }

   IF (nType := ASCAN( aCases, { | a1 | VALTYPE( xAny ) == a1[ 1 ] } ) ) > 0
      cRVal := EVAL( aCases[ nType, 2 ], xAny )
   ENDIF
   
RETU cRVal // Any2Strg()

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
/*

   f.ParsArStr() is a sub-function of f.MsgExtended().
   
   Author  : Bicahi Esgici
   
   Purpose : Pars Lines of an array
   
   Syntax  : ParsArStr( <aArray>, <aDelim> ) => <aParsed>
   
   Parameters : <aArray> : Array to parse 
                <aDelim> : Delimiter(s)
                
   Return : <aParsed> : Parsed verison of <aArray>
   
   History :
   
       2008.08 : First Release
   
*/


FUNC ParsArStr(;                                    // Pars Lines of an array
                aArray, aDelim )

   LOCA nDelm  :=  0,;
        cDelm  := '',;
        nLiNo  :=  0,;
        c1Lin  := '',;
        aTemp  := {},;
        a1Arr  := {},;
        nPosNo :=  0,;
        aRVal  := {}

   DEFAULT aDelim TO { CRLF }
   
   IF !ISARRY( aArray )
      aArray := { Any2Strg( aArray ) }
   ENDIF   
   
   IF !ISARRY( aDelim )
      aDelim := { Any2Strg( aDelim ) }
   ENDIF   

   FOR nDelm := 1 TO LEN( aDelim )
      cDelm := aDelim[ nDelm ]
      FOR nLiNo := 1 TO LEN( aArray )
         c1Lin  := aArray[ nLiNo ]
         a1Arr  := {}
         IF ISCHAR( c1Lin ) .AND. !EMPTY( c1Lin )
            WHILE ( nPosNo := AT( cDelm, c1Lin ) ) > 0
               AADD( a1Arr, LEFT( c1Lin, nPosNo - 1 ) )
               c1Lin := SUBS( c1Lin, nPosNo + LEN( cDelm ) )
            ENDDO
            IF !EMPTY( c1Lin  )
               AADD( a1Arr, c1Lin )
            ENDIF
         ENDIF ISCHAR( c1Lin ) .AND. !EMPTY( c1Lin )
         AEVAL( a1Arr, { | c1 | AADD( aTemp, c1 ) } )
      NEXT nLinNo
      aRVal := ACLONE( aTemp )
      aTemp := {}
   NEXT nDelm

RETU aRVal // ParsArStr()

* end of MsgExtended.prg; function itself and two sub-functions.

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.




Viva INTERNATIONAL HMG :D
Post Reply