Hi Roger,
Code: Select all
/* CUSTOM BOX */
#xtranslate @ <nSRow>,<nSCol> TO <nERow>,<nECol> ;
FORM_BOX [HEADER <cHeader>] ;
[TEXT <cText>] ;
[HEADALIGN <nHdAlign>] ;
[HEADHEIGHT <nHdHeight>] ;
[HEADFONT <nHdFont>] ;
[HEADCOLOR <ncHdFgC> [,<ncHdBgC>]] ;
[HEADOBJ <oHdObj>] ;
[TEXTALIGN <nTxAlign>] ;
[TEXTFONT <nTxFont>] ;
[TEXTCOLOR <ncTxFgC> [,<ncTxBgC>]] ;
[TEXTOBJ <oTxObj>] ;
[BOXCOLOR <ncBxFgC> [,<ncBxBgC>]] ;
[HRADIUS <nHRadius>] ;
[VRADIUS <nVRadius>] ;
[PARENT <oParent>] ;
[OBJECT <oObject>]
=> ;
Form_box( [<cHeader>], ;
[<cText>], ;
[<nSRow>], [<nSCol>], [<nERow>], [<nECol>], ;
[<nHdAlign>], ;
[<nHdHeight>], ;
[<nHdFont>], ;
[<ncHdFgC>], ;
[<ncHdBgC>], ;
[@<oHdObj>], ;
[<nTxAlign>], ;
[<nTxFont>], ;
[<ncTxFgC>], ;
[<ncTxBgC>], ;
[@<oTxObj>], ;
[<ncBxFgC>], ;
[<ncBxBgC>], ;
[<nHRadius>], ;
[<nVRadius>], ;
[@<oParent>], ;
GetList,;
.T., ;
.T. )
Code: Select all
* ------------
FUNCTION Form_Box(cHeader, cText, nSRow, nSCol, nERow, nECol, nHeadAlign, nHeadHeight, nHeadFont, ;
ncHdFgC, ncHdBgC, oHeadObj, nTextAlign, nTextFont, ncTxFgC, ncTxBgC, oTextObj, ;
ncBxFgC, ncBxBgC, nHRadius, nVRadius, oParent, GetList, lHeader, lBox )
LOCAL i, nRow := 0, aStatic[20], nOffSet, nTxRow, nHdRow, nHdCol
DEFAULT nHeadAlign := XBPSTATIC_TEXT_VCENTER + XBPSTATIC_TEXT_CENTER,;
nTextAlign := XBPSTATIC_TEXT_VCENTER + XBPSTATIC_TEXT_CENTER,;
nHeadHeight := 20,;
nHeadFont := '9.Arial',;
nTextFont := '9.Arial Bold',;
ncHdFgC := GRA_CLR_WHITE,;
ncHdBgC := GRA_CLR_PALEGRAY,;
ncTxFgC := GRA_CLR_BLACK,;
ncTxBgC := XBPSYSCLR_TRANSPARENT,;
ncBxFgC := GRA_CLR_PALEGRAY,;
ncBxBgC := GRA_CLR_WHITE,;
nHRadius := 30,;
nVRadius := 30,;
lHeader := .T.,;
lBox := .T.,;
nOffSet := IIF( lHeader, 3, 0 )
IF lBox
nTxRow := IIF( lHeader, (nHeadHeight*16)+nOffSet, 3 )
@ nSRow, nSCol DCSTATIC SIZE nECol - nSCol, nERow - nSRow PIXEL;
SUBCLASS 'CustomStatic()' ;
PARENT oParent ;
COLOR ncBxFgC, ncBxBgC OBJECT oTextObj ;
PREEVAL {|o|o:radiusH := nHRadius, ;
o:radiusV := nVRadius, ;
o:isOutline := .t., ;
o:outlineWidth := 5 } ;
DROP {|o,a,b|DropIcon(o,a,b)}
@ nTxRow, 3.00 DCSAY cText PARENT oTextObj ;
SIZE DCGUI_PARENTWIDTH-10 PIXEL ;
SAYOPTION nTextAlign FONT nTextFont ;
COLOR ncTxFgC, nctxBgC
ENDIF
IF lHeader
nHdRow := IIF( lBox, 0, nSRow )
nHdCol := IIF( lBox, 0, nSCol )
nHeadHeight := IIF( lBox, nHeadHeight, nERow - nSRow )
@ nHdRow,nHdCol DCSTATIC SIZE nECol - nSCol, nHeadHeight PIXEL ;
SUBCLASS 'CustomStatic()' ;
PARENT oTextObj ;
COLOR ncHdFgC, ncHdBgC OBJECT oHeadObj ;
PREEVAL {|o|o:radiusH := nHRadius, ;
o:radiusV := nVRadius, ;
o:isOutline := .f., ;
o:isHeader := .t.} ;
RESIZE DCGUI_RESIZE_REPOSY_RESIZEX
@ 2.00, 8.00 DCSAY cHeader PARENT oHeadObj ;
SIZE DCGUI_PARENTWIDTH-16, DCGUI_PARENTHEIGHT-4 PIXEL ;
SAYOPTION nHeadAlign FONT nHeadFont ;
COLOR ncHdFgC, ncHdBgC
ENDIF
RETURN nil
Code: Select all
*--------------------------------------
CLASS CustomStatic FROM DC_XbpStatic
EXPORTED:
VAR radiusH
VAR radiusV
VAR colorBG
VAR colorFG
VAR caption
VAR isOutline
VAR outlineWidth
VAR isHeader
* ----------
INLINE METHOD Init(a,b,c,d,e,f,g,h)
LOCAL aGetList, aGetListItem
::DC_XbpStatic:init(a,b,c,d,e,f,g,h)
aGetList := ::getList:getListArray
aGetListItem := ::getList:getListArray[::getListPointer]
::drawMode := XBP_DRAW_OWNER
::colorFG := aGetListItem[aGETLIST_COLOR][2]
::colorBG := aGetListItem[aGETLIST_COLOR][1]
::caption := aGetListItem[cGETLIST_CAPTION]
DEFAULT ::radiusH := 10,;
::radiusH := 10,;
::isOutline := .f.,;
::outlineWidth := 5, ;
::isHeader := .f.
RETURN self
* ----------
INLINE METHOD Create(a,b,c,d,e,f,g,h)
::DC_XbpStatic:create(a,b,c,d,e,f,g,h)
return self
* -----------
INLINE METHOD Draw( oPS, aInfo )
LOCAL aStartPos := {aInfo[4][1],aInfo[4][2]}
LOCAL aEndPos := {aInfo[4][3],aInfo[4][4]}
LOCAL aAttrArea := Array(GRA_AA_COUNT)
LOCAL aAttrLine := Array(GRA_AL_COUNT)
LOCAL nColor
IF !::isHeader
nColor := ::parent:setColorBG()
IF nColor == NIL
IF IsMethod(::parent:setParent(),'SETCOLORBG')
nColor := ::parent:setParent():setColorBG()
ENDIF
ENDIF
GraSetColor( oPS, nColor, nColor )
GraBox( oPS, aStartPos, aEndPos, GRA_FILL )
ENDIF
GraSetColor( oPS, ::colorFG, ::colorBG )
GraBox( oPS, aStartPos, aEndPos, GRA_FILL, ::radiusH, ::radiusV)
IF ::isOutline
aAttrLine[GRA_AL_WIDTH] := ::outlineWidth
GraSetAttrLine( oPS, aAttrLine )
GraSetColor( oPS, ::colorBG, ::colorFG )
GraBox( oPS, aStartPos, aEndPos, GRA_OUTLINE, ::radiusH, ::radiusV)
ENDIF
GraSetColor( oPS, ::colorBG )
GraStringAt( oPS, {10,10}, ::caption )
RETURN self
ENDCLASS