Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : WINDOWS.ZIP
Filename : DEMO.PRG

 
Output of file : DEMO.PRG contained in archive : WINDOWS.ZIP
*-----------------------COPYRIGHT 1987,1988 (c) LOGITEK---------------------
*
* All Registered Users are free to modify and use this source code
* as they see fit, with no royalties, obligations or fees to LOGITEK.
*
*-----------------------------------------------------------------------
set scoreboard off
set cursor off

************************
** Check Monitor Type **
************************

if(scrmode() = 7)
shaded = 0
color1 = "w+/n"
color2 = "n/w"
color3 = "w+/n"
color4 = "w+/n"
color5 = "n/w"
color6 = "w+/n"
color7 = "n/w"
color8 = "w/n"
color9 = "w+/n"
color10 = "w+/n"
color11 = color10
color12 = "n/w"
color13 = "w/n"
color14 = "w+/n"
color15 = "n/w"
else
shaded = 1
color1 = "r+/n"
color2 = "n/bg"
color3 = "rb/n"
color4 = "w/b"
color5 = "n/bg"
color6 = "n/bg"
color7 = "n/w"
color8 = "n/rb"
color9 = "w+/n"
color10 = "gr+/n"
color11 = "rb+/n"
color12 = "n/w"
color13 = "w/n"
color14 = "b/w"
color15 = "b/g"
endif

********************
** Set Up Windows **
********************
do wind0 with color15
do wind1 with color2
do wind2 with color3
do wind3 with color4
do wind4 with color5


clearscr(0,0,24,79,color7,32)

box(4,3,22,77,1,1,color7)

set color to &color14
@ 4,20 say chr(17)
set color to &color4
@ 4,21 say " A TRUE Windowing Library For Clipper "
set color to &color14
@ 4,61 say chr(16)

if(scrmode() = 7)
color4 = "n/w"
endif

do title with color6 && Moving boxes for title

wselect(1) && First Box
wuse(5,10,5,0,color9)
wframe()
wdisplay()

wselect(2) && Second Box
wuse(5,10,14,0,color6)
wframe()
wdisplay()

wselect(3) && third Box
wuse(5,10,20,35,color10)
wframe()
wdisplay()

wselect(4) && Fourth Box
wuse(5,10,14,70,color1)
wframe()
wdisplay()

wselect(5) && Fifth Box
wuse(5,10,5,70,color11)
wframe()
wdisplay()

key = 0

currwind = 1

do while currwind < 6

heigth = wrow(currwind)
width = wcolumn(currwind)

do while wcolscr(currwind) < 12
sound(250,5)
wshift(2,currwind)
sound(125,5)
enddo

do while wcolscr(currwind) > 56
sound(250,5)
wshift(4,currwind)
sound(125,5)
enddo


do while wrowscr(currwind) + (heigth - 1) < 16
sound(250,5)
wshift(3,currwind)
sound(125,5)
enddo

do while wcolscr(currwind) < 35
sound(250,5)
wshift(2,currwind)
sound(125,5)
enddo

do while wcolscr(currwind) > 35
sound(250,5)
wshift(4,currwind)
sound(125,5)
enddo

do while wrowscr(currwind) > 9
sound(250,5)
wshift(1,currwind)
sound(125,5)
enddo


**********************
** Display The Info **
**********************

wzoom(2000,600,50,(79+currwind))
wdisplay((79 + currwind))
key = keycode()
wclose((79 + currwind))

currwind = currwind + 1

enddo

wrelease(1)
wrelease(2)
wrelease(3)
wrelease(4)
wrelease(5)
wrelease(80) && Release all unneeded windows
wrelease(81)
wrelease(82)
wrelease(83)
wrelease(84)

clearscr(5,4,21,76,color12,' ')

*******************
** MENU SELECTION *
*******************
oldcntr = 1
menucntr = 1
code = 0

shade(5,5,7,58,color4,color12)
box(5,5,7,58,3)

printstr(6,7,"Windows")
printstr(6,19,"Screen Output")
printstr(6,37,"Calculator")
printstr(6,52,"Menus")

temp1 = color9
temp2 = color12

if(scrmode() <> 7)
color9 = "b/w"
color12 ="w/b"
endif

set color to &color9
@ 6,7 say "Windows"
set color to &color12
do while code <> 1

code = keycode()

oldcntr = menucntr
do case
case code = 75
menucntr = menucntr - 1
case code = 77
menucntr = menucntr + 1
case code = 28
menucntr = menucntr
case code = 17
menucntr = 1
case code = 31
menucntr = 2
case code = 46
menucntr = 3
case code = 50
menucntr = 4
endcase

if menucntr < 1
menucntr = 4
endif
if menucntr > 4
menucntr = 1
endif

set color to &color12
do case
case oldcntr = 1
@ 6,7 say "Windows"
case oldcntr = 2
@ 6,19 say "Screen Output"
case oldcntr = 3
@ 6,37 say "Calculator"
case oldcntr = 4
@ 6,52 say "Menus"
endcase

set color to &color9
do case
case menucntr = 1
@ 6,7 say "Windows"
set color to &color12
if code = 28 .or. code = 17
do saverest
endif
case menucntr = 2
@ 6,19 say "Screen Output"
set color to &color12
if code = 28 .or. code = 31
do spdemos
endif
case menucntr = 3
@ 6,37 say "Calculator"
set color to &color12
if code = 28 .or. code = 46
wselect(81)
wuse(9,60,10,10,color9)
wframe(2)
wprint(2,2,"This demonstration 'pops' a calculator onto the screen.")
wprint(3,2,"Use the cursor keys to move the calculator around the")
wprint(4,2,"screen, the calculator is functional, source code for")
wprint(5,2,"calculator IS supplied with the library.")
wprint(7,2," Press any key to start.")
wdisplay()
keycode()
wclose()
wrelease()
do calc with color4,color2,5,5,1
endif
case menucntr = 4
@ 6,52 say "Menus"
set color to &color12
if code = 28 .or. code = 50
wselect(81)
wuse(9,60,10,10,color9)
wframe(2)
wprint(2,2,"This demonstration uses the windowing capabilities")
wprint(3,2,"for a very general popdown menu system. This simple")
wprint(4,2,"system could be easily modified for your application's")
wprint(5,2,"specific needs, giving it that hi-tech look !")
wprint(7,2," Press any key to start.")
wdisplay()
keycode()
wclose()
wrelease()
do popdowns
menucntr = 4
endif
endcase
set color to &color9
clear typeahead

enddo


*******************
** **
** Ending Screen **
** **
*******************

@ 23,5 say " "
clearscr(0,0,24,79,"w+/n",176)
box(0,0,24,79,5)

printstr(5,16,"Free Information About THE BREEZE Library Can")
printstr(6,16,"Be Obtained By Calling:")
printstr(8,30,"703-486-3518")
printstr(10,35,"OR")

printstr(12,16,"Write To:")
printstr(14,25,"LOGITEK")
printstr(15,25,"P.O. Box 4603")
printstr(16,25,"Arlington, Virginia 22204")

printstr(18,25,"LOGITEK BBS Support: 703-450-7864")

keycode()
set cursor on

return

*********************************************
procedure title
*********************************************

wselect(1) && First Box
wuse(3,5,19,0,color6,shaded,color7)
*wframe()
wprint(1,2,"E")
wdisplay()

wselect(2) && Second Box
wuse(3,5,19,6,color6,shaded,color7)
*wframe()
wprint(1,2,"Z")
wdisplay()

wselect(3) && third Box
wuse(3,5,19,12,color6,shaded,color7)
*wframe()
wprint(1,2,"E")
wdisplay()

wselect(4) && Fourth Box
wuse(3,5,19,18,color6,shaded,color7)
*wframe()
wprint(1,2,"E")
wdisplay()

wselect(5) && Fifth Box
wuse(3,5,19,24,color6,shaded,color7)
*wframe()
wprint(1,2,"R")
wdisplay()

wselect(6) && Sixth Box
wuse(3,5,19,30,color6,shaded,color7)
*wframe()
wprint(1,2,"B")
wdisplay()

wselect(7) && Seventh Box
wuse(3,5,19,42,color6,shaded,color7)
*wframe()
wprint(1,2,"E")
wdisplay()

wselect(8) && Eighth Box
wuse(3,5,19,48,color6,shaded,color7)
*wframe()
wprint(1,2,"H")
wdisplay()

wselect(9) && ninth Box
wuse(3,5,19,54,color6,shaded,color7)
*wframe()
wprint(1,2,"T")
wdisplay()

windptr = 9

windptr = 9
do while windptr > 0
cntr = 0
do while cntr < 120

do case
case wrowscr(windptr) = 0
goflag = 0
do case
case windptr = 9 .and. wcolscr(9) > 10
goflag = 1
case windptr = 8 .and. wcolscr(8) > 16
goflag = 1
case windptr = 7 .and. wcolscr(7) > 22
goflag = 1
case windptr = 6 .and. wcolscr(6) > 34
goflag = 1
case windptr = 5 .and. wcolscr(5) > 40
goflag = 1
case windptr = 4 .and. wcolscr(4) > 46
goflag = 1
case windptr = 3 .and. wcolscr(3) > 52
goflag = 1
case windptr = 2 .and. wcolscr(2) > 58
goflag = 1
case windptr = 1 .and. wcolscr(1) > 64
goflag = 1
case windptr = 1 .and. wcolscr(1) = 64
cntr = 400
endcase
if goflag = 1
wshift(4,windptr)
else
sound(200,25)
cntr = 200
endif

case wrowscr(windptr) = 1
sound(200,10)
wshift(1,windptr)
tmpcntr = 0
do while tmpcntr < 5
wshift(4,windptr)
tmpcntr = tmpcntr + 1
enddo
sound(800,10)
case wcolscr(windptr) = 73 .and. wrowscr(windptr) = 19
sound(200,10)
wshift(2,windptr)
tmpcntr = 0
do while tmpcntr < 4
wshift(1,windptr)
tmpcntr = tmpcntr + 1
enddo
sound(800,10)
case wcolscr(windptr) > 73 .and. wrowscr(windptr) > 1
wshift(1,windptr)
case wcolscr(windptr) < 73 .and. wrowscr(windptr) = 19
wshift(2,windptr)
endcase

cntr = cntr + 1
enddo
windptr = windptr - 1
enddo

windptr = 1
do while windptr < 10
wrelease(windptr)
windptr = windptr + 1
enddo

windptr = 1
do while windptr < 1000
windptr = windptr + 1
enddo

return



**********************************************

procedure wind0

parameter color

**********************************************

wselect(80)
wuse(23,75,1,2,color,1,"n/w")
wframe()

wprint(1,4,"This program is a simple demonstration of a few of the ")
wprint(2,4,"capabilities of the BREEZE windowing library. The program was")
wprint(3,4,"purposefully made to mimick the moving windows of Sidekick, giving")
wprint(4,4,"you an idea of how fast this library is. This program ONLY")
wprint(5,4,"uses a few of the special windowing functions, the following")
wprint(6,4,"is a list of the more important windowing functions:")
wprint( 7,4," WUSE() - opens a window in memory")
wprint( 8,4," WDISPLAY() - displays a window.")
wprint( 9,4," WCLOSE() - closes the window and restores screen")
wprint(10,4," WRELEASE() - releases a window from memory.")
wprint(11,4," WCOPY() - copies a window to another window.")
wprint(12,4," WSAVE() - saves a window to a disk file.")
wprint(13,4," WRESTORE() - restores a windows from a disk file.")
wprint(14,4," WSELECT() - selects a window as the active window.")
wprint(15,4," WPRINT() - prints to the active window")
wprint(16,4," WFRAME() - frames a window, and/or draws boxes on the window")
wprint(17,4," WLINE() - draws vertical and horizontal lines on a window")
wprint(18,4," WSHIFT() - moves a window one space in any direction.")
wprint(19,4," WCLEAR() - clears all or a portion of a window.")
wprint(20,4," WMOVETO() - moves a defined portion of the screen to a window.")
wprint(21,4," WMOVFROM() - moves a defined portion of a window to the screen.")

return

**********************************************

procedure wind1

parameter color

**********************************************

wselect(81)
wuse(13,50,5,15,color,1,"n/w")
wframe()

wprint(1,15,"GENERAL INFORMATION")
wprint(3,3,"Windows of information can be moved or")
wprint(4,3,"manipulated in any manner a programmer may")
wprint(5,3,"desire. THE BREEZE allows Full AND PARTIAL")
wprint(6,3,"screen saves to windows, as well as a host of")
wprint(7,3,"other TRUE windowing functions. This Library")
wprint(8,3,"adds to CLIPPER the windowing functions now")
wprint(9,3,"available with the Quicksilver compiler !!")

return

************************************************

procedure wind2

parameter color

************************************************

wselect(82)
wuse(11,50,5,15,color,1,"n/w")
wframe()

wprint(1,14,"CLIPPER COMPATABILITY")
wprint(3,4,"The functions that are provided with the")
wprint(4,4,"BREEZE are 100 percent compatible with ")
wprint(5,4,"Clipper's Extend system. NO part of ")
wprint(6,4,"THE BREEZE is 'memory resident.' All")
wprint(7,4,"functions are linked during the normal")
wprint(8,4,"'link' phase of your application !")

return

************************************************

procedure wind3

parameter color

************************************************

wselect(83)
wuse(13,50,5,15,color,1,"n/w")
wframe()

wprint( 1,14,"HARDWARE COMPATABILITY")
wprint( 3,2,"THE BREEZE will work with any truly 100%")
wprint( 4,2,"IBM PC compatible machine running DOS 2.0 and")
wprint( 5,2,"later. Different video adapters are ")
wprint( 6,2,"transparent to THE BREEZE, because it adjusts")
wprint( 7,2,"automatically to the type of video adapter")
wprint( 8,2,"board the machine has, CGA,EGA or MONO. This")
wprint( 9,2,"makes any program written with THE BREEZE ")
wprint(10,2,"portable to many different adapter ")
wprint(11,2,"environments !!")


return

************************************************

procedure wind4

parameter color

************************************************

wselect(84)
wuse(9,50,5,15,color,1,"n/w")
wframe()

wprint(1,11,"dBASE COMPILER COMPATABILITY")
wprint(3,2,"THE BREEZE will work with the Nantucket")
wprint(4,2,"Clipper compiler, Autumn 1986 version,")
wprint(5,2,"and the latest Clipper version, Summer 1987.")
wprint(6,2,"Additional versions will be made available")
wprint(7,2,"for interpreted dBASE at a later date.")

return






****************************************************************
procedure spdemos
****************************************************************

wselect(1)
wuse(25,80,0,0,color13)
wmoveto(0,0,24,79,1,0,0) && save screen

wselect(2)
wuse(9,60,10,10,color9)
wframe(2)

wprint(1,2,"This demonstration will use a BREEZE function to fill")
wprint(2,2,"the screen several times. The program will pause")
wprint(3,2,"between each fill, press any key to go to the next fill.")
wprint(4,2,"These simple screen fills are an example of the speed")
wprint(5,2,"this library possesses.")
wprint(7,2," Press any key to start.")
wdisplay()

keycode()
wclose()
wrelease(2)

clearscr(0,0,24,79,color7,176)
keycode()
clearscr(0,0,24,79,color3,216)
keycode()
clearscr(0,0,12,39,color7,42)
clearscr(0,40,12,79,color1,177)
clearscr(13,0,24,39,color10,254)
clearscr(13,40,24,79,color9,206)
keycode()

wmovfrom(0,0,24,79,1,0,0) && Restore Screen

wrelease(1) && Release the window

return

*************************************************************************
procedure saverest
*************************************************************************

wselect(1)
wuse(9,40,7,10,color11)
wframe(1)
wprint(2,4,"Now, with THE BREEZE, You can")
wprint(3,4,"write applications that include")
wprint(4,4,"State-Of-The-Art technology....")
wprint(5,4," WINDOWS !!")
wprint(7,4," Press Any Key")

wselect(2)
wuse(9,40,13,20,color10)
wframe(2)
wprint(2,4,"Opening a Window is a BREEZE !!")
wprint(3,4,"If you can use dBASE already,")
wprint(4,4,"don't worry, opening a window is")
wprint(5,4,"as easy as opening a file.....")

wprint(7,4," Press Any Key")

wselect(3)
wuse(8,40,16,30,color2)
wframe(3)
wprint(2,4,"You can USE up to 99 Windows at")
wprint(3,4," ONCE !!")
wprint(5,4," Press Any Key")


*************
** Display section
**
*************

wdisplay(1)
keycode()
wdisplay(2) && Display the windows
keycode()
wdisplay(3)
keycode()

wclose(3)
wclose(2) && close all 3
wclose(1)


wselect(1)
wclear()
wprint(3,4,"Screen design and management are")
wprint(4,4," a BREEZE with windows !")
wdisplay(1,0,0)



wselect(2)
wclear()
wprint(3,4,"Screens FULL of information can be")
wprint(4,4," overlayed, and restored")
wprint(5,4," INSTANTLY !!")
wdisplay(2,6,15)

wselect(3)
wclear()
wprint(2,4," ...And with THE BREEZE")
wprint(3,4," Windows can MOVE....")
wprint(4,4," FAST !!")
wprint(6,4," Press Any Key")
wdisplay(3,14,40)

keycode()



****************************
** Window Demo
**
****************************

wselect(4)
wuse(10,30,10,5,color13)
wframe(4)
wprint(4,5,"This Is Window One !")

wselect(5)
wuse(5,40,12,10,color11)
wframe(5)
wprint(2,10,"This is Window Two !")

wselect(6)
wuse(5,40,14,20,color7)
wprint(2,10,"This is Window Three !")
wframe(1)

sound(500,10)
wdisplay(4)
sound(600,10)
wdisplay(5)
sound(800,10)
wdisplay(6)

cntr = 0
do while cntr < 250
cntr = cntr + 1
enddo

sound(100,10)
wclose(6)
cntr = 0
do while cntr < 250
cntr = cntr + 1
enddo
sound(100,10)
wclose(5)
cntr = 0
do while cntr < 250
cntr = cntr + 1
enddo
sound(100,10)
wclose(4)


cntr = 1
delaycntr = 150

do while cntr < 6

sound(500,3)
wdisplay(4,1,1)
tmpcntr = 0
do while tmpcntr < delaycntr
tmpcntr = tmpcntr + 1
enddo
sound(800,5)
wclose(4)


sound(500,3)
wdisplay(5,10,35)
tmpcntr = 0
do while tmpcntr < delaycntr
tmpcntr = tmpcntr + 1
enddo
sound(800,5)
wclose(5)

sound(500,3)
wdisplay(6,8,25)
tmpcntr = 0
do while tmpcntr < delaycntr
tmpcntr = tmpcntr + 1
enddo
sound(800,5)
wclose(6)

sound(500,3)
wdisplay(4,14,5)
tmpcntr = 0

do while tmpcntr < delaycntr
tmpcntr = tmpcntr + 1
enddo
sound(800,5)
wclose(4)

sound(500,3)
wdisplay(5,4,40)
tmpcntr = 0
do while tmpcntr < delaycntr
tmpcntr = tmpcntr + 1
enddo
sound(800,5)
wclose(5)

sound(500,3)
wdisplay(6,14,35)
tmpcntr = 0
do while tmpcntr < delaycntr
tmpcntr = tmpcntr + 1
enddo
sound(800,5)
wclose(6)

sound(500,3)
wdisplay(4,2,5)
tmpcntr = 0
do while tmpcntr < delaycntr
tmpcntr = tmpcntr + 1
enddo
sound(800,5)
wclose(4)

sound(500,3)
wdisplay(5,14,25)
tmpcntr = 0
do while tmpcntr < delaycntr
tmpcntr = tmpcntr + 1
enddo
sound(800,5)
wclose(5)

cntr = cntr + 1
delaycntr = delaycntr - 100

enddo

clear typeahead

wclose(3)
wclose(2)
wclose(1)

******************
** Text Section **
******************
wselect(1)
wrelease()
wuse(10,40,0,0,color11)
wframe(1)
wprint(1,4,"Displaying AND Scrolling Text is")
wprint(2,4," SIMPLE with THE BREEZE ! ")
wprint(3,4,"All of the windowing functions")
wprint(4,4,"Work relative to the window, NOT")
wprint(5,4,"the screen. The upper left corner")
wprint(6,4,"of a window is ALWAYS coordinate")
wprint(7,4,"0,0. This makes window positioning")
wprint(8,4,"and printing incredibly EASY !!")
wdisplay(1,0,20)



wselect(2)
wclear()
wprint(1,4," AND ")
wprint(2,4,"With with the AUTOMATIC 'smart'")
wprint(3,4,"wordwrap function and the window")
wprint(4,4,"scrolling function, help text or")
wprint(5,4,"any kind of text can be viewed and")
wprint(6,4,"scrolled at one's leisure !!")
wdisplay(2,11,2)

wselect(3)
wclear()
wprint(2,4," ...And of Course")
wprint(3,4," These functions are")
wprint(4,4," VERY FAST !!")
wprint(6,4," Press Any Key")
wdisplay(3,14,40)

keycode()

wclose()
wclose(2)
wclose(1)

wrelease(1)
wrelease(2)
wrelease(3)
wrelease(4) && Release the Temporary windows
wrelease(5)
wrelease(6)

return

*****************************************************************************
procedure popdowns
*****************************************************************************



wselect(80)
wuse(3,58,5,1,color9)
wframe(2)
wprint(1,2,"Menu 1")
wprint(1,18,"Menu 2")
wprint(1,33,"Menu 3")
wprint(1,49,"Menu 4")

wcolor(color12)
wprint(1,2,"Menu 1")
wcolor(color9)

wdisplay()
docode = .f.
oldcntr = 1
menucntr = 1
code = 28

do while code <> 1

if docode
code = keycode()
endif
docode = .t.

oldcntr = menucntr
do case
case code = 75
menucntr = menucntr - 1
case code = 77
menucntr = menucntr + 1
case code = 28
menucntr = menucntr
otherwise
loop
endcase

if menucntr < 1
menucntr = 4
endif
if menucntr > 4
menucntr = 1
endif

wcolor(color9)
do case
case oldcntr = 1
wprint(1,2,"Menu 1")
case oldcntr = 2
wprint(1,18,"Menu 2")
case oldcntr = 3
wprint(1,33,"Menu 3")
case oldcntr = 4
wprint(1,49,"Menu 4")
endcase
wcolor(color12)

do case
case menucntr = 1
wprint(1,2,"Menu 1")
do popone
if menucntr <> 1
docode = .f.
endif
case menucntr = 2
wprint(1,18,"Menu 2")
do poptwo
if menucntr <> 2
docode = .f.
endif
case menucntr = 3
wprint(1,33,"Menu 3")
do popthree
if menucntr <> 3
docode = .f.
endif

case menucntr = 4
wprint(1,49,"Menu 4")
do popfour
if menucntr <> 4
docode = .f.
endif
endcase

wcolor(color9)
clear typeahead

enddo

wclose(80)
wrelease(80)
code = 28

return


********************
procedure popone
********************
wselect(81)
wuse(5,20,7,1,color9)
wframe(3)
wprint(1,6,"Choice 1")
wprint(2,6,"Choice 2")
wprint(3,6,"Choice 3")
wdisplay()

wcolor(color12)
wprint(1,6,"Choice 1")
s_code = 0
scntr = 1
soldcntr = 1
do while s_code <> 1 .and. menucntr = 1

s_code = keycode()

soldcntr = scntr

do case
case s_code = 72
scntr = scntr - 1
case s_code = 80
scntr = scntr + 1
case s_code = 28
scntr = scntr
case s_code = 77
menucntr = 2
case s_code = 75
menucntr = 4
case s_code = 1
menucntr = menucntr
otherwise
loop
endcase

if scntr < 1
scntr = 3
endif
if scntr > 3
scntr = 1
endif

wcolor(color9)
do case
case soldcntr = 1
wprint(1,6,"Choice 1")
case soldcntr = 2
wprint(2,6,"Choice 2")
case soldcntr = 3
wprint(3,6,"Choice 3")
endcase

wcolor(color12)

do case
case scntr = 1
wprint(1,6,"Choice 1")
case scntr = 2
wprint(2,6,"Choice 2")
case scntr = 3
wprint(3,6,"Choice 3")
endcase
clear typeahead

enddo

wclose(81)
wrelease(81)

wselect(80)
wcolor(color9)
wprint(1,2,"Menu 1")
wcolor(color12)
do case
case menucntr = 1
wprint(1,2,"Menu 1")
case menucntr = 2
wprint(1,18,"Menu 2")
case menucntr = 3
wprint(1,33,"Menu 3")
case menucntr = 4
wprint(1,49,"Menu 4")
endcase
wcolor(color9)
code = 28
return



********************
procedure poptwo
********************
wselect(81)
wuse(7,20,7,11,color9)
wframe(3)
wprint(1,6,"Choice 1")
wprint(2,6,"Choice 2")
wprint(3,6,"Choice 3")
wprint(4,6,"Choice 4")
wprint(5,6,"Choice 5")
wdisplay()

wcolor(color12)
wprint(1,6,"Choice 1")
s_code = 0
scntr = 1
soldcntr = 1
do while s_code <> 1 .and. menucntr = 2

s_code = keycode()

soldcntr = scntr

do case
case s_code = 72
scntr = scntr - 1
case s_code = 80
scntr = scntr + 1
case s_code = 28
scntr = scntr
case s_code = 77
menucntr = 3
case s_code = 75
menucntr = 1
case s_code = 1
menucntr = menucntr
otherwise
loop
endcase

if scntr < 1
scntr = 5
endif
if scntr > 5
scntr = 1
endif

wcolor(color9)
do case
case soldcntr = 1
wprint(1,6,"Choice 1")
case soldcntr = 2
wprint(2,6,"Choice 2")
case soldcntr = 3
wprint(3,6,"Choice 3")
case soldcntr = 4
wprint(4,6,"Choice 4")
case soldcntr = 5
wprint(5,6,"Choice 5")
endcase

wcolor(color12)

do case
case scntr = 1
wprint(1,6,"Choice 1")
case scntr = 2
wprint(2,6,"Choice 2")
case scntr = 3
wprint(3,6,"Choice 3")
case scntr = 4
wprint(4,6,"Choice 4")
case scntr = 5
wprint(5,6,"Choice 5")

endcase
clear typeahead

enddo

wclose(81)
wrelease(81)

wselect(80)
wcolor(color9)
wprint(1,18,"Menu 2")
wcolor(color12)
do case
case menucntr = 1
wprint(1,2,"Menu 1")
case menucntr = 2
wprint(1,18,"Menu 2")
case menucntr = 3
wprint(1,33,"Menu 3")
case menucntr = 4
wprint(1,49,"Menu 4")
endcase
wcolor(color9)
code = 28
return

********************
procedure popthree
********************
wselect(81)
wuse(5,20,7,27,color9)
wframe(3)
wprint(1,6,"Choice 1")
wprint(2,6,"Choice 2")
wprint(3,6,"Choice 3")
wdisplay()

wcolor(color12)
wprint(1,6,"Choice 1")
s_code = 0
scntr = 1
soldcntr = 1
do while s_code <> 1 .and. menucntr = 3

s_code = keycode()

soldcntr = scntr

do case
case s_code = 72
scntr = scntr - 1
case s_code = 80
scntr = scntr + 1
case s_code = 28
scntr = scntr
case s_code = 77
menucntr = 4
case s_code = 75
menucntr = 2
case s_code = 1
menucntr = menucntr
otherwise
loop
endcase

if scntr < 1
scntr = 3
endif
if scntr > 3
scntr = 1
endif

wcolor(color9)
do case
case soldcntr = 1
wprint(1,6,"Choice 1")
case soldcntr = 2
wprint(2,6,"Choice 2")
case soldcntr = 3
wprint(3,6,"Choice 3")
endcase

wcolor(color12)

do case
case scntr = 1
wprint(1,6,"Choice 1")
case scntr = 2
wprint(2,6,"Choice 2")
case scntr = 3
wprint(3,6,"Choice 3")
endcase
clear typeahead

enddo

wclose(81)
wrelease(81)

wselect(80)
wcolor(color9)
wprint(1,33,"Menu 3")
wcolor(color12)
do case
case menucntr = 1
wprint(1,2,"Menu 1")
case menucntr = 2
wprint(1,18,"Menu 2")
case menucntr = 3
wprint(1,33,"Menu 3")
case menucntr = 4
wprint(1,49,"Menu 4")
endcase
wcolor(color9)
code = 28
return

********************
procedure popfour
********************
wselect(81)
wuse(7,20,7,44,color9)
wframe(3)
wprint(1,6,"Choice 1")
wprint(2,6,"Choice 2")
wprint(3,6,"Choice 3")
wprint(4,6,"Choice 4")
wprint(5,6,"Choice 5")
wdisplay()

wcolor(color12)
wprint(1,6,"Choice 1")
s_code = 0
scntr = 1
soldcntr = 1
do while s_code <> 1 .and. menucntr = 4

s_code = keycode()

soldcntr = scntr

do case
case s_code = 72
scntr = scntr - 1
case s_code = 80
scntr = scntr + 1
case s_code = 28
scntr = scntr
case s_code = 77
menucntr = 1
case s_code = 75
menucntr = 3
case s_code = 1
menucntr = menucntr
otherwise
loop
endcase

if scntr < 1
scntr = 5
endif
if scntr > 5
scntr = 1
endif

wcolor(color9)
do case
case soldcntr = 1
wprint(1,6,"Choice 1")
case soldcntr = 2
wprint(2,6,"Choice 2")
case soldcntr = 3
wprint(3,6,"Choice 3")
case soldcntr = 4
wprint(4,6,"Choice 4")
case soldcntr = 5
wprint(5,6,"Choice 5")
endcase

wcolor(color12)

do case
case scntr = 1
wprint(1,6,"Choice 1")
case scntr = 2
wprint(2,6,"Choice 2")
case scntr = 3
wprint(3,6,"Choice 3")
case scntr = 4
wprint(4,6,"Choice 4")
case scntr = 5
wprint(5,6,"Choice 5")

endcase
clear typeahead

enddo

wclose(81)
wrelease(81)

wselect(80)
wcolor(color9)
wprint(1,49,"Menu 4")
wcolor(color12)
do case
case menucntr = 1
wprint(1,2,"Menu 1")
case menucntr = 2
wprint(1,18,"Menu 2")
case menucntr = 3
wprint(1,33,"Menu 3")
case menucntr = 4
wprint(1,49,"Menu 4")
endcase
wcolor(color9)
code = 28
return


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : WINDOWS.ZIP
Filename : DEMO.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/