HMGforum.com

Code: Select all

#include "minigui.ch"
#xtranslate VALID <condition> [MESSAGE <message>];
=>;
ON LOSTFOCUS _DOVALID (<condition>,<message>)
MEMVAR _HMG_ISVALIDINPROGRESS

PROCEDURE MAIN()
	PUBLIC CDIR,_HMG_ISVALIDINPROGRESS := .F.,exit := .F.
	SET MULTIPLE OFF WARNING
	SET NAVIGATION EXTENDED
	CDIR='\'+CURDIR()	
	SET DEFA TO &CDIR
	USE COMPANY
	DEFINE WINDOW WINMAIN AT 0,0;
                      WIDTH 500 HEIGHT 700 TITLE "TESTING SOFTWARE";
                      WINDOWTYPE MAIN
		DEFINE MAIN MENU
			POPUP "FIRM MENU"
				ITEM "CREATE NEW FIRM" ACTION COMPADD()
				ITEM "EDIT FIRM DATA"  ACTION NIL
				ITEM "SELECT A FIRM"   ACTION NIL
				ITEM "BACKUP FIRM DATA" ACTION NIL
				ITEM "RESTORE FIRM DATA" ACTION NIL
				ITEM "DELETE FIRM" ACTION NIL
				SEPARATOR
				ITEM "Exit" ACTION EXIT PROGRAM    
			END POPUP
		END MENU
	END WINDOW
        MAXIMIZE WINDOW WINMAIN
	WINMAIN.ACTIVATE()
RETURN 

*****************
PROCEDURE COMPADD
*****************
exit := .F.
DEFINE WINDOW WINCOMPADD AT 100,100; 
              WIDTH 560 HEIGHT 360;
              TITLE "Add New Company";
              FONT 'ARIAL' SIZE 12;
              WINDOWTYPE CHILD;
              ON INIT  WINCOMPADD.CC.SETFOCUS ;
              ON INTERACTIVECLOSE exit:=.T.
	@ 30, 30  LABEL LBLCC    VALUE 'Company Code' 
	@ 80, 30  LABEL LBLCNAME VALUE 'Company Name'  
	@ 130,30  LABEL LBLCADD1 VALUE 'Address'
	@ 230,30  LABEL LBLFDATE VALUE 'From Date'
	@ 230,300 LABEL LBLTDATE VALUE 'To Date'
	@ 30, 150 TEXTBOX CC WIDTH 25 MAXLENGTH 2 VALID V_CC() MESSAGE 'THIS COMPANY CODE ALREADY EXISTS....'
	@ 80, 150 TEXTBOX CNAME WIDTH 375 MAXLENGTH 35 VALID V_CNAME() 
	@ 130,150 TEXTBOX CADD1 WIDTH 375 MAXLENGTH 80 
	@ 155,150 TEXTBOX CADD2 WIDTH 375 MAXLENGTH 80 
	@ 180,150 TEXTBOX CADD3 WIDTH 375 MAXLENGTH 80 
	@ 230,150 DATEPICKER FDATE 
	@ 230,380 DATEPICKER TDATE 
	@ 280,175 BUTTON BTNSAVE CAPTION 'Save' WIDTH 100 ON CLICK SAVECOMPANYDATA()
	@ 280,285 BUTTON BTNEXIT CAPTION 'Exit' WIDTH 100 ACTION EXITWINDOW()
END WINDOW
WINCOMPADD.CENTER()
WINCOMPADD.ACTIVATE()
RETURN

*************
FUNCTION V_CC
*************
IF ! EMPTY(THIS.VALUE)
   SELECT COMPANY
   LOCA FOR COMPCODE=WINCOMPADD.CC.VALUE
   IF FOUND()
	RETURN .F.
   ENDIF
ENDIF
RETURN .T.

****************
FUNCTION V_CNAME
****************
IF EMPTY(WINCOMPADD.CNAME.VALUE)
	RETURN .F.
ENDIF
RETURN .T.

************************
FUNCTION SAVECOMPANYDATA
************************
IF ! EMPTY(WINCOMPADD.CC.VALUE)
	SELECT COMPANY
	APPE BLAN
	REPL COMPCODE WITH WINCOMPADD.CC.Value
	REPL COMPNAME WITH WINCOMPADD.CNAME.VALUE
	REPL COMPADD1 WITH WINCOMPADD.CADD1.VALUE
	REPL COMPADD2 WITH WINCOMPADD.CADD2.VALUE
	REPL COMPADD3 WITH WINCOMPADD.CADD3.VALUE
	REPL FROMDATE WITH WINCOMPADD.FDATE.VALUE
	REPL TODATE   WITH WINCOMPADD.TDATE.VALUE
	MSGINFO("COMPANY HAS BEEN INSTALLED")
	RELEASE WINDOW WINCOMPADD
ELSE
	MSGSTOP("PLEASE ENTER COMPANY CODE!")
	SETFOCUS CC OF WINCOMPADD
ENDIF
RETURN NIL

*******************
FUNCTION EXITWINDOW
*******************
RELEASE WINDOW WINCOMPADD
RETURN .T.

************************************** 
FUNCTION _DOVALID (EXPRESSION,MESSAGE)
************************************** 
IF _HMG_ISVALIDINPROGRESS .OR. THIS.FOCUSEDCONTROL == "BTNEXIT" .OR. exit
	RETURN NIL
ELSE
	IF VALTYPE(MESSAGE)="U"
		MESSAGE := "INVALID ENTRY"
	ENDIF
	_HMG_ISVALIDINPROGRESS := .T.
	IF (EXPRESSION,NIL,(MSGSTOP(MESSAGE,"ERROR"),THIS.SETFOCUS))
	_HMG_ISVALIDINPROGRESS := .F.
ENDIF
RETURN NIL