SET ESCA ON
SET SYSMENU TO
SET TALK OFF
SET ECHO OFF
SET STEP OFF
SET SAFE OFF
SET EXCL OFF
SET DATE TO ANSI
SET CENT ON
SET HOUR TO 24
SET MULT ON
SET DELE ON

LCDEFA=SET('DEFAULT')
LCDEFAULTNOW=JUSTPATH(SYS(16))
IF RIGHT(LCDEFAULTNOW,1)<>'\'
 LCDEFAULTNOW=LCDEFAULTNOW+'\'
ENDI
LLCALLAPP=IIF(TYPE('LCCALLAPP')='C',LCCALLAPP=='CALLAPP',.F.)
IF !LLCALLAPP
ON SHUTDOWN DO ONSHUTD
ON ESCAPE DO ONESCAPE
ON ERROR DO ONERROR WITH ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO(1)
ON READERROR DO ONERROR WITH ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO(1)
ON KEY LABE F12 DO ONESCAPEF12
*SET DEFA TO &LCDEFAULTNOW
_SCREEN.WINDOWSTATE=2
_SCREEN.Caption='商品管理'
_screen.icon='stock.ico'
_SCREEN.AddObject('imgBK','image')&&按程序主界面的大小插入背景圖片
_SCREEN.imgBK.Picture = "mainview.gif"
_SCREEN.imgBK.Stretch = 2
_SCREEN.imgBK.Width=_SCREEN.WIDTH
_SCREEN.imgBK.Height = _SCREEN.HEIGHT
_SCREEN.imgBK.VISIBLE=.T.
_SCREEN.REFRESH
ENDI
CLOSE DATA ALL
CLOSE TABLE ALL

PUBLIC USERNAME,SHORTNAME,FULLNAME,ADDR
SELE 0
USEDBFCOMPANY()
M.SHORTNAME=COMPANY.NAME
M.FULLNAME=COMPANY.FULLNAME
M.ADDR=COMPANY.ADDR
USE
USERNAME=''
USEDBFEMPLOYEE()
DO FORM LOGIN NAME FORMLOGIN LINK
USEDBFEMPLOYEE()
USE
IF LEN(ALLT(USERNAME))>0
 _SCREEN.CAPTION='商品管理  操作員：'+USERNAME
 SET SYSM TO DEFA
 DO MAINMENU.MPR
 READ EVENTS
ENDI
SET SYSMENU TO DEFAULT
CLOSE DATA ALL
CLOSE TABLE ALL
IF LLCALLAPP
RETU
ELSE
ON SHUTDOWN
QUIT
ENDI

PROC ONERROR  &&錯誤處理程序
PARA MERROR, MESS, MESS1, MPROG, MLINENO
DO CASE
 CASE MERROR=0
  WAIT WINDOW '出錯信息：數據超出指定范圍，需要重新輸入。' TIMEOUT 3
  RETU
 CASE MERROR=1707
  WAIT WINDOW '出錯信息：找不到 .CDX 索引文件，忽略索引。' TIMEOUT 3
  RETRY
ENDCASE
=AERROR(aErrorArray)
IF TYPE('aErrorArray')='U'
LCERRM1=''
LCERRM2=''
LCERRM3=''
LCERRM4=''
LCERRM5=''
LCERRM6=''
LCERRM7=''
ELSE
LCERRM1=aErrorArray(1)
LCERRM2=aErrorArray(2)
LCERRM3=aErrorArray(3)
LCERRM4=aErrorArray(4)
LCERRM5=aErrorArray(5)
LCERRM6=aErrorArray(6)
LCERRM7=aErrorArray(7)
ENDI
LCERR0='出錯程序：'+MPROG+CHR(13)+'出錯行號：'+LTRIM(STR(MLINENO))+CHR(13)+'出錯代碼：'+MESS1+CHR(13)
LCERR1='錯誤編號：'+ALLT(IIF(TYPE('LCERRM1')='C' AND !ISNULL(LCERRM1),LCERRM1,IIF(TYPE('LCERRM1')='N',STR(LCERRM1),'')))+CHR(13)
LCERR2='錯誤信息：'+ALLT(IIF(TYPE('LCERRM2')='C' AND !ISNULL(LCERRM2),LCERRM2,IIF(TYPE('LCERRM2')='N',STR(LCERRM2),'')))+CHR(13)
LCERR3='附加信息：'+ALLT(IIF(TYPE('LCERRM3')='C' AND !ISNULL(LCERRM3),LCERRM3,IIF(TYPE('LCERRM3')='N',STR(LCERRM3),'')))+CHR(13)
LCERR4='錯誤狀態：'+ALLT(IIF(TYPE('LCERRM4')='C' AND !ISNULL(LCERRM4),LCERRM4,IIF(TYPE('LCERRM4')='N',STR(LCERRM4),'')))+CHR(13)
LCERR5='觸發信息：'+ALLT(IIF(TYPE('LCERRM5')='C' AND !ISNULL(LCERRM5),LCERRM5,IIF(TYPE('LCERRM5')='N',STR(LCERRM5),'')))+CHR(13)
LCERR6='相關標識：'+ALLT(IIF(TYPE('LCERRM6')='C' AND !ISNULL(LCERRM6),LCERRM6,IIF(TYPE('LCERRM6')='N',STR(LCERRM6),'')))+CHR(13)
LCERR7='異常信息：'+ALLT(IIF(TYPE('LCERRM7')='C' AND !ISNULL(LCERRM7),LCERRM7,IIF(TYPE('LCERRM7')='N',STR(LCERRM7),'')))+CHR(13)+SPACE(50)+CHR(13)
ERRMSG=MESSAGEBOX(LCERR0+LCERR1+LCERR2+LCERR3+LCERR4+LCERR5+LCERR6+LCERR7;
+'是否要終止？  (建議終止本程序并與程序設計或數據管理人員聯系)    ',2+48,'出錯信息')
DO CASE
CASE ERRMSG=4
 SET DEBUG ON
 SET ECHO ON
 RETRY
CASE ERRMSG=5
 SET DEBUG ON
 SET ECHO ON
 RETURN
CASE ERRMSG=3
 DO REALQUIT
ENDCASE
RETU

PROC REALQUIT  &&退出
CLEAR WINDOWS ALL
CLOSE ALTE ALL
CLOSE DATA ALL
CLOSE FORMAT ALL
CLOSE INDE ALL
CLOSE TABLES ALL
CLEAR READ ALL
CLEAR EVENTS
SET SYSM TO DEFA
IF LLCALLAPP
RETU
ELSE
ON SHUTDOWN
QUIT
ENDI

PROC ONSHUTD  &&退出處理程序
IF MESSAGEBOX("是否要退出本系統?    ",32+1,"退出")=1
DO REALQUIT
ENDI

PROC ONESCAPE  &&按ESC鍵處理程序
=MESSAGEBOX("ESCAPE鍵中止！    ",4+48,"中止")
DO ONSHUTD
RETU

PROC ONESCAPEF12  &&按F12鍵處理程序
=MESSAGEBOX("F12 鍵中止！    ",4+48,"中止")
DO ONSHUTD
RETU