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.
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.
