Marius Mutu
63f3828d5e
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_012P75yL9Fc9EcT33tMbuxcF
8956 lines
258 KiB
Plaintext
8956 lines
258 KiB
Plaintext
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
|
|
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
*< FOXBIN2PRG: Version="1.21" SourceFile="_framewk.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
|
|
*
|
|
*
|
|
DEFINE CLASS _aboutbox AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default about box
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="imgApplication" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblApplicationName" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblCredits" UniqueID="" Timestamp="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*m: applyattributestodialogelements && Called in ApplyAppAttributes(), after this method has transferred app "credits" information to dialog property values, so you can apply these attributes to the visual elements of the dialog.
|
|
*p: cauthor
|
|
*p: ccaption
|
|
*p: ccompany
|
|
*p: ccopyright
|
|
*p: cimage
|
|
*p: ctrademark
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
Caption = "About Application"
|
|
cauthor =
|
|
ccaption =
|
|
ccompany =
|
|
ccopyright =
|
|
cimage =
|
|
ctrademark =
|
|
cversion =
|
|
DoCreate = .T.
|
|
Height = 218
|
|
Name = "_aboutbox"
|
|
Width = 367
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'cmdOK' AS _commandbutton WITH ;
|
|
AutoSize = .F., ;
|
|
Caption = "\<OK", ;
|
|
Default = .T., ;
|
|
FontName = "MS Sans Serif", ;
|
|
Height = 27, ;
|
|
Left = 307, ;
|
|
Name = "cmdOK", ;
|
|
Top = 183, ;
|
|
Width = 48
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'imgApplication' AS _image WITH ;
|
|
BackStyle = 0, ;
|
|
Height = 72, ;
|
|
Left = 14, ;
|
|
Name = "imgApplication", ;
|
|
Stretch = 1, ;
|
|
Top = 12, ;
|
|
Width = 90
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="image" />
|
|
|
|
ADD OBJECT 'lblApplicationName' AS _label WITH ;
|
|
Alignment = 2, ;
|
|
AutoSize = .F., ;
|
|
Caption = "Application Name", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 31, ;
|
|
Left = 116, ;
|
|
Name = "lblApplicationName", ;
|
|
Top = 12, ;
|
|
Width = 237
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'lblCredits' AS _label WITH ;
|
|
Alignment = 2, ;
|
|
AutoSize = .F., ;
|
|
Caption = "Credits", ;
|
|
FontName = "MS Sans Serif", ;
|
|
Height = 127, ;
|
|
Left = 116, ;
|
|
Name = "lblCredits", ;
|
|
Top = 48, ;
|
|
Width = 237
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
PROCEDURE applyappattributes
|
|
LPARAMETERS toApp
|
|
IF DODEFAULT(toApp)
|
|
|
|
* parent dialog class is already setting Icon
|
|
THIS.Caption = ABOUT_LOC+" "+TRANS(toApp.cCaption)
|
|
THIS.cCaption = TRANS(toApp.cCaption)
|
|
THIS.cVersion = TRANS(toApp.cVersion)
|
|
THIS.cCopyright = TRANS(toApp.cCopyright)
|
|
THIS.cCompany = TRANS(toApp.cCompany)
|
|
THIS.cAuthor = TRANS(toApp.cAuthor)
|
|
THIS.cTrademark = TRANS(toApp.cTrademark)
|
|
THIS.cImage = TRANS(toApp.cImage)
|
|
|
|
|
|
ENDIF
|
|
|
|
THIS.ApplyAttributesToDialogElements()
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE applyattributestodialogelements && Called in ApplyAppAttributes(), after this method has transferred app "credits" information to dialog property values, so you can apply these attributes to the visual elements of the dialog.
|
|
IF PEMSTATUS(THIS,"imgApplication",5)
|
|
IF (NOT EMPTY(THIS.cImage)) AND ;
|
|
(FILE(THIS.cImage))
|
|
THIS.imgApplication.Visible = .T.
|
|
THIS.imgApplication.Picture = THIS.cImage
|
|
ELSE
|
|
THIS.imgApplication.Visible = .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF PEMSTATUS(THIS,"lblApplicationName",5)
|
|
THIS.lblApplicationName.Caption = THIS.cCaption
|
|
ENDIF
|
|
|
|
IF PEMSTATUS(THIS,"lblCredits",5)
|
|
|
|
THIS.lblCredits.Caption = THIS.cAuthor
|
|
|
|
THIS.lblCredits.Caption = THIS.lblCredits.Caption + ;
|
|
CHR(13)+ ;
|
|
THIS.cCompany
|
|
|
|
THIS.lblCredits.Caption = THIS.lblCredits.Caption + ;
|
|
CHR(13)+ ;
|
|
THIS.cCopyright
|
|
|
|
THIS.lblCredits.Caption = THIS.lblCredits.Caption + ;
|
|
CHR(13)+ ;
|
|
THIS.cTrademark
|
|
|
|
THIS.lblCredits.Caption = THIS.lblCredits.Caption + ;
|
|
CHR(13)+ ;
|
|
THIS.cVersion
|
|
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdOK.Click
|
|
THISFORM.Release()
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _application AS _container OF "..\ffc\_base.vcx" && application object superclass
|
|
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="cusError" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cusDataSession" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cusWindowHandler" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cusTableSort" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cusTableNav" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="tmrRefresh" UniqueID="" Timestamp="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*m: activate && Makes the application active
|
|
*m: activateforminframe && Takes a form or toolbar reference and fixes it to appear in top form "frame" even if its ShowWindow property was 0
|
|
*m: activatesystemwindow && Activates a system window whose name has been passed, in _SCREEN, even if _SCREEN wasn't previously visible (for debugging, does nothing in runtime)
|
|
*m: addcollaborator && Instantiate objects that can't be part of application container and add a reference to collaborators collection for maintenance. See SetScreenAttributes() for examples.
|
|
*m: addmediatedsession && Creates a data session with a mediator object attached, referenced in the aCollaborators collection, returns a reference to this framework-enabled session.
|
|
*m: applyglobaluseroptions && Applies global (non-datasession-specific) options to the _application object and environment. Where user login and preferences are not used, applies a single set at startup -- with user login and preferences, applies to each user login.
|
|
*m: applyuseroptsforsession && Applies datasession-specific options a form object and its session environment.
|
|
*m: beforedoform && Hook in DoForm method, allowing last-minute manipulation of environment before the form class or object is instantiated.
|
|
*m: beforereadevents && Method executed before READ EVENTS is executed when ReadEvents is called.
|
|
*m: caboutboxclass_access && Synchronizes classname value with lAboutBox value
|
|
*m: cappfolder_access && Determines the application folder, usually the folder containing the running APP or EXE. However where a temporary wrapper program or ON... command has been used to instantiate the application, this value may be the location of the VCX
|
|
*m: cascadeall && Wraps cusWindowHandler's CascadeFormInstances() method, passing no argument.
|
|
*m: cascadeform && For backwards compatibility, not used
|
|
*m: ccaption_access
|
|
*m: ccaption_assign
|
|
*m: cdatafolder_assign
|
|
*m: cerrorlogtablename_access && adds cAppFolder information to the error log table name, so the default error DBF is always in one place.
|
|
*m: checkpassword && Sends a passed value and a stored value from the current user information to CheckValueAgainstStoredPassword for verification.
|
|
*m: checkvalueagainststoredpassword && Compares a current password entry against an encrypted stored entry. Separated from CheckPassword so its simple algorithm can be replaced as necessary. Algorithms in CreateStoredPassword and CheckValueAgainstStoredPassword should match.
|
|
*m: cicon_assign
|
|
*m: cimage_assign && Verifies the availability of an image file for use as the application logo
|
|
*m: clearevents && Clears any pending read events.
|
|
*m: clearfavorites && Called by Favorites menu item, to confirm "zap" of user favorites and invoke SetCurrentUserFavoriteIDs mechanism.
|
|
*m: clearlasterror && Sets _application.iLastError to NULL, called before operations which may require an error to be tested on conclusion. Abstracted for easy overriding in subclasses.
|
|
*m: createcollaborators && A startup hook to allow you to call the AddCollaborators() method during initialization procedures
|
|
*m: createformmediator && Adds a app mediator object to a form
|
|
*m: createframe && Creates the MDI frame for top form applications.
|
|
*m: createstoredpassword && Creates an encrypted value of a password. Separated from StorePassword() for easy replacement of its simple algorithm. Algorithms in CreateStoredPassword and CheckValueAgainstStoredPassword should match.
|
|
*m: createusertable && Creates and indexs user table when it does not exist. Abstracted for easy editing. The app expects this table to have 1 c-type field, with its name in the cUserTableIDField property, and 1 i-type field, its name in cUserTableLevelField.
|
|
*m: creference_assign
|
|
*m: cstartupformclass_access && Synchronizes classname value with lStartupForm value
|
|
*m: cstartuptoolbarclass_access && Synchronizes classname value with lStartupToolbar value
|
|
*m: ctextdisplayfont_assign
|
|
*m: cusertablealias_assign
|
|
*m: cusertablename_access
|
|
*m: datarevert && Wraps cusDataSession's Revert() method.
|
|
*m: dataupdate && Wraps cusDataSession's Update() method.
|
|
*m: displayerrorlog && Instantiates cErrorViewerClass dialog
|
|
*m: doaboutbox && Invokes cAboutBoxClass dialog class
|
|
*m: dochangepassword && Invokes cChangePasswordClass dialog class
|
|
*m: docontextmenu && Manages context menus and context menu collection
|
|
*m: dodocumentpickerdialog && Invokes all the dialogs descending from the _documentpicker dialog superclass
|
|
*m: dofile && Executes files, channelling known FoxPro-type files to appropriate application Do... methods, and files of unknown types through Windows API
|
|
*m: doform && Executes an SCX form or instantiates a VCX-based form/formset class.
|
|
*m: doformnoshow && Executes an SCX form or instantiates a VCX-based form/formset class, without Showing it, and returning a reference to the form or formset instantiated.
|
|
*m: dohelp && Executes help of types .hlp, .dbf, .htm, or .chm
|
|
*m: dolabel && Executes an LBX label
|
|
*m: domenu && Executes an MPR/MPX menu.
|
|
*m: domenuiteminframe && Not currently used, wraps cusWindowHandler method
|
|
*m: domodaldialogclass && Instantiates a modal dialog, applying application attributes as appropriate. RETURNs a form reference, if NOSHOW.
|
|
*m: donewopen && Invokes cNewOpenClass
|
|
*m: dooptionsdialog && Invokes cOptionsDialogClass
|
|
*m: doprogram && Executes a PRG, APP, FXP, or EXE program.
|
|
*m: doreport && Executes an FRX or LBX report form.
|
|
*m: doreportdialog && Invokes cReportDialogClass
|
|
*m: dosort && Wraps cusTableSort's DoSort() method.
|
|
*m: dostartupform && Instantiates cStartupFormClass dialog
|
|
*m: dotableoutput && Looks at the current form/alias and invokes the _outputdialog class appropriately for a table. Scope 1 or all. Hooks mediator's PrepareOutputAlias() and CleanupOutputAlias(), for framework-enabled forms, and app.SetHTMLClass/SetHTMLStyleID for GENHTML.
|
|
*m: dotoolbar && Parallel to DoForm. Maintains toolbars collection. Pass a toolbar class library & class name. Uses THIS.iInitialToolbarPosition to set position.
|
|
*m: douserlogin && Invokes cUserLoginClass dialog. Returns (NOT EOF(THIS.cUserTableAlias)) to indicate success at locating a user.
|
|
*m: exporterrorlog && Invokes _outputdialog class to allow output of error log information.
|
|
*m: filenotfoundmsgbox && Displays a File Not Found messagebox.
|
|
*m: filluseroptionsarray && Moves the user table's UserOpts contents to aCurrentUserOpts. Array has 4 columns: property name, value, toggle property or SET, datasession or global attribute
|
|
*m: formisframeworkenabled && Reports the existance of a mediator object on a form. Uses THIS.cFormMediatorName to determine the naming convention for this object on the form.
|
|
*m: getcurrentalias && Wraps the cusTableNav member's GetCurrentAlias() method.
|
|
*m: getcurrenttopformref && Wraps cusWindowHandler's GetCurrentTopFormRef() method.
|
|
*m: getformmediatorref && Returns a reference to a form's mediator object, or NULL if the form is not framework-enabled with a mediator object.
|
|
*m: getresourcefilename && Pass: tcSource, tcExtList, tlSuppressMsg, looks for file with any of extensions in list, in order, to RETURN the appropriate pathed name ("" if none, with File Not Found msg unless tlSuppressMsg). Ignores tcExtlList if explicit ext passed in tcSource.
|
|
*m: getuseroptionsetting && Takes option name and array (usually aCurrentUserOpts) and returns current value for that option, NULL if not found.
|
|
*m: gobottom && Wraps cusTableNav member's GoBottom() method.
|
|
*m: gonext && Wraps cusTableNav member's GoNext() method.
|
|
*m: goprevious && Wraps cusTableNav member's GoPrevious() method.
|
|
*m: gotop && Wraps cusTableNav member's GoTop() method.
|
|
*m: gotorecord && Wraps cusTableNav member's GoToRecord() method.
|
|
*m: handleprojectwindow && Hides a project with the name stored in THIS.cProjectName on startup, if it is showing, and restores it when the app object Destroys.
|
|
*m: iinitialtoolbarposition_assign
|
|
*m: ilasterror_access
|
|
*m: instantiate && RETURNs object reference -- pass classname, classlib, APP/EXE if library is external, string of delimited parameters to be macro-executed. If being added as a member, also pass container ref plus membername if it's not OK to use unique/generated name.
|
|
*m: iserrorfree && RETURNs ISNULL(THIS.iLastError) -- See THIS.ClearLastError().
|
|
*m: lgomenu_assign
|
|
*m: lnavtoolbar_assign
|
|
*m: lnointerrupt_assign
|
|
*m: lusercanchangepassword_access
|
|
*m: lusercanchangepassword_assign
|
|
*m: onshutdown && Occurs when the user attempts to exit Visual FoxPro by pressing _SCREEN close button or the close button on a framework top form MDI frame.
|
|
*m: purgeerrorlog && Zaps current error log with appropriate confirmation and checks.
|
|
*m: querydatachanged && Wraps cusDataSession member's DataChanged() method.
|
|
*m: querydatasessionunload && Wraps cusDataSession member's Queryunload() method.
|
|
*m: readevents && Starts read events mode.
|
|
*m: refreshfavoritepopup && DEFINEs BARs for Favorites menu popup using THIS.cCurrentUserFavoriteIDs.
|
|
*m: refreshformscollection && Refresh forms collection arrays and counters.
|
|
*m: refreshtoolbars && Called by member timer and at any other time you need to synch toolbars to current environment. Iterates through toolbar collection calling Refresh methods so that it doesn't assume any tbr class.
|
|
*m: releasecollaborators && Manages release of collaborative objects
|
|
*m: releasecontextmenu && Manages release of a single context menu and the context menu collection.
|
|
*m: releasecontextmenus && Releases all context menus.
|
|
*m: releaseform && Release specific or active form and manages forms collection.
|
|
*m: releaseforms && Release all application forms from memory and the forms collection.
|
|
*m: releaseframe && Releases top form/MDI frame.
|
|
*m: releasesessions && Releases all mediated datasession collaborator objects
|
|
*m: releasetoolbar && Parallel to ReleaseForm. Maintains toolbars collection.
|
|
*m: releasetoolbars && Parallel to ReleaseForms. Iterates through toolbar collection
|
|
*m: resetformscollection && Reset arrays and counters of forms collection.
|
|
*m: restoreenvironment && Restores environment settings.
|
|
*m: saveenvironment && Saves environment settings.
|
|
*m: seekcurrentuser && This method finds the current user using an exact match (case sensitivity depends on THIS.lUserNameIsCaseSensitive).
|
|
*m: seekdefaultuser && This method finds a record with a blank user name where default options and favorites are stores, for use when defining a new user or when user logins and separate user profiles are not required.
|
|
*m: seekmetatablefavoriteid && Finds a record in the meta table using an identification specified in #DEFINE APP_META_FAVE_ID in _FRAMEWK.H. Override this method if you decide to use a more sophisticated method of identifying records in the metatable!
|
|
*m: setappfilenames && Get top-level filename, and also get the name of the module (app or exe) that owns this particular object, for SET CLASSLIB ... IN... default usage, which may be different, especially in modular and non-ReadEvents apps.
|
|
*m: setcurrentuser && Finds the current user and sets up the app to deal with the current user (permissions, options, favorites, and macros may all change per user).
|
|
*m: setcurrentuserfavoriteids && Saves and restores THIS.cCurrentUserFavoriteIDs information to UserFave memo field in user table. This memo field also contains date information, so user can opt to clear favorites list if metatable has changed since user has identified favorites.
|
|
*m: setdatasessionenvironment && Sets a specified data session to a default set of SETs, which you place in the SetDataSessionSets for use by any form or session you want.
|
|
*m: setdatasessionsets && Contains a default list of data-session-related SETs so you can easily invoke this list within any form or datasesion.
|
|
*m: setenvironment && Sets up certain global attributes, such as screen or frame characteristics, ON SHUTDOWN, ON ERROR, and macros for use during the life of the app. Does *nothing* if not a ReadEvents app.
|
|
*m: setframeattributes && Applies application cCaption and cIcon to the MDI frame, as well as the appropriate backcolor for an MDI frame window.
|
|
*m: sethtmlclass && Abstract. Takes parameters tcSource (report form or alias/table), tlTable, so you can decide what HTMLClass is appropriate. Passed to GENHTML via _outputdialog attributes.
|
|
*m: sethtmlstyleid && Abstract. Takes parameters tcSource (report form or alias/table), tlTable, so you can decide what HTMLClass is appropriate. Passed to GENHTML via _outputdialog attributes.
|
|
*m: setmacros && Saves and restores a set of macros using the user table. Synchronizes enabling of bars on the macro-handling popup, using THIS.cMacroPopupName, depending on current set of user macros.
|
|
*m: setscreenattributes && Sets up screen attributes, including visibility, caption and icon, and system toolbars, for a read events app that does not take place in its own topform MDI frame.
|
|
*m: setuserpermissions && Abstract in the base. Called when a new user logs on. Designed to use iCurrentUserLevel property, derived from user table, to maintain groups. Menu items would be added/substracted/enabled/disabled based on group level at this time.
|
|
*m: show && Sets up visible aspects of the application and, if successful, Activate()s the application, at startup.
|
|
*m: showstartupelements && Sets up top form MDI frame, startup menu, startup toolbar, screen attributes, and startup form.
|
|
*m: showtablefinddialog && Instantiates _FindDialog class, in advanced or standard mode, depending on THIS.lFindOnMultipleTables value. (Advanced mode allows the user to choose between all open aliases in a data session.)
|
|
*m: showtablegotodialog && Instantiates _GoToDialog class.
|
|
*m: showtablesetfilterdialog && Instantiates _FilterExpr class, in advanced or standard depending on THIS.lUseGetExpr value. (Standard mode uses _FilterDialog as a subsidiary dialog, Advanced uses _GETEXPR.)
|
|
*m: storepassword && Stores the encrypted value of a new password to the current record in the user table.
|
|
*m: validatemetatable && Ensures that a table contains a valid and available table for documents registry. Validates THIS.cMetatable, if used, on startup.
|
|
*p: caboutboxclass && Name of dialog class instantiated by DoAboutBox()
|
|
*p: caboutboxclasslib && Class library for dialog class instantiated by DoAboutBox(). If empty defaults to same class library as application object.
|
|
*p: cappfilename && Top level filename
|
|
*p: cappfolder && Location of application, usually top level file, but sometimes the location of the module that owns the VCX of this application object. Indicates default location of generated system files such as error and user tables.
|
|
*p: cauthor && "Credits" information.
|
|
*p: ccaption && Friendly name of the application object.
|
|
*p: cchangepasswordclass && Dialog class instantiated by DoChangePassword().
|
|
*p: cchangepasswordclasslib && Class library for dialog class instantiated by DoChangePassword(). If empty defaults to same class library as application object.
|
|
*p: cclasscontainerfilename && APP,EXE, or DLL containing the VCX from which this app object was instantiated.
|
|
*p: ccompany && "Credits" information.
|
|
*p: ccopyright && "Credits" information.
|
|
*p: ccurrentuser && Name of current user as logged on.
|
|
*p: ccurrentuserfavoriteids && A delimited string containing IDs of metatable entries that should be included in Favorites list as well as filenames picked by user for inclusions in Favorites list.
|
|
*p: cdatafolder && Not used internally, allows you to maintain a current location for your data or for user-generated files.
|
|
*p: cerrorlogtablename && Default table name for error log.
|
|
*p: cerrorviewerclass && Dialog class instantiated by DisplayErrorLog().
|
|
*p: cerrorviewerclasslib && Class library for dialog class instantiated by DisplayErrorLog(). If empty defaults to same class library as application object.
|
|
*p: cfavoritepopupname && Name of popup displaying favorites. Required so the app object can refresh this popup between users or when a user selects new Favorites.
|
|
*p: cformmediatorname && Member name the app object looks for when contacting a mediator object on framework-enabled forms.
|
|
*p: cframeclass && Dialog class instantiated by CreateFrame().
|
|
*p: cframeclasslib && Class library for dialog class instantiated by CreateFrame(). If empty defaults to same class library as application object.
|
|
*p: cgomenufile && Name of menu to be used when a form entry in the meta table indicates that it should have a navigation menu.
|
|
*p: chelpfile && Name of help file for this application.
|
|
*p: cicon && Icon of the application object.
|
|
*p: cimage && Image to be used in logos, on the splash screen, etc.
|
|
*p: clastdirectory && Stores default directory when a readevents-type application starts up, for later restoration.
|
|
*p: clastmackey && Stores SET MACKEY when a readevents-type application starts up, for later restoration.
|
|
*p: clastonerror && Stores ON ERROR when a readevents-type application starts up, for later restoration.
|
|
*p: clastonshutdown && Stores ON SHUTDOWN when a readevents-type application starts up, for later restoration.
|
|
*p: clastpath && Stores SET("PATH") when a readevents-type application starts up, for later restoration.
|
|
*p: cmackey && Supplies the SET MACKEY for the application. Only used in ReadEvents apps.
|
|
*p: cmacropopupname && Name of popup handling macro sets. Required so the app object can refresh this popup between users, when the user stores a macro set, etc.
|
|
*p: cmacrosavefile && Stores the (generated) name of an FKY file created on startup of a ReadEvents app, for later restoration.
|
|
*p: cmediatedsessionclass && Name of class used to instance a framework-enabled datasession object, defaults to "_MediatedSession"
|
|
*p: cmediatedsessionclasslib && Classlib containing cMediatedSession class, defaults to "_FRAMEWK.VCX"
|
|
*p: cmediatorclass && Class used for dynamic form enabling at runtime (see lEnableFormsAtRuntime.) Should always contain a class descended from _formmediator in _FRAMEWK.VCX.
|
|
*p: cmediatorclasslib && Classlibrary used for dynamic form enabling at runtime (see lEnableFormsAtRuntime). Should always be the name of the library containing the class specified in _application.cMediatorClass.
|
|
*p: cmetatable && Stores the name of the application's metatable.
|
|
*p: cnavtoolbarclass && Toolbar class when a metatable entry calls for a navigation toolbar.
|
|
*p: cnavtoolbarclasslib && Class library for toolbar class when a metatable entry calls for a navigation toolbar. If empty defaults to same class library as application object.
|
|
*p: cnewopenclass && Dialog class instantiated by DoNewOpen().
|
|
*p: cnewopenclasslib && Class library for dialog class instantiated by DoNewOpen(). If empty defaults to same class library as application object.
|
|
*p: coptionsdialogclass && Dialog class instantiated by DoOptionsDialog().
|
|
*p: coptionsdialogclasslib && Class library for dialog class instantiated by DoOptionsDialog(). If empty defaults to same class library as application object.
|
|
*p: cprojectname && Name of a project that should be hidden on startup, for display at the end of the application. For convenience (so you don't inadvertently try to work on an app component while it's running, especially in non-ReadEvents or top form apps).
|
|
*p: creference && The var name that the app should declare as its PUBLIC reference and release when it ends.
|
|
*p: creportdialogclass && Dialog class instantiated by DoReportDialog().
|
|
*p: creportdialogclasslib && Class library for dialog class instantiated by DoReportDialog(). If empty defaults to same class library as application object.
|
|
*p: csessionclass && Default class definition name to pass to any _MediatedSession collaborator. If empty will be filled by member's cSessionClass property after successful instantiation.
|
|
*p: csessionclasslib && Default programmatic class definition filename to pass to any _MediatedSession collaborator. If empty will be filled by member's cSessionClassLib property after successful instantiation.
|
|
*p: cstartupformclass && Form (SCX) which is executed when the application object is shown.
|
|
*p: cstartupformclasslib && Class library for dialog class instantiated by DoStartupForm(). If empty defaults to same class library as application object.
|
|
*p: cstartupmenu && Menu (MPR) which is executed when the application object is shown.
|
|
*p: cstartupmenupad && For non-ReadEvents/Append style app menus, allows the application to remove this menu pad when the app ends.
|
|
*p: cstartupmenupopup && For non-ReadEvents/Append style app menus, allows the application to release this popup when the app ends.
|
|
*p: cstartuptoolbarclass && Standard toolbar instantiated by ShowStartupElements().
|
|
*p: cstartuptoolbarclasslib && Class library for standard toolbar instantiated by ShowStartupElements(). If empty defaults to same class library as application object.
|
|
*p: ctextdisplayfont && A sample "global user pref", allows users to store a font for display of text such as editboxes. To see it used, see the error log dialog.ApplyAppAttributes. The app gives this value to _outputdialog, applying it to the dialog's cDisplayFontName.
|
|
*p: ctrademark && "Credits" information.
|
|
*p: cuserloginclass && Dialog class instantiated by DoUserLogin().
|
|
*p: cuserloginclasslib && Class library for dialog class instantiated by DoUserLogin(). If empty defaults to same class library as application object.
|
|
*p: cusertablealias && Alias for user table.
|
|
*p: cusertableidfield && Name of c-type field storing user name.
|
|
*p: cusertablelevelfield && Name of i-type field storing user level.
|
|
*p: cusertablename && Name of user table.
|
|
*p: icurrentuserlevel && Current user's level.
|
|
*p: iinitialtoolbarposition && Indicates how a toolbar should be Docked() when instantiated.
|
|
*p: ilasterror && Stores error number of last number, or NULL when cleared.
|
|
*p: iqueryunloadresultfornonvisualsessions && Used by ReleaseSessions method -- if 0, reverts, if 1, updates, otherwise asks user for confirm just like forms. Defaults to 0.
|
|
*p: laboutbox && Indicates whether app should display an about box.
|
|
*p: laddingnewdocument && Application flag a form can check to see whether it should start a new document rather than edit an existing one.
|
|
*p: lcascadeforms && Specifies whether multiple forms of the same type are cascaded when a new form is instanced.
|
|
*p: lenableformsatruntime && Indicates whether DoForm() will dynamically adds base mediator objects to forms at runtime if they don't already have them.
|
|
*p: lfavorites && Specifies whether Favorites should be used/shown on a menu in this application.
|
|
*p: lfindonmultipletables && Specifies whether the ShowTableFindDialog will allow the user to switch to different tables in use in the data session.
|
|
*p: lgomenu && Specifies whether a navigation menu is currently required.
|
|
*p: lnavtoolbar && Specifies whether a navigation toolbar is currently required.
|
|
*p: lnointerrupt && Flag to alert application object that current activity, such as data-session-changing or modal dialogs, should not be interrupted by toolbar-refreshing or other timer-related activity.
|
|
*p: lnoscreenduringapp && Specifies whether screen should not be made visible during the app.
|
|
*p: lreadevents && Enable READ EVENTS within ReadEvents method.
|
|
*p: lreleaseunusedmenuitems && Indicates whether some menu items specific to application state should be released rather than disabled, when the MPR executes, if they are inappropriate. Used by framework's template menus.
|
|
*p: lrestoredenvironment
|
|
*p: lsavedenvironment
|
|
*p: lskiperrorhandling && Flag to allow an error number to be stored with no further error handling, for certain brief activities within the app.
|
|
*p: lstartupform && Specifies whether the app should begin with a "quick start" form.
|
|
*p: lstartuptoolbar && Specifies whether the app should invoke a toolbar at startup.
|
|
*p: lusercanchangepassword && Determines whether DoChangePassword() will allow the user to change his or her password. A placeholder -- you affect this behavior by using the attached access and assign methods however you decide, for example by user level.
|
|
*p: lusernameiscasesensitive && Determines how the user table is searched for a match when a user logs in.
|
|
*p: luserpreferences && Determines whether the user logon and options system is in place, or whether one set of options is set up for the full application.
|
|
*p: luse_getexpr && Determines whether the application -- or the current user -- should use _GETEXPR or the simpler _FilterDialog to enter expressions.
|
|
*p: nformcount && Forms collection count for application object.
|
|
*p: npixeloffset && Number of pixels which offset multiple instances of the same form. Not used in this version, but can provide a useful value for default "margins" for form and object placement.
|
|
*p: oframe && Reference to MDI frame window in top form applications.
|
|
*p: onavtoolbar && Reference to navigation toolbar shared by various forms as indicated in their metatable entries.
|
|
*a: acollaborators[1,0] && Collection of object references for members that cannot be contained by custom application object, such as forms
|
|
*a: acontextmenus[1,4] && Manages context menus invoked by the application object.
|
|
*a: acurrentuseropts[1,4] && Holds user preferences for use globally (by the app object and global SETs) or in a data session (by a form or formset object and data-session-specific SETs).
|
|
*a: aformnames[1,0] && Collection of strings (for SCXs, file names, for VCXs, file and class names), enabling the application object to uniquely identify form and formset classes currently instantiated and referenced in its aForms() collection.
|
|
*a: aforms[1,0]
|
|
*a: atoolbars[1,2] && Parallel to aForms[]
|
|
*</DefinedPropArrayMethod>
|
|
|
|
PROTECTED Destroy,Init,lrestoredenvironment,lsavedenvironment
|
|
*<PropValue>
|
|
BorderWidth = 0
|
|
caboutboxclass =
|
|
caboutboxclasslib =
|
|
cappfilename =
|
|
cappfolder =
|
|
cauthor =
|
|
ccaption =
|
|
cchangepasswordclass =
|
|
cchangepasswordclasslib =
|
|
cclasscontainerfilename = ("")
|
|
ccompany =
|
|
ccopyright =
|
|
ccurrentuser =
|
|
ccurrentuserfavoriteids = .NULL.
|
|
cdatafolder =
|
|
cerrorlogtablename = ("AppError")
|
|
cerrorviewerclass =
|
|
cerrorviewerclasslib =
|
|
cfavoritepopupname =
|
|
cformmediatorname = ("app_mediator")
|
|
cframeclass =
|
|
cframeclasslib =
|
|
cgomenufile = ("GO_APP")
|
|
chelpfile =
|
|
cicon =
|
|
cimage =
|
|
clastdirectory =
|
|
clastmackey =
|
|
clastonerror =
|
|
clastonshutdown =
|
|
clastpath =
|
|
cmackey = ("ALT-F10")
|
|
cmacropopupname =
|
|
cmacrosavefile =
|
|
cmediatedsessionclass = ("_MediatedSession")
|
|
cmediatedsessionclasslib = ("_FRAMEWK.VCX")
|
|
cmediatorclass = ("_FormMediator")
|
|
cmediatorclasslib = ("_FRAMEWK.VCX")
|
|
cmetatable =
|
|
cnavtoolbarclass =
|
|
cnavtoolbarclasslib =
|
|
cnewopenclass =
|
|
cnewopenclasslib =
|
|
coptionsdialogclass =
|
|
coptionsdialogclasslib =
|
|
cprojectname =
|
|
creference =
|
|
creportdialogclass =
|
|
creportdialogclasslib =
|
|
csessionclass =
|
|
csessionclasslib =
|
|
cstartupformclass =
|
|
cstartupformclasslib =
|
|
cstartupmenu =
|
|
cstartupmenupad =
|
|
cstartupmenupopup =
|
|
cstartuptoolbarclass =
|
|
cstartuptoolbarclasslib =
|
|
ctextdisplayfont = ("Courier New")
|
|
ctrademark =
|
|
cuserloginclass =
|
|
cuserloginclasslib =
|
|
cusertablealias =
|
|
cusertableidfield = ("UserName")
|
|
cusertablelevelfield = ("UserLevel")
|
|
cusertablename = ("AppUser")
|
|
cversion =
|
|
Height = 28
|
|
icurrentuserlevel = 0
|
|
iinitialtoolbarposition = 0
|
|
ilasterror = .NULL.
|
|
iqueryunloadresultfornonvisualsessions = 0
|
|
laboutbox = .T.
|
|
lenableformsatruntime = .T.
|
|
lfavorites = .T.
|
|
lreadevents = .T.
|
|
lstartupform = .T.
|
|
lstartuptoolbar = .T.
|
|
lusercanchangepassword = .T.
|
|
Name = "_application"
|
|
nformcount = 0
|
|
npixeloffset = 22
|
|
oframe = .NULL.
|
|
onavtoolbar = .NULL.
|
|
Visible = .F.
|
|
Width = 154
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'cusDataSession' AS _datasession WITH ;
|
|
Height = 19, ;
|
|
Left = 25, ;
|
|
Name = "cusDataSession", ;
|
|
Top = 0, ;
|
|
Width = 23
|
|
*< END OBJECT: ClassLib="..\ffc\_app.vcx" BaseClass="custom" />
|
|
|
|
ADD OBJECT 'cusError' AS _error WITH ;
|
|
Height = 19, ;
|
|
Left = 0, ;
|
|
Name = "cusError", ;
|
|
Top = 0, ;
|
|
Width = 23
|
|
*< END OBJECT: ClassLib="..\ffc\_app.vcx" BaseClass="custom" />
|
|
|
|
ADD OBJECT 'cusTableNav' AS _tablenav WITH ;
|
|
Height = 19, ;
|
|
Left = 96, ;
|
|
Name = "cusTableNav", ;
|
|
Top = 0, ;
|
|
Width = 23
|
|
*< END OBJECT: ClassLib="..\ffc\_table.vcx" BaseClass="custom" />
|
|
|
|
ADD OBJECT 'cusTableSort' AS _tablesort WITH ;
|
|
Height = 19, ;
|
|
Left = 72, ;
|
|
Name = "cusTableSort", ;
|
|
Top = 0, ;
|
|
Width = 23
|
|
*< END OBJECT: ClassLib="..\ffc\_table.vcx" BaseClass="custom" />
|
|
|
|
ADD OBJECT 'cusWindowHandler' AS _windowhandler WITH ;
|
|
Height = 19, ;
|
|
Left = 48, ;
|
|
Name = "cusWindowHandler", ;
|
|
Top = 0, ;
|
|
Width = 23
|
|
*< END OBJECT: ClassLib="..\ffc\_ui.vcx" BaseClass="custom" />
|
|
|
|
ADD OBJECT 'tmrRefresh' AS _traceawaretimer WITH ;
|
|
Interval = 500, ;
|
|
Left = 120, ;
|
|
Name = "tmrRefresh", ;
|
|
Top = 0
|
|
*< END OBJECT: ClassLib="..\ffc\_app.vcx" BaseClass="timer" />
|
|
|
|
PROCEDURE activate && Makes the application active
|
|
THIS.ClearLastError()
|
|
THIS.BeforeReadEvents()
|
|
THIS.ReadEvents()
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE activateforminframe && Takes a form or toolbar reference and fixes it to appear in top form "frame" even if its ShowWindow property was 0
|
|
LPARAMETERS toFormRef
|
|
|
|
LOCAL lcFormID, llToolbar
|
|
|
|
IF UPPER(toFormRef.BaseClass) == "TOOLBAR"
|
|
llToolbar = .T.
|
|
ENDIF
|
|
|
|
|
|
IF VARTYPE(THIS.oFrame) = "O" AND ;
|
|
toFormRef.ShowWindow = 0
|
|
|
|
IF llToolBar
|
|
lcFormID = toFormRef.Caption
|
|
toFormRef.Caption = "."
|
|
ELSE
|
|
lcFormID = toFormRef.Name
|
|
toFormRef.Name = "W"+SYS(2015)
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
IF EMPTY(lcFormID)
|
|
|
|
* ShowWindow is appropriate, no problem
|
|
|
|
IF (NOT llToolBar) AND ;
|
|
(toFormRef.WindowType = WINDOWTYPE_MODAL)
|
|
toFormRef.Show(1)
|
|
ELSE
|
|
toFormRef.Show()
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
* fix the problem:
|
|
|
|
IF llToolbar
|
|
|
|
ACTIVATE WINDOW (toFormRef.Caption) ;
|
|
IN WINDOW (THIS.oFrame.Name)
|
|
toFormRef.Caption = lcFormID
|
|
|
|
ELSE
|
|
|
|
ACTIVATE WINDOW (toFormRef.Name) ;
|
|
IN WINDOW (THIS.oFrame.Name)
|
|
toFormRef.Name = lcFormID
|
|
|
|
IF toFormRef.WindowType = WINDOWTYPE_MODAL
|
|
toFormRef.Show(1)
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE activatesystemwindow && Activates a system window whose name has been passed, in _SCREEN, even if _SCREEN wasn't previously visible (for debugging, does nothing in runtime)
|
|
LPARAMETERs tcWindow
|
|
|
|
IF EMPTY(tcWindow) OR _VFP.StartMode > 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
LOCAL llAutoCenter
|
|
|
|
llAutoCenter = _Screen.AutoCenter
|
|
_SCREEN.AutoCenter = .T.
|
|
_SCREEN.AutoCenter = llAutoCenter
|
|
|
|
IF ! _SCREEN.Visible
|
|
_SCREEN.Show()
|
|
ENDIF
|
|
|
|
IF WMIN("")
|
|
ZOOM WINDOW SCREEN NORM
|
|
ENDIF
|
|
|
|
ACTIVATE WINDOW (tcWindow) IN SCREEN
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE addcollaborator && Instantiate objects that can't be part of application container and add a reference to collaborators collection for maintenance. See SetScreenAttributes() for examples.
|
|
LPARAMETERS tcClass, tcClassLib,tcClassContainer, tcParamString, toParent, tcMemberName
|
|
* should match Instantiate
|
|
* Instantiate params:
|
|
* LPARAMETERS tcClass, tcClassLib, tcClassContainer, tcParamString, toParent, tcMemberName
|
|
* wrap Instantiate and puts the reference in the aCollaborators collection
|
|
* so it can be properly managed
|
|
|
|
* it's not really necessary to look out for usable empty array elements
|
|
* in the middle of the array here -- objects may be released
|
|
* during the life of the application, but the empty array elements will
|
|
* not do any harm, so we
|
|
* just re-DIME as necessary if the last element is in use...
|
|
LOCAL liElement, lcClassLib
|
|
|
|
liElement = ALEN(THIS.aCollaborators)
|
|
|
|
IF VARTYPE(THIS.aCollaborators[liElement]) = "O"
|
|
liElement = liElement + 1
|
|
DIME THIS.aCollaborators[liElement]
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(tcClassLib)
|
|
lcClassLib = tcClassLib
|
|
* want to avoid passing a null string
|
|
ENDIF
|
|
|
|
THIS.aCollaborators[liElement] = ;
|
|
THIS.Instantiate(tcClass, lcClassLib,tcClassContainer,tcParamString, toParent, tcMemberName)
|
|
|
|
* Instantiate() will know to do a NEWOBJECT() or <parent>.NewObject() as required
|
|
|
|
RETURN THIS.aCollaborators[liElement]
|
|
ENDPROC
|
|
|
|
PROCEDURE addmediatedsession && Creates a data session with a mediator object attached, referenced in the aCollaborators collection, returns a reference to this framework-enabled session.
|
|
* Creates a data session with a mediator object attached,
|
|
* referenced in the aCollaborators collection,
|
|
* returns a reference to this framework-enabled session.
|
|
LOCAL loSession, lcPass
|
|
|
|
THIS.cSessionClassLib = THIS.GetResourceFileName(THIS.cSessionClassLib,".fxp .prg")
|
|
|
|
IF EMPTY(THIS.cSessionClass) OR EMPTY(THIS.cSessionClassLib)
|
|
lcPass = ".T."
|
|
ELSE
|
|
lcPass = ".T.,["+THIS.cSessionClass+"],["+THIS.cSessionClassLib+"]"
|
|
ENDIF
|
|
|
|
loSession = THIS.AddCollaborator(THIS.cMediatedSessionClass, THIS.cMediatedSessionClassLib,,lcPass)
|
|
|
|
IF NOT ISNULL(loSession)
|
|
loSession.LoadApp(THIS.cReference)
|
|
|
|
* save class def information, which
|
|
* may in some instances be generated,
|
|
* for other members, so it doesn't need to be
|
|
* re-generated each time
|
|
|
|
IF EMPTY(THIS.cSessionClass) AND NOT EMPTY(loSession.cSessionClass)
|
|
THIS.cSessionClass = loSession.cSessionClass
|
|
ENDIF
|
|
|
|
IF EMPTY(THIS.cSessionClassLib) AND NOT EMPTY(loSession.cSessionClassLib)
|
|
THIS.cSessionClassLib = loSession.cSessionClassLib
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
RETURN loSession
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE applyglobaluseroptions && Applies global (non-datasession-specific) options to the _application object and environment. Where user login and preferences are not used, applies a single set at startup -- with user login and preferences, applies to each user login.
|
|
LOCAL liRow, lcItem, lvValue, liPos
|
|
|
|
FOR liRow = 1 TO ALEN(THIS.aCurrentUserOpts,1)
|
|
|
|
IF NOT THIS.aCurrentUserOpts[liRow,4] && datasession preference, not global
|
|
LOOP
|
|
ENDIF
|
|
|
|
lcItem = THIS.aCurrentUserOpts[liRow,1]
|
|
lvValue = THIS.aCurrentUserOpts[liRow,2]
|
|
IF VARTYPE(lcItem) # "C"
|
|
LOOP
|
|
ENDIF
|
|
IF NOT THIS.aCurrentUserOpts[liRow,3] && property of app or app member
|
|
liPos = AT(".",lcItem)
|
|
IF (liPos = 0 AND PEMSTATUS(THIS,lcItem,5)) OR ;
|
|
(liPos > 1 AND PEMSTATUS(EVAL("THIS."+SUBSTR(lcItem,1,liPos-1)),SUBSTR(lcItem,liPos+1),5))
|
|
THIS.&lcItem. = lvValue
|
|
ENDIF
|
|
ELSE && SET value
|
|
IF VARTYPE(lvValue) # "C"
|
|
LOOP
|
|
ENDIF
|
|
SET &lcItem &lvValue
|
|
ENDIF
|
|
|
|
ENDFOR
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE applyuseroptsforsession && Applies datasession-specific options a form object and its session environment.
|
|
LPARAMETERS toSession
|
|
IF VARTYPE(toSession) # "O"
|
|
RETURN
|
|
ENDIF
|
|
LOCAL liSession, liRow, lcItem, lvValue, liPos, llInterrupted
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
liSession = SET("DATASESSION")
|
|
SET DATASESSION TO (toSession.DataSessionID)
|
|
|
|
FOR liRow = 1 TO ALEN(THIS.aCurrentUserOpts,1)
|
|
|
|
IF THIS.aCurrentUserOpts[liRow,4] && global preference, not private to session
|
|
LOOP
|
|
ENDIF
|
|
|
|
lcItem = THIS.aCurrentUserOpts[liRow,1]
|
|
lvValue = THIS.aCurrentUserOpts[liRow,2]
|
|
IF VARTYPE(lcItem) # "C"
|
|
LOOP
|
|
ENDIF
|
|
IF NOT THIS.aCurrentUserOpts[liRow,3] && property of form or form member
|
|
|
|
liPos = AT(".",lcItem)
|
|
IF (liPos = 0 AND PEMSTATUS(toSession,lcItem,5)) OR ;
|
|
(liPos > 1 AND PEMSTATUS(EVAL("toSession."+SUBSTR(lcItem,1,liPos-1)),SUBSTR(lcItem,liPos+1),5))
|
|
toSession.&lcItem. = lvValue
|
|
ENDIF
|
|
ELSE && SET value
|
|
IF VARTYPE(lvValue) # "C"
|
|
LOOP
|
|
ENDIF
|
|
SET &lcItem &lvValue
|
|
ENDIF
|
|
|
|
ENDFOR
|
|
SET DATASESSION TO (liSession)
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE beforedoform && Hook in DoForm method, allowing last-minute manipulation of environment before the form class or object is instantiated.
|
|
LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlNoShow, tlGoMenu, tlNavToolbar
|
|
* abstract hook from DoForm
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE beforereadevents && Method executed before READ EVENTS is executed when ReadEvents is called.
|
|
ENDPROC
|
|
|
|
PROCEDURE caboutboxclass_access && Synchronizes classname value with lAboutBox value
|
|
IF NOT THIS.lAboutBox
|
|
|
|
RETURN ""
|
|
|
|
ELSE
|
|
|
|
RETURN THIS.cAboutBoxClass
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cappfolder_access && Determines the application folder, usually the folder containing the running APP or EXE. However where a temporary wrapper program or ON... command has been used to instantiate the application, this value may be the location of the VCX
|
|
* note: this is an access method because
|
|
* conceivably directories could get renamed
|
|
* while an app is running!
|
|
IF EMPTY(THIS.cAppFolder) OR (NOT DIRECTORY(THIS.cAppFolder))
|
|
|
|
LOCAL lcAppFolder
|
|
|
|
IF (NOT EMPTY(THIS.cClassContainerFileName))
|
|
lcAppFolder = ;
|
|
LEFT(THIS.cClassContainerFileName,RAT("\",THIS.cClassContainerFileName))
|
|
ENDIF
|
|
|
|
* The cClassContainerFileName could be empty... it's possible
|
|
* that this CREATEOBJECT was not done in an APP or EXE...
|
|
* (see comments in SetAppFileNames() for how these properties are
|
|
* used and what they represent)
|
|
|
|
IF ( EMPTY(lcAppFolder) OR (NOT DIRECTORY(lcAppFolder)) ) ;
|
|
AND ;
|
|
(NOT EMPTY(THIS.cAppFileName))
|
|
|
|
lcAppFolder = LEFT(THIS.cAppFileName,RAT("\",THIS.cAppFileName))
|
|
* this will be a wrapper program -- may or may not
|
|
* be the same for every user or every login,
|
|
* especially if temp programs are involved,
|
|
* so it is not as good as cClassContainerFileName
|
|
ENDIF
|
|
|
|
* finally, both the properties may be empty, especially if
|
|
* an ON... was involved in the initial call,
|
|
* We still need an appfolder **on disk** to give us
|
|
* a default location for some system files
|
|
|
|
IF ( EMPTY(lcAppFolder) OR (NOT DIRECTORY(lcAppFolder)) )
|
|
lcAppFolder = SET("DIRECTORY")
|
|
ENDIF
|
|
|
|
THIS.cAppFolder = lcAppFolder
|
|
|
|
ENDIF
|
|
|
|
IF RIGHT(THIS.cAppFolder,1) # "\" && for example, SET("DIRE") doesn't provide a final backslash!
|
|
THIS.cAppFolder = THIS.cAppFolder + "\"
|
|
ENDIF
|
|
|
|
RETURN THIS.cAppFolder
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cascadeall && Wraps cusWindowHandler's CascadeFormInstances() method, passing no argument.
|
|
LPARAMETERS tcForm
|
|
|
|
THIS.cusWindowHandler.CascadeFormInstances(tcForm)
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cascadeform && For backwards compatibility, not used
|
|
LPARAMETERS tcFormName
|
|
LOCAL lcFormName
|
|
DO CASE
|
|
CASE (NOT EMPTY(tcFormName)) AND WEXIST(tcFormName)
|
|
lcFormName = tcFormName
|
|
CASE TYPE("_SCREEN.ActiveForm")= "O"
|
|
lcFormName = _SCREEN.ActiveForm.Name
|
|
OTHERWISE
|
|
RETURN .F.
|
|
ENDCASE
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ccaption_access
|
|
IF VARTYPE(THIS.cCaption) # "C"
|
|
RETURN ""
|
|
ELSE
|
|
RETURN THIS.cCaption
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ccaption_assign
|
|
LPARAMETERS tvNewVal
|
|
IF VARTYPE(tvNewVal) # "C"
|
|
THIS.cCaption = ""
|
|
ELSE
|
|
THIS.cCaption = tvNewVal
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cdatafolder_assign
|
|
LPARAMETERS tcDataFolder
|
|
|
|
LOCAL lcDataFolder
|
|
|
|
lcDataFolder = IIF(VARTYPE(tcDataFolder) = "C" AND ;
|
|
DIRECTORY(tcDataFolder), ;
|
|
tcDataFolder,"")
|
|
|
|
THIS.cDataFolder = lcDataFolder
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cerrorlogtablename_access && adds cAppFolder information to the error log table name, so the default error DBF is always in one place.
|
|
LOCAL lcTable
|
|
lcTable = THIS.cErrorLogTableName
|
|
IF AT("\",lcTable) = 0
|
|
lcTable = THIS.cAppFolder+lcTable
|
|
ENDIF
|
|
IF AT(".",lcTable) = 0
|
|
lcTable = lcTable+".DBF"
|
|
ENDIF
|
|
RETURN lcTable
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE checkpassword && Sends a passed value and a stored value from the current user information to CheckValueAgainstStoredPassword for verification.
|
|
LPARAMETERS tcValueToCheck
|
|
|
|
ASSERT VARTYPE(tcValueToCheck) = "C" AND USED(THIS.cUserTableAlias)
|
|
|
|
LOCAL lcValueToCheck, lcStoredPassword, llSuccess
|
|
|
|
IF (NOT THIS.lUserPreferences) OR ;
|
|
VARTYPE(tcValueToCheck) # "C"
|
|
|
|
RETURN .F.
|
|
|
|
ENDIF
|
|
|
|
lcValueToCheck = ALLTRIM(tcValueToCheck)
|
|
lcStoredPassword = EVAL("ALLTRIM("+THIS.cUserTableAlias+".UserPass)")
|
|
llSuccess = THIS.CheckValueAgainstStoredPassword(lcValueToCheck, lcStoredPassword)
|
|
|
|
RETURN llSuccess
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE checkvalueagainststoredpassword && Compares a current password entry against an encrypted stored entry. Separated from CheckPassword so its simple algorithm can be replaced as necessary. Algorithms in CreateStoredPassword and CheckValueAgainstStoredPassword should match.
|
|
LPARAMETERS tcValueToCheck, tcStoredValue
|
|
IF VARTYPE(tcValueToCheck) # "C"
|
|
RETURN .F.
|
|
ENDIF
|
|
* see notes in _application.CreateStoredPassword()...
|
|
* this method is separated out to make the method
|
|
* of encryption more easily edited...
|
|
|
|
RETURN (tcStoredValue == SYS(2007,tcValueToCheck))
|
|
ENDPROC
|
|
|
|
PROCEDURE cicon_assign
|
|
LPARAMETERS m.vNewVal
|
|
IF NOT EMPTY(m.vNewVal)
|
|
THIS.cIcon = THIS.GetResourceFileName(m.vNewVal,".ico")
|
|
ELSE
|
|
THIS.cIcon = ""
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cimage_assign && Verifies the availability of an image file for use as the application logo
|
|
LPARAMETERS m.vNewVal
|
|
*To do: Modify this routine for the Assign method
|
|
IF NOT EMPTY(m.vNewVal)
|
|
THIS.cimage = THIS.GetResourceFileName(m.vNewVal,".bmp .ico .gif")
|
|
ELSE
|
|
THIS.cImage = ""
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE clearevents && Clears any pending read events.
|
|
THIS.ClearLastError()
|
|
IF THIS.lReadEvents
|
|
CLEAR EVENTS
|
|
ENDIF
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE clearfavorites && Called by Favorites menu item, to confirm "zap" of user favorites and invoke SetCurrentUserFavoriteIDs mechanism.
|
|
* this is meant for interactive confirmation/menu use
|
|
IF (MESSAGEBOX(APP_USER_FAVES_CLEAR_LOC, ;
|
|
MB_ICONQUESTION + MB_YESNO, ;
|
|
THIS.cCaption)) ;
|
|
= IDYES
|
|
THIS.SetCurrentUserFavoriteIDs("")
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE clearlasterror && Sets _application.iLastError to NULL, called before operations which may require an error to be tested on conclusion. Abstracted for easy overriding in subclasses.
|
|
THIS.iLastError = .NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE createcollaborators && A startup hook to allow you to call the AddCollaborators() method during initialization procedures
|
|
*&* The collaborators mechanism allows for things that can't be
|
|
*&* a member of the app container to disappear on cue,
|
|
*&* like a background image on screen.
|
|
*&* This abstract method gives you a hook to create collaborators
|
|
*&* at startup (during the .Show() method), using AddCollaborator(),
|
|
*&* but you can scope objects to the application
|
|
*&* at any time during the life of the app.
|
|
*&* AddCollaborator()'s params match Instantiate()'s.
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE createformmediator && Adds a app mediator object to a form
|
|
LPARAMETERS toForm
|
|
|
|
IF VARTYPE(toForm) # "O" OR ;
|
|
NOT (UPPER(toForm.BaseClass) == "FORM")
|
|
RETURN NULL
|
|
ENDIF
|
|
|
|
LOCAL lcMediatorName, loMediator
|
|
|
|
IF TYPE("toForm."+THIS.cFormMediatorName+".Name") # "C"
|
|
lcMediatorName = THIS.cFormMediatorName
|
|
ELSE
|
|
lcMediatorName = "Mediator_"+SYS(2015)
|
|
* a mediator with a generated name
|
|
* is less useful and will cause slower
|
|
* behavior but it will do in a pinch
|
|
ENDIF
|
|
|
|
THIS.ClearLastError()
|
|
|
|
loMediator = THIS.Instantiate(THIS.cMediatorClass,THIS.cMediatorClassLib,,,;
|
|
toForm,lcMediatorName)
|
|
|
|
IF (NOT THIS.IsErrorFree()) OR (NOT THIS.FormIsFrameworkEnabled(toForm))
|
|
THIS.ClearLastError()
|
|
* required default classes
|
|
THIS.cMediatorClass = "_FormMediator"
|
|
THIS.cMediatorClassLib = "_FRAMEWK.VCX"
|
|
loMediator = THIS.Instantiate(THIS.cMediatorClass,THIS.cMediatorClassLib,,,;
|
|
toForm,lcMediatorName)
|
|
ENDIF
|
|
|
|
IF THIS.IsErrorFree()
|
|
loMediator.cAppRef = THIS.cReference
|
|
RETURN loMediator
|
|
ELSE
|
|
RETURN NULL
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE createframe && Creates the MDI frame for top form applications.
|
|
LOCAL lcClassLib
|
|
|
|
THIS.ClearLastError()
|
|
|
|
IF NOT EMPTY(THIS.cFrameClassLib)
|
|
lcClassLib = THIS.cFrameClassLib
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(THIS.cFrameClass)
|
|
THIS.oFrame = THIS.Instantiate(THIS.cFrameClass,lcClassLib)
|
|
IF VARTYPE(THIS.oFrame) = "O"
|
|
THIS.oFrame.oApp = THIS
|
|
ENDIF
|
|
ELSE
|
|
THIS.oFrame = .NULL.
|
|
ENDIF
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
ENDPROC
|
|
|
|
PROCEDURE createstoredpassword && Creates an encrypted value of a password. Separated from StorePassword() for easy replacement of its simple algorithm. Algorithms in CreateStoredPassword and CheckValueAgainstStoredPassword should match.
|
|
* separated out for easier editing,
|
|
* created for Q&D checksum method of storing information,
|
|
* but this is not really encryption...
|
|
|
|
LPARAMETERS tcValueToStore
|
|
ASSERT VARTYPE(tcValueToStore) = "C"
|
|
|
|
RETURN SYS(2007,ALLTRIM(tcValueToStore))
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE createusertable && Creates and indexs user table when it does not exist. Abstracted for easy editing. The app expects this table to have 1 c-type field, with its name in the cUserTableIDField property, and 1 i-type field, its name in cUserTableLevelField.
|
|
LPARAMETERS tcTable
|
|
* is passed exact table name and location
|
|
|
|
* is separated out so that you can
|
|
* use different table structures more easily
|
|
|
|
* The application object expects that whatever table
|
|
* you use, you will have created one c-type field and placed
|
|
* its name in THIS.cUserTableIDField, and one i-type field and
|
|
* placed its name in THIS.cUserTableLevelField.
|
|
|
|
|
|
THIS.ClearLastError()
|
|
LOCAL liSelect, lcIDField, lcLevelField
|
|
lcIDField = THIS.cUserTableIDField
|
|
lcLevelField = THIS.cUserTableLevelField
|
|
liSelect = SELECT()
|
|
SELECT 0
|
|
CREATE TABLE (tcTable) ;
|
|
((lcIDField) C(60), ;
|
|
(lcLevelField) I, ;
|
|
UserPass M NOCPTRANS, ;
|
|
UserOpts M NOCPTRANS, ;
|
|
UserFave M NOCPTRANS, ;
|
|
UserMacro M NOCPTRANS, ;
|
|
UserNotes M )
|
|
INDEX ON PADR(ALLTR(&lcIDField.),60) TAG ID
|
|
* create a case-sensitive, exact word match
|
|
INDEX ON PADR(UPPER(ALLTR(&lcIDField.)),60) TAG ID_Upper
|
|
* create a case-insensitive, exact word match
|
|
INDEX ON DELETED() TAG IfDeleted
|
|
USE
|
|
SELECT (liSelect)
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE creference_assign
|
|
LPARAMETERS tcReference
|
|
|
|
IF VARTYPE(tcReference) = "C"
|
|
|
|
IF (TYPE(THIS.cReference+".Name") = "C" AND ;
|
|
EVAL(THIS.cReference) = THIS)
|
|
RELEASE (THIS.cReference)
|
|
ENDIF
|
|
|
|
THIS.cReference = tcReference
|
|
|
|
ENDIF
|
|
|
|
IF (NOT EMPTY(THIS.cReference)) AND ;
|
|
(TYPE(THIS.cReference+".Name") # "C" OR ;
|
|
EVAL(THIS.cReference) # THIS)
|
|
|
|
RELEASE (THIS.cReference)
|
|
PUBLIC (THIS.cReference)
|
|
STORE THIS TO (THIS.cReference)
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cstartupformclass_access && Synchronizes classname value with lStartupForm value
|
|
RETURN THIS.cStartupFormClass
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cstartuptoolbarclass_access && Synchronizes classname value with lStartupToolbar value
|
|
IF NOT THIS.lStartupToolbar
|
|
|
|
RETURN ""
|
|
|
|
ELSE
|
|
|
|
RETURN THIS.cStartupToolbarClass
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ctextdisplayfont_assign
|
|
LPARAMETERS tcNewVal
|
|
IF VARTYPE(tcNewVal) # "C" OR EMPTY(tcNewVal)
|
|
RETURN
|
|
ENDIF
|
|
|
|
LOCAL laTemp[1], lcVal, lcFont
|
|
lcVal = ALLTR(tcNewVal)
|
|
|
|
IF NOT EMPTY(AFONT(laTemp))
|
|
|
|
FOR EACH lcFont IN laTemp
|
|
IF UPPER(lcVal) == UPPER(lcFont)
|
|
THIS.cTextDisplayFont = lcVal
|
|
EXIT
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cusertablealias_assign
|
|
LPARAMETERS tcNewVal
|
|
IF VARTYPE(tcNewVal) # "C" OR ;
|
|
(USED(tcNewVal) AND ;
|
|
(NOT DBF(tcNewVal) == THIS.cUserTableName) )
|
|
THIS.cUserTableAlias = "U"+SYS(2015)
|
|
ELSE
|
|
THIS.cUserTableAlias = tcNewVal
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cusertablename_access
|
|
LOCAL lcTable
|
|
lcTable = UPPER(THIS.cUserTableName)
|
|
IF AT("\",lcTable) = 0
|
|
lcTable = THIS.cAppFolder+lcTable
|
|
ENDIF
|
|
IF AT(".",lcTable) = 0
|
|
lcTable = lcTable+".DBF"
|
|
ENDIF
|
|
IF EMPTY(SYS(2000,lcTable)) OR ;
|
|
EMPTY(SYS(2000,STRTRAN(lcTable,".DBF",".FPT")))
|
|
THIS.CreateUserTable(lcTable)
|
|
ENDIF
|
|
|
|
RETURN lcTable
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE datarevert && Wraps cusDataSession's Revert() method.
|
|
LPARAMETERS tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow
|
|
|
|
LOCAL llInterrupted, llReturn
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
llReturn = THIS.cusDataSession.Revert(tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow)
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE dataupdate && Wraps cusDataSession's Update() method.
|
|
LPARAMETERS tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow
|
|
|
|
LOCAL llReturn, llInterrupted
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
llReturn = THIS.cusDataSession.Update(tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow)
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE Destroy
|
|
DODEFAULT()
|
|
|
|
THIS.lNoInterrupt = .T.
|
|
* one last disable the timer so we can avoid it
|
|
* interfering while we're closing up shop.
|
|
|
|
IF EMPTY(THIS.cFrameClass) AND (NOT EMPTY(THIS.cGoMenuFile))
|
|
RELEASE PAD _msm_Go OF _MSYSMENU
|
|
RELEASE POPUP _mGo EXTENDED
|
|
ENDIF
|
|
|
|
* some of this is double-handling but
|
|
* will not hurt -- it's possible
|
|
* that a CLEAR ALL or other mechanism
|
|
* has ended the app without a Release()
|
|
* method having been issued -- such
|
|
* as a failed Show method:
|
|
THIS.ReleaseContextMenus(.T.)
|
|
THIS.ReleaseSessions(.T.)
|
|
THIS.ReleaseForms(.T.)
|
|
THIS.ReleaseToolbars(.T.)
|
|
THIS.ReleaseCollaborators()
|
|
THIS.ReleaseFrame()
|
|
THIS.ClearEvents()
|
|
|
|
IF USED(THIS.cUserTableAlias)
|
|
USE IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
IF NOT THIS.lRestoredEnvironment
|
|
* must restore environment
|
|
* at all times, because
|
|
* failure may have occurred
|
|
* during Show, but
|
|
* have to make sure *not*
|
|
* to restore environment
|
|
* if it's already been done
|
|
* because there are things
|
|
* in here than cannot or
|
|
* should not be done twice:
|
|
THIS.RestoreEnvironment()
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(THIS.cReference)
|
|
RELEASE (THIS.cReference)
|
|
ENDIF
|
|
|
|
THIS.HandleProjectWindow(.T.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE displayerrorlog && Instantiates cErrorViewerClass dialog
|
|
LOCAL loTemp, liIndex, llOK
|
|
|
|
IF NOT EMPTY(THIS.cErrorViewerClass)
|
|
|
|
|
|
loTemp = THIS.AddCollaborator(THIS.cErrorViewerClass,;
|
|
THIS.cErrorViewerClassLib)
|
|
|
|
IF VARTYPE(loTemp) = "O"
|
|
|
|
llOK = loTemp.ApplyAppAttributes(THIS)
|
|
|
|
IF llOK
|
|
* maybe no error records, or even no table
|
|
|
|
THIS.ActivateFormInFrame(loTemp) && modeless
|
|
|
|
ELSE
|
|
|
|
loTemp.Release()
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
|
|
RETURN llOK
|
|
|
|
ELSE
|
|
THIS.cusError.DisplayErrorLog()
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE doaboutbox && Invokes cAboutBoxClass dialog class
|
|
LOCAL llReturn
|
|
llReturn = THIS.DoModalDialogClass(THIS.cAboutBoxClass, THIS.cAboutBoxClassLib)
|
|
RETURN llReturn
|
|
ENDPROC
|
|
|
|
PROCEDURE dochangepassword && Invokes cChangePasswordClass dialog class
|
|
IF (NOT THIS.lUserPreferences)
|
|
* shouldn't even be in here
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF NOT THIS.lUserCanChangePassword
|
|
* this item may be on the menu
|
|
* but not applicable to this user,
|
|
* for various reasons
|
|
MESSAGEBOX(USER_PERMISSION_DENIED_LOC,MB_ICONEXCLAMATION,THIS.cCaption)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
LOCAL llOpenedTable, llReturn
|
|
|
|
IF NOT USED(THIS.cUserTableAlias)
|
|
USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias)
|
|
llOpenedTable = .T.
|
|
ENDIF
|
|
|
|
THIS.SeekCurrentUser()
|
|
|
|
llReturn = THIS.DoModalDialogClass(THIS.cChangePasswordClass, THIS.cChangePasswordClassLib)
|
|
|
|
IF llOpenedTable
|
|
USE IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE docontextmenu && Manages context menus and context menu collection
|
|
LPARAMETERS tcMenuFileName, tcPadName, tcPopupName
|
|
|
|
LOCAL lcMenuFileName, ;
|
|
liElement, liIndex, liMenus, lcMenu
|
|
|
|
IF EMPTY(tcMenuFileName) OR EMPTY(tcPadName) OR EMPTY(tcPopupName)
|
|
RETURN 0
|
|
ENDIF
|
|
|
|
ASSERT VARTYPE(tcPadName) = "C"
|
|
ASSERT VARTYPE(tcPopupName) = "C"
|
|
ASSERT VARTYPE(tcMenuFileName) = "C"
|
|
|
|
|
|
lcMenuFileName = THIS.GetResourceFileName(tcMenuFileName,".mpx .mpr")
|
|
IF EMPTY(lcMenuFileName)
|
|
RETURN 0
|
|
ENDIF
|
|
|
|
liElement = 0
|
|
liMenus = ALEN(THIS.aContextMenus,1)
|
|
FOR liIndex = 1 TO liMenus
|
|
lcMenu = THIS.aContextMenus[liIndex,1]
|
|
IF VARTYPE(lcMenu) # "C" OR ;
|
|
VARTYPE(THIS.aContextMenus[liIndex,2]) # "N" ;
|
|
OR THIS.aContextMenus[liIndex,2] = 0
|
|
|
|
liElement = liIndex
|
|
LOOP
|
|
ENDIF
|
|
* is this menu already up?
|
|
IF lcMenu == lcMenuFileName
|
|
* increment its counter
|
|
THIS.aContextMenus[liIndex,2] = THIS.aContextMenus[liIndex,2]+1
|
|
RETURN liIndex
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
IF liElement = 0
|
|
IF VARTYPE(THIS.aContextMenus[1,1]) = "C"
|
|
liElement = liMenus+1
|
|
ELSE
|
|
liElement = 1
|
|
ENDIF
|
|
DIMENSION THIS.aContextMenus[liElement,4]
|
|
ENDIF
|
|
|
|
THIS.aContextMenus[liElement,1]=lcMenuFileName
|
|
THIS.aContextMenus[liElement,2] = 1
|
|
THIS.aContextMenus[liElement,3] = ALLTRIM(tcPadName)
|
|
THIS.aContextMenus[liElement,4] = ALLTRIM(tcPopupName)
|
|
|
|
THIS.DoMenu(lcMenuFileName) && we don't want unique popup names for a context menu
|
|
|
|
RETURN liElement
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE dodocumentpickerdialog && Invokes all the dialogs descending from the _documentpicker dialog superclass
|
|
LPARAMETERS tcClass,tcClassLib,tlAlternateMode
|
|
|
|
IF EMPTY(tcClass)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
LOCAL loTemp, lcClassLib
|
|
|
|
IF NOT EMPTY(tcClassLib)
|
|
lcClassLib = tcClassLib
|
|
ENDIF
|
|
|
|
IF VARTYPE(THIS.oFrame) = "O"
|
|
THIS.oFrame.Show()
|
|
ENDIF
|
|
|
|
loTemp = THIS.Instantiate(tcClass,;
|
|
lcClassLib, ,;
|
|
"THIS,"+IIF(tlAlternateMode,".T.",".F."))
|
|
|
|
IF VARTYPE(loTemp) = "O"
|
|
|
|
IF PEMSTATUS(loTemp,"ApplyAppAttributes",5)
|
|
loTemp.ApplyAppAttributes(THIS)
|
|
ELSE
|
|
IF EMPTY(loTemp.Icon)
|
|
loTemp.Icon = THIS.cIcon
|
|
ENDIF
|
|
ENDIF
|
|
|
|
loTemp.Show(1)
|
|
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE dofile && Executes files, channelling known FoxPro-type files to appropriate application Do... methods, and files of unknown types through Windows API
|
|
LPARAMETERS tcFile
|
|
|
|
LOCAL lcFileName, liReturnValue, lcExt, lcStem, llReturn, llDevProduct
|
|
|
|
THIS.ClearLastError()
|
|
|
|
IF VARTYPE(tcFile) = "C" AND FILE(ALLTRIM(tcFile))
|
|
lcFileName = ALLTRIM(tcFile)
|
|
ENDIF
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcFileName= THIS.GetResourceFileName(lcFileName)
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcExt = " "+UPPER(JUSTEXT(lcFileName))+" "
|
|
IF NOT EMPTY(lcExt) AND LEN(lcExt) = 5
|
|
lcStem = FORCEEXT(lcFileName,"")
|
|
ENDIF
|
|
|
|
llReturn = NULL
|
|
llDevProduct = (VERS(2) # 0)
|
|
|
|
DO CASE
|
|
CASE EMPTY(lcStem)
|
|
* we didn't get anything we can use,
|
|
* don't bother checking the CASEs
|
|
|
|
CASE INLIST(lcExt," SCX ", " SCT ")
|
|
llReturn = THIS.DoForm(lcStem)
|
|
|
|
CASE INLIST(lcExt," LBX ", " LBT ")
|
|
llReturn = THIS.DoLabel(lcStem)
|
|
|
|
CASE INLIST(lcExt, " FRX ", " FRT ")
|
|
llReturn = THIS.DoReport(lcStem)
|
|
|
|
CASE lcExt == " MPX "
|
|
llReturn = THIS.DoMenu(lcFileName)
|
|
|
|
CASE INLIST(lcExt," MPR ", " MNX ", " MNT ") AND ;
|
|
( (llDevProduct AND FILE(FORCEEXT(lcFileName,"MPR"))) OR ;
|
|
FILE(FORCEEXT(lcFileName,"MPX")) )
|
|
llReturn = THIS.DoMenu(lcStem)
|
|
|
|
CASE INLIST(lcExt, " APP ", " FXP ")
|
|
llReturn = THIS.DoProgram(lcFileName)
|
|
|
|
CASE lcExt == " PRG " AND ;
|
|
( llDevProduct OR ;
|
|
FILE(FORCEEXT(lcFileName,"FXP")) )
|
|
llReturn = THIS.DoProgram(lcStem)
|
|
|
|
CASE INLIST(lcExt, " QPX ", " SPX ")
|
|
|
|
* must use full filename for queries and sprs,
|
|
* maintaining exact same behavior as the base product
|
|
llReturn = THIS.DoProgram(lcFileName)
|
|
|
|
CASE lcExt == " QPR " AND ;
|
|
( llDevProduct OR ;
|
|
FILE(FORCEEXT(lcFileName,"QPX")) )
|
|
llReturn = THIS.DoProgram(FORCEEXT(lcFileName, "QPX"))
|
|
|
|
CASE lcExt == " SPR " AND ;
|
|
( llDevProduct OR ;
|
|
FILE(FORCEEXT(lcFileName,"SPX")) )
|
|
llReturn = THIS.DoProgram(FORCEEXT(lcFileName, "SPX"))
|
|
|
|
OTHERWISE
|
|
* fall through to below, unknown type file
|
|
ENDCASE
|
|
|
|
IF ISNULL(llReturn)
|
|
|
|
DECLARE long ShellExecuteA IN SHELL32 ;
|
|
long, string, string, string, string, long
|
|
|
|
liReturnValue = ShellExecuteA( 0, "open", ;
|
|
lcFilename, "","", 1 )
|
|
|
|
llReturn = (liReturnValue >= 32)
|
|
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE doform && Executes an SCX form or instantiates a VCX-based form/formset class.
|
|
LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlNoShow, tlGoMenu, tlNavToolbar
|
|
|
|
ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C"
|
|
ASSERT EMPTY(tcClass) OR VARTYPE(tcClass) = "C"
|
|
|
|
LOCAL lcFileName,lcClass,lnCount, lcFormName,lnFormCount, loMediator, ;
|
|
loForm, loFormMember, lNeedReActivateFormset, ;
|
|
llFormSet,llEnabledFormFound
|
|
*&* VFP 5 framework cascade code also used:
|
|
*&* LOCAL lnTop,lnLeft,loForm2,lcName
|
|
|
|
THIS.ClearLastError()
|
|
|
|
lcFileName=ALLTRIM(tcFileName)
|
|
|
|
lcClass=IIF(VARTYPE(tcClass)="C",LOWER(ALLTRIM(tcClass)),"")
|
|
|
|
IF EMPTY(lcClass)
|
|
lcFileName = THIS.GetResourceFileName(lcFileName,".scx")
|
|
ELSE
|
|
lcFileName = THIS.GetResourceFileName(lcFileName,".vcx")
|
|
ENDIF
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcFormName=IIF(EMPTY(lcClass),lcFileName,lcFileName+","+lcClass)
|
|
IF tlNoMultipleInstances
|
|
FOR lnCount = 1 TO THIS.nFormCount
|
|
IF THIS.aFormNames[lnCount]==lcFormName AND ;
|
|
VARTYPE(THIS.aForms[lnCount])="O"
|
|
IF UPPER(THIS.aForms[lnCount].BaseClass)== "FORM" AND ;
|
|
THIS.aForms[lnCount].WindowState = 1 && minimized
|
|
THIS.aForms[lnCount].WindowState = 0
|
|
ENDIF
|
|
IF VARTYPE(THIS.oFrame) = "O"
|
|
THIS.oFrame.Show()
|
|
ENDIF
|
|
THIS.aForms[lnCount].Show
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDFOR
|
|
ENDIF
|
|
|
|
* this is a hook, nothing in it
|
|
IF NOT THIS.BeforeDoForm(tcFileName,tcClass,tlNoMultipleInstances,tlNoShow, tlGoMenu, tlNavToolbar)
|
|
RETURN .F
|
|
ENDIF
|
|
|
|
THIS.RefreshFormsCollection
|
|
THIS.nFormCount=THIS.nFormCount+1
|
|
DIMENSION THIS.aForms[THIS.nFormCount],THIS.aFormNames[THIS.nFormCount]
|
|
THIS.aFormNames[THIS.nFormCount]=lcFormName
|
|
|
|
IF VARTYPE(THIS.oFrame) = "O"
|
|
THIS.oFrame.Show()
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(lcClass)
|
|
THIS.aForms[THIS.nFormCount] = ;
|
|
THIS.Instantiate(lcClass, lcFileName)
|
|
ELSE
|
|
DO FORM (lcFileName) NAME THIS.aForms[THIS.nFormCount] LINKED NOSHOW
|
|
ENDIF
|
|
|
|
lnFormCount=THIS.nFormCount
|
|
THIS.RefreshFormsCollection
|
|
|
|
IF THIS.nFormCount>=lnFormCount
|
|
* success so far,
|
|
* let's enable and position the new object(s)
|
|
* and then show it/them if we're supposed to:
|
|
|
|
loForm = THIS.aForms[THIS.nFormCount]
|
|
llFormSet = (UPPER(loForm.BaseClass) == "FORMSET")
|
|
|
|
IF llFormSet
|
|
|
|
FOR EACH loFormMember IN loForm.Forms
|
|
IF UPPER(loFormMember.BaseClass) == "FORM"
|
|
* skip toolbars
|
|
loMediator = THIS.GetFormMediatorRef(loFormMember)
|
|
* don't force until we know about all forms
|
|
* in set; see note below
|
|
IF VARTYPE(loMediator) = "O"
|
|
loMediator.LoadApp(THIS.cReference)
|
|
loMediator.lGoMenu = tlGoMenu
|
|
loMediator.lNavToolbar = tlNavToolbar
|
|
llEnabledFormFound = .T.
|
|
ENDIF
|
|
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
ELSE
|
|
|
|
loMediator = THIS.GetFormMediatorRef(THIS.aForms[THIS.nFormCount], ;
|
|
THIS.lEnableFormsAtRunTime)
|
|
* second param will force creation
|
|
* if lEnableFormsAtRuntime is on
|
|
IF VARTYPE(loMediator) = "O"
|
|
loMediator.LoadApp(THIS.cReference)
|
|
loMediator.lGoMenu = tlGoMenu
|
|
loMediator.lNavToolbar = tlNavToolbar
|
|
ENDIF
|
|
ENDIF
|
|
|
|
* if any forms in the formset are enabled,
|
|
* some may have been left un-enabled by
|
|
* intent, so that they don't get icon or whatever.
|
|
* So if even one form in the formset is enabled
|
|
* we won't dynamically enable the rest. That's
|
|
* why the below FOR/ENDFOR has to be done separately
|
|
* from the above attempt to load mediators in a formset:
|
|
|
|
IF llFormSet AND ;
|
|
(NOT llEnabledFormFound) AND ;
|
|
THIS.lEnableFormsAtRunTime
|
|
|
|
THIS.ClearLastError()
|
|
|
|
FOR EACH loFormMember IN loForm.Forms
|
|
IF UPPER(loFormMember.BaseClass) == "FORM"
|
|
loMediator = THIS.CreateFormMediator(loFormMember)
|
|
IF VARTYPE(loMediator) = "O"
|
|
loMediator.LoadApp(THIS.cReference)
|
|
loMediator.lGoMenu = tlGoMenu
|
|
loMediator.lNavToolbar = tlNavToolbar
|
|
ENDIF
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
ENDIF
|
|
|
|
IF NOT tlNoShow
|
|
IF VARTYPE(THIS.oFrame) # "O"
|
|
IF llFormSet
|
|
* there is something screwy about
|
|
* formsets when some forms may be showwindow 0
|
|
* and others 1, even in _SCREEN, so it's
|
|
* best to show each form separately:
|
|
FOR EACH loFormMember IN loForm.Forms
|
|
loFormMember.Show()
|
|
ENDFOR
|
|
ELSE
|
|
loForm.Show()
|
|
ENDIF
|
|
ELSE
|
|
* seems as though if even one form in
|
|
* the formset is ShowWindow = 0,
|
|
* then all forms must be brought into the top form
|
|
IF llFormSet
|
|
FOR EACH loFormMember IN loForm.Forms
|
|
IF loFormMember.ShowWindow = 0
|
|
lNeedReActivateFormset = .T.
|
|
EXIT
|
|
ENDIF
|
|
ENDFOR
|
|
FOR EACH loFormMember IN loForm.Forms
|
|
IF lNeedReActivateFormset
|
|
THIS.ActivateFormInFrame(loFormMember)
|
|
ELSE
|
|
loFormMember.Show()
|
|
ENDIF
|
|
ENDFOR
|
|
ELSE
|
|
IF loForm.ShowWindow = 0
|
|
THIS.ActivateFormInFrame(loForm)
|
|
ELSE
|
|
loForm.Show()
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF THIS.lCascadeForms AND NOT llFormSet
|
|
THIS.CascadeAll(loForm.Name)
|
|
*&* this is where VFP framework used THIS.nPixelOffset,
|
|
*&* all that code removed but the property might still
|
|
*&* be useful somewhere
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE doformnoshow && Executes an SCX form or instantiates a VCX-based form/formset class, without Showing it, and returning a reference to the form or formset instantiated.
|
|
LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlGoMenu, tlNavToolbar
|
|
|
|
LOCAL loForm, liCount
|
|
THIS.RefreshFormsCollection()
|
|
liCount = THIS.nFormCount
|
|
loForm = .NULL.
|
|
THIS.DoForm(tcFileName,tcClass,tlNoMultipleInstances,.T.,tlGoMenu, tlNavToolbar)
|
|
IF THIS.nFormCount > liCount
|
|
loForm = THIS.aForms(THIS.nFormCount)
|
|
ENDIF
|
|
RETURN loForm
|
|
ENDPROC
|
|
|
|
PROCEDURE dohelp && Executes help of types .hlp, .dbf, .htm, or .chm
|
|
LPARAMETERS tcFile
|
|
LOCAL lcFileName, lcExt, llReturn
|
|
|
|
llReturn = .T.
|
|
|
|
THIS.ClearLastError()
|
|
|
|
IF VARTYPE(tcFile) = "C" AND FILE(ALLTRIM(tcFile))
|
|
lcFileName = ALLTRIM(tcFile)
|
|
ELSE
|
|
lcFileName=ALLTRIM(THIS.cHelpFile)
|
|
ENDIF
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcFileName= THIS.GetResourceFileName(lcFileName,".hlp .dbf .htm .chm")
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcExt = UPPER(JUSTEXT(lcFileName))
|
|
|
|
DO CASE
|
|
CASE lcExt = "DBF"
|
|
|
|
IF UPPER(lcFileName) # UPPER(SET("HELP",1))
|
|
LOCAL lcOldHelpFile, lcOldHelp
|
|
lcOldHelp = SET("HELP")
|
|
lcOldHelpFile = SET("HELP",1)
|
|
SET HELP TO (lcFileName)
|
|
SET HELP ON
|
|
HELP
|
|
IF NOT EMPTY(lcOldHelpFile) AND FILE(lcOldHelpFile)
|
|
SET HELP TO (lcOldHelpFile)
|
|
ENDIF
|
|
SET HELP &lcOldHelp
|
|
ELSE
|
|
HELP
|
|
ENDIF
|
|
|
|
CASE INLIST(lcExt,"HLP","HTM","CHM")
|
|
|
|
llReturn = THIS.DoFile(lcFilename)
|
|
|
|
OTHERWISE
|
|
|
|
* ??
|
|
ENDCASE
|
|
|
|
|
|
RETURN llReturn AND (THIS.IsErrorFree())
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE dolabel && Executes an LBX label
|
|
LPARAMETERS tcFileName, tcDescription
|
|
ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C"
|
|
ASSERT EMPTY(tcDescription) OR VARTYPE(tcDescription) = "C"
|
|
|
|
LOCAL lcFileName, lcDescription
|
|
THIS.ClearLastError()
|
|
lcFileName=ALLTRIM(tcFileName)
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcFileName= THIS.GetResourceFileName(lcFileName,".lbx")
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF EMPTY(tcDescription)
|
|
lcDescription = PROPER(JUSTSTEM(lcFileName))
|
|
ELSE
|
|
lcDescription = tcDescription
|
|
ENDIF
|
|
|
|
THIS.DoReport(lcFileName, lcDescription)
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE domenu && Executes an MPR/MPX menu.
|
|
LPARAMETERS tcFileName, tlUniquePopupNames
|
|
ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C"
|
|
|
|
LOCAL lcFileName
|
|
THIS.ClearLastError()
|
|
lcFileName=ALLTRIM(tcFileName)
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcFileName= THIS.GetResourceFileName(lcFileName,".mpx .mpr")
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF VARTYPE(THIS.oFrame) # "O"
|
|
DO (lcFileName)
|
|
ELSE
|
|
DO (lcFileName) WITH THIS.oFrame, THIS.oFrame.cMenuName, tlUniquePopupNames
|
|
ENDIF
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE domenuiteminframe && Not currently used, wraps cusWindowHandler method
|
|
LPARAMETERS tcToken
|
|
IF EMPTY(tcToken)
|
|
RETURN
|
|
ENDIF
|
|
THIS.cusWindowHandler.InvokeMenuItemInFrame(tcToken)
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE domodaldialogclass && Instantiates a modal dialog, applying application attributes as appropriate. RETURNs a form reference, if NOSHOW.
|
|
LPARAMETERS tcWhichDialogClass, tcWhichDialogClassLib, tlNoShow
|
|
|
|
LOCAL loFormRef, lcWhichDialogClassLib
|
|
|
|
IF EMPTY(tcWhichDialogClass)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(tcWhichDialogClassLib)
|
|
lcWhichDialogClassLib = tcWhichDialogClassLib
|
|
ENDIF
|
|
|
|
IF VARTYPE(THIS.oFrame) = "O" and THIS.oFrame.ShowWindow < 2
|
|
THIS.oFrame.Show()
|
|
ENDIF
|
|
|
|
|
|
loFormRef = THIS.Instantiate(tcWhichDialogClass,lcWhichDialogClassLib)
|
|
|
|
IF VARTYPE(loFormRef) # "O"
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
|
|
IF PEMSTATUS(loFormRef,"ApplyAppAttributes",5)
|
|
loFormRef.ApplyAppAttributes(THIS)
|
|
ELSE
|
|
IF EMPTY(loFormRef.Icon)
|
|
loFormRef.Icon = THIS.cIcon
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF tlNoShow
|
|
|
|
RETURN loFormRef
|
|
|
|
ELSE
|
|
|
|
|
|
loFormRef.WindowType = 1
|
|
THIS.ActivateFormInFrame(loFormRef)
|
|
|
|
RETURN .T.
|
|
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE donewopen && Invokes cNewOpenClass
|
|
LPARAMETERS tlNew
|
|
LOCAL llReturn
|
|
THIS.lAddingNewDocument = tlNew
|
|
llReturn = THIS.DoDocumentPickerDialog(THIS.cNewOpenClass,;
|
|
THIS.cNewOpenClassLib, ;
|
|
tlNew)
|
|
THIS.ResetToDefault("lAddingNewDocument")
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE dooptionsdialog && Invokes cOptionsDialogClass
|
|
LOCAL llOpenedTable, llReturn
|
|
|
|
IF NOT USED(THIS.cUserTableAlias)
|
|
USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias)
|
|
llOpenedTable = .T.
|
|
ENDIF
|
|
|
|
IF THIS.lUserPreferences
|
|
THIS.SeekCurrentUser()
|
|
ELSE
|
|
THIS.SeekDefaultUser()
|
|
ENDIF
|
|
|
|
llReturn = THIS.DoModalDialogClass(THIS.cOptionsDialogClass, THIS.cOptionsDialogClassLib)
|
|
|
|
IF llOpenedTable
|
|
USE IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE doprogram && Executes a PRG, APP, FXP, or EXE program.
|
|
LPARAMETERS tcFileName
|
|
|
|
ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C"
|
|
|
|
LOCAL lcFileName
|
|
THIS.ClearLastError()
|
|
lcFileName=ALLTRIM(tcFileName)
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
* the following uses the order of precedence
|
|
* to determine the appropriate extension:
|
|
* .EXE (executable version)
|
|
* .APP (an application)
|
|
* .FXP (compiled version)
|
|
* .PRG (program)
|
|
|
|
* this program will run an SPR/SPX or QPR/QPX
|
|
* as well as the explicit list that
|
|
* VFP will run if you don't supply an extension,
|
|
* if you pass the name with an extension.
|
|
* This is consistent with the native behavior.
|
|
|
|
lcFileName= THIS.GetResourceFileName(lcFileName,".exe .app .fxp .prg")
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF VERSION(2) = 0 AND ;
|
|
UPPER(JUSTEXT(lcFileName)) == "PRG"
|
|
IF NOT EMPTY(SYS(2000,lcFileName))
|
|
* FXP was not found and PRG is on disk,
|
|
* not built in to a file
|
|
COMPILE (lcFileName)
|
|
lcFileName = FORCEEXT(lcFileName,"FXP")
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
DO (lcFileName)
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE doreport && Executes an FRX or LBX report form.
|
|
LPARAMETERS tcFileName, tcDescription, tlModify
|
|
|
|
ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C"
|
|
ASSERT EMPTY(tcDescription) OR VARTYPE(tcDescription) = "C"
|
|
|
|
LOCAL lcFileName
|
|
THIS.ClearLastError()
|
|
|
|
IF (EMPTY(tcFileName) AND NOT tlModify)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcFileName=ALLTRIM(tcFileName)
|
|
|
|
lcFileName= THIS.GetResourceFileName(lcFileName,".frx .lbx", tlModify)
|
|
|
|
IF tlModify
|
|
|
|
* if EMPTY(lcFileName)
|
|
* confirm creation, use template?
|
|
* else MODIFY
|
|
|
|
* not yet implemented
|
|
MESSAGEBOX(APP_FEATURE_NOT_AVAILABLE_LOC, ;
|
|
MB_ICONINFORMATION,THIS.cCaption)
|
|
|
|
ELSE
|
|
|
|
IF EMPTY(lcFileName)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
* we can provide output *without* going through the
|
|
* user's choices in the dialog at all, simply
|
|
* by instantiating an _output object and setting
|
|
* its properties rather than going through this dialog
|
|
* This is not implemented here, because it
|
|
* would definitely require that you set properties,
|
|
* as below. Would make sense for a subclass app object
|
|
* to have a lWantOutputDialog property which defaults .T.
|
|
* If the dialog is not desired, augment the
|
|
* standard behavior by looking for developer's
|
|
* information -- whether in the metatable or elsewhere
|
|
* about destination and options settings.
|
|
|
|
LOCAL loDialog
|
|
|
|
loDialog = THIS.DoModalDialogClass("_outputdialog","_reports", .T.)
|
|
|
|
* note: could add a metatable check here to fill out loDialog.cAlias
|
|
* or loDialog.cFieldList, or loDialog.cAddedParams...
|
|
* could prefill the destination...
|
|
* also note that this dialog doesn't, strictly speaking, have to
|
|
* be modal, but we're calling it from a modal dialog (the picker) so
|
|
* it seems reasonable to keep it modal here. We could subclass it
|
|
* to know how to be a singleton, like the error dialog, instead...
|
|
* and automatically know about app attributes, rather than
|
|
* using the generic gallery version and adjusting it.
|
|
|
|
|
|
IF VARTYPE(loDialog) = "O"
|
|
|
|
LOCAL laRecNos[1], laWorkAreas[1], ;
|
|
liUsed, liRow, lcAlias
|
|
|
|
liUsed = AUSED(laWorkAreas)
|
|
|
|
* Unlike DoTableOutput(), we really
|
|
* have no clue in this method what
|
|
* workareas might be affected by
|
|
* the named report or label form, so
|
|
* should take care of all current
|
|
* record pointers,
|
|
* assuming that any workareas at all
|
|
* are affected in the current data
|
|
* session.
|
|
|
|
* Because it has a custom property
|
|
* allowing a new alias to be selected
|
|
* before output is generated, the
|
|
* _output object saves and
|
|
* restore current workarea,
|
|
* after output is generated -- so
|
|
* that (at least) is not an issue here.
|
|
|
|
* Note also that the report either has its
|
|
* own datasession, which has been
|
|
* disposed of separately,
|
|
* or it takes place in this
|
|
* datasession, so no save/restore
|
|
* of data sessions should be necessary.
|
|
|
|
* We will stipulate that any custom
|
|
* datasession objects that a report
|
|
* might open, and even create a public
|
|
* reference to, should not affect the
|
|
* environment of the application
|
|
* at the time this method was called.
|
|
* Any additional aliases open in
|
|
* this datasession by the running
|
|
* report which are not closed by
|
|
* the report will not be affected
|
|
* by this code.
|
|
|
|
* However, see remarks about VUE
|
|
* file below.
|
|
|
|
IF liUsed > 0
|
|
DIMENSION laRecNos[liUsed]
|
|
FOR liRow = 1 TO liUsed
|
|
lcAlias = laWorkAreas[liRow,1]
|
|
IF EOF(lcAlias)
|
|
laRecNos[liRow] = 0
|
|
ELSE
|
|
laRecNos[liRow] = RECNO(lcAlias)
|
|
ENDIF
|
|
ENDFOR
|
|
ENDIF
|
|
|
|
* We must allow for the fact that
|
|
* reports can cause errors -- either
|
|
* because being invoked in this generic
|
|
* way they don't have access to the data
|
|
* they need or a UDF causes an error.
|
|
|
|
THIS.lSkipErrorHandling = .T.
|
|
|
|
loDialog.Icon = THIS.cIcon
|
|
IF EMPTY(tcDescription)
|
|
loDialog.Caption = loDialog.Caption+" "+ ;
|
|
PROPER(JUSTFNAME(lcFileName))
|
|
ELSE
|
|
loDialog.Caption = loDialog.Caption + " "+tcDescription
|
|
ENDIF
|
|
loDialog.cHTMLClass = THIS.SetHTMLClass(tcFileName)
|
|
loDialog.cHTMLStyleID = THIS.SetHTMLStyleID(tcFileName)
|
|
loDialog.lAddSourceNameToDropDown = .F.
|
|
loDialog.cReport = lcFileName
|
|
loDialog.lPreventSourceChanges = .T.
|
|
loDialog.Show(1)
|
|
loDialog = .NULL.
|
|
|
|
* This "restore" code does *not*
|
|
* handle any dropped or changed
|
|
* relations that might occur in the the
|
|
* FRX or LBX data environment.
|
|
* Neither does it handle the possibility
|
|
* that a UDF attached to the report
|
|
* or label might actually close a table,
|
|
* except in the most basic way, and
|
|
* there could be many other
|
|
* unforeseen changes
|
|
* to the current data session that could
|
|
* take place in a UDF.
|
|
|
|
* If complete save and restore behavior
|
|
* is desirable, a VUE file
|
|
* should be CREATEd earlier to a
|
|
* generated tempfile name, SET here
|
|
* and then ERASEd, followed by
|
|
* record-pointer-restoring code similar
|
|
* to the following.
|
|
|
|
IF liUsed > 0
|
|
FOR liRow = 1 TO liUsed
|
|
lcAlias = laWorkAreas[liRow,1]
|
|
IF NOT USED(lcAlias)
|
|
LOOP
|
|
ENDIF
|
|
IF laRecNos[liRow] = 0
|
|
GO BOTTOM IN (lcAlias)
|
|
SKIP IN (lcAlias)
|
|
ELSE
|
|
GO (laRecNos[liRow]) IN (lcAlias)
|
|
ENDIF
|
|
ENDFOR
|
|
ENDIF
|
|
|
|
IF (NOT THIS.IsErrorFree())
|
|
MESSAGEBOX(REPORT_RUN_ERROR_LOC,MB_ICONSTOP,THIS.cCaption)
|
|
ENDIF
|
|
THIS.lSkipErrorHandling = .F.
|
|
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE doreportdialog && Invokes cReportDialogClass
|
|
LPARAMETERS tlModify
|
|
|
|
LOCAL llReturn
|
|
llReturn = THIS.DoDocumentPickerDialog(THIS.cReportDialogClass,;
|
|
THIS.cReportDialogClassLib, ;
|
|
tlModify)
|
|
RETURN llReturn
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE dosort && Wraps cusTableSort's DoSort() method.
|
|
LPARAMETERS tcField, tcAlias, tcTag, tlDescending
|
|
THIS.cusTableSort.DoSort(tcField,tcAlias,tcTag,tlDescending)
|
|
ENDPROC
|
|
|
|
PROCEDURE dostartupform && Instantiates cStartupFormClass dialog
|
|
LPARAMETERS tlAdd
|
|
LOCAL llReturn, lcFavoriteIDs
|
|
|
|
lcFavoriteIDs = THIS.cCurrentUserFavoriteIDs
|
|
|
|
llReturn = THIS.DoDocumentPickerDialog(THIS.cStartupFormClass,;
|
|
THIS.cStartupFormClassLib, ;
|
|
tlAdd)
|
|
IF tlAdd AND NOT (lcFavoriteIDs == THIS.cCurrentUserFavoriteIDs)
|
|
* re-refresh the popup and save to disk
|
|
* note:
|
|
* modal form doesn't seem to be able to
|
|
* affect the popup permanently -- the new bars "leave"
|
|
* when the modal dialog's Destroy() fires!
|
|
* That's why we don't do this earlier...
|
|
THIS.SetCurrentUserFavoriteIDs(THIS.cCurrentUserFavoriteIDs)
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE dotableoutput && Looks at the current form/alias and invokes the _outputdialog class appropriately for a table. Scope 1 or all. Hooks mediator's PrepareOutputAlias() and CleanupOutputAlias(), for framework-enabled forms, and app.SetHTMLClass/SetHTMLStyleID for GENHTML.
|
|
* this option looks at the current
|
|
* form/alias for any form
|
|
* if the form is enabled for
|
|
* framework use, it can derive the
|
|
* alias information with help of the
|
|
* app mediator object
|
|
|
|
LPARAMETERS tlOutputOneRecord
|
|
|
|
LOCAL loDialog, loMediator, loActiveForm, liSession, lcAlias, ;
|
|
lcCaption, lcScope, liRecno, llReturn, llInterrupted
|
|
|
|
IF TYPE("_SCREEN.ActiveForm") = "O"
|
|
loActiveForm = _SCREEN.ActiveForm
|
|
loMediator = THIS.GetFormMediatorRef(loActiveForm)
|
|
ENDIF
|
|
liSession = SET("DATASESSION")
|
|
|
|
DO CASE
|
|
CASE TYPE("loActiveForm.Parent") = "O"
|
|
SET DATASESSION TO (loActiveForm.Parent.DataSessionID)
|
|
CASE VARTYPE(loActiveForm) = "O"
|
|
SET DATASESSION TO (loActiveForm.DataSessionID)
|
|
ENDCASE
|
|
|
|
IF VARTYPE(loMediator) = "O"
|
|
loMediator.PrepareOutputAlias()
|
|
lcAlias = loMediator.cOutputAlias
|
|
lcCaption = loMediator.cOutputCaption
|
|
ENDIF
|
|
|
|
IF EMPTY(lcAlias)
|
|
lcAlias = ALIAS()
|
|
ENDIF
|
|
|
|
IF EMPTY(lcCaption)
|
|
lcCaption = PROPER(lcAlias)
|
|
ENDIF
|
|
|
|
|
|
IF NOT ( EMPTY(lcAlias) OR EMPTY(RECCOUNT(lcAlias)) )
|
|
|
|
IF (NOT tlOutputOneRecord)
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
* we only have to worry about
|
|
* this if we are
|
|
* going to be using the
|
|
* navigation features, which
|
|
* may bring up a messagebox()
|
|
ENDIF
|
|
|
|
IF THIS.cusTableNav.CurrentTableAllowsNavigation(lcAlias)
|
|
lcScope = ""
|
|
ELSE
|
|
lcScope = NULL
|
|
ENDIF
|
|
|
|
ELSE
|
|
lcScope = "NEXT 1"
|
|
ENDIF
|
|
|
|
IF NOT ISNULL(lcScope)
|
|
|
|
IF EOF(lcAlias)
|
|
liRecno = 0
|
|
ELSE
|
|
liRecno = RECNO(lcAlias)
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
IF (NOT ISNULL(lcScope)) AND ;
|
|
VARTYPE(liRecno) = "N" AND ;
|
|
(EMPTY(lcScope) OR liRecno # 0)
|
|
|
|
IF NOT EMPTY(lcScope)
|
|
lcCaption = lcCaption+"("+APP_OUTPUT_ONE_REC_LOC+")"
|
|
ENDIF
|
|
|
|
loDialog = THIS.DoModalDialogClass("_outputdialog","_reports", .T.)
|
|
|
|
IF VARTYPE(loDialog) = "O"
|
|
loDialog.cScope = lcScope
|
|
loDialog.cAlias = lcAlias
|
|
loDialog.Caption = loDialog.Caption + " " + lcCaption
|
|
loDialog.lAddSourceNameToDropDown = .F.
|
|
loDialog.cHTMLClass = THIS.SetHTMLClass(lcAlias,.T.)
|
|
loDialog.cHTMLStyleID = THIS.SetHTMLStyleID(lcAlias, .T.)
|
|
loDialog.Icon = THIS.cIcon
|
|
loDialog.lPreventSourceChanges = .T.
|
|
loDialog.cDisplayFontName = THIS.cTextDisplayFont
|
|
loDialog.Show(1)
|
|
loDialog = .NULL.
|
|
llReturn = .T.
|
|
|
|
ENDIF
|
|
|
|
IF liRecno = 0
|
|
GO BOTTOM IN (lcAlias)
|
|
SKIP IN (lcAlias)
|
|
ELSE
|
|
GO liRecno IN (lcAlias)
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
IF VARTYPE(loMediator) = "O"
|
|
loMediator.CleanupOutputAlias()
|
|
ENDIF
|
|
|
|
SET DATASESSION TO (liSession)
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
ENDPROC
|
|
|
|
PROCEDURE dotoolbar && Parallel to DoForm. Maintains toolbars collection. Pass a toolbar class library & class name. Uses THIS.iInitialToolbarPosition to set position.
|
|
LPARAMETERS tcClassLib, tcClass
|
|
|
|
ASSERT EMPTY(tcClassLib) OR VARTYPE(tcClassLib) = "C"
|
|
ASSERT EMPTY(tcClass) OR VARTYPE(tcClass) = "C"
|
|
|
|
LOCAL lcClass, loToolbar, lcClassLib, ;
|
|
liElement, liIndex, liToolbars, lcToolbarName
|
|
|
|
IF EMPTY(tcClass)
|
|
RETURN 0
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(tcClassLib)
|
|
lcClassLib = tcClassLib
|
|
ENDIF
|
|
|
|
|
|
lcClass = UPPER(ALLTRIM(tcClass))
|
|
|
|
liElement = 0
|
|
liToolbars = ALEN(THIS.aToolbars,1)
|
|
FOR liIndex = 1 TO liToolbars
|
|
loToolbar = THIS.aToolbars[liIndex,1]
|
|
* do we have a free element to fill?
|
|
IF VARTYPE(loToolbar) # "O" OR ;
|
|
VARTYPE(THIS.aToolbars[liIndex,2]) # "N" ;
|
|
OR THIS.aToolbars[liIndex,2] = 0
|
|
|
|
liElement = liIndex
|
|
LOOP
|
|
ENDIF
|
|
* is this toolbar already instantiated?
|
|
IF UPPER(loToolbar.Class) == lcClass
|
|
* increment its counter
|
|
THIS.aToolbars[liIndex,2] = THIS.aToolbars[liIndex,2]+1
|
|
loToolbar.Show && position or dock here?
|
|
RETURN liIndex
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
IF liElement = 0
|
|
IF VARTYPE(THIS.aToolbars[1,1]) = "O"
|
|
liElement = liToolbars+1
|
|
ELSE
|
|
liElement = 1
|
|
ENDIF
|
|
DIMENSION THIS.aToolbars[liElement,2]
|
|
ENDIF
|
|
|
|
THIS.aToolbars[liElement,2] = 0
|
|
|
|
IF VARTYPE(THIS.oFrame) = "O" AND (NOT WONTOP(THIS.oFrame.Name))
|
|
THIS.oFrame.Show()
|
|
ENDIF
|
|
|
|
THIS.aToolbars[liElement,1]=THIS.Instantiate(lcClass,lcClassLib)
|
|
|
|
IF VARTYPE(THIS.aToolbars[liElement,1]) = "O"
|
|
IF PEMSTATUS(THIS.aToolbars[liElement,1], "oApp",5)
|
|
THIS.aToolbars[liElement,1].oApp = THIS
|
|
ENDIF
|
|
THIS.aToolbars[liElement,2] = 1
|
|
THIS.aToolbars(liElement,1).Dock(THIS.iInitialToolbarPosition)
|
|
* THIS.aToolbars[liElement,1].Show() replaced by:
|
|
THIS.ActivateFormInFrame(THIS.aToolbars[liElement,1])
|
|
ENDIF
|
|
|
|
|
|
RETURN liElement
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE douserlogin && Invokes cUserLoginClass dialog. Returns (NOT EOF(THIS.cUserTableAlias)) to indicate success at locating a user.
|
|
ASSERT USED(THIS.cUserTableAlias)
|
|
* we're supposed to be setting a record pointer
|
|
* in an open table here...
|
|
|
|
IF (NOT THIS.lUserPreferences)
|
|
RETURN .F.
|
|
ENDIF
|
|
LOCAL loForm
|
|
|
|
loForm = THIS.DoModalDialogClass(THIS.cUserLogInClass, THIS.cUserLogInClassLib, .T.)
|
|
IF VARTYPE(loForm) = "O"
|
|
loForm.Show(1)
|
|
RETURN (NOT EOF(THIS.cUserTableAlias))
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
THIS.iLastError = nError
|
|
|
|
IF THIS.lSkipErrorHandling
|
|
* special cases -- right
|
|
* now this is done when
|
|
* trying to USE the error log EXCLUSIVEly
|
|
* for purging
|
|
RETURN
|
|
ENDIF
|
|
|
|
THIS.cusError.Handle(nError,cMethod,nLine)
|
|
|
|
LOCAL llFatal, llUserCancelled, lcCaller, lcProg, ;
|
|
llNoCodeExecuting, liLevel, lcTemp
|
|
|
|
llFatal = THIS.cusError.IsFatal()
|
|
llUserCancelled = THIS.cusError.UserCancelled()
|
|
|
|
IF NOT (llFatal OR llUserCancelled)
|
|
liLevel = 0
|
|
lcCaller = ""
|
|
lcProg = PROGRAM(0)
|
|
DO WHILE .T.
|
|
lcCaller = PROGRAM(liLevel)
|
|
liLevel = liLevel + 1
|
|
lcProg = PROGRAM(liLevel)
|
|
IF EMPTY(lcProg) OR (UPPER(lcProg) == UPPER(THIS.Name+".ERROR"))
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
llNoCodeExecuting = (UPPER(lcCaller) == UPPER(THIS.Name+".READEVENTS"))
|
|
ENDIF
|
|
|
|
DO CASE
|
|
CASE THIS.iLastError # nError
|
|
* an error in the error handler!
|
|
* this will have been taken care of
|
|
* and we don't want to get
|
|
* into a recursive situation
|
|
CASE llFatal OR llUserCancelled
|
|
|
|
IF THIS.lReadEvents
|
|
lcTemp = THIS.cLastOnError
|
|
ON ERROR &lcTemp
|
|
* remove reference to App Object
|
|
* in error handler *now* before
|
|
* it can start messing about with
|
|
* destroying itself
|
|
ENDIF
|
|
THIS.Release()
|
|
CASE llNoCodeExecuting
|
|
RETRY
|
|
OTHERWISE
|
|
RETURN
|
|
ENDCASE
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE exporterrorlog && Invokes _outputdialog class to allow output of error log information.
|
|
LOCAL lcTable, liSelect, lcAlias, loDialog, lcTableAlias, llReturn
|
|
|
|
lcTable = THIS.cErrorLogTableName
|
|
IF EMPTY(lcTable) OR NOT FILE(lcTable)
|
|
MESSAGEBOX(ERRORVIEWER_UNAVAILABLE_LOC,MB_ICONINFORMATION,THIS.cCaption)
|
|
RETURN
|
|
ENDIF
|
|
|
|
THIS.ClearLastError()
|
|
liSelect = SELECT()
|
|
lcAlias = "ExportErrors"
|
|
IF USED(lcAlias)
|
|
lcAlias = "E"+SYS(2015)
|
|
ENDIF
|
|
SELE 0
|
|
USE (lcTable) AGAIN SHARED
|
|
lcTableAlias = ALIAS()
|
|
|
|
IF (NOT THIS.IsErrorFree())
|
|
THIS.ClearLastError()
|
|
SELECT (liSelect)
|
|
RETURN
|
|
ENDIF
|
|
|
|
SELECT errstamp, ;
|
|
MLINE (listing,1)+" "+MLINE(listing,3) AS listing, ;
|
|
MLINE(usernotes,1) AS usernotes ;
|
|
FROM (lcTable) ;
|
|
INTO CURSOR (lcAlias)
|
|
SELECT (lcAlias)
|
|
USE IN (lcTableAlias)
|
|
|
|
IF _TALLY > 0
|
|
|
|
loDialog = THIS.DoModalDialogClass("_outputdialog","_reports", .T.)
|
|
|
|
IF VARTYPE(loDialog) = "O"
|
|
loDialog.Icon = THIS.cIcon
|
|
loDialog.cAlias = lcAlias
|
|
loDialog.lPreventSourceChanges = .T.
|
|
loDialog.cDisplayFontName = THIS.cTextDisplayFont
|
|
loDialog.cHTMLClass = THIS.SetHTMLClass(lcAlias,.T.)
|
|
loDialog.cHTMLStyleID = THIS.SetHTMLStyleID(lcAlias,.T.)
|
|
loDialog.Show(1)
|
|
loDialog = .NULL.
|
|
llReturn = .T.
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
MESSAGEBOX(ERRORVIEWER_EMPTY_LOC,MB_ICONINFORMATION,THIS.cCaption)
|
|
|
|
ENDIF
|
|
|
|
IF USED(lcAlias)
|
|
USE IN (lcAlias)
|
|
ENDIF
|
|
|
|
SELECT (liSelect)
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE filenotfoundmsgbox && Displays a File Not Found messagebox.
|
|
LPARAMETERS tcFileName
|
|
|
|
IF INLIST(_VFP.Startmode, 0, 4)
|
|
MESSAGEBOX(APP_FILE_NOT_FOUND_LOC+":"+;
|
|
CHR(13) + CHR(13)+ ;
|
|
tcFileName,MB_ICONEXCLAMATION,THIS.cCaption)
|
|
ELSE
|
|
THIS.cusError.RecordServerError(;
|
|
THIS.cCaption+ ": "+APP_FILE_NOT_FOUND_LOC)
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE filluseroptionsarray && Moves the user table's UserOpts contents to aCurrentUserOpts. Array has 4 columns: property name, value, toggle property or SET, datasession or global attribute
|
|
ASSERT USED(THIS.cUserTableAlias)
|
|
IF TYPE(THIS.cUserTableAlias+".UserOpts") = "M" AND ;
|
|
NOT EMPTY(EVAL(THIS.cUserTableAlias+".UserOpts"))
|
|
RESTORE FROM MEMO (THIS.cUserTableAlias+".UserOpts") ADDITIVE
|
|
* adds a local array, laOptions
|
|
DIME THIS.aCurrentUserOpts[ALEN(laOptions,1),4]
|
|
* array columns: property name, value, property or SET, datasession or global
|
|
ACOPY(laOptions,THIS.aCurrentUserOpts)
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE formisframeworkenabled && Reports the existance of a mediator object on a form. Uses THIS.cFormMediatorName to determine the naming convention for this object on the form.
|
|
LPARAMETERS toForm
|
|
RETURN (NOT ISNULL(THIS.GetFormMediatorRef(toForm)))
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE getcurrentalias && Wraps the cusTableNav member's GetCurrentAlias() method.
|
|
RETURN THIS.cusTableNav.GetCurrentAlias()
|
|
ENDPROC
|
|
|
|
PROCEDURE getcurrenttopformref && Wraps cusWindowHandler's GetCurrentTopFormRef() method.
|
|
|
|
RETURN THIS.cusWindowHandler.GetCurrentTopFormRef()
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE getformmediatorref && Returns a reference to a form's mediator object, or NULL if the form is not framework-enabled with a mediator object.
|
|
LPARAMETERS toForm, tlForce
|
|
|
|
IF VARTYPE(toForm) # "O" OR ;
|
|
NOT (UPPER(toForm.BaseClass) == "FORM")
|
|
RETURN NULL
|
|
ENDIF
|
|
|
|
LOCAL loMember, laCheck[1], loMediator, llExactSet
|
|
|
|
loMediator = NULL
|
|
|
|
llExactSet =(SET("EXACT") = "OFF")
|
|
IF llExactSet
|
|
SET EXACT ON
|
|
ENDIF
|
|
|
|
IF TYPE("toForm."+THIS.cFormMediatorName+".Name") = "C"
|
|
loMediator = EVAL("toForm."+THIS.cFormMediatorName)
|
|
IF ACLASS(laCheck,loMediator) = 0 OR ;
|
|
ASCAN(laCheck,UPPER(APP_MEDIATOR_SUPERCLASS)) = 0
|
|
loMediator = NULL
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF ISNULL(loMediator) AND toForm.ControlCount > 0
|
|
* try to find a member of the appropriate
|
|
* class; slower than the above but still worthwhile
|
|
* for generic dialogs that might not use the
|
|
* appropriate mediator name for this app.
|
|
FOR EACH loMember in toForm.Controls
|
|
IF VARTYPE(loMember) = "O" ;
|
|
AND ACLASS(laCheck,loMember) > 0 AND ;
|
|
ASCAN(laCheck,UPPER(APP_MEDIATOR_SUPERCLASS)) > 0
|
|
loMediator = loMember
|
|
EXIT
|
|
ENDIF
|
|
ENDFOR
|
|
ENDIF
|
|
|
|
IF ISNULL(loMediator) AND tlForce
|
|
* create one
|
|
loMediator = THIS.CreateFormMediator(toForm)
|
|
|
|
ENDIF
|
|
|
|
IF llExactSet
|
|
SET EXACT OFF
|
|
ENDIF
|
|
|
|
RETURN loMediator
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE getresourcefilename && Pass: tcSource, tcExtList, tlSuppressMsg, looks for file with any of extensions in list, in order, to RETURN the appropriate pathed name ("" if none, with File Not Found msg unless tlSuppressMsg). Ignores tcExtlList if explicit ext passed in tcSource.
|
|
LPARAMETERS tcSourceFileName, tcExtensionList, tlSuppressMessage
|
|
ASSERT VARTYPE(tcSourceFileName) = "C" AND NOT EMPTY(tcSourceFileName)
|
|
ASSERT EMPTY(tcExtensionList) OR VARTYPE(tcExtensionList) = "C"
|
|
|
|
|
|
* Try out any one of a number of extensions in a delimited
|
|
* list if the filename-as-delivered is not found.
|
|
* The "." characer is considered the delimiter for this
|
|
* list, as it forms an integral part of the definition of a
|
|
* file extension.
|
|
|
|
* If *no* "." characters are found in the list but the list
|
|
* is passed with a string containing spaces, then the
|
|
* list will be assumed to be a list of space-delimited
|
|
* extensions.
|
|
|
|
* Filenames passed in a list will be tried in the order passed;
|
|
* see THIS.DoProgram() for a potential list by precedence.
|
|
* It's up to the calling program to figure out
|
|
* what extensions are appropriate.
|
|
|
|
LOCAL lcSourceFileName, lcTargetFileName, lcExtList, ;
|
|
lcExt, liExts, liTryExt, liThisExtStarts,liNextExtStarts
|
|
|
|
IF VARTYPE(tcSourceFileName) # "C" OR EMPTY(tcSourceFileName)
|
|
RETURN ""
|
|
ENDIF
|
|
|
|
lcSourceFileName = ALLTR(tcSourceFileName)
|
|
|
|
IF EMPTY(tcExtensionList) OR ("." $ tcSourceFileName)
|
|
lcTargetFileName = LOWER(FULLPATH(lcSourceFileName))
|
|
IF NOT FILE(lcTargetFileName)
|
|
lcTargetFileName = ""
|
|
ENDIF
|
|
ELSE
|
|
lcExtList = ALLTRIM(tcExtensionList)
|
|
liExts = OCCURS(".",lcExtList)
|
|
IF liExts = 0
|
|
lcExtList = STRTRAN(tcExtensionList," ",".")
|
|
ELSE
|
|
lcExtList = STRTRAN(tcExtensionList," ","")
|
|
ENDIF
|
|
IF LEFT(lcExtList,1) # "."
|
|
lcExtList = "."+lcExtList
|
|
ENDIF
|
|
liExts = OCCURS(".",lcExtList)
|
|
FOR liTryExt = 1 TO liExts
|
|
liThisExtStarts = AT(".",lcExtList,liTryExt)
|
|
IF liTryExt # liExts
|
|
liNextExtStarts = AT(".",lcExtList,liTryExt + 1)
|
|
lcExt = SUBSTR(lcExtList,liThisExtStarts,liNextExtStarts-liThisExtStarts)
|
|
ELSE
|
|
lcExt = SUBSTR(lcExtList,liThisExtStarts)
|
|
ENDIF
|
|
lcTargetFileName = LOWER(FULLPATH(lcSourceFileName+lcExt))
|
|
IF FILE(lcTargetFileName)
|
|
EXIT
|
|
ELSE
|
|
lcTargetFileName = ""
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
ENDIF
|
|
|
|
IF EMPTY(lcTargetFileName) AND NOT tlSuppressMessage
|
|
THIS.FileNotFoundMsgBox(tcSourceFileName)
|
|
ENDIF
|
|
|
|
RETURN lcTargetFileName
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE getuseroptionsetting && Takes option name and array (usually aCurrentUserOpts) and returns current value for that option, NULL if not found.
|
|
LPARAMETERS tcOption,taOptionArray
|
|
|
|
IF VARTYPE(tcOption) # "C"
|
|
RETURN .NULL.
|
|
ENDIF
|
|
|
|
IF PCOUNT() = 2 AND TYPE("taOptionArray[1,1]") # "C"
|
|
RETURN .NULL.
|
|
ENDIF
|
|
|
|
LOCAL liElement, liRow, llExactSet
|
|
LOCAL ARRAY laTemp[1]
|
|
|
|
IF PCOUNT() = 2
|
|
ACOPY(taOptionArray,laTemp)
|
|
ELSE
|
|
ACOPY(THIS.aCurrentUserOpts,laTemp)
|
|
ENDIF
|
|
|
|
llExactSet = (SET("EXACT") = "OFF")
|
|
IF llExactSet
|
|
SET EXACT ON
|
|
ENDIF
|
|
|
|
liELEMENT = ASCAN(laTemp,tcOption)
|
|
|
|
IF llExactSet
|
|
SET EXACT OFF
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(liElement)
|
|
liRow = ASUBSCRIPT(laTemp,liElement,1)
|
|
RETURN laTemp[liRow,2]
|
|
ELSE
|
|
RETURN .NULL.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE gobottom && Wraps cusTableNav member's GoBottom() method.
|
|
THIS.lNoInterrupt = .T.
|
|
THIS.cusTableNav.GoBottom()
|
|
THIS.lNoInterrupt = .F.
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE gonext && Wraps cusTableNav member's GoNext() method.
|
|
THIS.lNoInterrupt = .T.
|
|
THIS.cusTableNav.GoNext()
|
|
THIS.lNoInterrupt = .F.
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE goprevious && Wraps cusTableNav member's GoPrevious() method.
|
|
THIS.lNoInterrupt = .T.
|
|
THIS.cusTableNav.GoPrevious()
|
|
THIS.lNoInterrupt = .F.
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE gotop && Wraps cusTableNav member's GoTop() method.
|
|
THIS.lNoInterrupt = .T.
|
|
THIS.cusTableNav.GoTop()
|
|
THIS.lNoInterrupt = .F.
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE gotorecord && Wraps cusTableNav member's GoToRecord() method.
|
|
LPARAMETERS tiRecord
|
|
THIS.lNoInterrupt = .T.
|
|
THIS.cusTableNav.GoToRecord(tiRecord)
|
|
THIS.lNoInterrupt = .F.
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE handleprojectwindow && Hides a project with the name stored in THIS.cProjectName on startup, if it is showing, and restores it when the app object Destroys.
|
|
LPARAMETERS tlShow
|
|
|
|
IF VARTYPE(THIS.cProjectName) = "C" AND ;
|
|
NOT EMPTY(THIS.cProjectName) AND ;
|
|
WEXIST( APP_PM_WIN_TITLE_LOC +THIS.cProjectName)
|
|
|
|
DO CASE
|
|
|
|
CASE tlShow AND (NOT WVISIBLE( APP_PM_WIN_TITLE_LOC +THIS.cProjectName))
|
|
|
|
SHOW WINDOW ( APP_PM_WIN_TITLE_LOC +THIS.cProjectName)
|
|
|
|
CASE tlShow
|
|
|
|
* no problem
|
|
|
|
OTHERWISE
|
|
|
|
HIDE WINDOW ( APP_PM_WIN_TITLE_LOC +THIS.cProjectName)
|
|
|
|
ENDCASE
|
|
|
|
ELSE
|
|
|
|
THIS.cProjectName = ""
|
|
* prevent SHOWing it later
|
|
* if we aren't responsible for HIDEing it
|
|
* at this point, even if it does exist
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE iinitialtoolbarposition_assign
|
|
LPARAMETERS tiNewVal
|
|
IF VARTYPE(tiNewVal) # "N" OR NOT INLIST(tiNewVal,-1,0,1,2,3)
|
|
THIS.iInitialToolbarPosition = 0
|
|
ELSE
|
|
THIS.iInitialToolbarPosition = tiNewVal
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ilasterror_access
|
|
RETURN THIS.ilasterror
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE Init
|
|
IF NOT DODEFAULT()
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
THIS.cIcon = THIS.GetResourceFileName(THIS.cIcon, ".ico", .T.)
|
|
THIS.cImage = THIS.GetResourceFileName(THIS.cImage, ".bmp .ico .gif", .T.)
|
|
|
|
IF VARTYPE(THIS.cReference) = "C" AND (NOT EMPTY(THIS.cReference))
|
|
THIS.cReference = THIS.cReference
|
|
ENDIF
|
|
|
|
IF NOT THIS.SetAppFileNames()
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF VERSION(2) = 0 AND _VFP.StartMode = 4 AND ;
|
|
UPPER(THIS.cClassContainerFileName) == UPPER(THIS.cAppFileName)
|
|
* if the running EXE is this file, and this file
|
|
* is not set up to be Read Events, make it Read Events anyway.
|
|
THIS.lReadEvents = .T.
|
|
ENDIF
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE instantiate && RETURNs object reference -- pass classname, classlib, APP/EXE if library is external, string of delimited parameters to be macro-executed. If being added as a member, also pass container ref plus membername if it's not OK to use unique/generated name.
|
|
LPARAMETERS tcClass, tcClassLib, tcClassContainerFileName, ;
|
|
tcParamString, toParent, tcMemberName
|
|
|
|
*&* new third param for IN support
|
|
*&* will default to "" for ReadEvents, THIS.cClassContainerFileName
|
|
*&* for non-ReadEvents...
|
|
|
|
LOCAL loReturn, lcMemberName, lcClass, lcClassLib, lcContainer
|
|
|
|
ASSERT VARTYPE(tcClass) = "C" AND (NOT EMPTY(tcClass))
|
|
ASSERT EMPTY(tcClassLib) OR VARTYPE(tcClassLib) = "C"
|
|
ASSERT EMPTY(tcClassContainerFileName) OR ;
|
|
(VARTYPE(tcClassContainerFileName) = "C" AND ;
|
|
NOT EMPTY(SYS(2000,FULLPATH(tcClassContainerFileName))))
|
|
ASSERT EMPTY(tcParamString) OR VARTYPE(tcParamString) = "C"
|
|
ASSERT VARTYPE(toParent) = "O" OR EMPTY(toParent)
|
|
ASSERT EMPTY(tcMemberName) OR VARTYPE(tcMemberName) = "C"
|
|
|
|
lcClass = ALLTRIM(tcClass)
|
|
|
|
DO CASE
|
|
|
|
CASE VARTYPE(tcClassLib) # "C"
|
|
* default library is the app object's
|
|
lcClassLib = THIS.ClassLibrary
|
|
lcContainer = THIS.cClassContainerFileName
|
|
CASE EMPTY(tcClassLib)
|
|
* somebody has already SET CLASSLIB
|
|
* and passed a null string to indicate this
|
|
lcClassLib = ""
|
|
lcContainer = ""
|
|
OTHERWISE
|
|
lcClassLib = ALLTRIM(tcClassLib)
|
|
IF VARTYPE(tcClassContainerFileName) = "C"
|
|
lcContainer = ALLTRIM(tcClassContainerFileName)
|
|
ELSE
|
|
IF EMPTY(SYS(2000,lcClassLib)) AND ;
|
|
EMPTY(SYS(2000,lcClassLib+".VCX"))
|
|
* not on disk, gotta find it somewhere...
|
|
* like the product, we are assuming
|
|
* that if the extension isn't used
|
|
* it's a VCX, not a PRG/FXP
|
|
lcContainer = THIS.cClassContainerFileName
|
|
ELSE
|
|
* found it!
|
|
lcContainer = ""
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ENDCASE
|
|
|
|
loReturn = .NULL.
|
|
|
|
lcClassLib = THIS.GetResourceFileName(lcClassLib,".vcx .fxp .prg")
|
|
|
|
IF NOT EMPTY(lcContainer)
|
|
lcContainer = THIS.GetResourceFileName(lcContainer,".app .exe")
|
|
ENDIF
|
|
|
|
IF (EMPTY(lcClassLib) AND NOT EMPTY(tcClassLib)) OR ;
|
|
(EMPTY(lcContainer) AND NOT EMPTY(tcClassContainerFileName))
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF VERSION(2) = 0 AND ;
|
|
UPPER(JUSTEXT(lcClassLib)) == "PRG"
|
|
IF NOT EMPTY(SYS(2000,lcClassLib))
|
|
* file is on disk for sure, and
|
|
* we can't use it if it is built into
|
|
* another file like this...
|
|
lcContainer = ""
|
|
COMPILE (lcClassLib)
|
|
lcClassLib = FORCEEXT(lcClassLib,"FXP")
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF VARTYPE(toParent) = "O"
|
|
IF VARTYPE(tcMemberName)= "C"
|
|
lcMemberName = tcMemberName
|
|
ELSE
|
|
lcMemberName = "C"+SYS(2015)
|
|
ENDIF
|
|
ASSERT TYPE("toParent."+lcMemberName) # "O" ;
|
|
MESSAGE toParent.&lcMemberName..Name + " "+APP_ALREADY_EXISTS_LOC+"."
|
|
THIS.ClearLastError()
|
|
IF EMPTY(tcParamString)
|
|
toParent.NewObject(lcMemberName,lcClass,lcClassLib,lcContainer)
|
|
ELSE
|
|
toParent.NewObject(lcMemberName,lcClass,lcClassLib,lcContainer,&tcParamString.)
|
|
ENDIF
|
|
IF THIS.IsErrorFree()
|
|
loReturn = EVAL("toParent."+lcMemberName)
|
|
ENDIF
|
|
ELSE
|
|
IF EMPTY(tcParamString)
|
|
loReturn = NEWOBJECT(lcClass,lcClassLib,lcContainer)
|
|
ELSE
|
|
loReturn = NEWOBJECT(lcClass,lcClassLib, lcContainer,&tcParamString.)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN loReturn
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE iserrorfree && RETURNs ISNULL(THIS.iLastError) -- See THIS.ClearLastError().
|
|
RETURN (ISNULL(THIS.iLastError))
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE lgomenu_assign
|
|
LPARAMETERS tlGoMenuNeeded
|
|
|
|
IF EMPTY(THIS.cGoMenuFile)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
DO CASE
|
|
CASE tlGoMenuNeeded = THIS.lGoMenu
|
|
* nothing to worry about
|
|
|
|
CASE tlGoMenuNeeded
|
|
THIS.lGoMenu = .T.
|
|
IF TYPE([CNTBAR("_mGo")]) = "U"
|
|
DO CASE
|
|
CASE VARTYPE(THIS.oFrame) # "O"
|
|
THIS.DoMenu(THIS.cGoMenuFile)
|
|
CASE NOT EMPTY(THIS.oFrame.cMenuName)
|
|
THIS.DoMenu(THIS.cGoMenuFile, .F.)
|
|
OTHERWISE
|
|
ENDCASE
|
|
ELSE
|
|
* already defined, just show the pad
|
|
DO CASE
|
|
CASE VARTYPE(THIS.oFrame) # "O"
|
|
DEFINE PAD _msm_Go OF _MSYSMENU ;
|
|
PROMPT APP_GO_PAD_LOC COLOR SCHEME 3 ;
|
|
BEFORE _msm_windo ;
|
|
KEY APP_GO_PAD_HOTKEY_LOC, [APP_GO_PAD_HOTKEY_LOC] ;
|
|
MESSAGE APP_GO_MESSAGE_LOC
|
|
ON PAD _msm_Go OF _MSYSMENU ACTIVATE POPUP _mgo
|
|
|
|
|
|
CASE NOT EMPTY(THIS.oFrame.cMenuName)
|
|
|
|
DEFINE PAD _msm_Go OF (THIS.oFrame.cMenuName);
|
|
PROMPT APP_GO_PAD_LOC COLOR SCHEME 3 ;
|
|
BEFORE _msm_windo ;
|
|
KEY APP_GO_PAD_HOTKEY_LOC, [APP_GO_PAD_HOTKEY_LOC]
|
|
|
|
ON PAD _msm_Go OF (THIS.oFrame.cMenuName) ACTIVATE POPUP _mgo
|
|
|
|
OTHERWISE
|
|
|
|
ENDCASE
|
|
ENDIF
|
|
|
|
OTHERWISE
|
|
THIS.lGoMenu = .F.
|
|
* for now, I am not putting menu shortcut keys on the
|
|
* popup and I am just leaving it DEFINEd and inaccessible
|
|
* for speed reasons -- so am not releasing it once defined
|
|
DO CASE
|
|
CASE VARTYPE(THIS.oFrame) # "O"
|
|
RELEASE PAD _msm_Go OF _MSYSMENU
|
|
* RELEASE POPUP _mGo EXTENDED
|
|
CASE NOT EMPTY(THIS.oFrame.cMenuName)
|
|
RELEASE PAD _msm_Go OF (THIS.oFrame.cMenuName)
|
|
* RELEASE POPUP _mGo EXTENDED
|
|
OTHERWISE
|
|
ENDCASE
|
|
|
|
ENDCASE
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE lnavtoolbar_assign
|
|
LPARAMETERS tlNavToolbarNeeded
|
|
|
|
IF EMPTY(THIS.cNavToolbarClass)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
DO CASE
|
|
CASE tlNavToolbarNeeded = THIS.lNavToolbar
|
|
THIS.lNavToolbar = tlNavToolbarNeeded
|
|
* nothing to worry about
|
|
CASE tlNavToolbarNeeded
|
|
THIS.lNavToolbar = .T.
|
|
IF VARTYPE(THIS.oNavToolbar) # "O"
|
|
LOCAL liIndex
|
|
liIndex = THIS.DoToolbar(THIS.cNavToolbarClassLib,THIS.cNavToolbarClass)
|
|
THIS.oNavToolbar = THIS.aToolbars[liIndex,1]
|
|
ELSE
|
|
IF NOT THIS.oNavToolBar.Visible
|
|
THIS.oNavToolbar.Show()
|
|
ENDIF
|
|
ENDIF
|
|
OTHERWISE
|
|
THIS.lNavToolbar = .F.
|
|
IF (VARTYPE(THIS.oNavToolbar)= "O") AND THIS.oNavToolbar.Visible
|
|
THIS.oNavToolbar.Hide()
|
|
ENDIF
|
|
ENDCASE
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE lnointerrupt_assign
|
|
LPARAMETERS tvNewVal
|
|
|
|
IF VARTYPE(tvNewVal) = "L" AND ;
|
|
tvNewVal # THIS.lNoInterrupt
|
|
|
|
WITH THIS.tmrRefresh
|
|
IF tvNewVal
|
|
.Interval = 0
|
|
ELSE
|
|
.Interval = .iRegularInterval
|
|
ENDIF
|
|
ENDWITH
|
|
THIS.lNoInterrupt = tvNewVal
|
|
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE lusercanchangepassword_access
|
|
*To do: Modify this routine for the Access method
|
|
RETURN THIS.lusercanchangepassword
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE lusercanchangepassword_assign
|
|
LPARAMETERS m.vNewVal
|
|
*To do: Modify this routine for the Assign method
|
|
THIS.lusercanchangepassword = m.vNewVal
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE onshutdown && Occurs when the user attempts to exit Visual FoxPro by pressing _SCREEN close button or the close button on a framework top form MDI frame.
|
|
LPARAMETERS tlCalledFromTopForm
|
|
|
|
LOCAL llReturn, llInterrupted
|
|
|
|
DO CASE
|
|
CASE INLIST(_VFP.StartMode,1,2,3,5)
|
|
* we really shouldn't be here at all
|
|
llReturn = .T.
|
|
CASE TYPE("_SCREEN.ActiveForm.Parent") = "O" AND ;
|
|
_SCREEN.ActiveForm.Parent.WindowType = 1 && modal
|
|
* formset overrides form on this one
|
|
?? CHR(7)
|
|
CASE TYPE("_SCREEN.ActiveForm") = "O" AND ;
|
|
_SCREEN.ActiveForm.WindowType = 1
|
|
?? CHR(7)
|
|
OTHERWISE
|
|
llReturn = .T.
|
|
ENDCASE
|
|
|
|
IF llReturn
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
llReturn = (INLIST(_VFP.StartMode,1,2,3,5) OR ;
|
|
(MESSAGEBOX(APP_READY_TO_SHUTDOWN_LOC, ;
|
|
MB_YESNO+MB_ICONQUESTION, ;
|
|
THIS.cCaption)= IDYES))
|
|
IF llReturn
|
|
llReturn = THIS.ReleaseForms()
|
|
ENDIF
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
IF llReturn
|
|
IF NOT tlCalledFromTopForm
|
|
THIS.Release()
|
|
QUIT
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE purgeerrorlog && Zaps current error log with appropriate confirmation and checks.
|
|
LOCAL lcTable, liSelect, lcAlias, llSafety
|
|
|
|
|
|
|
|
lcTable = THIS.cErrorLogTableName
|
|
IF EMPTY(lcTable) OR NOT FILE(lcTable)
|
|
MESSAGEBOX(ERRORVIEWER_UNAVAILABLE_LOC,MB_ICONINFORMATION,THIS.cCaption)
|
|
RETURN
|
|
ENDIF
|
|
THIS.ClearLastError()
|
|
THIS.lSkipErrorHandling = .T.
|
|
liSelect = SELECT()
|
|
lcAlias = "E"+SYS(2015)
|
|
USE (lcTable) ALIAS (lcAlias) EXCLUSIVE IN 0
|
|
THIS.lSkipErrorHandling = .F.
|
|
|
|
IF (NOT THIS.IsErrorFree()) OR (NOT USED(lcAlias))
|
|
THIS.ClearLastError()
|
|
MESSAGEBOX(ERRORVIEWER_IN_USE_LOC,MB_ICONSTOP,THIS.cCaption)
|
|
IF USED(lcAlias)
|
|
USE IN (lcAlias)
|
|
ENDIF
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF NOT (RECCOUNT(lcAlias) = 0)
|
|
|
|
llSafety = SET("SAFETY") = "OFF"
|
|
IF llSafety
|
|
SET SAFETY ON
|
|
ENDIF
|
|
|
|
SELECT (lcAlias)
|
|
ZAP
|
|
SELECT (liSelect)
|
|
|
|
IF llSafety
|
|
SET SAFETY OFF
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
IF (RECCOUNT(lcAlias) = 0)
|
|
MESSAGEBOX(ERRORVIEWER_EMPTY_LOC,MB_ICONINFORMATION,THIS.cCaption)
|
|
ENDIF
|
|
|
|
USE IN (lcAlias)
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE querydatachanged && Wraps cusDataSession member's DataChanged() method.
|
|
LPARAMETERS toSession, tiChangeMode
|
|
LOCAL llReturn, llInterrupted
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
llReturn = THIS.cusDataSession.DataChanged(toSession,tiChangeMode)
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE querydatasessionunload && Wraps cusDataSession member's Queryunload() method.
|
|
LPARAMETERS tlDataChangeAlreadyConfirmed, toSession
|
|
|
|
ASSERT VARTYPE(tlDataChangeAlreadyConfirmed) = "L"
|
|
ASSERT TYPE("toSession.DataSessionID") = "N" OR ;
|
|
TYPE("_SCREEN.ActiveForm") = "O"
|
|
|
|
LOCAL llDataHandled, loSession, llInterrupted
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
IF TYPE("toSession.DataSessionID") = "N"
|
|
loSession = toSession
|
|
ELSE
|
|
loSession = _SCREEN.ActiveForm
|
|
ENDIF
|
|
|
|
IF tlDataChangeAlreadyConfirmed OR ;
|
|
THIS.cusDataSession.DataChanged(loSession)
|
|
|
|
llDataHandled = ;
|
|
THIS.cusDataSession.QueryUnload(.t., loSession)
|
|
|
|
ELSE
|
|
|
|
llDataHandled = .T.
|
|
|
|
ENDIF
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
RETURN llDataHandled
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE readevents && Starts read events mode.
|
|
THIS.ClearLastError()
|
|
IF THIS.lReadEvents
|
|
READ EVENTS
|
|
ENDIF
|
|
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE refreshfavoritepopup && DEFINEs BARs for Favorites menu popup using THIS.cCurrentUserFavoriteIDs.
|
|
IF (NOT THIS.lFavorites) OR ;
|
|
TYPE("CNTBAR(THIS.cFavoritePopupName)") # "N"
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
LOCAL lcThisRef, lcStatement, lcFavoriteID, ;
|
|
liBarNo, lcAlias, liSelect, laFavorites[1]
|
|
|
|
lcThisRef = THIS.cReference
|
|
|
|
* release all but top bars:
|
|
FOR liBarNo = 4 TO CNTBAR(THIS.cFavoritePopupName)
|
|
RELEASE BAR liBarNo OF (THIS.cFavoritePopupName)
|
|
ENDFOR
|
|
|
|
liBarNo = 3
|
|
|
|
* open metatable
|
|
THIS.ClearLastError()
|
|
|
|
IF NOT EMPTY(THIS.cMetaTable)
|
|
lcAlias = "M"+SYS(2015)
|
|
USE (THIS.cMetaTable) ALIAS (lcAlias) AGAIN SHARED IN 0
|
|
ENDIF
|
|
|
|
IF NOT (THIS.IsErrorFree())
|
|
SET SKIP OF BAR 1 OF (THIS.cFavoritePopupName) .T.
|
|
SET SKIP OF BAR 2 OF (THIS.cFavoritePopupName) .T.
|
|
RETURN
|
|
ENDIF
|
|
|
|
liSelect = SELECT()
|
|
IF NOT EMPTY(lcAlias)
|
|
SELECT (lcAlias)
|
|
ENDIF
|
|
|
|
* now add rest of bars:
|
|
IF NOT EMPTY(THIS.cCurrentUserFavoriteIDs)
|
|
|
|
ALINES(laFavorites,THIS.cCurrentUserFavoriteIDs,.T.)
|
|
STORE "" TO lcFavoriteID, lcStatement
|
|
FOR EACH lcFavoriteID IN laFavorites
|
|
IF NOT EMPTY(lcFavoriteID)
|
|
lcFavoriteID = UPPER(ALLTR(lcFavoriteID))
|
|
lcStatement = ""
|
|
IF FILE(lcFavoriteID)
|
|
liBarNo = liBarNo + 1
|
|
DEFINE BAR liBarNo OF (THIS.cFavoritePopupName) ;
|
|
PROMPT lcFavoriteID
|
|
lcStatement = lcThisRef+"."
|
|
lcStatement = lcStatement+"DoFile"
|
|
lcStatement = lcStatement + "(["+lcFavoriteID+"])"
|
|
ELSE
|
|
IF NOT EMPTY(lcAlias) AND ;
|
|
THIS.SeekMetaTableFavoriteID(lcFavoriteID,lcAlias)
|
|
liBarNo = liBarNo + 1
|
|
DEFINE BAR liBarNo OF (THIS.cFavoritePopupName) ;
|
|
PROMPT ALLTR(Doc_Descr)
|
|
|
|
DO CASE
|
|
CASE NOT EMPTY(Alt_Exec)
|
|
lcStatement = ALLTRIM(Alt_Exec)
|
|
CASE Doc_Wrap
|
|
lcStatement = "DO (["+ ALLTRIM(Doc_Exec)+"])"
|
|
CASE Doc_Type = PJX_META_DOC_REPORT_TYPE
|
|
lcStatement = lcThisRef+".DoReport(["+;
|
|
ALLTRIM(Doc_Exec)+"],["+ ;
|
|
ALLTRIM(Doc_Descr)+"])"
|
|
CASE Doc_Type = PJX_META_DOC_FORM_TYPE
|
|
lcStatement = lcThisRef+".DoForm(["+ ;
|
|
ALLTRIM(Doc_Exec)+"],["+ ;
|
|
ALLTRIM(Doc_Class)+"],"+;
|
|
IIF(Doc_Single,".T.,",".F.,")+;
|
|
IIF(Doc_NoShow,".T.,",".F.,")+;
|
|
IIF(Doc_Go,".T.,",".F.,")+;
|
|
IIF(Doc_Nav,".T.",".F.")+")"
|
|
OTHERWISE
|
|
* ... ?
|
|
ENDCASE
|
|
ENDIF
|
|
ENDIF
|
|
IF NOT EMPTY(lcStatement)
|
|
ON SELECTION BAR liBarNo OF ;
|
|
(THIS.cFavoritePopupName) &lcStatement
|
|
ENDIF
|
|
ENDIF
|
|
ENDFOR
|
|
ENDIF
|
|
|
|
* no possible docs? got all possible docs as favorites? didn't get any favorites?
|
|
* the first two possibilities are no longer possible <g>, since
|
|
* we allow GETFILE() picking of favorites...
|
|
* however it's still possible not to be able to clear any favorites
|
|
* because there are none saved
|
|
SET SKIP OF BAR 2 OF (THIS.cFavoritePopupName) (liBarNo = 3)
|
|
|
|
IF NOT EMPTY(lcAlias)
|
|
USE IN (lcAlias)
|
|
ENDIF
|
|
SELECT (liSelect)
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE refreshformscollection && Refresh forms collection arrays and counters.
|
|
LOCAL lnCount,lnCount2
|
|
THIS.ClearLastError()
|
|
lnCount=1
|
|
DO WHILE lnCount<=THIS.nFormCount
|
|
IF VARTYPE(THIS.aForms[lnCount])="O"
|
|
lnCount=lnCount+1
|
|
LOOP
|
|
ENDIF
|
|
FOR lnCount2 = lnCount TO (THIS.nFormCount-1)
|
|
THIS.aForms[lnCount2]=THIS.aForms[lnCount2+1]
|
|
THIS.aForms[lnCount2+1]=.NULL.
|
|
THIS.aFormNames[lnCount2]=THIS.aFormNames[lnCount2+1]
|
|
THIS.aFormNames[lnCount2+1]=""
|
|
ENDFOR
|
|
THIS.nFormCount=THIS.nFormCount-1
|
|
IF THIS.nFormCount=0
|
|
EXIT
|
|
ENDIF
|
|
DIMENSION THIS.aForms[THIS.nFormCount],THIS.aFormNames[THIS.nFormCount]
|
|
ENDDO
|
|
IF THIS.nFormCount=0
|
|
THIS.ResetFormsCollection
|
|
ENDIF
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE refreshtoolbars && Called by member timer and at any other time you need to synch toolbars to current environment. Iterates through toolbar collection calling Refresh methods so that it doesn't assume any tbr class.
|
|
IF THIS.lNoInterrupt
|
|
* shouldn't happen
|
|
RETURN
|
|
ENDIF
|
|
|
|
LOCAL loToolbar
|
|
FOR EACH loToolbar IN THIS.aToolbars
|
|
IF VARTYPE(loToolbar) = "O"
|
|
loToolbar.Refresh
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release
|
|
LPARAMETERS tlForce
|
|
|
|
|
|
IF NOT THIS.ReleaseSessions(tlForce)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF NOT THIS.ReleaseForms(tlForce)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
THIS.lNoInterrupt = .T.
|
|
THIS.ReleaseContextMenus(tlForce)
|
|
THIS.ReleaseToolbars(tlForce)
|
|
THIS.ReleaseCollaborators()
|
|
THIS.ReleaseFrame()
|
|
THIS.ClearEvents()
|
|
|
|
|
|
RELEASE THIS
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releasecollaborators && Manages release of collaborative objects
|
|
THIS.ClearLastError()
|
|
|
|
LOCAL liMemberIndex, loMember
|
|
FOR liMemberIndex = 1 TO ALEN(THIS.aCollaborators)
|
|
loMember = THIS.aCollaborators[liMemberIndex]
|
|
IF VARTYPE(loMember) = "O"
|
|
IF TYPE("loMember.Parent") = "O"
|
|
loMember.Parent.RemoveObject(loMember.Name)
|
|
ELSE
|
|
* otherwise it was just done with a CREATEOBJECT,
|
|
IF PEMSTATUS(loMember,"Release",5)
|
|
loMember.Release()
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
* the following should get rid of the object, if any:
|
|
loMember = NULL
|
|
THIS.aCollaborators[liMemberIndex] = NULL
|
|
ENDFOR
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releasecontextmenu && Manages release of a single context menu and the context menu collection.
|
|
LPARAMETERS tiMenuIndex, tlForce
|
|
|
|
ASSERT VARTYPE(tiMenuIndex) = "N" AND ;
|
|
BETWEEN(tiMenuIndex,1,ALEN(THIS.aContextMenus,1))
|
|
|
|
ASSERT VARTYPE(tlForce) = "L"
|
|
|
|
* this function expects an index from the context menu array.
|
|
* see comments in the ReleaseToolbar method.
|
|
|
|
THIS.ClearLastError()
|
|
|
|
IF PCOUNT()=0 OR EMPTY(tiMenuIndex)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
LOCAL liCurrentMenuRefCount
|
|
|
|
IF VARTYPE(THIS.aContextMenus[tiMenuIndex,2]) # "N"
|
|
liCurrentMenuRefCount = 0
|
|
ELSE
|
|
liCurrentMenuRefCount = THIS.aContextMenus[tiMenuIndex,2]
|
|
ENDIF
|
|
|
|
IF tlForce OR liCurrentMenuRefCount <= 1
|
|
IF VARTYPE(THIS.oFrame) # "O"
|
|
RELEASE PAD (THIS.aContextMenus[tiMenuIndex,3]) OF _MSYSMENU
|
|
ELSE
|
|
RELEASE PAD (THIS.aContextMenus[tiMenuIndex,3]) OF (THIS.oFrame.cMenuName)
|
|
ENDIF
|
|
RELEASE POPUP (THIS.aContextMenus[tiMenuIndex,4]) EXTENDED
|
|
STORE .F. TO THIS.aContextMenus[tiMenuIndex,1], ;
|
|
THIS.aContextMenus[tiMenuIndex,2], ;
|
|
THIS.aContextMenus[tiMenuIndex,3], ;
|
|
THIS.aContextMenus[tiMenuIndex,4]
|
|
ELSE
|
|
THIS.aContextMenus[tiMenuIndex,2] = liCurrentMenuRefCount - 1
|
|
ENDIF
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releasecontextmenus && Releases all context menus.
|
|
LPARAMETERS tlForce
|
|
LOCAL liMenu, liMenuCount
|
|
|
|
THIS.ClearLastError()
|
|
|
|
liMenuCount = ALEN(THIS.aContextMenus,1)
|
|
|
|
FOR liMenu = 1 TO liMenuCount
|
|
IF VARTYPE(THIS.aContextMenus[liMenu,1]) = "C" AND ;
|
|
NOT THIS.ReleaseContextMenu(liMenu, .T.)
|
|
IF NOT tlForce
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
ENDFOR
|
|
RELEASE POPUP _mGo EXTENDED
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseform && Release specific or active form and manages forms collection.
|
|
LPARAMETERS toForm
|
|
|
|
THIS.ClearLastError()
|
|
|
|
IF PCOUNT()=0
|
|
IF TYPE("_SCREEN.ActiveForm")= "O"
|
|
_SCREEN.ActiveForm.Release()
|
|
ENDIF
|
|
ELSE
|
|
IF VARTYPE(toForm)="O"
|
|
toForm.Release()
|
|
ENDIF
|
|
ENDIF
|
|
THIS.RefreshFormsCollection
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseforms && Release all application forms from memory and the forms collection.
|
|
LPARAMETERS tlForce
|
|
|
|
LOCAL lnFormCount
|
|
|
|
THIS.RefreshFormsCollection
|
|
|
|
IF THIS.nFormCount = 0
|
|
RETURN
|
|
ENDIF
|
|
|
|
LOCAL loForm, loMemberForm, liResult, llInterrupted
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
FOR EACH loForm IN THIS.aForms
|
|
|
|
IF VARTYPE(loForm) # "O" OR ;
|
|
NOT INLIST("#"+UPPER(loForm.BaseClass)+"#","#FORMSET#","#FORM#")
|
|
LOOP
|
|
ENDIF
|
|
|
|
IF tlForce
|
|
THIS.DataRevert(.T.,.F.,loForm,.T.)
|
|
ELSE
|
|
IF NOT THIS.QueryDataSessionUnload(.F.,loForm)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ENDFOR
|
|
|
|
|
|
* only once they have confirmed all possible dataupdating/cancelling
|
|
* out of the process can we begin to actually close forms.
|
|
|
|
DO WHILE THIS.nFormCount>0
|
|
|
|
lnFormCount=THIS.nFormCount
|
|
THIS.ReleaseForm(THIS.aForms[lnFormCount])
|
|
IF THIS.nFormCount=lnFormCount
|
|
IF NOT tlForce
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseframe && Releases top form/MDI frame.
|
|
IF VARTYPE(THIS.oFrame) = "O"
|
|
THIS.oFrame.oApp = .NULL.
|
|
THIS.oFrame.Release()
|
|
THIS.oFrame = .NULL.
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE releasesessions && Releases all mediated datasession collaborator objects
|
|
LPARAMETERS tlForce
|
|
|
|
LOCAL loCollaborator, liMemberIndex, llInterrupted
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
FOR EACH loCollaborator IN THIS.aCollaborators
|
|
|
|
IF VARTYPE(loCollaborator) # "O" ;
|
|
OR NOT PEMSTATUS(loCollaborator,"DataSessionID",5)
|
|
LOOP
|
|
ENDIF
|
|
|
|
IF tlForce
|
|
THIS.DataRevert(.T.,.F.,loCollaborator)
|
|
ELSE
|
|
DO CASE
|
|
CASE THIS.iQueryUnloadResultForNonVisualSessions = 0
|
|
THIS.DataRevert(.T.,.F.,loCollaborator)
|
|
CASE THIS.iQueryUnloadResultForNonVisualSessions = 1
|
|
THIS.DataUpdate(.T.,.F.,loCollaborator)
|
|
OTHERWISE
|
|
IF NOT THIS.QueryDataSessionUnload(.F.,loCollaborator)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDCASE
|
|
ENDIF
|
|
|
|
ENDFOR
|
|
|
|
|
|
* only once they have confirmed all possible dataupdating/cancelling
|
|
* out of the process do we begin to actually close sessions, just as with forms
|
|
|
|
FOR liMemberIndex = 1 TO ALEN(THIS.aCollaborators)
|
|
|
|
loCollaborator = THIS.aCollaborators[liMemberIndex]
|
|
|
|
IF VARTYPE(loCollaborator) # "O" ;
|
|
OR NOT PEMSTATUS(loCollaborator,"DataSessionID",5)
|
|
LOOP
|
|
ENDIF
|
|
|
|
IF TYPE("loCollaborator.Parent") = "O"
|
|
loCollaborator.Parent.RemoveObject(loCollaborator.Name)
|
|
ELSE
|
|
IF PEMSTATUS(loCollaborator,"Release",5)
|
|
loCollaborator.Release()
|
|
ENDIF
|
|
ENDIF
|
|
loCollaborator = NULL
|
|
THIS.aCollaborators[liMemberIndex] = NULL
|
|
|
|
ENDFOR
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releasetoolbar && Parallel to ReleaseForm. Maintains toolbars collection.
|
|
LPARAMETERS tiToolbarIndex, tlForce
|
|
|
|
ASSERT VARTYPE(tiToolbarIndex) = "N" AND ;
|
|
BETWEEN(tiToolbarIndex,1,ALEN(THIS.aToolbars,1))
|
|
|
|
ASSERT VARTYPE(tlForce) = "L"
|
|
|
|
* this function expects an index from the toolbar array.
|
|
|
|
* The second parameter normally comes from the
|
|
* application releasing all toolbars by ReleaseToolbars()
|
|
* or from some other manager releasing all forms of some
|
|
* particular type, which represent all the "clients" of
|
|
* this toolbar. In either case they would normally
|
|
* use the tlForce parameter.
|
|
|
|
* OTOH you pass can pass the index of the toolbar from
|
|
* a single client of the toolbar, such as a form,
|
|
* which would have kept a record of this reference when it
|
|
* issued an app.dotoolbar() on its load. (DoToolbar returns
|
|
* this index). WHen the form releases it wants
|
|
* to notify the application that it doesn't need the toolbar
|
|
* any more. The client form has no way of knowing
|
|
* how many other clients may be using this toolbar, so tlForce
|
|
* is not used.
|
|
|
|
THIS.ClearLastError()
|
|
|
|
IF PCOUNT()=0 OR EMPTY(tiToolbarIndex)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
LOCAL liCurrentToolbarRefCount
|
|
|
|
IF VARTYPE(THIS.aToolbars[tiToolbarIndex,2]) # "N"
|
|
liCurrentToobarRefCount = 0
|
|
ELSE
|
|
liCurrentToolbarRefCount = THIS.aToolbars[tiToolbarIndex,2]
|
|
ENDIF
|
|
|
|
* toolbars don't have a RELEASE method by default,
|
|
* and I don't want to assume any particular baseclass,
|
|
* which is why I'm using the toolbar collection index
|
|
* instead
|
|
|
|
* release if this is the last reference to this
|
|
* toolbar or if we are releasing all toolbars
|
|
IF tlForce OR liCurrentToolbarRefCount <= 1
|
|
IF VARTYPE(THIS.aToolbars[tiToolbarIndex,1]) = "O"
|
|
THIS.aToolbars[tiToolbarIndex,1].Release()
|
|
ENDIF
|
|
THIS.aToolbars[tiToolbarIndex,1] = .NULL.
|
|
THIS.aToolbars[tiToolbarIndex,2] = 0
|
|
ELSE
|
|
THIS.aToolbars[tiToolbarIndex,2] = liCurrentToolbarRefCount - 1
|
|
ENDIF
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releasetoolbars && Parallel to ReleaseForms. Iterates through toolbar collection
|
|
LPARAMETERS tlForce
|
|
LOCAL liToolbar, liToolbarCount, llInterrupted
|
|
|
|
THIS.ClearLastError()
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
liToolbarCount = ALEN(THIS.aToolbars,1)
|
|
|
|
FOR liToolbar = 1 TO liToolbarCount
|
|
IF VARTYPE(THIS.aToolbars[liToolbar,1]) = "O" AND ;
|
|
NOT THIS.ReleaseToolbar(liToolbar, .T.)
|
|
IF NOT tlForce
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
THIS.oNavToolbar = .NULL. && can't hurt
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE resetformscollection && Reset arrays and counters of forms collection.
|
|
THIS.nFormCount=0
|
|
DIMENSION THIS.aForms[1],THIS.aFormNames[1]
|
|
THIS.aForms=.NULL.
|
|
THIS.aFormNames=""
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE restoreenvironment && Restores environment settings.
|
|
IF THIS.lRestoredEnvironment OR ;
|
|
(NOT THIS.lSavedEnvironment)
|
|
RETURN .T.
|
|
ENDIF
|
|
|
|
THIS.ClearLastError()
|
|
|
|
LOCAL lcTemp
|
|
|
|
IF THIS.lReadEvents
|
|
|
|
lcTemp = THIS.cLastOnShutDown
|
|
ON SHUTDOWN &lcTemp
|
|
|
|
lcTemp = THIS.cLastOnError
|
|
ON ERROR &lcTemp
|
|
|
|
lcTemp = THIS.cLastMacKey
|
|
SET MACKEY TO &lcTemp
|
|
|
|
SET PATH TO (THIS.cLastPath)
|
|
|
|
CD (THIS.cLastDirectory)
|
|
|
|
IF FILE(THIS.cMacroSaveFile)
|
|
CLEAR MACROS && restore macros is additive
|
|
RESTORE MACROS FROM (THIS.cMacroSaveFile)
|
|
ERASE (THIS.cMacroSaveFile) NORECYCLE
|
|
ENDIF
|
|
|
|
IF EMPTY(THIS.cFrameClass) AND (NOT EMPTY(THIS.cStartUpMenu))
|
|
RELEASE MENU _MSYSMENU EXTENDED
|
|
POP MENU _MSYSMENU
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
THIS.lRestoredEnvironment = .T.
|
|
|
|
RETURN THIS.IsErrorFree()
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE saveenvironment && Saves environment settings.
|
|
IF THIS.lReadEvents
|
|
|
|
THIS.cLastOnShutDown = ON("SHUTDOWN")
|
|
THIS.cLastPath = SET("PATH")
|
|
THIS.cLastOnError = ON("ERROR")
|
|
THIS.cLastDirectory = SET("DIRECTORY")
|
|
THIS.cLastMacKey = SET("MACKEY")
|
|
THIS.cMacroSaveFile = THIS.cAppFolder+"M"+SYS(2015)+".FKY"
|
|
THIS.lSkipErrorHandling = .T.
|
|
SAVE MACROS TO (THIS.cMacroSaveFile)
|
|
THIS.lSkipErrorHandling = .F.
|
|
|
|
IF EMPTY(THIS.cFrameClass) AND ;
|
|
(NOT EMPTY(THIS.cStartupMenu))
|
|
|
|
PUSH MENU _MSYSMENU
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
THIS.lSavedEnvironment = .T.
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE seekcurrentuser && This method finds the current user using an exact match (case sensitivity depends on THIS.lUserNameIsCaseSensitive).
|
|
LPARAMETERS tcName
|
|
|
|
* This method is separated out so you can use different
|
|
* user-location strategies (move the record pointer
|
|
* differently) if you like. You will want to
|
|
* change CreateUserTable() to match any changes you make here.
|
|
* The application object expects that whatever table
|
|
* you use, you will have created one c-type field and placed
|
|
* its name in THIS.cUserTableIDField, and one i-type field and
|
|
* placed its name in THIS.iUserTableLevelField.
|
|
|
|
LOCAL llOpenedTable, llSuccess, lcName, llDeletedOff
|
|
|
|
IF VARTYPE(tcName) = "C"
|
|
lcName = tcName
|
|
ELSE
|
|
lcName = THIS.cCurrentUser
|
|
ENDIF
|
|
|
|
IF NOT USED(THIS.cUserTableAlias)
|
|
* Note that ordinarily this method will be called with the
|
|
* user table already opened but it might some time
|
|
* be useful just to validate the current user
|
|
|
|
USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias)
|
|
IF NOT (THIS.IsErrorFree())
|
|
RETURN .F.
|
|
ENDIF
|
|
llOpenedTable = .T.
|
|
ENDIF
|
|
|
|
* this is an exact but case-insensitive match
|
|
|
|
IF SET("DELETED") = "OFF"
|
|
llDeletedOff = .F.
|
|
SET DELETED ON
|
|
ENDIF
|
|
|
|
IF THIS.lUserNameIsCaseSensitive
|
|
llSuccess = SEEK(PADR(ALLTR((lcName)), ;
|
|
LEN(EVAL(THIS.cUserTableAlias+"."+THIS.cUserTableIDField))), ;
|
|
THIS.cUserTableAlias,"ID")
|
|
ELSE
|
|
llSuccess = SEEK(PADR(UPPER(ALLTR((lcName))), ;
|
|
LEN(EVAL(THIS.cUserTableAlias+"."+THIS.cUserTableIDField))), ;
|
|
THIS.cUserTableAlias,"ID_Upper")
|
|
ENDIF
|
|
|
|
IF llDeletedOff
|
|
SET DELETED OFF
|
|
ENDIF
|
|
|
|
IF llOpenedTable
|
|
USE IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
RETURN llSuccess
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE seekdefaultuser && This method finds a record with a blank user name where default options and favorites are stores, for use when defining a new user or when user logins and separate user profiles are not required.
|
|
* this is broken out in case
|
|
* you want a different way of
|
|
* assigning a "default user record"
|
|
* than this one (blank user id field)
|
|
|
|
LOCAL llOpenedTable
|
|
|
|
IF NOT USED(THIS.cUserTableAlias)
|
|
* see notes in SeekCurrentUser()
|
|
USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias)
|
|
IF NOT (THIS.IsErrorFree())
|
|
RETURN .F.
|
|
ENDIF
|
|
llOpenedTable = .T.
|
|
ENDIF
|
|
|
|
IF RECCOUNT(THIS.cUserTableAlias) > 0
|
|
IF NOT THIS.SeekCurrentUser("")
|
|
GO TOP IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
ELSE
|
|
APPEND BLANK IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
IF llOpenedTable
|
|
USE IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE seekmetatablefavoriteid && Finds a record in the meta table using an identification specified in #DEFINE APP_META_FAVE_ID in _FRAMEWK.H. Override this method if you decide to use a more sophisticated method of identifying records in the metatable!
|
|
LPARAMETERS tcFavoriteID,tcAlias
|
|
ASSERT USED(tcAlias)
|
|
ASSERT TYPE("VAL(tcFavoriteID)") = "N"
|
|
|
|
LOCAL liRecID
|
|
|
|
* this is meant to be overridden if you have a better idea!
|
|
* see the #DEFINE APP_META_FAVE_ID for what I'm using
|
|
* here...
|
|
|
|
liRecID = VAL(tcFavoriteID)
|
|
|
|
IF liRecID > 0 AND liRecID <= RECCOUNT(tcAlias)
|
|
GO liRecID IN (tcAlias)
|
|
RETURN (NOT DELETED(tcAlias))
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setappfilenames && Get top-level filename, and also get the name of the module (app or exe) that owns this particular object, for SET CLASSLIB ... IN... default usage, which may be different, especially in modular and non-ReadEvents apps.
|
|
LOCAL lcSys16, liLevel
|
|
lcSys16 = UPPER(SYS(16,0))
|
|
* get top-level filename, and also
|
|
* get the name of the module (app or exe) that
|
|
* owns this particular object, for SET CLASSLIB ... IN...
|
|
* default usage, which may be different.
|
|
* The latter is important to non-READ EVENTS apps.
|
|
IF EMPTY(lcSys16)
|
|
THIS.cAppFileName = ""
|
|
ELSE
|
|
THIS.cAppFileName = lcSys16
|
|
IF "PROCEDURE" $ THIS.cAppFileName
|
|
THIS.cAppFileName = SUBSTR(THIS.cAppFileName,11)
|
|
THIS.cAppFileName = SUBSTR(THIS.cAppFileName,1,AT(" ",THIS.cAppFileName)-1)
|
|
ENDIF
|
|
IF NOT FILE(THIS.cAppFileName)
|
|
* this can happen if an "ON..." was involved...
|
|
THIS.cAppFileName = ""
|
|
ENDIF
|
|
IF INLIST(RIGHT(THIS.cAppFileName,3),"VCT","DCT")
|
|
* createobject from the command window,
|
|
* or a stored procedure --
|
|
* a top-level SCX/FRX/LBX/MPR/QPR/SPR actually has a
|
|
* chance at being used properly later,
|
|
* but I don't think these two do!
|
|
THIS.cAppFileName = ""
|
|
ENDIF
|
|
ENDIF
|
|
|
|
* FOR liLevel = 256 TO 1 STEP -1 && 256 = twice the nested programs currently allowed!
|
|
FOR liLevel = PROGRAM(-1) TO 1 STEP -1
|
|
lcSys16 = UPPER(SYS(16,liLevel))
|
|
IF INLIST(RIGHT(lcSys16,3),"APP","EXE","DLL")
|
|
THIS.cClassContainerFileName = lcSys16
|
|
EXIT
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
RETURN (THIS.IsErrorFree())
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setcurrentuser && Finds the current user and sets up the app to deal with the current user (permissions, options, favorites, and macros may all change per user).
|
|
LPARAMETERS tlChangeUser
|
|
ASSERT VARTYPE(tlChangeUser) = "L"
|
|
LOCAL llOpenedTable, llSuccess
|
|
|
|
THIS.ClearLastError()
|
|
|
|
IF NOT USED(THIS.cUserTableAlias)
|
|
USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias)
|
|
IF NOT (THIS.IsErrorFree())
|
|
RETURN .F.
|
|
ENDIF
|
|
llOpenedTable = .T.
|
|
ENDIF
|
|
|
|
IF THIS.lUserPreferences
|
|
|
|
IF EMPTY(THIS.cCurrentUser) OR tlChangeUser
|
|
llSuccess = THIS.DoUserLogIn()
|
|
ELSE
|
|
llSuccess = THIS.SeekCurrentUser()
|
|
ENDIF
|
|
ELSE
|
|
* we are using a global set of preferences
|
|
* to cover all users
|
|
THIS.SeekDefaultUser()
|
|
llSuccess = .T.
|
|
ENDIF
|
|
|
|
IF llSuccess
|
|
THIS.cCurrentUser = ;
|
|
EVAL(THIS.cUserTableAlias+"."+THIS.cUserTableIDField)
|
|
THIS.iCurrentUserLevel = ;
|
|
EVAL(THIS.cUserTableAlias+"."+THIS.cUserTableLevelField)
|
|
|
|
THIS.SetUserPermissions() && abstract in the base
|
|
|
|
THIS.FillUserOptionsArray()
|
|
THIS.ApplyGlobalUserOptions()
|
|
THIS.SetCurrentUserFavoriteIDs(.NULL.)
|
|
IF THIS.lReadEvents
|
|
THIS.SetMacros()
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF llOpenedTable
|
|
USE IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
RETURN llSuccess
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setcurrentuserfavoriteids && Saves and restores THIS.cCurrentUserFavoriteIDs information to UserFave memo field in user table. This memo field also contains date information, so user can opt to clear favorites list if metatable has changed since user has identified favorites.
|
|
LPARAMETERS tcNewVal
|
|
|
|
LOCAL llOpenedTable, lcMetaTableLastUpdated, lcNewVal, ;
|
|
laFavorites[1], liVal
|
|
|
|
lcNewVal = ""
|
|
|
|
THIS.ClearLastError()
|
|
IF NOT USED(THIS.cUserTableAlias)
|
|
USE (THIS.cUserTableName) ALIAS (THIS.cUserTableAlias) SHARED AGAIN IN 0
|
|
llOpenedTable = .T.
|
|
ENDIF
|
|
|
|
IF THIS.IsErrorFree()
|
|
IF THIS.lUserPreferences
|
|
THIS.SeekCurrentUser()
|
|
ELSE
|
|
THIS.SeekDefaultUser()
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF THIS.IsErrorFree()
|
|
IF VARTYPE(tcNewVal) # "C"
|
|
* assignment to NULL while setting up a new user,
|
|
* or for some other reason improperly initialized, so
|
|
* refresh from the current or default record,
|
|
* checking lupdate and lastrefresh first
|
|
* set to "" if no good, with message
|
|
IF TYPE(THIS.cUserTableAlias+".UserFave") = "M" AND ;
|
|
NOT EMPTY(EVAL(THIS.cUserTableAlias+".UserFave"))
|
|
|
|
IF (ALINES(laFavorites,EVAL(THIS.cUserTableAlias+".UserFave"),.T.) > 1) AND ;
|
|
(TYPE(laFavorites[1])= "N")
|
|
|
|
IF DTOS(LUPDATE(THIS.cUserTableAlias)) # laFavorites[1]
|
|
* the meta table has been edited
|
|
IF (MESSAGEBOX(APP_META_TABLE_CHANGED_LOC, ;
|
|
MB_YESNO+MB_ICONEXCLAMATION, ;
|
|
THIS.cCaption) = IDYES)
|
|
REPLACE (THIS.cUserTableAlias+".UserFave") WITH "" ;
|
|
IN (THIS.cUserTableAlias)
|
|
ELSE
|
|
* change the datestamp so they don't get asked again
|
|
lcNewVal = EVAL(THIS.cUserTableAlias+".UserFave")
|
|
lcNewVal = DTOS(LUPDATE(THIS.cUserTableAlias))+ ;
|
|
SUBSTR(lcNewVal,AT(CHR(13),lcNewVal))
|
|
REPLACE (THIS.cUserTableAlias+".UserFave") WITH lcNewVal ;
|
|
IN (THIS.cUserTableAlias)
|
|
lcNewVal = ""
|
|
ENDIF
|
|
ENDIF
|
|
IF NOT EMPTY(EVAL(THIS.cUserTableAlias+".UserFave"))
|
|
FOR liVal = 2 TO ALEN(laFavorites)
|
|
IF NOT EMPTY(laFavorites[liVal])
|
|
lcNewVal = lcNewVal + CHR(13)+laFavorites[liVal]
|
|
ENDIF
|
|
ENDFOR
|
|
ENDIF
|
|
ELSE
|
|
MESSAGEBOX(APP_USER_FAVES_CORRUPT_LOC, ;
|
|
MB_ICONSTOP, ;
|
|
THIS.cCaption)
|
|
REPLACE (THIS.cUserTableAlias+".UserFave") ;
|
|
WITH "" IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
ENDIF
|
|
ELSE
|
|
* store the new string and the meta table lupdate,
|
|
* back to the current user in the table, or clear the entry
|
|
IF THIS.IsErrorFree()
|
|
IF NOT EMPTY(tcNewVal)
|
|
REPLACE (THIS.cUserTableAlias+".UserFave") ;
|
|
WITH DTOS(LUPDATE(THIS.cUserTableAlias))+ ;
|
|
tcNewVal ;
|
|
IN (THIS.cUserTableAlias)
|
|
lcNewVal = tcNewVal
|
|
ELSE
|
|
REPLACE (THIS.cUserTableAlias+".UserFave") ;
|
|
WITH "" IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
THIS.cCurrentUserFavoriteIDs = lcNewVal
|
|
|
|
IF llOpenedTable
|
|
USE IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
THIS.RefreshFavoritePopup()
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setdatasessionenvironment && Sets a specified data session to a default set of SETs, which you place in the SetDataSessionSets for use by any form or session you want.
|
|
LPARAMETERS tiSessionID
|
|
LOCAL liSessionID
|
|
liThisSessionID = SET("DATASESSION")
|
|
IF VARTYPE(tiSessionID) = "N"
|
|
SET DATASESSION TO (tiSessionID)
|
|
ENDIF
|
|
|
|
THIS.SetDataSessionSets()
|
|
|
|
SET DATASESSION TO (liThisSessionID)
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setdatasessionsets && Contains a default list of data-session-related SETs so you can easily invoke this list within any form or datasesion.
|
|
SET MULTILOCKS ON
|
|
SET TALK OFF
|
|
* ....
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setenvironment && Sets up certain global attributes, such as screen or frame characteristics, ON SHUTDOWN, ON ERROR, and macros for use during the life of the app. Does *nothing* if not a ReadEvents app.
|
|
THIS.ClearLastError()
|
|
|
|
IF THIS.lReadEvents
|
|
|
|
lcTemp = THIS.cReference+".OnShutdown()"
|
|
ON SHUTDOWN &lcTemp
|
|
lcTemp = THIS.cReference+".Error(ERROR(),PROGRAM(),LINENO())"
|
|
ON ERROR &lcTemp
|
|
|
|
IF VARTYPE(THIS.cMacKey) = "C"
|
|
lcTemp = THIS.cMacKey
|
|
SET MACKEY TO &lcTemp
|
|
ELSE
|
|
SET MACKEY TO
|
|
ENDIF
|
|
|
|
CLEAR MACROS
|
|
|
|
ENDIF
|
|
|
|
IF THIS.lNoScreenDuringApp
|
|
|
|
THIS.SetScreenAttributes(.F.)
|
|
|
|
* you always have the option to turn off _SCREEN,
|
|
* in any type of app, although you should use
|
|
* this ability sparingly if you are non-ReadEvents!
|
|
* This ability is placed outside the CASE statement
|
|
* below because the various permutations --
|
|
* readevents top form in a development environment,
|
|
* ActiveDoc from which environment, even a special
|
|
* type of server that you instantiate and "takes over"
|
|
* temporary -- can't really be predicted.
|
|
* Since original state will be restored at cleanup,
|
|
* this isn't a risk, but the option is still .F. by
|
|
* default because you should think before implementing
|
|
* it <g>.
|
|
|
|
ENDIF
|
|
|
|
DO CASE
|
|
|
|
CASE VARTYPE(THIS.oFrame) = "O"
|
|
|
|
THIS.SetFrameAttributes()
|
|
|
|
CASE THIS.lReadEvents AND (NOT THIS.lNoScreenDuringApp)
|
|
|
|
THIS.SetScreenAttributes(.T.)
|
|
|
|
OTHERWISE
|
|
|
|
* hands off!
|
|
|
|
ENDCASE
|
|
|
|
RETURN THIS.IsErrorFree()
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setframeattributes && Applies application cCaption and cIcon to the MDI frame, as well as the appropriate backcolor for an MDI frame window.
|
|
IF VARTYPE(THIS.oFrame) # "O"
|
|
** shouldn't happen
|
|
RETURN
|
|
ENDIF
|
|
|
|
THIS.oFrame.BackColor = THIS.cusWindowHandler.iMDIWorkSpaceColor
|
|
THIS.oFrame.Icon = THIS.cIcon
|
|
THIS.oFrame.Caption = THIS.cCaption
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethtmlclass && Abstract. Takes parameters tcSource (report form or alias/table), tlTable, so you can decide what HTMLClass is appropriate. Passed to GENHTML via _outputdialog attributes.
|
|
LPARAMETERS tcSource, tlTable
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethtmlstyleid && Abstract. Takes parameters tcSource (report form or alias/table), tlTable, so you can decide what HTMLClass is appropriate. Passed to GENHTML via _outputdialog attributes.
|
|
LPARAMETERS tcSource, tlTable
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setmacros && Saves and restores a set of macros using the user table. Synchronizes enabling of bars on the macro-handling popup, using THIS.cMacroPopupName, depending on current set of user macros.
|
|
LPARAMETERS tlSave
|
|
|
|
IF VARTYPE(tlSave) # "L" OR (NOT THIS.lReadEvents)
|
|
RETURN
|
|
ENDIF
|
|
|
|
LOCAL llOpenedTable, liBar, llSuccess
|
|
|
|
THIS.ClearLastError()
|
|
|
|
IF NOT USED(THIS.cUserTableAlias)
|
|
USE (THIS.cUserTableName) ALIAS (THIS.cUserTableAlias) SHARED AGAIN IN 0
|
|
llOpenedTable = .T.
|
|
ENDIF
|
|
|
|
IF THIS.lUserPreferences
|
|
THIS.SeekCurrentUser()
|
|
ELSE
|
|
THIS.SeekDefaultUser()
|
|
ENDIF
|
|
|
|
IF THIS.IsErrorFree()
|
|
|
|
IF TYPE(THIS.cUserTableAlias+".UserMacro") = "M"
|
|
DO CASE
|
|
CASE tlSave
|
|
SAVE MACROS TO MEMO (THIS.cUserTableAlias+".UserMacro")
|
|
llSuccess = .T.
|
|
CASE NOT EMPTY(EVAL(THIS.cUserTableAlias+".UserMacro"))
|
|
llSuccess = .T.
|
|
CLEAR MACROS
|
|
RESTORE MACROS FROM MEMO (THIS.cUserTableAlias+".UserMacro")
|
|
OTHERWISE
|
|
CLEAR MACROS
|
|
* can't restore from empty field
|
|
ENDCASE
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
IF llOpenedTable
|
|
USE IN (THIS.cUserTableAlias)
|
|
ENDIF
|
|
|
|
IF TYPE("CNTBAR(THIS.cMacroPopupName)") = "N"
|
|
FOR liBar = 1 TO CNTBAR(THIS.cMacroPopupName)
|
|
IF UPPER(APP_MACRO_RESTORE_LOC) $ UPPER(BARPROMPT(liBar,THIS.cMacroPopupName))
|
|
SET SKIP OF BAR liBar OF (THIS.cMacroPopupName) (NOT llSuccess)
|
|
EXIT
|
|
ENDIF
|
|
ENDFOR
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setscreenattributes && Sets up screen attributes, including visibility, caption and icon, and system toolbars, for a read events app that does not take place in its own topform MDI frame.
|
|
LPARAMETERS tlOn
|
|
|
|
LOCAL loTemp
|
|
|
|
loTemp = THIS.AddCollaborator("_SysToolbars","_app",,".T.")
|
|
|
|
loTemp = THIS.AddCollaborator("_ObjectState","_app",,"_SCREEN")
|
|
|
|
IF VARTYPE(loTemp) = "O"
|
|
|
|
IF tlOn
|
|
|
|
IF NOT EMPTY(THIS.cCaption)
|
|
|
|
loTemp.Set("Caption", THIS.cCaption, .T.)
|
|
|
|
ENDIF
|
|
|
|
loTemp.Set("Icon",THIS.cIcon, .T.)
|
|
|
|
ENDIF
|
|
|
|
loTemp.Set("Visible",tlOn,.T.)
|
|
|
|
|
|
ELSE
|
|
* this should never happen, but JIC, we'd
|
|
* have a hard time debugging if we didn't do this!
|
|
|
|
IF tlOn AND NOT _SCREEN.Visible
|
|
_SCREEN.Visible = .T.
|
|
ENDIF
|
|
|
|
* notice I don't bother turning it off in the ! tlOn case.
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setuserpermissions && Abstract in the base. Called when a new user logs on. Designed to use iCurrentUserLevel property, derived from user table, to maintain groups. Menu items would be added/substracted/enabled/disabled based on group level at this time.
|
|
* This method is abstract in the base,
|
|
* meant to utilize iCurrentUserLevel property to maintain groups
|
|
ENDPROC
|
|
|
|
PROCEDURE show && Sets up visible aspects of the application and, if successful, Activate()s the application, at startup.
|
|
LOCAL llSuccess
|
|
|
|
llSuccess = THIS.SaveEnvironment()
|
|
|
|
IF llSuccess
|
|
|
|
llSuccess = THIS.ValidateMetaTable()
|
|
|
|
ENDIF
|
|
|
|
IF llSuccess
|
|
|
|
llSuccess = THIS.CreateFrame()
|
|
|
|
ENDIF
|
|
|
|
IF llSuccess AND NOT EMPTY(APP_LOADING_LOC)
|
|
|
|
IF VARTYPE(THIS.oFrame) = "O"
|
|
THIS.oFrame.Show()
|
|
ENDIF
|
|
|
|
WAIT WINDOW NOWAIT ;
|
|
LEFT(APP_LOADING_LOC,254)
|
|
|
|
ENDIF
|
|
|
|
IF llSuccess
|
|
|
|
llSuccess = THIS.ResetFormsCollection()
|
|
|
|
ENDIF
|
|
|
|
IF llSuccess
|
|
|
|
llSuccess = THIS.CreateCollaborators()
|
|
|
|
ENDIF
|
|
|
|
IF llSuccess
|
|
|
|
llSuccess = THIS.HandleProjectWindow()
|
|
|
|
ENDIF
|
|
|
|
IF llSuccess
|
|
|
|
llSuccess = THIS.SetEnvironment()
|
|
|
|
ENDIF
|
|
|
|
IF llSuccess
|
|
|
|
THIS.cUserTableAlias = JUSTSTEM(THIS.cUserTableName)
|
|
llSuccess = NOT EMPTY(THIS.cUserTableAlias)
|
|
|
|
ENDIF
|
|
|
|
IF llSuccess
|
|
|
|
llSuccess = THIS.SetCurrentUser()
|
|
|
|
ENDIF
|
|
|
|
IF llSuccess
|
|
|
|
llSuccess = THIS.ShowStartupElements()
|
|
|
|
ENDIF
|
|
|
|
WAIT CLEAR
|
|
|
|
IF llSuccess
|
|
|
|
llSuccess = THIS.Activate()
|
|
|
|
ENDIF
|
|
|
|
THIS.RestoreEnvironment()
|
|
|
|
RETURN llSuccess
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE showstartupelements && Sets up top form MDI frame, startup menu, startup toolbar, screen attributes, and startup form.
|
|
LOCAL llSuccess
|
|
|
|
THIS.lNoInterrupt = .T.
|
|
|
|
IF VARTYPE(THIS.oFrame) = "O"
|
|
THIS.oFrame.Show()
|
|
ENDIF
|
|
|
|
llSuccess = ;
|
|
(EMPTY(THIS.cStartupToolbarClass) OR ;
|
|
(NOT EMPTY(THIS.DoToolbar( THIS.cStartupToolbarClassLib,THIS.cStartupToolbarClass))) )
|
|
|
|
IF llSuccess AND (NOT EMPTY(THIS.cStartupMenu))
|
|
|
|
DO CASE
|
|
|
|
CASE VARTYPE(THIS.oFrame) = "O"
|
|
|
|
llSuccess = THIS.DoMenu(THIS.cStartupMenu, .T.)
|
|
|
|
CASE THIS.lReadEvents
|
|
|
|
llSuccess = THIS.DoMenu(THIS.cStartupMenu)
|
|
|
|
OTHERWISE
|
|
|
|
* append type
|
|
IF EMPTY(THIS.cStartupMenuPad)
|
|
llSuccess = THIS.DoMenu(THIS.cStartupMenu)
|
|
* it's hard to believe that anybody is going to take over the
|
|
* menu for a non-read-events app, but it could happen
|
|
ELSE
|
|
llSuccess = (NOT EMPTY(THIS.DoContextMenu(THIS.cStartupMenu, ;
|
|
THIS.cStartupMenuPad, ;
|
|
THIS.cStartupMenuPopup)))
|
|
* this one returns a # so we can't do the exact same llSuccess check
|
|
ENDIF
|
|
|
|
ENDCASE
|
|
|
|
ENDIF
|
|
|
|
|
|
IF llSuccess
|
|
|
|
IF (VARTYPE(THIS.oFrame) = "O")
|
|
* if we closed screen during a topform-in-development-version
|
|
* app, the frame is likely behind another Windows app at this point...
|
|
|
|
THIS.oFrame.Show()
|
|
|
|
ELSE
|
|
|
|
SET MESSAGE TO && for neatness' sake
|
|
|
|
ENDIF
|
|
|
|
THIS.lNoInterrupt = .F.
|
|
IF THIS.lStartupForm
|
|
THIS.DoStartupForm()
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
RETURN llSuccess
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE showtablefinddialog && Instantiates _FindDialog class, in advanced or standard mode, depending on THIS.lFindOnMultipleTables value. (Advanced mode allows the user to choose between all open aliases in a data session.)
|
|
|
|
LOCAL loForm, llInterrupted
|
|
loForm = THIS.DoModalDialogClass("_FindDialog", "_table.vcx", .T.)
|
|
IF VARTYPE(loForm) = "O"
|
|
loForm.lAdvanced = THIS.lFindOnMultipleTables
|
|
|
|
llInterrupted = (NOT THIS.lNoInterrupt)
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .T.
|
|
ENDIF
|
|
|
|
loForm.Show(1)
|
|
|
|
IF llInterrupted
|
|
THIS.lNoInterrupt = .F.
|
|
ENDIF
|
|
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE showtablegotodialog && Instantiates _GoToDialog class.
|
|
LOCAL llReturn
|
|
|
|
llReturn = THIS.DoModalDialogClass("_GoTodialog", "_table.vcx")
|
|
|
|
RETURN llReturn
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE showtablesetfilterdialog && Instantiates _FilterExpr class, in advanced or standard depending on THIS.lUseGetExpr value. (Standard mode uses _FilterDialog as a subsidiary dialog, Advanced uses _GETEXPR.)
|
|
LOCAL loForm
|
|
|
|
THIS.cusTableNav.SetToActiveSession()
|
|
loForm = THIS.DoModalDialogClass("_FilterExpr", "_table.vcx", .T.)
|
|
IF VARTYPE(loForm) = "O"
|
|
loForm.lAdvanced = THIS.lUse_GETEXPR
|
|
loForm.Show(1)
|
|
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE storepassword && Stores the encrypted value of a new password to the current record in the user table.
|
|
LPARAMETERS tcValueToStore
|
|
|
|
IF (NOT THIS.lUserPreferences) OR ;
|
|
NOT USED(THIS.cUserTableAlias) OR ;
|
|
VARTYPE(tcValueToStore) # "C"
|
|
|
|
RETURN .F.
|
|
|
|
ENDIF
|
|
|
|
REPLACE UserPass WITH ;
|
|
(THIS.CreateStoredPassword(tcValueToStore)) IN ;
|
|
(THIS.cUserTableAlias)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE validatemetatable && Ensures that a table contains a valid and available table for documents registry. Validates THIS.cMetatable, if used, on startup.
|
|
LPARAMETERS tcTable, tlOmitFeedback
|
|
|
|
IF EMPTY(tcTable) AND EMPTY(THIS.cMetaTable)
|
|
RETURN .T.
|
|
ENDIF
|
|
|
|
LOCAL lcTable, lcMessage, lcAlias, liSelect, ;
|
|
llReturn, liTagCount ,laRequired[1], laKeys[1], ;
|
|
liFound, llExactOff
|
|
|
|
lcAlias = "M"+SYS(2015)
|
|
|
|
THIS.ClearLastError()
|
|
|
|
IF EMPTY(tcTable)
|
|
USE (THIS.cMetaTable) ALIAS (lcAlias) EXCLU IN 0
|
|
lcTable = THIS.cMetaTable
|
|
ELSE
|
|
USE (tcTable) ALIAS (lcAlias) EXCLU IN 0
|
|
lcTable = tcTable
|
|
ENDIF
|
|
|
|
llReturn = THIS.IsErrorFree() AND USED(lcAlias)
|
|
|
|
IF NOT llReturn
|
|
lcMessage = APP_META_UNAVAILABLE_LOC+;
|
|
CHR(13) + CHR(13)+ ;
|
|
lcTable
|
|
ENDIF
|
|
|
|
IF llReturn
|
|
llReturn = ;
|
|
TYPE(lcAlias+".DOC_TYPE") = "C" AND ;
|
|
TYPE(lcAlias+".DOC_DESCR") = "C" AND ;
|
|
TYPE(lcAlias+".DOC_EXEC") = "M" AND ;
|
|
TYPE(lcAlias+".DOC_CLASS") = "M" AND ;
|
|
TYPE(lcAlias+".DOC_NEW") = "L" AND ;
|
|
TYPE(lcAlias+".DOC_OPEN") = "L" AND ;
|
|
TYPE(lcAlias+".DOC_SINGLE") = "L" AND ;
|
|
TYPE(lcAlias+".DOC_NOSHOW") = "L" AND ;
|
|
TYPE(lcAlias+".DOC_WRAP") = "L" AND ;
|
|
TYPE(lcAlias+".DOC_GO") = "L" AND ;
|
|
TYPE(lcAlias+".DOC_NAV") = "L" AND ;
|
|
TYPE(lcAlias+".ALT_EXEC") = "M"
|
|
* the last two fields in the delivered metatable
|
|
* are non-required fields
|
|
IF NOT llReturn
|
|
|
|
lcMessage = APP_META_WRONGFORMAT_LOC + ;
|
|
CHR(13)+CHR(13)+ ;
|
|
lcTable
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF llReturn
|
|
|
|
IF (SET("EXACT") = "OFF")
|
|
SET EXACT ON
|
|
llExactOff = .T.
|
|
ENDIF
|
|
|
|
liSelect = SELECT()
|
|
SELECT (lcAlias)
|
|
|
|
* check for required tags...
|
|
|
|
DIME laRequired[5]
|
|
laRequired[1] = "DOC_OPEN"
|
|
laRequired[2] = "DOC_NEW"
|
|
laRequired[3] = "DOC_DESCR"
|
|
laRequired[4] = "DOC_TYPE"
|
|
laRequired[5] = "DELETED()"
|
|
|
|
DIME laKeys[TAGCOUNT()]
|
|
|
|
FOR liTagCount = 1 TO TAGCOUNT()
|
|
laKeys[liTagCount] = UPPER(KEY(liTagCount))
|
|
ENDFOR
|
|
|
|
FOR liTagCount = 1 TO ALEN(laRequired)
|
|
liFound = ASCAN(laKeys,UPPER(laRequired[liTagCount]))
|
|
IF liFound = 0
|
|
llReturn = .F.
|
|
EXIT
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
IF NOT llReturn
|
|
lcMessage = APP_META_MISSINGINDEX_LOC + CHR(13) + ;
|
|
laRequired[1]+ CHR(13)+ ;
|
|
laRequired[2]+ CHR(13)+ ;
|
|
laRequired[3]+ CHR(13) + ;
|
|
laRequired[4]+ CHR(13) + ;
|
|
laRequired[5]
|
|
ENDIF
|
|
|
|
IF llExactOff
|
|
SET EXACT OFF
|
|
ENDIF
|
|
SELECT (liSelect)
|
|
|
|
ENDIF
|
|
|
|
IF NOT (llReturn OR tlOmitFeedback)
|
|
IF INLIST(_VFP.Startmode, 0, 4)
|
|
MESSAGEBOX(lcMessage,MB_ICONSTOP,THIS.cCaption)
|
|
ELSE
|
|
THIS.cusError.RecordServerError(;
|
|
THIS.cCaption+": "+lcMessage)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF USED(lcAlias)
|
|
USE IN (lcAlias)
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cusError.Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
THIS.Parent.iLastError = nError
|
|
DODEFAULT(nError, cMethod, nLine)
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cusError.getmessageboxtitle
|
|
LOCAL lcTitle, lcCaption
|
|
lcCaption = THIS.Parent.cCaption
|
|
lcTitle = DODEFAULT()
|
|
IF NOT EMPTY(lcCaption)
|
|
lcTitle = ALLTR(lcCaption+" "+lcTitle)
|
|
ENDIF
|
|
RETURN lcTitle
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cusError.setlog
|
|
LPARAMETERS tcTableName, tcAlias
|
|
|
|
DODEFAULT(THIS.Parent.cErrorLogTableName,tcAlias)
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE tmrRefresh.Timer
|
|
IF THIS.Parent.lNoInterrupt
|
|
* shouldn't happen
|
|
RETURN
|
|
ENDIF
|
|
DODEFAULT()
|
|
|
|
THIS.Parent.RefreshToolbars()
|
|
|
|
LOCAL loMediator, loForm, llBusy
|
|
IF TYPE("_SCREEN.ActiveForm") = "O"
|
|
loForm = _SCREEN.ActiveForm
|
|
ELSE
|
|
STORE .F. TO THIS.Parent.lGoMenu, THIS.Parent.lNavToolbar
|
|
RETURN
|
|
ENDIF
|
|
IF TYPE("loForm.Parent") = "O" AND ;
|
|
INLIST(loForm.Parent.WindowType,WINDOWTYPE_MODAL, WINDOWTYPE_READMODAL)
|
|
RETURN
|
|
ENDIF
|
|
IF loForm.WindowType = WINDOWTYPE_MODAL
|
|
RETURN
|
|
ENDIF
|
|
|
|
loMediator = THIS.Parent.GetFormMediatorRef(_SCREEN.ActiveForm)
|
|
IF VARTYPE(loMediator) = "O"
|
|
THIS.Parent.lGoMenu = loMediator.lGoMenu
|
|
THIS.Parent.lNavToolbar = loMediator.lNavToolbar
|
|
ELSE
|
|
STORE .F. TO THIS.Parent.lGoMenu, THIS.Parent.lNavToolbar
|
|
ENDIF
|
|
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _changepassword AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default password-changing dialog
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="txtPassword" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblPassword" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="txtConfirmPassword" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblConfirmPassword" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*m: savepassword && Confirms and stores new password for the user.
|
|
*p: oapp
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
DoCreate = .T.
|
|
Height = 80
|
|
Name = "_changepassword"
|
|
oapp = .NULL.
|
|
Width = 390
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'cmdCancel' AS _commandbutton WITH ;
|
|
Cancel = .T., ;
|
|
Caption = "\<Cancel", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 27, ;
|
|
Left = 307, ;
|
|
Name = "cmdCancel", ;
|
|
Top = 42, ;
|
|
Width = 69
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdOK' AS _commandbutton WITH ;
|
|
Caption = "\<OK", ;
|
|
Default = .T., ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 27, ;
|
|
Left = 307, ;
|
|
Name = "cmdOK", ;
|
|
Top = 10, ;
|
|
Width = 69
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'lblConfirmPassword' AS _label WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
Caption = "Confirm Password:", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 15, ;
|
|
Left = 12, ;
|
|
Name = "lblConfirmPassword", ;
|
|
TabIndex = 16, ;
|
|
Top = 47, ;
|
|
Width = 89
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'lblPassword' AS _label WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
Caption = "New Password:", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 15, ;
|
|
Left = 12, ;
|
|
Name = "lblPassword", ;
|
|
TabIndex = 15, ;
|
|
Top = 15, ;
|
|
Width = 76
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'txtConfirmPassword' AS _textbox WITH ;
|
|
FontBold = .T., ;
|
|
FontName = "Courier New", ;
|
|
FontSize = 9, ;
|
|
Height = 24, ;
|
|
Left = 118, ;
|
|
Name = "txtConfirmPassword", ;
|
|
PasswordChar = "*", ;
|
|
SelectOnEntry = .T., ;
|
|
TabIndex = 6, ;
|
|
Top = 43, ;
|
|
Value = (""), ;
|
|
Width = 174
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" />
|
|
|
|
ADD OBJECT 'txtPassword' AS _textbox WITH ;
|
|
FontBold = .T., ;
|
|
FontName = "Courier New", ;
|
|
FontSize = 9, ;
|
|
Height = 24, ;
|
|
Left = 118, ;
|
|
Name = "txtPassword", ;
|
|
PasswordChar = "*", ;
|
|
SelectOnEntry = .T., ;
|
|
TabIndex = 5, ;
|
|
Top = 11, ;
|
|
Value = (""), ;
|
|
Width = 174
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" />
|
|
|
|
PROCEDURE applyappattributes
|
|
LPARAMETERS toApp
|
|
LOCAL llSuccess
|
|
llSuccess = DODEFAULT(toApp)
|
|
IF llSuccess
|
|
IF USED(toApp.cUserTableAlias)
|
|
THIS.Caption = toApp.cCaption + " " + CHANGEPASSWORD_LOC
|
|
THIS.oApp = toApp
|
|
ELSE
|
|
llSuccess = .F.
|
|
ENDIF
|
|
ENDIF
|
|
IF NOT (llSuccess AND THIS.oApp.IsErrorFree())
|
|
THIS.Release()
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
DODEFAULT()
|
|
THIS.oApp = .NULL.
|
|
ENDPROC
|
|
|
|
PROCEDURE KeyPress
|
|
LPARAMETERS nKeyCode, nShiftAltCtrl
|
|
IF nKeyCode = 27
|
|
THIS.Release()
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE savepassword && Confirms and stores new password for the user.
|
|
IF ALLTRIM(THIS.txtConfirmPassword.Value) == ALLTRIM(THIS.txtPassword.Value)
|
|
THIS.oApp.StorePassword(ALLTRIM(THIS.txtPassword.Value))
|
|
MESSAGEBOX(OPTIONS_PASSWORD_CONFIRMED_LOC,0,THIS.Caption)
|
|
STORE SPACE(30) TO THIS.txtConfirmPassword.Value, THIS.txtPassword.Value
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdCancel.Click
|
|
THISFORM.Release()
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdOK.Click
|
|
THISFORM.SavePassword()
|
|
THISFORM.Release()
|
|
ENDPROC
|
|
|
|
PROCEDURE txtConfirmPassword.InteractiveChange
|
|
THISFORM.cmdOK.Enabled = (ALLTRIM(THISFORM.txtPassword.Value) == ALLTRIM(THIS.Value))
|
|
ENDPROC
|
|
|
|
PROCEDURE txtPassword.InteractiveChange
|
|
THISFORM.cmdOK.Enabled = (ALLTRIM(THISFORM.txtConfirmPassword.Value) == ALLTRIM(THIS.Value))
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _dialog AS _form OF "..\ffc\_base.vcx" && superclass for framework-supplied default dialogs
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*m: adjustforsystemfontsize && Handles large font use for any dialogs that are supplied with the framework. Since the framework visual elements default to MS San Serif, these dialogs switch to Arial if the user is in large font mode.
|
|
*m: applyappattributes && Takes a reference to the application object and applies app session-specific attributes, caption, and icon to this dialog.
|
|
*p: lsingleton && Indicates that this dialog should re-show rather re-instantiate, if invoked when it already exists.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
AutoCenter = .T.
|
|
BorderStyle = 0
|
|
Caption = ("")
|
|
DoCreate = .T.
|
|
Height = 250
|
|
Icon = ..\model\
|
|
MaxButton = .F.
|
|
MinButton = .F.
|
|
Name = "_dialog"
|
|
Width = 375
|
|
*</PropValue>
|
|
|
|
PROCEDURE adjustforsystemfontsize && Handles large font use for any dialogs that are supplied with the framework. Since the framework visual elements default to MS San Serif, these dialogs switch to Arial if the user is in large font mode.
|
|
LOCAL lcStandardFont, loControl
|
|
|
|
IF FONTMETRIC(1, 'MS Sans Serif', 8, '') # 13 OR ;
|
|
FONTMETRIC(4, 'MS Sans Serif', 8, '') # 2 OR ;
|
|
FONTMETRIC(6, 'MS Sans Serif', 8, '') # 5 OR ;
|
|
FONTMETRIC(7, 'MS Sans Serif', 8, '') # 11
|
|
|
|
lcStandardFont = UPPER(DIALOG_SMALLFONT_NAME)
|
|
|
|
|
|
FOR EACH loControl IN THIS.Controls
|
|
|
|
DO CASE
|
|
CASE PEMSTATUS(loControl,"FontName",5) AND ;
|
|
UPPER(loControl.FontName) == lcStandardFont
|
|
|
|
loControl.FontName = DIALOG_LARGEFONT_NAME
|
|
|
|
CASE TYPE("loControl.Buttons(1)") = "O"
|
|
|
|
loControl.SetAll("FontName",DIALOG_LARGEFONT_NAME)
|
|
|
|
OTHERWISE
|
|
|
|
* note: I am *not* going to do this recursively,
|
|
* although I would in other instances.
|
|
* none of the _framewk dialogs based on
|
|
* _dialog class use containers extensively,
|
|
* and if some were added it would be unwise
|
|
* for me to assume that these containers should
|
|
* be unilaterally altered by this code.
|
|
* The best thing to do would be to add a
|
|
* FontName property to such containers, with
|
|
* an assign method so that the change could
|
|
* be applied appropriately to the members of
|
|
* said container.
|
|
|
|
ENDCASE
|
|
|
|
ENDFOR
|
|
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE applyappattributes && Takes a reference to the application object and applies app session-specific attributes, caption, and icon to this dialog.
|
|
LPARAMETERS toApp
|
|
|
|
IF VARTYPE(toApp) = "O"
|
|
IF EMPTY(THIS.Caption)
|
|
THIS.Caption = toApp.cCaption + " " + THIS.Caption
|
|
ENDIF
|
|
IF EMPTY(THIS.Icon)
|
|
THIS.Icon = toApp.cIcon
|
|
ENDIF
|
|
THIS.AdjustForSystemFontSize()
|
|
toApp.ApplyUserOptsForSession(THIS.DataSessionID)
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Load
|
|
DODEFAULT()
|
|
SET TALK OFF
|
|
IF THIS.lSingleton
|
|
LOCAL loForm, llFound
|
|
FOR EACH loForm IN _SCREEN.Forms
|
|
IF (loForm.ClassLibrary == THIS.ClassLibrary AND ;
|
|
loForm.Class == THIS.Class ) AND ;
|
|
loForm.Visible
|
|
llFound = .T.
|
|
loForm.Show()
|
|
loForm.Autocenter = loForm.AutoCenter
|
|
EXIT
|
|
ENDIF
|
|
ENDFOR
|
|
IF llFound
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _documentpicker AS _dialog OF "_framewk.vcx" && superclass for framework-supplied dialogs manipulating the metatable of documents
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="lstDocuments" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*m: execdocument && Abstract, called when the user presses OK or makes a selection from the document list.
|
|
*m: filldocumentsarray && Abstract, called on startup to dimension and fill the array that supplies the listbox with values and provides potential action parameters when the user chooses from the listbox.
|
|
*m: setdialogsizeparameters && Sets initial, minimum, and maximum dialog size based on number of items in the listbox.
|
|
*p: lnew && Toggles the dialog between two states.
|
|
*p: lsorted && Determines whether items in list will be sorted by visible field when descendent classes' FillDocumentsArray method prepares contents
|
|
*p: oapp
|
|
*a: adocuments[1,7]
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
BorderStyle = 3
|
|
Caption = "Choose a document"
|
|
DataSession = 2
|
|
DoCreate = .T.
|
|
Height = 229
|
|
KeyPreview = .T.
|
|
lsorted = .T.
|
|
Name = "_documentpicker"
|
|
oapp = .NULL.
|
|
Width = 328
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'cmdCancel' AS _commandbutton WITH ;
|
|
Cancel = .T., ;
|
|
Caption = "\<Cancel", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 27, ;
|
|
Left = 252, ;
|
|
Name = "cmdCancel", ;
|
|
Top = 47, ;
|
|
Width = 63
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdOK' AS _commandbutton WITH ;
|
|
Caption = "\<OK", ;
|
|
Default = .T., ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 27, ;
|
|
Left = 252, ;
|
|
Name = "cmdOK", ;
|
|
Top = 14, ;
|
|
Width = 63
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'lstDocuments' AS _listbox WITH ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 204, ;
|
|
IntegralHeight = .T., ;
|
|
ItemTips = .T., ;
|
|
Left = 12, ;
|
|
Name = "lstDocuments", ;
|
|
RowSourceType = 5, ;
|
|
Top = 12, ;
|
|
Value = 1, ;
|
|
Width = 230
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="listbox" />
|
|
|
|
PROCEDURE applyappattributes
|
|
LPARAMETERS toapp
|
|
|
|
IF DODEFAULT(toApp)
|
|
THIS.SetDialogSizeParameters()
|
|
THIS.Resize()
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
DODEFAULT()
|
|
THIS.oApp = .NULL.
|
|
ENDPROC
|
|
|
|
PROCEDURE execdocument && Abstract, called when the user presses OK or makes a selection from the document list.
|
|
ENDPROC
|
|
|
|
PROCEDURE filldocumentsarray && Abstract, called on startup to dimension and fill the array that supplies the listbox with values and provides potential action parameters when the user chooses from the listbox.
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
LPARAMETERS toApp, tlNew
|
|
|
|
IF NOT DODEFAULT()
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
LOCAL laTemp[1], llReturn
|
|
|
|
ASSERT VARTYPE(tlNew) = "L"
|
|
ASSERT TYPE("toApp.cMetaTable") = "C" AND ;
|
|
ACLASS(laTemp,toApp) > 0 AND ;
|
|
ASCAN(laTemp,"_APPLICATION") > 0 ;
|
|
MESSAGE DOCUMENTPICKER_NO_APP_LOC
|
|
|
|
THIS.lNew = tlNew
|
|
|
|
THIS.oApp = toApp
|
|
|
|
DO CASE
|
|
|
|
CASE EMPTY(toApp.cMetaTable) OR ;
|
|
(NOT THIS.FillDocumentsArray(toApp.GetResourceFileName(toApp.cMetaTable,".dbf"))) OR ;
|
|
VARTYPE(THIS.aDocuments[1,1]) # "C"
|
|
|
|
MESSAGEBOX(DOCUMENTPICKER_NO_DOCUMENTS_LOC, ;
|
|
MB_ICONEXCLAMATION, ;
|
|
toApp.cCaption)
|
|
|
|
CASE ALEN(THIS.aDocuments,1) = 1
|
|
THIS.lstDocuments.RowSource = "THISFORM.aDocuments"
|
|
THIS.lstDocuments.Value = 1
|
|
THIS.ExecDocument()
|
|
|
|
OTHERWISE
|
|
llReturn = .T.
|
|
THIS.lstDocuments.RowSource = "THISFORM.aDocuments"
|
|
ENDCASE
|
|
|
|
IF NOT llReturn
|
|
THIS.oApp = .NULL.
|
|
ENDIF
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE KeyPress
|
|
LPARAMETERS nKeyCode, nShiftAltCtrl
|
|
DO CASE
|
|
CASE nKeyCode = 27
|
|
THIS.cmdCancel.Click()
|
|
NODEFAULT
|
|
CASE nKeyCode = 23
|
|
THIS.cmdOK.Click()
|
|
NODEFAULT
|
|
OTHERWISE
|
|
ENDCASE
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Load
|
|
DODEFAULT()
|
|
SET DELETED ON
|
|
ENDPROC
|
|
|
|
PROCEDURE Resize
|
|
LOCAL lnMargin
|
|
|
|
lnMargin = THIS.lstDocuments.Left
|
|
|
|
STORE THIS.Width - (THIS.cmdCancel.Width + lnMargin ) TO ;
|
|
THIS.cmdCancel.Left, ;
|
|
THIS.cmdOK.Left
|
|
|
|
STORE THIS.cmdCancel.Left - (lnMargin * 2) TO THIS.lstDocuments.Width
|
|
|
|
lnMargin = THIS.lstDocuments.Top
|
|
|
|
STORE THIS.Height - (lnMargin * 2) TO THIS.lstDocuments.Height
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setdialogsizeparameters && Sets initial, minimum, and maximum dialog size based on number of items in the listbox.
|
|
LOCAL liMaxRows, lnListRowHeight, lnListMaxHeight, lnListMinHeight, lnMargin
|
|
|
|
liMaxRows = ALEN(THIS.aDocuments,1)
|
|
|
|
lnMargin = THIS.lstDocuments.Top
|
|
|
|
WITH THIS.lstDocuments
|
|
lnListRowHeight = FONTM(1,.FontName,.FontSize) + ;
|
|
FONTM(5,.FontName,.FontSize) + ;
|
|
FONTM(4,.FontName,.FontSize)
|
|
|
|
lnListMaxHeight = MIN(lnListRowHeight * liMaxRows, ;
|
|
(SYSMETRIC(2) - lnMargin * 2))
|
|
lnListMinHeight = lnListRowHeight * 2
|
|
|
|
IF NOT BETWEEN(.Height, lnListMinHeight, lnListMaxHeight)
|
|
.Height = MIN(lnListMaxHeight, .Height)
|
|
ENDIF
|
|
|
|
ENDWITH
|
|
|
|
|
|
|
|
THIS.MinWidth = THIS.Width
|
|
THIS.MinHeight = MAX(lnListMinHeight + (lnMargin * 2), ;
|
|
(THIS.cmdCancel.Top + THIS.cmdCancel.Height + lnMargin))
|
|
THIS.MaxHeight = MAX(THIS.MinHeight, lnListMaxHeight + (lnMargin * 2))
|
|
|
|
THIS.Height = MAX(THIS.MinHeight,THIS.lstDocuments.Height + (lnMargin * 2))
|
|
|
|
lnMargin = THIS.lstDocuments.Left
|
|
|
|
THIS.Width = THIS.lstDocuments.Width+THIS.cmdCancel.Width+ lnMargin * 3
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdCancel.Click
|
|
THISFORM.Release()
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdOK.Click
|
|
IF NOT EMPTY(THISFORM.lstDocuments.Value)
|
|
THISFORM.ExecDocument()
|
|
ENDIF
|
|
THISFORM.Release()
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE lstDocuments.DblClick
|
|
THISFORM.cmdOK.Click()
|
|
ENDPROC
|
|
|
|
PROCEDURE lstDocuments.KeyPress
|
|
LPARAMETERS nKeyCode, nShiftAltCtrl
|
|
IF INLIST(nKeyCode,13,32)
|
|
THIS.DblClick()
|
|
NODEFAULT
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _errorlogviewer AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default dialog to browse error log and add user notes to the log
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="pgfErrorLog" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="pgfErrorLog.Page1.edtListing" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="pgfErrorLog.Page2.edtUserNotes" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="txtErrStamp" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="spnNav" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdBrowseErrorLog" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="app_mediator" UniqueID="" Timestamp="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*m: ctextdisplayfont_assign
|
|
*m: donologmessage
|
|
*p: calias
|
|
*p: ctextdisplayfont
|
|
*p: imargin
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
BorderStyle = 3
|
|
calias = ("ErrorLog")
|
|
DataSession = 2
|
|
DoCreate = .T.
|
|
Height = 250
|
|
imargin = 0
|
|
lsingleton = .T.
|
|
Name = "_errorlogviewer"
|
|
ShowTips = .T.
|
|
TabIndex = 1
|
|
Width = 375
|
|
WindowState = 0
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'app_mediator' AS _formmediator WITH ;
|
|
Left = 48, ;
|
|
Name = "app_mediator", ;
|
|
Top = 36
|
|
*< END OBJECT: ClassLib="_framewk.vcx" BaseClass="custom" />
|
|
|
|
ADD OBJECT 'cmdBrowseErrorLog' AS _commandbutton WITH ;
|
|
Caption = (""), ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 24, ;
|
|
Left = 10, ;
|
|
Name = "cmdBrowseErrorLog", ;
|
|
Picture = graphics\browse.bmp, ;
|
|
TabIndex = 4, ;
|
|
ToolTipText = ("Browse the Error Log records"), ;
|
|
Top = 35, ;
|
|
Width = 24
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'pgfErrorLog' AS _pageframe WITH ;
|
|
ActivePage = 1, ;
|
|
ErasePage = .T., ;
|
|
Height = 252, ;
|
|
Left = 0, ;
|
|
Name = "pgfErrorLog", ;
|
|
PageCount = 2, ;
|
|
TabIndex = 1, ;
|
|
Top = 0, ;
|
|
Width = 377, ;
|
|
Page1.Caption = "\<Listing of Error Details", ;
|
|
Page1.FontName = "MS Sans Serif", ;
|
|
Page1.FontSize = 8, ;
|
|
Page1.Name = "Page1", ;
|
|
Page2.Caption = "\<User Notes On Errors", ;
|
|
Page2.FontName = "MS Sans Serif", ;
|
|
Page2.FontSize = 8, ;
|
|
Page2.Name = "Page2"
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="pageframe" />
|
|
|
|
ADD OBJECT 'pgfErrorLog.Page1.edtListing' AS _editbox WITH ;
|
|
DefLeft = , ;
|
|
FontCondense = .T., ;
|
|
FontName = "Courier New", ;
|
|
FontSize = 9, ;
|
|
Height = 180, ;
|
|
Left = (THISFORM.iMargin), ;
|
|
Name = "edtListing", ;
|
|
ToolTipText = ("Technical details of the error for you to tell the programmer"), ;
|
|
Top = 39, ;
|
|
Width = 367
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="editbox" />
|
|
|
|
ADD OBJECT 'pgfErrorLog.Page2.edtUserNotes' AS _editbox WITH ;
|
|
DefLeft = , ;
|
|
FontName = "Courier New", ;
|
|
Height = 180, ;
|
|
Left = (THISFORM.iMargin), ;
|
|
Name = "edtUserNotes", ;
|
|
ToolTipText = ("A place for you to write whatever might help the programmer fix the error"), ;
|
|
Top = 39, ;
|
|
Width = 367
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="editbox" />
|
|
|
|
ADD OBJECT 'spnNav' AS _spinner WITH ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 24, ;
|
|
Left = 352, ;
|
|
Name = "spnNav", ;
|
|
TabIndex = 3, ;
|
|
TabStop = .F., ;
|
|
ToolTipText = ("Move to a different Error Log record"), ;
|
|
Top = 36, ;
|
|
Width = 16
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="spinner" />
|
|
|
|
ADD OBJECT 'txtErrStamp' AS _textbox WITH ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 24, ;
|
|
Left = 120, ;
|
|
Name = "txtErrStamp", ;
|
|
ReadOnly = .T., ;
|
|
TabIndex = 2, ;
|
|
TabStop = .F., ;
|
|
ToolTipText = ("Date and Time of this error"), ;
|
|
Top = 36, ;
|
|
Width = 228
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" />
|
|
|
|
PROCEDURE Activate
|
|
IF RECCOUNT(THIS.cAlias) < 2
|
|
THIS.spnNav.Enabled = .F.
|
|
ELSE
|
|
STORE RECCOUNT(THIS.cAlias) TO ;
|
|
THIS.spnNav.SpinnerHighValue, THIS.spnNav.KeyboardHighValue
|
|
STORE 1 TO THIS.spnNav.SpinnerLowValue, THIS.spnNav.KeyboardLowValue
|
|
STORE RECNO(THIS.cAlias) TO THIS.spnNav.Value
|
|
ENDIF
|
|
THIS.Refresh()
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE applyappattributes
|
|
LPARAMETERS toApp
|
|
|
|
LOCAL lcTable
|
|
|
|
IF DODEFAULT(toApp)
|
|
|
|
lcTable = toApp.cErrorLogTableName
|
|
IF EMPTY(lcTable) OR NOT FILE(lcTable)
|
|
THIS.DoNoLogMessage(ERRORVIEWER_UNAVAILABLE_LOC )
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
USE (lcTable) SHARED ALIAS (THIS.cAlias) IN 0
|
|
|
|
IF NOT USED(THIS.cAlias)
|
|
THIS.DoNoLogMessage(ERRORVIEWER_UNAVAILABLE_LOC )
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF EMPTY(RECCOUNT(THIS.cAlias))
|
|
THIS.DoNoLogMessage(ERRORVIEWER_EMPTY_LOC )
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
GO BOTTOM
|
|
THIS.txtErrStamp.ControlSource=THIS.cAlias+".ErrStamp"
|
|
THIS.pgfErrorLog.Page1.edtListing.ControlSource = THIS.cAlias+".Listing"
|
|
THIS.pgfErrorLog.Page2.edtUserNotes.ControlSource = THIS.cAlias+".UserNotes"
|
|
THIS.app_mediator.LoadApp(toApp.cReference)
|
|
* the error log viewer is different from other
|
|
* _dialog descendents in that it's not modal,
|
|
* so it deserves a mediator for later use.
|
|
|
|
ELSE
|
|
|
|
RETURN .F.
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ctextdisplayfont_assign
|
|
LPARAMETERS tvNewVal
|
|
IF VARTYPE(tvNewVal) = "C"
|
|
THIS.cTextDisplayFont = tvNewVal
|
|
STORE tvNewVal TO THIS.pgfErrorLog.Page1.edtListing.FontName, ;
|
|
THIS.pgfErrorLog.Page2.edtUserNotes.FontName
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF (NOT EMPTY(THIS.cAlias)) AND USED(THIS.cAlias)
|
|
USE IN (THIS.cAlias)
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE donologmessage
|
|
LPARAMETERS tcMessage
|
|
?? CHR(7)
|
|
MESSAGEBOX(tcMessage,MB_ICONINFORMATION,THIS.Caption)
|
|
RETURN
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF DODEFAULT()
|
|
THIS.MinHeight = THIS.Height
|
|
THIS.MinWidth = THIS.Width
|
|
THIS.iMargin = SYSMETRIC(12)
|
|
STORE THIS.iMargin TO ;
|
|
THIS.pgfErrorLog.Page1.edtListing.Left, ;
|
|
THIS.pgfErrorLog.Page2.edtUserNotes.Left
|
|
THIS.Resize()
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Resize
|
|
WITH THIS.pgfErrorLog
|
|
|
|
.Height = THIS.Height
|
|
.Width = THIS.Width
|
|
THIS.txtErrStamp.Left = (THIS.Width - THIS.txtErrStamp.Width)/2
|
|
THIS.spnNav.Left = THIS.txtErrStamp.Left+THIS.txtErrStamp.Width
|
|
|
|
STORE .PageHeight - ;
|
|
(THIS.pgfErrorLog.Page1.edtListing.Top+ ;
|
|
THIS.iMargin) TO ;
|
|
THIS.pgfErrorLog.Page1.edtListing.Height, ;
|
|
THIS.pgfErrorLog.Page2.edtUserNotes.Height
|
|
|
|
STORE THIS.Width - (THIS.iMargin*2) TO ;
|
|
.Page1.edtListing.Width, ;
|
|
.Page2.edtUserNotes.Width
|
|
|
|
ENDWITH
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE app_mediator.dosessionsets
|
|
LPARAMETERS toApp
|
|
|
|
LOCAL loApp
|
|
|
|
IF VARTYPE(toApp) = "O"
|
|
loApp = toApp
|
|
ELSE
|
|
loApp = THIS.GetAppRef()
|
|
ENDIF
|
|
|
|
IF VARTYPE(loApp) = "O"
|
|
DODEFAULT(loApp)
|
|
THISFORM.cTextDisplayFont = loApp.cTextDisplayFont
|
|
ENDIF
|
|
loApp = NULL
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdBrowseErrorLog.Click
|
|
LOCAL lcFrame, loApp, iSelect && jic
|
|
iSelect = SELECT()
|
|
SELECT (THISFORM.cAlias)
|
|
loApp = THISFORM.app_mediator.GetAppRef()
|
|
IF TYPE("loApp.oFrame.Name") = "C"
|
|
lcFrame = " IN WINDOW (loApp.oFrame.Name) "
|
|
ELSE
|
|
lcFrame = " IN SCREEN "
|
|
ENDIF
|
|
BROWSE FIELDS ;
|
|
errstamp :H= "Error Date and Time", ;
|
|
field2 = LEFT(Listing, 20) :H="Tech Listing", ;
|
|
field3 = LEFT(UserNotes,10) :H= "Your Notes Go Here" ;
|
|
WINDOW (THISFORM.Name) ;
|
|
FONT (THISFORM.cTextDisplayFont) ;
|
|
&lcFrame
|
|
THISFORM.Refresh()
|
|
THISFORM.spnNav.Value = RECNO()
|
|
SELECT (iSelect)
|
|
loApp = NULL
|
|
ENDPROC
|
|
|
|
PROCEDURE spnNav.DownClick
|
|
IF THIS.Value = THIS.SpinnerLowValue
|
|
?? CHR(7)
|
|
ENDIF
|
|
THISFORM.cmdBrowseErrorLog.SetFocus()
|
|
ENDPROC
|
|
|
|
PROCEDURE spnNav.InteractiveChange
|
|
GO THIS.Value IN (THISFORM.cAlias)
|
|
THISFORM.Refresh()
|
|
ENDPROC
|
|
|
|
PROCEDURE spnNav.UpClick
|
|
IF THIS.Value = THIS.SpinnerHighValue
|
|
?? CHR(7)
|
|
ENDIF
|
|
THISFORM.cmdBrowseErrorLog.SetFocus()
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _favoritepicker AS _documentpicker OF "_framewk.vcx" && superclass for framework-supplied default dialog to add items to the Favorites menu (in New mode) or execute a document at startup ("quick start")
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="cmdBrowse" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdRemove" UniqueID="" Timestamp="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*m: refreshbuttons
|
|
*m: refreshfavoriteids && Adds to the app cCurrentUserFavoriteIDs list when the user makes a new choice.
|
|
*m: removedocument
|
|
*p: lallowfilebrowsing && Determines whether the user is allowed to pick files from disk for QuickStart or Favorites use.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
DoCreate = .T.
|
|
lallowfilebrowsing = .T.
|
|
Name = "_favoritepicker"
|
|
lstDocuments.Name = "lstDocuments"
|
|
lstDocuments.TabIndex = 1
|
|
lstDocuments.Top = 12
|
|
cmdOK.Left = 254
|
|
cmdOK.Name = "cmdOK"
|
|
cmdOK.TabIndex = 2
|
|
cmdOK.Top = 14
|
|
cmdOK.Width = 63
|
|
cmdCancel.Height = 27
|
|
cmdCancel.Left = 254
|
|
cmdCancel.Name = "cmdCancel"
|
|
cmdCancel.TabIndex = 4
|
|
cmdCancel.Top = 82
|
|
cmdCancel.Width = 63
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'cmdBrowse' AS _commandbutton WITH ;
|
|
Caption = "\<Browse...", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 27, ;
|
|
Left = 254, ;
|
|
Name = "cmdBrowse", ;
|
|
TabIndex = 5, ;
|
|
Top = 189, ;
|
|
Width = 63
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdRemove' AS _commandbutton WITH ;
|
|
Caption = "\<Remove", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 27, ;
|
|
Left = 254, ;
|
|
Name = "cmdRemove", ;
|
|
TabIndex = 3, ;
|
|
Top = 48, ;
|
|
Width = 63
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
PROCEDURE execdocument
|
|
LPARAMETERS tcFile
|
|
|
|
* if a filename has been sent here,
|
|
* we're browsing/picking directly
|
|
* otherwise, we're working off the documents array
|
|
|
|
LOCAL liRow, lcExt, lcFile, lcStatement, ;
|
|
laFavorites[1], ;
|
|
llDocumentFromDisk, llExactSet
|
|
|
|
liRow = THIS.lstDocuments.Value
|
|
|
|
IF VARTYPE(tcFile) # "C" AND ;
|
|
(EMPTY(THIS.aDocuments[liRow,1]) OR ;
|
|
NOT BETWEEN(liRow,1,ALEN(THIS.aDocuments,1)))
|
|
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF VARTYPE(tcFile) = "C"
|
|
|
|
lcFile = UPPER(ALLTRIM(tcFile))
|
|
lcExt = JUSTEXT(lcFile)
|
|
|
|
IF INLIST(lcExt,"SCT","LBT","FRT")
|
|
lcFile = LEFT(lcFile,LEN(lcFile)-1)+"X"
|
|
lcExt = LEFT(lcExt,LEN(lcExt)-1)+"X"
|
|
ENDIF
|
|
|
|
IF NOT FILE(lcFile)
|
|
THIS.oApp.FileNotFoundMsgBox(lcFile)
|
|
RETURN
|
|
ENDIF
|
|
|
|
llDocumentFromDisk = .T.
|
|
|
|
ELSE
|
|
|
|
IF LEFT(THIS.aDocuments[liRow,1],FAVORITEPICKER_PICKED_LEN ) = ;
|
|
FAVORITEPICKER_PICKED_LOC
|
|
* we're removing a document
|
|
* we've been called from
|
|
* doubleclick on list or something,
|
|
* so let's toggle:
|
|
THIS.RemoveDocument()
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF THIS.lNew
|
|
lcFile = THIS.aDocuments[liRow,11]
|
|
THIS.aDocuments[liRow,1] = ;
|
|
FAVORITEPICKER_PICKED_LOC +THIS.aDocuments[liRow,1]
|
|
|
|
ELSE
|
|
* is this a document from disk instead
|
|
* of a metatable entry?
|
|
* documents from disk use only
|
|
* the first column of the array
|
|
IF EMPTY(THIS.aDocuments[liRow,11])
|
|
lcFile = THIS.aDocuments[liRow,1]
|
|
llDocumentFromDisk = .T.
|
|
lcExt = JUSTEXT(lcFile)
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
IF THIS.lNew
|
|
|
|
* we have a document to add to the
|
|
* list. Is it from the metatable or disk?
|
|
* and is it already there?
|
|
|
|
IF (NOT EMPTY(lcFile))
|
|
|
|
ALINES(laFavorites,THIS.oApp.cCurrentUserFavoriteIDs,.T.)
|
|
llExactSet = (SET("EXACT") = "OFF")
|
|
IF llExactSet
|
|
SET EXACT ON
|
|
ENDIF
|
|
|
|
IF (ASCAN(laFavorites,lcFile) = 0)
|
|
|
|
IF llDocumentFromDisk
|
|
liRow = ALEN(THIS.aDocuments,1)
|
|
IF VARTYPE(THIS.aDocuments[liRow,1]) = "C" AND ;
|
|
(NOT EMPTY(THIS.aDocuments[liRow,1]))
|
|
liRow = liRow + 1
|
|
DIME THIS.aDocuments[liRow,11]
|
|
ENDIF
|
|
THIS.aDocuments[liRow,1] = FAVORITEPICKER_PICKED_LOC +lcFile
|
|
|
|
ENDIF
|
|
THIS.lstDocuments.Requery()
|
|
THIS.lstDocuments.Value = liRow
|
|
THIS.RefreshFavoriteIDs(lcFile)
|
|
ELSE
|
|
|
|
MESSAGEBOX(lcFile+;
|
|
CHR(13)+CHR(13)+ ;
|
|
FAVORITEPICKER_DOC_ALREADY_LOC, ;
|
|
48,THISFORM.oApp.cCaption)
|
|
|
|
ENDIF
|
|
|
|
IF llExactSet
|
|
SET EXACT OFF
|
|
ENDIF
|
|
|
|
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
IF llDocumentFromDisk
|
|
|
|
THIS.oApp.DoFile(lcFile)
|
|
|
|
ELSE
|
|
|
|
DO CASE
|
|
|
|
CASE NOT EMPTY(THIS.aDocuments[liRow,9]) && alt-exec
|
|
|
|
lcStatement = ALLTR(THIS.aDocuments[liRow,9])
|
|
&lcStatement
|
|
|
|
CASE THIS.aDocuments[liRow,8] && wrapped
|
|
|
|
DO (ALLTRIM(THIS.aDocuments[liRow,2]))
|
|
|
|
OTHERWISE && report or form??
|
|
|
|
IF ALLTR(THIS.aDocuments[liRow,10]) = PJX_META_DOC_REPORT_TYPE
|
|
|
|
THIS.oApp.DoReport(ALLTRIM(THIS.aDocuments[liRow,2]), ;
|
|
ALLTRIM(THIS.aDocuments[liRow,1]))
|
|
ELSE
|
|
|
|
THIS.oApp.DoForm(ALLTRIM(THIS.aDocuments[liRow,2]), ;
|
|
ALLTRIM(THIS.aDocuments[liRow,3]), ;
|
|
THIS.aDocuments[liRow,4], ;
|
|
THIS.aDocuments[liRow,5], ;
|
|
THIS.aDocuments[liRow,6], ;
|
|
THIS.aDocuments[liRow,7])
|
|
ENDIF
|
|
|
|
ENDCASE
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE filldocumentsarray
|
|
LPARAMETERS tcMetaTableName
|
|
|
|
DIME THIS.aDocuments[1,11]
|
|
|
|
LOCAL liTally, liDocument, lcConditions, laFavorites[1], ;
|
|
liFaves, lcDocument, llExactSet, lcTable, liDocs
|
|
|
|
|
|
llExactSet = (SET("EXACT") = "OFF")
|
|
IF llExactSet
|
|
SET EXACT ON
|
|
ENDIF
|
|
|
|
liTally = 0
|
|
liDocs = 0
|
|
|
|
IF NOT EMPTY(tcMetaTableName)
|
|
lcTable = THIS.oApp.GetResourceFileName(tcMetaTableName,".dbf")
|
|
IF NOT EMPTY(lcTable)
|
|
lcConditions = " DOC_OPEN AND NOT DELETED() "
|
|
SELECT DOC_DESCR, DOC_EXEC, DOC_CLASS, ;
|
|
DOC_SINGLE, DOC_NOSHOW, ;
|
|
DOC_GO, DOC_NAV, ;
|
|
DOC_WRAP, ALT_EXEC, DOC_TYPE, APP_META_FAVE_ID AS DOC_ID ;
|
|
FROM (lcTable) ;
|
|
WHERE &lcConditions ;
|
|
INTO ARRAY THIS.aDocuments
|
|
|
|
* this is for a startup form, and picking favorites, using
|
|
* all metatable's document items, both reports and forms,
|
|
* so array fits both types of documents' usage
|
|
|
|
* above is form's use of metatable fields + one (doc_type) + ID field or expression
|
|
* below is report's use of fields (favorites/startup has to use both)
|
|
* report's use of fields:
|
|
* SELECT DOC_DESCR, DOC_EXEC, ;
|
|
* DOC_WRAP, ALT_EXEC ;
|
|
* FROM (tcMetaTableName) ;
|
|
* WHERE DOC_TYPE = PJX_META_DOC_REPORT_TYPE ;
|
|
* &lcConditions ;
|
|
* AND NOT DELETED() ;
|
|
* INTO ARRAY THIS.aDocuments
|
|
|
|
|
|
STORE _TALLY TO liTally, liDocs
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
liFaves = ALINES(laFavorites,THIS.oApp.cCurrentUserFavoriteIDs,.T.)
|
|
|
|
IF (liTally # 0)
|
|
|
|
FOR liDocument = 1 TO liTally
|
|
THIS.aDocuments[liDocument,11] = ALLTR(THIS.aDocuments[liDocument,11])
|
|
IF ASCAN(laFavorites,;
|
|
THIS.aDocuments[liDocument,11]) > 0
|
|
IF THIS.lNew
|
|
THIS.aDocuments[liDocument,1] = ;
|
|
FAVORITEPICKER_PICKED_LOC + ;
|
|
THIS.aDocuments[liDocument,1]
|
|
liTally = liTally - 1
|
|
* show as disabled items already
|
|
* in the user table as favorites
|
|
ENDIF
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
ENDIF
|
|
|
|
IF (liFaves # 0)
|
|
* if a favorite is a document on disk,
|
|
* rather than something from the metatable,
|
|
* add it to the list,
|
|
* disabled if we are in New,
|
|
* enabled otherwise
|
|
FOR EACH lcDocument IN laFavorites
|
|
IF NOT EMPTY(lcDocument) AND ;
|
|
ASCAN(THIS.aDocuments,lcDocument) = 0 AND ;
|
|
FILE(lcDocument)
|
|
liTally = liTally + 1
|
|
liDocs = liDocs + 1
|
|
DIME THIS.aDocuments[liDocs,11]
|
|
THIS.aDocuments[liDocs,1] = ALLTR(UPPER(lcDocument))
|
|
IF THIS.lNew
|
|
THIS.aDocuments[liDocs,1] = FAVORITEPICKER_PICKED_LOC + THIS.aDocuments[liDocs,1]
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ENDFOR
|
|
|
|
ENDIF
|
|
|
|
If llExactSet
|
|
SET EXACT OFF
|
|
ENDIF
|
|
|
|
IF THIS.lSorted
|
|
ASORT(THIS.aDocuments)
|
|
ENDIF
|
|
|
|
IF liDocs = 0 AND (THIS.lNew AND THIS.lAllowFileBrowsing)
|
|
* make sure list doesn't look stupid
|
|
THIS.aDocuments[1,1]=""
|
|
ENDIF
|
|
|
|
RETURN (liTally # 0) OR ;
|
|
(THIS.lNew AND (THIS.lAllowFileBrowsing OR liDocs # 0))
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
LPARAMETERS toApp, tlAdd
|
|
|
|
LOCAL laTemp[1], llReturn
|
|
|
|
THIS.lNew = tlAdd
|
|
|
|
THIS.oApp = toApp
|
|
|
|
ASSERT TYPE("toApp.cMetaTable") = "C" AND ;
|
|
ACLASS(laTemp,toApp) > 0 AND ;
|
|
ASCAN(laTemp,"_APPLICATION") > 0 ;
|
|
MESSAGE DOCUMENTPICKER_NO_APP_LOC
|
|
|
|
|
|
* override of some document picker stuff...
|
|
* favorites can work without a
|
|
* registered document table or a list at all...
|
|
|
|
DO CASE
|
|
CASE NOT THIS.FillDocumentsArray(toApp.cMetaTable)
|
|
|
|
IF THIS.lAllowFileBrowsing
|
|
LOCAL lcFile, lcWaitMessage
|
|
THIS.lNew = tlAdd
|
|
IF tlAdd
|
|
lcWaitMessage = FAVORITEPICKER_CAPTION_ADD_LOC
|
|
ELSE
|
|
lcWaitMessage = FAVORITEPICKER_CAPTION_START_LOC
|
|
ENDIF
|
|
WAIT WINDOW NOWAIT ;
|
|
LEFT(lcWaitMessage, 250)+"..."
|
|
lcFile = GETFILE()
|
|
WAIT CLEAR
|
|
IF (NOT EMPTY(lcFile)) AND FILE(lcFile)
|
|
THIS.ExecDocument(lcFile)
|
|
ENDIF
|
|
ELSE
|
|
MESSAGEBOX(DOCUMENTPICKER_NO_DOCUMENTS_LOC, ;
|
|
MB_ICONEXCLAMATION, ;
|
|
toApp.cCaption)
|
|
|
|
ENDIF
|
|
THIS.oApp = .NULL.
|
|
RETURN .F.
|
|
|
|
CASE ALEN(THIS.aDocuments,1) = 1 AND ;
|
|
NOT (tlAdd OR THIS.lAllowFileBrowsing)
|
|
|
|
THIS.lstDocuments.RowSource = "THISFORM.aDocuments"
|
|
THIS.lstDocuments.Value = 1
|
|
|
|
THIS.ExecDocument()
|
|
THIS.oApp = .NULL.
|
|
RETURN .F.
|
|
|
|
OTHERWISE
|
|
|
|
THIS.lstDocuments.RowSource = "THISFORM.aDocuments"
|
|
THIS.lstDocuments.Value = 1
|
|
|
|
IF tlAdd
|
|
THIS.Caption = FAVORITEPICKER_CAPTION_ADD_LOC
|
|
THIS.cmdOK.Caption = FAVORITEPICKER_ADDBUTTON_LOC
|
|
THIS.cmdCancel.Caption = FAVORITEPICKER_CLOSEBUTTON_LOC
|
|
THIS.cmdOK.Default = .F.
|
|
ELSE
|
|
THIS.Caption = FAVORITEPICKER_CAPTION_START_LOC
|
|
THIS.cmdCancel.Top = THIS.cmdRemove.Top
|
|
STORE .F. TO THIS.cmdRemove.Visible, ;
|
|
THIS.cmdRemove.Enabled
|
|
|
|
ENDIF
|
|
|
|
IF NOT THIS.lAllowFileBrowsing
|
|
STORE .F. TO THIS.cmdBrowse.Visible, ;
|
|
THIS.cmdBrowse.Enabled
|
|
ENDIF
|
|
|
|
ENDCASE
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE refreshbuttons
|
|
IF THIS.lNew
|
|
|
|
IF THIS.lstDocuments.Value = 0 OR ;
|
|
EMPTY(THIS.aDocuments[THIS.lstDocuments.Value,1])
|
|
|
|
STORE .F. TO THIS.cmdOK.Enabled, THIS.cmdRemove.Enabled
|
|
|
|
|
|
ELSE
|
|
|
|
STORE (LEFT(THIS.aDocuments[THIS.lstDocuments.Value,1], ;
|
|
FAVORITEPICKER_PICKED_LEN ) # ;
|
|
FAVORITEPICKER_PICKED_LOC ) TO ;
|
|
THIS.cmdOK.Enabled
|
|
|
|
STORE ! THIS.cmdOK.Enabled TO ;
|
|
THIS.cmdRemove.Enabled
|
|
ENDIF
|
|
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE refreshfavoriteids && Adds to the app cCurrentUserFavoriteIDs list when the user makes a new choice.
|
|
LPARAMETERS tcFavoriteIDToAdd
|
|
|
|
ASSERT THIS.lNew
|
|
|
|
LOCAL lcCurrentIDs, lcID, liID
|
|
|
|
IF VARTYPE(tcFavoriteIDToAdd) = "C" AND ;
|
|
NOT EMPTY(tcFavoriteIDToAdd)
|
|
|
|
lcID = ALLTRIM(tcFavoriteIDToAdd)
|
|
|
|
lcCurrentIDs = ALLTRIM(THIS.oApp.cCurrentUserFavoriteIDs)
|
|
|
|
IF INLIST(RIGHT(lcCurrentIDs,1), ;
|
|
CHR(13), CHR(10))
|
|
|
|
THIS.oApp.cCurrentUserFavoriteIDs = ;
|
|
lcCurrentIDs + lcID
|
|
|
|
ELSE
|
|
THIS.oApp.cCurrentUserFavoriteIDs = ;
|
|
lcCurrentIDs +CHR(13)+lcID
|
|
ENDIF
|
|
|
|
ELSE
|
|
* removing or otherwise doing a general refresh
|
|
|
|
lcCurrentIDs = ""
|
|
FOR liID = 1 TO ALEN(THIS.aDocuments,1)
|
|
IF LEFT(THIS.aDocuments[liID,1],FAVORITEPICKER_PICKED_LEN) = FAVORITEPICKER_PICKED_LOC
|
|
lcCurrentIDs = lcCurrentIDs + CHR(13)
|
|
IF EMPTY(THIS.aDocuments[liID,11])
|
|
lcCurrentIDs = lcCurrentIDs + SUBSTR(THIS.aDocuments[liID,1],FAVORITEPICKER_PICKED_LEN+1)
|
|
ELSE
|
|
lcCurrentIDs = lcCurrentIDs + THIS.aDocuments[liID,11]
|
|
ENDIF
|
|
ENDIF
|
|
ENDFOR
|
|
|
|
THIS.oApp.cCurrentUserFavoriteIDs = lcCurrentIDs
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE removedocument
|
|
ASSERT THIS.lNew
|
|
|
|
LOCAL liRow, liCount
|
|
liRow = THIS.lstDocuments.Value
|
|
liCount = ALEN(THIS.aDocuments,1)
|
|
|
|
|
|
IF (NOT BETWEEN(liRow,1,liCount)) OR ;
|
|
(LEFT(THIS.aDocuments[liRow,1], ;
|
|
FAVORITEPICKER_PICKED_LEN) # ;
|
|
FAVORITEPICKER_PICKED_LOC )
|
|
* shouldn't happen
|
|
RETURN
|
|
ENDIF
|
|
|
|
DO CASE
|
|
CASE EMPTY(THIS.aDocuments[liRow,1])
|
|
* empty first row, nothing to do
|
|
RETURN
|
|
CASE EMPTY(THIS.aDocuments[liRow,11])
|
|
* document on disk, remove from listbox
|
|
ADEL(THIS.aDocuments,liRow)
|
|
IF liCount > 1
|
|
liCount = liCount - 1
|
|
DIME THIS.aDocuments[liCount,11]
|
|
ELSE
|
|
THIS.aDocuments[1,1] = ""
|
|
ENDIF
|
|
OTHERWISE
|
|
* metatable entry, un-mark in listbox
|
|
THIS.aDocuments[liRow,1] = SUBSTR(THIS.aDocuments[liRow,1],;
|
|
FAVORITEPICKER_PICKED_LEN+1)
|
|
ENDCASE
|
|
|
|
THIS.lstDocuments.Requery()
|
|
IF liRow > liCount
|
|
THIS.lstDocuments.Value = liCount
|
|
ELSE
|
|
THIS.lstDocuments.Value = liRow
|
|
ENDIF
|
|
|
|
THIS.RefreshFavoriteIDs()
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Resize
|
|
DODEFAULT()
|
|
LOCAL lnMargin
|
|
lnMargin = THIS.Height - (THIS.lstDocuments.Top+THIS.lstDocuments.Height)
|
|
THIS.cmdBrowse.Top = THIS.Height - (THIS.cmdBrowse.Height + lnMargin)
|
|
STORE THIS.cmdCancel.Left TO THIS.cmdBrowse.Left, THIS.cmdRemove.Left
|
|
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setdialogsizeparameters
|
|
DODEFAULT()
|
|
THIS.MinHeight = MAX(THIS.MinHeight, ;
|
|
THIS.cmdCancel.Top + THIS.cmdCancel.Height + ;
|
|
THIS.cmdBrowse.Height + ;
|
|
THIS.lstDocuments.Top * 2)
|
|
THIS.Height = MAX(THIS.Height, THIS.MinHeight)
|
|
THIS.MaxHeight = MAX(THIS.Height, THIS.MaxHeight)
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdBrowse.Click
|
|
LOCAL lcFile
|
|
|
|
lcFile = GETFILE()
|
|
IF EMPTY(lcFile)
|
|
RETURN
|
|
ENDIF
|
|
IF FILE(lcFile)
|
|
THISFORM.ExecDocument(lcFile)
|
|
ENDIF
|
|
|
|
IF NOT THISFORM.lNew
|
|
THISFORM.Release()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdOK.Click
|
|
IF THISFORM.lNew
|
|
|
|
THISFORM.ExecDocument()
|
|
|
|
ELSE
|
|
|
|
DODEFAULT()
|
|
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdRemove.Click
|
|
THISFORM.RemoveDocument()
|
|
ENDPROC
|
|
|
|
PROCEDURE lstDocuments.DblClick
|
|
THISFORM.ExecDocument()
|
|
IF NOT THISFORM.lNew
|
|
THISFORM.Release()
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE lstDocuments.InteractiveChange
|
|
THISFORM.RefreshButtons()
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE lstDocuments.ProgrammaticChange
|
|
THIS.InteractiveChange()
|
|
ENDPROC
|
|
|
|
PROCEDURE lstDocuments.When
|
|
THIS.InteractiveChange()
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _formmediator AS _mediatedsession OF "_framewk.vcx" && member object to framework-enable any form
|
|
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*p: ccontextmenufile && Holds the name of a context menu you wish to attach to this mediator's host document.
|
|
*p: ccontextmenupad && Holds the pad name of the context menu so it can be removed when the host document destroys.
|
|
*p: ccontextmenupopup && Holds the pad name of the context menu popup so it can be released when the host document destroys.
|
|
*p: ctoolbarclass && Holds the name of a context toolbar class you wish to attach to this mediator's host document.
|
|
*p: ctoolbarclasslib && Holds the name of a class library containing the context toolbar class you wish to attach to this mediator's host document.
|
|
*p: icontextmenuindex && Provided to the mediator by the app when it invokes a context menu for the mediator's host document, passed back to the app by the mediator so the app can refresh its context menu collection when this host document destroys.
|
|
*p: itoolbarindex && Provided to the mediator by the app when it invokes a context toolbar for the mediator's host document, passed back to the app by the mediator so the app can refresh its context toolbar collection when this host document destroys.
|
|
*p: laddappicon && Specifies that the mediator should apply the application's standard Icon to the form's Icon property, if this property has been left empty. Defaults to .T.; turn it off if you want a borderless form!
|
|
*p: lgomenu && Specifies whether or not the host document has been assigned a navigation menu by the application and its metatable entry.
|
|
*p: lnavtoolbar && Specifies whether or not the host document has been assigned a navigation toolbar by the application and its metatable entry.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
ccontextmenufile = ("")
|
|
ccontextmenupad = ("")
|
|
ccontextmenupopup = ("")
|
|
ctoolbarclass = ("")
|
|
ctoolbarclasslib = ("")
|
|
icontextmenuindex = 0
|
|
itoolbarindex = 0
|
|
laddappicon = .T.
|
|
lsetdocumenttonewonappload = .T.
|
|
Name = "_formmediator"
|
|
*</PropValue>
|
|
|
|
PROCEDURE Destroy
|
|
DODEFAULT()
|
|
|
|
LOCAL loApp
|
|
|
|
loApp = THIS.GetAppRef()
|
|
|
|
IF ISNULL(loApp)
|
|
RETURN
|
|
ENDIF
|
|
|
|
|
|
IF NOT EMPTY(THIS.iContextMenuIndex)
|
|
|
|
loApp.ReleaseContextMenu(THIS.iContextMenuIndex)
|
|
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(THIS.iToolbarIndex)
|
|
|
|
loApp.ReleaseToolbar(THIS.iToolbarIndex)
|
|
|
|
ENDIF
|
|
|
|
loApp = .NULL.
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE loadapp
|
|
LPARAMETERS tcAppRef
|
|
IF DODEFAULT(tcAppRef)
|
|
LOCAL loApp
|
|
loApp = THIS.GetAppRef()
|
|
IF NOT (EMPTY(THIS.cContextMenuFile) OR ;
|
|
EMPTY(THIS.cContextMenuPad) OR ;
|
|
EMPTY(THIS.cContextMenuPopup))
|
|
|
|
THIS.iContextMenuIndex = ;
|
|
loApp.DoContextMenu(THIS.cContextMenuFile, THIS.cContextMenuPad, THIS.cContextMenuPopup)
|
|
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(THIS.cToolbarClass)
|
|
|
|
THIS.iToolbarIndex = ;
|
|
loApp.DoToolbar(THIS.cToolbarClassLib, THIS.cToolbarClass)
|
|
|
|
ENDIF
|
|
|
|
IF THIS.lAddAppIcon AND ;
|
|
EMPTY(THISFORM.Icon) AND ;
|
|
NOT THISFORM.TitleBar = 0
|
|
THISFORM.Icon = loApp.cIcon
|
|
ENDIF
|
|
|
|
loApp = NULL
|
|
|
|
ELSE
|
|
RETURN .F.
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _mediatedsession AS _custom OF "..\ffc\_base.vcx"
|
|
*<ClassComment>
|
|
*Mediator object to framework-enable a datasession. Drop on form to handle the datasession of the form/formset, or pass Init(tlCreateSession,tcSessionClass, tcSessionClassLib) to create and wrap a non-visual session.
|
|
*</ClassComment>
|
|
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: cleanupoutputalias && Abstract, see PrepareOutputAlias(). If you have created a temporary cursor for the purposes of DoTableOutput(), here's your chance to destroy it.
|
|
*m: coutputalias_assign
|
|
*m: coutputcaption_access
|
|
*m: createsession && Creates the session object if .T. passed to the class upon instantiation
|
|
*m: csessionclasslib_access
|
|
*m: csessionclass_access
|
|
*m: datachanged && Wraps application QueryDataChanged method, using iChangeMode specific to this object.
|
|
*m: datasessionid_access
|
|
*m: datasessionid_assign
|
|
*m: datasessionname_access
|
|
*m: datasessionname_assign
|
|
*m: datasession_access
|
|
*m: datasession_assign
|
|
*m: dosessionsets && If lSessionSettings is .T., invokes app SetDataSessionEnvironment() method for this session If lUserSessionSettings is .T., invokes app ApplyUserOptsForSession() method for this session.
|
|
*m: getappref && RETURNs an object reference to the app.
|
|
*m: loadapp && Applies app attributes, including session settings. Sets new or open status if lSetDocumentToNewOnAppLoad is .T..
|
|
*m: output && Wraps the app DoTableOutput() method.
|
|
*m: outputonerecord && Wraps the app DoTableOutput() method with a scope of one record.
|
|
*m: pickrecordtoworkon && Abstract, available to evaluate whether form has been invoked in "new" or "open" mode, and for you to add record browsing/navigation/APPEND BLANK/whatever based on this information.
|
|
*m: prepareoutputalias && Abstract, will be invoked by app's DoTableOutput() so you can SELECT a focus table, or put together a cursor, filter data, or otherwise prepare appropriate "focussed" table information when the user chooses to get quick output from any form.
|
|
*m: queryunload && Invokes the app's QueryDataSessionUnload for this Session. If used with a form, should be called in the form's QueryUnload() to handle any data changes, updates, or reverts before the form is closed.
|
|
*m: setdocumenttonew && Stores the app's lAddingNewDocument flag at the time the app attributes are loaded, so the form can evaluate what record to work on.
|
|
*m: writesessionclassdefinition && Not currently used; designed to provide a model for generation of a class definition file if desired. Would be called by the cSessionClassLib access method.
|
|
*p: cappref && Holds the name of the reference variable for the running app so the mediator can evaluate it to an object reference when necessary. The mediator does not store any object references, for safety.
|
|
*p: coutputalias && Allows you to indicate the right alias to "focus on" when the app DoTableOutput method runs, without any additional work in PrepareOutputAlias() and CleanupOutputAlias().
|
|
*p: coutputcaption && Will be passed by the app's DoTableOutput() to the _outputdialog, if used.
|
|
*p: csessionclass && The programmatic class definition to instance if .T. is passed to the class. By default, an instance of the session baseclass is created.
|
|
*p: csessionclasslib && The programmatic classlibrary holding the cSessionClass class definition you wish to instantiate. By default, an instance of the session baseclass is created.
|
|
*p: datasession && Wraps the Datasession property of the session object, if this mediator created one
|
|
*p: datasessionid && Wraps the DatasessionID property of the session object, if this mediator created one
|
|
*p: datasessionname && Wraps the Name property of the session object, if this mediator created one
|
|
*p: ichangemode && Sent on to the app's cusDataSession object to detemine what constitutes data change. 0 - anything changed. 1 - ignore view fields not in Updatefields list. 2- ignore views not set to send updates.
|
|
*p: ladding && Stores information about whether the framework invoked a session for "new" or "open" editing.
|
|
*p: lsessionsettings && Specifies whether the mediator should load session settings using the application's defaults.
|
|
*p: lsetdocumenttonewonappload && If .T., specifies that mediator should invoke SetDocumentToNew() in LoadApp.
|
|
*p: lusersessionsettings && Specifies whether the mediator should load data-session-specific user settings using the application's defaults.
|
|
*p: osession && If .T. is passed to the _mediator class when it's instanced, holds the session object for this mediator. Otherwise the mediator looks for its parent form's session.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
cappref = ("")
|
|
coutputalias =
|
|
coutputcaption =
|
|
csessionclass =
|
|
csessionclasslib =
|
|
datasession = 1
|
|
datasessionname =
|
|
ichangemode = 0
|
|
lusersessionsettings = .T.
|
|
Name = "_mediatedsession"
|
|
osession = .NULL.
|
|
*</PropValue>
|
|
|
|
PROCEDURE cleanupoutputalias && Abstract, see PrepareOutputAlias(). If you have created a temporary cursor for the purposes of DoTableOutput(), here's your chance to destroy it.
|
|
ENDPROC
|
|
|
|
PROCEDURE coutputalias_assign
|
|
LPARAMETERS tvNewVal
|
|
IF VARTYPE(tvNewVal) = "C" AND USED(tvNewVal)
|
|
THIS.cOutputAlias = tvNewVal
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE coutputcaption_access
|
|
IF EMPTY(THIS.cOutputCaption) AND (NOT EMPTY(THIS.cOutputAlias))
|
|
RETURN PROPER(THIS.cOutputAlias)
|
|
ELSE
|
|
RETURN THIS.cOutputCaption
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE createsession && Creates the session object if .T. passed to the class upon instantiation
|
|
lcClass = THIS.cSessionClass
|
|
lcClassLib = THIS.cSessionClassLib
|
|
IF EMPTY(lcClassLib)
|
|
RETURN CREATEOBJECT("Session")
|
|
ELSE
|
|
RETURN NEWOBJECT(lcClass, lcClassLib)
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE csessionclasslib_access
|
|
LOCAL lcVal
|
|
|
|
IF VARTYPE(THIS.cSessionClassLib) # "C" OR EMPTY(THIS.cSessionClassLib)
|
|
*!* * to generate:
|
|
*!* lcVal = ADDBS(GETENV("TEMP"))+"C"+SYS(2015)+".PRG"
|
|
lcVal = ""
|
|
ELSE
|
|
lcVal = FORCEEXT(THIS.cSessionClassLib,"FXP")
|
|
IF NOT FILE(lcVal) && either on disk or bound
|
|
|
|
*!* * to generate:
|
|
*!* IF NOT DIRECTORY(JUSTPATH(lcVal))
|
|
*!* lcVal = FORCEPATH(lcVal,ADDBS(GETENV("TEMP")))
|
|
*!* ENDIF
|
|
|
|
*!* lcVal = FORCEEXT(lcVal,"PRG")
|
|
|
|
*!* IF EMPTY(SYS(2000,lcVal))
|
|
*!* THIS.WriteSessionClassDefinition(lcVal)
|
|
*!* ENDIF
|
|
|
|
*!* lcVal = FORCEEXT(lcVal,"FXP")
|
|
|
|
lcVal = FORCEEXT(lcVal,"PRG")
|
|
IF EMPTY(SYS(2000,lcVal)) && on disk
|
|
lcVal = ""
|
|
ELSE
|
|
COMPILE (lcVal)
|
|
lcVal = FORCEEXT(lcVal,"FXP")
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
THIS.cSessionClassLib = lcVal
|
|
|
|
RETURN THIS.cSessionClassLib
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE csessionclass_access
|
|
IF VARTYPE(THIS.cSessionClass) # "C" ;
|
|
OR EMPTY(THIS.cSessionClass) ;
|
|
OR VARTYPE(THIS.cSessionClassLib) # "C" ;
|
|
OR EMPTY(THIS.cSessionClassLib)
|
|
* THIS.cSessionClass = "Session"+SYS(2015)
|
|
THIS.cSessionClass = "Session"
|
|
ENDIF
|
|
RETURN THIS.cSessionClass
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE datachanged && Wraps application QueryDataChanged method, using iChangeMode specific to this object.
|
|
LOCAL loApp, llReturn, loSession
|
|
|
|
loApp = THIS.GetAppRef()
|
|
|
|
IF ISNULL(loApp)
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF ISNULL(THIS.oSession)
|
|
IF TYPE("THISFORM") # "O"
|
|
RETURN
|
|
ELSE
|
|
loSession = THISFORM
|
|
ENDIF
|
|
ELSE
|
|
loSession = THIS.oSession
|
|
ENDIF
|
|
|
|
llReturn = NOT ISNULL(loSession)
|
|
|
|
IF llReturn
|
|
llReturn = loApp.QueryDataChanged(loSession,THIS.iChangeMode)
|
|
ENDIF
|
|
|
|
STORE .NULL. TO loApp, loSession
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE datasessionid_access
|
|
IF ISNULL(THIS.oSession)
|
|
RETURN SET("DATASESSION")
|
|
ELSE
|
|
RETURN THIS.oSession.DataSessionID
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE datasessionid_assign
|
|
LPARAMETERS tvNewVal
|
|
* don't allow assignment
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE datasessionname_access
|
|
IF ISNULL(THIS.oSession)
|
|
RETURN ""
|
|
ELSE
|
|
RETURN THIS.oSession.Name
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE datasessionname_assign
|
|
LPARAMETERS vNewVal
|
|
* readonly, don't allow assignment
|
|
ENDPROC
|
|
|
|
PROCEDURE datasession_access
|
|
IF ISNULL(THIS.oSession)
|
|
IF TYPE("THISFORMSET.BaseClass") = "C"
|
|
RETURN THISFORMSET.DataSession
|
|
ELSE
|
|
RETURN THISFORM.DataSession
|
|
ENDIF
|
|
ELSE
|
|
RETURN THIS.oSession.DataSession
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE datasession_assign
|
|
LPARAMETERS vNewVal
|
|
* don't allow assignment
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
DODEFAULT()
|
|
THIS.oSession = NULL
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE dosessionsets && If lSessionSettings is .T., invokes app SetDataSessionEnvironment() method for this session If lUserSessionSettings is .T., invokes app ApplyUserOptsForSession() method for this session.
|
|
LPARAMETERS toApp
|
|
|
|
LOCAL loApp
|
|
|
|
loApp = NULL
|
|
|
|
IF VARTYPE(toApp) = "O"
|
|
* called from LoadApp
|
|
* or something else that knows
|
|
* the app already
|
|
loApp = toApp
|
|
ELSE
|
|
loApp = THIS.GetAppRef()
|
|
ENDIF
|
|
|
|
IF ISNULL(loApp)
|
|
RETURN
|
|
ENDIF
|
|
|
|
|
|
IF THIS.lSessionSettings
|
|
|
|
DO CASE
|
|
|
|
CASE NOT ISNULL(THIS.oSession)
|
|
|
|
loApp.SetDataSessionEnvironment(THIS.oSession.DataSessionID)
|
|
|
|
CASE TYPE("THISFORMSET.DataSession") = "N" AND ;
|
|
THISFORMSET.DataSession # 1
|
|
|
|
loApp.SetDataSessionEnvironment(THISFORMSET.DataSessionID)
|
|
|
|
CASE THISFORM.DataSession # 1
|
|
|
|
loApp.SetDataSessionEnvironment(THISFORM.DataSessionID)
|
|
|
|
OTHERWISE
|
|
|
|
* a form or formset in the default session, don't touch
|
|
|
|
ENDCASE
|
|
|
|
ENDIF
|
|
|
|
|
|
IF THIS.lUserSessionSettings
|
|
|
|
IF NOT ISNULL(THIS.oSession)
|
|
loApp.ApplyUserOptsForSession(THIS.oSession)
|
|
ELSE
|
|
loApp.ApplyUserOptsForSession(THISFORM)
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
loApp = NULL
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE getappref && RETURNs an object reference to the app.
|
|
IF EMPTY(THIS.cAppRef)
|
|
RETURN .NULL.
|
|
ENDIF
|
|
|
|
LOCAL ARRAY laCheck[1]
|
|
|
|
IF TYPE(THIS.cAppRef+".BaseClass") = "C" ;
|
|
AND ACLASS(laCheck,EVAL(THIS.cAppRef)) > 0 AND ;
|
|
ASCAN(laCheck,"_APPLICATION") > 0
|
|
|
|
RETURN EVAL(THIS.cAppRef)
|
|
ELSE
|
|
RETURN .NULL.
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
LPARAMETERS tlCreateSession, tcSessionClass, tcSessionClassLib
|
|
IF DODEFAULT()
|
|
IF tlCreateSession
|
|
IF NOT (EMPTY(tcSessionClass) OR EMPTY(tcSessionClassLib))
|
|
THIS.cSessionClass = tcSessionClass
|
|
THIS.cSessionClassLib = tcSessionClassLib
|
|
ENDIF
|
|
THIS.oSession = THIS.CreateSession()
|
|
IF VARTYPE(THIS.oSession) # "O"
|
|
RETURN .F.
|
|
ENDIF
|
|
ELSE
|
|
IF TYPE("THISFORM") # "O"
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE loadapp && Applies app attributes, including session settings. Sets new or open status if lSetDocumentToNewOnAppLoad is .T..
|
|
LPARAMETERS tcAppRef
|
|
|
|
THIS.cAppRef = tcAppRef
|
|
|
|
LOCAL loApp
|
|
|
|
loApp = THIS.GetAppRef()
|
|
|
|
IF ISNULL(loApp)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
THIS.DoSessionSets(loApp)
|
|
|
|
IF THIS.lSetDocumentToNewOnAppLoad
|
|
THIS.SetDocumentToNew(loApp)
|
|
ENDIF
|
|
|
|
loApp = .NULL.
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE output && Wraps the app DoTableOutput() method.
|
|
LOCAL loApp, llReturn
|
|
|
|
loApp = THIS.GetAppRef()
|
|
|
|
IF ISNULL(loApp)
|
|
RETURN
|
|
ENDIF
|
|
|
|
llReturn = loApp.DoTableOutput()
|
|
|
|
loApp = .NULL.
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE outputonerecord && Wraps the app DoTableOutput() method with a scope of one record.
|
|
LOCAL loApp, llReturn
|
|
|
|
loApp = THIS.GetAppRef()
|
|
|
|
IF ISNULL(loApp)
|
|
RETURN
|
|
ENDIF
|
|
|
|
llReturn = loApp.DoTableOutput(.T.)
|
|
|
|
loApp = .NULL.
|
|
|
|
RETURN llReturn
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE pickrecordtoworkon && Abstract, available to evaluate whether form has been invoked in "new" or "open" mode, and for you to add record browsing/navigation/APPEND BLANK/whatever based on this information.
|
|
ENDPROC
|
|
|
|
PROCEDURE prepareoutputalias && Abstract, will be invoked by app's DoTableOutput() so you can SELECT a focus table, or put together a cursor, filter data, or otherwise prepare appropriate "focussed" table information when the user chooses to get quick output from any form.
|
|
ENDPROC
|
|
|
|
PROCEDURE queryunload && Invokes the app's QueryDataSessionUnload for this Session. If used with a form, should be called in the form's QueryUnload() to handle any data changes, updates, or reverts before the form is closed.
|
|
LPARAMETERS tlDataChangeAlreadyConfirmed
|
|
|
|
LOCAL loApp, llReturn, loSession
|
|
|
|
loApp = THIS.GetAppRef()
|
|
|
|
IF ISNULL(loApp)
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF ISNULL(THIS.oSession)
|
|
IF TYPE("THISFORM") # "O"
|
|
RETURN
|
|
ELSE
|
|
loSession = THISFORM
|
|
ENDIF
|
|
ELSE
|
|
loSession = THIS.oSession
|
|
ENDIF
|
|
|
|
llReturn = NOT ISNULL(loSession)
|
|
|
|
IF llReturn
|
|
llReturn = loApp.QueryDataSessionUnload(tlDataChangeAlreadyConfirmed,loSession)
|
|
ENDIF
|
|
|
|
STORE .NULL. TO loApp, loSession
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setdocumenttonew && Stores the app's lAddingNewDocument flag at the time the app attributes are loaded, so the form can evaluate what record to work on.
|
|
LPARAMETERS toApp
|
|
LOCAL loApp
|
|
loApp = NULL
|
|
IF VARTYPE(toApp) = "O"
|
|
* called from LoadApp
|
|
* or something else that knows
|
|
* the app already
|
|
loApp = toApp
|
|
ELSE
|
|
loApp = THIS.GetAppRef()
|
|
ENDIF
|
|
|
|
IF ISNULL(loApp)
|
|
RETURN
|
|
ENDIF
|
|
|
|
THIS.lAdding = loApp.lAddingNewDocument
|
|
|
|
loApp = .NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE writesessionclassdefinition && Not currently used; designed to provide a model for generation of a class definition file if desired. Would be called by the cSessionClassLib access method.
|
|
LPARAMETERS tcFileName
|
|
* not currently used,
|
|
* for generation purposes
|
|
LOCAL lcFileName, llSafety
|
|
IF EMPTY(tcFileName)
|
|
RETURN
|
|
ELSE
|
|
lcFileName = tcFileName
|
|
ENDIF
|
|
llSafety = (SET("SAFETY") == "ON")
|
|
IF llSafety
|
|
SET SAFETY OFF
|
|
ENDIF
|
|
lcFileName = FORCEEXT(lcFileName,"PRG")
|
|
STRTOFILE("DEFINE CLASS "+THIS.cSessionClass+" AS Session"+CHR(13)+CHR(10),lcFileName)
|
|
STRTOFILE("DataSession = 2"+CHR(13)+CHR(10),lcFileName,.T.)
|
|
STRTOFILE("ENDDEFINE"+CHR(13)+CHR(10),lcFileName,.T.)
|
|
COMPILE (lcFileName)
|
|
ERASE (lcFileName)
|
|
THIS.cSessionClassLib = FORCEEXT(lcFileName,"FXP")
|
|
IF llSafety
|
|
SET SAFETY ON
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _navtoolbar AS _modalawaretoolbar OF "..\ffc\_ui.vcx" && superclass for framework-supplied default navigation toolbar (application object makes a nav toolbar class available to any form designated as using a nav toolbar in the metatable)
|
|
*< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="_separator1" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdTop" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdPrev" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdNext" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdBottom" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="spnGo" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdSortUp" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdSortDown" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="_separator2" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdFilter" UniqueID="" Timestamp="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*p: oapp
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
Caption = "Navigate"
|
|
ControlBox = .F.
|
|
Height = 30
|
|
Left = 0
|
|
Name = "_navtoolbar"
|
|
oapp = .NULL.
|
|
Top = 0
|
|
Width = 234
|
|
*</PropValue>
|
|
|
|
ADD OBJECT '_separator1' AS _separator WITH ;
|
|
Height = 30, ;
|
|
Left = 5, ;
|
|
Name = "_separator1", ;
|
|
Top = 3, ;
|
|
Width = 103
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" />
|
|
|
|
ADD OBJECT '_separator2' AS _separator WITH ;
|
|
Height = 29, ;
|
|
Left = 205, ;
|
|
Name = "_separator2", ;
|
|
Top = 3, ;
|
|
Width = 58
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" />
|
|
|
|
ADD OBJECT 'cmdBottom' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 74, ;
|
|
Name = "cmdBottom", ;
|
|
Picture = graphics\bottom.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 4
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdFilter' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 205, ;
|
|
Name = "cmdFilter", ;
|
|
Picture = graphics\filter.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 8
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdNext' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 51, ;
|
|
Name = "cmdNext", ;
|
|
Picture = graphics\next.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 3
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdPrev' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 28, ;
|
|
Name = "cmdPrev", ;
|
|
Picture = graphics\previous.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 2
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdSortDown' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 174, ;
|
|
Name = "cmdSortDown", ;
|
|
Picture = graphics\sortdes.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 7
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdSortUp' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 151, ;
|
|
Name = "cmdSortUp", ;
|
|
Picture = graphics\sortasc.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 6
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdTop' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 5, ;
|
|
Name = "cmdTop", ;
|
|
Picture = graphics\top.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 1
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'spnGo' AS _spinner WITH ;
|
|
Height = 24, ;
|
|
Left = 97, ;
|
|
Name = "spnGo", ;
|
|
SpecialEffect = 2, ;
|
|
Top = 3, ;
|
|
Width = 55, ;
|
|
ZOrderSet = 5
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="spinner" />
|
|
|
|
PROCEDURE Destroy
|
|
DODEFAULT()
|
|
THIS.oApp = .NULL.
|
|
ENDPROC
|
|
|
|
PROCEDURE Refresh
|
|
LOCAL llEnable
|
|
|
|
IF NOT THIS.lDisabledForModal
|
|
NODEFAULT
|
|
DO CASE
|
|
CASE TYPE("_SCREEN.ActiveForm.Parent") = "O"
|
|
SET DATASESSION TO _SCREEN.ActiveForm.Parent.DataSessionID
|
|
CASE TYPE("_SCREEN.ActiveForm") = "O"
|
|
SET DATASESSION TO _SCREEN.ActiveForm.DataSessionID
|
|
OTHERWISE
|
|
* we're wherever we should be...
|
|
ENDCASE
|
|
llEnable = (RECCOUNT() > 1)
|
|
IF llEnable
|
|
* everything has been enabled
|
|
WITH THIS.spnGo
|
|
STORE 1 TO .SpinnerLowValue, .KeyBoardLowValue
|
|
STORE RECCOUNT() TO ;
|
|
.SpinnerHighValue, .KeyBoardHighValue
|
|
.Value = RECNO()
|
|
.Value = MIN(.Value,.SpinnerHighValue) && EOF()
|
|
ENDWITH
|
|
ELSE
|
|
THIS.SetAll("Enabled", .F.)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN llEnable
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdBottom.Click
|
|
IF NOT ISNULL(THIS.Parent.oApp)
|
|
THIS.Parent.oApp.GoBottom()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdFilter.Click
|
|
IF NOT ISNULL(THIS.Parent.oApp)
|
|
THIS.Parent.oApp.ShowTableSetFilterDialog()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdNext.Click
|
|
IF NOT ISNULL(THIS.Parent.oApp)
|
|
THIS.Parent.oApp.GoNext()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdPrev.Click
|
|
IF NOT ISNULL(THIS.Parent.oApp)
|
|
THIS.Parent.oApp.GoPrevious()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdSortDown.Click
|
|
IF NOT ISNULL(THIS.Parent.oApp)
|
|
THIS.Parent.oApp.DoSort(,,,.T.)
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdSortUp.Click
|
|
IF NOT ISNULL(THIS.Parent.oApp)
|
|
THIS.Parent.oApp.DoSort(,,,.F.)
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdTop.Click
|
|
IF NOT ISNULL(THIS.Parent.oApp)
|
|
THIS.Parent.oApp.GoTop()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE spnGo.InteractiveChange
|
|
IF NOT ISNULL(THIS.Parent.oApp)
|
|
THIS.Parent.oApp.GoToRecord(THIS.Value)
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _newopen AS _documentpicker OF "_framewk.vcx" && superclass for framework-supplied default dialog to add or edit a document
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<PropValue>
|
|
DoCreate = .T.
|
|
Name = "_newopen"
|
|
lstDocuments.Name = "lstDocuments"
|
|
cmdOK.Name = "cmdOK"
|
|
cmdCancel.Name = "cmdCancel"
|
|
*</PropValue>
|
|
|
|
PROCEDURE execdocument
|
|
LOCAL liRow
|
|
|
|
liRow = THISFORM.lstDocuments.Value
|
|
|
|
IF EMPTY(liRow)
|
|
RETURN
|
|
ENDIF
|
|
|
|
DO CASE
|
|
|
|
CASE NOT EMPTY(THIS.aDocuments[liRow,9]) && alt-exec
|
|
LOCAL lcStatement
|
|
lcStatement = ALLTR(THIS.aDocuments[liRow,9])
|
|
|
|
&lcStatement
|
|
|
|
CASE THIS.aDocuments[liRow,8] && wrapped
|
|
DO (ALLTRIM(THIS.aDocuments[liRow,2]))
|
|
|
|
OTHERWISE && form or form class
|
|
|
|
THIS.oApp.DoForm(ALLTRIM(THIS.aDocuments[liRow,2]), ;
|
|
ALLTRIM(THIS.aDocuments[liRow,3]), ;
|
|
THIS.aDocuments[liRow,4], ;
|
|
THIS.aDocuments[liRow,5], ;
|
|
THIS.aDocuments[liRow,6], ;
|
|
THIS.aDocuments[liRow,7])
|
|
ENDCASE
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE filldocumentsarray
|
|
LPARAMETERS tcMetaTableName
|
|
|
|
DIME THIS.aDocuments[1,9]
|
|
* array has 9 columns to match meta data info
|
|
* First is visible description, plus 6 columns of DoForm params,
|
|
* and then "wrapped" column meaning "this is a program not a class"
|
|
* followed by "alt-exec" column, which gets macro-evaluated if used
|
|
|
|
|
|
* LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlNoShow, tlGoMenu, tlNavToolbar
|
|
* are the doform params...
|
|
|
|
IF EMPTY(tcMetaTableName)
|
|
|
|
RETURN .F.
|
|
|
|
ENDIF
|
|
|
|
LOCAL lcConditions
|
|
|
|
IF THIS.lNew
|
|
lcConditions = " AND DOC_NEW "
|
|
ELSE
|
|
lcConditions = " AND DOC_OPEN "
|
|
ENDIF
|
|
|
|
lcConditions = lcConditions + " AND NOT DELETED() "
|
|
|
|
IF THIS.lSorted
|
|
lcConditions = lcConditions + " ORDER BY 1 "
|
|
ENDIF
|
|
|
|
|
|
SELECT DOC_DESCR, DOC_EXEC, DOC_CLASS, ;
|
|
DOC_SINGLE, DOC_NOSHOW, ;
|
|
DOC_GO, DOC_NAV, ;
|
|
DOC_WRAP, ALT_EXEC ;
|
|
FROM (tcMetaTableName) ;
|
|
WHERE DOC_TYPE = PJX_META_DOC_FORM_TYPE ;
|
|
&lcConditions ;
|
|
INTO ARRAY THIS.aDocuments
|
|
|
|
RETURN ( _TALLY # 0)
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
LPARAMETERS toApp, tlNew
|
|
|
|
IF NOT DODEFAULT(toApp,tlNew)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
IF tlNew
|
|
THIS.Caption = NEWOPEN_CAPTION_NEW_LOC
|
|
ELSE
|
|
THIS.Caption = NEWOPEN_CAPTION_OPEN_LOC
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _options AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default dialog to edit, apply, or save user options
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="shpGlobalItems" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="shpDocumentItems" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdApply" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdSetDefault" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdResetToDefault" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="chkConfirm" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="chkShowTips" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblTextDisplay" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cboTextDisplayFont" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblBell" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblDocumentOptions" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblGlobalOptions" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblHours" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="opgBell" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="opgHours" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="txtBell" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdPickWav" UniqueID="" Timestamp="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*m: displaycurrentuseroptions
|
|
*m: displayoptions
|
|
*m: displayuserdefaultoptions
|
|
*m: saveuseroptionsfromdisplay
|
|
*m: setfromdisplay
|
|
*m: setuseroptionsfromdisplay
|
|
*p: oapp
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
BufferMode = 2
|
|
Caption = "Options"
|
|
DoCreate = .T.
|
|
Height = 190
|
|
KeyPreview = .T.
|
|
Name = "_options"
|
|
oapp = .NULL.
|
|
Width = 345
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'cboTextDisplayFont' AS _combobox WITH ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 21, ;
|
|
Left = 101, ;
|
|
Name = "cboTextDisplayFont", ;
|
|
Style = 2, ;
|
|
TabIndex = 8, ;
|
|
Top = 114, ;
|
|
Value = (""), ;
|
|
Width = 229, ;
|
|
ZOrderSet = 8
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="combobox" />
|
|
|
|
ADD OBJECT 'chkConfirm' AS _checkbox WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
Caption = "Confirm entry when leaving text fields", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Left = 16, ;
|
|
Name = "chkConfirm", ;
|
|
TabIndex = 2, ;
|
|
Top = 24, ;
|
|
ZOrderSet = 5
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="checkbox" />
|
|
|
|
ADD OBJECT 'chkShowTips' AS _checkbox WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
Caption = "Show tool tips in forms", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 15, ;
|
|
Left = 16, ;
|
|
Name = "chkShowTips", ;
|
|
TabIndex = 3, ;
|
|
Top = 41, ;
|
|
Width = 123, ;
|
|
ZOrderSet = 6
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="checkbox" />
|
|
|
|
ADD OBJECT 'cmdApply' AS _commandbutton WITH ;
|
|
Caption = "\<Apply Now", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 24, ;
|
|
Left = 238, ;
|
|
Name = "cmdApply", ;
|
|
TabIndex = 13, ;
|
|
Top = 9, ;
|
|
Width = 100, ;
|
|
ZOrderSet = 2
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdPickWav' AS _commandbutton WITH ;
|
|
AutoSize = .T., ;
|
|
Caption = "...", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Left = 303, ;
|
|
Name = "cmdPickWav", ;
|
|
TabIndex = 12, ;
|
|
Top = 147
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdResetToDefault' AS _commandbutton WITH ;
|
|
AutoSize = .F., ;
|
|
Caption = "\<Reset To Default", ;
|
|
Default = .F., ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 24, ;
|
|
Left = 238, ;
|
|
Name = "cmdResetToDefault", ;
|
|
TabIndex = 14, ;
|
|
Top = 37, ;
|
|
Width = 100, ;
|
|
ZOrderSet = 4
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdSetDefault' AS _commandbutton WITH ;
|
|
AutoSize = .F., ;
|
|
Caption = "\<Save As Default", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 24, ;
|
|
Left = 238, ;
|
|
Name = "cmdSetDefault", ;
|
|
TabIndex = 15, ;
|
|
Top = 66, ;
|
|
Width = 100, ;
|
|
ZOrderSet = 3
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'lblBell' AS _label WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
Caption = "Warning sound:", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Left = 15, ;
|
|
Name = "lblBell", ;
|
|
TabIndex = 9, ;
|
|
Top = 137, ;
|
|
ZOrderSet = 7
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'lblDocumentOptions' AS _label WITH ;
|
|
AutoSize = .T., ;
|
|
Caption = "Document options", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Left = 13, ;
|
|
Name = "lblDocumentOptions", ;
|
|
TabIndex = 1, ;
|
|
Top = 8, ;
|
|
ZOrderSet = 7
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'lblGlobalOptions' AS _label WITH ;
|
|
AutoSize = .T., ;
|
|
Caption = "Global options", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Left = 13, ;
|
|
Name = "lblGlobalOptions", ;
|
|
TabIndex = 6, ;
|
|
Top = 100, ;
|
|
ZOrderSet = 7
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'lblHours' AS _label WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
Caption = "Hours display:", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Left = 15, ;
|
|
Name = "lblHours", ;
|
|
TabIndex = 4, ;
|
|
Top = 62, ;
|
|
ZOrderSet = 7
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'lblTextDisplay' AS _label WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
Caption = "Text display font:", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Left = 15, ;
|
|
Name = "lblTextDisplay", ;
|
|
TabIndex = 7, ;
|
|
Top = 117, ;
|
|
ZOrderSet = 7
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'opgBell' AS _optiongroup WITH ;
|
|
BackStyle = 0, ;
|
|
BorderStyle = 0, ;
|
|
ButtonCount = 3, ;
|
|
Height = 21, ;
|
|
Left = 9, ;
|
|
Name = "opgBell", ;
|
|
TabIndex = 10, ;
|
|
Top = 149, ;
|
|
Width = 145, ;
|
|
OPTION1.AutoSize = .T., ;
|
|
OPTION1.BackStyle = 0, ;
|
|
OPTION1.Caption = "Off", ;
|
|
OPTION1.FontName = "MS Sans Serif", ;
|
|
OPTION1.FontSize = 8, ;
|
|
OPTION1.Left = 5, ;
|
|
OPTION1.Name = "OPTION1", ;
|
|
OPTION1.Top = 3, ;
|
|
OPTION2.AutoSize = .T., ;
|
|
OPTION2.BackStyle = 0, ;
|
|
OPTION2.Caption = "Default", ;
|
|
OPTION2.FontName = "MS Sans Serif", ;
|
|
OPTION2.FontSize = 8, ;
|
|
OPTION2.Left = 42, ;
|
|
OPTION2.Name = "OPTION2", ;
|
|
OPTION2.Top = 3, ;
|
|
Option3.AutoSize = .T., ;
|
|
Option3.BackStyle = 0, ;
|
|
Option3.Caption = "Play:", ;
|
|
Option3.FontName = "MS Sans Serif", ;
|
|
Option3.FontSize = 8, ;
|
|
Option3.Height = 15, ;
|
|
Option3.Left = 99, ;
|
|
Option3.Name = "Option3", ;
|
|
Option3.Top = 3, ;
|
|
Option3.Width = 41
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="optiongroup" />
|
|
|
|
ADD OBJECT 'opgHours' AS _optiongroup WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
BorderStyle = 0, ;
|
|
Height = 25, ;
|
|
Left = 96, ;
|
|
Name = "opgHours", ;
|
|
TabIndex = 5, ;
|
|
Top = 57, ;
|
|
Width = 74, ;
|
|
OPTION1.AutoSize = .T., ;
|
|
OPTION1.BackStyle = 0, ;
|
|
OPTION1.Caption = "12", ;
|
|
OPTION1.FontName = "MS Sans Serif", ;
|
|
OPTION1.FontSize = 8, ;
|
|
OPTION1.Left = 5, ;
|
|
OPTION1.Name = "OPTION1", ;
|
|
OPTION1.Top = 5, ;
|
|
OPTION2.AutoSize = .T., ;
|
|
OPTION2.BackStyle = 0, ;
|
|
OPTION2.Caption = "24", ;
|
|
OPTION2.FontName = "MS Sans Serif", ;
|
|
OPTION2.FontSize = 8, ;
|
|
OPTION2.Height = 15, ;
|
|
OPTION2.Left = 39, ;
|
|
OPTION2.Name = "OPTION2", ;
|
|
OPTION2.Top = 5, ;
|
|
OPTION2.Width = 30
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="optiongroup" />
|
|
|
|
ADD OBJECT 'shpDocumentItems' AS _shape WITH ;
|
|
BackStyle = 0, ;
|
|
Height = 74, ;
|
|
Left = 6, ;
|
|
Name = "shpDocumentItems", ;
|
|
SpecialEffect = 0, ;
|
|
Top = 14, ;
|
|
Width = 220, ;
|
|
ZOrderSet = 1
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="shape" />
|
|
|
|
ADD OBJECT 'shpGlobalItems' AS _shape WITH ;
|
|
BackStyle = 0, ;
|
|
Height = 74, ;
|
|
Left = 6, ;
|
|
Name = "shpGlobalItems", ;
|
|
SpecialEffect = 0, ;
|
|
Top = 106, ;
|
|
Width = 332, ;
|
|
ZOrderSet = 0
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="shape" />
|
|
|
|
ADD OBJECT 'txtBell' AS _textbox WITH ;
|
|
Alignment = 1, ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 22, ;
|
|
Left = 154, ;
|
|
Name = "txtBell", ;
|
|
ReadOnly = .T., ;
|
|
TabIndex = 11, ;
|
|
Top = 148, ;
|
|
Width = 144
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" />
|
|
|
|
PROCEDURE applyappattributes
|
|
LPARAMETERS toApp
|
|
LOCAL llSuccess
|
|
llSuccess = DODEFAULT(toApp)
|
|
IF llSuccess
|
|
IF USED(toApp.cUserTableAlias)
|
|
|
|
THIS.Caption = toApp.cCaption + " " + OPTIONS_LOC
|
|
THIS.oApp = toApp
|
|
THIS.DisplayCurrentUserOptions()
|
|
IF EMPTY(EVAL(toApp.cUserTableAlias+".UserOpts"))
|
|
WAIT WINDOW NOWAIT LEFT(OPTIONS_NOT_STORED_LOC,254)
|
|
THIS.cmdResetToDefault.Enabled = .F.
|
|
ENDIF
|
|
ELSE
|
|
llSuccess = .F.
|
|
ENDIF
|
|
|
|
ENDIF
|
|
IF NOT (llSuccess AND THIS.oApp.IsErrorFree())
|
|
THIS.Release()
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
DODEFAULT()
|
|
THIS.oApp = .NULL.
|
|
ENDPROC
|
|
|
|
PROCEDURE displaycurrentuseroptions
|
|
* show values from user options array in the dialog
|
|
THIS.DisplayOptions("CURRENT")
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE displayoptions
|
|
LPARAMETERS tcWhichSet
|
|
|
|
IF VARTYPE(tcWhichSet) # "C" OR ;
|
|
(NOT INLIST(tcWhichSet,"CURRENT","SAVED"))
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
LOCAL llCurrent, lvValue
|
|
llCurrent = (tcWhichSet = "CURRENT")
|
|
|
|
IF NOT llCurrent
|
|
RESTORE FROM MEMO (THIS.oApp.cUserTableAlias+".UserOpts") ADDITIVE
|
|
* local array laOptions now exists
|
|
ENDIF
|
|
|
|
IF llCurrent
|
|
lvValue = THIS.oApp.GetUserOptionSetting("BELL")
|
|
ELSE
|
|
lvValue = THIS.oApp.GetUserOptionSetting("BELL", @laOptions)
|
|
ENDIF
|
|
IF VARTYPE(lvValue) # "C"
|
|
lvValue = SET("BELL")
|
|
ENDIF
|
|
IF lvValue = "OFF"
|
|
THIS.opgBell.Value = 1
|
|
ELSE
|
|
THIS.opgBell.Value = 2
|
|
ENDIF
|
|
|
|
IF llCurrent
|
|
lvValue = THIS.oApp.GetUserOptionSetting("BELL TO")
|
|
ELSE
|
|
lvValue = THIS.oApp.GetUserOptionSetting("BELL TO", @laOptions)
|
|
ENDIF
|
|
IF VARTYPE(lvValue) = "C"
|
|
lvValue = STRTRAN(UPPER(lvValue),",0","")
|
|
lvValue = STRTRAN(lvValue,"[","")
|
|
lvValue = ALLTRIM(STRTRAN(lvValue,"]",""))
|
|
IF (NOT EMPTY(lvValue)) AND FILE(lvValue)
|
|
THIS.opgBell.Value = 3
|
|
THIS.txtBell.Value = lvValue
|
|
ELSE
|
|
THIS.txtBell.Value = SET("BELL",1)
|
|
ENDIF
|
|
ELSE
|
|
THIS.txtBell.Value = SET("BELL",1)
|
|
ENDIF
|
|
|
|
|
|
IF llCurrent
|
|
lvValue = THIS.oApp.GetUserOptionSetting("CONFIRM")
|
|
ELSE
|
|
lvValue = THIS.oApp.GetUserOptionSetting("CONFIRM", @laOptions)
|
|
ENDIF
|
|
IF VARTYPE(lvValue) # "C"
|
|
THIS.chkConfirm.Value = (SET("CONFIRM") = "ON")
|
|
ELSE
|
|
THIS.chkConfirm.Value = (lvValue = "ON")
|
|
ENDIF
|
|
|
|
IF llCurrent
|
|
lvValue = THIS.oApp.GetUserOptionSetting("SHOWTIPS")
|
|
ELSE
|
|
lvValue = THIS.oApp.GetUserOptionSetting("SHOWTIPS", @laOptions)
|
|
ENDIF
|
|
IF VARTYPE(lvValue) # "L"
|
|
THIS.chkShowTips.Value = THIS.ShowTips
|
|
ELSE
|
|
THIS.chkShowTips.Value = lvValue
|
|
ENDIF
|
|
|
|
IF llCurrent
|
|
lvValue = THIS.oApp.GetUserOptionSetting("cTextDisplayFont")
|
|
ELSE
|
|
lvValue = THIS.oApp.GetUserOptionSetting("cTextDisplayFont", @laOptions)
|
|
ENDIF
|
|
IF VARTYPE(lvValue) # "C"
|
|
THIS.cboTextDisplayFont.Value = THIS.oApp.cTextDisplayFont
|
|
ELSE
|
|
THIS.cboTextDisplayFont.Value = lvValue
|
|
ENDIF
|
|
|
|
IF llCurrent
|
|
lvValue = THIS.oApp.GetUserOptionSetting("HOURS")
|
|
ELSE
|
|
lvValue = THIS.oApp.GetUserOptionSetting("HOURS", @laOptions)
|
|
ENDIF
|
|
IF VARTYPE(lvValue) # "C"
|
|
lvValue = TRANSFORM(SET("HOURS"))
|
|
ENDIF
|
|
IF THIS.opgHours.Buttons(1).Caption $ lvValue
|
|
THIS.opgHours.Value = 1
|
|
ELSE
|
|
THIS.opgHours.Value = 2
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE displayuserdefaultoptions
|
|
* show values from default record in the dialog
|
|
THIS.DisplayOptions("SAVED")
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE KeyPress
|
|
LPARAMETERS nKeyCode, nShiftAltCtrl
|
|
IF nKeyCode = 27
|
|
THIS.Release()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE saveuseroptionsfromdisplay
|
|
THIS.SetFromDisplay("SAVE")
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setfromdisplay
|
|
LPARAMETERS tcWhichSet
|
|
IF VARTYPE(tcWhichSet) # "C" OR ;
|
|
(NOT INLIST(tcWhichSet,"CURRENT","SAVE"))
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
LOCAL llCurrent, lcArray, loForm, loMediator
|
|
llCurrent = (tcWhichSet = "CURRENT")
|
|
|
|
IF llCurrent
|
|
lcArray = "THIS.oApp.aCurrentUserOpts"
|
|
ELSE
|
|
LOCAL ARRAY laOptions[1,4]
|
|
lcArray = "laOptions"
|
|
ENDIF
|
|
|
|
DIME &lcArray.[6,4]
|
|
* change depending on how many options you have...
|
|
* and fill the array any way you want, just
|
|
* so long as your usage matches
|
|
* what you put in the array!
|
|
|
|
&lcArray.[1,1] = "SHOWTIPS"
|
|
&lcArray.[1,2] = THIS.chkShowTips.Value
|
|
&lcArray.[1,3] = .F. && form or form member property
|
|
&lcArray.[1,4] = .F. && private to datasessions/enabled forms, ;
|
|
&& and applied only on that level as requested
|
|
&& by form mediator object
|
|
|
|
&lcArray.[2,1] = "CONFIRM"
|
|
&lcArray.[2,2] = IIF(THIS.chkConfirm.Value,"ON","OFF")
|
|
&lcArray.[2,3] = .T. && SET, not form or form member property
|
|
&lcArray.[2,4] = .F.
|
|
|
|
&lcArray.[3,1] = "HOURS"
|
|
&lcArray.[3,2] = "TO "+THIS.opgHours.Buttons(THIS.opgHours.Value).Caption
|
|
&lcArray.[3,3] = .T. && SET, not form or form member property
|
|
&lcArray.[3,4] = .F.
|
|
|
|
|
|
&lcArray.[4,1] = "cTextDisplayFont"
|
|
&lcArray.[4,2] = IIF(EMPTY(THIS.cboTextDisplayFont.Value), ;
|
|
THIS.oApp.cTextDisplayFont, ;
|
|
THIS.cboTextDisplayFont.Value)
|
|
&lcArray.[4,3] = .F. && application or application member property
|
|
&lcArray.[4,4] = .T. && set on a global level, not form/session private
|
|
|
|
&lcArray.[5,1] = "BELL"
|
|
&lcArray.[5,2] = IIF(THIS.opgBell.Value = 1, "OFF","ON")
|
|
&lcArray.[5,3] = .T. && SET, not app or app member property
|
|
&lcArray.[5,4] = .T.
|
|
|
|
&lcArray.[6,1] = "BELL TO"
|
|
* I could have placed the word either in the first or
|
|
* second part of the 'SET phrase', as you
|
|
* can see from the SET HOURS entry, but in this case
|
|
* putting it in the first one allows me to identify the
|
|
* two SET BELL items uniquely later, when I use the
|
|
* application.GetUserOptionSetting() method to find them.
|
|
&lcArray.[6,2] = " "
|
|
IF THIS.opgBell.Value = 3 AND (NOT EMPTY(ALLTRIM(THIS.txtBell.Value)))
|
|
&lcArray.[6,2] = &lcArray.[6,2]+"["+ALLTR(THIS.txtBell.Value)+"],0"
|
|
ENDIF
|
|
&lcArray.[6,3] = .T.
|
|
&lcArray.[6,4] = .T.
|
|
|
|
IF llCurrent
|
|
|
|
THIS.oApp.ApplyGlobalUserOptions()
|
|
IF _SCREEN.FormCount > 0
|
|
* I am deliberately using
|
|
* _SCREEN rather than THIS.oApp.aForms
|
|
* here to account for collaborators or
|
|
* a modal dialog under this one --
|
|
* anything that has a mediator,
|
|
* not just anything in the aForms modeless
|
|
* collection, should have properties applied.
|
|
* It's faster, too, and I don't have to
|
|
* distinguish between forms and formsets in
|
|
* the _SCREEN collection
|
|
|
|
FOR EACH loForm IN _SCREEN.Forms
|
|
loMediator = THIS.oApp.GetFormMediatorRef(loForm)
|
|
IF VARTYPE(loMediator) = "O"
|
|
loMediator.DoSessionSets()
|
|
loForm.Refresh()
|
|
ENDIF
|
|
ENDFOR
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
REPLACE (THIS.oApp.cUserTableAlias+".UserOpts") WITH "" && this may avoid some bloat
|
|
SAVE ALL LIKE laOptions TO MEMO (THIS.oApp.cUserTableAlias+".UserOpts")
|
|
THIS.cmdResetToDefault.Enabled = .T.
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setuseroptionsfromdisplay
|
|
THIS.SetFromDisplay("CURRENT")
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cboTextDisplayFont.Init
|
|
LOCAL ARRAY laFonts[1]
|
|
LOCAL lcFont
|
|
|
|
IF NOT EMPTY(AFONT(laFonts))
|
|
FOR EACH lcFont IN laFonts
|
|
THIS.AddItem(lcFont)
|
|
ENDFOR
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdApply.Click
|
|
THISFORM.SetUserOptionsFromDisplay()
|
|
WAIT WINDOW NOWAIT LEFT(OPTIONS_APPLIED_LOC,254)
|
|
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdPickWav.Click
|
|
LOCAL lcFile
|
|
lcFile = UPPER(ALLTRIM(GETFILE("wav")))
|
|
IF EMPTY(lcFile) OR (NOT FILE(lcFile))
|
|
THISFORM.txtBell.Value = ""
|
|
IF THISFORM.opgBell.Value = 3
|
|
THISFORM.opgBell.Value = 2
|
|
ENDIF
|
|
ELSE
|
|
THISFORM.txtBell.Value = lcFile
|
|
THISFORM.opgBell.Value = 3
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdResetToDefault.Click
|
|
* get values from current record
|
|
THISFORM.DisplayUserDefaultOptions()
|
|
WAIT WINDOW NOWAIT LEFT(OPTIONS_DEFAULTS_SHOWN_LOC,254)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdSetDefault.Click
|
|
* save values from this dialog to
|
|
* to current record -- not to current values
|
|
THISFORM.SaveUserOptionsFromDisplay()
|
|
|
|
WAIT WINDOW NOWAIT LEFT(OPTIONS_DEFAULTS_SAVED_LOC,254)
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE opgBell.InteractiveChange
|
|
IF THIS.Value = 3 AND EMPTY(THISFORM.txtBell.Value)
|
|
THISFORM.cmdPickWav.Click()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _reportpicker AS _documentpicker OF "_framewk.vcx" && superclass for framework-supplied dialog to execute or modify (in New mode -- not yet implemented) a report document
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<PropValue>
|
|
Caption = "Choose a report to run"
|
|
DoCreate = .T.
|
|
Name = "_reportpicker"
|
|
lstDocuments.Name = "lstDocuments"
|
|
cmdOK.Name = "cmdOK"
|
|
cmdCancel.Name = "cmdCancel"
|
|
*</PropValue>
|
|
|
|
PROCEDURE execdocument
|
|
LOCAL liRow
|
|
|
|
liRow = THISFORM.lstDocuments.Value
|
|
|
|
IF EMPTY(liRow)
|
|
RETURN
|
|
ENDIF
|
|
|
|
DO CASE
|
|
|
|
CASE NOT EMPTY(THIS.aDocuments[liRow,4]) && alt-exec
|
|
LOCAL lcStatement
|
|
lcStatement = ALLTR(THIS.aDocuments[liRow,4])
|
|
|
|
&lcStatement
|
|
|
|
CASE THIS.aDocuments[liRow,3] && wrapped
|
|
DO (ALLTRIM(THIS.aDocuments[liRow,2]))
|
|
|
|
OTHERWISE && report
|
|
|
|
THIS.oApp.DoReport(ALLTRIM(THIS.aDocuments[liRow,2]), ;
|
|
ALLTRIM(THIS.aDocuments[liRow,1]))
|
|
|
|
ENDCASE
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE filldocumentsarray
|
|
LPARAMETERS tcMetaTableName
|
|
|
|
DIME THIS.aDocuments[1,4]
|
|
|
|
IF EMPTY(tcMetaTableName)
|
|
|
|
RETURN .F.
|
|
|
|
ENDIF
|
|
|
|
|
|
LOCAL lcConditions
|
|
|
|
IF THIS.lNew
|
|
lcConditions = " AND DOC_NEW "
|
|
ELSE
|
|
lcConditions = " AND DOC_OPEN "
|
|
ENDIF
|
|
|
|
lcConditions = lcConditions + " AND NOT DELETED() "
|
|
|
|
IF THIS.lSorted
|
|
lcConditions = lcConditions + " ORDER BY 1 "
|
|
ENDIF
|
|
|
|
|
|
SELECT DOC_DESCR, DOC_EXEC, ;
|
|
DOC_WRAP, ALT_EXEC ;
|
|
FROM (tcMetaTableName) ;
|
|
WHERE DOC_TYPE = PJX_META_DOC_REPORT_TYPE ;
|
|
&lcConditions ;
|
|
INTO ARRAY THIS.aDocuments
|
|
|
|
RETURN ( _TALLY # 0)
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
LPARAMETERS toApp, tlAdd
|
|
|
|
IF NOT DODEFAULT(toApp,tlAdd)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
* note: the editing capability isn't implemented yet.
|
|
|
|
IF tlAdd
|
|
THIS.Caption = REPORTPICKER_CAPTION_MODIFY_LOC
|
|
ELSE
|
|
THIS.Caption = REPORTPICKER_CAPTION_RUN_LOC
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _splash AS _form OF "..\ffc\_base.vcx" && superclass for framework-supplied default splash screen
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="imgApplication" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblApplicationName" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="lblCredits" UniqueID="" Timestamp="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*p: cauthor
|
|
*p: ccaption
|
|
*p: ccompany
|
|
*p: ccopyright
|
|
*p: cimage
|
|
*p: ctrademark
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
AlwaysOnTop = .T.
|
|
AutoCenter = .T.
|
|
BorderStyle = 2
|
|
Caption = ("")
|
|
cauthor =
|
|
ccaption =
|
|
ccompany =
|
|
ccopyright =
|
|
cimage =
|
|
Closable = .F.
|
|
ControlBox = .F.
|
|
ctrademark =
|
|
cversion =
|
|
Desktop = .T.
|
|
DoCreate = .T.
|
|
Height = 285
|
|
KeyPreview = .T.
|
|
MaxButton = .F.
|
|
MinButton = .F.
|
|
Name = "_splash"
|
|
ShowWindow = 2
|
|
TitleBar = 0
|
|
Width = 305
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'imgApplication' AS _image WITH ;
|
|
BackStyle = 0, ;
|
|
Height = 120, ;
|
|
Left = 80, ;
|
|
Name = "imgApplication", ;
|
|
Stretch = 1, ;
|
|
Top = 12, ;
|
|
Width = 144
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="image" />
|
|
|
|
ADD OBJECT 'lblApplicationName' AS _label WITH ;
|
|
Alignment = 2, ;
|
|
AutoSize = .F., ;
|
|
Caption = "Application Name", ;
|
|
FontName = "MS Sans Serif", ;
|
|
Height = 17, ;
|
|
Left = 14, ;
|
|
Name = "lblApplicationName", ;
|
|
Top = 156, ;
|
|
Width = 276
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'lblCredits' AS _label WITH ;
|
|
Alignment = 2, ;
|
|
AutoSize = .F., ;
|
|
Caption = "Credits", ;
|
|
FontName = "MS Sans Serif", ;
|
|
Height = 84, ;
|
|
Left = 14, ;
|
|
Name = "lblCredits", ;
|
|
Top = 180, ;
|
|
Width = 274
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
PROCEDURE Init
|
|
LPARAMETERS tcCaption, tcVersion, tcAuthor, tcCompany, tcCopyright, tcTrademark, tcImage
|
|
|
|
LOCAL liPCount
|
|
liPCount = PCOUNT()
|
|
|
|
IF DODEFAULT()
|
|
|
|
IF liPCount > 0 AND VARTYPE(tcCaption) = "C"
|
|
THIS.cCaption = tcCaption
|
|
ENDIF
|
|
IF liPCount > 1 AND VARTYPE(tcVersion) = "C"
|
|
THIS.cVersion = tcVersion
|
|
ENDIF
|
|
IF liPCount > 2 AND VARTYPE(tcAuthor) = "C"
|
|
THIS.cAuthor = tcAuthor
|
|
ENDIF
|
|
IF liPCount > 3 AND VARTYPE(tcCompany) = "C"
|
|
THIS.cCompany = tcCompany
|
|
ENDIF
|
|
IF liPCount > 4 AND VARTYPE(tcCopyright) = "C"
|
|
THIS.cCopyright = tcCopyright
|
|
ENDIF
|
|
IF liPCount > 5 AND VARTYPE(tcTrademark) = "C"
|
|
THIS.cTrademark = tcTrademark
|
|
ENDIF
|
|
IF liPcount > 6 AND VARTYPE(tcImage) = "C"
|
|
THIS.cImage = tcImage
|
|
ENDIF
|
|
|
|
THIS.cImage = ALLTR(THIS.cImage)
|
|
IF AT(".",THIS.cImage) = 0
|
|
THIS.cImage = THIS.cImage+".bmp"
|
|
ENDIF
|
|
THIS.cImage = FULLPATH(THIS.cImage)
|
|
|
|
IF (FILE(THIS.cImage))
|
|
THIS.imgApplication.Visible = .T.
|
|
THIS.imgApplication.Picture = THIS.cImage
|
|
ELSE
|
|
THIS.imgApplication.Visible = .F.
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(THIS.cCaption)
|
|
THIS.lblApplicationName.Caption = TRANS(THIS.cCaption)
|
|
ENDIF.
|
|
|
|
THIS.lblCredits.Caption = TRANS(THIS.cAuthor)
|
|
|
|
THIS.lblCredits.Caption = THIS.lblCredits.Caption + ;
|
|
CHR(13)+ ;
|
|
TRANS(THIS.cCompany)
|
|
|
|
THIS.lblCredits.Caption = THIS.lblCredits.Caption + ;
|
|
CHR(13)+ ;
|
|
TRANS(THIS.cCopyright)
|
|
|
|
THIS.lblCredits.Caption = THIS.lblCredits.Caption + ;
|
|
CHR(13)+ ;
|
|
TRANS(THIS.cTrademark)
|
|
|
|
THIS.lblCredits.Caption = THIS.lblCredits.Caption + ;
|
|
CHR(13)+ ;
|
|
TRANS(THIS.cVersion)
|
|
|
|
THIS.Titlebar = 0
|
|
|
|
ELSE
|
|
|
|
RETURN .F.
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _standardtoolbar AS _modalawaretoolbar OF "..\ffc\_ui.vcx" && superclass for framework-supplied default startup toolbar (exists throughout the life of the application, if used)
|
|
*< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="_separator3" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdNew" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdOpen" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdSave" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdRevert" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="_separator2" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdPrint" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="_separator1" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdCut" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdCopy" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdPaste" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="_separator4" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="cmdHelp" UniqueID="" Timestamp="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*p: lprintonerecord
|
|
*p: oapp
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
Caption = "Standard"
|
|
ControlBox = .F.
|
|
Height = 30
|
|
Left = 0
|
|
Name = "_standardtoolbar"
|
|
oapp = .NULL.
|
|
Top = 0
|
|
Width = 242
|
|
*</PropValue>
|
|
|
|
ADD OBJECT '_separator1' AS _separator WITH ;
|
|
Height = 24, ;
|
|
Left = 136, ;
|
|
Name = "_separator1", ;
|
|
Style = 1, ;
|
|
Top = 3, ;
|
|
Width = 3
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" />
|
|
|
|
ADD OBJECT '_separator2' AS _separator WITH ;
|
|
Height = 35, ;
|
|
Left = 105, ;
|
|
Name = "_separator2", ;
|
|
Style = 1, ;
|
|
Top = 3, ;
|
|
Width = 5
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" />
|
|
|
|
ADD OBJECT '_separator3' AS _separator WITH ;
|
|
Height = 0, ;
|
|
Left = 5, ;
|
|
Name = "_separator3", ;
|
|
Top = 3, ;
|
|
Width = 0
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" />
|
|
|
|
ADD OBJECT '_separator4' AS _separator WITH ;
|
|
Height = 31, ;
|
|
Left = 213, ;
|
|
Name = "_separator4", ;
|
|
Style = 1, ;
|
|
Top = 3, ;
|
|
Width = 3
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" />
|
|
|
|
ADD OBJECT 'cmdCopy' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 159, ;
|
|
Name = "cmdCopy", ;
|
|
Picture = graphics\copy.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
ToolTipText = "Copy", ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 9
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdCut' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 136, ;
|
|
Name = "cmdCut", ;
|
|
Picture = graphics\cut.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
ToolTipText = "Cut", ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 8
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdHelp' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 213, ;
|
|
Name = "cmdHelp", ;
|
|
Picture = graphics\help.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
ToolTipText = "Help", ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 12
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdNew' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 5, ;
|
|
Name = "cmdNew", ;
|
|
Picture = graphics\new.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
ToolTipText = "New", ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 1
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdOpen' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 28, ;
|
|
Name = "cmdOpen", ;
|
|
Picture = graphics\open.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
ToolTipText = "Open", ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 2
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdPaste' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 182, ;
|
|
Name = "cmdPaste", ;
|
|
Picture = graphics\paste.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
ToolTipText = "Paste", ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 10
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdPrint' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 105, ;
|
|
Name = "cmdPrint", ;
|
|
Picture = graphics\print.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
ToolTipText = "Print", ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 6
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdRevert' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 74, ;
|
|
Name = "cmdRevert", ;
|
|
Picture = graphics\revert.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
ToolTipText = "Revert", ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 4
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
ADD OBJECT 'cmdSave' AS _commandbutton WITH ;
|
|
Caption = "", ;
|
|
Height = 24, ;
|
|
Left = 51, ;
|
|
Name = "cmdSave", ;
|
|
Picture = graphics\save.bmp, ;
|
|
SpecialEffect = 2, ;
|
|
ToolTipText = "Save", ;
|
|
Top = 3, ;
|
|
Width = 24, ;
|
|
ZOrderSet = 3
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" />
|
|
|
|
PROCEDURE Destroy
|
|
DODEFAULT()
|
|
THIS.oApp = .NULL.
|
|
ENDPROC
|
|
|
|
PROCEDURE Refresh
|
|
LOCAL llActiveEditingControl
|
|
|
|
IF THIS.lDisabledForModal
|
|
RETURN
|
|
ENDIF
|
|
|
|
|
|
|
|
* .T. TO THIS.cmdNew.Enabled, ;
|
|
* THIS.cmdOpen.Enabled, ;
|
|
* THIS.cmdHelp.Enabled is already handled
|
|
* automatically, now for specific button behavior:
|
|
|
|
LOCAL ARRAY laTempx[1]
|
|
|
|
LOCAL liSession
|
|
|
|
IF TYPE("_SCREEN.ActiveForm") = "O"
|
|
|
|
WITH _SCREEN.ActiveForm
|
|
|
|
llActiveEditingControl = (TYPE(".ActiveControl.SelText") = "C")
|
|
|
|
STORE llActiveEditingControl AND ;
|
|
(NOT EMPTY(.ActiveControl.SelLength)) TO ;
|
|
THIS.cmdCut.Enabled, THIS.cmdCopy.Enabled
|
|
|
|
STORE llActiveEditingControl AND ;
|
|
(NOT EMPTY(_CLIPTEXT)) TO ;
|
|
THIS.cmdPaste.Enabled
|
|
|
|
ENDWITH
|
|
|
|
IF VARTYPE(THIS.oApp) # "O"
|
|
STORE .F. TO THIS.cmdSave.Enabled, ;
|
|
THIS.cmdRevert.Enabled, ;
|
|
THIS.cmdPrint.Enabled, ;
|
|
THIS.cmdHelp.Enabled
|
|
ELSE
|
|
liSession = IIF(UPPER(TYPE("_SCREEN.ActiveForm.Parent.BaseClass")) == ;
|
|
"FORMSET", _SCREEN.ActiveForm.Parent.DataSessionID, ;
|
|
_SCREEN.ActiveForm.DataSessionID)
|
|
IF EMPTY(AUSED(laTempx, liSession))
|
|
STORE .F. TO THIS.cmdSave.Enabled, ;
|
|
THIS.cmdRevert.Enabled, ;
|
|
THIS.cmdPrint.Enabled
|
|
ENDIF
|
|
|
|
IF EMPTY(THIS.oApp.cHelpFile)
|
|
STORE .F. TO THIS.cmdHelp.Enabled
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ELSE
|
|
* no active form but may be system window ready for editing
|
|
* etc...
|
|
STORE .F. TO THIS.cmdSave.Enabled, ;
|
|
THIS.cmdRevert.Enabled, ;
|
|
THIS.cmdPrint.Enabled
|
|
|
|
IF VARTYPE(THIS.oApp) # "O" OR EMPTY(THIS.oApp.cHelpFile)
|
|
STORE .F. TO THIS.cmdHelp.Enabled
|
|
ENDIF
|
|
|
|
IF NOT EMPTY(WONTOP())
|
|
STORE .T. TO THIS.cmdCut.Enabled, ;
|
|
THIS.cmdCopy.Enabled
|
|
STORE (NOT EMPTY(_CLIPTEXT)) TO ;
|
|
THIS.cmdPaste.Enabled
|
|
ELSE
|
|
STORE .F. TO THIS.cmdCut.Enabled, ;
|
|
THIS.cmdCopy.Enabled, ;
|
|
THIS.cmdPaste.Enabled
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdCopy.Click
|
|
IF VARTYPE(THIS.Parent.oApp) = "O"
|
|
THIS.Parent.oApp.DoMenuItemInFrame("COPY")
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdCut.Click
|
|
IF VARTYPE(THIS.Parent.oApp) = "O"
|
|
THIS.Parent.oApp.DoMenuItemInFrame("CUT")
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdHelp.Click
|
|
IF VARTYPE(THIS.Parent.oApp) = "O"
|
|
THIS.Parent.oApp.DoHelp()
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdNew.Click
|
|
IF VARTYPE(THIS.Parent.oApp) = "O"
|
|
THIS.Parent.oApp.DoNewOpen(.T.)
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdOpen.Click
|
|
IF VARTYPE(THIS.Parent.oApp) = "O"
|
|
THIS.Parent.oApp.DoNewOpen()
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdPaste.Click
|
|
IF VARTYPE(THIS.Parent.oApp) = "O"
|
|
THIS.Parent.oApp.DoMenuItemInFrame("PASTE")
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdPrint.Click
|
|
IF VARTYPE(THIS.Parent.oApp) = "O"
|
|
THIS.Parent.oApp.DoTableOutPut(THIS.Parent.lPrintOneRecord)
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdRevert.Click
|
|
IF VARTYPE(THIS.Parent.oApp) = "O"
|
|
THIS.Parent.oApp.DataRevert()
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE cmdSave.Click
|
|
IF VARTYPE(THIS.Parent.oApp) = "O"
|
|
THIS.Parent.oApp.DataUpdate()
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _topform AS _form OF "..\ffc\_base.vcx" && superclass for "frame" or "parent window", for MDI applications existing outside _screen
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*p: cmenuname && Holds a unique menu name for association with this form so that it can be RELEASEd EXTENDED when the form is destroyed.
|
|
*p: oapp
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
AutoCenter = .T.
|
|
Caption = "Top Form Frame window"
|
|
cmenuname = ("")
|
|
DoCreate = .T.
|
|
Height = 454
|
|
Name = "_topform"
|
|
oapp = .NULL.
|
|
ShowWindow = 2
|
|
Width = 631
|
|
*</PropValue>
|
|
|
|
PROCEDURE Destroy
|
|
DODEFAULT()
|
|
THIS.oApp = .NULL.
|
|
IF NOT EMPTY(THIS.cMenuName)
|
|
RELEASE MENU (THIS.cMenuName) EXTENDED
|
|
ENDIF
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Load
|
|
IF DODEFAULT()
|
|
THIS.cMenuName = "M"+SYS(2015)
|
|
ELSE
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE QueryUnload
|
|
LOCAL loTemp, llReturn
|
|
|
|
|
|
IF VARTYPE(THIS.oApp) = "O"
|
|
|
|
llReturn = THIS.oApp.OnShutDown(.T.)
|
|
|
|
IF llReturn
|
|
|
|
loTemp = THIS.oApp
|
|
THIS.oApp = .NULL.
|
|
loTemp.oFrame = .NULL.
|
|
loTemp.Release()
|
|
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
llReturn = .T.
|
|
|
|
ENDIF
|
|
|
|
IF NOT llReturn
|
|
|
|
NODEFAULT
|
|
|
|
ENDIF
|
|
|
|
|
|
RETURN llReturn
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _userlogin AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default dialog for user login
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="txtName" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="txtPassword" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="_label1" UniqueID="" Timestamp="" />
|
|
*< OBJECTDATA: ObjPath="_label2" UniqueID="" Timestamp="" />
|
|
|
|
#INCLUDE "_framewk.h"
|
|
*<DefinedPropArrayMethod>
|
|
*m: addusernow
|
|
*m: checkpasswordinfo
|
|
*m: faillogin
|
|
*m: incrementfailedattempts
|
|
*m: oktoadduser && Abstract in the base, allows you to indicate what conditions are required to add a new user rather than simply validating existing users.
|
|
*m: storenewpasswordinfo
|
|
*p: itries && Number of tries before the user login fails.
|
|
*p: itriesallowed
|
|
*p: laddinguser
|
|
*p: lvalidpassword
|
|
*p: lvaliduser
|
|
*p: oapp
|
|
*</DefinedPropArrayMethod>
|
|
|
|
PROTECTED itriesallowed
|
|
*<PropValue>
|
|
AlwaysOnTop = .T.
|
|
BufferMode = 1
|
|
Caption = "User Login"
|
|
DoCreate = .T.
|
|
Height = 100
|
|
itries = 0
|
|
itriesallowed = 3
|
|
KeyPreview = .T.
|
|
Name = "_userlogin"
|
|
Width = 375
|
|
*</PropValue>
|
|
|
|
ADD OBJECT '_label1' AS _label WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
Caption = "Name:", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 15, ;
|
|
Left = 8, ;
|
|
Name = "_label1", ;
|
|
Top = 24, ;
|
|
Width = 33
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT '_label2' AS _label WITH ;
|
|
AutoSize = .T., ;
|
|
BackStyle = 0, ;
|
|
Caption = "Password:", ;
|
|
FontName = "MS Sans Serif", ;
|
|
FontSize = 8, ;
|
|
Height = 15, ;
|
|
Left = 8, ;
|
|
Name = "_label2", ;
|
|
Top = 60, ;
|
|
Width = 51
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" />
|
|
|
|
ADD OBJECT 'txtName' AS _textbox WITH ;
|
|
FontBold = .T., ;
|
|
FontName = "Courier New", ;
|
|
Height = 24, ;
|
|
Left = 68, ;
|
|
Name = "txtName", ;
|
|
SelectOnEntry = .T., ;
|
|
Top = 19, ;
|
|
Width = 294
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" />
|
|
|
|
ADD OBJECT 'txtPassword' AS _textbox WITH ;
|
|
FontBold = .T., ;
|
|
FontName = "Courier New", ;
|
|
Height = 24, ;
|
|
Left = 68, ;
|
|
Name = "txtPassword", ;
|
|
PasswordChar = "*", ;
|
|
SelectOnEntry = .T., ;
|
|
Top = 55, ;
|
|
Width = 294
|
|
*< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" />
|
|
|
|
PROCEDURE addusernow
|
|
|
|
LOCAL lcName
|
|
THIS.lAddingUser = .F.
|
|
IF THIS.OKToAdduser()
|
|
IF (MESSAGEBOX(LOGIN_ADD_USER_LOC , ;
|
|
MB_ICONEXCLAMATION+MB_YESNO, ;
|
|
LOGIN_USER_NOT_FOUND_LOC) = IDYES)
|
|
lcName = ALLTRIM(THIS.txtName.Value)
|
|
INSERT INTO (THIS.oApp.cUserTableAlias) ;
|
|
((THIS.oApp.cUserTableIDField)) ;
|
|
VALUES (lcName)
|
|
|
|
THIS.lAddingUser = .T.
|
|
|
|
MESSAGEBOX(LOGIN_NEW_USER_INFO_LOC,0,THIS.Caption)
|
|
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN THIS.lAddingUser
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE applyappattributes
|
|
LPARAMETERS toApp
|
|
LOCAL llSuccess
|
|
llSuccess = DODEFAULT(toApp)
|
|
IF llSuccess
|
|
IF VARTYPE(toApp.cUserTableAlias) # "C" OR NOT USED(toApp.cUserTableAlias)
|
|
llSuccess = .F.
|
|
ELSE
|
|
THIS.Caption = toApp.cCaption + " " + LOGIN_CAPTION_LOC
|
|
IF NOT EMPTY(toApp.cCurrentUser)
|
|
IF toApp.SeekCurrentUser()
|
|
THIS.txtName.Value = toApp.cCurrentUser
|
|
THIS.lValidUser = .T.
|
|
ELSE
|
|
THIS.lValidUser = .F.
|
|
ENDIF
|
|
ELSE
|
|
THIS.lValidUser = .F.
|
|
ENDIF
|
|
THIS.lValidPassword = .F.
|
|
THIS.oApp = toApp
|
|
ENDIF
|
|
ENDIF
|
|
IF NOT llSuccess
|
|
THIS.Release()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE checkpasswordinfo
|
|
LPARAMETERS tcValueToCheck
|
|
|
|
RETURN (THIS.oApp.CheckPassword(tcValueToCheck))
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
THIS.oApp = .NULL.
|
|
ENDPROC
|
|
|
|
PROCEDURE faillogin
|
|
* this is the equivalent of a failed
|
|
* SEEK in the table
|
|
IF RECCOUNT(THIS.oApp.cUserTableAlias) > 0
|
|
GO BOTTOM IN (THIS.oApp.cUserTableAlias)
|
|
SKIP IN (THIS.oApp.cUserTableAlias)
|
|
ENDIF
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE incrementfailedattempts
|
|
THIS.iTries = THIS.iTries + 1
|
|
IF THIS.iTries >= THIS.iTriesAllowed
|
|
MESSAGEBOX(LOGIN_TRIES_EXCEEDED_LOC,MB_ICONSTOP,THIS.Caption)
|
|
THIS.FailLogIn()
|
|
THIS.Release()
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE KeyPress
|
|
LPARAMETERS nKeyCode, nShiftAltCtrl
|
|
IF nKeyCode = 27
|
|
THIS.FailLogIn()
|
|
THIS.Release()
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE oktoadduser && Abstract in the base, allows you to indicate what conditions are required to add a new user rather than simply validating existing users.
|
|
* abstract in the base, would be done
|
|
* according to any conditions you like.
|
|
* certainly there has to be some way of adding
|
|
* new users at startup,
|
|
* if no currently-valid user exists.
|
|
RETURN .T.
|
|
ENDPROC
|
|
|
|
PROCEDURE QueryUnload
|
|
IF THIS.ReleaseType = 1 && box hit
|
|
IF THIS.lValidUser AND THIS.lValidPassword
|
|
IF THIS.lAddingUser
|
|
THIS.StoreNewPasswordInfo(ALLTR(THIS.txtPassword.Value))
|
|
ELSE
|
|
IF NOT THIS.CheckPasswordInfo(ALLTR(THIS.txtPassword.Value))
|
|
WAIT WINDOW LEFT(LOGIN_WRONG_PASSWORD_LOC,254) TIMEOUT 2
|
|
THIS.txtPassword.SetFocus()
|
|
NODEFAULT
|
|
ENDIF
|
|
ENDIF
|
|
ELSE
|
|
THIS.FailLogIn()
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROCEDURE storenewpasswordinfo
|
|
LPARAMETERS tcValueToStore
|
|
ASSERT VARTYPE(tcValueToStore) = "C"
|
|
|
|
THIS.oApp.StorePassword(tcValueToStore)
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE txtName.Valid
|
|
LOCAL llSuccess
|
|
THISFORM.lValidPassword = .F.
|
|
IF EMPTY(THIS.Value)
|
|
THISFORM.lValidUser = .F.
|
|
RETURN
|
|
ENDIF
|
|
llSuccess = THISFORM.oApp.SeekCurrentUser(THIS.Value)
|
|
IF NOT llSuccess
|
|
* do they want a new user?
|
|
llSuccess = THISFORM.AddUserNow()
|
|
|
|
ENDIF
|
|
|
|
THISFORM.lValidUser = llSuccess
|
|
|
|
IF NOT llSuccess
|
|
IF SET("BELL") = "ON"
|
|
?? CHR(7)
|
|
ENDIF
|
|
WAIT WINDOW LEFT(LOGIN_USER_NOT_FOUND_LOC,254) TIMEOUT 2
|
|
THISFORM.IncrementFailedAttempts()
|
|
ENDIF
|
|
|
|
IF llSuccess AND (NOT THISFORM.lAddingUser) AND (NOT EMPTY(THISFORM.txtPassword.Value))
|
|
IF THISFORM.CheckPasswordInfo(ALLTR(THISFORM.txtPassword.Value))
|
|
THISFORM.Release()
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN llSuccess
|
|
ENDPROC
|
|
|
|
PROCEDURE txtPassword.Valid
|
|
ASSERT (NOT EOF(THISFORM.oApp.cUserTableAlias))
|
|
LOCAL llSuccess, lcPassword
|
|
|
|
lcPassword = ALLTRIM(THIS.Value)
|
|
|
|
IF THISFORM.lAddingUser && (AND NOT EMPTY(lcPassword))
|
|
THISFORM.StoreNewPasswordInfo(lcPassword)
|
|
THISFORM.lAddingUser = .F.
|
|
THISFORM.lValidUser = .T.
|
|
llSuccess = .T.
|
|
ENDIF
|
|
|
|
DO CASE
|
|
* CASE EMPTY(lcPassword)
|
|
* THISFORM.lValidPassword = .F.
|
|
CASE THISFORM.lValidUser
|
|
llSuccess = THISFORM.CheckPasswordInfo(lcPassword)
|
|
THISFORM.lValidPassword = llSuccess
|
|
OTHERWISE
|
|
THISFORM.lValidPassword = .F.
|
|
ENDCASE
|
|
|
|
IF llSuccess
|
|
THISFORM.Release()
|
|
ELSE
|
|
IF SET("BELL") = "ON"
|
|
?? CHR(7)
|
|
ENDIF
|
|
IF THISFORM.lValidUser
|
|
* WAIT WINDOW TIMEOUT 2 ;
|
|
* LEFT(IIF(EMPTY(lcPassword),;
|
|
* LOGIN_EMPTY_PASSWORD_LOC,;
|
|
* LOGIN_WRONG_PASSWORD_LOC ),254)
|
|
WAIT WINDOW TIMEOUT 2 ;
|
|
LEFT(LOGIN_WRONG_PASSWORD_LOC,254)
|
|
THISFORM.IncrementFailedAttempts()
|
|
IF EMPTY(lcPassword)
|
|
RETURN 0
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|