home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / SCHWARTZ.ZIP / EXAMPLE4.PRG < prev    next >
Encoding:
Text File  |  1990-06-06  |  3.3 KB  |  116 lines
  1. /*********************************************************************
  2. *
  3. * Name:        DISPSETS() - Extension UDF()  Sample Debug Tool
  4. * Description:  Displays Clipper 5.0 current global settings
  5. * Author:    Philip H. Schwartz
  6. * Audience:    Nantucket DEVCON '90
  7. * Written:      June 4, 1990
  8. * Compiler:    Clipper 5.0 V7.7 BETA
  9. * Comp Option:
  10. * Linker:       RTLink Version 1.3 (Clipper)
  11. * Library:    clipper, extend
  12. * Obj Module:   
  13. * Link input:   rtlink fi example4 out example4 li clipper,extend
  14. * Headers:    STD.ch, SET.ch
  15. * Copyright:    (c) 1990 Philip H. Schwartz
  16. * Rights:    All Commercial & Publishing Rights Reserved
  17. *
  18. *********************************************************************/
  19.  
  20. #include "set.ch"
  21.  
  22. #define DEMO                // remove this to compile UDF only
  23.  
  24. #define BETA                // BETA version of SET() doesn't
  25.                     // work.  Delete this line for
  26.                     // version that works.
  27. #ifdef DEMO
  28. /* The test program consists of the following lines */
  29. CLS
  30. DispSets()                // display global settings
  31. RETURN
  32. #endif
  33.  
  34. /* This function displays the current global settings in Clipper 5.0.
  35.    It would be very easy to modify the routine to allow changing
  36.    these settings.  This will be discussed in the DEVCON talk.  */
  37. FUNCTION DispSets
  38. LOCAL aSET,aSetCurrent[_SET_COUNT],nSetCount,cSaveScreen,i
  39.  
  40. aSET:={"SET EXACT",;
  41.        "SET FIXED",;
  42.        "SET DECIMALS",;
  43.        "SET DATE",;
  44.        "SET EPOCH",;
  45.        "SET PATH",;
  46.        "SET DEFAULT",;
  47.        "SET EXCLUSIVE",;
  48.        "SET SOFTSEEK",;
  49.        "SET UNIQUE",;
  50.        "SET DELETED",;
  51.        "SETCANCEL()",;
  52.        "ALTD()",;
  53.        "SETCOLOR()",;
  54.        "SETCURSOR()",;
  55.        "SET CONSOLE",;
  56.        "SET ALTERNATE",;
  57.        "SET ALTERNATE TO",;
  58.        "SET DEVICE",;
  59.        "SET PRINTER",;
  60.        "SET PRINTER TO",;
  61.        "SET MARGIN",;
  62.        "SET BELL",;
  63.        "SET CONFIRM",;
  64.        "SET ESCAPE",;
  65.        "READINSERT()",;
  66.        "READEXIT()",;
  67.        "SET INTENSITY",;
  68.        "SET SCOREBOARD",;
  69.        "SET DELIMITERS",;
  70.        "SET DELIMITERS TO",;
  71.        "SET WRAP",;
  72.        "SET MESSAGE",;
  73.        "SET MESSAGE (CENTERED)"}
  74.  
  75. cSaveScreen=SAVESCREEN(0,0,24,79)    // save original screen
  76.  
  77. nSetCount=MIN(LEN(aSet),_SET_COUNT)    // SET() values are version dependent,
  78.                     // but the character string
  79.                     // values are hard-wired.  So we
  80.                     // limit the FOR/NEXT argument
  81.                     // to whichever is less: _SET_COUNT
  82.                     // or size of the string array. 
  83.  
  84. FOR i=1 TO nSetCount
  85. #ifdef BETA
  86.   aSetCurrent[i]=PAD(aSet[i],30)+"  "+;
  87.    IIF(i>=12 .AND. i<=15,"This function is BROKE", LTRIM(SetFmt(SET(i))))
  88. #else
  89.   aSetCurrent[i]=PAD(aSet[i],30)+"  "+LTRIM(SetFmt(SET(i)))
  90. #endif
  91. NEXT
  92.  
  93. CLS
  94. @ 1,0 TO 24,79 DOUBLE            // draw the ACHOICE frame
  95. nChoice=ACHOICE(2,1,23,78,aSetcurrent)    // show values with ACHOICE
  96.  
  97. RESTSCREEN(0,0,24,79,cSaveScreen)    // restore original screen
  98. RETURN NIL
  99.  
  100. /* This function formats the passed SET() variable
  101.    based on the type of its returned value */
  102. FUNCTION SetFmt
  103. PARAMETER SetVariable
  104. DO CASE
  105. CASE VALTYPE(SetVariable)="C"
  106.   RETURN(SetVariable)
  107. CASE VALTYPE(SetVariable)="N"
  108.   RETURN(STR(SetVariable))
  109. CASE VALTYPE(SetVariable)="L"
  110.   RETURN(IIF(SetVariable,"ON   (TRUE)","OFF  (FALSE)"))
  111. OTHERWISE
  112.   RETURN("NOT SUPPORTED TYPE")
  113. ENDCASE
  114. RETURN NIL
  115. /*EOF*/
  116.