[<<Previous Entry] [^^Up^^] [Next Entry>>] [Menu] [About The Guide]


/*********************************************************************

   Demo.PRG - CUA-Clip Library examples & Demo program.

   This program illustrates examples of the functions within the
   Delcom Interface Library.


Author: Dave Rooney
Date  : Feb. 22, 1993

*********************************************************************/

#include "Demo.CH"
#include "Set.CH"

STATIC   cDOSScreen,    ; // DOS screen on entry
         cOldColor,     ; // Colour on entry
         lBlink,        ; // SETBLINK on entry
         nCursor          // Cursor on entry


PROCEDURE Main

//
// Save the environment on entry...
//
cDOSScreen  := SAVESCREEN()
cOldColor   := SETCOLOR()
lBlink      := SETBLINK(.F.)
nCursor     := SETCURSOR(0)

//
// System setup...
//
InitSets()

//
// Display the main screen.
//
WallPaper()

//
// Call the menu...
//
MainMenu()

//
// Yer outta there!
//
Quit_Sys()

RETURN
//
// EOP: Main
//


/***********************************************************************

   InitSets - Perform some system setups, and initialize the colours.

***********************************************************************/

FUNCTION InitSets

//
// Clipper settings...
//
SET CENTURY OFF
SET( _SET_BELL, .F. )
SET( _SET_CONFIRM, .F. )
SET( _SET_DATEFORMAT, "YY.MM.DD" )     // Standard ANSI format.
SET( _SET_DELETED, .T. )
SET( _SET_ESCAPE, .T. )
SET( _SET_EXACT, .F. )
SET( _SET_EXCLUSIVE, .F. )
SET( _SET_MESSAGE, MAXROW() )
SET( _SET_MCENTER, .T. )
SET( _SET_SCOREBOARD, .F. )
SET( _SET_SOFTSEEK, .F. )
SET( _SET_WRAP, .T. )

// Disable default call to Help.
SETKEY( K_F1, NIL )

//
// CUACLIP.LIB settings...
//
WindowsComp( .T. )                              // Windows compatibility
SetFlushKey( K_F10 )                            // GET flush key
SetListKey( K_F2 )                              // GET list key

//
// System colours.
//
SETCOLOR( "W/B, W+/R,,, N/W" )
SetMessColor( "W+/B" )                          // Message area
SetMenuColor( "W+/B, W+/R, W/B, R+/B, GR+/R" )  // Bar menus
SetPullColor( "N/W*, W+/B, W/W*, R/W*, R+/B" )  // Pull-downs/Pull-outs
SetPopColor( { "B+/W*", "W+/R", "N/W*" } )      // Pop-up lists
SetGetColor( { "N/W", "W+/R", "N/W", "" } )     // GETs

RETURN NIL
//
// EOP: InitSets
//


/***********************************************************************

   WallPaper - Display the main screen 'wallpaper'.

***********************************************************************/

FUNCTION WallPaper

LOCAL cOldColor,     ; // Colour on entry
      cName,         ; // Wallpaper name
      cPaper,        ; // Wallpaper output string
      nLines,        ; // Number of lines in the wallpaper string
      i                // Loop counter

cOldColor := SETCOLOR()
cName     := "Delcom Interface Library    "

cPaper := REPLICATE( cName, (( MAXROW() / 2 ) * MAXCOL() ) / LEN( cName ) )
nLines := MLCOUNT( cPaper, 80, 3, .F. )

DISPBEGIN()

SETCOLOR( "W/B" )

@ 0,0 CLEAR TO 0,MAXCOL()
@ MAXROW(), 0 CLEAR TO MAXROW(), MAXCOL()

SETCOLOR( "B/W" )

@ 1,0 CLEAR TO MAXROW() - 1,MAXCOL()

FOR i := 1 TO nLines * 2 STEP 2
   @ i, 0 SAY MEMOLINE( cPaper, 80, MAX( 1, ( i / 2 )), 3, .F. )
NEXT

Message( "" )

DISPEND()

//
// Reset environment...
//
SETCOLOR( cOldColor )

RETURN NIL
//
// EOP: WallPaper
//


/***********************************************************************

   Quit_Sys - Terminate operation and restore the DOS environment.

***********************************************************************/

FUNCTION Quit_Sys

//
// Reset the environment...
//
SetMouse( MOUSE_OFF )

SETCOLOR( cOldColor )
RESTSCREEN(,,,, cDOSScreen )

SETBLINK( lBlink )
SETCURSOR( nCursor )

@ MAXROW() - 1, 0 CLEAR
SETPOS( MAXROW() - 1, 0 )

//
// Must use the QUIT command in order
// to properly reset the mouse driver.
//
QUIT

RETURN NIL
//
// EOP: Quit_Sys
//

This page created by ng2html v1.05, the Norton guide to HTML conversion utility. Written by Dave Pearson