| Name | Initial value |
|---|---|
| Caption | "Activedoc1" |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CActiveDoc | |
| extrabuffer | .f. |
RELEASE THIS
| Name | Initial value |
|---|---|
| BackStyle | 0 |
| Caption | "Check1" |
| HelpContextID | 297 |
| Value | 0 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CCheckBox | Internal use.Specifies the original VFX Class Name |
| cviewparameter | .f. | Specifies the name of the view argument which the control is bounded |
| extrabuffer | .f. | A user buffer |
| lautosetup | .T. | .T. if it's enabled when the form is in Insert or Edit mode |
| lautosize | .T. | wa (for VFP 3.0) property to define the property AutoSize in the Init() of the control |
| lnorefresh | .f. | Setting this property to .t. does prevent the control from beeing refreshed once. This is usefull, when a refresh of the form is issued and you want prevent the user from loosing what he currently was typing. |
| lproportionalresize | .T. | |
| lusesyscolor | .T. |
RELEASE THIS
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") = "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
THISFORM.nformstatus = 1
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") == "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
THISFORM.nformstatus = 1
THIS.lnorefresh = .T.
THIS.setfocus()
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
LOCAL lcanedit
IF pemstatus(THISFORM,'lCanEdit',5)
lcanedit = THISFORM.lcanedit
ELSE
lcanedit = .T.
ENDIF
IF THIS.lautosetup
IF pemstatus(THISFORM, 'lEmpty',5)
IF THISFORM.lempty AND THISFORM.nformstatus != 2
RETURN .F.
ENDIF
ENDIF
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit AND lcanedit
RETURN .T.
ELSE
RETURN THISFORM.nformstatus <> id_normal_mode
ENDIF
ELSE
RETURN THISFORM.nformstatus <> id_normal_mode
ENDIF
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("When",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
IF LOWER(THIS.PARENT.BASECLASS) == "column" && Checkbox may be in a grid column.
RETURN .T.
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ELSE
THIS.ENABLED = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
ELSE
THIS.ENABLED = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
IF THIS.ENABLED
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ENDIF
ENDIF
IF THIS.lnorefresh
NODEFAULT
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
LPARAMETERS nkeycode, nshiftaltctrl
IF TYPE("goprogram.lUseEnterAsTab") = "L"
IF goprogram.luseenterastab AND nkeycode=13
NODEFAULT
KEYBOARD CHR(9)
ENDIF
ENDIF
IF THIS.lnorefresh
THIS.lnorefresh = .F.
ENDIF
| Name | Initial value |
|---|---|
| HelpContextID | 298 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CComboBox | Internal use.Specifies the original VFX Class Name |
| ctablename | .f. | Name of the view of the rowsource when rowsourcetype = 2 (alias) or 6 (fields). Only needed if the user defines the sql string manually, this name can either be set by the programmer or it will be generated using the sys(2015) function. |
| cviewparameter | .f. | Specifies the name of the view argument which the control is bounded |
| extrabuffer | .f. | A user buffer |
| lautosetup | .T. | .T. if it's enabled when the form is in Insert or Edit mode |
| lnorefresh | .f. | Setting this property to .t. does prevent the control from beeing refreshed once. This is usefull, when a refresh of the form is issued and you want prevent the user from loosing what he currently was typing. |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lrequeryoninit | .f. | If the rowsource of the combo is parametrised, set this property to .t. if during the init() you have the correct parameter values and want a requery to happen. If set to .f., the rowsource will only be fetched with an empty structure. |
| lsptsourcefromuser | .f. | Set to .t. defines, that the programmer defined the SPT select statement during design time. |
| lusespt | .f. | This property defines whether SQL Pass Through (short: SPT) will be used to speedup operation and reduce the dataenvironment and connection overhead. |
| lusesyscolor | .T. |
RELEASE THIS
PARAMETERS nkeycode, nshiftaltctrl
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("KeyPress",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
NODEFAULT
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
NODEFAULT
RETURN luhookvalue=0
ENDCASE
ENDIF
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
IF THIS.lusespt AND !EMPTY(NVL(THIS.ctablename,"")) AND USED(THIS.ctablename)
USE IN (THIS.ctablename)
ENDIF
LOCAL lcanedit
IF pemstatus(THISFORM,'lCanEdit',5)
lcanedit = THISFORM.lcanedit
ELSE
lcanedit = .T.
ENDIF
IF THIS.lautosetup
IF pemstatus(THISFORM, 'lEmpty',5)
IF THISFORM.lempty AND THISFORM.nformstatus != 2
RETURN .F.
ENDIF
ENDIF
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit AND lcanedit
RETURN .T.
ELSE
RETURN THISFORM.nformstatus <> id_normal_mode
ENDIF
ELSE
RETURN THISFORM.nformstatus <> id_normal_mode
ENDIF
ENDIF
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("When",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
THIS.SELSTART = 0
THIS.SELLENGTH = 0
IF THIS.lusespt
LOCAL lcsql, lctablename, lnsqlconnection
lctablename = ""
lnsqlconnection = -1
IF EMPTY(THIS.ctablename) OR ISNULL(THIS.ctablename)
DO WHILE .T.
THIS.ctablename = SYS(2015)
IF !USED(THIS.ctablename)
EXIT
ENDIF
ENDDO
ENDIF
IF VARTYPE(thisForm)="O" AND ;
TYPE("goProgram.oConnMgr") = "O" AND !ISNULL(goprogram.oconnmgr) AND ;
(THIS.lsptsourcefromuser OR ;
INLIST(THIS.ROWSOURCETYPE, 2, 6))
DO CASE
CASE THIS.lsptsourcefromuser
*-- do nothing
CASE THIS.ROWSOURCETYPE = 2
lctablename = THIS.ROWSOURCE
CASE THIS.ROWSOURCETYPE = 6
lctablename = SUBSTR(THIS.ROWSOURCE, 1, AT(".", THIS.ROWSOURCE) -1)
ENDCASE
IF THIS.lsptsourcefromuser
lcsql = THIS.getsptsource()
ELSE
IF !EMPTY(NVL(lctablename,""))
IF INDBC(lctablename, 'VIEW') AND DBGETPROP(lctablename, "VIEW", "SOURCETYPE") = 2
lcsql = DBGETPROP(lctablename, "VIEW", "SQL")
ENDIF
ENDIF
ENDIF
IF (!EMPTY(NVL(lctablename,"")) AND !USED(lctablename)) OR ;
(THIS.lsptsourcefromuser AND !EMPTY(NVL(lcsql,"")))
lnsqlconnection = goprogram.oconnmgr.getconnection()
IF lnsqlconnection > 0
IF AT("?", lcsql) > 0
lcsql = clearsqlparameters(lcsql)
ENDIF
IF THIS.lrequeryoninit
THIS.REQUERY()
ELSE
vfxsqlexec(lnsqlconnection, lcsql, THIS.ctablename)
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF VARTYPE(thisForm)="O"
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") = "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
THISFORM.nformstatus = 1
THIS.lnorefresh = .T.
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ELSE
THIS.ENABLED = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
ELSE
THIS.ENABLED = THISFORM.nformstatus <> id_normal_mode
ENDIF
IF THIS.ENABLED
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ENDIF
ENDIF
IF THIS.lnorefresh
NODEFAULT
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
LOCAL lothis
lothis=THIS
DEFINE POPUP shortcut shortcut RELATIVE FROM MROW(),MCOL()
DEFINE BAR _MED_CUT OF shortcut PROMPT ttt_cmdcut
DEFINE BAR _MED_COPY OF shortcut PROMPT ttt_cmdcopy
DEFINE BAR _MED_PASTE OF shortcut PROMPT ttt_cmdpaste
DEFINE BAR 4 OF shortcut PROMPT "\-"
DEFINE BAR 5 OF shortcut PROMPT ttt_cmdrequery
ON SELECTION BAR 5 OF shortcut lothis.REQUERY()
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("RightClick",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ACTIVATE POPUP shortcut
IF THIS.lnorefresh
THIS.lnorefresh = .F.
ENDIF
IF THIS.lusespt
LOCAL lcsql, lctablename, lnsqlconnection
STORE "" TO lcsql, lctablename
lnsqlconnection = -1
IF VARTYPE(thisForm)="O" AND ;
TYPE("goProgram.oConnMgr") = "O" AND !ISNULL(goprogram.oconnmgr) AND ;
(THIS.lsptsourcefromuser OR ;
INLIST(THIS.ROWSOURCETYPE, 2, 6))
DO CASE
CASE THIS.lsptsourcefromuser
*-- do nothing
CASE THIS.ROWSOURCETYPE = 2
lctablename = THIS.ROWSOURCE
CASE THIS.ROWSOURCETYPE = 6
lctablename = SUBSTR(THIS.ROWSOURCE, 1, AT(".", THIS.ROWSOURCE) -1)
ENDCASE
IF THIS.lsptsourcefromuser
lcsql = THIS.getsptsource()
ELSE
IF !EMPTY(NVL(lctablename,""))
IF INDBC(lctablename, 'VIEW') AND DBGETPROP(lctablename, "VIEW", "SOURCETYPE") = 2
lcsql = DBGETPROP(lctablename, "VIEW", "SQL")
ENDIF
ENDIF
ENDIF
IF !EMPTY(NVL(lctablename,"")) OR ;
(THIS.lsptsourcefromuser AND !EMPTY(NVL(lcsql,"")))
lnsqlconnection = goprogram.oconnmgr.getconnection()
vfxsqlexec(lnsqlconnection, lcsql, THIS.ctablename)
ENDIF
ELSE
DODEFAULT()
ENDIF
ELSE
DODEFAULT()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "Command1" |
| HelpContextID | 285 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CCommandButton | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
| lautosetup | .F. | |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
RELEASE THIS
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
WITH THIS
IF .lautosetup
.ENABLED = THISFORM.nformstatus # 0
ENDIF
ENDWITH
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
| Name | Initial value |
|---|---|
| ButtonCount | 2 |
| Value | 1 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CCommandGroup | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | User Buffer |
| lautosetup | .F. | Specifies if the control it's sincronized with the form status |
| lproportionalresize | .F. | Specifies if the resize of this object it proportional or not |
RELEASE THIS
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF THIS.lautosetup
THIS.ENABLED = .F.
THIS.SETALL('Enabled',THIS.ENABLED)
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
IF THIS.lautosetup
THIS.ENABLED = THISFORM.nformstatus <> id_normal_mode
THIS.SETALL('Enabled',THIS.ENABLED)
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
| Baseclass | Class | Object name |
|---|---|---|
| zzz | zzz | ccommandgroup.Command1 |
| ccommandgroup.Command2 |
| Name | Initial value |
|---|---|
| Caption | "Command1" |
| Name | Initial value |
|---|---|
| Caption | "Command2" |
| Name | Initial value |
|---|---|
| BackStyle | 0 |
| HelpContextID | 291 |
| OLEDragMode | 1 |
| SpecialEffect | 2 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CContainer | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
| lautosetup | .f. | |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lusesyscolor | .T. | Specifies if the system color will be used |
RELEASE THIS
LPARAMETERS oDataObject, eFormat
oDataObject.SetData(collectoledata(this))
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
LPARAMETERS oDataObject, nEffect
oDataObject.ClearData()
nEffect=1
oDataObject.SetFormat(1)
| Name | Initial value |
|---|---|
| Enabled | .T. |
| HelpContextID | 299 |
| OLEDragMode | 1 |
| OLEDropMode | 1 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CEditBox | Internal use.Specifies the original VFX Class Name |
| cviewparameter | .f. | Specifies the name of the view argument which the control is bounded |
| extrabuffer | .f. | A user buffer |
| lautosetup | .T. | .T. if it's enabled when the form is in Insert or Edit mode |
| lnorefresh | .f. | Setting this property to .t. does prevent the control from beeing refreshed once. This is usefull, when a refresh of the form is issued and you want prevent the user from loosing what he currently was typing. |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lusesyscolor | .f. |
RELEASE THIS
IF THIS.lnorefresh
THIS.lnorefresh = .F.
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") = "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
THISFORM.nformstatus = 1
THIS.lnorefresh = .T.
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF THIS.READONLY
THIS.lautosetup = .F.
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") != "U"
IF !THISFORM.lautoedit
THIS.READONLY = THISFORM.nformstatus = id_normal_mode
ENDIF
ELSE
THIS.READONLY = THISFORM.nformstatus = id_normal_mode
ENDIF
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.READONLY = !THISFORM.lcanedit
ENDIF
ELSE
THIS.READONLY = (THISFORM.nformstatus = id_normal_mode)
ENDIF
ELSE
THIS.READONLY = (THISFORM.nformstatus = id_normal_mode)
ENDIF
IF !THIS.READONLY
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.READONLY = !THISFORM.lcanedit
ENDIF
ENDIF
THIS.FONTITALIC = !THIS.ENABLED
ENDIF
IF THIS.lnorefresh
NODEFAULT
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
DEFINE POPUP shortcut shortcut RELATIVE FROM MROW(),MCOL()
DEFINE BAR _MED_CUT OF shortcut PROMPT ttt_cmdcut
DEFINE BAR _MED_COPY OF shortcut PROMPT ttt_cmdcopy
DEFINE BAR _MED_PASTE OF shortcut PROMPT ttt_cmdpaste
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("RightClick",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ACTIVATE POPUP shortcut
LPARAMETERS oDataObject, nEffect
nEffect=1
this.interactivechange()
| Name | Initial value |
|---|---|
| HelpContextID | 284 |
| _vfxclassname | CFixField |
| lfixfield | .T. |
| Name | Initial value |
|---|---|
| BufferMode | 2 |
| Caption | "CForm" |
| DataSession | 2 |
| DoCreate | .T. |
| FontBold | .F. |
| MinHeight | 0 |
| MinWidth | 0 |
| ShowTips | .T. |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | Array containing other object references |
| _vfxclassname | CForm | Internal use.Specifies the original VFX class name |
| cchildformmgrclass | CChildFormManager | Name of the class to be used as childformmanager. |
| cfavoritescx | .f. | Enter the name of the scx-file of this form (usually the name of the scx file without extension) which will be used to reference favorites entries for this form. |
| cformcaption | Stores original form caption. |
|
| cformname | Stores original window name. |
|
| chookfunction | .f. | Specifies the alternate function name to be call. Parameters: tcEvent, toObject, toForm. See also cform.oneventhookhandler() |
| cmenuform | .F. | Specifies the name of the menu associated with the form |
| creporttypelist | Defines, which report types are used in the crselection based form. ATTENTION: Enter exactly in the following format since its used in the program directly: i.e. ='1,2' if you waht to offer report types '1' and '2' within this form. | |
| cresizectrlclass | CResizeCtrl | Class to be used for the resizer. |
| cscxname | .f. | Stores the original name of the SCX file for this form. |
| ctoolbarclass | ToolBar Class name. Example 'COfficeBar'. | |
| extrabuffer | .f. | Use this property for any storage you may need. |
| lautoresizecontrol | .T. | Specifies if the controls are resized automatically by the form |
| lautosyncchildform | .f. | Specifies if the child form will be syncronized automatically when the parent form moves from record to record. |
| lcascade | .T. | .T. if this window should open cascaded relative to the last form opened. ATTENTION: Only thr very first time you open a form this way this will work. Later on, VFX positions the form based on the entry in the resource file. |
| lclosechildformonexit | .f. | Specifies if the child forms will be closed when the parent form is closed |
| lcloseonesc | .T. | Defines whether you can close a form by pressing the |
| lmultiinstance | .T. | Defines, whether the form can be opened multiple times or not. |
| lnhotkeyrefresh | -4 | Specifies the Key Code to be used for Refreshing on demang. Default is -4 which is the (F5) key like in other windows applications. |
| lputinlastfile | .f. | .T. if this form will be added in the recently used file list |
| lputinwindowmenu | .f. | .T. if this form will be in added to the Window Menu |
| lresized | .f. | No more used. |
| lresizefont | .T. | Specifies whether the font will also be resized during a resize operation. See also the cfoxapp property nresizefont for easier usage for all forms at once. |
| lsaveposition | .T. | .T. if you want store window's layout in the VFXRES file |
| lsetfocus | .T. | Defines whether the form gets the focus during a refresh operation |
| lshowtoolbar | .f. | .T. If the tool will be showed |
| lusechildform | .f. | Specifies if this form will have one or more linked child forms |
| lusehook | .f. | Specifies if Hooks are used. See also the cfoxapp property nenablehook for easier usage for all forms at once. |
| lusesyscolor | .T. | Specifies if the system colors will be used on this fom |
| nlockscreen | -1 | LockScreen counter. Used internally to ptimize screen looks for smoother repaint visualization |
| nreportid | 0 | Used to save and default the actually selected report. |
| nreporttype | 0 | Used to save and default the actually selected report type. |
| otoolbar | .NULL. | Reserved. It's a reference to the form's toolbar. Must be initialized to .NULL. |
IF !THISFORM.LOCKSCREEN
THISFORM.LOCKSCREEN = .T.
ENDIF
IF THISFORM.nlockscreen >= 0
THISFORM.nlockscreen = THISFORM.nlockscreen + 1
ENDIF
LPARAMETERS tlforce
IF tlforce
_SCREEN.LOCKSCREEN = .F.
THISFORM.LOCKSCREEN = .F.
THISFORM.nlockscreen = 0
ELSE
THISFORM.nlockscreen = THISFORM.nlockscreen - 1
IF THISFORM.nlockscreen < 1
THISFORM.nlockscreen = 0
THISFORM.LOCKSCREEN = .F.
ENDIF
ENDIF
LOCAL lfound, ckey, lcalias
IF !THISFORM.lsaveposition
RETURN .F.
ENDIF
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("LoadPosition",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
this.dispbegin()
lcalias = ALIAS()
USE vfxres IN 0 ORDER TAG USER AGAIN ALIAS RESOURCE
SELECT RESOURCE
ckey = UPPER( PADR(m.gu_user,32,' ') + PADR(THISFORM.cformname, LEN(RESOURCE.objname)) )
lfound = .F.
IF SEEK(ckey,"RESOURCE","USER") AND !EMPTY(RESOURCE.layout)
lfound = .T.
** Form Layout
THISFORM.lshowtoolbar = RESOURCE.TOOLBAR
THISFORM.TOP = VAL(SUBSTR(RESOURCE.layout, 1,4))
THISFORM.LEFT = VAL(SUBSTR(RESOURCE.layout, 5,4))
IF VARTYPE(gu_formsize)="N" AND gu_formsize<>0
THISFORM.WIDTH = ROUND(THISFORM.WIDTH*gu_formsize,0)
THISFORM.HEIGHT = ROUND(THISFORM.HEIGHT*gu_formsize,0)
ELSE
THISFORM.WIDTH = VAL(SUBSTR(RESOURCE.layout, 9,4))
THISFORM.HEIGHT = VAL(SUBSTR(RESOURCE.layout,13,4))
ENDIF
THISFORM.onloadposition()
ENDIF
USE IN RESOURCE
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
this.dispend()
RETURN lfound
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("OnLoadPosition",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("OnSavePosition",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
LOCAL lcdateformat, lcentury
SET TALK OFF
SET DOHISTORY OFF
SET BRSTATUS OFF
SET SAFETY OFF
SET EXCLUSIVE OFF
SET NOTIFY OFF
SET BELL OFF
SET NEAR OFF
SET EXACT OFF
SET STATUS OFF
SET DELETED ON
SET MULTILOCKS ON
SET CONFIRM ON
SET DECIMAL TO 2
SET MEMOWIDTH TO 256
SET SEPARATOR TO id_num_separator
SET POINT TO id_num_decimal
IF TYPE("goProgram")="O"
lcdateformat = IIF( EMPTY(goprogram.cdateformat),"BRITISH",goprogram.cdateformat)
lcentury = goprogram.lcentury
ELSE
lcdateformat = SET('DATE')
lcentury = .T.
ENDIF
IF lcentury
SET CENTURY ON
ELSE
SET CENTURY OFF
ENDIF
*!* Following code added to set the set century to parameters
*!* which makes it easy to work with VFX Apps beyond the year 2000.
IF VARTYPE(goProgram)="O"
lncentury = IIF( EMPTY(goprogram.ncentury),INT(YEAR(DATE())/100),goprogram.ncentury)
lnrollover = IIF( EMPTY(goprogram.nrollover),0,goprogram.nrollover)
ELSE
*!* Actual century is the default.
lncentury = INT(YEAR(DATE())/100)
lnrollover = 0
ENDIF
SET CENTURY TO (lncentury) rollover (lnrollover)
SET DATE TO &lcdateformat
=formsetup(THISFORM)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("OnSetEnv",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
LPARAMETERS tlmode
IF TYPE("goProgram")="O"
goprogram.showtoolbar()
ELSE
RETURN .F.
ENDIF
IF !THISFORM.lshowtoolbar
RETURN .F.
ENDIF
IF ISNULL(THISFORM.otoolbar)
RETURN .F.
ENDIF
IF pcount() = 0
tlmode = .T.
ENDIF
IF tlmode
THISFORM.otoolbar.SHOW()
THISFORM.otoolbar.REFRESH()
THISFORM.otoolbar.ENABLED = .T.
ELSE
IF !ISNULL(THISFORM.otoolbar)
THISFORM.otoolbar.HIDE()
THISFORM.otoolbar.ENABLED = .F.
ENDIF
ENDIF
IF !THISFORM.lsaveposition OR THISFORM.WINDOWSTATE = 1 && Minimized
RETURN .F.
ENDIF
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("SavePosition",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
LOCAL ckey, lcalias
lcalias = ALIAS()
USE vfxres IN 0 ORDER TAG USER AGAIN ALIAS RESOURCE
SELECT RESOURCE
ckey = UPPER( PADR(m.gu_user,32,' ') + PADR(THISFORM.cformname, LEN(RESOURCE.objname)) )
LOCAL lnoldreprocess
lnoldreprocess = SET('REPROCESS')
SET REPROCESS TO AUTOMATIC
IF !SEEK(ckey,"RESOURCE","USER")
INSERT INTO RESOURCE (USER, objname) VALUES (UPPER( PADR(m.gu_user,32,' ')), PADR(THISFORM.cformname, LEN(RESOURCE.objname)))
ENDIF
IF RLOCK()
REPLACE RESOURCE.layout WITH STR(THISFORM.TOP ,4) +;
STR(THISFORM.LEFT ,4) +;
STR(THISFORM.WIDTH ,4) +;
STR(THISFORM.HEIGHT,4) ,;
RESOURCE.TOOLBAR WITH THISFORM.lshowtoolbar
THISFORM.onsaveposition()
ENDIF
USE IN RESOURCE
SET REPROCESS TO lnoldreprocess
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
LPARAMETERS tlmode
LOCAL lnmouse
lnmouse = IIF(tlmode,mouse_hourglass,mouse_default)
THISFORM.MOUSEPOINTER = lnmouse
_SCREEN.MOUSEPOINTER = lnmouse
THISFORM.SETALL('MousePointer',lnmouse)
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
THISFORM.SETALL('FontName', 'Arial')
ENDIF
LPARAMETERS tlonlydata,tlsetfocus
IF !tlonlydata
LOCAL lsetfocus
lsetfocus = THISFORM.lsetfocus
IF !tlsetfocus
THISFORM.lsetfocus=.F.
ENDIF
THISFORM.REFRESH()
THISFORM.lsetfocus = lsetfocus
ENDIF
LPARAMETERS tcformname, toform
LPARAMETERS tcevent, toobject, toform
LOCAL lretcode
lretcode = .T.
IF EMPTY(THISFORM.chookfunction)
lretcode = eventhookhandler(tcevent,toobject,toform)
ELSE
lretcode = EVAL(THISFORM.chookfunction+"(tcEvent,toObject,toForm)")
ENDIF
RETURN lretcode
LPARAMETERS tocontainer
IF TYPE("toContainer.BaseClass") # "C"
tocontainer = THISFORM
ENDIF
LOCAL lamembers[1], ;
lncount, ;
lcobject, ;
locontrol
locontrol = .NULL.
IF AMEMBERS(lamembers,tocontainer,2) > 0
FOR lncount = 1 TO ALEN(lamembers,1)
lcobject = lamembers[lnCount]
locontrol = tocontainer.&lcobject
IF INLIST(UPPER(locontrol.BASECLASS), ;
"pageframe","PAGE","GRID","COLUMN","CONTAINER","CONTROL")
IF UPPER(locontrol.BASECLASS) == "CONTAINER" AND ;
pemstatus(locontrol, "_vfxclassname", 5) AND ;
LOWER(locontrol._vfxclassname) == "cpickfield"
IF pemstatus(locontrol, "oLinkForm", 5)
IF TYPE("loControl.oLinkForm") = "O" AND !ISNULL(locontrol.olinkform)
IF pemstatus(locontrol.olinkform, "opickfield", 5)
locontrol.olinkform.opickfield = .NULL.
ENDIF
IF pemstatus(locontrol, "lReleaseMFormOnClose", 5)
IF locontrol.lreleasemformonclose
locontrol.olinkform.RELEASE()
ENDIF
ENDIF
ENDIF
locontrol.olinkform = .NULL.
ENDIF
ELSE
IF TYPE("laContainers[1]") = "U"
LOCAL lacontainers[1]
DIMENSION lacontainers[1]
ELSE
DIMENSION lacontainers[alen(laContainers,1)+1]
ENDIF
lacontainers[alen(laContainers,1)] = locontrol
ENDIF
ELSE
IF LOWER(UPPER(locontrol.BASECLASS)) == "textbox" AND ;
pemstatus(locontrol, "_vfxclassname", 5) AND ;
LOWER(locontrol._vfxclassname) == "cpicktextbox"
IF pemstatus(locontrol, "oLinkForm", 5)
IF TYPE("loControl.oLinkForm") = "O" AND !ISNULL(locontrol.olinkform)
IF pemstatus(locontrol.olinkform, "opickfield", 5)
locontrol.olinkform.opickfield = .NULL.
ENDIF
IF pemstatus(locontrol, "lReleaseMFormOnClose", 5)
IF locontrol.lreleasemformonclose
locontrol.olinkform.RELEASE()
ENDIF
ENDIF
ENDIF
locontrol.olinkform = .NULL.
ENDIF
ENDIF
ENDIF
ENDFOR
IF TYPE("laContainers[1]") = "O"
FOR lncount = 1 TO ALEN(lacontainers,1)
locontrol = lacontainers[lnCount]
IF INLIST(UPPER(locontrol.BASECLASS), ;
"pageframe","PAGE","GRID","COLUMN","CONTAINER","CONTROL")
IF !(TYPE("loControl.ReadOnly") = "L" AND locontrol.READONLY)
locontrol = THIS.cleanobjectref(locontrol)
ENDIF
ENDIF
ENDFOR
ENDIF
ENDIF
LPARAMETERS tloutput, tcreport
DO CASE
CASE tloutput = 0
LOCAL lcasciifile
lcasciifile = PUTFILE("Please supply a filename for Ascii Output", "OUTPUT.TXT", "TXT")
IF !EMPTY(lcasciifile)
* delete file if it already exists !
IF FILE(lcasciifile)
DELETE FILE &lcasciifile
ENDIF
REPORT FORM (tcreport) NOCONSOLE TO FILE &lcasciifile. ASCII
ENDIF
CASE tloutput = 1
REPORT FORM (tcreport) NOCONSOLE TO PRINTER PROMPT
OTHERWISE
LOCAL lconerror, llfailed, lcwinpath
lcerror = ON("error")
llfailed = .F.
ON ERROR llfailed = .T.
lcwinpath = STRTRAN(ALLTRIM(GETENV("windir")) + "\system32", "\\", "\")
IF !FILE(lcwinpath + "\foxuser.dbf") AND FILE("_foxuser.*")
COPY FILE "_foxuser.*" TO lcwinpath + "\foxuser.*"
ENDIF
SET RESOURCE ON
DEFINE WINDOW _preview FROM 0, 0 TO 10, 10;
TITLE THIS.CAPTION+" ("+cap_preview+")" IN SCREEN CLOSE GROW SYSTEM FLOAT
ZOOM WINDOW _preview MAX
REPORT FORM (tcreport) NOCONSOLE PREVIEW WINDOW _preview
RELEASE WINDOW _preview
IF !llfailed
SET RESOURCE OFF
ENDIF
ON ERROR &lcerror
ENDCASE
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
SET MESSAGE TO THISFORM.CAPTION
LOCAL lnitem, lloldflag
IF !EMPTY(THISFORM.cmenuform)
POP MENU _MSYSMENU
ENDIF
IF ISNULL(THISFORM.otoolbar)
THISFORM.lshowtoolbar = .F.
ENDIF
LOCAL lwinmenu
lwinmenu = THISFORM.lputinwindowmenu
THISFORM.lputinwindowmenu = .F.
IF TYPE("goProgram")="O"
goprogram.refreshwindowmenu()
IF lwinmenu
IF goprogram.nwinmnucount > 0
goprogram.nwinmnucount = goprogram.nwinmnucount -1
ENDIF
ENDIF
IF goprogram.nformcount > 0
LOCAL lninstance, lnformcount
lninstance = 0
lnformcount = goprogram.nformcount
IF THISFORM.lsaveposition
THISFORM.saveposition()
ENDIF
FOR lnitem = 1 TO lnformcount
IF TYPE("goProgram.aFormList[lnItem,3]")="O"
IF goprogram.aformlist[lnItem,1] == THISFORM.NAME
=ADEL(goprogram.aformlist, lnitem)
EXIT
ENDIF
ENDIF
NEXT
IF goprogram.nformcount > 0
goprogram.nformcount = goprogram.nformcount - 1
IF goprogram.nformcount > 0
DIMENSION goprogram.aformlist[goProgram.nFormCount,4]
ELSE
DIMENSION goprogram.aformlist[1,4]
goprogram.aformlist[1,1] = .F.
goprogram.aformlist[1,2] = .F.
goprogram.aformlist[1,3] = .F.
goprogram.aformlist[1,4] = .NULL.
ENDIF
ENDIF
ENDIF
ENDIF
IF TYPE("goProgram")="O"
IF !EMPTY(THISFORM.ctoolbarclass)
goprogram.removetoolbar(THISFORM.ctoolbarclass)
ENDIF
goprogram.lopendialog = .F.
goprogram.showtoolbar()
ENDIF
IF TYPE("thisForm.oResizeControl") = "O"
THISFORM.REMOVEOBJECT('oResizeControl')
ENDIF
THISFORM.otoolbar = .NULL.
THISFORM.lshowtoolbar = .F.
THISFORM.onresetenv()
IF THISFORM.WINDOWTYPE = 0
THISFORM.VISIBLE = .F.
THISFORM.refreshtoolbar(.F.)
ENDIF
FOR lnitem = 1 TO ALEN(THISFORM.acargo,1)
THISFORM.acargo[lnItem] = .NULL.
NEXT
THISFORM.cleanobjectref()
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Resize",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
WITH THIS
IF .lautoresizecontrol
.oresizecontrol.onformresize()
ENDIF
ENDWITH
LPARAMETERS tcarg
LOCAL lninstance, lnform, lnformcount, lnextinstance, lccaption,;
lnx, lny, lcscxname
IF VARTYPE(_VFX_FORM_WIZARD)="U"
lcscxname = SYS(1271,THIS)
IF !EMPTY(lcscxname)
THISFORM.cscxname = JUSTFNAME(UPPER(lcscxname))
ENDIF
IF EMPTY(JUSTFNAME(THISFORM.ICON))
THISFORM.ICON = _SCREEN.ICON
ENDIF
IF THISFORM.lusechildform
IF EMPTY(THISFORM.cchildformmgrclass)
THISFORM.cchildformmgrclass = "CChildFormManager"
ENDIF
THISFORM.ADDOBJECT('oFormList',THISFORM.cchildformmgrclass)
THISFORM.oformlist.TOP = THISFORM.HEIGHT
THISFORM.oformlist.LEFT = THISFORM.WIDTH
IF TYPE("thisForm.oFormList") # "O"
THISFORM.lusechildform = .F.
THISFORM.lautosyncchildform = .F.
WAIT WINDOW "Error creating the CChildFormManager!"
ENDIF
ELSE
THISFORM.lautosyncchildform = .F.
ENDIF
IF VARTYPE(goProgram)="O"
goprogram.olastformcreated = THIS
ENDIF
IF VARTYPE(GU_User)="U"
THIS.lsaveposition = .F.
ENDIF
IF TYPE("goProgram.lDisableFormResize")="L" AND goprogram.ldisableformresize
THISFORM.lautoresizecontrol = .F.
THISFORM.BORDERSTYLE = 2
THISFORM.MAXBUTTON = .F.
ENDIF
IF THISFORM.BORDERSTYLE != 3
THISFORM.lautoresizecontrol = .F.
ENDIF
IF THISFORM.lautoresizecontrol
IF EMPTY(THISFORM.MINWIDTH)
THISFORM.MINWIDTH = INT(THISFORM.WIDTH/2)
ENDIF
IF EMPTY(THISFORM.MINHEIGHT)
THISFORM.MINHEIGHT = INT(THISFORM.HEIGHT/2)
ENDIF
IF TYPE("goProgram.nResizeFont")="N"
IF goprogram.nResizeFont=1
THISFORM.lResizeFont = .T.
ENDIF
IF goprogram.nResizeFont=2
THISFORM.lResizeFont = .F.
ENDIF
ENDIF
IF EMPTY(THISFORM.cresizectrlclass)
THISFORM.cresizectrlclass = "CResizeCtrl"
ENDIF
THISFORM.ADDOBJECT("oResizeControl",THISFORM.cresizectrlclass)
IF TYPE("thisForm.oResizeControl") # "O"
THISFORM.lautoresizecontrol = .F.
THISFORM.MINWIDTH = THISFORM.WIDTH
THISFORM.MINHEIGHT = THISFORM.HEIGHT
ENDIF
ELSE
THISFORM.MINWIDTH = THISFORM.WIDTH
THISFORM.MINHEIGHT = THISFORM.HEIGHT
ENDIF
THISFORM.langsetup()
THISFORM.cformcaption = THISFORM.CAPTION
lnextinstance = .F.
lccaption = THISFORM.CAPTION
IF THISFORM.WINDOWTYPE = 1
THISFORM.cmenuform = ''
ENDIF
IF THISFORM.lsaveposition
IF !THISFORM.loadposition()
IF THISFORM.lcascade AND VARTYPE(goProgram)="O"
IF !(WMINIMUM() OR WMAXIMUM())
THISFORM.TOP = goprogram.nlastwintop + id_winofftop
THISFORM.LEFT = goprogram.nlastwinleft + id_winoffleft
goprogram.nlastwintop = THISFORM.TOP
goprogram.nlastwinleft = THISFORM.LEFT
ELSE
THISFORM.AUTOCENTER = .T.
ENDIF
ELSE
THISFORM.AUTOCENTER = .T.
ENDIF
ENDIF
ELSE
IF THISFORM.lcascade
IF !(WMINIMUM() OR WMAXIMUM())
IF VARTYPE(goProgram)="O"
THISFORM.TOP = goprogram.nlastwintop + id_winofftop
THISFORM.LEFT = goprogram.nlastwinleft + id_winoffleft
goprogram.nlastwintop = THISFORM.TOP
goprogram.nlastwinleft = THISFORM.LEFT
ELSE
THISFORM.AUTOCENTER = .T.
ENDIF
ELSE
THISFORM.AUTOCENTER = .T.
ENDIF
ELSE
THISFORM.AUTOCENTER = .T.
ENDIF
ENDIF
IF VARTYPE(goProgram)="O"
IF !EMPTY(THISFORM.ctoolbarclass)
IF ISNULL(THISFORM.otoolbar)
THISFORM.otoolbar = goprogram.addtoolbar(THISFORM.ctoolbarclass)
IF !THISFORM.lshowtoolbar
IF TYPE("thisForm.oToolBar")="O" AND !ISNULL(THISFORM.otoolbar)
THISFORM.otoolbar.VISIBLE = .F.
ENDIF
ENDIF
ENDIF
ENDIF
IF goprogram.nformcount = 0
lninstance = 1
lnform = 1
lnformcount = 0
ELSE
lnformcount = goprogram.nformcount
lnfound = .F.
FOR lnform = lnformcount TO 1 STEP -1
IF !ISNULL(goprogram.aformlist[lnForm,3])
IF goprogram.aformlist[lnForm,3].cformname == THISFORM.cformname
IF EMPTY(goprogram.aformlist[lnForm,4])
goprogram.aformlist[lnForm,4] = 1
ENDIF
IF goprogram.aformlist[lnForm,4] >= 1
lninstance = goprogram.aformlist[lnForm,4] + 1
THISFORM.NAME = SYS(2015)
THISFORM.CAPTION = ALLTRIM(THISFORM.CAPTION)+ ":" + ALLTRIM(STR(lninstance))
ENDIF
EXIT
ENDIF
ENDIF
NEXT
ENDIF
goprogram.nformcount = lnformcount + 1
lnform = goprogram.nformcount
DIMENSION goprogram.aformlist[lnForm,4]
goprogram.aformlist[lnForm,1] = THISFORM.NAME && Object Name
goprogram.aformlist[lnForm,2] = THISFORM.CAPTION && Object Caption
goprogram.aformlist[lnForm,3] = THIS && Object
goprogram.aformlist[lnForm,4] = lninstance && Instance
IF THISFORM.lputinwindowmenu
goprogram.nwinmnucount = goprogram.nwinmnucount + 1
goprogram.refreshwindowmenu()
ENDIF
* Moved here from cfoxapp.runform
IF THIS.lputinlastfile AND VARTYPE(this.cscxname)="C"
goprogram.addtolastfile(this.cscxname,this.cformcaption)
ENDIF
ENDIF
THISFORM.oninit()
IF THISFORM.lautoresizecontrol
THISFORM.RESIZE()
ENDIF
ENDIF
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Activate",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
THISFORM.refreshtoolbar(.T.)
IF THISFORM.lcascade
IF VARTYPE(goProgram)="O"
goprogram.nlastwintop = THISFORM.TOP
goprogram.nlastwinleft = THISFORM.LEFT
ENDIF
ENDIF
SET MESSAGE TO
SET MESSAGE TO ''
IF VARTYPE(this.cmenuform)="C" AND !EMPTY(THIS.cmenuform)
PUSH MENU _MSYSMENU
IF UPPER(RIGHT(THIS.cmenuform,4))#".MPR"
THIS.cmenuform=THIS.cmenuform+".MPR"
ENDIF
DO (THIS.cmenuform)
ENDIF
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Deactivate",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
* Restore the system menu
IF!EMPTY(THIS.cmenuform)
POP MENU _MSYSMENU
ENDIF
THISFORM.refreshtoolbar(.F.)
IF THISFORM.lcascade
IF TYPE("goProgram")="O"
goprogram.nlastwintop = THISFORM.TOP
goprogram.nlastwinleft = THISFORM.LEFT
ENDIF
ENDIF
IF THISFORM.lusechildform
*!* Check wheter the oformlist exists
IF VARTYPE(thisform.oformlist)="O"
THISFORM.oformlist.refreshallchild(.T.) && Only Data
ENDIF
ENDIF
IF TYPE("_VFX_FORM_WIZARD")="U"
IF !("VFXFUNC" $ SET('proc'))
SET PROCEDURE TO PROGRAM\vfxfunc ADDITIVE
ENDIF
IF !("VFXOBJ.VCX" $ SET('classlib'))
SET CLASSLIB TO lib\vfxobj.vcx ADDITIVE
ENDIF
IF !("VFXCTRL.VCX" $ SET('classlib'))
SET CLASSLIB TO lib\vfxctrl.vcx ADDITIVE
ENDIF
IF !("VFXAPPL" $ SET('classlib'))
SET CLASSLIB TO lib\vfxappl ADDITIVE
ENDIF
IF !("APPLFUNC" $ SET('procedure'))
SET PROCEDURE TO PROGRAM\applfunc ADDITIVE
ENDIF
IF TYPE("goProgram.nEnableHook")="N"
IF goprogram.nenablehook > 0
THISFORM.lusehook = (goprogram.nenablehook = 1)
ENDIF
ENDIF
IF THISFORM.lusehook
IF !("VFXHOOK" $ SET('proc'))
SET PROC TO PROGRAM\vfxhook ADDITIVE
ENDIF
ENDIF
THISFORM.onsetenv()
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Load",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
THISFORM.cformname = THISFORM.NAME
ENDIF
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("RightClick",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
IF VARTYPE(goProgram)="O"
IF goprogram.ldebugmode
WAIT WINDOW THISFORM.CAPTION + CHR(13)+ " * DEBUG *"
SET
ACTIVATE WIND DEBUG
ACTIVATE WIND COMMAND
SUSPEND
ENDIF
ENDIF
PARAMETERS nkeycode, nshiftaltctrl
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("KeyPress",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
NODEFAULT
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
NODEFAULT
RETURN luhookvalue=0
ENDCASE
ENDIF
IF THISFORM.lcloseonesc AND nkeycode = key_escape
IF THISFORM.QUERYUNLOAD()
THISFORM.RELEASE()
NODEFAULT
ENDIF
ENDIF
IF nkeycode = THISFORM.lnhotkeyrefresh AND THISFORM.lnhotkeyrefresh != 0
THISFORM.REFRESH()
ENDIF
| Name | Initial value |
|---|---|
| AutoRelease | .T. |
| BufferMode | 2 |
| DataSession | 2 |
| Name | Initial value | Comment |
|---|---|---|
| _vfxclassname | CFormSet | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer to store any kind of usefull information. |
| Baseclass | Class | Object name |
|---|---|---|
| form | cdataformpage | cformset.frmUntitled |
| Name | Initial value |
|---|---|
| DoCreate | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| zzz | zzz | cformset.frmUntitled.pgfPageFrame |
| Name | Initial value |
|---|---|
| ErasePage | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| zzz | zzz | cformset.frmUntitled.pgfPageFrame.Page1 |
| Name | Initial value |
|---|---|
| DeleteMark | .F. |
| FontBold | .F. |
| GridLineColor | 192,192,192 |
| GridLines | 2 |
| HelpContextID | 302 |
| ReadOnly | .T. |
| RecordMark | .T. |
| RowHeight | 18 |
| TabIndex | 999 |
| Name | Initial value | Comment |
|---|---|---|
| ^acolumns[1,0] | .f. | |
| _vfxclassname | CGrid | Internal use.Specifies the original VFX Class Name |
| cascorderrgb | RGB(255,255,0) | Specifies the color to use for Ascending Order |
| cdescorderrgb | RGB(255,0,0) | Specifies the color to use to descending order |
| csavesortcolumns | .f. | Internal use |
| csavesortexpr | .f. | Internal Use |
| csavesortexprval | .f. | Internal Use |
| csearchtext | Internal Use. | |
| csortcolumns | ||
| csortexpr | ||
| ctablename | .f. | Name of the view of the rowsource when rowsourcetype = 2 (alias) or 6 (fields). Only needed if the user defines the sql string manually, this name can either be set by the programmer or it will be generated using the sys(2015) function. |
| ctitlecolor | .f. | Store the original Header BackColor |
| extrabuffer | .f. | A user buffer |
| getsptsource | .f. | Method to place the sql select source used for spt operations |
| lautosaveposition | .f. | Specifies if the Grid should Save/Restore the positions |
| lautosetup | .T. | .T. if it's enabled when the form is in Insert or Edit mode |
| lenteriseditmode | .f. | Specifies if the OnKeyEnter() will call the OnEdit() method or not |
| lproportionalfont | .f. | |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lrequeryoninit | .f. | If the rowsource of the combo is parametrised, set this property to .t. if during the init() you have the correct parameter values and want a requery to happen. If set to .f., the rowsource will only be fetched with an empty structure. |
| lsptsourcefromuser | .f. | Set to .t. defines, that the programmer defined the SPT select statement during design time. |
| lusesetkey | .f. | Specifies if this grid use a SET KEY |
| lusespt | .f. | This property defines whether SQL Pass Through (short: SPT) will be used to speedup operation and reduce the dataenvironment and connection overhead. |
| ncolumn | 0 | Reserved. Current Column |
| nincsearchtimeout | 2 | Specifies when the incremental search string will be cleared |
| nlastkey | 0 | Internal Use |
| nmaxrec | 25000 | Specifies how many records are used when creating temporary index. |
| nrecno | 0 | Internal Use |
| ocontrol | .NULL. | Current active control |
LPARAMETERS nkeycode, nshiftaltctrl
LOCAL controltype, llusemultisorttag
THISFORM.noldrecno = IIF(EOF() OR DELETED(), 0, RECNO())
* Ctrl+Tab or Shift+Ctrl+Tab.
IF nkeycode=148 AND (nshiftaltctrl=2 OR nshiftaltctrl=3)
RETURN .F.
ENDIF
IF nshiftaltctrl > 1
RETURN .T.
ENDIF
IF !EMPTY(THIS.nincsearchtimeout)
IF SECONDS() - THIS.nlastkey > THIS.nincsearchtimeout
THIS.csearchtext = ''
ENDIF
ENDIF
IF 32 <= nkeycode AND nkeycode <= 255
LOCAL otext, noldrec
otext = THIS.ocontrol
IF !EMPTY(otext.COMMENT)
controltype = VARTYPE(EVAL(otext.COMMENT))
ELSE
controltype = VARTYPE(EVAL(otext.PARENT.CONTROLSOURCE))
ENDIF
noldrec = IIF( ! (EOF() OR DELETED()), RECNO(), 0)
IF nkeycode = 127
IF EMPTY(THIS.csearchtext)
THIS.nlastkey = SECONDS()
RETURN .T.
ENDIF
THIS.csearchtext = ALLTRIM(THIS.csearchtext)
IF LEN(THIS.csearchtext)> 0
THIS.csearchtext = LEFT(THIS.csearchtext, LEN(THIS.csearchtext)-1)
ENDIF
ELSE
THIS.csearchtext = THIS.csearchtext + CHR(nkeycode)
ENDIF
IF EMPTY(otext.TAG)
*!* Recognize the difference between column1 and column10.
IF getarg(THIS.csortcolumns,1) == THIS.ocontrol.PARENT.NAME
llusemultisorttag = (getargcount(THIS.csortcolumns)>2)
ELSE
IF !THIS.onsetorder(otext.PARENT,.T.)
THIS.nlastkey = SECONDS()
RETURN .F.
ENDIF
ENDIF
ELSE
IF getarg(THIS.csortcolumns,1) == THIS.ocontrol.PARENT.NAME
llusemultisorttag = (getargcount(THIS.csortcolumns)>2)
ELSE
IF TAG() <> otext.TAG
SET ORDER TO TAG otext.TAG
THISFORM.setkeyreset()
SET MESSAGE TO THISFORM.CAPTION
THIS.setcolumn(otext.PARENT)
THIS.REFRESH()
ENDIF
ENDIF
ENDIF
*!* Limit length of string to avoid errors.
SET MESSAGE TO LEFT(msg_search + " : " + THIS.csearchtext,200)
LOCAL ckeyexpr, csortexpr, csource
ckeyexpr = .NULL.
DO CASE
CASE controltype = "C"
DO CASE
CASE KEY() = "UPPER" OR KEY() = "LEFT(UPPER"
ckeyexpr = UPPER(ALLTRIM(THIS.csearchtext))
CASE KEY() = "LOWER" OR KEY() = "LEFT(LOWER"
ckeyexpr = LOWER(ALLTRIM(THIS.csearchtext))
OTHERWISE
ckeyexpr = ALLTRIM(THIS.csearchtext)
ENDCASE
CASE controltype = "L"
ckeyexpr = UPPER(CHR(nkeycode))
CASE controltype $ "DT"
* Detect order sequence of day/month/year
* 1=say, 2=month, 3=year
LOCAL ladatf[3], lcdate
lcdate = SET("date")
DO CASE
CASE lcdate $ "GERMAN ITALIAN DMY BRITISH FRENCH"
ladatf[1] = 1
ladatf[2] = 2
ladatf[3] = 3
CASE lcdate $ "AMERICAN USA MDY"
ladatf[1] = 2
ladatf[2] = 1
ladatf[3] = 3
OTHERWISE
ladatf[1] = 3
ladatf[2] = 2
ladatf[3] = 1
ENDCASE
* Analyze input regarding day/month/year
LOCAL ladate[5], lnc, lnlen, lnpart, lcc
lltrenner = .F.
lnpart = 1
STORE "" TO ladate &&& Ok, Now all elements of array are char and not logical!
lnlen = LEN(THIS.csearchtext)
FOR lnc = 1 TO lnlen
lcc = SUBSTR(THIS.csearchtext, lnc, 1)
IF !ISDIGIT(lcc) OR ( LEN(ladate[lnPart])+1 > IIF(ladatf[lnPart]<=2,2,4) )
lnpart = lnpart + IIF(lnpart < 3,1,0) && Now lnPart Max. Value is 3!
ENDIF
IF ISDIGIT(lcc)
ladate[lnPart] = ladate[lnPart] + lcc
ENDIF
NEXT
LOCAL lcdtos, lcsave
lcdtos = DTOS(DATE())
FOR lnpart = 1 TO 3
* Content is always text
IF EMPTY(ladate[lnPart])
ladate[lnPart] = ""
ENDIF
* complete
IF EMPTY(ladate[laDatF[lnPart]])
DO CASE
CASE lnpart = 1
* day
ladate[laDatF[lnPart]] = RIGHT(lcdtos,2)
CASE lnpart = 2
* month
ladate[laDatF[lnPart]] = SUBSTR(lcdtos,5,2)
CASE lnpart = 3
* year
ladate[laDatF[lnPart]] = LEFT(lcdtos,4)
ENDCASE
ELSE
IF lnpart = 3
* Year
DO CASE
CASE LEN(ladate[laDatF[lnPart]]) = 2
* Year with 2 digits - calc century
LOCAL lccent
IF !EMPTY(goprogram.nrollover)
* Rollover has been set - use it !
IF VAL(ladate[laDatF[lnPart]]) < goprogram.nrollover
* next Century
lccent = TRANSFORM(VAL(LEFT(lcdtos,2))+1)
ELSE
* actual Century
lccent = LEFT(lcdtos,2)
ENDIF
ELSE
* no Rollover set - use century of actual year
lccent = LEFT(lcdtos,2)
ENDIF
* put century and year together
ladate[laDatF[lnPart]] = lccent+ladate[laDatF[lnPart]]
CASE LEN(ladate[laDatF[lnPart]]) = 4
* do nothing century specified by user
OTHERWISE
* year is incomplete - complete with actual year
lnlen = LEN(ladate[laDatF[lnPart]])
ladate[laDatF[lnPart]] = ladate[laDatF[lnPart]] + SUBSTR(lcdtos, lnlen+1, 4-lnlen)
ENDCASE
ELSE
* format day and month with leading 0
ladate[laDatF[lnPart]] = PADL(ladate[laDatF[lnPart]],2,"0")
ENDIF
ENDIF
NEXT
* put together cKeyExpr to search for in year/month/day order
ckeyexpr = ""
FOR lnpart = 3 TO 1 STEP -1
ckeyexpr = ckeyexpr + ladate[laDatF[lnPart]]
NEXT
CASE controltype $ "NFYIB"
IF this.lUseSetKey OR llusemultisorttag
ckeyexpr = TRANSFORM(VAL(THIS.csearchtext))
ELSE
ckeyexpr = VAL(ALLTRIM(THIS.csearchtext))
ENDIF
OTHERWISE
THIS.nlastkey = SECONDS()
RETURN .T.
ENDCASE
IF VARTYPE(ckeyexpr)="O"
THIS.nlastkey = SECONDS()
RETURN .T.
ENDIF
*-- for multisort
IF !llusemultisorttag
IF !EMPTY(THIS.ocontrol.COMMENT)
csource = UPPER(THIS.ocontrol.COMMENT)
ELSE
csource = UPPER(THIS.ocontrol.CONTROLSOURCE)
ENDIF
csource = ALLTRIM(UPPER(STRTRAN(csource,ALIAS()+".","")))
DO CASE
CASE TYPE(csource) = "C"
DO CASE
CASE KEY() = "UPPER" OR KEY() = "LEFT(UPPER"
csortexpr = "UPPER("+csource+")"
CASE KEY() = "LOWER" OR KEY() = "LEFT(LOWER"
csortexpr = "LOWER("+csource+")"
OTHERWISE
csortexpr = csource
ENDCASE
CASE TYPE(csource) = "L"
csortexpr = 'IIF('+csource+',"T","F")'
CASE TYPE(csource) $ "DT"
csortexpr = "DTOS("+csource+")"
CASE TYPE(csource) $ "NI"
IF THIS.lusesetkey
csortexpr = "STR("+csource+")"
ELSE
csortexpr = csource
ENDIF
ENDCASE
THIS.csortexpr = IIF(TYPE(csortexpr) $ "NI", "STR("+csortexpr+")", csortexpr)
THIS.csortcolumns = THIS.ocontrol.PARENT.NAME + ";"
ENDIF
*-- for multisort end
IF THIS.lusesetkey
ckeyexpr = THISFORM.csetkeyvalue + ckeyexpr
ENDIF
IF !SEEK(ckeyexpr)
IF !EMPTY(noldrec)
GO noldrec
ELSE
LOCATE
ENDIF
ENDIF
THIS.onrecordmove()
THIS.nlastkey = SECONDS()
RETURN .T.
ELSE
THIS.nlastkey = SECONDS()
THISFORM.noldrecno = IIF(EOF() OR DELETED(), 0, RECNO())
THIS.csearchtext = ""
SET MESSAGE TO THISFORM.CAPTION
IF nkeycode = 13
CLEAR TYPEAHEAD
THIS.onkeyenter()
RETURN .T. && Ignore this Key
ENDIF
IF nkeycode = 7 && Canc
CLEAR TYPEAHEAD
RETURN .T. && Ignore this Key
ENDIF
ENDIF
RETURN .F.
LPARAMETERS tocolumn, tlfromkey, tlmultisort
LOCAL ckeyexpr, ncount, makeidx, usecdxtag, ;
csource, lcsetkey, lcoldtag, lccontrolname, locontrol, noldrec, lldescending, ;
lcoldsortexpr, lcoldsortcolumns
lcoldtag = TAG()
** Search the column that match the current order
IF VARTYPE(THIS.RECORDSOURCE)="C"
IF USED(THIS.RECORDSOURCE)
SELECT (THIS.RECORDSOURCE)
ENDIF
ENDIF
THISFORM.TAG = ''
** Called from the Form Init Method()
LOCAL lnthiscolumn
lnthiscolumn = THIS.ACTIVECOLUMN
IF VARTYPE(tocolumn)#"O"
IF EMPTY(TAG())
THIS.csortexpr = ""
THIS.csortcolumns = ""
RETURN .F.
ENDIF
** Search the best index like
THIS.setcolumn()
IF !EMPTY(THIS.csortcolumns)
THIS.setcolumn("", .T.)
ELSE
FOR ncount = 1 TO THIS.COLUMNCOUNT
tocolumn = THIS.COLUMNS[nCount]
lccontrolname = THIS.COLUMNS[nCount].CURRENTCONTROL
locontrol = THIS.COLUMNS[nCount].&lccontrolname
IF !EMPTY(locontrol.COMMENT)
csource = UPPER(locontrol.COMMENT)
ELSE
csource = UPPER(tocolumn.CONTROLSOURCE)
ENDIF
csource = STRTRAN(csource,ALIAS()+".","")
DO CASE
CASE TYPE(csource) = "C"
ckeyexpr = "UPPER("+ALLTRIM(UPPER(csource))+")"
CASE TYPE(csource) = "L"
ckeyexpr = 'IIF('+ALLTRIM(csource)+',"T","F")'
CASE TYPE(csource) $ "DT"
ckeyexpr = "DTOS("+ALLTRIM(csource)+")"
CASE TYPE(csource) $ "NI"
IF THIS.lusesetkey
ckeyexpr = "STR("+ALLTRIM(csource)+")"
ELSE
ckeyexpr = ALLTRIM(csource)
ENDIF
OTHERWISE
RETURN .F.
ENDCASE
IF THIS.lusesetkey AND THISFORM.lusesetkeyasfilter
ckeyexpr = THISFORM.csetkeyexpr + '+' + ckeyexpr
ENDIF
IF ALLTRIM(UPPER(ckeyexpr)) == LEFT(ALLTRIM(UPPER(KEY())),LEN(ckeyexpr))
THIS.csortexpr = IIF(TYPE(ckeyexpr)$"NI", "STR("+ckeyexpr+")", ckeyexpr)
THIS.csortcolumns = tocolumn.NAME + ";"
IF lnthiscolumn != ncount
THIS.setcolumn(tocolumn)
ENDIF
EXIT
ENDIF
NEXT
ENDIF
IF THIS.lusesetkey
THISFORM.setkeyreset(.T.)
ENDIF
RETURN .F.
ENDIF
** Specified a Column
ncount = 0
* Store the record number in a local variable because thisform.noldrecno
* is modified during the grid.refresh (which calls afterrowcolchange).
noldrec = IIF(EOF() OR DELETED(), 0, RECNO())
LOCATE
IF EOF()
RETURN .F.
ENDIF
lccontrolname = tocolumn.CURRENTCONTROL
locontrol = tocolumn.&lccontrolname
IF tlmultisort
usecdxtag = UPPER(TAG())
ELSE
usecdxtag = UPPER(locontrol.TAG)
ENDIF
LOCAL ltagdeleted
ltagdeleted = .T.
** Check if the TAG Is still available
FOR ncount = 1 TO tagcount()
IF TAG(ncount) == usecdxtag
ltagdeleted = .F.
EXIT
ENDIF
ENDFOR
IF !EMPTY(locontrol.COMMENT)
csource = UPPER(locontrol.COMMENT)
ELSE
csource = UPPER(tocolumn.CONTROLSOURCE)
ENDIF
csource = ALLTRIM(UPPER(STRTRAN(csource,ALIAS()+".","")))
DO CASE
CASE TYPE(csource) = "C"
ckeyexpr = "UPPER("+csource+")"
CASE TYPE(csource) = "L"
ckeyexpr = 'IIF('+csource+',"T","F")'
CASE TYPE(csource) $ "DT"
ckeyexpr = "DTOS("+csource+")"
CASE TYPE(csource) $ "NI"
IF THIS.lusesetkey
ckeyexpr = "STR("+csource+")"
ELSE
ckeyexpr = csource
ENDIF
OTHERWISE
RETURN .T.
ENDCASE
IF (!tlmultisort AND (EMPTY(locontrol.TAG) OR ltagdeleted)) OR ;
(tlmultisort AND (!tocolumn.NAME + ";" $ THIS.csortcolumns OR AT(";", THIS.csortcolumns, 2) = 0))
lcoldsortexpr = THIS.csortexpr
lcoldsortcolumns = THIS.csortcolumns
IF tlmultisort
lldescending = DESCENDING()
ELSE
THIS.csortexpr = IIF(TYPE(ckeyexpr) $ "NI", "STR("+ckeyexpr+")", ckeyexpr)
THIS.csortcolumns = tocolumn.NAME + ";"
ENDIF
IF tlmultisort AND !tocolumn.NAME + ";" $ THIS.csortcolumns
THIS.csortexpr = THIS.csortexpr + '+' + IIF(TYPE(ckeyexpr)$"NI", "STR("+ckeyexpr+")", ckeyexpr)
THIS.csortcolumns = THIS.csortcolumns + tocolumn.NAME + ";"
ckeyexpr = THIS.csortexpr
ENDIF
IF THIS.lusesetkey
ckeyexpr = THISFORM.csetkeyexpr + '+' + ckeyexpr
ENDIF
IF VARTYPE(EVAL(ckeyexpr))="C"
IF LEN(EVAL(ckeyexpr)) > 80
ckeyexpr = "LEFT("+ckeyexpr+",80)"
ENDIF
ENDIF
makeidx = .T.
usecdxtag = ""
IF !tlmultisort
FOR ncount = 1 TO tagcount()
IF ALLTRIM(UPPER(ckeyexpr)) == LEFT(ALLTRIM(UPPER(KEY(ncount))),LEN(ckeyexpr)) AND ;
RIGHT(TAG(ncount),1) <> ";"
makeidx = !EMPTY(SYS(2021,ncount))
usecdxtag = TAG(ncount)
EXIT
ENDIF
ENDFOR
ENDIF
IF makeidx
** Table Buffering: It's not possible to make a temporary index!
IF THISFORM.nformstatus <> 0
WAIT WINDOW msg_not_available TIMEOUT 2
THIS.csortexpr = lcoldsortexpr
THIS.csortcolumns = lcoldsortcolumns
RETURN .F.
ENDIF
LOCAL lnresettobuffermode
lnresettobuffermode = 0
LOCAL lnreccount, cfilterexpr, lcidx
cfilterexpr = IIF(LOWER(THISFORM.cworkalias) == LOWER(THIS.RECORDSOURCE), THISFORM.cfilterexpr, "")
IF !EMPTY(cfilterexpr)
COUNT FOR &cfilterexpr TO lnreccount
ELSE
lnreccount = RECCOUNT()
ENDIF
IF lnreccount >= THIS.nmaxrec
IF MESSAGEBOX(msg_ask_for_idx,4+32,msg_attention)=7
THIS.csortexpr = lcoldsortexpr
THIS.csortcolumns = lcoldsortcolumns
RETURN .F.
ENDIF
ENDIF
lcidx = "X"+SUBSTR(SYS(2015), 4, 7)
IF !tlmultisort
locontrol.TAG = lcidx
ENDIF
WAIT WINDOW msg_make_index NOWAIT
LOCAL lcerror
_vfx_index_error = .F.
lcerror = ON('error')
ON ERROR _vfx_index_error = .T.
IF TYPE("goProgram.lDebugMode")="L" AND goprogram.ldebugmode
ON ERROR
ENDIF
IF INLIST(CURSORGETPROP("Buffering", ALIAS()) ,4,5)
lnresettobuffermode = CURSORGETPROP("buffering")
CURSORSETPROP("buffering", 3)
ENDIF
IF EMPTY(cfilterexpr)
INDEX ON &ckeyexpr TO (lcidx) ADDITIVE
ELSE
INDEX ON &ckeyexpr TO (lcidx) FOR &cfilterexpr ADDITIVE
ENDIF
IF lnresettobuffermode > 0
CURSORSETPROP("buffering", lnresettobuffermode)
ENDIF
ON ERROR &lcerror
IF !_vfx_index_error
IF tlmultisort
IF lldescending
SET ORDER TO (lcidx) DESCENDING
ELSE
SET ORDER TO (lcidx) ASCENDING
ENDIF
ENDIF
THISFORM.oidxmanager.addtag(TAG(),ALIAS())
IF VARTYPE(goprogram)="O"
goprogram.nidxcount = goprogram.nidxcount + 1
ENDIF
ELSE
IF !tlmultisort
locontrol.TAG = "" && clear index name when error!
ENDIF
WAIT WINDOW msg_not_available TIMEOUT 2
ENDIF
RELEASE _vfx_index_error
ELSE
locontrol.TAG = usecdxtag
SET ORDER TO TAG (usecdxtag)
IF lcoldtag = TAG() AND !tlfromkey
IF DESCENDING()
SET ORDER TO TAG (usecdxtag) ASCENDING
ELSE
SET ORDER TO TAG (usecdxtag) DESCENDING
ENDIF
ELSE
SET ORDER TO TAG (usecdxtag) ASCENDING
ENDIF
ENDIF
ELSE
LOCAL lctag
lctag = usecdxtag
SET ORDER TO TAG (lctag)
IF lcoldtag = TAG() AND !tlfromkey
IF DESCENDING()
SET ORDER TO TAG (lctag) ASCENDING
ELSE
SET ORDER TO TAG (lctag) DESCENDING
ENDIF
ENDIF
IF !tlmultisort
IF VARTYPE(csource) = "C"
DO CASE
CASE KEY() = "UPPER"
ckeyexpr = "UPPER("+csource+")"
CASE KEY() = "LOWER"
ckeyexpr = "LOWER("+csource+")"
OTHERWISE
ckeyexpr = csource
ENDCASE
ENDIF
THIS.csortexpr = IIF(TYPE(ckeyexpr) $ "NI", "STR("+ckeyexpr+")", ckeyexpr)
THIS.csortcolumns = tocolumn.NAME + ";"
ENDIF
ENDIF
WAIT CLEAR
THISFORM.LOCKSCREEN = .T.
IF THIS.lusesetkey
THISFORM.setkeyreset(.T.)
ENDIF
* The refresh modifies nOldRecno and moves to the wrong record.
THIS.REFRESH()
IF !EMPTY(noldrec)
GO noldrec
ELSE
LOCATE
ENDIF
THISFORM.noldrecno = IIF(EOF() OR DELETED(), 0, RECNO())
* Already refreshed with the current order. NOldrecno is not modified again.
THIS.REFRESH()
* Refresh all Childs with the actual record!
IF THISFORM.lautosyncchildform
THISFORM.oformlist.refreshallchild()
ENDIF
LOCAL lfromvalid
lfromvalid = .F.
IF VARTYPE(__vfx_fromvalid)="L" AND __vfx_fromvalid
lfromvalid = .T.
ENDIF
IF !lfromvalid
tocolumn.SETFOCUS()
ENDIF
THIS.setcolumn(tocolumn, tlmultisort)
THISFORM.LOCKSCREEN = .F.
RELEASE THIS
LOCAL j, griddata, lckey, lcalias, lnrec, lcindexkey, lldescending
lcalias = ALIAS()
lnrec = IIF(EOF() OR DELETED(), 0, RECNO())
griddata = ""
FOR j = 1 TO THIS.COLUMNCOUNT
griddata = griddata + STR(THIS.COLUMNS[j].COLUMNORDER,4) && Position
griddata = griddata + STR(THIS.COLUMNS[j].WIDTH ,4) && Width
ENDFOR
griddata=griddata+str(this.partition,4)
LOCAL lcloseit, lcobjname, loparent, lcformname
lcobjname = THIS.NAME
loparent = THIS.PARENT
DO WHILE LOWER(loparent.BASECLASS) # 'form'
lcobjname = loparent.NAME + "." + lcobjname
loparent = loparent.PARENT
ENDDO
IF LOWER(loparent.BASECLASS) = 'form'
IF TYPE("loParent.cFormName")="C"
lcobjname = UPPER(loparent.cformname + "." + lcobjname)
lcformname = UPPER(loparent.cformname)
ELSE
lcobjname = UPPER(loparent.NAME + "." + lcobjname)
lcformname = UPPER(loparent.NAME)
ENDIF
ELSE
lcobjname = UPPER(loparent.NAME + "." + lcobjname)
lcformname = UPPER(loparent.NAME)
ENDIF
lcloseit = !USED("resource")
IF lcloseit
USE vfxres IN 0 ORDER TAG USER AGAIN ALIAS RESOURCE
ENDIF
SELECT (THIS.RECORDSOURCE)
lcindexkey = KEY()
lldescending = DESCENDING()
SELECT RESOURCE
LOCAL lnoldreprocess
lnoldreprocess = SET('REPROCESS')
SET REPROCESS TO AUTOMATIC
lckey = UPPER( PADR(m.gu_user,32,' ') + PADR(lcobjname, LEN(RESOURCE.objname)))
IF !SEEK(lckey,"RESOURCE","USER")
INSERT INTO RESOURCE (USER, objname);
VALUES (UPPER(m.gu_user), lcobjname)
ENDIF
IF RLOCK()
REPLACE RESOURCE.layout WITH griddata, ;
RESOURCE.INDEX WITH TRIM(lcindexkey) + "[" + TRIM(THIS.csortcolumns) + "]", ;
RESOURCE.DESCENDING WITH lldescending
ENDIF
IF lcloseit
USE IN RESOURCE
ENDIF
SET REPROCESS TO lnoldreprocess
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
IF lnrec > 0 AND lnrec<=RECCOUNT()
GOTO lnrec
ENDIF
LOCAL j, griddata, lckey, lcalias, lnrec
lcalias = ALIAS()
lnrec = IIF(EOF() OR DELETED(), 0, RECNO())
griddata = ""
LOCAL lcloseit, lcobjname, loparent, lcformname
lcobjname = THIS.NAME
loparent = THIS.PARENT
DO WHILE LOWER(loparent.BASECLASS) # 'form'
lcobjname = loparent.NAME + "." + lcobjname
loparent = loparent.PARENT
ENDDO
IF LOWER(loparent.BASECLASS) = 'form'
IF VARTYPE(loparent.cformname)="C"
lcobjname = UPPER(loparent.cformname + "." + lcobjname)
lcformname = UPPER(loparent.cformname)
ELSE
lcobjname = UPPER(loparent.NAME + "." + lcobjname)
lcformname = UPPER(loparent.NAME)
ENDIF
ELSE
lcobjname = UPPER(loparent.NAME + "." + lcobjname)
lcformname = UPPER(loparent.NAME)
ENDIF
lcloseit = !USED("resource")
IF lcloseit
USE vfxres IN 0 ORDER TAG USER AGAIN ALIAS RESOURCE
ENDIF
SELECT RESOURCE
lckey = UPPER( PADR(m.gu_user,32,' ') + PADR(lcobjname, LEN(RESOURCE.objname)))
IF SEEK(lckey,"resource","user")
LOCAL lnpos, lncolno, lnwidth
lnpos = 0
FOR j = 1 TO THIS.COLUMNCOUNT
lnpos = lnpos + 1
IF LEN(RESOURCE.layout)<(lnpos*4)
EXIT
ENDIF
lncolno = VAL(SUBSTR(RESOURCE.layout, (lnpos*4)-3,4))
lnpos = lnpos + 1
lnwidth = VAL(SUBSTR(RESOURCE.layout, (lnpos*4)-3,4))
THIS.COLUMNS[j].WIDTH = INT(lnwidth)
THIS.COLUMNS[j].COLUMNORDER = INT(lncolno)
NEXT
this.partition = VAL(SUBSTR(RESOURCE.layout, ((lnpos+1)*4)-3,4))
LOCAL cfilterexpr
cfilterexpr = IIF(LOWER(THISFORM.cworkalias) == LOWER(THIS.RECORDSOURCE), THISFORM.cfilterexpr, "")
IF EMPTY(cfilterexpr) AND (THISFORM.lrestoreidx)
LOCAL lckey, lcdescending, lcsortcolumns, llmultisort
lckey = RESOURCE.INDEX
IF "[" $ lckey
THIS.csortexpr = SUBSTR(lckey, 1, AT("[", lckey) -1)
THIS.csortcolumns = SUBSTR(lckey, AT("[", lckey) +1, ;
AT("]", lckey) - AT("[", lckey) -1)
llmultisort = AT(";", THIS.csortcolumns, 2) > 0
lckey = SUBSTR(lckey, 1, AT("[", lckey) -1)
ELSE
THIS.csortcolumns = ""
ENDIF
lcdescending = RESOURCE.DESCENDING
SELECT (THIS.RECORDSOURCE)
IF tagcount() != 0
SET ORDER TO 1
ENDIF
LOCAL makeidx, usecdxtag
makeidx = .T.
usecdxtag = ""
IF !llmultisort
FOR ncount = 1 TO 254
IF EMPTY( TAG(ncount) )
EXIT
ENDIF
IF ALLTRIM(UPPER(lckey)) == ALLTRIM(UPPER(KEY(ncount)))
makeidx = .F.
usecdxtag = TAG(ncount)
EXIT
ENDIF
ENDFOR
ENDIF
IF !EMPTY(lckey)
IF makeidx
WAIT WINDOW msg_make_index NOWAIT
usecdxtag = "X"+SUBSTR(SYS(2015),4,7)
LOCAL lnresettobuffermode
lnresettobuffermode = 0
IF INLIST(CURSORGETPROP("Buffering", ALIAS()) ,4,5)
lnresettobuffermode = CURSORGETPROP("buffering")
CURSORSETPROP("buffering", 3)
ENDIF
IF EMPTY(cfilterexpr)
INDEX ON &lckey TO (usecdxtag) ADDITIVE
ELSE
INDEX ON &lckey TO (usecdxtag) FOR &cfilterexpr ADDITIVE
ENDIF
IF lnresettobuffermode > 0
CURSORSETPROP("buffering", lnresettobuffermode)
ENDIF
THISFORM.oidxmanager.addtag(usecdxtag,ALIAS())
IF VARTYPE(goprogram)="O"
goprogram.nidxcount = goprogram.nidxcount + 1
ENDIF
WAIT CLEAR
ENDIF
IF lcdescending
SET ORDER TO TAG (usecdxtag) DESCENDING
ELSE
SET ORDER TO TAG (usecdxtag) ASCENDING
ENDIF
ENDIF
LOCATE
ENDIF
ENDIF
SELECT (this.recordsource)
THIS.onsetorder()
IF lcloseit
USE IN RESOURCE
ENDIF
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
IF lnrec > 0 AND lnrec<=RECCOUNT()
GOTO lnrec
ENDIF
* Called from a PickField ....
IF VARTYPE(THISFORM.opickfield)="O"
** Pick the selected value
LOCAL lcretval, lopickfield
lopickfield = THISFORM.opickfield
IF TYPE("loPickField._VFXClassName")="C" AND ;
lopickfield._vfxclassname == "CLookUp"
lopickfield.lupdated = .T.
lopickfield.VALID(EVAL(lopickfield.csearchexpr))
lopickfield.writebuffer()
lopickfield.onpick()
THISFORM.RELEASE()
RETURN .T.
ENDIF
lcretval = EVALUATE(lopickfield.creturnexpr) + ";"
LOCAL luvalue
IF UPPER(lopickfield.BASECLASS) = "CONTAINER"
IF EMPTY(lopickfield.creturnexprdesc)
lcretval = lcretval + ";"
ELSE
luvalue = EVALUATE(lopickfield.creturnexprdesc)
lcretval = lcretval + IIF(EMPTY(NVL(luvalue,"")), ";", luvalue + ";")
ENDIF
ELSE
lcretval = lcretval + ";"
ENDIF
IF EMPTY(lopickfield.creturnmoreexpr)
lcretval = lcretval
ELSE
luvalue = EVALUATE(lopickfield.creturnmoreexpr)
lcretval = lcretval + IIF(!EMPTY(NVL(luvalue,"")), luvalue, "")
ENDIF
IF !EMPTY(lcretval)
LOCAL lorec
SCATTER MEMO NAME lorec
lopickfield.opickrec = lorec
RELEASE lorec
lopickfield.setvalues(lcretval)
ENDIF
THISFORM.RELEASE()
RETURN .T.
ENDIF
IF THIS.lenteriseditmode
THISFORM.onedit()
ELSE
IF pemstatus(THISFORM,'pgfPageFrame',5)
IF THISFORM.npageedit > 0
THISFORM.pgfpageframe.PAGES(THISFORM.npageedit).SETFOCUS()
THISFORM.pgfpageframe.ACTIVEPAGE = THISFORM.npageedit
ELSE
THISFORM.pgfpageframe.page1.SETFOCUS()
THISFORM.pgfpageframe.ACTIVEPAGE = 1
ENDIF
ENDIF
THISFORM.REFRESH()
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CGrid_OnKeyEnter",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
LOCAL lcalias
lcalias = ALIAS()
IF THIS.lusespt
LOCAL lcsql, lctablename, lnsqlconnection
STORE "" TO lcsql, lctablename
lnsqlconnection = -1
IF VARTYPE(THISFORM)="O" AND ;
TYPE("goProgram.oConnMgr") = "O" AND !ISNULL(goprogram.oconnmgr) AND ;
(THIS.lsptsourcefromuser OR ;
INLIST(THIS.RECORDSOURCETYPE, 0, 1))
lctablename = THIS.RECORDSOURCE
IF THIS.lsptsourcefromuser OR ;
(INDBC(lctablename, 'VIEW') AND DBGETPROP(lctablename, "VIEW", "SOURCETYPE") = 2)
IF !EMPTY(NVL(lctablename,""))
lnsqlconnection = goprogram.oconnmgr.getconnection()
IF THIS.lsptsourcefromuser
lcsql = THIS.getsptsource()
ELSE
lcsql = DBGETPROP(lctablename, "VIEW", "SQL")
ENDIF
THIS.savestatus()
SELECT (THIS.RECORDSOURCE)
LOCAL lckey, lcfilter , lcidx, lldescending
lckey = KEY()
lcfilter = FILTER()
lcidx = ORDER()
lldescending = DESCENDING()
THIS.RECORDSOURCE = "xxx"
IF lnsqlconnection > 0
vfxsqlexec(lnsqlconnection, lcsql, lctablename)
ENDIF
IF USED(lctablename)
THIS.RECORDSOURCE = lctablename
IF !EMPTY(lckey)
IF EMPTY(lcfilter)
INDEX ON &lckey TO (lcidx) ADDITIVE
ELSE
INDEX ON &lckey TO (lcidx) FOR &lcfilter ADDITIVE
ENDIF
IF lldescending
SET ORDER TO TAG (lcidx) DESCENDING
ENDIF
ENDIF
THIS.restorestatus()
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
IF !EMPTY(lcalias) AND USED(lcalias)
SELECT (lcalias)
ENDIF
LPARAMETERS tocolumn, tlmultisort
IF TYPE("goProgram.nShowGridOrderType")#"N"
RETURN .T.
ENDIF
LOCAL lscreen, lni, locolumn
lscreen = THISFORM.LOCKSCREEN
IF !lscreen
THISFORM.LOCKSCREEN = .T.
ENDIF
IF goprogram.nshowgridordertype = 2 && Colors
IF THIS.ctitlecolor = -1
IF TYPE("this.Columns[1].Header1") = "O"
THIS.ctitlecolor = THIS.COLUMNS[1].header1.BACKCOLOR
ELSE
THIS.ctitlecolor = RGB(192,192,192)
ENDIF
ENDIF
IF !tlmultisort
THIS.SETALL('BackColor',THIS.ctitlecolor,'Header')
ENDIF
ELSE
THIS.SETALL('FontUnderline',.F.,'Header')
ENDIF
IF !tlmultisort
FOR lni = 1 TO THIS.COLUMNCOUNT
IF TYPE("this.columns[lni].header1") = "O" AND ;
CHR(160) $ THIS.COLUMNS[lni].header1.CAPTION
WITH THIS.COLUMNS[lni].header1
.CAPTION = SUBSTR(.CAPTION, 1, AT(CHR(160), .CAPTION) -1)
ENDWITH
ENDIF
NEXT lni
ENDIF
IF TYPE("toColumn")="O" OR tlmultisort
LOCAL llmorethanone, lccaption
llmorethanone = AT(";", THIS.csortcolumns, 2) > 0
DO CASE
CASE goprogram.nshowgridordertype = 1 && Header
IF tlmultisort
FOR lni = 1 TO THIS.COLUMNCOUNT
locolumn = "this." + getarg(THIS.csortcolumns, lni)
IF TYPE(locolumn) <> "O"
EXIT
ELSE
&locolumn..SETALL('FontUnderline',.T.,'Header')
IF llmorethanone AND TYPE("&locolumn..header1") = "O"
lccaption = &locolumn..header1.CAPTION
IF CHR(160) $ lccaption
lccaption = SUBSTR(lccaption, 1, AT(CHR(160), lccaption) -1)
ENDIF
&locolumn..header1.CAPTION = lccaption + CHR(160) + " (" + TRANSFORM(lni) + ")"
ENDIF
ENDIF
NEXT lni
ELSE
tocolumn.SETALL('FontUnderline',.T.,'Header')
ENDIF
CASE goprogram.nshowgridordertype = 2 && Colors
IF !EMPTY("goProgram.cAscOrderRGB")
THIS.cascorderrgb = goprogram.cascorderrgb
ENDIF
IF !EMPTY("goProgram.cDescOrderRGB")
THIS.cdescorderrgb = goprogram.cdescorderrgb
ENDIF
IF tlmultisort
FOR lni = 1 TO THIS.COLUMNCOUNT
locolumn = "this." + getarg(THIS.csortcolumns, lni)
IF TYPE(locolumn) <> "O"
EXIT
ELSE
IF DESCENDING()
&locolumn..SETALL('BackColor',EVAL(THIS.cdescorderrgb),'Header')
ELSE
&locolumn..SETALL('BackColor',EVAL(THIS.cascorderrgb),'Header')
ENDIF
IF llmorethanone AND TYPE("&locolumn..header1") = "O"
lccaption = &locolumn..header1.CAPTION
IF CHR(160) $ lccaption
lccaption = SUBSTR(lccaption, 1, AT(CHR(160), lccaption) -1)
ENDIF
&locolumn..header1.CAPTION = lccaption + CHR(160) + " (" + TRANSFORM(lni) + ")"
ENDIF
ENDIF
NEXT lni
ELSE
IF DESCENDING()
tocolumn.SETALL('BackColor',EVAL(THIS.cdescorderrgb),'Header')
ELSE
tocolumn.SETALL('BackColor',EVAL(THIS.cascorderrgb),'Header')
ENDIF
ENDIF
ENDCASE
ENDIF
THISFORM.LOCKSCREEN = lscreen
DIMENSION THIS.acolumns[this.ColumnCount]
LOCAL lccontrolname
FOR j = 1 TO THIS.COLUMNCOUNT
lccontrolname = THIS.COLUMNS[j].CURRENTCONTROL
IF EMPTY(THIS.COLUMNS[j].&lccontrolname..COMMENT) OR ;
UPPER(THIS.COLUMNS[j].&lccontrolname..COMMENT)="*CALCULATED FIELD"
THIS.acolumns[j] = THIS.COLUMNS[j].&lccontrolname..CONTROLSOURCE
ELSE
THIS.acolumns[j] = THIS.COLUMNS[j].&lccontrolname..COMMENT
ENDIF
NEXT
DIMENSION THIS.acolumns[this.ColumnCount]
FOR j = 1 TO THIS.COLUMNCOUNT
IF LEFT(THIS.acolumns[j],1)="*"
*!* It's a comment do nothing!
LOOP
ENDIF
IF LEFT(THIS.acolumns[j],1)="!"
*!* It´s a constant column !
THIS.COLUMNS[j].CONTROLSOURCE = SUBSTR(THIS.acolumns[j],2)
LOOP
ENDIF
IF EMPTY(CHRTRAN(THIS.acolumns[j],".*/+-",""))
THIS.COLUMNS[j].CONTROLSOURCE=THIS.RECORDSOURCE+"."+THIS.acolumns[j]
ELSE
THIS.COLUMNS[j].CONTROLSOURCE=THIS.acolumns[j]
ENDIF
THIS.COLUMNS[j].CONTROLSOURCE = THIS.acolumns[j]
NEXT
THIS.savestatus()
THIS.RECORDSOURCE = THIS.RECORDSOURCE
THIS.restorestatus()
IF pemstatus(THISFORM,'OnRecordMove',5) AND ;
LOWER(THIS.RECORDSOURCE) == LOWER(THISFORM.cworkalias)
THISFORM.onrecordmove()
IF LOWER(THISFORM._vfxclassname) == "conetomany"
THISFORM.pgfchildgrid.PAGES(THISFORM.pgfchildgrid.ACTIVEPAGE).REFRESH()
ENDIF
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CGrid_OnRecordMove",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
LPARAMETERS ncolindex
IF THIS.ncolumn <> THIS.ACTIVECOLUMN
SET MESSAGE TO THISFORM.CAPTION
THIS.csearchtext = ""
THIS.ncolumn = THIS.ACTIVECOLUMN
SET MESSAGE TO THISFORM.CAPTION
ENDIF
IF RECNO() <> THIS.nrecno
IF THIS.onrecordmove()
THIS.nrecno = IIF(EOF() OR DELETED(), 0, RECNO())
ELSE
NODEFAULT
ENDIF
ENDIF
IF THIS.lusespt
LOCAL lcsql, lctablename, lnsqlconnection
lctablename = ""
lnsqlconnection = -1
IF EMPTY(THIS.ctablename) OR ISNULL(THIS.ctablename)
DO WHILE .T.
THIS.ctablename = SYS(2015)
IF !USED(THIS.ctablename)
EXIT
ENDIF
ENDDO
ENDIF
IF VARTYPE(THISFORM)="O" AND ;
TYPE("goProgram.oConnMgr") = "O" AND !ISNULL(goprogram.oconnmgr) AND ;
(THIS.lsptsourcefromuser OR ;
INLIST(THIS.RECORDSOURCETYPE, 0, 1))
lctablename = THIS.ctablename
IF !USED(lctablename)
IF THIS.lsptsourcefromuser OR ;
(INDBC(lctablename, 'VIEW') AND DBGETPROP(lctablename, "VIEW", "SOURCETYPE") = 2)
IF !EMPTY(NVL(lctablename,""))
lnsqlconnection = goprogram.oconnmgr.getconnection()
IF lnsqlconnection > 0
IF THIS.lsptsourcefromuser
lcsql = THIS.getsptsource()
ELSE
lcsql = DBGETPROP(lctablename, "VIEW", "SQL")
ENDIF
IF !EMPTY(NVL(lcsql,""))
IF AT("?", lcsql) > 0
lcsql = clearsqlparameters(lcsql)
ENDIF
THIS.savestatus()
THIS.RECORDSOURCE = "xxx"
vfxsqlexec(lnsqlconnection, lcsql, lctablename)
IF USED(lctablename)
THIS.RECORDSOURCE = lctablename
THIS.restorestatus()
ENDIF
ENDIF
IF AT("?", lcsql) > 0 AND THIS.lrequeryoninit
THIS.REQUERY()
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
THIS.ctitlecolor = -1
THIS.csearchtext = ''
THIS.ncolumn = THIS.ACTIVECOLUMN
IF TYPE("goProgram.nEnterIsEditInGrid")="N"
IF goprogram.nenteriseditingrid > 0
THIS.lenteriseditmode = (goprogram.nenteriseditingrid = 1)
ENDIF
ENDIF
IF VARTYPE(_vfx_form_wizard)#"U"
THIS.extrabuffer = "_VFX_FORM_WIZARD"
ENDIF
IF VARTYPE(THISFORM)="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
SET MESSAGE TO THISFORM.CAPTION
THIS.csearchtext = ""
THIS.nrecno = IIF(EOF() OR DELETED(), 0, RECNO())
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CGrid_Valid",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
SET MESSAGE TO THISFORM.CAPTION
THIS.csearchtext = ""
IF THIS.lautosetup
IF THISFORM.lempty
RETURN .F.
ENDIF
THIS.nrecno = IIF(EOF() OR DELETED(), 0, RECNO())
IF EMPTY(THISFORM.lusesetkeyasfilter) AND THIS.lusesetkey
THIS.lusesetkey = .F.
ENDIF
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CGrid_When",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
IF VARTYPE(THIS.extrabuffer)="C" AND THIS.extrabuffer = "_VFX_FORM_WIZARD"
THIS.extrabuffer = .F.
ENDIF
IF THIS.lusespt AND !EMPTY(NVL(THIS.ctablename,"")) AND USED(THIS.ctablename)
USE IN (THIS.ctablename)
ENDIF
LPARAMETERS oDataObject, eFormat
LOCAL lcDatei, lnZ, lcFields, lcZ
lcDatei="X"+SUBSTR(SYS(2015),4,7)+".txt"
lcFields=""
WITH this
FOR lnZ=1 TO .columncount
IF "." $ .columns(m.lnZ).controlsource
lcZ=SUBSTR(.columns(m.lnZ).controlsource,AT(".",.columns(m.lnZ).controlsource))
ELSE
lcZ=.columns(m.lnZ).controlsource
ENDIF
IF !(LOWER(lcZ) $ LOWER(m.lcFields))
lcFields=m.lcFields+","+.columns(m.lnZ).controlsource
ENDIF
NEXT
ENDWITH
lcFields=SUBSTR(m.lcFields,2)
COPY TO (m.lcDatei) FIELDS &lcFields. DELIMITED WITH TAB
oDataObject.SetData(FILETOSTR(m.lcDatei))
DELETE FILE (m.lcDatei)
LPARAMETERS oDataObject, nEffect
oDataObject.ClearData()
nEffect=1
oDataObject.SetFormat(1)
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CHyperLink | |
| extrabuffer | .f. |
RELEASE THIS
| Name | Initial value |
|---|---|
| HelpContextID | 286 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CImage | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
THIS.VISIBLE = .F.
RELEASE THIS
LPARAMETERS nstyle
THIS.VISIBLE = .T.
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
| Name | Initial value |
|---|---|
| HelpContextID | 283 |
| _vfxclassname | CKeyField |
| lkeyfield | .T. |
| Name | Initial value |
|---|---|
| Alignment | 0 |
| AutoSize | .T. |
| BackStyle | 0 |
| Caption | "Label1" |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CLabel | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lusesyscolor | .T. |
RELEASE THIS
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
| Name | Initial value | Comment |
|---|---|---|
| _vfxclassname | CLine | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
RELEASE THIS
| Name | Initial value |
|---|---|
| Enabled | .T. |
| HelpContextID | 287 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CListBox | Internal use.Specifies the original VFX Class Name |
| cviewparameter | .f. | Specifies the name of the view argument which the control is bounded |
| extrabuffer | .f. | A user buffer |
| lautosetup | .T. | .T. if it's enabled when the form is in Insert or Edit mode |
| lnorefresh | .f. | Setting this property to .t. does prevent the control from beeing refreshed once. This is usefull, when a refresh of the form is issued and you want prevent the user from loosing what he currently was typing. |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lusesyscolor | .T. |
RELEASE THIS
DEFINE POPUP shortcut shortcut RELATIVE FROM MROW(),MCOL()
DEFINE BAR _MED_CUT OF shortcut PROMPT ttt_cmdcut
DEFINE BAR _MED_COPY OF shortcut PROMPT ttt_cmdcopy
DEFINE BAR _MED_PASTE OF shortcut PROMPT ttt_cmdpaste
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("RightClick",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ACTIVATE POPUP shortcut
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") = "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
THISFORM.nformstatus = 1
THIS.lnorefresh = .T.
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") != "U"
IF !THISFORM.lautoedit
THIS.ENABLED = .F.
ENDIF
ELSE
THIS.ENABLED = .F.
ENDIF
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ELSE
THIS.ENABLED = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
ELSE
THIS.ENABLED = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
IF THIS.ENABLED
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ENDIF
IF pemstatus(THISFORM, 'lEmpty',5)
IF THISFORM.lempty AND THISFORM.nformstatus != 2
THIS.ENABLED = .F.
ENDIF
ENDIF
ENDIF
IF THIS.lnorefresh
NODEFAULT
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
IF THIS.lnorefresh
THIS.lnorefresh = .F.
ENDIF
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | COleBoundControl | Internal use.Specifies the original VFX Class Name |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
RELEASE THIS
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
| Name | Initial value |
|---|---|
| BackStyle | 0 |
| ButtonCount | 2 |
| HelpContextID | 289 |
| Value | 1 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | COptionGroup | Internal use.Specifies the original VFX Class Name |
| cviewparameter | .f. | Specifies the name of the view argument which the control is bounded |
| extrabuffer | .f. | A user buffer |
| lautosetup | .T. | .T. if it's enabled when the form is in Insert or Edit mode |
| lnorefresh | .f. | Setting this property to .t. does prevent the control from beeing refreshed once. This is usefull, when a refresh of the form is issued and you want prevent the user from loosing what he currently was typing. |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lusesyscolor | .T. | Specifies if the system color will be used |
RELEASE THIS
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ELSE
THIS.ENABLED = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
ELSE
THIS.ENABLED = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
IF THIS.ENABLED
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ENDIF
ENDIF
IF THIS.lnorefresh
THIS.lnorefresh = .F.
NODEFAULT
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
LOCAL lcanedit
IF pemstatus(THISFORM,'lCanEdit',5)
lcanedit = THISFORM.lcanedit
ELSE
lcanedit = .T.
ENDIF
IF THIS.lautosetup
IF pemstatus(THISFORM, 'lEmpty',5)
IF THISFORM.lempty AND THISFORM.nformstatus != 2
RETURN .F.
ENDIF
ENDIF
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit AND lcanedit
RETURN .T.
ELSE
RETURN (THISFORM.nformstatus <> id_normal_mode)
ENDIF
ELSE
RETURN (THISFORM.nformstatus <> id_normal_mode)
ENDIF
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("When",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") == "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0
THISFORM.nformstatus = 1
THIS.lnorefresh = .T.
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
| Baseclass | Class | Object name |
|---|---|---|
| zzz | zzz | coptiongroup.Option1 |
| coptiongroup.Option2 |
| Name | Initial value |
|---|---|
| AutoSize | .T. |
| Caption | "Option1" |
| Value | 1 |
| Name | Initial value |
|---|---|
| AutoSize | .T. |
| Caption | "Option2" |
| Value | 0 |
| Name | Initial value |
|---|---|
| ErasePage | .T. |
| OLEDragMode | 1 |
| PageCount | 1 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| ^aneedrefresh[1,0] | .f. | |
| _vfxclassname | CPageFrame | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
| lautosetup | .T. | Specifies if the Object is auto-sync. |
| lproportionalfont | .f. | Specifies if the FontSize of the Pages are proportional |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lusegrid | .f. | .T. if this pageframe contain a grid object |
| lusesyscolor | .T. | Specifies if the system color will be used |
RELEASE THIS
LPARAMETERS tlrefresh
IF !THIS.lautosetup
RETURN .T.
ENDIF
LOCAL lscreenlock, loActivePage
lscreenlock = THISFORM.LOCKSCREEN
IF !lscreenlock
THISFORM.LOCKSCREEN = .T.
ENDIF
THIS.tabcolor()
IF THIS.PAGECOUNT > 0 AND THIS.ACTIVEPAGE > 0
IF tlrefresh
IF !pemstatus(THISFORM, 'nFormStatus', 5) OR ;
THISFORM.nformstatus = 0 OR ;
(THISFORM.nformstatus <> 0 AND THIS.aneedrefresh(THIS.ACTIVEPAGE))
loActivePage=getactivepage(this)
loActivePage.REFRESH()
ENDIF
ENDIF
THIS.aneedrefresh = .T.
THIS.aneedrefresh(THIS.ACTIVEPAGE) = .F.
ENDIF
THISFORM.LOCKSCREEN = lscreenlock
IF !THIS.lautosetup
RETURN .T.
ENDIF
LOCAL lscreenlock
lscreenlock = THISFORM.LOCKSCREEN
IF !lscreenlock
THISFORM.LOCKSCREEN = .T.
ENDIF
THIS.SETALL('ForeColor',RGB(0,0,0), 'Page')
IF THIS.PAGECOUNT > 0 AND THIS.ACTIVEPAGE > 0
loActivePage=getactivepage(this)
loActivePage.FORECOLOR = RGB(0,0,255)
ENDIF
THISFORM.LOCKSCREEN = lscreenlock
LPARAMETERS oDataObject, eFormat
oDataObject.SetData(collectoledata(this))
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Click",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
THIS.tabrefresh(.T.)
*!* Create an array to save the refresh status of all pages.
DIMENSION THIS.aneedrefresh[this.pagecount]
THIS.aneedrefresh = .T.
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
LPARAMETERS oDataObject, nEffect
oDataObject.ClearData()
nEffect=1
oDataObject.SetFormat(1)
| Baseclass | Class | Object name |
|---|---|---|
| zzz | zzz | cpageframe.Page1 |
| Name | Initial value |
|---|---|
| Caption | "Page1" |
| Name | Initial value |
|---|---|
| HelpContextID | 288 |
| Name | Initial value | Comment |
|---|---|---|
| ccontrolsourceinternalkey | .f. | Control source of the internal key. |
| ccontrolsourcetxtdesc | .f. | Control source of the description field. |
| ccontrolsourcetxtfield | .f. | Control source of the alternate key. |
| internalkeymaybenull | .f. | .T. if the internal key may be .null. |
| lnoreplace | .f. | Set to .t. if you want to avoid any replace statements since no data binding to a view or table |
| ninternalkey | .f. | The internal key value. |
DODEFAULT()
LOCAL lcinternalkey, lctxtfield, lctxtdesc
lcinternalkey = THIS.ccontrolsourceinternalkey
lctxtfield = THIS.ccontrolsourcetxtfield
lctxtdesc = THIS.ccontrolsourcetxtdesc
IF !EMPTY(NVL(THIS.txtfield.VALUE,"")) AND ;
!EMPTY(NVL(THIS.creturnmoreexprval,""))
IF !THIS.lnoreplace
REPLACE &lcinternalkey WITH VAL(THIS.creturnmoreexprval)
ELSE
THIS.ninternalkey = VAL(THIS.creturnmoreexprval)
ENDIF
ELSE
THIS.CLEAR()
ENDIF
IF !DODEFAULT()
RETURN .F.
ENDIF
LOCAL lccontrolsourcetxtfield, lccontrolsourcetxtdesc
lccontrolsourcetxtfield = THIS.ccontrolsourcetxtfield
lccontrolsourcetxtdesc = THIS.ccontrolsourcetxtdesc
IF VARTYPE(lccontrolsourcetxtfield) <> "C"
lccontrolsourcetxtfield = ""
ENDIF
IF VARTYPE(lccontrolsourcetxtdesc) <> "C"
lccontrolsourcetxtdesc = ""
ENDIF
THIS.txtfield.CONTROLSOURCE = lccontrolsourcetxtfield
THIS.txtdesc.CONTROLSOURCE = lccontrolsourcetxtdesc
LOCAL lcinternalkey, lctxtfield, lctxtdesc
lcinternalkey = THIS.ccontrolsourceinternalkey
lctxtfield = THIS.ccontrolsourcetxtfield
lctxtdesc = THIS.ccontrolsourcetxtdesc
IF THIS.internalkeymaybenull
IF !THIS.lnoreplace
REPLACE &lcinternalkey WITH .NULL.
THIS.ninternalkey = .NULL.
ELSE
THIS.ninternalkey = 0
ENDIF
ELSE
IF !THIS.lnoreplace
REPLACE &lcinternalkey WITH 0
ENDIF
THIS.ninternalkey = 0
ENDIF
IF !THIS.lnoreplace
REPLACE &lctxtfield WITH .NULL.
REPLACE &lctxtdesc WITH .NULL.
ENDIF
THIS.txtfield.VALUE = ""
THIS.txtdesc.VALUE = ""
DO CASE
CASE TYPE(THIS.creturnmoreexpr) = "C"
THIS.creturnmoreexprval = ''
CASE TYPE(THIS.creturnmoreexpr) = "D"
THIS.creturnmoreexprval = CTOD('')
CASE TYPE(THIS.creturnmoreexpr) = "T"
THIS.creturnmoreexprval = CTOT('')
CASE TYPE(THIS.creturnmoreexpr) = "L"
THIS.creturnmoreexprval = .F.
OTHERWISE
THIS.creturnmoreexprval = 0
ENDCASE
THIS.opickrec = .NULL.
| Baseclass | Class | Object name |
|---|---|---|
| zzz | zzz | cpickalternate.cmdPick |
| cpickalternate.txtDesc | ||
| cpickalternate.txtField |
*
*
| Name | Initial value |
|---|---|
| HelpContextID | 290 |
| Name | Initial value | Comment |
|---|---|---|
| ccontrolsourcefield | .f. | Controlsource of the alternate field |
| ccontrolsourceinternalkey | .f. | Controlsource of the internal (effective) key |
| internalkeymaybenull | .f. | Set .t. if the internal key can be null |
| lnoreplace | .f. | Set to .t. if you want to avoid any replace statements since no data binding to a view or table |
| ninternalkey | .f. | The internal key value. |
DODEFAULT()
LOCAL lcinternalkey, lctxtfield
lcinternalkey = THIS.ccontrolsourceinternalkey
lctxtfield = THIS.ccontrolsourcefield
IF !EMPTY(NVL(THIS.VALUE,"")) AND ;
!EMPTY(NVL(THIS.creturnmoreexprval,""))
IF !THIS.lnoreplace
REPLACE &lcinternalkey. WITH VAL(THIS.creturnmoreexprval)
ELSE
THIS.ninternalkey = VAL(THIS.creturnmoreexprval)
ENDIF
ELSE
THIS.CLEAR()
ENDIF
IF !DODEFAULT()
RETURN .F.
ENDIF
LOCAL lccontrolsourcefield
lccontrolsourcefield = THIS.ccontrolsourcefield
IF VARTYPE(lcControlSourceField) <> "C"
lccontrolsourcefield = ""
ENDIF
IF EMPTY(lccontrolsourcefield)
WAIT WINDOW "CPickAlterTextBox Error" + CHR(13)+;
"the property
RETURN .F.
ENDIF
IF LOWER(THIS.PARENT.PARENT.BASECLASS) == "grid"
IF LOWER(THIS.PARENT.CONTROLSOURCE) <> IIF(EMPTY(NVL(lccontrolsourcefield, "")), "???", LOWER(lccontrolsourcefield))
WAIT WINDOW "CPickAlterTextBox Error" + CHR(13)+;
"column control source: " + ALLTRIM(THIS.PARENT.CONTROLSOURCE) + CHR(13) + ;
"text contorl source: " + lccontrolsourcefield + CHR(13) + ;
"both control source must be equal."
RETURN .F.
ENDIF
ENDIF
THIS.CONTROLSOURCE = lccontrolsourcefield
LOCAL lcinternalkey, lctxtfield
lcinternalkey = THIS.ccontrolsourceinternalkey
lctxtfield = THIS.ccontrolsourcefield
IF THIS.internalkeymaybenull
IF !THIS.lnoreplace
REPLACE &lcinternalkey. WITH .NULL.
THIS.ninternalkey = .NULL.
ELSE
THIS.ninternalkey = 0
ENDIF
ELSE
IF !THIS.lnoreplace
REPLACE &lcinternalkey. WITH 0
ENDIF
THIS.ninternalkey = 0
ENDIF
IF !THIS.lnoreplace
REPLACE &lctxtfield. WITH .NULL.
ENDIF
THIS.VALUE = ""
| Name | Initial value |
|---|---|
| BorderWidth | 0 |
| HelpContextID | 292 |
| _vfxclassname | CPickField |
| lautosetup | .T. |
| Name | Initial value | Comment |
|---|---|---|
| _lfromvalid | .f. | |
| _lnoreplace | .F. | |
| ccontrolbuffer | Stores the current controlsource. |
|
| cdataform | Name of the form to be launched when user selects with the right mouse or from within pick dialog to start maintenance form. | |
| cfieldlist | Field list separated with ; for all fields to be displayed in the pickfield | |
| cfieldtitle | Specifies the Caption for the Fields defined using cfieldlist | |
| cfilterexpr | User filter expression for the pickdialog. ATTENTION: Just a filter, all data are fetched anyhow. | |
| cfixfieldname | Now, when calling the maintenance form from a pickfield, the property cFixFieldName and cFixFieldValue are available on the originating pickfield object and can be referenced from the init of the called form. | |
| cfixfieldvalue | Now, when calling the maintenance form from a pickfield, the property cFixFieldName and cFixFieldValue are available on the originating pickfield object and can be referenced from the init of the called form. | |
| cindexexpr | Used to sort the list in the pickdialog | |
| coldkey | .f. | Old key. |
| cpickcaption | Caption for the pick dialog. | |
| cpickcursor | Temporary cursor. | |
| cpickform | VFXPICK | Name of the pickdialog form |
| creturnexpr | Main return expression. Must be cast to char type! | |
| creturnexprdesc | Return expression for the description. | |
| creturnmoreexpr | More return expressions. Must be cast to char type! | |
| creturnmoreexprval | Value of the returnmoreexpr | |
| cseekvalue | .f. | Value to search into pick dialog. Load in onprequery() |
| csqlvalid | SQL Valid statement for SQL Validation. | |
| ctablename | Name of the table or view to be uesed to prick from. | |
| ctagname | Default tagname to be used (order) | |
| ctagnamejump | .f. | Tagname used for Maintenance form when accessing through rightmouse click from txtdesc or from pickdialog's icon bar. |
| cupdsourcefields | .f. | When the cpickfield class is used in a C/S environment, quite often there is the need to replace specific fields after pick. Use this property to define from which fields the values come from to update the fields specified in |
| cupdtargetfields | .f. | |
| cupdtargetfields | .f. | When the cpickfield class is used in a C/S environment, quite often there is the need to replace specific fields after picking. Use this property to define which fields have to be updated using the fields specified in cupdsourcefields |
| cupdtargettable | .f. | Optional alias of the target fields specified in cupdtargetfields (only needed if not specified in cupdtargetfields) |
| cviewparameter | .f. | Specifies the name of the view argument which the control is bounded |
| cviewvalid | Viewname wich we can use to vilidate the Value of txtField. | |
| l3ddesc | .T. | Use 3d effects. |
| lautopick | .f. | Specifies if the PickDialog will be called automatically when a wrong code is entered. |
| lautoresize | .f. | .t. if the control autoresizes itself |
| ldescitalicfont | .f. | Specifies if the description should use ITALIC Font |
| ldovalid | .f. | .t. if it's necessary to call txtfield.valid |
| lfixfield | .f. | Specifies if this is a Fix Field and therefore disabled in a parent child scenario (foreign key field) |
| lhidecode | .f. | Specifies if the txtField should be hidden. Just code and oick command button displayed. |
| lkeyfield | .f. | .t. if it's a key field (editable only in insert mode) |
| llpickon | .f. | Used to define whether pick is currently used. |
| lnopickdialog | .f. | Set this property to .t. if you want to use the maintenance form directly rather than the normal pick dialog to pick a value. |
| lnullvalid | .f. | .t. if it's possible to have txtfield empty |
| lreleasemformonclose | .f. | Defines whether the referenced maintenance form will be closed when the pickfield goes out of scope. |
| lrightclickchange | .f. | |
| lrightclickon | .f. | |
| lrunform | .f. | This property set to .t. defines that the maintenance form will be used as instead of the pickdialog. |
| luserpreparepickdata | .f. | .T. if user prepares pick data. |
| luserrefresh | .f. | .T. if you uses onrefresh method |
| lusespt | .f. | This property defines whether SQL Pass Through (short: SPT) will be used to speedup operation and reduce the dataenvironment and connection overhead. |
| lusetab | .f. | Specifies if after picking a value the next field will have the focus |
| lworkonview | .f. | .T. if works with views |
| nvalidmode | 0 | Validmode for txtField. When the value is 0 indicates that property cSqlValid is used to validate the value of txtField else property cViewValid is used to validate the value of txtField. |
| olinkform | .NULL. | |
| opickrec | .NULL. | Object Reference holding the result of the "scatter name oPickRec" from the picked record. This replaces the creturnmoreexpr property. |
| readonly | .f. | Specifies if this field is read only |
| which | .f. | values. |
RETURN THIS.txtfield.VALUE
RETURN THIS.txtdesc.VALUE
THIS.REQUERY(.T.)
RETURN THIS.creturnmoreexprval
LPARAMETERS tlvalid
LOCAL lok
lok = .F.
IF THIS.onprequery()
LOCAL ccommand, lctable, lccursor, lctag, lcindexexpr, ;
lnworkarea, lnrecno, lcseek
lok = .T.
lcindexexpr = ""
lnworkarea = SELECT()
lctable = THIS.ctablename
lctag = THIS.ctagname
lccursor = "X"+SUBSTR(SYS(2015),4,7)
THIS.opickrec = .NULL.
IF THIS.lworkonview AND tlvalid
DO CASE
CASE THIS.nvalidmode = 0
lok = THIS.dosqlvalid(lccursor)
CASE THIS.nvalidmode = 1
lok = THIS.doviewvalid(lccursor)
CASE THIS.nvalidmode = 2
lok = THIS.douservalid(lccursor)
ENDCASE
ELSE
IF EMPTY(lctag)
USE (lctable) IN 0 ALIAS (lccursor) SHARED AGAIN
SELECT (lccursor)
IF !EMPTY(THIS.cfilterexpr)
LOCAL lcfilterexpr
lcfilterexpr = THIS.cfilterexpr
SET FILTER TO &lcfilterexpr
ENDIF
IF !EMPTY(THIS.cindexexpr)
lcindexexpr = THIS.cindexexpr
INDEX ON &lcindexexpr TAG (lccursor)
ENDIF
ELSE
USE (lctable) IN 0 ALIAS (lccursor) ORDER TAG (lctag) SHARED AGAIN
SELECT (lccursor)
IF !EMPTY(THIS.cfilterexpr)
LOCAL lcfilterexpr
lcfilterexpr = THIS.cfilterexpr
SET FILTER TO &lcfilterexpr
ENDIF
lcindexexpr = KEY()
ENDIF
IF EMPTY(THIS.cseekvalue)
lcseek = THIS.txtfield.VALUE
ELSE
lcseek = THIS.cseekvalue
ENDIF
IF CURSORGETPROP('SourceType',lccursor) != 3
=REQUERY(lccursor)
ENDIF
IF !EMPTY(lcindexexpr)
IF !EMPTY(lcseek)
IF "UPPER" $ lcindexexpr
lok =SEEK(UPPER(lcseek), lccursor)
ELSE
lok =SEEK(lcseek, lccursor)
ENDIF
ENDIF
ENDIF
ENDIF
SELECT (lccursor)
LOCAL lorec
SCATTER MEMO NAME lorec BLANK
THIS.opickrec = lorec
IF !lok
IF !EMPTY(THIS.creturnexprdesc)
THIS.txtdesc.VALUE = ""
ENDIF
IF !EMPTY(THIS.creturnmoreexpr)
THIS.creturnmoreexprval = ""
ENDIF
ELSE
SCATTER MEMO NAME lorec
THIS.opickrec = lorec
IF !EMPTY(THIS.creturnexprdesc)
THIS.txtdesc.VALUE = EVALUATE(THIS.creturnexprdesc)
IF THIS.lworkonview AND !EMPTY(THIS.ccontrolbuffer)
THIS.replacedescinview()
ENDIF
ENDIF
IF !EMPTY(THIS.creturnmoreexpr)
THIS.creturnmoreexprval = EVALUATE(THIS.creturnmoreexpr)
ENDIF
IF converttochar(THIS.coldkey) != converttochar(THIS.txtfield.VALUE)
IF pemstatus(THISFORM, "nformstatus", 5)
IF THISFORM.nformstatus <> 0
THIS.updatetargetfields()
ENDIF
ELSE
THIS.updatetargetfields()
ENDIF
ENDIF
ENDIF
RELEASE lorec
IF USED(lccursor)
SELECT (lccursor)
ENDIF
THIS.onpostquery()
THIS.onpick()
CLOSE INDEX
IF USED(lccursor)
USE IN (lccursor)
ENDIF
SELECT (lnworkarea)
ENDIF
RETURN lok
LPARAMETERS tvalue, tlforcevalid, tlnointeractive
WITH THIS.txtfield
IF !tlnointeractive
.INTERACTIVECHANGE()
ENDIF
THIS.coldkey = .VALUE
.VALUE = tvalue
ENDWITH
IF tlforcevalid
THIS.ldovalid = .T.
THIS.coldkey = .NULL.
ENDIF
THIS._lfromvalid = .T.
THIS.LOSTFOCUS()
THIS._lfromvalid = .F.
LPARAMETERS tvalue
THIS.txtdesc.VALUE = tvalue
LPARAMETERS tlvalid
LOCAL lok, lvalid
IF EMPTY(NVL(THIS.txtfield.VALUE,"")) AND THIS.lnullvalid
WITH THIS
.CLEAR()
IF THIS.lworkonview AND !EMPTY(THIS.ccontrolbuffer)
.replacedescinview()
ENDIF
ENDWITH
THIS.onpick()
RETURN .T.
ENDIF
IF THIS.lautosetup
IF THISFORM.nformstatus = 0
lok = .T.
lvalid = .F.
ENDIF
ENDIF
lok = !(EMPTY(NVL(THIS.txtfield.VALUE,"")) AND !THIS.lnullvalid)
lvalid = THIS.ldovalid OR tlvalid OR !lok
IF lvalid
LOCAL lcalias, lcseekvalue, lcoldseekvalue
lcseekvalue = THIS.txtfield.VALUE
lcalias = ALIAS()
IF lok
lok = THIS.REQUERY(.T.)
ENDIF
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
IF !lok
IF THIS.lautopick OR (MESSAGEBOX(msg_ask_for_pick,mb_yesno+mb_iconquestion+mb_defbutton1,msg_attention) = idyes)
lcoldseekvalue = THIS.cseekvalue
THIS.cseekvalue = lcseekvalue
THIS.CLEAR()
PUBLIC __vfx_fromvalid
__vfx_fromvalid = .T.
THIS.cmdpick.CLICK()
__vfx_fromvalid = .F.
RELEASE __vfx_fromvalid
THIS.cseekvalue = lcoldseekvalue
lok = !(EMPTY(NVL(THIS.txtfield.VALUE,"")) AND !THIS.lnullvalid)
IF !lok
THIS.CLEAR()
IF !THIS._lfromvalid
THIS.txtfield.SETFOCUS()
THIS._lfromvalid = .F.
ENDIF
ENDIF
ELSE
THIS.CLEAR()
IF !THIS._lfromvalid
THIS.txtfield.SETFOCUS()
THIS._lfromvalid = .F.
ENDIF
ENDIF
ENDIF
ENDIF
RETURN lok
IF !EMPTY(THIS.txtfield.CONTROLSOURCE)
DO CASE
CASE VARTYPE(THIS.txtfield.CONTROLSOURCE) = "C"
THIS.txtfield.VALUE = ''
CASE VARTYPE(THIS.txtfield.CONTROLSOURCE) = "D"
THIS.txtfield.VALUE = CTOD('')
CASE VARTYPE(THIS.txtfield.CONTROLSOURCE) = "T"
THIS.txtfield.VALUE = CTOT('')
CASE VARTYPE(THIS.txtfield.CONTROLSOURCE) $ "NY"
THIS.txtfield.VALUE = 0
OTHERWISE
THIS.txtfield.VALUE = .NULL.
ENDCASE
ELSE
DO CASE
CASE VARTYPE("this.txtField.value") = "C"
THIS.txtfield.VALUE = ''
CASE VARTYPE("this.txtField.value") = "D"
THIS.txtfield.VALUE = CTOD('')
CASE VARTYPE("this.txtField.value") = "T"
THIS.txtfield.VALUE = CTOT('')
CASE VARTYPE("this.txtField.value") $ "NY"
THIS.txtfield.VALUE = 0
OTHERWISE
THIS.txtfield.VALUE = .NULL.
ENDCASE
ENDIF
THIS.txtdesc.VALUE = ''
DO CASE
CASE VARTYPE(THIS.creturnmoreexpr) = "C"
THIS.creturnmoreexprval = ''
CASE VARTYPE(THIS.creturnmoreexpr) = "D"
THIS.creturnmoreexprval = CTOD('')
CASE VARTYPE(THIS.creturnmoreexpr) = "T"
THIS.creturnmoreexprval = CTOT('')
CASE VARTYPE(THIS.creturnmoreexpr) = "L"
THIS.creturnmoreexprval = .F.
CASE VARTYPE(THIS.creturnmoreexpr) $ "NY"
THIS.creturnmoreexprval = 0
OTHERWISE
THIS.creturnmoreexprval = .NULL.
ENDCASE
THIS.opickrec = .NULL.
THIS._lnoreplace = .T.
THIS.REFRESH()
LPARAMETERS tccursor
LOCAL lcsql, lok, lcparameters, lcviewvalid, lctemp, lcretexpr, lnsqlconnection
lok = .T.
lctable = THIS.ctablename
lctemp = ""
lcretexpr = ""
lcviewvalid = IIF(EMPTY(tccursor), THIS.cviewvalid, tccursor)
lnsqlconnection = 0
lcsql = ""
IF !USED(lcviewvalid)
IF THIS.lusespt AND ;
TYPE("goProgram.oConnMgr") = "O" AND !ISNULL(goprogram.oconnmgr) AND ;
INDBC(THIS.cviewvalid,"VIEW") AND ;
DBGETPROP(THIS.cviewvalid, "VIEW", "SOURCETYPE") = 2
lnsqlconnection = goprogram.oconnmgr.getconnection()
IF lnsqlconnection > 0
lcsql = DBGETPROP(THIS.cviewvalid, "VIEW", "SQL")
ELSE
USE (THIS.cviewvalid) IN 0 ALIAS (lcviewvalid) AGAIN NODATA
ENDIF
ELSE
USE (THIS.cviewvalid) IN 0 ALIAS (lcviewvalid) AGAIN NODATA
ENDIF
ENDIF
IF EMPTY(lcsql)
SELECT(lcviewvalid)
lcparameters = ALLTRIM(DBGETPROP(THIS.cviewvalid, 'view', 'SQL'))
ELSE
lcparameters = ALLTRIM(lcsql)
ENDIF
IF !EMPTY(lcparameters)
LOCAL lnargcount, lnsymbolcount, lcsymbol, lcvalue, lasymtable[1], lctext, k
LOCAL lasymtable
lnargcount = OCCURS('?',lcparameters)
lnsymbolcount = 0
IF lnargcount > 0
LOCAL lnpos, llassingvalue
llassingvalue = .T.
** take only the first parameter by default
lnargcount = 1
FOR lnpos=1 TO lnargcount
lcsymbol = SUBSTR(lcparameters,AT('?',lcparameters,lnpos)+1)
lctext = ''
FOR k = 1 TO LEN(lcsymbol)
IF LOWER(SUBSTR(lcsymbol,k,1)) $ "abcdefghijklmnopqrstuvwxyz0123456789_"
lctext = lctext + SUBSTR(lcsymbol,k,1)
ELSE
EXIT
ENDIF
NEXT
IF !EMPTY(lctext)
lcsymbol = lctext
lnsymbolcount = lnsymbolcount + 1
DIMENSION lasymtable[lnSymbolCount]
lasymtable[lnSymbolCount] = lcsymbol
IF TYPE(lcsymbol) == "U"
PUBLIC (lcsymbol)
llassingvalue = .T.
ELSE
llassingvalue = .F.
ENDIF
DO CASE
CASE lnpos = 1
&lcsymbol. = THIS.txtfield.VALUE
ENDCASE
ENDIF
NEXT
IF THIS.lusespt AND lnsqlconnection > 0
vfxsqlexec(lnsqlconnection, lcsql, lcviewvalid)
ELSE
REQUERY(lcviewvalid)
ENDIF
k = 0
SELECT (lcviewvalid)
k = RECCOUNT()
lok = k > 0
FOR k = 1 TO lnsymbolcount
lcsymbol = lasymtable[k]
RELEASE (lcsymbol)
NEXT
ELSE
lok = .F.
ENDIF
ELSE
lok = .F.
ENDIF
RETURN lok
LPARAMETERS tccursor
LOCAL lok, lccursor, lcsqlvalid, lcfilterexpr
lok = .T.
lctable = THIS.ctablename
lccursor = tccursor
lcsqlvalid = THIS.csqlvalid + " into cursor " + lccursor + " noconsole"
&lcsqlvalid
SELECT (lccursor)
lok = _TALLY > 0
IF !EMPTY(THIS.cfilterexpr)
LOCAL lcfilterexpr
lcfilterexpr = THIS.cfilterexpr
SET FILTER TO &lcfilterexpr
LOCATE
lok = FOUND()
ENDIF
LOCATE
RETURN lok
LPARAMETERS tcproperty
LOCAL loobj, luretval
loobj = THIS.opickrec
luretval = .NULL.
IF !(TYPE("loObj") == "O") OR ISNULL(loobj)
RETURN .NULL.
ENDIF
tcproperty = IIF(TYPE("tcProperty") <> "C", .NULL., tcproperty)
IF EMPTY(NVL(tcproperty,""))
RETURN .NULL.
ENDIF
IF pemstatus(loobj, tcproperty, 5)
luretval = loobj.&tcproperty
ENDIF
RETURN luretval
LOCAL lni, lcfield, lxfieldvalue, lcworkalias, lccurralias, ;
lcsfieldlist, lctfieldlist, lcsourcefield, lctargetfield
lni = 1
IF EMPTY(NVL(THIS.cupdtargettable,""))
IF pemstatus(THISFORM, "cworkalias", 5)
lcworkalias = THISFORM.cworkalias
ELSE
lcworkalias = ALIAS()
ENDIF
ELSE
lcworkalias = THIS.cupdtargettable
ENDIF
lcsfieldlist = IIF(EMPTY(NVL(THIS.cupdsourcefields,"")), "", UPPER(THIS.cupdsourcefields))
lctfieldlist = IIF(EMPTY(NVL(THIS.cupdtargetfields,"")), "", UPPER(THIS.cupdtargetfields))
lccurralias = ""
lnsourcefields = IIF(EMPTY(lcsfieldlist), 0, getargcount(lcsfieldlist))
lntargetfields = IIF(EMPTY(lctfieldlist), 0, getargcount(lctfieldlist))
FOR lni = 1 TO lnsourcefields
lcsourcefield = getarg(lcsfieldlist, lni)
lctargetfield = getarg(lctfieldlist, lni)
IF EMPTY(NVL(lctargetfield,"")) OR EMPTY(NVL(lcsourcefield,""))
LOOP
ENDIF
lccurralias = IIF(AT(".", lctargetfield) = 0, lcworkalias, ;
LEFT(lctargetfield, AT(".", lctargetfield)-1))
lxfieldvalue = THIS.getmorevalues(lcsourcefield)
IF !ISNULL(lxfieldvalue)
IF THIS.isfield(lctargetfield, lccurralias)
IF !EMPTY(lccurralias)
REPLACE &lctargetfield WITH lxfieldvalue IN (lccurralias)
ELSE
REPLACE &lctargetfield WITH lxfieldvalue
ENDIF
ELSE
&lctargetfield. = lxfieldvalue
ENDIF
ENDIF
ENDFOR
LPARAMETERS tcfield, tcalias
LOCAL llx, lcerror, lcfield, lcworktable
lcerror = ON("error")
llx = .F.
lcworktable = IIF(EMPTY(NVL(tcalias,"")), ALIAS(), tcalias)
lcfield = IIF(AT(".", tcfield) <> 0, ;
tcfield, ;
lcworktable + "." + tcfield)
ON ERROR llx = .T.
** check to see whether it's a field, if not -> error -> llx = .T.
IF THIS.lworkonview
DBGETPROP(lcfield, "field", "datatype")
ELSE
DBGETPROP(lcfield, "field", "caption")
ENDIF
ON ERROR &lcerror
RETURN !llx
LPARAMETERS tcretval
IF THIS.llpickon AND THIS.lrightclickon AND !THIS.lrightclickchange
RETURN
ENDIF
LOCAL lcfieldvalue, lcreturnexprdesc, lcreturnmoreexprval, llcanedit
lcfieldvalue = getarg(tcretval, 1)
lcreturnexprdesc = getarg(tcretval, 2)
lcreturnmoreexprval = getarg(tcretval, 3)
llcanedit = .T.
LOCAL lufieldvalue
DO CASE
CASE TYPE(THIS.txtfield.CONTROLSOURCE) $ "NIBFY"
lufieldvalue = VAL(lcfieldvalue)
CASE TYPE(THIS.txtfield.CONTROLSOURCE) = "D"
lufieldvalue = CTOD(lcfieldvalue)
CASE TYPE(THIS.txtfield.CONTROLSOURCE) = "T"
lufieldvalue = CTOT(lcfieldvalue)
CASE TYPE(THIS.txtfield.CONTROLSOURCE) = "L"
lufieldvalue = (UPPER(lcfieldvalue) = "T")
OTHERWISE
lufieldvalue = lcfieldvalue
ENDCASE
IF converttochar(THIS.coldkey) = converttochar(lufieldvalue) AND ;
converttochar(THIS.txtfield.VALUE) = converttochar(lufieldvalue)
RETURN
ENDIF
IF pemstatus(THISFORM,"lAutoEdit",5)
IF THIS.lautosetup AND THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
llcanedit = THISFORM.onedit()
ENDIF
ENDIF
IF llcanedit
THIS.txtfield.VALUE = lufieldvalue
THIS.coldkey = .NULL.
IF EMPTY(lcreturnexprdesc)
THIS.txtdesc.VALUE = ""
ELSE
THIS.txtdesc.VALUE = IIF(EMPTY(NVL(lcreturnexprdesc, "")), "", lcreturnexprdesc)
ENDIF
IF EMPTY(lcreturnmoreexprval)
THIS.creturnmoreexprval = ""
ELSE
THIS.creturnmoreexprval = IIF(EMPTY(NVL(lcreturnmoreexprval,"")), "", lcreturnmoreexprval)
ENDIF
ENDIF
THIS.onpostquery()
IF llcanedit
THIS.onpick()
ENDIF
THIS.ldovalid = .F.
THIS.lrunform = .F.
IF THIS.luserrefresh
THIS.onrefresh()
ENDIF
IF !EMPTY(THIS.ccontrolbuffer)
LOCAL llisfield, lcworktable
llisfield = .F.
IF pemstatus(THISFORM, "cworkalias", 5)
lcworktable = IIF(EMPTY(NVL(THISFORM.cworkalias,"")), ALIAS(), THISFORM.cworkalias)
ELSE
lcworktable = ALIAS()
ENDIF
llisfield = THIS.isfield(SUBSTR(THIS.ccontrolbuffer, AT(".", THIS.ccontrolbuffer)+1), ;
SUBSTR(THIS.ccontrolbuffer, 1, AT(".", THIS.ccontrolbuffer)-1))
IF llisfield AND converttochar(THIS.coldkey) != converttochar(THIS.txtfield.VALUE)
** update the view!
REPLACE (THIS.ccontrolbuffer) WITH THIS.txtdesc.VALUE IN (lcworktable)
ENDIF
ENDIF
LPARAMETERS tccursorname
*!* * Sample Code
*!* local lcSQL
*!* lcSQL = "
*!* local lnSQLConnection
*!* lnSQLConnection = goProgram.oConnMgr.getConnection()
*!* if (lnSQLConnection > 0)
*!* if vfxSQLExec(lnSQLConnection, lcSQL, tcCursorName) != 1
*!* messagebox("
*!* endif
*!* else
*!* messagebox(MSG_UNABLE_TO_GET_CONNECTION)
*!* endif
LPARAMETERS tccursorname
LOCAL loform
loform = THIS.olinkform
IF VARTYPE(loForm) = "O"
IF pemstatus(loform, "opickfield", 5)
loform.opickfield = .NULL.
ENDIF
loform.RELEASE()
loform = .NULL.
ENDIF
THIS.olinkform = .NULL.
RETURN DODEFAULT()
IF THIS.lrunform
THIS.lrunform = .F.
IF TYPE("this.oLinkForm")=="O" AND !ISNULL(THIS.olinkform)
THIS.olinkform.SHOW()
ENDIF
RETURN .T.
ENDIF
IF !THIS.llpickon
THIS.coldkey = THIS.txtfield.VALUE
ELSE
LOCAL llcanedit
llcanedit = .T.
THIS.lrightclickon = .F.
THIS._lnoreplace = .T.
IF converttochar(THIS.coldkey) != converttochar(THIS.txtfield.VALUE)
IF pemstatus(THISFORM,"lAutoEdit",5)
IF THIS.lautosetup AND THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
llcanedit = THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF llcanedit AND THIS.lworkonview AND !EMPTY(THIS.ccontrolbuffer)
THIS.replacedescinview()
ENDIF
IF llcanedit AND converttochar(THIS.coldkey) != converttochar(THIS.txtfield.VALUE)
IF pemstatus(THISFORM, "nformstatus", 5)
IF THISFORM.nformstatus <> 0
THIS.updatetargetfields()
THIS.coldkey = THIS.txtfield.VALUE
ENDIF
ELSE
THIS.updatetargetfields()
THIS.coldkey = THIS.txtfield.VALUE
ENDIF
ENDIF
THIS._lnoreplace = .T.
THIS.REFRESH()
THIS.olinkform = .NULL.
THIS.llpickon = .F.
THIS.txtfield.SETFOCUS()
ENDIF
DODEFAULT()
IF !THIS.llpickon
IF !THIS.lfixfield AND ;
( (EMPTY(NVL(THIS.txtfield.VALUE,"")) AND !THIS.lnullvalid) OR ;
(THIS.ldovalid AND ;
converttochar(THIS.coldkey)!=converttochar(THIS.txtfield.VALUE)) )
IF THIS.VALID(THIS.ldovalid)
THIS._lnoreplace = .T.
THIS.REFRESH()
ELSE
RETURN (.F.)
ENDIF
ENDIF
ENDIF
IF THIS.lrunform
THIS.txtfield.SETFOCUS()
ENDIF
DODEFAULT()
THIS.cmdpick.TOOLTIPTEXT = ttt_cmdpick
THIS.txtfield.TOOLTIPTEXT = ttt_pickeditmode
THIS.cmdpick.extrabuffer = THIS.cmdpick.TOOLTIPTEXT
THIS.txtfield.extrabuffer = THIS.txtfield.TOOLTIPTEXT
THIS.llpickon = .F.
THIS.ldovalid = .F.
THIS.creturnmoreexprval = ""
THIS.ccontrolbuffer = THIS.txtdesc.CONTROLSOURCE
THIS.txtdesc.ENABLED = .T.
THIS.txtdesc.CONTROLSOURCE = ""
THIS.txtfield.lautosetup = .F.
THIS.txtdesc.INPUTMASK = ''
THIS.txtdesc.FORMAT = ''
THIS.txtfield.READONLY = THIS.READONLY
IF THIS.luserrefresh
THIS.ccontrolbuffer = ''
THIS.txtdesc.CONTROLSOURCE = ''
THIS.creturnexprdesc = ''
ELSE
IF EMPTY(THIS.creturnexprdesc)
THIS.txtdesc.VISIBLE = .F.
ENDIF
ENDIF
IF THIS.lautoresize
THIS.txtfield.TOP = 0
THIS.txtfield.LEFT = 0
THIS.cmdpick.TOP = 0
THIS.cmdpick.WIDTH = 18
THIS.cmdpick.HEIGHT = 23
THIS.txtfield.HEIGHT = 23
THIS.cmdpick.LEFT = THIS.txtfield.WIDTH + 2
THIS.txtdesc.TOP = 0
THIS.txtdesc.LEFT = THIS.cmdpick.LEFT +;
THIS.cmdpick.WIDTH + 2
THIS.txtdesc.HEIGHT = THIS.txtfield.HEIGHT
THIS.txtdesc.WIDTH = MAX(0,THIS.WIDTH-THIS.txtfield.WIDTH - THIS.cmdpick.WIDTH -4)
THIS.HEIGHT = THIS.txtfield.HEIGHT
ENDIF
IF THIS.lhidecode
THIS.txtfield.ZORDER(1)
THIS.txtfield.TABSTOP = .F.
THIS.txtfield.HEIGHT = THIS.txtdesc.HEIGHT
THIS.txtdesc.TOP = THIS.txtfield.TOP
THIS.txtdesc.LEFT = THIS.txtfield.LEFT
THIS.txtdesc.WIDTH = MAX(0,THIS.WIDTH - (THIS.cmdpick.WIDTH+2))
THIS.cmdpick.LEFT = THIS.WIDTH-THIS.cmdpick.WIDTH
THIS.cmdpick.TABSTOP = .T.
THIS.txtdesc.TABSTOP = .T.
THIS.txtdesc.TABINDEX = 1
THIS.cmdpick.TABINDEX = 2
ENDIF
IF THIS.l3ddesc
THIS.txtdesc.BORDERSTYLE = 1
ENDIF
IF THIS.lautosetup
LOCAL lenabled
lenabled = !THIS.lfixfield
THIS.ENABLED = lenabled
IF pemstatus(THISFORM,'lCanEdit',5)
IF !THISFORM.lcanedit
THIS.ENABLED = .F.
ENDIF
ENDIF
IF THIS.lkeyfield
THIS.SETALL('Enabled',.F.)
ENDIF
ENDIF
IF THIS.ldescitalicfont
THIS.txtdesc.FONTITALIC = .T.
ENDIF
THIS.cmdpick.ENABLED = THIS.ENABLED
IF THIS.ENABLED
THIS.txtdesc.ENABLED = .T.
THIS.txtdesc.READONLY = .T.
ELSE
THIS.txtdesc.ENABLED = .F.
ENDIF
IF EMPTY(THIS.txtfield.VALUE)
THIS.txtdesc.VALUE = ""
ENDIF
THIS.coldkey = THIS.txtfield.VALUE
THIS.olinkform = .NULL.
LOCAL lenabled, ltxtfield
IF THIS.lautosetup
lenabled = !THIS.lfixfield
IF pemstatus(THISFORM, 'lEmpty',5)
IF THISFORM.lempty AND THISFORM.nformstatus != 2
lenabled = .F.
ENDIF
ENDIF
ltxtfield = lenabled
THIS.ENABLED = lenabled
ELSE
ltxtfield = THIS.ENABLED
lenabled = THIS.ENABLED
ENDIF
IF THIS.lautosetup AND lenabled
IF pemstatus(THISFORM,'lAutoEdit',5)
IF !THISFORM.lautoedit
lenabled = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
ENDIF
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
lenabled = THIS.ENABLED AND lenabled
ENDIF
IF THIS.lkeyfield AND lenabled
lenabled = (THISFORM.nformstatus = id_insert_mode)
ENDIF
IF THIS.lfixfield AND !EMPTY(THISFORM.cfixfieldvalue) AND lenabled
lenabled = .F.
ENDIF
ltxtfield = lenabled
IF lenabled
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ltxtfield = THIS.ENABLED
ENDIF
ENDIF
THIS.SETALL('Enabled',lenabled)
ENDIF
IF ltxtfield
THIS.cmdpick.TOOLTIPTEXT = THIS.cmdpick.extrabuffer
THIS.txtfield.TOOLTIPTEXT = THIS.txtfield.extrabuffer
ELSE
THIS.cmdpick.TOOLTIPTEXT = ''
THIS.txtfield.TOOLTIPTEXT = ''
ENDIF
IF ltxtfield
THIS.txtdesc.ENABLED = .T.
THIS.txtdesc.READONLY = .T.
ENDIF
THIS.txtfield.REFRESH()
THIS.txtdesc.REFRESH()
IF THIS.luserrefresh
LOCAL lcalias
lcalias = ALIAS()
IF EMPTY(NVL(THIS.txtfield.VALUE,""))
THIS.txtdesc.VALUE = ''
ENDIF
THIS.onrefresh()
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
ELSE
IF EMPTY(NVL(THIS.txtfield.VALUE,""))
THIS.txtdesc.VALUE = ''
ELSE
IF !EMPTY(THIS.creturnexprdesc)
IF !EMPTY(THIS.ccontrolbuffer)
IF !THIS._lnoreplace
THIS.txtdesc.VALUE = EVAL(THIS.ccontrolbuffer)
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
THIS._lnoreplace = .F.
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
NODEFAULT
| Baseclass | Class | Object name |
|---|---|---|
| commandbutton | ccommandbutton | cpickfield.cmdPick |
| textbox | ctextbox | cpickfield.txtDesc |
| cpickfield.txtField |
| Name | Initial value |
|---|---|
| Caption | "..." |
| HelpContextID | 294 |
| TabIndex | 2 |
| TabStop | .F. |
| ToolTipText | "List Values..." |
IF !THIS.PARENT.txtfield.ENABLED
RETURN .F.
ENDIF
LOCAL lcretval, lcalias, loform
IF !ISNULL(THIS.PARENT.olinkform)
?? CHR(7)
THIS.PARENT.olinkform.ACTIVATE()
RETURN .F.
ENDIF
IF THIS.PARENT.lnopickdialog
THIS.PARENT.lrightclickchange = .T.
THIS.PARENT.txtdesc.RIGHTCLICK()
RETURN .T.
ENDIF
LOCAL lcoldvalue, lldovalid
IF TYPE("this.Parent.txtField.Value") = "C"
lcretval = THIS.PARENT.txtfield.VALUE
ELSE
lcretval = converttochar(THIS.PARENT.txtfield.VALUE)
ENDIF
lcoldvalue = lcretval
lldovalid = THIS.PARENT.ldovalid
THIS.PARENT.llpickon = .T.
lcalias = ALIAS()
THIS.PARENT.ldovalid = .F.
IF THIS.PARENT.onprequery()
IF THIS.PARENT.lusespt AND ;
TYPE("goProgram.oConnMgr") = "O" AND !ISNULL(goprogram.oconnmgr) AND ;
INDBC(THIS.PARENT.ctablename, 'VIEW') AND ;
DBGETPROP(THIS.PARENT.ctablename, "VIEW", "SOURCETYPE") = 2
LOCAL lnsqlconnection
lnsqlconnection = goprogram.oconnmgr.getconnection()
DO FORM (THIS.PARENT.cpickform) WITH THIS.PARENT, lnsqlconnection TO lcretval
ELSE
DO FORM (THIS.PARENT.cpickform) WITH THIS.PARENT TO lcretval
ENDIF
ENDIF
LOCAL llcanedit
llcanedit = .T.
IF lcretval != "[RUN_FORM]" AND lcretval != "[CANCEL]"
THIS.PARENT._lnoreplace = .T.
IF pemstatus(THISFORM,"lAutoEdit",5)
IF THIS.PARENT.lautosetup AND THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
IF converttochar(THIS.PARENT.coldkey) != converttochar(THIS.PARENT.txtfield.VALUE)
llcanedit = THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
IF !THIS.PARENT._lfromvalid
THIS.PARENT.txtfield.SETFOCUS()
THIS.PARENT._lfromvalid = .F.
ENDIF
IF THIS.PARENT.lusetab
CLEAR TYPEAHEAD
KEYBOARD '{TAB}' PLAIN
ENDIF
IF llcanedit AND THIS.PARENT.lworkonview AND !EMPTY(THIS.PARENT.ccontrolbuffer)
THIS.PARENT.replacedescinview()
ENDIF
IF llcanedit AND converttochar(THIS.PARENT.coldkey) != converttochar(THIS.PARENT.txtfield.VALUE)
IF pemstatus(THISFORM, "nformstatus", 5)
IF THISFORM.nformstatus <> 0
THIS.PARENT.updatetargetfields()
THIS.PARENT.coldkey = THIS.PARENT.txtfield.VALUE
ENDIF
ELSE
THIS.PARENT.updatetargetfields()
THIS.PARENT.coldkey = THIS.PARENT.txtfield.VALUE
ENDIF
ENDIF
THIS.PARENT._lnoreplace = .T.
THIS.PARENT.REFRESH()
THIS.PARENT.txtfield.SELSTART = 0
THIS.PARENT.txtfield.SELLENGTH = 0
THIS.PARENT.olinkform = .NULL.
ELSE
IF lcretval = "[RUN_FORM]"
THIS.PARENT.ldovalid = .T.
THIS.PARENT.lrunform = TYPE("__VFX_FromValid") == "L" AND __vfx_fromvalid
ELSE
THIS.PARENT.ldovalid = THIS.PARENT.ldovalid OR lldovalid
THIS.PARENT.txtfield.SETFOCUS()
ENDIF
ENDIF
DODEFAULT()
THIS.extrabuffer = THIS.TOOLTIPTEXT
| Name | Initial value |
|---|---|
| Enabled | .F. |
| HelpContextID | 295 |
| PasswordChar | "" |
| TabIndex | 3 |
| TabStop | .F. |
| lautosetup | .F. |
| lusesyscolor | .F. |
LOCAL lopickfield
lopickfield = THIS.PARENT
*!* Can make problems if NULL is allowed for the pick value.
IF !EMPTY(lopickfield.cdataform) AND !ISNULL(THIS.PARENT.txtfield.VALUE)
IF TYPE("__VFX_PickField") != 'U'
RELEASE __vfx_pickfield
ENDIF
IF TYPE("__VFX_pickRecLoc") != 'U'
RELEASE __vfx_pickrecloc
ENDIF
IF TYPE("__VFX_PickTagName") != 'U'
RELEASE __vfx_picktagname
ENDIF
PUBLIC __vfx_pickfield
__vfx_pickfield = lopickfield
PUBLIC __vfx_pickrecloc
IF TYPE("loPickField.txtfield.value") == "C"
__vfx_pickrecloc = ALLTRIM(lopickfield.txtfield.VALUE)
ELSE
__vfx_pickrecloc = lopickfield.txtfield.VALUE
ENDIF
IF TYPE("__VFX_FromValid") == "L" AND __vfx_fromvalid
__vfx_pickrecloc = IIF(EMPTY(NVL(THIS.PARENT.cseekvalue,"")), "", THIS.PARENT.cseekvalue)
ENDIF
IF !EMPTY(lopickfield.ctagnamejump)
PUBLIC __vfx_picktagname
__vfx_picktagname = lopickfield.ctagnamejump
ELSE
IF !EMPTY(lopickfield.ctagname)
PUBLIC __vfx_picktagname
__vfx_picktagname = lopickfield.ctagname
ENDIF
ENDIF
lopickfield.llpickon = .T.
lopickfield.lrightclickon = .T.
lopickfield.lrunform = TYPE("__VFX_FromValid") == "L" AND __vfx_fromvalid
LOCAL lcarg
lcarg = "PICKDIALOG;" + ;
lopickfield.cfixfieldvalue+";;" + ;
lopickfield.cfixfieldname+";" + ;
lopickfield.cfilterexpr+";;"
IF TYPE("goProgram")=="O"
goprogram.runform(lopickfield.cdataform, lcarg)
ELSE
DO FORM (lopickfield.cdataform) WITH lcarg
ENDIF
RELEASE lcarg
IF TYPE("__VFX_PickTagName") != 'U'
RELEASE __vfx_picktagname
ENDIF
RELEASE __vfx_pickrecloc
RELEASE __vfx_pickfield
ENDIF
IF !THIS.PARENT.txtfield.ENABLED
RETURN .F.
ENDIF
THIS.PARENT.cmdpick.CLICK()
LPARAMETERS nkeycode, nshiftaltctrl
DODEFAULT(nkeycode,nshiftaltctrl)
IF THIS.PARENT.READONLY
NODEFAULT
RETURN .F.
ENDIF
IF THIS.PARENT.lhidecode
IF nkeycode = key_f9 AND nshiftaltctrl = 0
THIS.SELSTART = 0
THIS.SELLENGTH = 0
THIS.PARENT.cmdpick.ENABLED = .T.
THIS.PARENT.cmdpick.CLICK()
NODEFAULT
ENDIF
ENDIF
IF INLIST(nkeycode,7,147,163)
LOCAL llcanedit
llcanedit = .T.
IF THIS.PARENT.lautosetup
IF TYPE("thisForm.lAutoEdit") = "L"
IF THISFORM.nformstatus = 0 AND !THISFORM.lempty
lcanedit = THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF llcanedit
THIS.PARENT.CLEAR()
ENDIF
NODEFAULT
ENDIF
| Name | Initial value |
|---|---|
| HelpContextID | 293 |
| PasswordChar | "" |
| TabIndex | 1 |
| lusesyscolor | .F. |
LPARAMETERS nkeycode, nshiftaltctrl
DODEFAULT(nkeycode,nshiftaltctrl)
IF THIS.PARENT.READONLY
NODEFAULT
RETURN .F.
ENDIF
IF nkeycode = key_f9 AND nshiftaltctrl = 0
THIS.SELSTART = 0
THIS.SELLENGTH = 0
THIS.PARENT.cmdpick.CLICK()
NODEFAULT
ENDIF
IF THIS.PARENT.lautosetup
IF TYPE("thisForm.lAutoEdit") == "L" AND THISFORM.lcanedit
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
THISFORM.nformstatus = 1
THIS.lnorefresh = .T.
THIS.PARENT.cmdpick.ENABLED = .T.
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
THIS.PARENT.ldovalid = .T.
IF THIS.PARENT.READONLY
RETURN .F.
ENDIF
THIS.SELSTART = 0
THIS.SELLENGTH = 0
THIS.PARENT.cmdpick.CLICK()
| Name | Initial value |
|---|---|
| BorderStyle | 0 |
| HelpContextID | 296 |
| SpecialEffect | 1 |
| ToolTipText | "F9 - Pick List [Edit Mode]" |
| _vfxclassname | CPickTextBox |
| cinputmask | |
| cviewparameter | .F. |
| extrabuffer |
| Name | Initial value | Comment |
|---|---|---|
| cdataform | See CPickField class | |
| cfieldlist | See CPickField class | |
| cfieldtitle | .f. | Specifies the caption for the cFieldList. See CPickField class |
| cfilterexpr | See CPickField class | |
| cfixfieldname | Now, when calling the maintenance form from a pickfield, the property cFixFieldName and cFixFieldValue are available on the originating pickfield object and can be referenced from the init of the called form. | |
| cfixfieldvalue | Now, when calling the maintenance form from a pickfield, the property cFixFieldName and cFixFieldValue are available on the originating pickfield object and can be referenced from the init of the called form. | |
| cindexexpr | See CPickField class | |
| coldkey | See CPickField class | |
| cpickcaption | See CPickField class | |
| cpickform | VFXPICK | See CPickField class |
| creturnexpr | See CPickField class | |
| creturnmoreexpr | See CPickField class | |
| creturnmoreexprval | See CPickField class | |
| cseekvalue | See CPickField class | |
| csqlselect | See CPickField class | |
| csqlvalid | See CPickField class | |
| ctablename | See CPickField class | |
| ctagname | See CPickField class | |
| cupdsourcefields | .f. | See CPickField class |
| cupdtargetfields | .f. | See CPickField class |
| cupdtargettable | .f. | See CPickField class |
| cviewvalid | .F. | See CPickField class |
| lautopick | .F. | See CPickField class |
| ldovalid | .f. | See CPickField class |
| llpickon | .F. | See CPickField class |
| lnopickdialog | .f. | Set this property to .t. if you want to use the maintenance form directly rather than the normal pick dialog to pick a value. |
| lnullvalid | .f. | See CPickField class |
| lreleasemformonclose | .f. | Defines whether the referenced maintenance form will be closed when the pickfield goes out of scope. |
| lrunform | .f. | This property set to .t. defines that the maintenance form will be used as instead of the pickdialog. |
| luserpreparepickdata | .F. | This property defines whether the Pickdialog and the validation of the input will be done against a user defined select statement using SQL Pass Through |
| lusespt | .f. | This property defines whether SQL Pass Through (short: SPT) will be used to speedup operation and reduce the dataenvironment and connection overhead. |
| lusetab | .T. | See CPickField class |
| lworkonview | .f. | See CPickField class |
| nvalidmode | 0 | See CPickField class |
| olinkform | .f. | Pointer to the maintenance form, when called. |
| opickrec | .f. | See CPickField class |
IF !THIS.ENABLED
RETURN .F.
ENDIF
LOCAL lcretval, lcalias, loform
IF !ISNULL(THIS.olinkform)
?? CHR(7)
THIS.olinkform.ACTIVATE()
RETURN .F.
ENDIF
IF THIS.lnopickdialog
THIS.runmform()
RETURN .T.
ENDIF
LOCAL lcoldvalue, lldovalid
IF TYPE("this.Value") = "C"
lcretval = THIS.VALUE
ELSE
lcretval = converttochar(THIS.VALUE)
ENDIF
lcoldvalue = lcretval
lldovalid = THIS.ldovalid
THIS.llpickon = .T.
lcalias = ALIAS()
THIS.ldovalid = .F.
THIS.opickrec = .NULL.
IF THIS.onprequery()
IF THIS.lusespt AND ;
TYPE("goProgram.oConnMgr") = "O" AND !ISNULL(goprogram.oconnmgr) AND ;
INDBC(THIS.ctablename, 'VIEW') AND ;
DBGETPROP(THIS.ctablename, "VIEW", "SOURCETYPE") = 2
LOCAL lnsqlconnection
lnsqlconnection = goprogram.oconnmgr.getconnection()
DO FORM (THIS.cpickform) WITH THIS, lnsqlconnection TO lcretval
ELSE
DO FORM (THIS.cpickform) WITH THIS TO lcretval
ENDIF
ENDIF
LOCAL llcanedit
llcanedit = .T.
IF lcretval != "[RUN_FORM]" AND lcretval != "[CANCEL]"
IF !EMPTY(NVL(lcretval,""))
UNLOCK IN (THIS.PARENT.PARENT.RECORDSOURCE)
IF pemstatus(THISFORM,"lAutoEdit",5)
IF THIS.lautosetup AND THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
IF converttochar(THIS.coldkey) != converttochar(THIS.VALUE)
llcanedit = THISFORM.onedit()
ENDIF
ENDIF
ENDIF
* UH/Michalis
IF CURSORGETPROP("buffering",THIS.PARENT.PARENT.RECORDSOURCE) = 5
IF !(EOF() OR DELETED())
GO RECNO()
ENDIF
ENDIF
IF llcanedit AND converttochar(THIS.coldkey) != converttochar(THIS.VALUE)
IF pemstatus(THISFORM, "nformstatus", 5)
IF THISFORM.nformstatus <> 0
THIS.updatetargetfields()
THIS.coldkey = THIS.VALUE
ENDIF
ELSE
THIS.updatetargetfields()
THIS.coldkey = THIS.VALUE
ENDIF
ENDIF
THIS.SELSTART = 0
THIS.SELLENGTH = 0
THIS.olinkform = .NULL.
ENDIF
IF THIS.lusetab
CLEAR TYPEAHEAD
KEYBOARD '{TAB}' PLAIN
ENDIF
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
ELSE
IF lcretval = "[RUN_FORM]"
THIS.ldovalid = .T.
THIS.lrunform = TYPE("__VFX_FromValid") == "L" AND __vfx_fromvalid
ELSE
THIS.ldovalid = THIS.ldovalid .OR. lldovalid
ENDIF
ENDIF
RETURN THIS.VALUE
THIS.REQUERY()
RETURN THIS.creturnmoreexprval
LPARAMETERS tlvalid
LOCAL lok
lok = .F.
IF THIS.onprequery()
LOCAL ccommand, lctable, lccursor, lctag, lcindexexpr, ;
lnworkarea, lnrecno, lcseek
lok = .T.
lcindexexpr = ""
lnworkarea = SELECT()
lctable = THIS.ctablename
lctag = THIS.ctagname
lccursor = "X"+SUBSTR(SYS(2015),4,7)
THIS.opickrec = .NULL.
IF THIS.lworkonview AND tlvalid
DO CASE
CASE THIS.nvalidmode = 0
lok = THIS.dosqlvalid(lccursor)
CASE THIS.nvalidmode = 1
lok = THIS.doviewvalid(lccursor)
CASE THIS.nvalidmode = 2
lok = THIS.douservalid(lccursor)
ENDCASE
ELSE
IF EMPTY(lctag)
USE (lctable) IN 0 ALIAS (lccursor) SHARED AGAIN
SELECT (lccursor)
IF !EMPTY(THIS.cfilterexpr)
LOCAL lcfilterexpr
lcfilterexpr = THIS.cfilterexpr
SET FILTER TO &lcfilterexpr
ENDIF
IF !EMPTY(THIS.cindexexpr)
lcindexexpr = THIS.cindexexpr
INDEX ON &lcindexexpr TAG (lccursor)
ENDIF
ELSE
USE (lctable) IN 0 ALIAS (lccursor) ORDER TAG (lctag) SHARED AGAIN
SELECT (lccursor)
lcindexexpr = KEY()
ENDIF
IF EMPTY(THIS.cseekvalue)
lcseek = THIS.VALUE
ELSE
lcseek = THIS.cseekvalue
ENDIF
IF CURSORGETPROP('SourceType',lccursor) != 3
=REQUERY(lccursor)
ENDIF
IF !EMPTY(lcindexexpr)
IF !EMPTY(lcseek)
IF "UPPER" $ lcindexexpr
lok =SEEK(UPPER(lcseek), lccursor)
ELSE
lok =SEEK(lcseek, lccursor)
ENDIF
ENDIF
ENDIF
ENDIF
SELECT (lccursor)
LOCAL lorec
SCATTER MEMO NAME lorec BLANK
THIS.opickrec = lorec
IF !lok
IF !EMPTY(THIS.creturnmoreexpr)
THIS.creturnmoreexprval = ""
ENDIF
ELSE
SCATTER MEMO NAME lorec
THIS.opickrec = lorec
IF !EMPTY(THIS.creturnmoreexpr)
THIS.creturnmoreexprval = EVALUATE(THIS.creturnmoreexpr)
ENDIF
IF converttochar(THIS.coldkey) != converttochar(THIS.VALUE)
IF pemstatus(THISFORM, "nformstatus", 5)
IF THISFORM.nformstatus <> 0
THIS.updatetargetfields()
ENDIF
ELSE
THIS.updatetargetfields()
ENDIF
ENDIF
ENDIF
RELEASE lorec
IF USED(lccursor)
SELECT (lccursor)
ENDIF
THIS.onpostquery()
THIS.onpick()
CLOSE INDEX
IF USED(lccursor)
USE IN (lccursor)
ENDIF
SELECT (lnworkarea)
ENDIF
RETURN lok
LPARAMETERS tvalue, tlforcevalid
THIS.coldkey = THIS.VALUE
THIS.VALUE = tvalue
IF tlforcevalid
THIS.ldovalid = .T.
THIS.coldkey = .NULL.
ENDIF
THIS.VALID(.T.)
LPARAMETERS tccursor
LOCAL lok, lccursor, lcsqlvalid, lcfilterexpr
lok = .T.
lctable = THIS.ctablename
lccursor = tccursor
lcsqlvalid = THIS.csqlvalid + " into cursor " + lccursor + " noconsole"
&lcsqlvalid
SELECT (lccursor)
lok = _TALLY > 0
IF !EMPTY(THIS.cfilterexpr)
LOCAL lcfilterexpr
lcfilterexpr = THIS.cfilterexpr
SET FILTER TO &lcfilterexpr
ENDIF
LOCATE
RETURN lok
LPARAMETERS tccursor
LOCAL lcsql, lok, lcparameters, lcviewvalid, lctemp, lcretexpr, lnsqlconnection
lok = .T.
lctable = THIS.ctablename
lctemp = ""
lcretexpr = ""
lcviewvalid = IIF(EMPTY(tccursor), THIS.cviewvalid, tccursor)
lnsqlconnection = 0
lcsql = ""
IF !USED(lcviewvalid)
IF THIS.lusespt AND ;
TYPE("goProgram.oConnMgr") = "O" AND !ISNULL(goprogram.oconnmgr) AND ;
INDBC(THIS.cviewvalid,"VIEW") AND ;
DBGETPROP(THIS.cviewvalid, "VIEW", "SOURCETYPE") = 2
lnsqlconnection = goprogram.oconnmgr.getconnection()
IF lnsqlconnection > 0
lcsql = DBGETPROP(THIS.cviewvalid, "VIEW", "SQL")
ELSE
USE (THIS.cviewvalid) IN 0 ALIAS (lcviewvalid) AGAIN NODATA
ENDIF
ELSE
USE (THIS.cviewvalid) IN 0 ALIAS (lcviewvalid) AGAIN NODATA
ENDIF
ENDIF
IF EMPTY(lcsql)
SELECT(lcviewvalid)
lcparameters = ALLTRIM(DBGETPROP(THIS.cviewvalid, 'view', 'SQL'))
ELSE
lcparameters = ALLTRIM(lcsql)
ENDIF
IF !EMPTY(lcparameters)
LOCAL lnargcount, lnsymbolcount, lcsymbol, lcvalue, lasymtable[1], lctext, k
LOCAL lasymtable
lnargcount = OCCURS('?',lcparameters)
lnsymbolcount = 0
IF lnargcount > 0
LOCAL lnpos, llassingvalue
llassingvalue = .T.
lnargcount = 1
FOR lnpos=1 TO lnargcount
lcsymbol = SUBSTR(lcparameters,AT('?',lcparameters,lnpos)+1)
lctext = ''
FOR k = 1 TO LEN(lcsymbol)
IF LOWER(SUBSTR(lcsymbol,k,1)) $ "abcdefghijklmnopqrstuvwxyz0123456789_"
lctext = lctext + SUBSTR(lcsymbol,k,1)
ELSE
EXIT
ENDIF
NEXT
IF !EMPTY(lctext)
lcsymbol = lctext
lnsymbolcount = lnsymbolcount + 1
DIMENSION lasymtable[lnSymbolCount]
lasymtable[lnSymbolCount] = lcsymbol
IF TYPE(lcsymbol) == "U"
PUBLIC (lcsymbol)
llassingvalue = .T.
ELSE
llassingvalue = .F.
ENDIF
IF lnpos = 1
&lcsymbol. = THIS.VALUE
ENDIF
ENDIF
NEXT
IF THIS.lusespt AND lnsqlconnection > 0
vfxsqlexec(lnsqlconnection, lcsql, lcviewvalid)
ELSE
REQUERY(lcviewvalid)
ENDIF
k = 0
SELECT (lcviewvalid)
k = RECCOUNT()
lok = k > 0
FOR k = 1 TO lnsymbolcount
lcsymbol = lasymtable[k]
RELEASE (lcsymbol)
NEXT
ELSE
lok = .F.
ENDIF
ELSE
lok = .F.
ENDIF
RETURN lok
LPARAMETERS tcproperty
LOCAL loobj, luretval
loobj = THIS.opickrec
luretval = .NULL.
IF !(TYPE("loObj") = "O") OR ISNULL(loobj)
RETURN .NULL.
ENDIF
tcproperty = IIF(TYPE("tcProperty") <> "C", .NULL., tcproperty)
IF EMPTY(NVL(tcproperty,""))
RETURN .NULL.
ENDIF
IF pemstatus(loobj, tcproperty, 5)
luretval = loobj.&tcproperty
ENDIF
RETURN luretval
LOCAL lni, lcfield, lxfieldvalue, lcworkalias, lccurralias, ;
lcsfieldlist, lctfieldlist, lcsourcefield, lctargetfield
lni = 1
lcworkalias = IIF(EMPTY(NVL(THIS.cupdtargettable,"")), "", THIS.cupdtargettable)
lcsfieldlist = IIF(EMPTY(NVL(THIS.cupdsourcefields,"")), "", UPPER(THIS.cupdsourcefields))
lctfieldlist = IIF(EMPTY(NVL(THIS.cupdtargetfields,"")), "", UPPER(THIS.cupdtargetfields))
lccurralias = ""
lnsourcefields = IIF(EMPTY(lcsfieldlist), 0, getargcount(lcsfieldlist))
lntargetfields = IIF(EMPTY(lctfieldlist), 0, getargcount(lctfieldlist))
FOR lni = 1 TO lnsourcefields
lcsourcefield = getarg(lcsfieldlist, lni)
lctargetfield = getarg(lctfieldlist, lni)
IF EMPTY(NVL(lctargetfield,"")) OR EMPTY(NVL(lcsourcefield,""))
LOOP
ENDIF
lccurralias = IIF(AT(".", lctargetfield) = 0, lcworkalias, ;
LEFT(lctargetfield, AT(".", lctargetfield)-1))
lxfieldvalue = THIS.getmorevalues(lcsourcefield)
IF !ISNULL(lxfieldvalue)
IF !EMPTY(lccurralias)
REPLACE &lctargetfield WITH lxfieldvalue IN (lccurralias)
ELSE
REPLACE &lctargetfield WITH lxfieldvalue
ENDIF
ENDIF
ENDFOR
LPARAMETERS tcretval
LOCAL lcfieldvalue, lcreturnmoreexprval
lcfieldvalue = getarg(tcretval, 1)
lcreturnmoreexprval = getarg(tcretval, 3)
LOCAL lufieldvalue
DO CASE
CASE TYPE(THIS.CONTROLSOURCE) $ "NIBFY"
lufieldvalue = VAL(lcfieldvalue)
CASE TYPE(THIS.CONTROLSOURCE) = "D"
lufieldvalue = CTOD(lcfieldvalue)
CASE TYPE(THIS.CONTROLSOURCE) = "T"
lufieldvalue = CTOT(lcfieldvalue)
CASE TYPE(THIS.CONTROLSOURCE) = "L"
lufieldvalue = (UPPER(lcfieldvalue) = "T")
OTHERWISE
lufieldvalue = lcfieldvalue
ENDCASE
THIS.llpickon = .F.
THIS.olinkform = .NULL.
THIS.lrunform = .F.
IF converttochar(THIS.coldkey) = converttochar(lufieldvalue) AND ;
converttochar(THIS.VALUE) = converttochar(lufieldvalue)
RETURN
ENDIF
LOCAL llcanedit
llcanedit = .T.
IF pemstatus(THISFORM,"lAutoEdit",5)
IF THIS.lautosetup AND THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
llcanedit = THISFORM.onedit()
ENDIF
ENDIF
IF llcanedit
THIS.VALUE = lcfieldvalue
THIS.coldkey = .NULL.
IF EMPTY(lcreturnmoreexprval)
THIS.creturnmoreexprval = ""
ELSE
THIS.creturnmoreexprval = IIF(EMPTY(NVL(lcreturnmoreexprval,"")), "", lcreturnmoreexprval)
ENDIF
ENDIF
THIS.onpostquery()
IF llcanedit
THIS.onpick()
IF pemstatus(THISFORM, "nformstatus", 5)
IF THISFORM.nformstatus <> 0
THIS.updatetargetfields()
THIS.coldkey = THIS.VALUE
ENDIF
ELSE
THIS.updatetargetfields()
THIS.coldkey = THIS.VALUE
ENDIF
ENDIF
THIS.ldovalid = .F.
IF this.lUseTab
CLEAR TYPEAHEAD
KEYBOARD '{TAB}' PLAIN
ENDIF
IF !EMPTY(THIS.CONTROLSOURCE)
DO CASE
CASE VARTYPE(THIS.CONTROLSOURCE) = "C"
THIS.VALUE = ''
CASE VARTYPE(THIS.CONTROLSOURCE) = "D"
THIS.VALUE = CTOD('')
CASE VARTYPE(THIS.CONTROLSOURCE) = "T"
THIS.VALUE = CTOT('')
CASE VARTYPE(THIS.CONTROLSOURCE) $ "NY"
THIS.VALUE = 0
OTHERWISE
THIS.VALUE = .NULL.
ENDCASE
ELSE
DO CASE
CASE VARTYPE("this.value") = "C"
THIS.VALUE = ''
CASE VARTYPE("this.value") = "D"
THIS.VALUE = CTOD('')
CASE VARTYPE("this.value") = "T"
THIS.VALUE = CTOT('')
CASE VARTYPE("this.value") $ "NY"
THIS.VALUE = 0
OTHERWISE
THIS.VALUE = .NULL.
ENDCASE
ENDIF
DO CASE
CASE VARTYPE(THIS.creturnmoreexpr) = "C"
THIS.creturnmoreexprval = ''
CASE VARTYPE(THIS.creturnmoreexpr) = "D"
THIS.creturnmoreexprval = CTOD('')
CASE VARTYPE(THIS.creturnmoreexpr) = "T"
THIS.creturnmoreexprval = CTOT('')
CASE VARTYPE(THIS.creturnmoreexpr) = "L"
THIS.creturnmoreexprval = .F.
CASE VARTYPE(THIS.creturnmoreexpr) $ "NY"
THIS.creturnmoreexprval = 0
OTHERWISE
THIS.creturnmoreexprval = .NULL.
ENDCASE
THIS.opickrec = .NULL.
LOCAL lopickfield
lopickfield = THIS
IF !EMPTY(lopickfield.cdataform)
IF TYPE("__VFX_PickField")=="O"
RELEASE __vfx_pickfield
ENDIF
PUBLIC __vfx_pickfield
__vfx_pickfield = lopickfield
IF TYPE("__VFX_pickRecLoc") != 'U'
RELEASE __vfx_pickrecloc
ENDIF
IF TYPE("__VFX_PickTagName") != 'U'
RELEASE __vfx_picktagname
ENDIF
PUBLIC __vfx_pickrecloc
IF TYPE("loPickField.value") == "C"
__vfx_pickrecloc = ALLTRIM(lopickfield.VALUE)
ELSE
__vfx_pickrecloc = lopickfield.VALUE
ENDIF
IF TYPE("__VFX_FromValid") == "L" AND __vfx_fromvalid
__vfx_pickrecloc = IIF(EMPTY(NVL(THIS.cseekvalue,"")), "", THIS.cseekvalue)
ENDIF
IF !EMPTY(lopickfield.ctagname)
PUBLIC __vfx_picktagname
__vfx_picktagname = lopickfield.ctagname
ENDIF
lopickfield.llpickon = .T.
lopickfield.lrunform = TYPE("__VFX_FromValid") == "L" AND __vfx_fromvalid
LOCAL lcarg
lcarg = "PICKDIALOG;" + ;
THIS.cfixfieldvalue+";;" + ;
THIS.cfixfieldname+";" + ;
THIS.cfilterexpr+";;"
IF TYPE("goProgram")=="O"
goprogram.runform(lopickfield.cdataform, lcarg)
ELSE
DO FORM (lopickfield.cdataform) WITH lcarg
ENDIF
RELEASE lcarg
__vfx_pickfield = .NULL.
RELEASE __vfx_pickfield
IF TYPE("__VFX_PickTagName") != 'U'
RELEASE __vfx_picktagname
ENDIF
RELEASE __vfx_pickrecloc
ENDIF
LPARAMETERS tccursorname
*!* * Sample Code
*!* local lcSQL
*!* lcSQL = "
*!* local lnSQLConnection
*!* lnSQLConnection = goProgram.oConnMgr.getConnection()
*!* if (lnSQLConnection > 0)
*!* if vfxSQLExec(lnSQLConnection, lcSQL, tcCursorName) != 1
*!* messagebox("
*!* endif
*!* else
*!* messagebox(MSG_UNABLE_TO_GET_CONNECTION)
*!* endif
LPARAMETERS tccursorname
LOCAL loform
loform = THIS.olinkform
IF TYPE("loForm") == "O" AND !ISNULL(loform)
IF pemstatus(loform, "opickfield", 5)
loform.opickfield = .NULL.
ENDIF
loform.RELEASE()
loform = .NULL.
ENDIF
THIS.olinkform = .NULL.
RETURN DODEFAULT()
IF UPPER(THIS.BASECLASS) # "TEXTBOX"
NODEFAULT
ENDIF
IF LOWER(THIS.PARENT.PARENT.BASECLASS) == "grid"
IF THIS.PARENT.PARENT.READONLY OR THIS.PARENT.READONLY
RETURN .F.
ENDIF
ENDIF
THIS.SELSTART = 0
THIS.SELLENGTH = 0
THIS.dopickform()
LPARAMETERS nkeycode, nshiftaltctrl
IF THIS.READONLY
RETURN .F.
ENDIF
IF nkeycode = key_f9 AND nshiftaltctrl = 0
IF LOWER(THIS.PARENT.PARENT.BASECLASS) == "grid"
IF THIS.PARENT.PARENT.READONLY OR THIS.PARENT.READONLY
NODEFAULT
RETURN .F.
ENDIF
ENDIF
THIS.SELSTART = 0
THIS.SELLENGTH = 0
THIS.dopickform()
NODEFAULT
RETURN
ENDIF
IF nshiftaltctrl = 2
IF nkeycode = 146 OR nkeycode = 147
NODEFAULT
RETURN
ENDIF
ENDIF
IF nkeycode = 27
THIS.ldovalid = .F.
NODEFAULT
RETURN
ENDIF
IF 32 <= nkeycode AND nkeycode <= 255
THIS.ldovalid = .T.
ENDIF
LPARAMETERS tlvalid
LOCAL lok, lvalid
IF UPPER(THIS.BASECLASS) # "TEXTBOX"
RETURN .T.
ENDIF
IF THIS.llpickon
RETURN .T.
ENDIF
lvalid = THIS.ldovalid OR tlvalid
IF !(!THIS.lfixfield AND ((EMPTY(NVL(THIS.VALUE,"")) AND ;
!THIS.lnullvalid) OR (lvalid AND converttochar(THIS.coldkey)!=converttochar(THIS.VALUE))))
RETURN .T.
ENDIF
lok = .T.
IF EMPTY(NVL(THIS.VALUE,"")) AND THIS.lnullvalid
THIS.CLEAR()
THIS.onpick()
RETURN .T.
ENDIF
IF THIS.lautosetup
IF THISFORM.nformstatus = 0
lok = .T.
lvalid = .F.
ENDIF
ENDIF
lok = !(EMPTY(NVL(THIS.VALUE,"")) .AND. !THIS.lnullvalid)
lvalid = THIS.ldovalid OR tlvalid OR (EMPTY(NVL(THIS.VALUE,"")) AND !THIS.lnullvalid)
IF lvalid
LOCAL lcalias, lcseekvalue
lcalias = ALIAS()
lcseekvalue = THIS.VALUE
IF lok
lok = THIS.REQUERY(.T.)
ENDIF
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
IF !lok
IF THIS.lautopick OR (MESSAGEBOX(msg_ask_for_pick,mb_yesno+mb_iconquestion+mb_defbutton1,msg_attention) = idyes)
THIS.cseekvalue = lcseekvalue
THIS.CLEAR()
PUBLIC __vfx_fromvalid
__vfx_fromvalid = .T.
THIS.dopickform()
__vfx_fromvalid = .F.
lok = !(EMPTY(NVL(THIS.VALUE,"")) .AND. !THIS.lnullvalid)
IF !lok
THIS.CLEAR()
ENDIF
IF THIS.lrunform
RETURN .F.
ENDIF
ELSE
THIS.CLEAR()
ENDIF
ENDIF
ENDIF
RETURN lok
IF !(TYPE("__VFX_Builder_Object")="L" AND __vfx_builder_object)
IF EMPTY(THIS.ctablename)
WAIT WINDOW "CPickTextBox Error" + CHR(13)+;
"no table defined - field: " + ALLTRIM(THIS.NAME)
RETURN .F.
ENDIF
ENDIF
THIS.ENABLED = .T.
THIS.llpickon = .F.
THIS.ldovalid = .F.
THIS.creturnmoreexprval = ""
IF THIS.lautosetup
THIS.FORMAT = "!K"
ENDIF
IF id_language <> "E"
THIS.TOOLTIPTEXT = ttt_pickeditmode
ENDIF
THIS.olinkform = .NULL.
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
DEFINE POPUP shortcut shortcut RELATIVE FROM MROW(),MCOL()
DEFINE BAR _MED_CUT OF shortcut PROMPT ttt_cmdcut
DEFINE BAR _MED_COPY OF shortcut PROMPT ttt_cmdcopy
DEFINE BAR _MED_PASTE OF shortcut PROMPT ttt_cmdpaste
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("RightClick",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ACTIVATE POPUP shortcut
IF THIS.lrunform
THIS.lrunform = .F.
IF TYPE("this.oLinkForm")=="O" AND !ISNULL(THIS.olinkform)
THIS.olinkform.SHOW()
ENDIF
RETURN .T.
ENDIF
DODEFAULT()
IF !THIS.llpickon
THIS.coldkey = THIS.VALUE
ELSE
THIS.llpickon = .F.
THIS.olinkform = .NULL.
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") == "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
THISFORM.nformstatus = 1
THIS.lnorefresh = .T.
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
THIS.ldovalid = .T.
| Name | Initial value |
|---|---|
| SpecialEffect | 0 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CShape | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
RELEASE THIS
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
| Name | Initial value |
|---|---|
| Alignment | 1 |
| HelpContextID | 300 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CSpinner | Internal use.Specifies the original VFX Class Name |
| cviewparameter | .f. | Specifies the name of the view argument which the control is bounded |
| extrabuffer | .f. | A user buffer |
| lautosetup | .T. | .T. if it's enabled when the form is in Insert or Edit mode |
| lnorefresh | .f. | Setting this property to .t. does prevent the control from beeing refreshed once. This is usefull, when a refresh of the form is issued and you want prevent the user from loosing what he currently was typing. |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lselectonentry | .T. | Specifies if the field is selected when got the focus |
| lusesyscolor | .T. |
RELEASE THIS
IF THIS.lnorefresh
THIS.lnorefresh = .F.
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") = "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
THISFORM.nformstatus = 1
THIS.lnorefresh = .T.
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ELSE
THIS.ENABLED = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
ELSE
THIS.ENABLED = (THISFORM.nformstatus <> id_normal_mode)
ENDIF
IF THIS.ENABLED
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ENDIF
ENDIF
IF THIS.lnorefresh
NODEFAULT
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF THIS.lselectonentry
THIS.FORMAT= "K"+THIS.FORMAT
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
DEFINE POPUP shortcut shortcut RELATIVE FROM MROW(),MCOL()
DEFINE BAR _MED_CUT OF shortcut PROMPT ttt_cmdcut
DEFINE BAR _MED_COPY OF shortcut PROMPT ttt_cmdcopy
DEFINE BAR _MED_PASTE OF shortcut PROMPT ttt_cmdpaste
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("RightClick",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ACTIVATE POPUP shortcut
| Name | Initial value |
|---|---|
| HelpContextID | 301 |
| OLEDragMode | 1 |
| OLEDropMode | 1 |
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | Array containing other object references |
| _vfxclassname | CTextBox | Internal use.Specifies the original VFX Class Name |
| cinputmask | .f. | Reserved. Stores current InputMask. |
| csuppressvalidwhen | cmdUndo;cmdExit | Description see property lsuppressvalid. |
| cviewparameter | .f. | Specifies the name of the view argument which the control is bounded to |
| extrabuffer | .f. | Use this property for any storage you may need. |
| lautosetup | .T. | .T. if it's enabled when the form is in Insert or Edit mode |
| lfixfield | .f. | Specifies if this is a Fix Field value and therefore disabled in a parent child scenario (foreign key field) |
| lkeyfield | .f. | Specifies if this field is a Key Field which can only be entered during insert and then will be disabled (read only). Use this if you don't want the user to change any of your primary keys or other important fields. |
| lnorefresh | .f. | Setting this property to .t. does prevent the control from beeing refreshed once. This is usefull, when a refresh of the form is issued and you want prevent the user from loosing what he currently was typing. |
| lproportionalresize | .T. | Specifies if the resize of this object it proportional or not |
| lselectonentry | .T. | Specifies if the control will be selected |
| lsuppressvalid | .F. | Defines whether the valid method can be quit i.e. by pressing a cancel command button. This property gets automatically set through the default valid() method and can be used in the own valid method to quit when needed. |
| lusesyscolor | .T. | Specifies if the System Color will be used |
RELEASE THIS
this.interactivechange()
IF pemstatus(THISFORM, "nformstatus", 5) AND THISFORM.nformstatus = 0
THIS.lsuppressvalid = .T.
ENDIF
*-- ESC
IF LASTKEY() = 27
THIS.lsuppressvalid = .T.
ENDIF
*-- cmdExit, cmdUndo
LOCAL loobj
loobj = SYS(1270)
IF MDOWN() AND ;
TYPE("loObj") = "O" AND ;
!ISNULL(loobj) AND ;
pemstatus(THIS, "cSuppressValidWhen", 5) AND ;
pemstatus(loobj, "name", 5) AND ;
TYPE("loObj.name") == "C" AND ;
LOWER(loobj.NAME) $ LOWER(THIS.csuppressvalidwhen)
THIS.lsuppressvalid = .T.
ENDIF
THIS.lsuppressvalid = .F.
DEFINE POPUP shortcut shortcut RELATIVE FROM MROW(),MCOL()
DEFINE BAR _MED_CUT OF shortcut PROMPT ttt_cmdcut
DEFINE BAR _MED_COPY OF shortcut PROMPT ttt_cmdcopy
DEFINE BAR _MED_PASTE OF shortcut PROMPT ttt_cmdpaste
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("RightClick",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ACTIVATE POPUP shortcut
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[m.lnItem] = .NULL.
NEXT
IF LOWER(THIS.PARENT.BASECLASS) = "column"
RETURN .T.
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") = "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
THISFORM.nformstatus = 1
THIS.lnorefresh = .T.
THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF TYPE("this.Parent")="O" AND LOWER(THIS.PARENT.BASECLASS)="column"
THIS.lautosetup = .F.
RETURN .T.
ENDIF
IF TYPE("thisForm.nFormStatus")="U"
THIS.lautosetup = .F.
ENDIF
IF !EMPTY(THIS.CONTROLSOURCE)
IF TYPE(THIS.CONTROLSOURCE) = "C" AND EMPTY(THIS.INPUTMASK)
IF !('M' $ THIS.FORMAT)
THIS.INPUTMASK = REPLICATE("X",;
FSIZE(SUBSTR(THIS.CONTROLSOURCE, AT(".", THIS.CONTROLSOURCE) + 1)))
ENDIF
ENDIF
ENDIF
IF THIS.lselectonentry
THIS.FORMAT= "K"+THIS.FORMAT
ENDIF
THIS.cinputmask = THIS.INPUTMASK
IF THIS.READONLY
THIS.lautosetup = .F.
ENDIF
IF TYPE("thisForm")="O"
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Init",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
ENDIF
IF LOWER(THIS.PARENT.BASECLASS) == "column"
RETURN .T.
ENDIF
IF THIS.lautosetup
IF TYPE("thisForm.lAutoEdit") != "U"
IF THISFORM.lautoedit
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ELSE
THIS.ENABLED = THISFORM.nformstatus <> id_normal_mode
ENDIF
ELSE
THIS.ENABLED = THISFORM.nformstatus <> id_normal_mode
ENDIF
IF THIS.lfixfield
THIS.ENABLED = .F.
ENDIF
IF THIS.ENABLED
IF pemstatus(THISFORM,'lCanEdit',5)
THIS.ENABLED = THISFORM.lcanedit
ENDIF
ENDIF
IF THIS.ENABLED AND THIS.lkeyfield AND THISFORM.nformstatus != 2
THIS.ENABLED = .F.
ENDIF
ENDIF
IF THIS.lnorefresh
NODEFAULT
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("Refresh",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
IF THIS.lnorefresh
THIS.lnorefresh = .F.
ENDIF
IF LOWER(THIS.PARENT.BASECLASS) = "column"
RETURN .T.
ENDIF
IF TYPE("this.Value") $ "NY"
THIS.INPUTMASK = THIS.cinputmask
ENDIF
IF LOWER(THIS.PARENT.BASECLASS) == "column"
RETURN .T.
ENDIF
IF TYPE("this.Value") $ "NY"
THIS.INPUTMASK = STRTRAN(THIS.INPUTMASK,",","")
THIS.INPUTMASK = STRTRAN(THIS.INPUTMASK," ","")
ENDIF
IF THIS.lselectonentry AND TYPE("this.value") $ "CM" AND LEN(TRIM(THIS.VALUE)) = 1
THIS.FORMAT = STRTRAN(THIS.FORMAT,"K","")
THIS.SELSTART = 0
THIS.SELLENGTH = 1
ELSE
IF THIS.lselectonentry AND !"K"$THIS.FORMAT
THIS.FORMAT= "K"+THIS.FORMAT
ENDIF
ENDIF
LPARAMETERS oDataObject, nEffect
nEffect=1
| Name | Initial value | Comment |
|---|---|---|
| _vfxclassname | CTimer | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
RELEASE THIS
| Name | Initial value |
|---|---|
| Caption | "CToolBar" |
| Name | Initial value | Comment |
|---|---|---|
| _vfxclassname | CToolBar | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
| lsaveposition | .T. | .T. if you want store into VFXRES current ToolBar layout |
| ndocktype | 0 | Save DockPosition before destroy |
LOCAL lfound, thisindexkey, isdescending, ckey, lcalias
IF !THIS.lsaveposition
RETURN .F.
ENDIF
lcalias = ALIAS()
USE vfxres IN 0 ORDER TAG USER AGAIN ALIAS RESOURCE
SELECT RESOURCE
ckey = UPPER( PADR(m.gu_user,32,' ') + PADR(THIS.CAPTION, LEN(RESOURCE.objname)) )
lfound = .F.
IF SEEK(ckey,"RESOURCE","USER") AND !EMPTY(RESOURCE.layout)
LOCAL ndockpos
lfound = .T.
** ToolBar Layout
ndockpos = VAL(SUBSTR(RESOURCE.layout, 1,4))
IF ndockpos = -1
THIS.DOCK(ndockpos)
THIS.TOP = VAL(SUBSTR(RESOURCE.layout, 5,4))
THIS.LEFT = VAL(SUBSTR(RESOURCE.layout, 9,4))
ELSE
THIS.DOCK(ndockpos,VAL(SUBSTR(RESOURCE.layout, 9,4)),VAL(SUBSTR(RESOURCE.layout, 5,4)))
ENDIF
THIS.VISIBLE = RESOURCE.TOOLBAR
ENDIF
USE IN RESOURCE
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
RETURN lfound
LOCAL lcalias, ckey
IF !THIS.lsaveposition
RETURN .F.
ENDIF
lcalias = ALIAS()
USE vfxres IN 0 ORDER TAG USER AGAIN ALIAS RESOURCE
SELECT RESOURCE
ckey = UPPER( PADR(m.gu_user,32,' ') + PADR(THIS.CAPTION, LEN(RESOURCE.objname)) )
IF !SEEK(ckey,"RESOURCE","USER")
INSERT INTO RESOURCE (USER, objname, TOOLBAR, layout) VALUES ;
(UPPER(m.gu_user), UPPER(THIS.CAPTION), THIS.VISIBLE, ;
STR(THIS.ndocktype,4) +;
STR(THIS.TOP ,4) +;
STR(THIS.LEFT ,4))
ELSE
REPLACE RESOURCE.TOOLBAR WITH THIS.VISIBLE, ;
RESOURCE.layout WITH STR(THIS.ndocktype,4) +;
STR(THIS.TOP ,4) +;
STR(THIS.LEFT ,4)
ENDIF
USE IN RESOURCE
IF !EMPTY(lcalias)
SELECT (lcalias)
ENDIF
IF TYPE ("_screen.ActiveForm") = "O"
IF UPPER(_SCREEN.ACTIVEFORM.BASECLASS) == "FORM"
SET MESSAGE TO _SCREEN.ACTIVEFORM.CAPTION
ENDIF
ENDIF
RELEASE THIS
LOCAL j
* Make sure to save the dockposition correct
THIS.ndocktype = THIS.DOCKPOSITION
THIS.saveposition()
IF VARTYPE(goProgram)="O"
goprogram.removetoolbar(THIS.CLASS)
ENDIF
FOR j = 1 TO _SCREEN.FORMCOUNT
IF TYPE("_screen.Forms[j].cToolBarClass")="C"
IF UPPER(_SCREEN.FORMS[j].ctoolbarclass) == UPPER(THIS.CAPTION)
_SCREEN.FORMS[j].lshowtoolbar = .F.
_SCREEN.FORMS[j].otoolbar = .NULL.
ENDIF
ENDIF
NEXT
THIS.langsetup()
IF !THIS.loadposition()
THIS.DOCK(0)
ENDIF
THIS.ndocktype = THIS.DOCKPOSITION