home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
clipper
/
cuaclip.zip
/
DEMO.PRG
< prev
next >
Wrap
Text File
|
1993-06-01
|
8KB
|
377 lines
/************************************************************************
* LB_Demo.PRG - Demo for the List Box GET reader.
*
* Copyright (c) 1990-1993 Delcom-Deltranik Int'l Software Engineering
*
* Author: Dave Rooney
* Date : March 16, 1993
*
************************************************************************/
#include "CUAClip.ch"
#include "Mouse.ch"
#include "Set.ch"
#include "Directry.ch"
#include "Inkey.ch"
STATIC aFiles, ; // Array of files for the unprocessed list
aUpload // Array of files to be uploaded
FUNCTION LB_Demo ( cFileSpec )
LOCAL cDOSScreen, ; // Screen on entry
cOldColor, ; // Colour on entry
nCursor, ; // Cursor on entry
cScreen, ; // Screen behind dialog box
cListClr, ; // Button GET colour string
cButtonClr, ; // Button GET colour string
aDir, ; // Directory info array
cToAdd, ; // Name of file to be added
cToRemove, ; // Name of file to be removed
GetList, ; // Getlist array
lProceed, ; // .T. if proceeding
i // Loop counter
DEFAULT cFileSpec TO "*.*"
cDOSScreen := SAVESCREEN()
cOldColor := SETCOLOR("W+/W")
nCursor := SETCURSOR(0)
aUpload := {}
GetList := {}
lProceed := .F.
aDir := DIRECTORY( cFileSpec )
aFiles := ARRAY( LEN( aDir ))
cButtonClr := "W+/B, W+/R"
FOR i := 0 TO MAXROW()
@ i, 0 SAY PADR( REPLICATE( CHR( 254 ), ( i - 1 ) % 14 + 1 ) + ;
" CUA-Clip Interface Library Version 1.1b ", ;
80, CHR( 254 ) )
NEXT i
//
// Mouse setup...
//
InitMouse()
SetMousePos( INT( MAXROW() / 2 ), INT( MAXCOL() / 2 ))
SetMouse( MOUSE_ON )
//
// 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, 0 )
SET( _SET_MCENTER, .T. )
SET( _SET_SCOREBOARD, .F. )
SET( _SET_SOFTSEEK, .F. )
SET( _SET_WRAP, .T. )
SETBLINK(.F.)
//
// CUA-Clip library settings...
//
WindowsComp( .T. )
SetFlushKey( K_F10 )
SetListKey( K_F5 )
SetMenuColor("N/BG,W+/B,N+/BG,R/BG,W+/B")
SetPullColor("N/BG,W+/B,N+/BG,R/BG,W+/B")
//
// Colours for the list box:
//
// 1 - Border & background colour - GET unselected
// 2 - Border & background colour - GET selected
// 3 - Border & background colour - WHEN condition is .F.
// 4 - Unselected data items - GET selected
// 5 - Selected data items - GET selected
// 6 - Unselected data items - GET unselected
// 7 - Selected data items - GET unselected
//
// 1 2 3 4 5 6 7
SetLBColor("N/W*, B/W*, N/W*, W+/W, W+/R, N/W*, W/N")
//
// Load the files array...
//
FOR i := 1 TO LEN( aDir )
aFiles[i] := PADR( aDir[ i, 1 ], 15 )
NEXT
cScreen := ShadowBox( 3, 13, 21, 67, SPACE(8), "B/BG", .T. )
@ 3,13 SAY PADC( "Export", 55 ) COLOR "W+/B"
@ 4,15 SAY PADC( "Unprocessed", 18 ) COLOR "B/BG"
@ 4,47 SAY PADC( "To Upload", 18 ) COLOR "B/BG"
@ 5,15 LISTBOX cToAdd TO 16,33 WITH aFiles ;
WHEN !EMPTY( aFiles ) ;
ACTION AddFile( cToAdd )
@ 18,16 BUTTON PADC( "Select All", 15 ) ;
WHEN !EMPTY( aFiles ) ;
ACTION AddAll() ;
COLOR cButtonClr
@ 5,47 LISTBOX cToRemove TO 16,65 WITH aUpload ;
WHEN !EMPTY( aUpload ) ;
ACTION RemoveFile( cToRemove )
@ 18,48 BUTTON PADC( "Remove All", 15 ) ;
WHEN !EMPTY( aUpload ) ;
ACTION RemoveAll() ;
COLOR cButtonClr
@ 20,27 BUTTON " Upload " ;
WHEN !EMPTY( aUpload ) ;
ACTION ( lProceed := .T. ) ;
COLOR cButtonClr
@ 20,44 BUTTON " Cancel " ;
ACTION !( lProceed := .F. ) ;
COLOR cButtonClr
READMODAL( GetList )
KillBox( cScreen )
IF lProceed .AND. !EMPTY( aUpload )
//
// Perform the Export...
//
Exporting( aUpload )
ENDIF
//
// Reset the environment...
//
SetMouse( MOUSE_OFF )
RESTSCREEN(,,,, cDOSScreen )
SETCOLOR( cOldColor )
SETCURSOR( nCursor )
SETPOS( MAXROW() - 1, 0 )
?
QUIT
RETURN NIL
//
// EOP: Export
//
***************************
** FUNCTION Exporting **
*****************************************************************************
//
// This function performs the export.
//
// Parameters: aUpload - The array of file names to be exported.
//
// Returns: NIL
//
STATIC FUNCTION Exporting ( aUpload )
LOCAL cScreen, ; // Screen on entry
cOldColor, ; // Colour on entry
nMouse, ; // Mouse on entry
nTotFiles, ; // Total number of files to be uploaded
nPercent, ; // Percentage complete
i, j // Loop counters
cOldColor := SETCOLOR()
cScreen := ShadowBox( 5, 18, 10, 62, SPACE(8), "B/BG", .T. )
@ 5,18 SAY PADC( "Exporting", 45 ) COLOR "W+/B"
@ 7,20 SAY "Exporting:" COLOR "B/BG"
@ 9,20 SAY REPLICATE( "░", 35 ) COLOR "W+/BG"
nTotFiles := LEN( aUpload )
FOR i := 1 TO nTotFiles
@ 7,31 SAY PADR( aUpload[i], 20 ) COLOR "N/BG"
//
// Your export code here...
//
//
// Update progress gauge...
//
nPercent := INT(( i / nTotFiles ) * 100 )
@ 9,20 SAY REPLICATE( "█", INT(( i / nTotFiles ) * 35 )) COLOR "W+/BG"
@ 9,57 SAY STR( nPercent, 3 ) + "%" COLOR "N/BG"
INKEY( 0.35 ) // ...for effect!
NEXT
SETCOLOR( "W+/BG" )
@ 7,20 SAY PADR( "Complete. Press any key...", 40 )
TONE( 250, 1 )
InterruptKey(0)
KillBox( cScreen )
//
// Reset the environment...
//
SETCOLOR( cOldColor )
RETURN NIL
//
// EOP: Exporting
//
*************************
** FUNCTION AddFile **
*****************************************************************************
//
// This function adds the specified file to the upload list.
//
// Parameters: cFile - The name of the file to be uploaded.
//
// Returns: Always returns .T.
//
STATIC FUNCTION AddFile ( cFile )
LOCAL nPos // Position in aFiles of the selection
//
// Add the file to the upload list...
//
AADD( aUpload, cFile )
// ...and remove it from the unprocessed list.
IF ( nPos := ASCAN( aFiles, cFile )) > 0
ADEL( aFiles, nPos )
ASIZE( aFiles, LEN( aFiles ) - 1 )
ENDIF
Monitor()
RETURN .F.
//
// EOP: AddFile
//
****************************
** FUNCTION RemoveFile **
*****************************************************************************
//
// This function removes the specified file to the upload list.
//
// Parameters: cFile - The name of the file to be removed from the list.
//
// Returns: Always returns .F.
//
STATIC FUNCTION RemoveFile ( cFile )
LOCAL nPos // Position in aFiles of the selection
//
// Add the file to the unprocessed list...
//
AADD( aFiles, cFile )
// ...and remove it from the unprocessed list.
IF ( nPos := ASCAN( aUpload, cFile )) > 0
ADEL( aUpload, nPos )
ASIZE( aUpload, LEN( aUpload ) - 1 )
ENDIF
Monitor()
RETURN .F.
//
// EOP: RemoveFile
//
************************
** FUNCTION AddAll **
*****************************************************************************
//
// This function adds all files in the unprocessed list to the
// upload list.
//
// Parameters: None.
//
// Returns: Always returns .F.
//
STATIC FUNCTION AddAll
LOCAL i // Loop counter
FOR i := 1 TO LEN( aFiles )
//
// Add the file to the upload list...
//
AADD( aUpload, aFiles[i] )
NEXT
ASIZE( aFiles, 0 )
Monitor()
RETURN .F.
//
// EOP: AddAll
//
***************************
** FUNCTION RemoveAll **
*****************************************************************************
//
// This function removes all files from the upload list, and places
// them in the unprocessed list.
//
// Parameters: None.
//
// Returns: Always returns .F.
//
STATIC FUNCTION RemoveAll
LOCAL i // Loop counter
FOR i := 1 TO LEN( aUpload )
//
// Add the file to the unprocessed list...
//
AADD( aFiles, aUpload[i] )
NEXT
ASIZE( aUpload, 0 )
Monitor()
RETURN .F.
//
// EOP: RemoveAll
//