/******* * * shadow.prg * * Collection for working with shadowed windows * * Autor : Ludvik Medve{ek, Ljubljana, 28.03.1992 * ludvik.medvesek@siol.net * http://members.xoom.com/lmedvesek/ * *******/ #include "Set.ch" #include "Inkey.ch" #include "Setcurs.ch" // Global Array for storing windows STATIC aWin := {}, nEl := 0 ******************************************************************************* FUNC ErrMess(aMess,nDelay,cColor,nAttr,lBeep) // Dialog for displaying error messages // It waits number of second or until key is pressed // It beeps, but it can be turned off LOCAL nCurs:=SetCursor(SC_NONE), cCol:=SetColor() IF (ValType(nDelay)!="N") ; nDelay:=3 ; END IF cColor==NIL ; cColor:=M->cHlp_2 ; END MsgOn(aMess,cColor,nAttr) IF (lBeep != .F.) Tone(400,3) ; Tone(200,3) ; Tone(400,3) ; Tone(200,3) ; Tone(400,3) ENDIF InKey(nDelay) SetCursor(nCurs) SetColor(cCol) MsgOff() RETURN NIL ******************************************************************************* FUNC MsgOn(aText,cColor,nAttr) // Displays message window in the center of screen LOCAL aWindow:={0,0,0,0}, aMess:={} LOCAL nMaxLen:=0, nI:=0 // Converts everything in array of characters aMess:=MakeArr(aText) // Find longest element FOR nI:=1 TO Len(aMess) nMaxLen:=; IF(Len(All2Str(aMess[nI])) > nMaxLen, Len(All2Str(aMess[nI])), nMaxLen) NEXT nMaxLen += 4 // Center all text and calculate coordinates aWindow[1] := Int((23 - Len(aMess))/2) aWindow[2] := Int(40 - nMaxLen/2) aWindow[3] := aWindow[1] + Len(aMess) + 1 aWindow[4] := aWindow[2] + nMaxLen + 1 // Draw window and display messages WinShade(aWindow[1],aWindow[2],aWindow[3],aWindow[4],'ON',nAttr,1,cColor) FOR nI:=1 TO Len(aMess) SetPos(aWindow[1]+nI,aWindow[2]+1) DispOut(PadC(aMess[nI],nMaxLen),cColor) NEXT RETURN NIL ****************************************************************************** FUNC FileInp(cFile,cText) // Input file name LOCAL cIme:=PadR(Upper(cFile),50) IF(cText==NIL,cText:="Vnesite ime datoteke",) RETURN AllTrim(MsgInp({"","",cText,"",""},cIme)) ****************************************************************************** FUNC MsgInp(aText,xGet,cColor,nAttr) // Input of one field with message MEMVAR pxGet LOCAL aWindow:={0,0,0,0}, aMess:={} LOCAL nMaxLen:=0, nI:=0, GetList:={} PRIVATE pxGet:=xGet // Convert everything in array of characters Aadd(aText,pxGet) aMess:=MakeArr(aText) // Find longest string FOR nI:=1 TO Len(aMess) nMaxLen:=; IF(Len(All2Str(aMess[nI])) > nMaxLen, Len(All2Str(aMess[nI])), nMaxLen) NEXT nMaxLen += 4 // Center all text and calculate coordinates aWindow[1] := Int((23 - Len(aMess))/2) aWindow[2] := Int(40 - nMaxLen/2) aWindow[3] := aWindow[1] + Len(aMess) + 1 aWindow[4] := aWindow[2] + nMaxLen + 1 // Draw window and display messages WinShade(aWindow[1],aWindow[2],aWindow[3],aWindow[4],'ON',nAttr,1,cColor) FOR nI:=1 TO Len(aMess)-1 SetPos(aWindow[1]+nI,aWindow[2]+1) DispOut(PadC(aMess[nI],nMaxLen),cColor) NEXT @ aWindow[1]+Len(aMess),; aWindow[2]+((nMaxLen-Len(All2Str(pxGet)))/2) GET pxGet SetInsCurs() SetKey(K_INS, InsBlock() ) READ SetCursor( SC_NONE ) SetKey(K_INS, NIL ) WinShade("OFF") RETURN pxGet ****************************************************************************** STATIC func MakeArr(xArray) // Convert everything into array LOCAL xTmp:={} IF ValType(xArray)=="A" xTmp:=xArray ELSE Aadd(xTmp,xArray) ENDIF RETURN xTmp ****************************************************************************** FUNC All2Str(xVal) // Convert everything into string LOCAL cVal:="" DO CASE CASE ValType(xVal)=="C" cVal := xVal CASE ValType(xVal)=="N" cVal := AllTrim(Str(xVal)) CASE ValType(xVal)=="D" cVal := Dtoc(xVal) CASE ValType(xVal)=="L" cVal := IF(xVal,".T.",".F.") CASE ValType(xVal)=="U" cVal := "" ENDCASE RETURN (cVal) ******************************************************************************* FUNC MsgOff() // Remove message from screen WinShade('OFF') RETURN NIL ******************************************************************************* FUNC WinShade(nT,nL,nB,nR,cSet,cShdCol,cnBox,cColor) // Push window on internal stack and draw shadow LOCAL nAttrib:=7, lShadow:=.T., cOldCol:=SetColor() // See if window needs to be removed from stack and deleted from screen IF ValType(nT)=="C" ; cSet:=nT ; END // Set default color for shadow to W/N (7) IF ValType(cShdCol) == "C" IF Upper(cShdCol) == "NOSHADOW" lShadow:=.F. ELSE nAttrib:=Col2Attr(cShdCol) ENDIF ELSEIF ValType(cShdCol) == "N" nAttrib:=cShdCol ENDIF IF (cnBox == NIL ) ; cnBox:=SPACE(9) ; END IF cSet == 'ON' .OR. cSet == 'PUT' IF cSet == 'ON' Aadd(aWin, {SaveScreen(nT,nL,nB+1,nR+2),nT,nL,nB,nR} ) nEl++ ENDIF IF lShadow == .T. ; fShadow(nT,nL,nB,nR,nAttrib) ; END if (cColor != NIL) ; SetColor(cColor) ; end Scroll(nT,nL,nB,nR) DispBox(nT,nL,nB,nR,cnBox,cColor) ELSE IF cSet == 'OFF' RestScreen(aWin[nEl,2],aWin[nEl,3],aWin[nEl,4]+1,; aWin[nEl,5]+2,aWin[nEl,1]) END Adel(aWin, nEl ) Asize(aWin, --nEl) ENDIF SetColor(cOldCol) RETURN NIL ******************************************************************************* STATIC FUNC fShadow(nT,nL,nB,nR,nAttr) // Drawing shadow on the edges of window f_Shadow(nB+1,nL+2,nB+1,nR+2,nAttr) f_Shadow(nT+1,nR+1,nB+1,nR+2,nAttr) Return NIL ******************************************************************************* STATIC func f_Shadow(y1,x1,y2,x2,nAttrib) // Draw shadow on area LOCAL cScr:=SaveScreen(y1,x1,y2,x2) RestScreen(y1,x1,y2,x2,Transform(cScr,; Replicate("X"+CHR(nAttrib),Len(cScr)/2))) Return NIL ******************************************************************************* FUNC fWX(nX) // Calculate relative column RETURN IF(nX!=NIL,aWin[nEl,3]+nX,aWin[nEl,3]) ******************************************************************************* FUNC fWY(nY) // Calculate relative row RETURN IF(nY!=NIL,aWin[nEl,2]+nY,aWin[nEl,2]) ******************************************************************************* FUNC WinTitle(cTitle,cColor) // Draw title of window LOCAL cCol:=IF(cColor==NIL,SetColor(),cColor) SetPos( fWY(0), Center(cTitle, aWin[nEl,3], aWin[nEl,5]) ) DispOut( cTitle, cCol ) RETURN NIL ******************************************************************************* FUNC WinMsgBar(nPX,cTxt,cCol) // Drow message in bottom line of window LOCAL nY:=aWin[nEl,4], nX:=Center(cTxt, aWin[nEl,3], aWin[nEl,5]) IF nPX != NIL ; nX:=aWin[nEl,5]-nPX-Len(cTxt) ; ENDIF SetPos(nY,nX) DispOut(cTxt, IF(cCol==NIL,SetColor(),cCol) ) RETURN NIL ******************************************************************************* FUNC WinSay(nY,nX,cTxt,cCol) // Display text in window with relative coordinates SetPos( fWY(nY), fWX(nX) ) DispOut(cTxt, IF(cCol==NIL,SetColor(),cCol) ) RETURN NIL ******************************************************************************* STATIC FUNC Col2Attr(cColor) // Conver color string in numeric attribute LOCAL nAttr:=0,nHigh,nBlink,cFore,cBack nAttr := IF("+" $ cColor,8,0) nAttr += IF("*" $ cColor,128,0) cColor:= Upper(cColor) cFore := SubStr(cColor,1,At("/",cColor)-1) cBack := SubStr(cColor,At("/",cColor)+1) nAttr += IF("B" $ cFore,1,0) nAttr += IF("G" $ cFore,2,0) nAttr += IF("R" $ cFore,4,0) nAttr += IF("W" $ cFore,7,0) nAttr += IF("B" $ cBack,16,0) nAttr += IF("G" $ cBack,32,0) nAttr += IF("R" $ cBack,64,0) nAttr += IF("W" $ cBack,112,0) RETURN (nAttr) ******************************************************************************* FUNCTION SetInsCurs() // Change cursor SetCursor( IF( ReadInsert(), SC_INSERT, SC_NORMAL) ) RETURN NIL ******************************************************************************