Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Unleash the power of WAIT WINDOW!!!
Message
 
À
Tous
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Titre:
Unleash the power of WAIT WINDOW!!!
Divers
Thread ID:
00000571
Message ID:
00000571
Vues:
170
WAIT WINDOW is a really neat tool to display messages such as
wait,indexing..., don't stop this, and so on; but is this all
it can do? No!! try this little tool and see if you can give
any use to it. Enjoy!

(IT WORKS IN BOT VFP AND FPW)

SWISSARMY.PRG
****There is a limit for the character string that is displayed in the WAIT WINDOW
****WAIT CLEAR erases the wait window from the screen IN VFP
****This can also be used as a substitute for the debug window

DO WHILE .T.
WAIT WINDOW 'Select the version you wish to run: ' + CHR(13) + CHR(13) +;
'1..........Visual Foxpro 3.0 ' + CHR(13) + '2..........Foxpro 2.0' + CHR(13) + '3..........Exit' TO lcanswer
VERS = VERSION()
DO CASE
CASE lcanswer = '1'
IF SUBSTR(VERS,1,3) = 'Vis'
DO vfpstuff
RETURN .F.
ELSE
WAIT WINDOW 'Sorry, you cannot use the VFP module' TIME 1
DO fpwstuff
RETURN .F.
ENDIF
CASE lcanswer = '2'
DO fpwstuff
RETURN .F.
CASE lcanswer = '3'
RETURN .F.
OTHERWISE
WAIT WINDO 'Invalid choice.' TIME 0.5
ENDCASE
ENDDO

PROCEDURE vfpstuff
VERS = VERSION()
IF SUBSTR(VERS,1,3) = 'Vis'
WAIT WINDOW AT 2,2 'We are running under Visual Foxpro' TIME 1
ELSE
WAIT WINDOW 'We are running under Foxpro 2.6' TIME 1
ENDIF
lnmainloop = 1
lnsecondloop = 0
DO WHILE lnmainloop = 1
DO WHILE lnsecondloop = 0
WAIT WINDOW AT 10,2 'Ring a ding .............1' + CHR(13) +;
'Screen Resolution ...2' + CHR(13) +;
'Wait date ...............3' + CHR(13) +;
'System status ..........4' + CHR(13) +;
'Visual stuff .............5' + CHR(13) +;
'Exit ........................6';
TO lcanswer
DO CASE
CASE UPPER(lcanswer) = '1'
SET BELL TO 'c:\windows\ding.wav',1
??CHR(7)
CASE UPPER(lcanswer) = '2'
WAIT WINDOW TIME 1 'Resolution is : ' + TRANS(SYSMETRIC(1),'###') + ' x ' + TRANS(SYSMETRIC(2),'###')
CASE UPPER(lcanswer) = '3'
WAIT WINDO TIME 1 AT 10,0 CDOW(DATE())+ ', ' + CMONTH(DATE())+ TRANSFORM(DAY(DATE()),'##')+ ', ' + TRANSFORM(YEAR(DATE()),'####')
CASE UPPER(lcanswer) = '4'
DO pathrep
CASE UPPER(lcanswer) = '5'
DO vistuff
CASE UPPER(lcanswer) = '6'
lnsecondloop = 1
OTHERWISE
WAIT WINDOW 'You pressed: ' + '"' + lcanswer + '" ' + ;
'which is different than any of the options in this;
pseudo-menu...' TIME 5
??CHR(7)
ENDCASE
ENDDO
WAIT WINDOW 'Are you sure? Y/N' TO lcanswer
IF UPPER(lcanswer) = 'Y'
WAIT WINDOW AT 4,2 'WAIT WINDOW can also be used as a debug window by leaving' + CHR(13) +;
'variable values displayed on the screen while we work on code.' TIME 3 NOCLEAR
SET BELL TO 'c:\windows\ding.wav',1
??CHR(7)
DO deb
lnmainloop = 0
ELSE
lnsecondloop = 0
ENDIF
ENDDO
SET BELL TO
??CHR(7)

PROCEDURE pathrep
m.localpath = SYS(5) + CURDIR()
lcdrive = SUBSTR(m.localpath, 1, 2)
m.gtdefpath = SUBSTR(m.localpath,3)
delstat = SYS(2001,'deleted')
LIBRA = SYS(2001,'library')
IF !EMPTY(ALIAS())
WAIT WINDOW TIME 5 'Default drive: ' + lcdrive +CHR(13) + 'Default path is : ' + m.gtdefpath + CHR(13)+;
'Selected Table: ' + ALIAS() + CHR(13) + 'Index tag used: ' + SYS(22) + CHR(13) + 'SET DELETED is : ' + delstat + CHR(13) + 'Libraries : ' + LIBRA
ELSE
WAIT WINDOW TIME 5 'Default drive: ' + lcdrive +CHR(13) + 'Default path is : ' + m.gtdefpath + CHR(13) + 'SET DELETED is : ' + delstat + CHR(13) + 'Libraries : ' + LIBRA
ENDIF

PROCEDURE vistuff
WAIT WINDOW AT 10,2 'One' TIME 0.5 NOCLEA
WAIT WINDOW AT 12,2 'Two' TIME 0.5 NOCLEA
WAIT WINDOW AT 14,2 'Three' NOCLEA TIME 1

PROCEDURE fpwstuff
VERS = VERSION()
IF SUBSTR(VERS,1,3) = 'Vis'
WAIT WINDOW 'We are running under Visual Foxpro' TIME 2
ELSE
WAIT WINDOW 'We are running under Foxpro 2.6' TIME 2
ENDIF
lnmainloop = 1
lnsecondloop = 0
DO WHILE lnmainloop = 1
DO WHILE lnsecondloop = 0
WAIT WINDOW 'Ring a ding .............1' + CHR(13) +;
'Screen Resolution ...2' + CHR(13) +;
'Wait date ...............3' + CHR(13) +;
'System status ..........4' + CHR(13) +;
'Exit ........................5';
TO lcanswer
DO CASE
CASE UPPER(lcanswer) = '1'
SET BELL TO 'c:\windows\ding.wav',1
??CHR(7)
CASE UPPER(lcanswer) = '2'
WAIT WINDOW TIME 1 'Resolution is : ' + TRANS(SYSMETRIC(1),'###') + ' x ' + TRANS(SYSMETRIC(2),'###')
CASE UPPER(lcanswer) = '3'
WAIT WINDOW TIME 1 CDOW(DATE())+ ', ' + CMONTH(DATE())+ TRANSFORM(DAY(DATE()),'##')+ ', ' + TRANSFORM(YEAR(DATE()),'####')
CASE UPPER(lcanswe
For every bug fixed, there is a bigger bug not yet discovered.
Répondre
Fil
Voir

Click here to load this message in the networking platform