home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / sv12us.zip / SOUNDVIS / DEMOSRC / DEMO.PRG
Text File  |  1993-07-26  |  36KB  |  1,288 lines
  1.  /*
  2.   *  PROGRAMM ... :   Demo.prg
  3.   *  AUTHOR ..... :   Tom Groeger
  4.   *  TRANSLATION  :   Max Bressel
  5.   *  DATE ....... :   07/20/93
  6.   *  PURPOSE .... :   Sound & Vision demonstration
  7.   *
  8.   *  compile CLIPPER DEMO /m /n
  9.   *  link BLINKER FI Demo, Errorsys, Getsys LIB SoundVis
  10.   *  or   RTLINK  FI Demo, Errorsys, Getsys LIB SoundVis
  11.   *
  12.   *  ATTENTION!
  13.   *  SetPref() only available in registered version !
  14.   *
  15.   */
  16.  
  17.  
  18.  // INCLUDES
  19.  // --------
  20.  #include 'INKEY.CH'
  21.  #include 'SET.CH'
  22.  #include "SOUNDVIS.CH"
  23.  
  24.  // color definition
  25.  // ----------------
  26.  #define  C_NHB       48               // black on light blue
  27.  #define  C_NW       112               // black on white
  28.  #define  C_RW       116               // balck on red
  29.  #define  C_WBROWN   191               // light white on brown (transfered)
  30.  #define  C_NBEIGE   208               // black on beige (transfered)
  31.  
  32.  // menu definitions
  33.  // -----------------
  34.  #define M_POINTSTAT  12
  35.  #define M_POINTLIST  13
  36.  #define M_MEMORY     40
  37.  #define M_VGASET     41
  38.  #define M_SIGN       42
  39.  #define M_SOUND      44
  40.  #define M_FM         45
  41.  #define M_SBINIT     46
  42.  #define M_FAKTIV     47
  43.  #define M_CDROM      48
  44.  #define M_HBUTTON    50
  45.  #define M_VBUTTON    51
  46.  #define M_LISTE      52
  47.  #define M_CRC        53
  48.  #define M_OUTLINE    54
  49.  #define M_QUEST      55
  50.  #define M_ALERT      56
  51.  #define M_FILE       75
  52.  #define M_HELP     200
  53.  
  54.  #define STD_INFO 'N/*RB,N/W,,,R/*RB'
  55.  
  56.  
  57.  
  58.  PROCEDURE Main
  59.  
  60.     // save DOS screen
  61.     LOCAL TestScr := ScrSave(0,0,24,79)
  62.  
  63.     // break flag
  64.     LOCAL lExit := .f.
  65.  
  66.     // codeblock for end or programm
  67.     LOCAL bExit := {||lExit := .t.}
  68.  
  69.     // MouseArray, Pos 1,2 to 1,3 will end the program
  70.     LOCAL aMaus  := {{1, 2, 3, bExit}}
  71.  
  72.     // WorkVars..
  73.     LOCAL nKey, lFont, cCrc32, nX
  74.     LOCAL c2Screen, cChr, nZeile, nSpalte
  75.  
  76.     // mouse init
  77.     LOCAL nMaus := Mse_Init()
  78.  
  79.     LOCAL cMessage, aButton := {'~OK','~Exit'}
  80.  
  81.     LOCAL xDummy1, xDummy2, xDummy3, xDummy4, aText
  82.  
  83.     // presetting CheckPrompt
  84.     LOCAL lSound := .t.
  85.  
  86.     // block for CheckPrompt, lSound PER REFERENCE!!
  87.     LOCAL bSetSound := {|lModus|SetSound(@lSound, lModus)}
  88.  
  89.  
  90.     //building the menu arrays
  91.     // --------------------------
  92.  
  93.     LOCAL aDatei := { ;
  94.      {'~Horizont. Buttons'    , M_HBUTTON, .T. ,'Window with ButtonChoice'},;
  95.      {'~Vertical  Buttons'    , M_VBUTTON, .T. ,'Window with ButtonBar'},;
  96.      {A_SEP},;
  97.      {'~Listings-Demo'        , M_LISTE,   .T. ,'Browse with 3D effects and buttons.'},;
  98.      {'~OutLine-Demo'         , M_OUTLINE, .T. ,'GETs with frames...'},;
  99.      {'~CRC calculation'      , M_CRC,     .T. ,'CRC32-Checksum of a file'},;
  100.      {A_SEP},;
  101.      {'~Question-Box'         , M_QUEST,   .T. ,'any questions ?'},;
  102.      {'~Alert-Box'            , M_ALERT,   .T. ,"alarm.. hey what's going on..."},;
  103.      {'~File-Box'             , M_FILE,    .F. ,'filebox, use your mouse '},;
  104.      {A_SEP},;
  105.      {'~End of Demo'          , B_QUIT,    .T. ,"...outta here ?!", 'ALT-F4' } }
  106.  
  107.  
  108.     LOCAL aSubSubPt :={ ;
  109.      {'~shoot him', 111, .T. , 'oh no, too loud'},;
  110.      {'~hang him',  112, .T. , 'not loud enough'},;
  111.      {'~drown him', 113, .T. , 'hmmm...too ~good for him'},;
  112.      {'~slain him', 114, .T. , "yeah... ~that's it!"} }
  113.  
  114.  
  115.     LOCAL aSubPoint :={ ;
  116.      {'~add new Points',  101 , .T. ,'gee, another one ?'},;
  117.      {'~change Points',   102 , .T. ,"are you sure ? :-)"},;
  118.      {'~delete Point',    103 , .T. ,'hum...why did he leave ?'},;
  119.      {A_SEP},;
  120.      {'~get rid of Point ', aSubSubpt, .T.,'ultima ratio..',''} }
  121.  
  122.  
  123.     LOCAL aPoint :={ ;
  124.      {'~Fees',       M_POINTSTAT,.T.,'payments, ~contributions'},;
  125.      {'~Pointlist',  M_POINTLIST,.F.,'list of all my points'},;
  126.      {A_SEP},;
  127.      {'~Database of points',aSubPoint,  .T.,'what will we do with them ?','' } }
  128.  
  129.  
  130.     LOCAL aSystem :={ ;
  131.      {'~Memory information' ,  M_MEMORY,  .T. ,'what fits ?'},;
  132.      {'~Color change' ,        M_VGASET,  .T. ,'feel like Picasso'},;
  133.      {'~ASCII-characters' ,    M_SIGN,    .T. ,'wow...'},;
  134.      {A_SEP},;
  135.      {'Soundblaster ~Init',    M_SBINIT,  .T., 'Change Portadress and IRQ'},;
  136.      {'Sound~blaster VOC' ,    M_SOUND,   .T., 'do you have one ?'},;
  137.      {'S~oundblaster FM' ,     M_FM,      .T., 'do you have one ?'},;
  138.      {'turn on the Soun~d' , bSetSound,   .T., 'toggle Sound     '},;
  139.      {A_SEP},;
  140.      {'~CD-Rom Audio Support',   M_CDROM, .T.,'May the Sound be with you'},;
  141.      {'~burn in serial numbers', M_FAKTIV,.F., 'yes, will be part of the next release !'}}
  142.  
  143.  
  144.  
  145.     LOCAL aMain :={ ;
  146.      {'~Window'       , aDatei,  .T., 'Window and Button demo'},;
  147.      {'~PopUps'       , aPoint,  .T., 'nested PopUp Menu'},;
  148.      {'Sys & ~Sound'  , aSystem, .T., "let's boot your computer <g>"},;
  149.      {'~Help'         , M_HELP,  .T., 'I think I can help', 36 } }
  150.  
  151.  
  152.     // Settings
  153.     // --------
  154.     SET(_SET_CURSOR,0)
  155.     SET(_SET_DECIMALS,2)
  156.     SET(_SET_WRAP,.t.)
  157.     SET(_SET_SCOREBOARD,.f.)
  158.     SET(_SET_DELIMITERS,.f.)
  159.     SET DATE german
  160.     SETBLINK(.f.)
  161.  
  162.     // mask- and Menu color
  163.     // ----------------------
  164.     SetDAC (C_RB,25,17,23)              // magenta       will be brown/red
  165.     SetDAC (C_RG, 41, 31, 24)           // brown         will be somewhat darker
  166.     SetDAC (C_HW,55,55,55)              // light white   will be somewhat lighter
  167.     SetDac (C_HBG, 34, 18, 26)          // light blue    will be red-brown
  168.     SetDac (C_HRB, 42, 41, 36)          // light magenta will be pus-yellow
  169.  
  170.  
  171.  
  172.     // fontload, return .F. = Error
  173.     // ----------------------------------------
  174.     lFont := SET_FONT('SVFont.016')
  175.  
  176.     IF nMaus # 0
  177.        cls
  178.  
  179.        cMessage := 'mouse could not be loaded'
  180.        DO CASE
  181.        CASE nMaus == 1
  182.             cMessage := cMessage - ';CPU not supported, < 80286'
  183.             QUIT
  184.  
  185.        CASE nMaus == 2
  186.             cMessage := cMessage - ';no VGA/EGA-adapter'
  187.  
  188.        CASE nMaus == 3
  189.             cMessage := cMessage - ";you forgot to load your mouse driver"
  190.  
  191.        ENDCASE
  192.  
  193.  
  194.        IF AlertBox(1,cMessage,aButton) == 2
  195.           Mse_Exit()
  196.           QUIT
  197.        ENDIF
  198.  
  199.  
  200.     ENDIF
  201.  
  202.     IF ! lFont
  203.        IF AlertBox(1,"Unable to load the Font !",aButton) == 2
  204.           Mse_Exit()
  205.           QUIT
  206.        ENDIF
  207.  
  208.     ENDIF
  209.  
  210.  // sattutation, always init the SoundBlaster !
  211.  // -------------------------------------------
  212.     SbInit( 7, 220)
  213.  
  214.  // here we go ...
  215.  // --------------
  216.     PlayVoc ( 'hal.voc')
  217.  
  218.  
  219.     SETCOLOR('RG+/RG')                 // background
  220.     CLS
  221.  
  222.     SetPref ( C_POPCOL,    240 )       // windows/text black on white
  223.     SetPref ( C_POPKEY,    244 )       // Hotkeys red on light blue
  224.     SetPref ( C_POPPASSIV, 248 )       // non chooseable point, grey on white
  225.     SetPref ( C_POPSHORT,  244 )       // ShortCut blue on light white
  226.  
  227.     SetPref ( C_BOXHEADER,  31 )       // heading of the Alertboxes
  228.  
  229.     SetPref ( C_DESCROW,    22 )       // row for description
  230.     SetPref ( C_DESCCOL,     5 )       // column for descripton
  231.     SetPref ( C_DESCEND,    75 )       // endcolumn
  232.     SetPref ( C_GRAFBUTTON,  1 )       // graphic button
  233.  
  234.  
  235.     // set mouse on position 13,39 and show
  236.     //---------------------------------------
  237.     Mse_Set ( 13,39, .f.)
  238.  
  239.  
  240.  
  241.     // does the nice window
  242.     // ---------------------
  243.     OPENWIN  FROM 1,2 TO 23,77                ;
  244.              TITLE 'SOUND & VISION demonstration' ;
  245.              TYP WIN_FULL
  246.  
  247.  
  248.     // color for inside window
  249.     // ------------------------
  250.     ColorMe ( 4, 4, 20, 73, 94)
  251.  
  252.  
  253.  
  254.  
  255.  
  256.       SETKEY(K_MOUSE, {||MouseReq()})   // Function MouseReq() on MouseButton
  257.       SETKEY(K_ALT_F4, bExit)           // ALT-F4 ends the demo
  258.  
  259.     // rename button 2
  260.     aButton [2] := 'watch ~again ??'
  261.  
  262.  
  263.     // PROGRAM
  264.     // -------
  265.  
  266.     DO WHILE nKey # B_QUIT
  267.  
  268.        // call menu
  269.        nKey := BarMen (2,4,1,,aMain, aMaus)
  270.  
  271.  
  272.  
  273.  
  274.        DO CASE
  275.  
  276.          // ========================
  277.          // horizontal ButtonDemo
  278.          // ========================
  279.        CASE nKey == M_HBUTTON
  280.  
  281.  
  282.             DO WHILE .t.
  283.                nKey := AlertBox(2,'DEMO.EXE Vers. 1.2  σ 1993 Tom Groeger;'+;
  284.                                  'choose via cursor, mouse;'+;
  285.                                  'or character', aButton)
  286.  
  287.                IF nKey = M_CLOSE
  288.                   Describe('CloseIcon')
  289.  
  290.                ELSEIF nKey = M_MOVE
  291.                   Describe('MoveIcon')
  292.  
  293.                ELSEIF nKey = M_CHOICE
  294.                   Describe('ChoiceIcon')
  295.  
  296.                ENDIF
  297.  
  298.                IF nKey == 1 .OR. nKey == K_ESC
  299.                   Exit
  300.                ENDIF
  301.  
  302.             ENDDO
  303.  
  304.  
  305.          // ======================
  306.          // Vertical ButtonDemo
  307.          // ======================
  308.        CASE nKey == M_VBUTTON
  309.  
  310.             OPENWIN FROM 6,25 TO 18,55        ;
  311.                     TITLE 'vertical button  ' ;
  312.                     TOPCOLOR C_WBROWN         ;
  313.                     WINCOLOR C_NBEIGE         ;
  314.                     TYP   WIN_MESSAGE         ;
  315.                     SAVE TO c2Screen
  316.  
  317.             ShowStr ( 11, 27, 'which drive')
  318.             ShowStr ( 12, 27, 'should be')
  319.             ShowStr ( 13, 27, 'formatted?')
  320.  
  321.  
  322.             DrawButton (  8, 46, C_NW, C_RW, ;
  323.                          {' ~A: ',' ~B: ',' ~C: ',' ~D: ','~Exit'}, .t., 3 )
  324.  
  325.             ScrRest ( c2Screen )
  326.  
  327.  
  328.          // ==================
  329.          // list-browsing demo
  330.          // ==================
  331.        CASE nKey == M_LISTE
  332.  
  333.  
  334.          // make TestArray
  335.             aText := {'Al Bundy          452324       1022.50',;
  336.                       'Mr.Fabulous     2 -55721        561.80',;
  337.                       'Billy Wilder     23/4530      51022.00',;
  338.                       'El Diabolo         i-448         45.60',;
  339.                       'Luciano Pavarotti 275679        532.10',;
  340.                       'Margret Thatcher   75424      32423.67',;
  341.                       'Toni Curtis      2435654         34.50',;
  342.                       'Stan Laurel          345       4522.20',;
  343.                       'Mark Lussier       32527        911.20',;
  344.                       'Bruce Wayne       1-3/93       1723.20' }
  345.  
  346.  
  347.          // Scrollkey redirection
  348.             SETKEY(K_DOWN, {||ScrollIt ( K_DOWN, aText )})
  349.             SETKEY(K_UP,   {||ScrollIt ( K_UP, aText )})
  350.             SETKEY(K_HOME, {||ScrollIt ( K_HOME, aText )})
  351.             SETKEY(K_END,  {||ScrollIt ( K_END, aText )})
  352.  
  353.          // Window
  354.          // ------
  355.             OPENWIN FROM 2,10 TO 22,68  ;
  356.                     TITLE 'Listing    ' ;
  357.                     TOPCOLOR C_WBROWN   ;
  358.                     WINCOLOR C_NBEIGE   ;
  359.                     TYP WIN_LIST        ;
  360.                     SAVE TO c2Screen
  361.  
  362.             ShowStr( 21, 14, 'Sum of invoices')
  363.  
  364.          // boarder for the listing
  365.             OutFrame ( 6, 12, 15, 65, 2)
  366.  
  367.  
  368.          // with SetPref ( C_BUTTLOWER, 208 ) the outline-boarder
  369.          // would be drawn as a double line (asc208)
  370.          // -----------------------------------------------------
  371.             xDummy1 := SetPref( C_BUTTLOWER, 208 )
  372.  
  373.             OutLine ( 4, 15, 'GOODS', 1 , C_NW , .t.)
  374.             OutLine ( 4, 34, 'INVOICE No.', 1, C_NW )
  375.             OutLine ( 4, 52, 'AMOUNT', 1, C_NW )
  376.  
  377.             SetPref ( C_BUTTLOWER, xDummy1 )
  378.  
  379.  
  380.          // draw button and choose
  381.          // ----------------------
  382.  
  383.  
  384.          nChoice := K_HOME
  385.  
  386.          DO WHILE nChoice # 0 .AND. nChoice # 4
  387.  
  388.             ScrollIt ( nChoice, aText )
  389.  
  390.             nChoice := 3
  391.             @ 18, 16 GET nChoice   ;
  392.                      AS PUSHBUTTON { '~book','~print','~delete','~abort' } ;
  393.                      COLOR C_NW ;
  394.                      HOTKEY C_RW
  395.             READ
  396.  
  397.          ENDDO
  398.  
  399.          // release setkeys
  400.          // ----------------
  401.             SETKEY(K_DOWN, NIL)
  402.             SETKEY(K_UP, NIL )
  403.             SETKEY(K_HOME, NIL)
  404.             SETKEY(K_END, NIL)
  405.  
  406.  
  407.          // restore screen
  408.             ScrRest ( c2Screen )
  409.  
  410.  
  411.          // ==============
  412.          // OutLine - Demo
  413.          // ==============
  414.        CASE nKey == M_OUTLINE
  415.  
  416.             // some dummys
  417.             xDummy1 := 'Focke Wulff'
  418.             xDummy2 := '190-D9  '
  419.             xDummy3 := CTOD('12.10.44')
  420.             xDummy4 := 1250
  421.  
  422.             OPENWIN from 8,22 to 18,55 title 'airplane'  ;
  423.                     topcolor C_WBROWN  wincolor C_NBEIGE ;
  424.                     typ WIN_MESSAGE                      ;
  425.                     save to c2Screen
  426.  
  427.             SETCOLOR  ( STD_INFO )
  428.             SETCURSOR ( 1 )
  429.  
  430.             @ 10, 26 SAY 'Manufacturer'
  431.             @ 12, 26 SAY 'Type'
  432.             @ 14, 26 SAY 'First flight'
  433.             @ 16, 26 SAY 'Produced'
  434.  
  435.          // READ as a 'boardered' get
  436.          // -------------------------
  437.             @ 10, 40 GET xDummy1 AS FRAME IN C_NW,C_NBEIGE
  438.             @ 12, 43 GET xDummy2 AS FRAME IN C_NW,C_NBEIGE
  439.             @ 14, 43 GET xDummy3 AS FRAME IN C_NW,C_NBEIGE
  440.             @ 16, 42 GET xDummy4 AS FRAME IN C_NW,C_NBEIGE PICT '999999.99'
  441.             READ
  442.  
  443.             SETCURSOR ( 0 )
  444.             ScrRest ( c2Screen )
  445.  
  446.           // ===========
  447.           //  Crc-Demo
  448.           // ===========
  449.        CASE nKey == M_CRC
  450.  
  451.             xDummy1 := 'C:DEMO.EXE                  '
  452.             c2Screen := OpenMask (  8, 10, 16, 70,;
  453.                                    'CRC-Check', 51, C_WBROWN, C_NBEIGE)
  454.  
  455.             SETCOLOR( 'N/*RB,N/W,,,R/*RB' )
  456.             SETCURSOR( 1 )
  457.  
  458.             @ 12, 22 SAY 'filename'
  459.             @ 12, 32 GET xDummy1 AS FRAME IN C_NW,C_NBEIGE PICT '@K'
  460.             READ
  461.  
  462.  
  463.             xDummy1 := TRIM( xDummy1 )
  464.  
  465.             // switch mouse cursor to a sandglass
  466.             Mse_Wait ( .t. )
  467.             Mse_Set ( 14, 45, .t.)
  468.  
  469.             // get the CrcCheckSum
  470.             xDummy2 := GetCrc32 ( xDummy1 )
  471.  
  472.             // normal mouse and switch off
  473.             Mse_Wait (.f.)
  474.             Mse_Show(.f.)
  475.  
  476.             //clear field and show the CRC
  477.             ShowStr ( 12, 17, SPACE( 52) )
  478.             ShowStr ( 11, 17, 'CRC-Sum of '+ xDummy1 +' ist', C_NBEIGE)
  479.             ShowStr ( 12, 35, xDummy2 , 222 )
  480.  
  481.             // Ok ?
  482.             DrawButton ( 14, 34, C_NW, C_RW, {'  ~OK  '})
  483.  
  484.             SETCURSOR (0)
  485.             ScrRest ( c2Screen )
  486.  
  487.           // =============
  488.           //  QuestionBox
  489.           // =============
  490.        CASE nKey == M_QUEST
  491.             xDummy1 := SetPref( C_BOXHEADER, C_NW )
  492.  
  493.             AlertBox(0,'Are you going to registrate for;'+;
  494.                                   '      SOUND & VISION ?',;
  495.                         {'~Sure,', "~I'll do it", '~tomorrow...'})
  496.  
  497.             SetPref( C_BOXHEADER, xDummy1 )
  498.  
  499.  
  500.           // ==========
  501.           //  Alert Box
  502.           // ==========
  503.        CASE nKey == M_ALERT
  504.             xDummy1 := SetPref( C_BOXHEADER, C_NW )
  505.  
  506.             AlertBox(1,'do you really want to format ;'+;
  507.                                   'drive C: ?',;
  508.                         {'~Yeah, sure', 'oh no, better ~not'})
  509.  
  510.             SetPref( C_BOXHEADER, xDummy1 )
  511.  
  512.  
  513.  
  514.           // ======
  515.           //  FEES
  516.           // ======
  517.        CASE nKey == M_POINTSTAT
  518.  
  519.             OPENWIN FROM 06, 20 TO 20, 60 ;
  520.                    TITLE "Cheaper than you'd think....." ;
  521.                    TOPCOLOR C_WBROWN   ;
  522.                    WINCOLOR C_NBEIGE   ;
  523.                    TYP WIN_MESSAGE     ;
  524.                    SAVE TO c2Screen
  525.  
  526.             ShowStr ( 08, 26, 'Copyright σ Tom Groeger 1993', 212 )
  527.             ShowStr ( 10, 32, 'Distributed by:')
  528.             ShowStr ( 11, 33, 'SOFTSOL GmbH', 212 )
  529.             ShowStr ( 12, 31, 'Neue Strasse 35a')
  530.             ShowStr ( 13, 29, '21073 HAMBURG/Germany')
  531.             ShowStr ( 14, 30, 'Tel:+49-40-7661290')
  532.             ShowStr ( 15, 30, 'Fax:+49-40-7665664')
  533.             ShowStr ( 16, 30, 'BBS:+49-40-7665527')
  534.  
  535.             DrawButton ( 18, 34, C_NW, C_RW, {'  ~OK  '})
  536.  
  537.             ScrRest ( c2Screen )
  538.  
  539.           // =============
  540.           //  SOUNDBLASTER
  541.           // =============
  542.        CASE nKey == M_FM
  543.  
  544.             aPiano  := {  1,   17,  77,  0, 241, 210, 96, 123, 00, 00, 08 }
  545.             aString := { 113, 161, 139, 64, 113,  66, 17,  21, 00, 00, 06 }
  546.  
  547.  
  548.             FM_Instr (1, aPiano)
  549.             FM_Instr (2, aPiano )
  550.             FM_Instr (3, aString )
  551.             FM_Instr (4, aString )
  552.  
  553.             nx = 1
  554.             do while nx < 13
  555.  
  556.                FM_KeyOn ( 1, nx , 2)
  557.                FM_KeyOn ( 2, nx , 4)
  558.                FM_KeyOn ( 3, 13-nx  , 2 )
  559.                FM_KeyOn ( 4, 13-nx++, 4 )
  560.  
  561.                FM_Delay (9)
  562.  
  563.             enddo
  564.             FM_KeyOff ( 1 )
  565.             FM_KeyOff ( 2 )
  566.             FM_KeyOff ( 3 )
  567.             FM_KeyOff ( 4 )
  568.  
  569.  
  570.        CASE nKey == M_SOUND
  571.             PlayVoc ('beam.voc')
  572.  
  573.  
  574.        CASE nKey == M_SBINIT
  575.          // Soundblaster Init
  576.  
  577.             xDummy1 := 7
  578.             xDummy2 := 220
  579.  
  580.             PlayStop()
  581.  
  582.             OPENWIN from 9,22 to 17,55 title 'Soundblaster'  ;
  583.                     topcolor C_WBROWN  wincolor C_NBEIGE ;
  584.                     typ WIN_MESSAGE                      ;
  585.                     save to c2Screen
  586.  
  587.             SETCOLOR  ( STD_INFO )
  588.             SETCURSOR ( 1 )
  589.  
  590.             @ 12, 26 SAY 'IRQ-Number'
  591.             @ 14, 26 SAY 'Portadress'
  592.  
  593.             DO WHILE .t.
  594.  
  595.                // a 'framed' Get
  596.                // --------------
  597.                @ 12, 42 GET xDummy1 AS FRAME IN C_NW,C_NBEIGE PICT '9'
  598.                @ 14, 40 GET xDummy2 AS FRAME IN C_NW,C_NBEIGE PICT '999'
  599.                READ
  600.  
  601.                IF ! SbInit ( xDummy1, xDummy2 )
  602.                   IF AlertBox (1,;
  603.                      'Something seems to be wrong ... Valid Inputs are ;'+;
  604.                      'IRQ 2/5/7 and Port 220/240/260',;
  605.                       { '~Retry', '~Cancel' } ) == 2
  606.                      EXIT
  607.                   ENDIF
  608.  
  609.                ELSE
  610.                   EXIT
  611.  
  612.                ENDIF
  613.  
  614.             ENDDO
  615.             SETCURSOR ( 0 )
  616.             ScrRest ( c2Screen )
  617.  
  618.           // ============
  619.           //  CD-ROM
  620.           // ============
  621.        CASE nKey == M_CDROM
  622.  
  623.             // NOTE!
  624.             // please read the passage within the Norton Guides !
  625.  
  626.             nDrive := CDInit()
  627.             nTrack := 1
  628.             nChoice := 1
  629.  
  630.             OPENWIN FROM 8,25 TO 18,55        ;
  631.                     TITLE 'CD-PLAYER'         ;
  632.                     TOPCOLOR C_WBROWN         ;
  633.                     WINCOLOR C_NBEIGE         ;
  634.                     TYP   WIN_MESSAGE         ;
  635.                     SAVE TO c2Screen
  636.  
  637.             ShowStr ( 11, 27, 'CD-Drives')
  638.             ShowStr ( 13, 27, 'Track No.')
  639.             OutLine ( 11, 42, STR(nDrive, 2), 1, C_NW, .f. )
  640.  
  641.             SetCursor( 1 )
  642.  
  643.             @ 13, 43 GET nTrack  AS FRAME IN C_NW,C_NBEIGE Pict '99'
  644.             @ 16, 30 GET nChoice AS PUSHBUTTON { '~Start','~Cancel' } ;
  645.                           COLOR C_NW  HOTKEY C_RW
  646.             READ
  647.  
  648.             SetCursor( 0 )
  649.  
  650.             IF nChoice == 1
  651.                PlayCD ( nTrack )
  652.             ENDIF
  653.  
  654.             ScrRest ( c2Screen )
  655.  
  656.           // ================
  657.           // character table
  658.           // ================
  659.        CASE nKey == M_SIGN
  660.             nX := 1
  661.             xDummy1 := ScrSave(4,4,20,73)
  662.  
  663.             FOR nRow := 1 TO 15
  664.                 FOR nColumn := 1 TO 51 STEP 3
  665.                     IF nX >= 213 .AND. nX <= 217
  666.                        nX++
  667.                     ELSE
  668.                        ShowStr (nRow+4, nColumn+14, CHR( nX++))
  669.                     ENDIF
  670.                 NEXT
  671.             NEXT
  672.  
  673.             MSE_Show (.t.)
  674.             INKEY(0)
  675.             MSE_Show (.f.)
  676.  
  677.             ScrRest ( xDummy1 )
  678.  
  679.  
  680.           // ============
  681.           //  SystemInfo
  682.           // ============
  683.        CASE nKey == M_MEMORY
  684.             ShowMem()
  685.  
  686.  
  687.           // ==============
  688.           //  Change colors
  689.           // ==============
  690.        CASE nKey == M_VGASET
  691.             VgaMenu()
  692.  
  693.        CASE nKey == M_HELP
  694.  
  695.             ShowStr(12,35,'RTFM !')
  696.             INKEY(1)
  697.             ShowStr(12,35,'      ')
  698.  
  699.  
  700.           // ===============
  701.           //  Finito l'amore
  702.           // ===============
  703.        CASE nKey == K_ESC .OR. lExit
  704.  
  705.             // Now we want show our impressions on SOUND & VISION <g>
  706.             PlayVoc("Cheer.voc")
  707.  
  708.  
  709.             nKey := 'Y'
  710.             SETCURSOR(1)
  711.             Describe ('Programm ~abort ? ')
  712.  
  713.             SETCOLOR(',N/*W')
  714.             @ 24,20 Get nKey PICT '!'
  715.             READ
  716.  
  717.             IF 'Y' $ nKey
  718.                nKey := B_QUIT
  719.             ELSE
  720.               nKey := 0
  721.               lExit := .f.
  722.  
  723.             ENDIF
  724.  
  725.             SETCURSOR(0)
  726.  
  727.  
  728.        ENDCASE
  729.  
  730.     ENDDO
  731.  
  732.  
  733.  // brutal method
  734.  // ---------------
  735.     PlayStop()
  736.  
  737.  // turn mouse off
  738.  // ---------------
  739.     Mse_Show(.f.)
  740.     Mse_Exit()
  741.  
  742.  // restoring
  743.  // -----------
  744.     SETCOLOR('W/N')
  745.     ScrRest(TestScr)
  746.     @ 23,0 SAY 'Thanks for trying SOUND & VISION'
  747.  
  748.  // byebye
  749.  // -------
  750.     QUIT
  751.  
  752.  
  753.  
  754.  
  755. /**************************************************
  756.  *
  757.  *   FUNCTION ScrollIt( nGrab, aText ) -> NIL
  758.  *
  759.  *   Demo of a function called via SetKey.
  760.  *   This function is passed via CodeBlock and scrolls the data
  761.  *   in a BrowseWindow up and down.
  762.  *   Function is called via SETKEY or by the GET AS A PUSHBUTTON
  763.  *   PARAMETER :  nGrab  : key pressed
  764.  *                aText  : Array containing test-data
  765.  */
  766.  
  767.  FUNCTION ScrollIt ( nGrab, aText )
  768.    STATIC nBarPos
  769.    LOCAL nX, nY
  770.  
  771.    nBarPos := IIF(nBarPos == NIL, 4, nBarPos)
  772.  
  773.     DO CASE
  774.     CASE nGrab == K_UP  .OR. nGrab == M_UP
  775.  
  776.          ShowStr( nBarPos, 67, A_VERTICAL)
  777.          nBarPos := MAX( --nBarPos,  4 )
  778.  
  779.     CASE nGrab == K_DOWN .OR. nGrab == M_DOWN
  780.          ShowStr( nBarPos, 67, A_VERTICAL)
  781.          nBarPos := MIN( ++nBarPos, 20)
  782.  
  783.     CASE nGrab == K_HOME
  784.          ShowStr( nBarPos, 67, A_VERTICAL)
  785.          nBarPos := 4
  786.  
  787.     CASE nGrab == K_END
  788.          ShowStr( nBarPos, 67, A_VERTICAL)
  789.          nBarPos := 20
  790.  
  791.  
  792.     ENDCASE
  793.  
  794.     // show array
  795.     // -----------
  796.     FOR nX := 1 TO 10
  797.         nY := (nBarPos - 4) + nX
  798.  
  799.         // valid values: 1-10
  800.         WHILE nY > 10
  801.            nY -= 10
  802.         END
  803.  
  804.         // Change row-colors White/Lightblue
  805.         ColorMe ( nX+5, 12, nX+5, 64, IIF (nX % 2 == 0, C_NHB, C_NW ))
  806.  
  807.         // show ArrayPosition
  808.         ShowStr ( nX+5, 17, aText [ nY ] )
  809.  
  810.     NEXT
  811.  
  812.     // show ScrollBar
  813.     ShowStr( nBarPos, 67, A_CHOIBOX )
  814.  
  815.  
  816.  RETURN ( NIL )
  817.  
  818.  
  819.  
  820. **************************************************
  821. *
  822. *   FUNCTION SetSound( lSound , lMode ) -> lSound
  823. *
  824. *   Demonstrates a function called via CheckPrompt.
  825. *   This function is passed via CodeBlock, it inverts
  826. *   VAR lSound, which is also passed via the CodeBlock
  827. *   (PER REFERENCE). Returns the new value.
  828. *
  829. *   PARAMETER :  lSound  is a logVar for Sound on/off
  830. *                lMode   .F.= read only lSound and return it
  831. *                        .T.= invert lSound and return it
  832. *
  833.  
  834.  FUNCTION SetSound( lSound , lMode )
  835.  
  836.     IF lMode
  837.        lSound := ! lSound
  838.  
  839.        // check if you're already playing a VOC-File and turn it off
  840.        IF ! lSound
  841.           PlayStop ()
  842.        ENDIF
  843.  
  844.     ENDIF
  845.  
  846.  RETURN (lSound)
  847.  
  848.  
  849.  
  850. /**************************************************
  851.  *
  852.  *   FUNCTION MouseReq()
  853.  *
  854.  *   Demonstrates a function called by the mouse.
  855.  *   This functions is called via SetKey-CodeBlock, on
  856.  *   INKEY-Code 255. This is done with an internal MouseRoutine
  857.  *   (The MouseEventHandler writes 255 into the keyboard-buffer,
  858.  *   when you press a mouse-button [outside Menus/Buttons/Icons])
  859.  *   Inside this functions you might use MSE_Row /MSE_Col /MSE_Key
  860.  *   Information to call a function of your own.
  861.  *
  862.  */
  863.  
  864.  FUNCTION MouseReq()
  865.    LOCAL cOldCol := SETCOLOR('N/W') , cScreen, lMouse := Mse_Show(.F.)
  866.    LOCAL cPos := Save_Mse()
  867.  
  868.     cScreen := OpenMask(9,9,14,32,'MousePosition',0)
  869.  
  870.     @ 11,12 SAY 'Row'
  871.     @ 12,12 SAY 'Column'
  872.     @ 13,12 SAY 'Button'
  873.  
  874.     @ 11,24 SAY Mse_Row() PICT '999'
  875.     @ 12,24 SAY Mse_Col() PICT '999'
  876.     @ 13,24 SAY Mse_Key() PICT '999'
  877.  
  878.     Mse_Show (lMouse )
  879.     inkey (0)
  880.  
  881.     ScrRest( cScreen)
  882.     Rest_Mse ( cPos )
  883.  
  884.     SETCOLOR (cOldCol)
  885.  
  886.  
  887.  RETURN(.T.)
  888.  
  889.  
  890. /**********************************************************
  891.  *
  892.  *   Function ShowMem () -> NIL
  893.  *   Demofunction how to use IsCpu() and IsVideo(),
  894.  *   shows you all memory() return values, some of them
  895.  *   are undocumented by Clipper
  896.  */
  897.  
  898.  FUNCTION ShowMem()
  899.  
  900.   LOCAL nCur := Setcursor(0)
  901.   LOCAL cCol := SETCOLOR( '+GR/*RB')
  902.   LOCAL cScreen := OpenMask (3,15,21,65,'System-Info',;
  903.                             WIN_MESSAGE, C_WBROWN, C_NBEIGE )
  904.  
  905.  
  906.  // Garbage-Collection
  907.  // -------------------
  908.     MEMORY(-1)
  909.  
  910.  // descriptions
  911.  // -------------
  912.     ShowStr ( 06, 20, 'CPU')
  913.     ShowStr ( 07, 20, 'Video Adapter')
  914.     ShowStr ( 09, 20, 'Conventional Memory      KByte' )  //Memory(0)
  915.     ShowStr ( 10, 20, 'Free Swap-Memory         KByte' )  //Mem(0)+MEM(103)
  916.     ShowStr ( 11, 20, 'Largest StringObject     KByte' )  //Memory(1)
  917.     ShowStr ( 12, 20, 'Free Run-Memory          KByte' )  //Memory(2)
  918.     ShowStr ( 13, 20, 'String/Array Memory      KByte' )  //Mem(3)
  919.     ShowStr ( 14, 20, 'Available EMS-Memory     KByte' )  //Mem(4)+(105)
  920.     ShowStr ( 15, 20, 'Fixed Heap-Size          KByte' )  //Mem(101)
  921.     ShowStr ( 16, 20, 'Segments in Heap' )                //102
  922.     ShowStr ( 17, 20, 'Unused Conv. Memory      KByte' )  //Mem(104)
  923.  
  924.  // show memory() returns
  925.  // ----------------------
  926.     @ 06,53 SAY IsCpu ( .t.)
  927.     @ 07,49 SAY IsVideo(.t.)
  928.  
  929.     @ 09,53 SAY MEMORY(0)             PICT '99999'
  930.     @ 10,53 SAY MEMORY(0)+MEMORY(103) PICT '99999'
  931.     @ 11,53 SAY MEMORY(1)             PICT '99999'
  932.     @ 12,53 SAY MEMORY(2)             PICT '99999'
  933.     @ 13,53 SAY MEMORY(3)             PICT '99999'
  934.  
  935.     @ 14,53 SAY MEMORY(4)+MEMORY(105) PICT '99999'
  936.     @ 15,53 SAY MEMORY(101)           PICT '99999'
  937.     @ 16,53 SAY MEMORY(102)           PICT '99999'
  938.     @ 17,53 SAY MEMORY(104)           PICT '99999'
  939.  
  940.  // draw button
  941.  // -------------
  942.     DrawButton(19, 37, C_NW, C_RW, {'  ~Ok  '})
  943.  
  944.     SETCOLOR(cCol)
  945.     SETCURSOR(nCur)
  946.     ScrRest(cScreen)
  947.  
  948.  RETURN( NIL )
  949.  
  950.  
  951. /**********************************************************
  952.  *
  953.  *   Function VgaMenu () -> NIL
  954.  *   Demo using WrapWert(), SetDac() and a_Red(), a_Blue(), a_Green(),
  955.  *   with the help of these functions you can read the Vga-Palette and
  956.  *   change it.  It's also a good example on 'how to add a mouse'.
  957.  */
  958.  
  959.  FUNCTION VgaMenu()
  960.  
  961.  // Coordinates
  962.     LOCAL  nTRow := 7, nLCol := 1
  963.  
  964.  // Array for the 3 main colors
  965.     LOCAL aColorCon := { a_Red(0), a_Green(0), a_Blue(0) }
  966.  
  967.  // Control and UpdateFlags
  968.     LOCAL lNewCon := .f., lNewColorCon := .f., lNewDAC := .f.
  969.  
  970.  // WorkVars
  971.     LOCAL nPalette := 0, nControl := 1
  972.     LOCAL xTemp, nX, nKey, cScreen
  973.  
  974.  // MousePosition and first ControlRow
  975.     LOCAL nMouseRow, nMouseCol, nConRow
  976.  
  977.  // declare ColorSave-Array
  978.     LOCAL aOrgColor [ 16, 3], nOrgButt
  979.  
  980.  // turn of Cursor and Mouse
  981.      LOCAL nCursor := SETCURSOR(0), lMouse := Mse_Show (.F.)
  982.  
  983.  // save Points of Interest
  984.     LOCAL cPos := Save_MSE()
  985.  
  986.  // save original values
  987.     FOR nX := 0 TO 15
  988.         aOrgColor [nX+1] := { a_Red(nX), a_Green(nX), a_Blue(nX) }
  989.     NEXT
  990.  
  991.  // Here comes the surrounding 'move-loop'
  992.  // --------------------------------------
  993.  DO WHILE nKey # K_ESC
  994.  
  995.  
  996.     // build screen
  997.     // --------------
  998.     cScreen := OpenMask( nTRow, nLCol, nTRow+11, nLCol+75,;
  999.                          'ColorSet', WIN_MESSAGE, C_WBROWN, C_NBEIGE)
  1000.  
  1001.     // Calculate first ControlRow
  1002.     nConRow := nTRow+4
  1003.  
  1004.  
  1005.     // draw ColorFields
  1006.     // -----------------
  1007.     FOR nX := 0 TO 15
  1008.         OutLine ( nTRow+2, nLCol+7+( nX*4 ), ' ', 1, (nX+1)*15 )
  1009.  
  1010.     NEXT
  1011.  
  1012.  
  1013.     // 1.Controller is activ (pushed)
  1014.     // --------------------------------------------
  1015.     OutLine ( nTRow+4, nLCol+2, 'R', 2)
  1016.     OutLine ( nTRow+6, nLCol+2, 'G', 1)
  1017.     OutLine ( nTRow+8, nLCol+2, 'B', 1)
  1018.  
  1019.  
  1020.     // draw field
  1021.     // ------------
  1022.     xTemp := nTRow+10
  1023.  
  1024.     ShowStr ( xTemp, nLCol+3, 'Farbe:' )
  1025.  
  1026.     ShowStr ( xTemp, nLCol+44, 'F3' )
  1027.     ShowStr ( xTemp, nLCol+56, 'F4' )
  1028.  
  1029.     nOrgButt := SetPref (C_BUTTLOWER, 208 )
  1030.     OutLine ( xTemp, nLCol+47, 'Reset',     1, C_NW )
  1031.     OutLine ( xTemp, nLCol+59, 'Reset all', 1, C_NW )
  1032.  
  1033.     OutLine ( xTemp, nLCol+11, STR( nPalette, 3), 1, C_NW )
  1034.     OutLine ( xTemp, nLCol+18, SPACE(22), 1, 15 )
  1035.  
  1036.     SetPref (C_BUTTLOWER, nOrgButt )
  1037.  
  1038.  
  1039.     // ============
  1040.     // Input-Loop
  1041.     // ------------
  1042.     DO WHILE .t.
  1043.  
  1044.  
  1045.  
  1046.        // Draw Control-line and Values
  1047.        // -----------------------------
  1048.        FOR nX := 1 TO 3
  1049.            // Calculate Row
  1050.            xTemp := nTRow+2+( nX * 2)
  1051.  
  1052.            // Draw Control-line ( akctive Control-line light white)
  1053.            HLinie  ( xTemp, nLCol+6, nLCol+70,;
  1054.                           IIF ( nControl == nX, 240, C_NW), A_HORIZONT )
  1055.  
  1056.            ShowStr ( xTemp, nLCol+6+ aColorCon [nX], '')
  1057.            ShowStr ( xTemp, nLCol+71, STR( aColorCon [nX], 2) )
  1058.  
  1059.        NEXT
  1060.  
  1061.        // draw description
  1062.        // -----------------
  1063.        ShowStr ( nTRow+10, nLCol+12, STR( nPalette, 3))
  1064.        ShowStr ( nTRow+10, nLCol+18, SPACE(24), nPalette * 16)
  1065.  
  1066.  
  1067.        // Wait for the user to do something
  1068.        // ----------------------------------
  1069.        Mse_Show (.t.)
  1070.        nKey := INKEY(0)
  1071.        Mse_Show (.f.)
  1072.  
  1073.        // =====================
  1074.        // get key
  1075.        // mousebutton pushed ?
  1076.        // ---------------------
  1077.        IF nKey == K_MOUSE
  1078.  
  1079.           // get Position
  1080.           nMouseRow := Mse_Row()
  1081.           nMouseCol := Mse_Col()
  1082.  
  1083.  
  1084.           DO CASE
  1085.  
  1086.           // Mouse on CloseButton ?
  1087.           // -----------------------
  1088.           CASE nMouseRow == nTRow .AND. ( nMouseCol == nLCol .OR. ;
  1089.                                          nMouseCol == nLCol+1 )
  1090.              // off we go...
  1091.              nKey := K_ESC
  1092.  
  1093.           // Mouse on MoveButton ?
  1094.           // ----------------------
  1095.           CASE nMouseRow == nTRow .AND. ( nMouseCol == nLCol+74 .OR. ;
  1096.                                          nMouseCol == nLCol+75 )
  1097.              // move Window
  1098.              nTRow := IIF ( nTRow == 0, 7, 0)
  1099.              nLCol := IIF ( nLCol == 0, 1, 0)
  1100.              EXIT
  1101.  
  1102.           // Mouse on ColorField ?
  1103.           // ----------------------
  1104.           CASE nMouseRow == nTRow+2 .AND. nMouseCol > nLCol+7 ;
  1105.                                    .AND. nMouseCol < nLCol+70
  1106.  
  1107.                // on which one, please ?
  1108.                FOR nX := 1 TO 16
  1109.  
  1110.                    // I see.. get ColorValues
  1111.                    IF nMouseCol < nLCol+7+( nX * 4 )
  1112.                       nPalette := --nX
  1113.                       aColorCon := { a_red  ( nPalette ),;
  1114.                                     a_green( nPalette ),;
  1115.                                     a_blue (nPalette  ) }
  1116.                       EXIT
  1117.                    ENDIF
  1118.                NEXT
  1119.  
  1120.  
  1121.             // Maus on RED ?
  1122.             // --------------
  1123.           CASE nMouseRow == nTRow+4 .AND. nMouseCol > nLCol+5 ;
  1124.                                    .AND. nMouseCol < nLCol+70
  1125.                nControl := 1
  1126.                lNewCon := lNewDAC := .t.
  1127.                aColorCon[ nControl ] := nMouseCol - (nLCol+6)
  1128.  
  1129.  
  1130.             // hum, maybe on GREEN ?
  1131.             // ---------------------
  1132.           CASE nMouseRow == nTRow+6 .AND. nMouseCol > nLCol+5 ;
  1133.                                    .AND. nMouseCol < nLCol+70
  1134.                nControl := 2
  1135.                lNewCon := lNewDAC := .t.
  1136.                aColorCon[ nControl ] := nMouseCol - (nLCol+6)
  1137.  
  1138.  
  1139.             // or BLUE
  1140.             // --------
  1141.           CASE nMouseRow == nTRow+8 .AND. nMouseCol > nLCol+5 ;
  1142.                                    .AND. nMouseCol < nLCol+70
  1143.                nControl := 3
  1144.                lNewCon := lNewDAC := .t.
  1145.                aColorCon[ nControl ] := nMouseCol - (nLCol+6)
  1146.  
  1147.  
  1148.             // Reset Color ?
  1149.             // -------------
  1150.           CASE nMouseRow == nTRow+10 .AND. nMouseCol > nLCol+47 ;
  1151.                                     .AND. nMouseCol < nLCol+51
  1152.                nKey := K_F3
  1153.  
  1154.  
  1155.             // Reset all Colors ?
  1156.             // ------------------
  1157.           CASE nMouseRow == nTRow+10 .AND. nMouseCol > nLCol+59 ;
  1158.                                     .AND. nMouseCol < nLCol+66
  1159.                nKey := K_F4
  1160.  
  1161.           ENDCASE
  1162.        ENDIF
  1163.  
  1164.  
  1165.        // Now for 'normal' KeyCodes
  1166.        // --------------------------
  1167.        DO CASE
  1168.  
  1169.  
  1170.          // Increase or Decrease ColorIntensity ?
  1171.          // --------------------------------------
  1172.        CASE nKey == K_LEFT .OR. nKey == K_RIGHT
  1173.             aColorCon[nControl] := ;
  1174.               WrapWert ( nKey == K_RIGHT, aColorCon[nControl], 0, 63 )
  1175.               lNewDAC := .t.
  1176.  
  1177.  
  1178.          // Beginning or End of Control-line ?
  1179.          // -----------------------------------
  1180.        CASE nKey == K_HOME .OR. nKey == K_END
  1181.             aColorCon[nControl] := IIF( nKey == K_HOME, 0, 63 )
  1182.             lNewDAC := .t.
  1183.  
  1184.  
  1185.          // Up or Down, change MainColor
  1186.          // -----------------------------
  1187.        CASE nKey == K_UP .OR. nKey == K_DOWN
  1188.             // get new ColorNo
  1189.             nControl := WrapWert( nKey == K_DOWN, nControl, 1, 3)
  1190.             lNewCon := .t.
  1191.  
  1192.  
  1193.          // Next Palette
  1194.          // -------------
  1195.        CASE nKey == K_PGDN .OR. nKey == K_PGUP
  1196.             nPalette := WrapWert( nKey == K_PGUP, nPalette, 0, 15)
  1197.             aColorCon := { a_red  (nPalette),;
  1198.                           a_green(nPalette),;
  1199.                           a_blue (nPalette)}
  1200.  
  1201.  
  1202.          // Restore all DAC-Registers
  1203.          // --------------------------
  1204.        CASE nKey == K_F4
  1205.             FOR nX := 1 TO 16
  1206.                 SetDac ( nX-1, aOrgColor [ nX, 1],;
  1207.                                aOrgColor [ nX, 2],;
  1208.                                aOrgColor [ nX, 3] )
  1209.             NEXT
  1210.  
  1211.             lNewColorCon := .t.
  1212.  
  1213.  
  1214.             // Restore active DAC-Register
  1215.             // ----------------------------
  1216.        CASE nKey == K_F3
  1217.             lNewDAC := .t.
  1218.             aColorCon := { aOrgColor [ nPalette+1, 1],;
  1219.                           aOrgColor [ nPalette+1, 2],;
  1220.                           aOrgColor [ nPalette+1, 3] }
  1221.  
  1222.          // Done ?
  1223.          // -------
  1224.        CASE nKey == K_ESC
  1225.             EXIT
  1226.  
  1227.  
  1228.        ENDCASE
  1229.  
  1230.  
  1231.  
  1232.        // Set new ColorControl ?
  1233.        // =======================
  1234.        IF lNewCon
  1235.  
  1236.           // Flag reset
  1237.           lNewCon := .f.
  1238.  
  1239.           // deactivate old ColorControl
  1240.           OutFrame ( nConRow, nLCol+2, nConRow, nLCol+5, 1)
  1241.  
  1242.           // calculate new row
  1243.           nConRow := nTRow+2+( 2*nControl )
  1244.  
  1245.           // 'push' the right ColorButton
  1246.           OutFrame( nConRow, nLCol+2, nConRow, nLCol+5, 2)
  1247.  
  1248.        ENDIF
  1249.  
  1250.  
  1251.        // Read new ColorRegister ?
  1252.        // =========================
  1253.        IF lNewColorCon
  1254.  
  1255.           // Flag reset
  1256.           lNewColorCon := .f.
  1257.  
  1258.           // Read ColorRegister and save to array
  1259.           aColorCon := { a_red  (nPalette),;
  1260.                         a_green(nPalette),;
  1261.                         a_blue (nPalette)}
  1262.        ENDIF
  1263.  
  1264.        // DAC new ?
  1265.        // ==========
  1266.        IF lNewDAC
  1267.           lNewDAC := .f.
  1268.           SetDAC ( nPalette, aColorCon[1], aColorCon[2], aColorCon[3] )
  1269.  
  1270.        ENDIF
  1271.  
  1272.  
  1273.     ENDDO
  1274.     ScrRest (cScreen)
  1275.  
  1276.   ENDDO
  1277.   Mse_Show(lmouse)
  1278.  
  1279.   Rest_MSE ( cPos )
  1280.  
  1281.  
  1282.   RETURN ( nil )
  1283.  
  1284.  
  1285.  
  1286.  
  1287.  *********** EOF Demo.prg **********
  1288.