I have made a common function called "MyMsgBox(...), to handle several types
of Messages, we use in the the application programming viz. :
MsgInfo
MsgGet
MsgWait
MsgRun
MsgYesNo
MsgList
MsgMeter
I will be very happy if it is useful to any of our members and I welcome suggestions
for its improvement.
Sample Screen Shots are:
- Ramesh Babu P
- Code: Select all Expand view
/* Standard icon resource IDs */
#define IDI_APPLICATION 32512
#define IDI_HAND 32513
#define IDI_QUESTION 32514
#define IDI_EXCLAMATION 32515
#define IDI_ASTERISK 32516
#define COLOR_BTNFACE 15
#define EM_SETSEL 177
#define MF_BYPOSITION 1024
#define MF_DISABLED 2
#include "fivewin.ch"
*******************************************************************************
*** FUNCTION MyMsgBox( cMsg, aOptions, cTitle, xIcon, nDefault, aGradiate, ***
*** bAction, oFont, cFileRes, oIcon, uVar, cPict, bValid,***
*** lSpinner, lMeter, oMeter, lCancel) ***
*** AUTHOR : P.Ramesh Babu ***
*** CREDITS: This function is derived from the FWHs ALERT.PRG ***
*******************************************************************************
FUNCTION MyMsgBox( cMsg, aOptions, cTitle, xIcon, nDefault, aGradiate, ;
bAction, oFont, cFileRes, oIcon, uVar, cPict, bValid,;
lSpinner, lMeter, oMeter, lCancel)
LOCAL oBrush
LOCAL oDlg, oIco
LOCAL nFund := 1, hDC, hBmp
LOCAL lLoaded := .F.
DEFAULT cMsg := "Alert dialog box" ,;
aOptions := {"&OK"} ,;
cTitle := "Attention" ,;
nDefault := 1 ,;
lSpinner := .F. ,;
lMeter := .F. ,;
aGradiate := {{1,CLR_WHITE, nRgb(183,172,234)},{1,CLR_WHITE, nRgb(183,172,234)}} // VIOLET
IF oFont = nil
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -10
ENDIF
DEFINE BRUSH oBrush
DEFINE DIALOG oDlg TITLE cTitle FONT oFont TRANSPARENT BRUSH oBrush ;
COLOR CLR_BLUE, CLR_WHITE
IF oIcon # nil
oDlg:oIcon := oIcon
ENDIF
oDlg:Cargo := 0
oDlg:lHelpIcon := .F.
IF .NOT. EMPTY(cFileRes)
xIcon := ""
ELSE
IF EMPTY(xIcon)
xIcon := "A"
ENDIF
IF UPPER(xIcon) = "E"
xIcon := IDI_APPLICATION
ELSEIF UPPER(xIcon) = "A"
xIcon := IDI_ASTERISK
ELSEIF UPPER(xIcon) = "X"
xIcon := IDI_HAND
ELSEIF UPPER(xIcon) = "Q"
xIcon := IDI_QUESTION
ELSEIF UPPER(xIcon) = "I"
xIcon := IDI_EXCLAMATION
ENDIF
ENDIF
IF bAction == NIL
ELSE
IF .NOT. lMeter
aOptions := {}
ELSE
aOptions := {"&Cancel"}
ENDIF
ENDIF
IF .NOT. EMPTY(cFileRes)
oDlg:bPainted := {||PaintBmp(oDlg, cFileRes, 12, 12)}
ENDIF
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT (DlgInit(oDlg, oFont, cMsg, aOptions, cTitle, nDefault,;
aGradiate, bAction, xIcon, @uVar, cPict, bValid,;
lSpinner, lMeter, oMeter, @lCancel),;
gradiate(oDlg, aGradiate))
IF oIco # nil
RELEASE ICON oIco
ENDIF
RELEASE FONT oFont
RELEASE BRUSH oBrush
RETURN oDlg:Cargo
*******************************************************************************
** STATIC FUNCTION DlgInit(oDlg,oFont,cMsg,aOptions,cTitle,xIcon,nDefault,;) **
** aGradiate, bAction, xIcon) Used by YesNo() Function **
*******************************************************************************
STATIC FUNCTION DlgInit(oDlg, oFont, cMsg, aOptions, cTitle, nDefault,;
aGradiate, bAction, xIcon, uVar, cPict, bValid,;
lSpinner, lMeter, oMeter, lCancel )
LOCAL oSay, oBtn, oIcon, oGet, uOldVal, lEnd := .F.
LOCAL cSay, cLine, aSay := {}, aBmpPal, hBitmap, nVal := 0
LOCAL nMaxWidth, nMaxHeight, nWidth, nHeight, nLines, nFor, nRow
LOCAL nBtnWidth, nBtnOffset, nBtnHeight, nBtnLength
LOCAL lHScroll, lVScroll, lPadded := .F., lPaded := .F.
LOCAL aBtns := ARRAY(LEN(aOptions)), aCoors
IF ValType( cMsg ) != "C"
cMsg := cValToChar( cMsg )
ENDIF
nDefault := 1
aCoors := GetCoors(GetDeskTopWindow())
cSay := ""
nMaxWidth := 0
nMaxHeight := 0
nLines := MLCOUNT(cMsg, 254)
IF uVar # nil .OR. lMeter
nLines := nLines + IF(lMeter,4,2)
ENDIF
FOR nFor := 1 TO nLines
cLine := TRIM(Memoline(cMsg, 254, nFor))
AADD(aSay, cLine)
cSay += cLine+CRLF
nMaxHeight += oDlg:nGetChrHeight()
nMaxWidth := Max(nMaxWidth, oDlg:GetWidth(cLine))
NEXT
aSay := ARRAY(LEN(aSay))
nWidth := nMaxWidth
nHeight := nMaxHeight
IF nHeight > 400
nHeight := 400
ENDIF
IF nWidth > 500
nWidth := 500
ENDIF
IF .NOT. EMPTY(xIcon)
@ .75, 18/12 ICON oIcon OF oDlg
oIcon:hIcon := LoadIcon(oDlg, xIcon)
oIcon:SetBrush( TBrush():New(" NULL" ) )
ENDIF
@ 20, 60 SAY oSay VAR cSay OF oDlg ;
SIZE nWidth, nHeight PIXEL ;
FONT oFont TRANSPARENT
IF bAction # nil
SysRefresh()
ENDIF
nMaxWidth := Max(nWidth + 80, oDlg:GetWidth(cTitle) + 80)
nBtnWidth := 50
FOR nFor := 1 TO LEN(aOptions)
nBtnWidth := Max(nBtnWidth, oDlg:GetWidth(aOptions[nFor]))
NEXT
* Save old Value before editing
IF uVar # nil
uOldVal := uVar
ENDIF
nBtnLength := ( LEN(aOptions) * nBtnWidth ) - IF(LEN(aOptions) > 1, 4,0)
nBtnHeight := Max(nHeight, 20) + 29
nMaxHeight := (oDlg:nGetChrHeight()*1.7) + nBtnHeight + 10 + IF(bAction == NIL,40,0) + 5
nMaxWidth := Max(nMaxWidth, nBtnLength+59+(8*LEN(aOptions)))
nBtnOffset := ROUND((nMaxWidth-nBtnLength) / 2,0) - ((8*LEN(aOptions))/2)
IF lMeter
nBtnHeight -= 25
ENDIF
FOR nFor := 1 TO LEN(aOptions)
@ nBtnHeight, nBtnOffset + ((nFor-1)*nBtnWidth) ;
BUTTON aBtns[nFor] PROMPT aOptions[nFor] OF oDlg ;
PIXEL SIZE nBtnWidth, oDlg:nGetChrHeight()*1.7 ;
nBtnOffset := nBtnOffset + 8
aBtns[nFor]:bAction := GenBlock(oDlg, nFor)
NEXT nFor
IF uVar # nil
aBtns[1]:bAction := {||oDlg:Cargo := uVar, oDlg:End()}
aBtns[2]:bAction := {||oDlg:Cargo := uOldVal, oDlg:End()}
IF VALTYPE(uVar) == "D"
nWidth := 60
ELSE
nWidth := nMaxWidth*.6
ENDIF
IF VALTYPE(uVar) $ "ND"
@ 20+(oDlg:nGetChrHeight()*1.5), 60 GET oGet VAR uVar OF oDlg PIXEL SIZE nWidth,18 SPINNER RIGHT
ELSE
@ 20+(oDlg:nGetChrHeight()*1.5), 60 GET oGet VAR uVar OF oDlg PIXEL SIZE nWidth,18
ENDIF
IF bValid # nil
oGet:bValid := bValid
ENDIF
IF cPict # nil
oGet:cPicture := cPict
ENDIF
ELSEIF lMeter
aBtns[1]:bAction := {||lCancel := .T.}
@ 20+(oDlg:nGetChrHeight()*1.5), 60 METER oMeter VAR nVal TOTAL 10 SIZE nWidth, 18 OF oDlg PIXEL
ENDIF
IF nDefault > LEN(oDlg:aControls) .OR. nDefault = NIL
nDefault := 2
ENDIF
IF bAction == NIL
oDlg:Move(0,0,nMaxWidth,nMaxHeight-6.25)
ELSE
oDlg:Move(0,0,nMaxWidth,nMaxHeight)
ENDIF
WndCenter(oDlg:hWnd)
IF bAction == NIL
oDlg:bStart := {|| ( DisableX(oDlg,.T.), SetFocus(aBtns[1]) ) }
ELSE
IF .NOT. lMeter
oDlg:bStart := {|| ( DisableX(oDlg,.T.), oDlg:lHelpIcon := .F.,;
SysRefresh(), Eval( bAction ), ;
oDlg:End(), SysRefresh() ) }
ELSE
oDlg:bStart := {|| ( DisableX(oDlg,.T.), oDlg:lHelpIcon := .F.,;
SysRefresh(), Eval( bAction, oMeter, @lCancel, aBtns[1]), ;
oDlg:Cargo := !lCancel, oDlg:End(), SysRefresh())}
ENDIF
ENDIF
SysRefresh()
RETURN nil
*******************************************************************************
*** FUNCTION DisableX(oWin, lDisable) - To Disable 'X' Button of a Dialog ***
*******************************************************************************
FUNCTION DisableX(oWin, lDisable)
LOCAL hMenu := 0
LOCAL nCount := 0
DEFAULT lDisable := .T.
IF lDisable
hMenu = GetSystemMenu(oWin:hWnd, .F.)
nCount = GetMItemCount(hMenu)
IF oWin:ClassName() = "TDIALOG"
RemoveMenu(hMenu, 1, nOR( MF_BYPOSITION, MF_DISABLED) )
ELSE
RemoveMenu(hMenu, nCount - 1, nOR( MF_BYPOSITION, MF_DISABLED) ) // Close Button
ENDIF
DrawMenuBar( oWin:hWnd )
ELSE
GetSystemMenu( oWin:hWnd, .T. )
DrawMenuBar( oWin:hWnd )
ENDIF
IF oWin:bValid = nil
oWin:bValid := (.F.)
ENDIF
RETURN nil
*******************************************************************************
*** STATIC FUNCTION GenBlock(oDlg, nElem) to Create a Code Block ***
*******************************************************************************
STATIC FUNCTION GenBlock(oDlg, nElem)
RETURN { || oDlg:Cargo := nElem, oDlg:End() }
*******************************************************************************
* FUNCTION Gradiate( oDlg, aColors, lDir ) Paint a Dialog with Gradiant Colors*
*******************************************************************************
FUNCTION Gradiate( oDlg, aColors, lDir )
LOCAL hDC, hBmp, hBmpOld , nWidth , nHeight
DEFAULT lDir := .T.
IF EMPTY( oDlg:oBrush:hBitmap )
nHeight := IF(lDir,oDlg:nHeight,1)
nWidth := IF(lDir,1,oDlg:nWidth)
hDC := CreateCompatibleDC( oDlg:GetDC() )
hBmp := CreateCompatibleBitMap( oDlg:hDC, nWidth, nHeight )
hBmpOld := SelectObject( hDC, hBmp )
GradientFill( hDC, 0, 0, nHeight, nWidth, aColors,lDir )
DeleteObject( oDlg:oBrush:hBrush )
oDlg:oBrush:hBitmap := hBmp
oDlg:oBrush:hBrush := CreatePatternBrush( hBmp )
SelectObject( hDC, hBmpOld )
oDlg:ReleaseDC()
ENDIF
RETURN nil
*******************************************************************************
*** FUNCTION PaintBmp(oDlg,row,col) to Paint a Transparent Bitmap directly ***
*** on a Dialog/Window from a File/Resource ***
*******************************************************************************
FUNCTION PaintBmp(oDlg, cFileRes, nRow, nCol)
LOCAL aBmpPal, hBitmap
IF FILE(cFileRes)
* This Code is for reading bitmap file from disk file
aBmpPal = PalBmpRead(oDlg:hDC, cFileRes )
ELSE
* This Code is for reading bitmap file resource
aBmpPal = PalBmpLoad( cFileRes )
ENDIF
hBitmap = aBmpPal[ 1 ]
DrawMasked( oDlg:hDC, hBitmap, nRow, nCol )
RETURN hBitMap
**************************
*** EOF() MyMsgBox.PRG ***
**************************
This is the Test Program "TSTMSGBOX.PRG", explaining the usage of MyMsgBox(...)
- Code: Select all Expand view
#include "fivewin.ch"
STATIC nVal := 1, oMeter, lCancel := .F.
EXTERNAL TMETER
FUNCTION main()
LOCAL nOpt := 0, oIcon1, oIcon2, oIcon3, oIcon4, oIcon5, oFont, cLines := "", cOpted := ""
LOCAL uVar := 0, cPict, bValid, bAction, oMeter
LOCAL aGradiate1 := {{1,CLR_WHITE, nRgb(152,194,152)},{1,CLR_WHITE, nRgb(152,194,152)}} // GREEN
LOCAL aGradiate2 := {{1,CLR_WHITE, nRgb(247,229,170)},{1,CLR_WHITE, nRgb(247,229,170)}} // YELLOW
LOCAL aGradiate3 := {{1,CLR_WHITE, nRgb(183,172,234)},{1,CLR_WHITE, nRgb(183,172,234)}} // VIOLET
LOCAL H := HB_LIBLOAD("MYMSGBOX.dll")
SET DATE ITALIAN
SET CENT ON
DEFINE ICON oIcon1 FILE "C:\FWH\ICONS\WORLD.ICO"
DEFINE ICON oIcon2 FILE "C:\FWH\ICONS\PEOPLE2.ICO"
DEFINE ICON oIcon3 FILE "C:\FWH\ICONS\PEOPLE.ICO"
DEFINE ICON oIcon4 FILE "C:\FWH\ICONS\PERSON.ICO"
DEFINE ICON oIcon5 FILE "C:\FWH\ICONS\NOTES.ICO"
* Message Info - 1
HB_LIBDO( "MYMSGBOX", "There is an error and the process could not be completed."+CRLF+"Please try it once again.",,"Error Message",,,aGradiate1,,,,oIcon1)
*************
* Message Info - 2
HB_LIBDO( "MYMSGBOX","This Message is shown for 3 Seconds.", ,"Wait Message", "A", ,aGradiate2 , {||SysWait(3)},,,oIcon2)
*************
* Message Run - 3
* MYMSGBOX("Counting Numbers from 1 to 100. Please wait ..", ,"Number Counting", "E", ,aGradiate3, {||Count(1,100)})
*************
* Message Meter - 4
MsgInfo(HB_LIBDO( "MYMSGBOX","Counting Numbers from 1 to 100 with a Meter. Please wait ..",,;
"Number Counting", "I", ,aGradiate3, {|oMeter,lCancel|Count(1,10,oMeter,lCancel)},,,,,,,,.T.,oMeter,@lCancel) )
*************
* Message MYMSGBOX - 5
nOpt := HB_LIBDO( "MYMSGBOX","Please specify your Option for the output.",{"&Printer","&File","&Screen"},"Output Option", "Q", aGradiate3,,,,,oIcon3)
IF nOpt = 1
cOpted := "Printer"
ELSEIF nOpt = 2
cOpted := "File"
ELSEIF nOpt = 3
cOpted := "Screen"
ELSE
cOpted := "None"
ENDIF
HB_LIBDO( "MYMSGBOX","You have opted for '"+cOpted+"'",,"Option Selected",, 1, aGradiate1,,,"C:\FWH\BITMAPS\32X32\USERS.BMP",oIcon4)
*************
* Tabular Message - 6
DEFINE FONT oFont NAME "Courier New" SIZE 0, -12
nOpt := 0
cLines := TableMsg()
DO WHILE nOpt = 0
nOpt := MsgInfo(HB_LIBDO("MYMSGBOX", cLines,{"&Create","&Cancel"},"Table Message","Q",1,aGradiate1,, oFont,,oIcon5 ))
ENDDO
oFont:End()
HB_LIBDO( "MYMSGBOX", "Painting a User defined Bitmap on the Message Box",{"&Ok"},"User Defined Bitmap",,1, aGradiate1,,, "C:\FWH\BITMAPS\32X32\USERS.BMP",oIcon4 )
*************
uVar := 1540.00
cPict := "99,999.99"
bValid := {|o|IF(o:Value >3000,(HB_LIBDO("MYMSGBOX","Sorry, You can't enter a Salary, more than 3,000."),.F.),.T.)}
MsgInfo(HB_LIBDO( "MYMSGBOX","Please enter your Salary here below 3000 Dollars.",{"&Ok","&Cancel"},"Enter your Salary",,,aGradiate2,,,,oIcon1,@uVar,cPict,bValid,.F.))
*************
uVar := DATE()
cPict := "99-99-9999"
bValid := {|o|IF(o:Value > CTOD("31/12/2011"),(HB_LIBDO("MYMSGBOX","Sorry, You can't enter a date beyond end of this year."),.F.),.T.)}
MsgInfo(HB_LIBDO( "MYMSGBOX","Please enter a Date prior to the end of this year.",{"&Ok","&Cancel"},"Get with Validation",,,aGradiate1,,,,oIcon4,@uVar,cPict,bValid,.T.))
*************
uVar := SPACE(25)
cPict := "@!"
bValid := {|o|IF(EMPT(o:Value),(HB_LIBDO("MYMSGBOX","Sorry, You can't leave the name empty."),.F.),.T.)}
MsgInfo(HB_LIBDO( "MYMSGBOX","Please enter your First Name and Second Name here.",{"&Ok","&Cancel"},"Enter First Name",,,aGradiate1,,,,oIcon3,@uVar,cPict,bValid,.T.))
HB_LIBFREE( H )
RETURN nil
*************
FUNCTION TableMsg()
LOCAL array, cLines, n
* Tabular Message
array := {}
AADD(array,padc("STATEMENT OF SUBJECTS SHWON IN THE PROGRESS REPORTS OF VII CLASS",71))
AADD(array,"")
AADD(array,padc("IN HALF YEARLY EXAM",71))
AADD(array,"")
AADD(array,"-----------------------------------------------------------------------")
AADD(array,"SUBJECT TYPE SUBJECT SUBJ. MAXIMUM MINIMUM SHOW AS ")
AADD(array," NAME CODE MARKS MARKS MARKS/GRADE")
AADD(array,"-----------------------------------------------------------------------")
AADD(array,"")
AADD(array,"1ST LANGUAGE ENGLISH 11 100 40 MARKS ")
AADD(array," HINDI 12 100 40 MARKS ")
AADD(array,"")
AADD(array,"2ND LANGUAGE HINDI 21 100 40 MARKS ")
AADD(array," SANSKRIT 22 100 40 MARKS ")
AADD(array,"")
AADD(array,"COMPULSERY MATHS-1 31 100 40 MARKS ")
AADD(array," MATHS-2 32 100 40 MARKS ")
AADD(array," PHY.SCIENCE 34 100 40 MARKS ")
AADD(array," BIO.SCIENCE 35 100 40 MARKS ")
AADD(array," GEOGRAPHY 37 100 40 MARKS ")
AADD(array," POLIT.SCI. 38 100 40 MARKS ")
AADD(array,"")
AADD(array,"EXTRA G.K 76 100 40 GRADE ")
AADD(array," DRAWING 77 100 40 GRADE ")
AADD(array,"")
AADD(array,"-----------------------------------------------------------------------")
cLines := ""
FOR n = 1 TO LEN(array)
cLines+= array[n]+CRLF
NEXT
cLines += CRLF
cLines += "Please confirm wether you want to Create Blank Marks as shown above?"
cLines += CRLF+CRLF+CRLF+CRLF
RETURN cLines
**************
FUNCTION Count(nFrom,nUpto,oMeter)
LOCAL n
DO WHILE .NOT. lCancel .AND. nFrom <= nUpto
SysWait(.5)
oMeter:Set(nFrom)
nFrom++
IF lCancel
EXIT
ENDIF
ENDDO
RETURN nil
*************
