bb.donnay-software.com

I found this function somewhere- i cannot remember. MsgBox is suppose to be modal but this code when executed does not MODAL. Can anyone pls translate it to EXPRESS++ and make it modal.

Thanks

Joe

#INCLUDE "appevent.CH"
#INCLUDE "gra.CH"
#INCLUDE "xbp.CH"
#INCLUDE "dcdialog.CH"
#INCLUDE "dll.CH"

FUNCTION MsgBoxCustom(aMessage, cTitle, nRadius, cFont, nTitleHeight )

LOCAL oMsgBox, mp1, mp2, oXbp, nEvent, oDlg, nWidth, nHeight, ;
oButton, lStatus, oFont, i, oPS, aSize

SETDEFAULT cTitle := DEVELOPER, nRadius := 20, cFont := '10.Arial', nTitleHeight := 30

IF ValType(aMessage) # "A"
aMessage := {aMessage}
EndIf
ASize(aMessage,Len(aMessage)+1)
AIns(aMessage,1)
aMessage[1] := ''

oDlg := XbpDialog():new(AppDeskTop(),,{0,0},{100,100},,.f.)
oDlg:border := XBPDLG_NO_BORDER
oDlg:titleBar := .f.
oDlg:taskList := .t.
oDlg:origin := XBPDLG_ORIGIN_MOUSE
oDlg:drawingArea:colorBG := XBPSYSCLR_TRANSPARENT
oDlg:create()

oFont := XbpFont():new()
oFont:create(cFont)
oPS := oDlg:drawingArea:lockPS()
GraSetFont( oPS, oFont )

nHeight := 0
aSize := GraQueryTextBox( oPS, cTitle )
nWidth := aSize[3,1] - aSize[1,1] + 50
FOR i := 1 TO Len(aMessage)
aSize := GraQueryTextBox( oPS, aMessage )
nHeight += aSize[1,2] - aSize[2,2]
nWidth := Max(nWidth, aSize[3,1] - aSize[1,1])
NEXT

nHeight += 100
nWidth += 20
oDlg:setSize( { nWidth, nHeight } )

SetRoundRectRegion( oDlg, nWidth, nHeight, nRadius )

oMsgBox := MsgBoxCustomStatic():new( oDlg:drawingArea,,{0,0},oDlg:drawingArea:currentSize())

oMsgBox:radius := nRadius
oMsgBox:titleFontObject := oFont
oMsgBox:titleCaption := cTitle
oMsgBox:titleHeight := nTitleHeight
oMsgBox:messageArray := aMessage
oMsgBox:messageFontObject := oFont
oMsgBox:create()
oMsgBox:lbDown := {|a,b,o|o:moveWindow(a,b)}
oMsgBox:lbClick := {|a,b,o|o:closeWindow(a,b)}
oMsgBox:show()

oButton := XbpPushButtonXP():new( oMsgBox,, {(oMsgBox:currentSize()[1]-80)/2,20},{80,22})
oButton:caption := 'Ok'
oButton:activate := {||lStatus := .t., PostAppEvent(xbeP_Close,,,oDlg)}
oButton:create()
oDlg:setParent(AppDesktop())
oDlg:setOwner(SetAppWindow())
oDlg:setModalState(XBP_DISP_APPMODAL)
oDlg:show()

nEvent := 0
lStatus := .f.
DO WHILE nEvent # xbeP_Close
nEvent := AppEvent(@mp1,@mp2,@oXbp,.1)
IF nEvent > 0
oXbp:handleEvent(nEvent,mp1,mp2)
ENDIF
IF nEvent == xbeP_Keyboard .AND. mp1 == xbeK_ESC
EXIT
ENDIF
ENDDO

oDlg:setModalState(XBP_DISP_MODELESS)
oDlg:destroy()

RETURN lStatus

* ------------

CLASS MsgBoxCustomStatic FROM XbpStatic

PROTECTED:

VAR titleCloseFontObject

EXPORTED:

VAR titleColor
VAR titleHeight
VAR fillColor
VAR radius
VAR gradientStep
VAR titleCaption
VAR titleFont
VAR messageFont
VAR messageColorFG
VAR messageArray
VAR messageFontObject
VAR titleFontObject

* ----------

INLINE METHOD Init(a,b,c,d,e,f,g,h)

::titleColor := { 200, 200, 200 }
::titleHeight := 30
::titleFont := '10.Arial'
::fillColor := { 200, 245, 245 }
::radius := 20
::gradientStep := 2
::titleCaption := 'Testing'
::XbpStatic:init(a,b,c,d,e,f,g,h)
::XbpStatic:drawMode := XBP_DRAW_OWNER
::messageArray := {}
::messageFont := '16.Arial'
::messageColorFG := GRA_CLR_BLACK

RETURN self

* ----------

INLINE METHOD Create(a,b,c,d,e,f,g,h)

IF !Empty(::titleFont) .AND. Empty(::titleFontObject)
::titleFontObject := XbpFont():new()
::titleFontObject:create(::titleFont)
ENDIF
::titleCloseFontObject := XbpFont():new()
::titleCloseFontObject:create('16.Marlett')
IF !Empty(::messageFont) .AND. Empty(::messageFontObject)
::messageFontObject := XbpFont():new()
::messageFontObject:create(::messageFont)
ENDIF

::XbpStatic:create(a,b,c,d,e,f,g,h)

RETURN self

* -----------

INLINE METHOD Draw( oPS, aInfo )

LOCAL aStringAttr, i, oFont, aPos, aRect, aSize, nTmp
LOCAL aColors, nColor
LOCAL aStartPos := {aInfo[4][1],aInfo[4][2]}
LOCAL aEndPos := {aInfo[4][3],aInfo[4][4]}
LOCAL aStartPosSave, aEndPosSave
LOCAL aAttrArea := Array(GRA_AA_COUNT)
LOCAL oSaveFont, nStartRow, nStartCol, nTextHeight, nEndCol

aColors := AClone(::titleColor)

aStartPosSave := AClone(aStartPos)
aEndPosSave := AClone(aEndPos)

FOR i := 1 TO ::titleHeight
aColors[1] += ::gradientStep
aColors[2] += ::gradientStep
aColors[3] += ::gradientStep
GraSetColor( oPS, GraMakeRGBColor(aColors))
GraBox( oPS, aStartPos, aEndPos, GRA_OUTLINEFILL, ::radius, ::radius )
aStartPos[2]++
aEndPos[2]--
NEXT

aStartPos := aStartPosSave
aEndPos := aEndPosSave
aEndPos[2] -= ::titleHeight

GraSetColor( oPS, GraMakeRGBColor( ::fillColor ))
GraBox( oPS, aStartPos, aEndPos, GRA_OUTLINEFILL, ::radius, ::radius)
aStartPos[2] += ::titleHeight
GraBox( oPS, aStartPos, aEndPos, GRA_OUTLINEFILL, 0, 0)

aStringAttr := Array( GRA_AS_COUNT )
aStringAttr[GRA_AS_COLOR] := GRA_CLR_BLACK
aStringAttr[GRA_AS_VERTALIGN] := GRA_VALIGN_TOP
GraSetAttrString( oPS, aStringAttr )

IF !Empty(::titleFontObject)
GraSetFont(oPS,::titleFontObject)
ENDIF
aPos := {20,::CurrentSize()[2]-::titleHeight/2+10}
GraPos( oPS, aPos )
GraStringAt( oPS,,::titleCaption )

oSaveFont := GraSetFont(oPS,::titleCloseFontObject)
aPos := {::CurrentSize()[1]-30,::CurrentSize()[2]-::titleHeight/2+10}
GraPos( oPS, aPos )
GraStringAt( oPS,,'r' )

IF !Empty(::messageArray)
nStartCol := 10
nEndCol := ::currentSize()[2]
GraSetFont(oPS,::messageFontObject)
aSize := GraQueryTextBox( oPS, ::messageArray[1] )
nTextHeight := aSize[1,2] - aSize[2,2]
nStartRow := ::currentSize()[2] - (Len(::messageArray)*nTextHeight) - ::titleHeight

FOR i := Len(::messageArray) TO 1 STEP -1
GraCaptionStr( oPS, { nStartCol, nStartRow },, ::messageArray )
nStartRow += nTextHeight
NEXT
ENDIF

GraSetFont(oPS,oSaveFont)

RETURN self

* ----------

INLINE METHOD CloseWindow( mp1, mp2 )

IF mp1[1] < ::currentSize()[1] - 30
RETURN self
ELSEIF mp1[2] < ::currentSize()[2] - ::titleHeight
RETURN self
ENDIF

PostAppEvent(xbeP_Close,,,self)

RETURN self

* ----------

INLINE METHOD MoveWindow( mp1, mp2, nStopEvent )

LOCAL oParent := self, oDeskTop := AppDeskTop(), nEvent, aPos, ;
aPosXbp, oXbp

IF mp1[1] > ::currentSize()[1] - 30
RETURN self
ELSEIF mp1[2] < ::currentSize()[2] - ::titleHeight
RETURN self
ENDIF

DEFAULT nStopEvent := xbeM_LbUp

DO WHILE !(oParent == oDesktop)
oParent := oParent:setParent()
IF oParent:isDerivedFrom('XbpDialog')
EXIT
ENDIF
ENDDO

aPosXbp := CalcAbsolutePosition( mp1, self, oParent )

oParent:captureMouse(.t.)

nEvent := 0
aPos := oParent:currentPos()
DO WHILE nEvent # nStopEvent
nEvent := AppEvent( @mp1, @mp2, @oXbp, .1 )
IF nEvent # 0
oXbp:handleEvent(nEvent,mp1,mp2)
ENDIF
IF nEvent == xbeM_Motion
aPos := CalcAbsolutePosition(mp1,oXbp)
aPos[1] -= aPosXbp[1]
aPos[2] -= aPosXbp[2]
oParent:setPos( aPos )
CompleteEvents()
ENDIF
ENDDO

oParent:captureMouse(.f.)

RETURN self

ENDCLASS

* -----------

FUNCTION SetRoundRectRegion( oXbp, nWidth, nHeight, nRadius )

LOCAL nDLL, nDLL2, hRgn

nDLL := DLLLoad( 'GDI32.DLL' )
IF nDll <> 0
hRgn := DllCall( nDLL, DLL_STDCALL,"CreateRoundRectRgn", ;
0,;
0,;
nWidth,;
nHeight, ;
nRadius, ;
nRadius )

nDll2 := DLLLoad( 'USER32.DLL' )
IF nDll2 <> 0
DllCall( nDll2, DLL_STDCALL,"SetWindowRgn", oXbp:GetHwnd(), hRgn, 1 )
DllUnload(nDll2)
ENDIF
DLLUnload(nDll2)
ENDIF

RETURN nil

* -----------

FUNCTION CalcAbsolutePosition(aPos,oXbp,oTop)

LOCAL aAbsPos, oParent := oXbp

DEFAULT oTop := AppDeskTop()
DEFAULT aPos := {0,0}

aAbsPos := AClone(aPos)

DO WHILE oParent <> oTop
aAbsPos[1] += oParent:currentPos()[1]
aAbsPos[2] += oParent:currentPos()[2]
oParent := oParent:setParent()
IF Valtype(oParent) # 'O'
EXIT
ENDIF
ENDDO

RETURN(aAbsPos)

* ---------

FUNCTION CompleteEvents()

LOCAL i, mp1, mp2, oXbp, nEvent, nSeconds := Seconds()

nEvent := -1
DO WHILE nEvent # 0 .AND. Seconds() - nSeconds < 2
nEvent := AppEvent( @mp1, @mp2, @oXbp, .1 )
IF nEvent > 0 .AND. Valtype(oXbp) == 'O' .AND. !(nEvent = xbeM_Motion .AND. mp1 == NIL)
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDIF
ENDDO

RETURN .T.

* ---------

FUNCTION DC_GraQueryTextBox( cCaption, cFont, nOption, nMode )

LOCAL oXbp , aArray, nWidth, nHeight

DEFAULT nMode := 2

oXbp := XbpStatic():new(AppDeskTop())
IF Valtype(nOption) == 'N'
oXbp:option := nOption
ENDIF

IF nMode == 1
oXbp:create()
ENDIF

IF Valtype(cFont) = 'C'
oXbp:setFontCompoundName(cFont)
ENDIF

IF nMode == 2
oXbp:create()
ENDIF

aArray := GraQueryTextBox( oXbp:lockPS(), cCaption )
nWidth := aArray[3,1] - aArray[1,1] // width
nHeight := aArray[1,2] - aArray[2,2] // height
oXbp:unlockPS()
oXbp:destroy()

RETURN {nWidth, nHeight}

Look at \exp20\samples\static\msgboxcustom.prg

I got it

Thanks