home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
clipper
/
obtn52.zip
/
TESTBTN.PRG
< prev
Wrap
Text File
|
1993-06-01
|
5KB
|
158 lines
// ----------------------------------------------------------------------------
// Demo for TButton() class for CLIPPER 5
// Created by Juan Miguel Sosso using captured BORLAND C++ 3.1 screens
// Thanks to Borland's team for their powerfull compiler
// and the star of the show is... TButton Class without external OOPS libraries!
//
// Note: This demo only works ok in 80x25 screen mode
#include "Button.ch"
#include "InKey.ch"
#include "box.ch"
// ----------------------------------------------------------------------------
Function Main()
local cOldColor := SetColor( "W+/B, W+/G,,, BG+/B" )
local cBc := MemoRead( "BC.BIN" )
SET SCOREBOARD OFF
SetPos( 2, 1 )
RestScreen( 0, 0, 24, 79, cBc )
Inkey( 2 )
RestScreen( 0, 0, 24, 79, MemoRead( "BCDIR.BIN" ) )
RunBcDir()
SetPos( 2, 1 )
RestScreen( 0, 0, 24, 79, cBc )
Inkey( 2 )
RestScreen( 0, 0, 24, 79, MemoRead( "BCAPP.BIN" ) )
RunBcApp()
SetPos( 2, 1 )
RestScreen( 0, 0, 24, 79, cBc )
Inkey( 2 )
SetColor( cOldColor )
ClearScr()
? "That's all folks..."
?
Return NIL
// ----------------------------------------------------------------------------
Function RunBcDir()
local cInclude := "C:\LENG\BORLANDC\INCLUDE "
local cLib := "C:\LENG\BORLANDC\LIB "
local cOutput := "C:\PROYECTO\BUTTON "
local cSource := "C:\PROYECTO\BUTTON "
@ 7, 15 GET cInclude
@ 10, 15 GET cLib
@ 13, 15 GET cOutput
@ 16, 15 GET cSource
@ 18, 34 BUTTON " O&K " ACTION __KeyBoard( Chr( K_CTRL_W ) ) COLOR "BG+/G, GR+/G"
@ 18, 46 BUTTON " &Cancel " ACTION __KeyBoard( Chr( K_ESC ) ) COLOR "N/G, GR+/G"
@ 18, 58 BUTTON " &Help " ACTION Alert( "Help Text" ) COLOR "N/G, GR+/G"
READ
if LastKey() != K_ESC
Alert( "Ok, let's store the info" )
// ...
endif
Return NIL
// ----------------------------------------------------------------------------
Function RunBcApp()
DispText( 1 )
@ 13, 7 BUTTON " DOS &Standard " COLOR "N/G, GR+/G" ACTION DispText( 1 )
@ 13, 25 BUTTON " DOS &Overlay " COLOR "N/G, GR+/G" ACTION DispText( 2 )
@ 13, 42 BUTTON " Windows &App " COLOR "N/G, GR+/G" ACTION DispText( 3 )
@ 13, 59 BUTTON " Windows &DLL " COLOR "N/G, GR+/G" ACTION DispText( 4 )
@ 17, 40 BUTTON " O&K " ACTION __KeyBoard( Chr( K_CTRL_W ) ) COLOR "BG+/G, GR+/G"
@ 17, 52 BUTTON " &Cancel " ACTION __KeyBoard( Chr( K_ESC ) ) COLOR "N/G, GR+/G"
@ 17, 64 BUTTON " &Help " ACTION Alert( "Help Text" ) COLOR "N/G, GR+/G"
READ
if LastKey() != K_ESC
Alert( "Ok, let's store the info" )
// ...
endif
Return NIL
// ----------------------------------------------------------------------------
Function DispText( nText )
local cText[ 4 ]
local n
do case
case nText == 1
cText[ 1 ] = "TButton class for CLIPPER (c) 1.993 RUNsoft"
cText[ 2 ] = "Written by Antonio Linares & Juan Miguel Sosso"
cText[ 3 ] = "This is not a demo, it is full operational"
cText[ 4 ] = "ShareWare edition, please support it"
case nText == 2
cText[ 1 ] = "You have a 21 days to evaluate this product and decide to"
cText[ 2 ] = "purchase it or stop using it"
cText[ 3 ] = "If you decide to register you will receive ALL THE SOURCE CODE"
cText[ 4 ] = "and post mail or electronic mail support"
case nText == 3
cText[ 1 ] = "To register send $30 (plus $3 if outside of Spain) to:"
cText[ 2 ] = "RUNsoft"
cText[ 3 ] = "Málaga 40, 3º"
cText[ 4 ] = "29600 Marbella (MA) Spain"
case nText == 4
cText[ 1 ] = "If you want to contact with the autors send us a letter to RUNsoft,"
cText[ 2 ] = "write a message to adress 2:345/201.8@fidoned.org or call"
cText[ 3 ] = "our BBS system at +34-5-221-3374 (24h) up to 19.200 bps"
cText[ 4 ] = "Leave a message in RUNsoft area and look for new products"
endcase
for n = 1 to 4
@ 5 + n, 6 SAY PadC( cText[ n ], 68 ) COLOR "BG+/B"
next
Return NIL
// ----------------------------------------------------------------------------
Function ClearScr()
local n, nLin, nCol
for n = 0 to MaxCol()
nLin = 0
nCol = n
while nLin <= MaxRow() .and. nCol >= 0
@ nLin++, nCol-- SAY " "
enddo
next
for n = 0 to MaxRow()
nLin = n
nCol = MaxCol()
while nLin <= MaxRow()
@ nLin++, nCol-- SAY " "
enddo
next
SetPos( 0, 0 )
Return NIL
// ----------------------------------------------------------------------------