supercls.prg

来自「MSComm控件资料,Visual Basic 6.0(以下简称VB) 是一种功」· PRG 代码 · 共 116 行

*  Program...........: SUPERCLS.PRG
*  Author............: Ken R. Levy
*  Project...........: Supercls
*  Created...........: 07/02/1995
*  Modified..........: 10/13/1998
*  Copyright.........: (Public Domain), Ken R. Levy, 1996-1998, (c) Flash Creative Management, Inc., 1995
*) Description.......: Supercls toolbar start-up routine.


LPARAMETERS tcClass,tlTimerDisabled,tnDockLocation
LOCAL lcProgramPath,lcMenuCommand,lcClass,lcClassLibrary,llTimerDisabled
LOCAL lnAtPos,lcProgram,lcLastSetTalk

lcLastSetTalk=SET("TALK")
SET TALK OFF
IF VAL(SUBSTR(VERSION(),15))<6
	WAIT WINDOW "SuperCls requires Visual FoxPro 6.0 or higher" NOWAIT
	IF lcLastSetTalk=="ON"
		SET TALK ON
	ELSE
		SET TALK OFF
	ENDIF
	RETURN .F.
ENDIF
lcProgram=LOWER(SYS(16))
lnAtPos=RAT("\",lcProgram)
lcProgramPath=ALLTRIM(IIF(lnAtPos=0,lcProgram,LEFT(lcProgram,lnAtPos)))

*** EGL: 2002.1.2 07:01 -  This is no longer needed with VFP 7
IF VAL(SUBSTR(VERSION(),15)) < 7
	IF EMPTY(ON("KEY","F2"))
		lcMenuCommand=["]+lcProgramPath+[OLSBldr.scx"]
		ON KEY LABEL F2 DO FORM &lcMenuCommand
	ENDIF
ENDIF

IF EMPTY(ON("KEY","Alt+F10"))
	lcMenuCommand=["]+lcProgramPath+[ObjectX.prg"]
	ON KEY LABEL Alt+F10 DO &lcMenuCommand
ENDIF
lcClass=IIF(TYPE("tcClass")#"C" OR EMPTY(tcClass),"Supercls",tcClass)
llTimerDisabled=(tlTimerDisabled OR TYPE("tnDockLocation")=="N")
lnAtPos=AT(",",lcClass)
IF lnAtPos>0
	lcClassLibrary=LOWER(ALLTRIM(MLINE(LEFT(lcClass,lnAtPos-1),1)))
	IF NOT "."$lcClassLibrary
		lcClassLibrary=lcClassLibrary+".vcx"
	ENDIF
	lcClass=LOWER(ALLTRIM(SUBSTR(lcClass,lnAtPos+1)))
	IF NOT FILE(lcClassLibrary)
		FileNotFoundMsg(lcClassLibrary)
		IF lcLastSetTalk=="ON"
			SET TALK ON
		ELSE
			SET TALK OFF
		ENDIF
		RETURN .F.
	ENDIF
	SET CLASSLIB TO (lcClassLibrary) ADDITIVE
ENDIF
IF TYPE("goSuperclassToolbar")#"O" OR ISNULL(goSuperclassToolbar) OR ;
		NOT LOWER(goSuperclassToolbar.Class)==LOWER(lcClass)
	RELEASE goSuperclassToolbar
	PUBLIC goSuperclassToolbar
	IF EMPTY(lcClassLibrary)
		lcClassLibrary=LOWER(FULLPATH(PROGRAM(),SYS(16)))
	ENDIF
	goSuperclassToolbar=NEWOBJECT(lcClass,lcClassLibrary)
ENDIF
IF TYPE("_screen.tmrSuperclass")=="O" AND ;
		_screen.tmrSuperclass.Enabled#(NOT llTimerDisabled)
	IF llTimerDisabled
		_screen.tmrSuperclass.Enabled=.F.
		IF TYPE("tnDockLocation")=="N"
			goSuperclassToolbar.Dock(tnDockLocation)
		ENDIF
		goSuperclassToolbar.Visible=.T.
	ELSE
		_screen.tmrSuperclass.Enabled=.T.
	ENDIF
ENDIF
IF lcLastSetTalk=="ON"
	SET TALK ON
ELSE
	SET TALK OFF
ENDIF
RETURN



FUNCTION ShowMsg(tcMessage)
LOCAL lnResult

lnResult=MESSAGEBOX(tcMessage,48,"Supercls")
WAIT CLEAR
RETURN lnResult



FUNCTION FileNotFoundMsg(tcFileName)
RETURN ShowMsg([File "]+LOWER(tcFileName)+[" not found.])



RETURN
* dummy command to insert files into project.
SET CLASSLIB TO supercls ADDITIVE
do objectx.prg
DO FORM olsbldr
DO FORM savecls
DO supercls.txt
DO olsbldr.ico
DO draglink.cur
DO nodrop.cur
DO savecls.ico