#define CINDEXEXT ".CDX"
#define DRIVER "SIX"
#define KS_ALT_M CHR(0) + CHR(50)
#define IDI_QUESTION 35214
// Menu Options
#define F_EXIT 11
#define M_INV 21
#define M_CUST 22
#define M_ALL 34
#define CKEY NIL
#include "Apollo.ch"
#include "FiveWin.ch"
#include "Inkey.ch"
STATIC oWnd
PROCEDURE Main (cSales)
LOCAL oIcon, oWindow, oBitMap, oBru, oMenu, nChoice, nI, nIndex, cOption, ;
cOpts
request SIX
rddRegister( "SIX", 1 )
rddsetdefault( "SIX" )
SET FILETYPE TO CDX
ThreadSleep(100)
* environment
SETCANCEL(.F.)
SET _3DLOOK ON
SET CENTURY ON
SET CONFIRM OFF
SET DELETED ON
SET EPOCH TO 2000
SET ESCAPE ON
SET WRAP ON
CLS
IF ! NetUse(.T., DRIVER, "Ctrl", , .T., , 5, , , CKEY)
QUIT
ENDIF
*****************************************************************
* Menu procedure
* Displays and performs menu actions.
*****************************************************************
* display fixed text
DEFINE BRUSH oBru DISK "logobmp.bmp"
DEFINE ICON oIcon DISK "logobmp.bmp"
DEFINE WINDOW oWindow FROM 13,45 TO 51,169 ;
TITLE "Mantenimiento De Sistema";
BRUSH oBru MENU MainMenu (@oWindow, @oMenu, @nChoice) ;
ICON oIcon
SET MESSAGE OF oWindow TO "Oprima Alt-Letra Subrayada" CLOCK DATE KEYBOARD
DEFINE BITMAP oBitMap DISK "logobmp.bmp" OF oWindow
oWindow:Center()
ACTIVATE WINDOW oWindow
oWnd := oWindow
* Menu loop
DO WHILE .T. .AND. cSales == NIL
IF LASTKEY() == K_ESC
nChoice := 0
ENDIF
IF VALTYPE(cOpts) == "C"
cOption := LEFT(cOpts,1)
HB_KEYPUT(KS_ALT_M)
HB_KEYPUT(cOption)
IF cOption == "C"
HB_KEYPUT(CHR(13))
HB_KEYPUT(CHR(13))
ENDIF
IF LEN(cOpts) > 1
cOpts := RIGHT(cOpts,LEN(cOpts) - 1)
ELSE
cOpts := NIL
ENDIF
ENDIF
ENDDO
CLOSE DATABASES
RETURN
* EOP: Main
STATIC PROCEDURE MainMenu (oWindow, oMenu, nChoice)
SETKEY(ASC("X"), {|| IIF( GetKeyState( ACC_ALT ), EVAL({|| IIF(ALERT( ;
"¿ Terminar ?", {"Si", "No"}, "Salir del Programa", IDI_QUESTION), ;
oWindow:End(), NIL)}), NIL)})
MENU oMenu
MENUITEM "&File" MESSAGE "Utilidades sobre archivos, Terminar"
MENU
MENUITEM "&Salir Alt-X" ;
ACTION IIF(ALERT("¿ Terminar ?", {"Si", "No"}, "Salir del " + ;
"Programa", IDI_QUESTION), oWnd:End(), NIL) ;
MESSAGE "Salir del programa"
ENDMENU
MENUITEM "&Mantenimiento" MESSAGE "Datos sobre Clientes"
MENU
MENUITEM "&Inventario" MESSAGE "Mantenimiento a Inventario" ;
ACTION Mant(@oWindow, M_INV)
// Other menu items omitted for the sake of clarity.
ENDMENU
ENDMENU
RETURN
* EOP: MainMenu
STATIC PROCEDURE Mant (oWindow, nChoice)
LOCAL nI, oSay, cIndexKey, nWindSel, cString
oWnd:bValid := {|| .F.}
DO CASE
CASE nChoice == M_INV
FERASE("Category" + CINDEXEXT)
IF NetUse(.T., DRIVER, "Category", , .F., , 5, , , CKEY)
MsgMeter( { | oMeter, oText, oDlg, lEnd | ;
CreateTag( oMeter, oText, oDlg, @lEnd , "CatNo", "Cat_no") },;
"Mantenimiento Inventario 2..." )
MsgMeter( { | oMeter, oText, oDlg, lEnd | ;
CreateTag( oMeter, oText, oDlg, @lEnd , "CatName", "Cat_name") },;
"Mantenimiento Inventario 2..." )
MsgMeter( { | oMeter, oText, oDlg, lEnd | ;
CreateTag( oMeter, oText, oDlg, @lEnd , "CatUserId", "Cat_userid", "! EMPTY(Cat_userid)") },;
"Mantenimiento Inventario 2..." )
USE
ENDIF
// Other CASE statements omitted for the sake of simplicity.
ENDCASE
oWnd:bValid := {|| .T.}
RETURN
// EOP: Mant
STATIC PROCEDURE CreateTag (OMeter, oText, oDlg, lEnd, cTagName, cKey, cCondition, lDescend)
*
* This PROCEDURE creates index TAGs.
*
MEMVAR cKeyField, cForCond
PRIVATE cKeyField, cForCond
IF VALTYPE(lDescend) != "L"
lDescend := .F.
ENDIF
cKeyField := cKey
oMeter:nTotal = RecCount()
IF cCondition != NIL
cForCond := cCondition
IF ! lDescend
INDEX ON &cKeyField TAG (cTagName) FOR &cForCond EVAL ( oMeter:Set( RecNo() ), SysRefresh(), ! lEnd )
ELSE
INDEX ON &cKeyField TAG (cTagName) FOR &cForCond EVAL ( oMeter:Set( RecNo() ), SysRefresh(), ! lEnd ) ;
DESCENDING
ENDIF
ELSE
IF ! lDescend
INDEX ON &cKeyField TAG (cTagName) EVAL ( oMeter:Set( RecNo() ), SysRefresh(), ! lEnd )
ELSE
INDEX ON &cKeyField TAG (cTagName) EVAL ( oMeter:Set( RecNo() ), SysRefresh(), ! lEnd ) ;
DESCENDING
ENDIF
ENDIF
RETURN
// EOP: CreateTag
#define NDISPLAY_TIME 5
FUNCTION NetUse (lNewArea, cDriver, cFileName, cAlias, lShared, lReadOnly, ;
nSeconds, acIndices, nTime, cPassWord)
/*
FUNCTION to use file in network environment.
PARAMETERS:
1. lNewArea (Logical) - USE NEW work area
2. cDriver (Character) - Database driver to be used
3. cFileName (Character) - Database filename
4. cAlias (Character) - Database ALIAS
5. lShared (Logical) - Open database in SHARED mode
6. lReadOnly (Logical) - Open database in READONLY mode
7. nSeconds (Numeric) - Number of seconds to attempt open
8. acIndices (Array) - Character array of indices to open
9. nTime (Numeric) - Number of seconds to elapse before
displaying message to user (for
infinite retries)
10. cPassWord (Character) - Database password
*/
LOCAL lForEver, nDisplay, lUsed := .F., nOldWindow, nWindow
#ifdef SINGLE_USER
lShared := .F.
#endif
IF VALTYPE(nSeconds) != "N"
nSeconds := 0
ENDIF
IF VALTYPE(nTime) != "N"
nTime := NDISPLAY_TIME
ENDIF
lForEver := (nSeconds == 0)
IF lForEver
nDisplay := 0
ENDIF
DO WHILE (lForEver .OR. nSeconds > 0) .AND. ! lUsed
BEGIN SEQUENCE
DBUSEAREA(lNewArea, (cDriver), (cFileName), (cAlias), ;
lShared, lReadOnly)
IF ! NETERR()
IF VALTYPE(acIndices) == "A"
AEVAL(acIndices, {|cIndex| DBSETINDEX(cIndex)})
ENDIF
lUsed := .T.
ENDIF
END
IF ! lUsed
INKEY(1)
IF lForEver
nDisplay++
IF nDisplay == nTime
MsgInfo("Tratando De Accesar Archivo")
INKEY(3)
nDisplay := 0
ENDIF
ENDIF
ENDIF
nSeconds--
ENDDO
/*
If lock unsuccesfull, display message.
*/
IF ! lUsed
MsgInfo("Un Archivo No Est Disponible")
INKEY(3) // display message 3 seconds
ENDIF
RETURN (lUsed)
* EOF: NetUse
