home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / news / 770 / fastgt15 / fastgtde / demo.prg < prev    next >
Text File  |  1994-03-27  |  12KB  |  366 lines
  1.  
  2. #include "inkey.ch"
  3. #include "fastgt.ch"
  4.  
  5. //
  6. // FastGT. The New Clipper Graphical Term
  7. //
  8. // (C) 1992-94 Manu Roibal
  9. //
  10.  
  11.  
  12. Function main()
  13.  
  14. Local GetList  := {}
  15. Local cData1   := "This's a demo program"
  16. Local cData2   := "More gets   "
  17. Local cScr1
  18. Local cScr2
  19. Local cScr3
  20. Local nInd
  21. Local aArray   := {}
  22. Local hButtom1
  23. Local hButtom2
  24. Local hIcon1
  25. Local nMode
  26. Local hHandle
  27. Local lMouse
  28. Local nKey     := 0
  29.  
  30.         SetCancel( .F. )
  31.  
  32. //        nMode := SearchMode()         // search the VESA mode to use
  33. //        hHandle := gtInit( nMode )    // installs FastGT system
  34.  
  35.         hHandle := gtInit( 4 )    // installs FastGT system
  36.                                   // You must test with
  37.                                   //
  38.                                   //    0  SVGA  640x400x256
  39.                                   //    1  SVGA  640x480x256
  40.                                   //    2  SVGA  800x600x256
  41.                                   //    3  SVGA 1024x768x256
  42.                                   //    4  VGA   640x480x16
  43.  
  44.         Set ScoreBoard Off
  45.  
  46.         Cls
  47.  
  48.         ? "FastGT. The New Technology of Fastware"
  49.         ?
  50.         ? "(C) 1992-94 Manu Roibal"
  51.         ?
  52.         ? "Now, you can build graphic aplications with Clipper!!!"
  53.         ?
  54.         ? "VESA Version       : " + VesaVer()
  55.         ? "VESA OEM           : " + VesaOEM()
  56.         ? "MaxRow             : " + Str( MaxRow() )
  57.         ? "MaxCol             : " + Str( MaxCol() )
  58.         ? "Write BIOS Support : " + If( VesaBIOS(), "Yes", "No" )
  59.         ?
  60.         ? "─────────────────────────────────────────────────────────"
  61.         ?
  62.         ? "If your SVGA is >256kb you can test gtInit( 0 ) or gtInit( 1 )"
  63.         ? "And if it's 1Mb Video Card you can test gtInit( 2 ) and gtInit( 3 )"
  64.         ? "But... if you haven't a SVGA you can test gtInit( 4 ) in VGA standard"
  65.         ?
  66.         ? "─────────────────────────────────────────────────────────"
  67.         ?
  68.         ? "Push any key to continue"
  69.  
  70.         MyInkey()
  71.  
  72.         MouseCursor( MOUSE_ON )
  73.  
  74.         MousePointer( MOUSE_CLOCK )
  75.  
  76.         Alert( "This's a Standard Alert();;Do you like FastGT?;;" + ;
  77.                "(C) 1992-93 Manu Roibal;;" + ;
  78.                "Working... The mouse pointer is a clock", { "Ok" } )
  79.  
  80.         MousePointer( MOUSE_POINT )
  81.  
  82.         @ 0, 0, MaxRow(), MaxCol() GTBOX COLOR "w/b*"
  83.  
  84.         ShowMSIco( "whello.ico",    60, 300 )
  85.         ShowMSIco( "bc.ico",        60, 340 )
  86.         ShowMSIco( "dlldemo.ico",   60, 380 )
  87.         ShowMSIco( "ffind.ico",     60, 420 )
  88.         ShowMSIco( "hdump.ico",     60, 460 )
  89.         ShowMSIco( "msgwnd.ico",    60, 500 )
  90.         ShowMSIco( "tstapp.ico",    60, 540 )
  91.         ShowMSIco( "rwdemo.ico",    60, 580 )
  92.         ShowMSIco( "tstapp.ico",   100, 300 )
  93.         ShowMSIco( "critter.ico",  100, 340 )
  94.         ShowMSIco( "critter2.ico", 100, 380 )
  95.         ShowMSIco( "calc.ico",     100, 420 )
  96.         ShowMSIco( "checkers.ico", 100, 460 )
  97.         ShowMSIco( "cursor.ico",   100, 500 )
  98.         ShowMSIco( "ellipse.ico",  100, 540 )
  99.         ShowMSIco( "fellipse.ico", 100, 580 )
  100.         ShowMSIco( "fill.ico",     140, 300 )
  101.         ShowMSIco( "frect.ico",    140, 340 )
  102.         ShowMSIco( "owlpaint.ico", 140, 380 )
  103.         ShowMSIco( "pen.ico",      140, 420 )
  104.         ShowMSIco( "rect.ico",     140, 460 )
  105.         ShowMSIco( "ttt.ico",      140, 500 )
  106.         ShowMSIco( "pserror.ico",  140, 540 )
  107.  
  108.         @ 30,  20 GTDRAWICON "Salida.fic"
  109.         @ 30,  60 GTDRAWICON "Camara.fic"
  110.         @ 30, 100 GTDRAWICON "Msdos.fic"
  111.         @ 30, 140 GTDRAWICON "Brocha.fic"
  112.         @ 30, 180 GTDRAWICON "Help.fic"
  113.         @ 90,  20 GTDRAWICON "Cia001.fic"
  114.         @ 90,  60 GTDRAWICON "Hogar.fic"
  115.         @ 90, 100 GTDRAWICON "decesos.fic"
  116.         @ 90, 140 GTDRAWICON "Vida.fic"
  117.         @ 90, 180 GTDRAWICON "Vida1m.fic"
  118.  
  119.         @ 90, 220 GTGIVEICON "Familia.fic" INTO hIcon1
  120.  
  121.         GTDRAWICON hIcon1
  122.  
  123.         SetCursor( 0 )
  124.         While MyInkey() != K_ESC
  125.           GTPUSHICON hIcon1
  126.         End
  127.  
  128.         @ 18, 6, 23, 24 GTWINBOX "Mouse Demo" COLOR "w/b"
  129.         @ 20, 10 Say "▓" Color "w/b"
  130.         @ 20, 15 Say "▓" Color "w/b"
  131.         @ 20, 20 Say "▓" Color "w/b"
  132.         While nKey != K_ESC
  133.           nKey := Inkey( 0 )
  134.           if nKey == K_MOUSE_LEFT
  135.             @ 20, 10 Say "▓" Color "gr+/b"
  136.           elseif nKey == K_MOUSE_CENTRE
  137.             @ 20, 15 Say "▓" Color "gr+/b"
  138.           elseif nKey == K_MOUSE_RIGHT
  139.             @ 20, 20 Say "▓" Color "gr+/b"
  140.           elseif nKey == K_MOUSE_RELEASE
  141.             @ 20, 10 Say "▓" Color "w/b"
  142.             @ 20, 15 Say "▓" Color "w/b"
  143.             @ 20, 20 Say "▓" Color "w/b"
  144.           endif
  145.           @ 22, 7 Say "Key pressed: " + Str( nKey, 3 ) color "w/b"
  146.         end
  147.  
  148.         SetCursor( 1 )
  149.  
  150.         @ 6, 3, 18, 50 GTWINBOX "FastGT Demo" COLOR "R/W"
  151.         @  9, 5 Say "This's a demo of FastGT"                   Color "B/W"
  152.         @ 11, 5 Say "You can draw graphic elements and display" Color "R/W"
  153.         @ 12, 5 Say "texts, boxs, shadows... with Clipper code" Color "R/W"
  154.         @ 14, 5 Say "Press Esc to exit"                         Color "B+/W"
  155.  
  156.         @ 15, 62 Say "Bar Demo" Color "B/B*"
  157.         DrawBar( 230, 470, 120, 20, 6, 2, 10 )
  158.         DrawBar( 230, 510, 160, 20, 6, 3, 11 )
  159.         DrawBar( 230, 550, 110, 20, 6, 4, 12 )
  160.  
  161.  
  162.         lMouse := MouseCursor( MOUSE_OFF )
  163.         VesaWriteAt( 352, 480, "Line Demo", 15, 9, 0, 8 )
  164.         VesaWriteAt( 368, 480, "Line Demo", 15, 9, 0, 10 )
  165.         VesaWriteAt( 384, 480, "Line Demo", 15, 9, 0, 12 )
  166.         VesaWriteAt( 400, 480, "Line Demo", 15, 9, 0, 14 )
  167.         VesaWriteAt( 416, 480, "Line Demo", 15, 9, 0, 16 )
  168.         Vesaline( 300, 450, 350, 450, 10 )
  169.         Vesaline( 300, 450, 300, 500, 11 )
  170.         Vesaline( 300, 500, 350, 500, 12 )
  171.         Vesaline( 350, 500, 350, 450, 13 )
  172.         Vesaline( 350, 500, 300, 450, 14 )
  173.         Vesaline( 350, 450, 300, 500, 15 )
  174.         MouseCursor( lMouse )
  175.  
  176.         SetCursor( 0 )
  177.         @ 16, 10 GTDRAWBTN "Cancel" INTO hButtom1
  178.         @ 16, 35 GTDRAWBTN "  Ok  " INTO hButtom2
  179.  
  180.         While MyInkey() != K_ESC
  181.           GTPUSHBTN hButtom2
  182.         End
  183.         GTPUSHBTN hButtom1
  184.         SetCursor( 1 )
  185.         
  186.  
  187.         @ 14, 19, 22, 77 GTWINBOX "MultiFont Demo" COLOR "R/B"
  188.  
  189.         @ 16, 22 Say "System Big Font   acdefghijklmnopqrstuvwxyz1234567890" Color "GR+/B"
  190.  
  191.         VesaLoadFont( "Script.fon" )
  192.         VesaSetFont( FONT_USER )
  193.  
  194.         @ 17, 22 Say "User Font 1       acdefghijklmnopqrstuvwxyz1234567890" Color "G+/B"
  195.  
  196.         VesaLoadFont( "Antique.fon" )
  197.         VesaSetFont( FONT_USER )
  198.  
  199.         @ 18, 22 Say "User Font 2       acdefghijklmnopqrstuvwxyz1234567890" Color "G+/B"
  200.  
  201.         VesaLoadFont( "Roman.fon" )
  202.         VesaSetFont( FONT_USER )
  203.  
  204.         @ 19, 22 Say "User Font 3       acdefghijklmnopqrstuvwxyz1234567890" Color "G+/B"
  205.  
  206.         VesaLoadFont( "Italic.fon" )
  207.         VesaSetFont( FONT_USER )
  208.  
  209.         @ 20, 22 Say "User Font 4       acdefghijklmnopqrstuvwxyz1234567890" Color "G+/B"
  210.  
  211.         VesaSetFont( FONT_SMALL )
  212.  
  213.         @ 21, 22 Say "System Small Font acdefghijklmnopqrstuvwxyz1234567890" Color "W+/B"
  214.  
  215.         VesaSetFont( FONT_BIG )
  216.  
  217.         MyInkey()
  218.  
  219.         @ 2, 27, 11, 72 GTWINBOX "Program Manager" COLOR "R/W"
  220.  
  221.         @  5, 30 Say "This's a demo of FastGT Window System"   Color "R/W"
  222.         @  7, 30 Say "You have source code of these functions" Color "G+/W"
  223.         @  9, 30 Say "You can add mouse control, scroll..."    Color "B+/W"
  224.         UserBox( 5, 29, 41, 15,  8 )
  225.         UserBox( 7, 29, 41,  8, 15 )
  226.         UserBox( 9, 29, 41,  8, 15 )
  227.  
  228.         SetCursor( 0 )
  229.         MyInkey()
  230.         UserBox( 5, 29, 41,  8, 15 )
  231.         UserBox( 7, 29, 41, 15,  8 )
  232.         MyInkey()
  233.         UserBox( 7, 29, 41,  8, 15 )
  234.         UserBox( 9, 29, 41, 15,  8 )
  235.         MyInkey()
  236.         UserBox( 9, 29, 41,  8, 15 )
  237.         SetCursor( 1 )
  238.  
  239.         cScr1 := SaveScreen( 12, 8, 17, 60 )       // goes to disk
  240.  
  241.         @ 12, 8, 17, 60 BOX "╔═╗║╝═╚║ "   Color "R/W"
  242.         @ 14, 10 Say "Data 1:" Get cData1 Color "B/W"
  243.         @ 15, 10 Say "Data 2:" Get cData2 Color "R/W"
  244.         Read
  245.  
  246.         RestScreen( 12, 8, 17, 60, cScr1 )         // restores from disk
  247.  
  248.         @ 20, 2, 23, 50 BOX "╔═╗║╝═╚║ "         Color "B/W"
  249.         @ 21, 4 Say "FastGT, (C) Manu Roibal"   Color "G+/W"
  250.         @ 22, 4 Say "Welcome to graphics world" Color "R/W"
  251.  
  252.         MyInkey()
  253.         SetCursor( 0 )
  254.         MyInkey()
  255.         SetCursor( 1 )
  256.         MyInkey()
  257.         SetCursor( 2 )
  258.         MyInkey()
  259.  
  260.         SetColor( "GR+/B" )
  261.         @ 10, 20, 16, 76 GTWINBOX "MemoEdit Demo"
  262.         VesaLoadFont( "Script.fon" )
  263.         VesaSetFont( FONT_USER )
  264.         MemoEdit( "This's a standard MemoEdit... Default Font is Script", 12, 21, 15, 75 )
  265.         VesaSetFont( FONT_BIG )
  266.  
  267.         cScr3 := SaveScreen( 8, 29, 20, 51 )
  268.  
  269.         SetColor( "W/B, GR+/B, , , N+/B" )
  270.         @ 8, 29, 20, 51 GTWINBOX "aChoice Demo"
  271.  
  272.         aAdd( aArray, "And this, is a" )
  273.         aAdd( aArray, "standard aChoice." )
  274.         aAdd( aArray, "***" )
  275.         aAdd( aArray, "Default font is" )
  276.         aAdd( aArray, "Italic." )
  277.         aAdd( aArray, "***" )
  278.         aAdd( aArray, "All code is 100%" )
  279.         aAdd( aArray, "Clipper Standard" )
  280.         aAdd( aArray, "Code" )
  281.         aAdd( aArray, "***" )
  282.         aAdd( aArray, "New Line" )
  283.         VesaLoadFont( "Italic.fon" )
  284.         VesaSetFont( FONT_USER )
  285.         aChoice( 10, 30, 19, 50, aArray, .T. )
  286.         VesaSetFont( FONT_BIG )
  287.  
  288.         cScr2 := SaveScreen( 16, 17, 21, 56 )
  289.  
  290.         @ 16, 17, 21, 56 GTWINBOX "256 colors - Pallete Demo" COLOR "W/R"
  291.         lMouse := MouseCursor( MOUSE_OFF )
  292.         For nInd := 0 To 255
  293.           VesaLine( 18 * 16, 20 * 8 + nInd, 21 * 16, 20 * 8 + nInd, nInd )
  294.         Next
  295.         MouseCursor( lMouse )
  296.         SetCursor( 0 )
  297.         MyInkey()
  298.         SetCursor( 1 )
  299.  
  300.         RestScreen( 16, 17, 21, 56, cScr2 )
  301.  
  302.         RestScreen( 8, 29, 20, 51, cScr3 )
  303.  
  304.         SetColor( "W/B, GR+/B, , , N+/B" )
  305.  
  306.         USE demo new
  307.         @ 6, 10, 22, 56 GTWINBOX "dbEdit Demo"
  308.  
  309.         VesaLoadFont( "UperCase.fon" )
  310.         VesaSetFont( FONT_USER )
  311.         Keyboard( Chr( K_RETURN ) )
  312.         dbEdit( 8, 11, 21, 53, { "Name", "Country" }, "DEMOFUNC" )
  313.  
  314.         CLOSE demo
  315.  
  316.         VesaLoadFont( "Script.fon" )
  317.         VesaSetFont( FONT_USER )
  318.         Alert( "Bye bye;;Press <─┘ to return to text mode;;" + ;
  319.                "For register read the file register.doc", { "Ok", "Register" } )
  320.  
  321.         gtClose( hHandle )                // deinstalls FastGT system
  322.  
  323. Return( Nil )
  324.  
  325.  
  326. Function DemoFunc( nMode, nCol )
  327. Static nPos
  328. Local  nIndex := RecNo() / LastRec()
  329. Local  nRet   := 1
  330.     If nPos == Nil
  331.       nPos := Int( 10 + 11 * nIndex )
  332.     EndIf
  333.     WriteChar( nPos, 55, , .F. )
  334.     nPos := Int( 10 + 11 * nIndex )
  335.     WriteChar( nPos, 55, "G/G", .T. )
  336.     If LastKey() == K_MOUSE_RIGHT .Or. LastKey() == K_ESC
  337.       nRet := 0
  338.     EndIf
  339. Return( nRet )
  340.  
  341.  
  342. Static Function WriteChar( nY, nX, cColor, lMode )
  343.     @ nY, nX Say " " Color cColor
  344.     If lMode
  345.       UserBox( nY, nX, 1, 8, 10 )
  346.     EndIf
  347. Return( Nil )
  348.  
  349.  
  350.  
  351. static function MyInkey()
  352. local nKey := Inkey( 0 )
  353.  
  354.     if nKey == K_MOUSE_LEFT  .or. ;
  355.        nKey == K_MOUSE_RIGHT .or. ;
  356.        nKey == K_MOUSE_CENTRE
  357.  
  358.       Inkey( 0 )        // when a mouse button is pressed 2 keys are
  359.                         // introduced to keyboard buffer. One for the
  360.                         // specified mouse buttons and another when
  361.                         // mouse button is released.
  362.  
  363.     endif
  364.  
  365. return( nKey )
  366.