THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Caption | "CBrowseWnd" |
| DoCreate | .T. |
| LockScreen | .F. |
| lautoresizecontrol | .F. |
| Name | Initial value | Comment |
|---|---|---|
| olookup | .NULL. |
IF THIS.olookup.ccolumnlist = '*'
THIS.olookup.setcolumnlist('*')
ENDIF
IF !EMPTY(THIS.olookup.acolumnlist)
LOCAL lcfield
FOR j = 1 TO ALEN(THIS.olookup.acolumnlist,1)
lcfield = THIS.olookup.ccursorname+"."+THIS.olookup.acolumnlist[j,1]
THIS.olookup.acolumnlist[j,2] = EVAL(lcfield)
NEXT
ENDIF
WITH THISFORM.otoolcontrol
.WIDTH = THISFORM.WIDTH
.REFRESH()
ENDWITH
WITH THISFORM.ogrid
.MOVE(.LEFT,.TOP,THISFORM.WIDTH,THISFORM.HEIGHT - .TOP)
ENDWITH
THIS.olookup = .NULL.
RETURN DODEFAULT()
LPARAMETERS tolookup
LOCAL cfieldname, maxfieldno, cfield, ccaption
IF EMPTY(tolookup.cdataform)
THIS.otoolcontrol.cmdedit.ENABLED = .F.
ENDIF
THIS.olookup = tolookup
IF EMPTY(tolookup.getcontrolid())
THISFORM.cformname = THIS.NAME
THISFORM.lsaveposition = .F.
ELSE
THISFORM.cformname = "CBrowseWnd"+tolookup.getcontrolid()
ENDIF
THISFORM.CAPTION = tolookup.settitle()
LOCAL lccolumnlist
lccolumnlist = tolookup.setcolumnlist()
IF !EMPTY(lccolumnlist)
maxfieldno = OCCURS(',',lccolumnlist)+1
ELSE
maxfieldno = FCOUNT()
ENDIF
IF !EMPTY(tolookup.csqlselect)
LOCAL lccommand, lfound
THIS.lworkonview = .T.
IF AT(" into cursor ",LOWER(tolookup.csqlselect)) = 0
lccommand = tolookup.csqlselect + " into cursor " + tolookup.ccursorname
ELSE
lccommand = tolookup.csqlselect
ENDIF
SET MESSAGE TO ''
&lccommand
SET MESSAGE TO ''
SELECT (tolookup.ccursorname)
IF tolookup.ccolumnlist = '*'
tolookup.ctablename = tolookup.ccursorname
tolookup.setcolumnlist(tolookup.ccolumnlist)
tolookup.ctablename = .F.
ENDIF
LOCATE
lfound = !EOF()
IF lfound AND !EMPTY(tolookup.acolumnlist)
LOCAL lcfield
FOR j = 1 TO ALEN(tolookup.acolumnlist,1)
lcfield = tolookup.ccursorname+"."+tolookup.acolumnlist[j,1]
tolookup.acolumnlist[j,2] = EVAL(lcfield)
NEXT
ENDIF
ELSE
USE (tolookup.ctablename) ALIAS (tolookup.ccursorname) SHARED AGAIN
IF !EMPTY(tolookup.ctagname)
SET ORDER TO TAG (tolookup.ctagname)
ENDIF
LOCAL lcfilter
lcfilter = tolookup.setfilter()
IF !EMPTY(lcfilter)
SET FILTER TO &lcfilter
ENDIF
ENDIF
SELECT (tolookup.ccursorname)
WITH THIS.ogrid
.RECORDSOURCE = tolookup.ccursorname
.COLUMNCOUNT = MIN(THIS.ogrid.COLUMNCOUNT, maxfieldno)
.READONLY = .T.
.DELETEMARK = .F.
ENDWITH
FOR j = 1 TO THIS.ogrid.COLUMNCOUNT
IF j <= maxfieldno
ccaption = ""
IF !EMPTY(lccolumnlist)
cfieldname = ALLTRIM(tolookup.acolumnlist[j,1])
THIS.ogrid.COLUMNS[j].CONTROLSOURCE = cfieldname
ELSE
cfieldname = FIELD(j)
ENDIF
THIS.ogrid.COLUMNS[j].ALIGNMENT = 3
IF AT(".",cfieldname) = 0
cfield = ALLTRIM(tolookup.ctablename) +"."+ ALLTRIM(cfieldname)
ENDIF
IF !EMPTY(DBC())
IF INDBC(cfield,"FIELD")
ccaption = DBGETPROP(cfield, "FIELD", "CAPTION")
ENDIF
ENDIF
IF EMPTY(ccaption)
ccaption = PROPER(STRTRAN(cfieldname,'_',' '))
ENDIF
THIS.ogrid.COLUMNS[j].header1.CAPTION = ccaption
LOCAL lnwidth, lcbufferm, lnsize1, lnsize2
lcbuffer = REPLICATE('H',FSIZE(FIELD(j)))
lnsize1 = TXTWIDTH(lcbuffer,'Arial',8,'') * FONTMETRIC(6, 'Arial', 8, '')
lnsize2 = TXTWIDTH(REPLICATE('H',LEN(ccaption)),'Arial',8,'') * FONTMETRIC(6, 'Arial', 8, '')
THIS.ogrid.COLUMNS[j].WIDTH = MAX(lnsize1,lnsize2)
ELSE
THIS.ogrid.COLUMNS[j].VISIBLE = .F.
ENDIF
NEXT
THIS.cworkalias = ALIAS()
RETURN DODEFAULT()
DODEFAULT()
THIS.ogrid.SETFOCUS()
| Baseclass | Class | Object name |
|---|---|---|
| container | ctoolbarcontrol | cbrowsewnd.oToolControl |
| grid | cpickgrid | cbrowsewnd.oGrid |
| zzz | zzz | cbrowsewnd.lblMsgEmpty |
| Name | Initial value |
|---|---|
| BackStyle | 0 |
| ZOrderSet | 0 |
| Baseclass | Class | Object name |
|---|---|---|
| commandbutton | commandbutton | cbrowsewnd.oToolControl.cmdApply |
| cbrowsewnd.oToolControl.cmdClose | ||
| cbrowsewnd.oToolControl.cmdEdit | ||
| zzz | zzz | cbrowsewnd.oToolControl.oBorder |
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\paste.bmp |
| ZOrderSet | 4 |
THISFORM.fetchcolumns()
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\close.bmp |
| ZOrderSet | 2 |
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\wzedit.bmp |
| ZOrderSet | 3 |
THIS.olookup.lrunform = .T.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| ColumnCount | 10 |
| Comment | " |
| Visible | .T. |
| ZOrderSet | 1 |
THISFORM.fetchcolumns()
THIS.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column1.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column1.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column10.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column10.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column2.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column2.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column3.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column3.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column4.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column4.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column5.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column5.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column6.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column6.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column7.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column7.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column8.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column8.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value |
|---|---|
| Visible | .T. |
| Baseclass | Class | Object name |
|---|---|---|
| header | header | cbrowsewnd.oGrid.Column9.Header1 |
| textbox | textbox | cbrowsewnd.oGrid.Column9.Text1 |
| Name | Initial value |
|---|---|
| Caption | "Header1" |
THIS.PARENT.PARENT.onsetorder(THIS.PARENT)
| Name | Initial value |
|---|---|
| BackColor | 255,255,255 |
| BorderStyle | 0 |
| ForeColor | 0,0,0 |
| Margin | 0 |
| Visible | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
THIS.PARENT.PARENT.ocontrol = THIS
IF THIS.PARENT.PARENT.onkeypress( nkeycode, nshiftaltctrl)
NODEFAULT
ENDIF
THISFORM.fetchcolumns()
THIS.PARENT.PARENT.ocontrol = .NULL.
THISFORM.RELEASE()
| Name | Initial value | Comment |
|---|---|---|
| ^aformlist[1,0] | .f. | Internal Form array |
| nformcount | 0 |
LPARAMETERS toformreference, tcformname
** 1. Search if the form reference exist
** 2. Check if the parent form it's me
** 3. If it's not found it will add one.
LOCAL lnformcount, loform, j
tcformname = LOWER(ALLTRIM(tcformname))
loform = .NULL.
lnformcount = THIS.nformcount
IF !ISNULL(toformreference)
loform = THIS.getchild(tcformname)
IF ISNULL(loform)
lnformcount = lnformcount + 1
DIMENSION THIS.aformlist[lnFormCount,2]
THIS.aformlist[lnFormCount,1] = toformreference
THIS.aformlist[lnFormCount,2] = tcformname
THIS.nformcount = lnformcount
ENDIF
ENDIF
RETURN !ISNULL(loform)
LPARAMETERS tcformname
loform = THIS.getchild(tcformname)
RETURN !ISNULL(loform)
RETURN THIS.nformcount
LPARAMETERS tcformname
LOCAL lnformcount, loform, j
tcformname = LOWER(ALLTRIM(tcformname))
loform = .NULL.
lnformcount = THIS.nformcount
FOR j = 1 TO lnformcount
IF THIS.aformlist[j,2] == tcformname
IF !ISNULL(THIS.aformlist[j,1])
loform = THIS.aformlist[j,1]
EXIT
ENDIF
ENDIF
NEXT
RETURN loform
LPARAMETERS tlonlydata
LOCAL lnformcount, loform, j
loform = .NULL.
lnformcount = THIS.nformcount
LOCAL lsetfocus
lsetfocus = .F.
FOR j = 1 TO lnformcount
loform = THIS.aformlist[j,1]
IF TYPE("loForm")="O" AND !ISNULL(loform)
IF pemstatus(loform,'nFormStatus',5)
IF loform.nformstatus != 0
loform.SHOW()
IF loform.recordchanged() OR loform.nformstatus = 2
loform.asktosave(.T.)
ELSE
loform.nformstatus = 0
loform.CAPTION = THISFORM.coldtitle
loform.refreshtoolbar(.T.)
loform.onformstatuschange()
ENDIF
THIS.PARENT.SHOW()
ENDIF
ENDIF
tcformname = THIS.aformlist[j,2]
THIS.PARENT.onsetchilddata(UPPER(tcformname),loform)
IF TYPE("loForm")="O" AND !ISNULL(loform)
lsetfocus = loform.lsetfocus
loform.lsetfocus = .F.
loform.onparentrefresh(tlonlydata)
IF TYPE("loForm")="O" AND !ISNULL(loform)
loform.lsetfocus = lsetfocus
ENDIF
ENDIF
ENDIF
NEXT
LPARAMETERS tcformname
LOCAL loform
loform = THIS.getchild(tcformname)
IF VARTYPE(loForm)="O"
THIS.PARENT.onsetchilddata(tcformname,loform)
*!* Check always if someone has destroyed the Form
IF VARTYPE(loForm)="O"
loform.onparentrefresh()
ENDIF
*!* Check always if someone has destroyed the Form
IF VARTYPE(loForm)="O"
loform.SHOW()
ENDIF
ENDIF
LOCAL lnformcount, loform, j
loform = .NULL.
lnformcount = THIS.nformcount
FOR j = 1 TO lnformcount
loform = THIS.aformlist[j,1]
IF TYPE("loForm")="O" AND !ISNULL(loform)
LOCAL lnform, loobj
FOR lnform = _SCREEN.FORMCOUNT TO 1 STEP - 1
IF TYPE("_screen.Forms[lnForm]")=="O" AND !ISNULL(_SCREEN.FORMS[lnForm])
IF !(UPPER(_SCREEN.FORMS[lnForm].CLASS) $ "CVFXTOOLBAR;MEMO;GENERAL")
IF UPPER(ALLTRIM(loform.NAME)) == UPPER(ALLTRIM(_SCREEN.FORMS[lnForm].NAME))
loobj = loform
IF pemstatus(_SCREEN.FORMS[lnForm],'QueryUnload',5)
IF !_SCREEN.FORMS[lnForm].QUERYUNLOAD()
loobj = .NULL.
ENDIF
ENDIF
IF !ISNULL(loobj)
THIS.aformlist[j,1] = .NULL.
loform = .NULL.
loobj.RELEASE()
loobj = .NULL.
ENDIF
EXIT
ENDIF
ENDIF
ENDIF
NEXT
ENDIF
NEXT
| Name | Initial value |
|---|---|
| _vfxclassname | CChildGrid |
| Name | Initial value | Comment |
|---|---|---|
| cfixcolumnlist | .f. | column list that must be always readonly: example: "1;3;5" |
| lcanupdate | .T. | you can use ^ins and ^canc |
| lediting | .T. | you can edit grid's cells |
LOCAL lok,llAllowDeleteChilddata
lok = .F.
llAllowDeleteChilddata=.F.
CLEAR TYPEA
IF VARTYPE(goprogram)="O"
IF goprogram.lAllowDeleteChilddata
llAllowDeleteChilddata=.T.
ENDIF
ENDIF
IF !THISFORM.lcandelete AND !llAllowDeleteChilddata
=MESSAGEBOX(msg_cant_delete,0+48,_SCREEN.CAPTION)
RETURN lok
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CChildGrid_OnDelete",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
SELECT (THIS.RECORDSOURCE)
IF THIS.onpredelete()
THIS.savestatus()
DELETE
IF THIS.onpostdelete()
lok = .T.
*-- If record is inserted and then deleted remove from buffer
IF DELETED() AND RECNO() < 0
* = TABLEREVERT( .F. )
ELSE
IF DELETED() OR EOF()
LOCATE
ELSE
SKIP +1
ENDIF
ENDIF
ELSE
* = TABLEREVERT(.F.)
ENDIF
THIS.restorestatus()
THIS.REFRESH()
ELSE
=MESSAGEBOX(msg_not_deleted,0+48,msg_attention)
ENDIF
RETURN lok
LOCAL lok
lok = .F.
CLEAR TYPEA
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CChildGrid_OnInsert",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
SELECT (THIS.RECORDSOURCE)
IF pemstatus(THISFORM,"OnSaveChildData", 5)
THISFORM.onsavechilddata()
ENDIF
IF THIS.onpreinsert()
APPEND BLANK
THIS.onpostinsert()
lok = .T.
ENDIF
CLEAR TYPEA
RETURN lok
LOCAL locolumn, lcname, locontrol
IF THIS.ACTIVECOLUMN = 0
RETURN .F.
ENDIF
locolumn = THIS.COLUMNS[this.ActiveColumn]
lcname = locolumn.CURRENTCONTROL
locontrol = EVAL("loColumn."+lcname)
IF pemstatus(locontrol,"SetFocus",5)
locontrol.SETFOCUS()
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CChildGrid_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 tocolumn, tlfromkey, tlmultisort
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CChildGrid_OnSetOrder",THIS,THISFORM)
DO CASE
CASE VARTYPE(luhookvalue)="L"
IF !luhookvalue
RETURN .T.
ENDIF
CASE VARTYPE(luhookvalue)="N"
RETURN luhookvalue=0
ENDCASE
ENDIF
ENDIF
RETURN DODEFAULT(tocolumn, tlfromkey, tlmultisort)
DODEFAULT()
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CChildGrid_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.lediting
THIS.READONLY = !THISFORM.lautoedit AND THISFORM.nformstatus=0
THIS.SETALL('ReadOnly',THIS.READONLY,'Column')
IF !EMPTY(THIS.cfixcolumnlist)
LOCAL lncol, lnitem, lnmaxlist, lcbuffer
lcbuffer = THIS.cfixcolumnlist
lnmaxlist = getargcount(lcbuffer)
FOR lnitem = 1 TO lnmaxlist
lncol = VAL(getarg(lcbuffer,lnitem))
IF lncol > 0 AND lncol <= THIS.COLUMNCOUNT
THIS.COLUMNS[lnCol].READONLY = .T.
ENDIF
NEXT
ENDIF
ELSE
THIS.READONLY = .T.
ENDIF
DODEFAULT()
THIS.READONLY = !THISFORM.lautoedit
IF TYPE("this.cFixColumnList") = "N"
THIS.cfixcolumnlist = ALLTRIM(STR(THIS.cfixcolumnlist))
ENDIF
IF TYPE("this.cFixColumnList") # "C"
THIS.cfixcolumnlist = ""
ENDIF
IF TYPE("thisForm")=="O"
IF EMPTY(THIS.LINKMASTER)
THIS.LINKMASTER = THISFORM.cworkalias
ENDIF
IF THIS.lcanupdate AND !EMPTY(THIS.RECORDSOURCE)
=CURSORSETPROP('Buffering',5,THIS.RECORDSOURCE)
ENDIF
IF pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CChildGrid_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 pemstatus(THISFORM,"lUseHook",5)
IF THISFORM.lusehook
LOCAL luhookvalue
luhookvalue = THISFORM.oneventhook("CChildGrid_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("this.parent.parent") = "O" AND !ISNULL(THIS.PARENT.PARENT) ;
AND LOWER(THIS.PARENT.PARENT.NAME) = "pgfchildgrid"
IF TYPE("thisForm.oChildGrid")#"U"
IF !THISFORM.lcanedit
THIS.lcanupdate = .F.
ENDIF
THISFORM.ochildgrid = THIS
ENDIF
THIS.nrecno = RECNO(THIS.RECORDSOURCE)
ENDIF
LOCAL latable[1], j
=AUSED(latable)
FOR j = 1 TO ALEN(latable,1)
IF CURSORGETPROP('Buffering',latable[j,1]) != 1
IF RECNO(latable[j,1]) != 0
=TABLEREVERT(.T.,latable[j,1])
ENDIF
ENDIF
NEXT
LPARAMETER tnmessagetype
LOCAL lok, lnfield, lcfield, luoldval, lucurval, lunewval, lufield,;
lchanged, lcalias, lnchoice
LOCAL llins_usr, llins_date, lledt_usr, lledt_date,;
lcins_usr, lcins_date, lcedt_usr, lcedt_date
IF TYPE("tnMessageType") # "N"
tnmessagetype = 0
ENDIF
IF CURSORGETPROP('Buffering',ALIAS()) = 1 && No Buffering Mode
RETURN .T.
ENDIF
lnchoice = 0
lok = .T.
lconflict = .F.
llins_usr = .F.
llins_date = .F.
lledt_usr = .F.
lledt_date = .F.
lcins_usr = ''
lcins_date = ''
lcedt_usr = ''
lcedt_date = ''
lchanged = THIS.modified()
IF TYPE("goProgram")=="O"
lcins_usr = UPPER(ALLTRIM(goprogram.cins_usr ))
lcins_date = UPPER(ALLTRIM(goprogram.cins_date))
lcedt_usr = UPPER(ALLTRIM(goprogram.cedt_usr ))
lcedt_date = UPPER(ALLTRIM(goprogram.cedt_date))
ENDIF
IF lchanged
FOR lnfield = 1 TO FCOUNT()
lcfield = FIELD(lnfield)
IF TYPE(lcfield)="G"
LOOP
ENDIF
IF lcfield == lcins_usr
llins_usr=.T.
ENDIF
IF lcfield == lcins_date
llins_date=.T.
ENDIF
IF lcfield == lcedt_usr
lledt_usr=.T.
ENDIF
IF lcfield == lcedt_date
lledt_date=.T.
ENDIF
luoldval = OLDVAL(lcfield)
lucurval = CURVAL(lcfield)
lunewval = EVAL(lcfield)
lnchoice = 0
IF tnmessagetype = 0
IF luoldval != lucurval
IF GETFLDSTATE(lcfield) = 1
REPLACE &lcfield WITH CURVAL(lcfield)
ELSE
lconflict = .T.
ENDIF
ENDIF
ELSE
IF luoldval != lucurval
lconflict = .T.
lnchoice =MESSAGEBOX(msg_user_changed_data,3+64,cap_lblfield + ": " + lcfield)
ENDIF
ENDIF
DO CASE
CASE lnchoice = 7 && Don't save changes
REPLACE (lcfield) WITH lucurval
CASE lnchoice = 2 && Restore old values
REPLACE (lcfield) WITH luoldval
ENDCASE
NEXT
* save username
IF THISFORM.nformstatus=1 && insert
IF lledt_usr
REPLACE (goprogram.cedt_usr) WITH gu_user
ENDIF
IF lledt_date
DO CASE
CASE TYPE(goprogram.cedt_date)="D"
REPLACE (goprogram.cedt_date) WITH DATE()
CASE TYPE(goprogram.cedt_date)="T"
REPLACE (goprogram.cedt_date) WITH DATETIME()
OTHERWISE
REPLACE (goprogram.cedt_date) WITH DTOC(DATE())+TIME()
ENDCASE
ENDIF
ENDIF
IF THISFORM.nformstatus=2 && insert
IF llins_usr
REPLACE (goprogram.cins_usr) WITH gu_user
ENDIF
IF llins_date
DO CASE
CASE TYPE(goprogram.cins_date)="D"
REPLACE (goprogram.cins_date) WITH DATE()
CASE TYPE(goprogram.cins_date)="T"
REPLACE (goprogram.cins_date) WITH DATETIME()
OTHERWISE
REPLACE (goprogram.cins_date) WITH DTOC(DATE())+TIME()
ENDCASE
ENDIF
ENDIF
IF !lconflict
* No conclicts recognizable if working with local or remote viewa.
IF INLIST(CURSORGETPROP("SourceType"),1,2) && Remote View or Local View
lok = TABLEUPDATE(.F.,.F.) && Can we update this record?
IF !lok
IF tnmessagetype = 0
lnchoice = MESSAGEBOX(msg_update_conflict + "! " + cap_cmdretry + "?",mb_yesno+mb_iconexclamation+mb_defbutton2,msg_attention)
IF lnchoice = 6
lok = TABLEUPDATE(.F.,.T.) && Force update only this one record!
ELSE
lok = .F.
ENDIF
ELSE
lok = TABLEUPDATE(.F.,.T.) && Force update only this one record!
ENDIF
ENDIF
ELSE
lok = TABLEUPDATE(.F.,.T.) && Force update only this one record!
ENDIF
ELSE
IF tnmessagetype = 0
lnchoice = MESSAGEBOX(msg_user_changed_data,mb_yesno+mb_iconexclamation+mb_defbutton2,msg_attention)
IF lnchoice = 6
lok = TABLEUPDATE(.F.,.T.) && Force update only this one record!
ELSE
lok = .F.
ENDIF
ELSE
lok = TABLEUPDATE(.F.,.T.) && Force update only this one record!
ENDIF
ENDIF
ENDIF
IF m.lok
FLUSH
ENDIF
RETURN lok
LOCAL lcalias
lcalias = ALIAS()
IF !EMPTY(THIS.caliasname)
SELECT (THIS.caliasname)
ENDIF
lctag = TAG()
IF !EMPTY(FILTER()) AND !EMPTY(lctag)
LOCAL ldescending
ldescending = DESCENDING()
IF ldescending
SET ORDER TO TAG (lctag) ASCENDING
ELSE
SET ORDER TO TAG (lctag) DESCENDING
ENDIF
LOCATE REST
CONTINUE
IF ldescending
SET ORDER TO TAG (lctag) DESCENDING
ELSE
SET ORDER TO TAG (lctag) ASCENDING
ENDIF
IF EOF()
LOCATE
ENDIF
ELSE
SKIP -1
IF BOF()
LOCATE
ENDIF
ENDIF
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
LOCAL lcalias
lcalias = ALIAS()
IF !EMPTY(THIS.caliasname)
SELECT (THIS.caliasname)
ENDIF
IF !EMPTY(FILTER())
LOCATE REST
CONTINUE
ELSE
IF !EOF()
SKIP + 1
ENDIF
ENDIF
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
LOCAL lcalias
lcalias = ALIAS()
IF !EMPTY(THIS.caliasname)
SELECT (THIS.caliasname)
ENDIF
IF !EMPTY(FILTER())
LOCATE
ELSE
GO TOP
ENDIF
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
LOCAL lcalias
lcalias = ALIAS()
IF !EMPTY(THIS.caliasname)
SELECT (THIS.caliasname)
ENDIF
lctag = TAG()
IF !EMPTY(FILTER()) AND !EMPTY(lctag)
LOCAL ldescending
ldescending = DESCENDING()
IF ldescending
SET ORDER TO TAG (lctag) ASCENDING
ELSE
SET ORDER TO TAG (lctag) DESCENDING
ENDIF
LOCATE
IF ldescending
SET ORDER TO TAG (lctag) DESCENDING
ELSE
SET ORDER TO TAG (lctag) ASCENDING
ENDIF
ELSE
GO BOTTOM
ENDIF
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
LOCAL lcalias
lcalias = ALIAS()
IF !EMPTY(THIS.caliasname)
SELECT (THIS.caliasname)
ENDIF
APPEND BLANK
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
LOCAL lcalias, lok, lcerror
lcalias = ALIAS()
IF !EMPTY(THIS.caliasname)
SELECT (THIS.caliasname)
ENDIF
lcerror = ON('error')
_vfx_error = .F.
ON ERROR _vfx_error = .T.
IF VARTYPE(goProgram)="O" AND goprogram.ldebugmode
SET ESCAPE ON
ON SHUTDOWN
ON ERROR
ENDIF
DELETE
lok = !_vfx_error
ON ERROR &lcerror
RELEASE _vfx_error
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
RETURN lok
LOCAL latables[1], j, lchanged, lcstatus, lcalias
lcalias = ALIAS()
IF TYPE("thisForm.ActiveControl")="O"
THISFORM.ACTIVECONTROL.SETFOCUS()
ENDIF
*!* First check the Main Tables, then the others
=AUSED(latables)
SELECT(THIS.caliasname)
lchanged = .F.
DO CASE
CASE INLIST(CURSORGETPROP('Buffering'),2,3) && Row
lcstatus = GETFLDSTATE(-1)
IF '2' $ lcstatus OR '3' $ lcstatus OR '4' $ lcstatus
lchanged = .T.
ELSE
lchanged = .F.
ENDIF
CASE INLIST(CURSORGETPROP('Buffering'),4,5) && Table
lchanged = (GETNEXTMODIFIED(0) # 0)
OTHERWISE
lchanged = .T.
ENDCASE
IF !lchanged
*!* Now check the other tables
FOR j = 1 TO ALEN(latables,1)
IF !(LOWER(latables[j,1]) == LOWER(ALLTRIM(THIS.caliasname)))
SELECT(latables[j,1])
DO CASE
CASE INLIST(CURSORGETPROP('Buffering'),2,3) && Row
lcstatus = GETFLDSTATE(-1)
IF '2' $ lcstatus OR '3' $ lcstatus OR '4' $ lcstatus
lchanged = .T.
ENDIF
CASE INLIST(CURSORGETPROP('Buffering'),4,5) && Table
lchanged = (GETNEXTMODIFIED(0) # 0)
ENDCASE
ENDIF
IF lchanged
*!* Stop when found the first changed table
EXIT
ENDIF
NEXT
ENDIF
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
RETURN lchanged
LPARAMETERS tlalltables, toparentform, tlvalid
LOCAL lcommit, lnrecord, lcalias, latable[1], j, lcstatus, lcerror, laerror[7]
lcalias = ALIAS()
IF !EMPTY(THIS.caliasname)
SELECT (THIS.caliasname)
ENDIF
lcommit = .T.
IF tlalltables
=AUSED(latable)
ELSE
DIMENSION latable[1,2]
latable[1,1] = ALIAS()
latable[1,2] = ''
ENDIF
** Update Main Table
lcerror = ON('error')
PUBLIC _vfx_save_error
_vfx_save_error = .F.
ON ERROR _vfx_save_error = .T.
IF TYPE("goProgram")=="O" AND goprogram.ldebugmode
SET ESCAPE ON
ON SHUTDOWN
ON ERROR
ENDIF
SELECT(THIS.caliasname)
LOCAL lncursormode
lncursormode = CURSORGETPROP('Buffering')
lcommit = .T.
DO CASE
CASE INLIST(lncursormode,2,3) && Row Buffering
lcstatus = GETFLDSTATE(-1)
IF AT('2',lcstatus) != 0 OR AT('3',lcstatus) != 0 OR AT('4',lcstatus) != 0
lcommit = THIS.UPDATE()
ENDIF
CASE INLIST(lncursormode,4,5) && Table Buffering
lnrecord = GETNEXTMODIFIED(0)
DO WHILE lnrecord != 0 AND lcommit AND !_vfx_save_error
GO lnrecord
lcommit = THIS.UPDATE()
lnrecord = GETNEXTMODIFIED(lnrecord)
ENDDO
ENDCASE
IF _vfx_save_error
lcommit = .F.
_vfx_save_error = .F.
THIS.ERROR()
EXIT && Stop to save other tables
ENDIF
IF lcommit
** Update all others tables
FOR j = 1 TO ALEN(latable,1)
_vfx_save_error = .F.
IF !(LOWER(latable[j,1]) == LOWER(ALLTRIM(THIS.caliasname)))
SELECT(latable[j,1])
lncursormode = CURSORGETPROP('Buffering')
DO CASE
CASE INLIST(lncursormode,2,3) && Row Buffering
lcstatus = GETFLDSTATE(-1)
IF AT('2',lcstatus) != 0 OR AT('3',lcstatus) != 0 OR AT('4',lcstatus) != 0
lcommit = THIS.UPDATE()
ENDIF
CASE INLIST(lncursormode,4,5) && Table Buffering
lnrecord = GETNEXTMODIFIED(0)
DO WHILE lnrecord != 0 AND lcommit AND !_vfx_save_error
GO lnrecord
lcommit = THIS.UPDATE()
lnrecord = GETNEXTMODIFIED(lnrecord)
ENDDO
ENDCASE
ENDIF
IF _vfx_save_error
lcommit = .F.
_vfx_save_error = .F.
THIS.ERROR()
EXIT && Stop to save other tables
ENDIF
NEXT
ELSE
IF PARAMETERS() = 3
toparentform.REFRESH()
tlvalid = .F.
ENDIF
ENDIF
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
ON ERROR &lcerror
_vfx_save_error = .F.
RELEASE _vfx_save_error
RETURN lcommit
| Name | Initial value | Comment |
|---|---|---|
| ^acontrolsource[1,0] | .f. | |
| ctablelist | ||
| nlistcount | 0 |
LPARAMETERS tccontrolsource, tccaption
THIS.nlistcount = THIS.nlistcount + 1
DIMENSION THIS.acontrolsource[this.nListCount,2]
THIS.acontrolsource[this.nListCount,1] = tccontrolsource
THIS.acontrolsource[this.nListCount,2] = tccaption
LOCAL lctable
lctable = ALLTRIM(LOWER(LEFT(tccontrolsource,AT('.',tccontrolsource)-1)))
IF AT(lctable,THIS.ctablelist) = 0
IF !EMPTY(THIS.ctablelist)
THIS.ctablelist = THIS.ctablelist + ";"
ENDIF
THIS.ctablelist = THIS.ctablelist + LOWER(ALLTRIM(lctable))
ENDIF
RETURN THIS.ctablelist
LPARAMETERS tnindex
IF tnindex < 1
tnindex = 1
ENDIF
IF THIS.nlistcount > 0 AND tnindex <= THIS.nlistcount
RETURN THIS.acontrolsource[tnIndex,1]
ENDIF
RETURN ''
LPARAMETERS tnindex
IF tnindex < 1
tnindex = 1
ENDIF
IF THIS.nlistcount > 0 AND tnindex <= THIS.nlistcount
RETURN THIS.acontrolsource[tnIndex,2]
ENDIF
RETURN ''
| Name | Initial value |
|---|---|
| BorderWidth | 0 |
| Name | Initial value | Comment |
|---|---|---|
| ctitle | Completed | Title of the gauge |
| lpercentshow | .T. | .t. if you wish to have a display in % |
| lusesyscolor | .T. | Specifies if the System Color will be used |
| nmaxvalue | 100 | Specifies the maximum value |
| nvalue | .f. | Specifies the current value |
RELEASE THIS
LPARAMETERS tnmaxvalue
LOCAL j
FOR j = 1 TO 20
THIS.CONTROLS[j+4].VISIBLE = .F. && Shape control!
NEXT
THIS.nmaxvalue = tnmaxvalue
LPARAMETERS tctitle
IF TYPE("tcTitle")="C"
THIS.ctitle = ALLTRIM(tctitle)
THIS.REFRESH()
ENDIF
LPARAMETERS tnvalue
IF tnvalue >= THIS.nmaxvalue
tnvalue = THIS.nmaxvalue
ENDIF
THIS.nvalue = tnvalue
THIS.REFRESH()
LPARAMETERS tnmaxvalue, tctitle
IF !EMPTY(tnmaxvalue)
THIS.setmaxvalue(tnmaxvalue)
ENDIF
IF !EMPTY(tctitle)
THIS.settext(tctitle)
ENDIF
LOCAL lnbackcolor, lnforecolor
DECLARE INTEGER GetSysColor IN Win32API INTEGER nColorIndex
lnbackcolor = getsyscolor(5)
IF THIS.lusesyscolor
THIS.BACKCOLOR = lnbackcolor
THIS.FORECOLOR = getsyscolor(8)
THIS.lbltext.BACKCOLOR = lnbackcolor
THIS.lbltext.FORECOLOR = getsyscolor(8)
ENDIF
THIS.setvalue(0)
LOCAL lnvalue, lnshape, j
lnshape = INT(20*THIS.nvalue/THIS.nmaxvalue)
IF lnshape = 0
lnshape = 1
ENDIF
lnvalue = INT(100*THIS.nvalue/THIS.nmaxvalue)
IF lnvalue = 0
lnvalue = 1
ENDIF
FOR j = 1 TO lnshape
THIS.CONTROLS[j+4].VISIBLE = .T. && Shape control!
NEXT
IF THIS.lpercentshow
THIS.lbltext.CAPTION = STR(lnvalue,3)+"% " + THIS.ctitle
ELSE
THIS.lbltext.CAPTION = THIS.ctitle
ENDIF
| Baseclass | Class | Object name |
|---|---|---|
| label | label | cgauge.lblText |
| line | line | cgauge.LineDown |
| cgauge.LineLeft | ||
| cgauge.LineRight | ||
| cgauge.lineUp | ||
| shape | shape | cgauge.Shape1 |
| cgauge.Shape10 | ||
| cgauge.Shape11 | ||
| cgauge.Shape12 | ||
| cgauge.Shape13 | ||
| cgauge.Shape14 | ||
| cgauge.Shape15 | ||
| cgauge.Shape16 | ||
| cgauge.Shape17 | ||
| cgauge.Shape18 | ||
| cgauge.Shape19 | ||
| cgauge.Shape2 | ||
| cgauge.Shape20 | ||
| cgauge.Shape3 | ||
| cgauge.Shape4 | ||
| cgauge.Shape5 | ||
| cgauge.Shape6 | ||
| cgauge.Shape7 | ||
| cgauge.Shape8 | ||
| cgauge.Shape9 |
| Name | Initial value |
|---|---|
| Alignment | 2 |
| BackStyle | 0 |
| Caption | " 0%" |
| FontBold | .F. |
| FontSize | 8 |
| Name | Initial value |
|---|---|
| BorderColor | 255,255,255 |
| BorderWidth | 1 |
| Name | Initial value |
|---|---|
| BorderColor | 128,128,128 |
| Name | Initial value |
|---|---|
| BorderColor | 255,255,255 |
| Name | Initial value |
|---|---|
| BorderColor | 128,128,128 |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value |
|---|---|
| BackColor | 0,0,128 |
| BorderStyle | 0 |
| Visible | .F. |
| Name | Initial value | Comment |
|---|---|---|
| ^aindexlist[1,0] | .f. | |
| ^ataglist[1,0] | .f. | |
| nindexcount | 0 | Internal Use |
| ntagcount | 0 |
LPARAMETERS tctagname, tcalias
LOCAL lcindexfile, lnindexcount
IF EMPTY(tcalias)
tcalias = ALIAS()
ENDIF
lcindexfile = UPPER(tctagname)+".IDX"
lnindexcount = THIS.nindexcount
lnindexcount = lnindexcount + 1
DIMENSION THIS.aindexlist[lnIndexCount,3]
THIS.aindexlist[lnIndexCount,1] = tctagname
THIS.aindexlist[lnIndexCount,2] = tcalias
THIS.aindexlist[lnIndexCount,3] = lcindexfile
THIS.nindexcount = lnindexcount
LOCAL j, lnindexcount
lnindexcount = THIS.nindexcount
FOR j = 1 TO lnindexcount
IF FILE(THIS.aindexlist[j,3])
SELECT (THIS.aindexlist[j,2])
CLOSE INDEX
ERASE (THIS.aindexlist[j,3])
ENDIF
NEXT
THIS.nindexcount = 0
LOCAL latables[1], k,j, lcindex, lnindexcount
lnindexcount = 0
=AUSED(latables)
FOR j = 1 TO ALEN(latables,1)
SELECT (latables[j,1])
lcindex = TAG()+".IDX"
IF !FILE(lcindex)
lnindexcount = lnindexcount + 1
DIMENSION THIS.ataglist[lnIndexCount,2]
THIS.ataglist[lnIndexCount,1] = TAG()
THIS.ataglist[lnIndexCount,2] = ALIAS()
ENDIF
NEXT
THIS.ntagcount = lnindexcount
LOCAL lcalias
lcalias = ALIAS()
FOR j = 1 TO THIS.ntagcount
IF USED(THIS.ataglist[j,2])
SELECT(THIS.ataglist[j,2])
SET ORDER TO TAG (THIS.ataglist[j,1])
ENDIF
NEXT
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
| Name | Initial value | Comment |
|---|---|---|
| ^acolumnlist[1,0] | .f. | |
| _vfxclassname | CLookUp | |
| cbrowseclass | CBrowseWnd | |
| ccolumnlist | * | |
| ccontrolid | .f. | |
| ccursorname | .f. | |
| cdataform | .f. | |
| cfilterexpr | .f. | |
| csearchexpr | .f. | |
| csearchvalue | .f. | |
| csqlselect | .f. | |
| ctablename | .f. | |
| ctagname | .f. | |
| ctitle | "Select a value ..." | |
| fetchcolumns | .f. | |
| lrunform | .f. | Specifies if the Data Form must be called |
| lupdated | .f. | Specifies if the data is been updated |
LPARAMETERS tccolumnlist
IF PARAMETERS() = 0
RETURN THIS.ccolumnlist
ENDIF
LOCAL lcbuffer, j
THIS.ccolumnlist = tccolumnlist
IF tccolumnlist = '*'
LOCAL lcalias, lafield[1]
lcalias = ALIAS()
IF !EMPTY(THIS.ctablename)
IF !USED(THIS.ccursorname)
USE (THIS.ctablename) IN 0 ALIAS (THIS.ccursorname) SHARED AGAIN
ENDIF
SELECT (THIS.ccursorname)
=AFIELDS(lafield)
THIS.ccolumnlist = ''
FOR j = 1 TO ALEN(lafield,1)
DIMENSION THIS.acolumnlist[j,2]
THIS.acolumnlist[j,1] = lafield[j,1]
THIS.acolumnlist[j,2] = .F.
IF !EMPTY(THIS.ccolumnlist)
THIS.ccolumnlist = THIS.ccolumnlist + ","
ENDIF
THIS.ccolumnlist = THIS.ccolumnlist + lafield[j,1]
NEXT
ENDIF
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
RETURN .T.
ENDIF
lcbuffer = STRTRAN(tccolumnlist,',',CHR(13))
FOR j = 1 TO MEMLINES(lcbuffer)
DIMENSION THIS.acolumnlist[j,2]
THIS.acolumnlist[j,1] = UPPER(ALLTRIM(MLINE(lcbuffer,j)))
THIS.acolumnlist[j,2] = .F.
NEXT
LPARAMETERS tctable, tctag
IF PARAMETERS() = 0
RETURN THIS.ctablename
ENDIF
THIS.ctablename = ALLTRIM(UPPER(tctable))
IF !EMPTY(tctag)
THIS.ctagname = ALLTRIM(UPPER(tctag))
ENDIF
LPARAMETERS tuvalue
LOCAL lcalias, lfound
lcalias = ALIAS()
IF !EMPTY(tuvalue)
THIS.csearchvalue = tuvalue
ENDIF
IF EMPTY(THIS.csqlselect)
** Use Tables
IF EMPTY(THIS.ctagname)
WAIT WINDOW "CLookUp::Valid() - No Index Expression"
RETURN .F.
ENDIF
IF !USED(THIS.ccursorname)
USE (THIS.ctablename) IN 0 ALIAS (THIS.ccursorname) SHARED AGAIN
ENDIF
lfound = SEEK(THIS.csearchvalue,THIS.ccursorname,THIS.ctagname)
IF lfound
THIS.fetchallcolumns()
ENDIF
ELSE
** Use the SELECT command
lfound = THIS.sqlexec()
ENDIF
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
RETURN lfound
THIS.lrunform = .F.
IF THIS.ccolumnlist = "*"
THIS.setcolumnlist(THIS.ccolumnlist)
ENDIF
IF !EMPTY(THIS.cbrowseclass)
LOCAL loform
loform = CREATEOBJECT(THIS.cbrowseclass, THIS)
IF TYPE("loForm") != "O"
WAIT WINDOW "CLookUp::Browse - Error creating object. " + CHR(13) +;
"class '" + THIS.cbrowseclass + "' not found"
ELSE
loform.SHOW(1)
ENDIF
ENDIF
IF THIS.lrunform
THIS.runform()
ENDIF
LPARAMETERS tccolumnname
IF EMPTY(tccolumnname)
WAIT WINDOW "CLookUp::FetchColumn - Syntax Error"
RETURN .F.
ENDIF
tccolumnname = UPPER(ALLTRIM(tccolumnname))
LOCAL lnindex, luretvalue
luretvalue = .F.
lnindex = ASCAN(THIS.acolumnlist,tccolumnname)
IF lnindex != 0
lnindex = ASUBSCRIPT(THIS.acolumnlist,lnindex,1)
luretvalue = THIS.acolumnlist[lnIndex,2]
ELSE
WAIT WINDOW "Field: '" + tccolumnname + "' not found" TIMEOUT 3
ENDIF
RETURN luretvalue
LPARAMETERS tuvalue
THIS.csearchvalue = tuvalue
LOCAL lccommand, lfound
IF EMPTY(THIS.csqlselect)
RETURN .F.
ENDIF
LOCAL lcalias, lfound
lcalias = ALIAS()
IF AT(" into cursor ",LOWER(THIS.csqlselect)) = 0
lccommand = THIS.csqlselect + " into cursor " + THIS.ccursorname
ELSE
lccommand = THIS.csqlselect
ENDIF
SET MESSAGE TO ''
&lccommand
SET MESSAGE TO ''
SELECT (THIS.ccursorname)
lfound = .F.
IF THIS.ccolumnlist = '*'
THIS.ctablename = THIS.ccursorname
THIS.setcolumnlist(THIS.ccolumnlist)
THIS.ctablename = .F.
ENDIF
LOCATE
lfound = !EOF()
IF lfound
THIS.fetchallcolumns()
ENDIF
IF !EMPTY(lcalias)
SELECT(lcalias)
ENDIF
RETURN lfound
LPARAMETERS tcsqlcommand
IF EMPTY(tcsqlcommand)
RETURN .F.
ENDIF
THIS.csqlselect = tcsqlcommand
tcsqlcommand = LOWER(ALLTRIM(tcsqlcommand))
IF AT("select ", tcsqlcommand) = 0
RETURN .F.
ENDIF
lcfieldlist = SUBSTR(tcsqlcommand,7)
lcfieldlist = ALLTRIM(LEFT(lcfieldlist,AT(" from",lcfieldlist)))
THIS.setcolumnlist(lcfieldlist)
LPARAMETERS tcfilter
IF PARAMETERS() = 0
RETURN THIS.cfilterexpr
ELSE
THIS.cfilterexpr = tcfilter
ENDIF
IF EMPTY(THIS.ccontrolid)
IF !EMPTY(THIS.ctablename)
THIS.ccontrolid = THIS.ctablename
ENDIF
ENDIF
RETURN THIS.ccontrolid
IF THIS.ccolumnlist = '*'
THIS.setcolumnlist(THIS.ccolumnlist)
ENDIF
IF !EMPTY(THIS.acolumnlist)
LOCAL lcfield
FOR j = 1 TO ALEN(THIS.acolumnlist,1)
lcfield = THIS.ccursorname+"."+THIS.acolumnlist[j,1]
THIS.acolumnlist[j,2] = EVAL(lcfield)
NEXT
ENDIF
LOCAL lcretval
IF !EMPTY(THIS.cdataform)
IF TYPE("__VFX_PickField")=="O"
RELEASE __vfx_pickfield
ENDIF
PUBLIC __vfx_pickfield
__vfx_pickfield = THIS
IF TYPE("__VFX_pickRecLoc") != 'U'
RELEASE __vfx_pickrecloc
ENDIF
IF TYPE("__VFX_PickTagName") != 'U'
RELEASE __vfx_picktagname
ENDIF
IF !EMPTY(THIS.csearchvalue)
PUBLIC __vfx_pickrecloc
__vfx_pickrecloc = THIS.csearchvalue
ELSE
IF TYPE("__VFX_PickRecLoc") != "U"
RELEASE __vfx_pickrecloc
ENDIF
ENDIF
IF !EMPTY(THIS.ctagname)
PUBLIC __vfx_picktagname
__vfx_picktagname = THIS.ctagname
ENDIF
THIS.lupdated = .F.
DO FORM (THIS.cdataform)
__vfx_pickfield = .NULL.
RELEASE __vfx_pickfield
IF TYPE("__VFX_PickTagName") != 'U'
RELEASE __vfx_picktagname
ENDIF
RELEASE __vfx_pickrecloc
ENDIF
LPARAMETERS tctitle
IF PARAMETERS() = 0
RETURN THIS.ctitle
ELSE
THIS.ctitle = UPPER(ALLTRIM(tctitle))
ENDIF
LPARAMETERS tcdataform
IF PARAMETERS() == 0
RETURN THIS.cdataform
ELSE
THIS.cdataform = UPPER(ALLTRIM(tcdataform))
ENDIF
LPARAMETERS tccursorname
IF PARAMETERS() = 0
RETURN THIS.ccursorname
ELSE
IF !EMPTY(tccursorname)
THIS.ccursorname = ALLTRIM(UPPER(tccursorname))
ENDIF
ENDIF
LPARAMETERS tcsearchexpr
THIS.csearchexpr = ALLTRIM(UPPER(tcsearchexpr))
IF USED(THIS.ccursorname)
USE IN (THIS.ccursorname)
ENDIF
LPARAMETERS tusearchvalue, tctablename, tctagname
THIS.ccursorname = "X"+SUBSTR(SYS(2015),4,7)
IF PARAMETERS() != 0
THIS.csearchvalue = tusearchvalue
THIS.ctablename = tctablename
THIS.ctagname = tctagname
ENDIF
| Name | Initial value |
|---|---|
| BackStyle | 0 |
| BorderWidth | 0 |
| Name | Initial value | Comment |
|---|---|---|
| ^list[1,1] | .f. | a character string array used to access the items in a combobox or listbox control. |
| lcformclass | .f. | |
| listindex | 0 | index of selected item into original array |
| ncoltocheck | 0 | describes which column will be used to check for uniqueness |
| ncoltoview | 0 | column of array to display |
| nmaxcol | 0 | number of columns |
| nmaxrow | 0 | number of items |
| sourcelistindex | 0 |
DIMENSION THIS.LIST[1,1]
THIS.LIST[1,1] = .F.
THIS.lstsource.CLEAR()
THIS.lstselected.CLEAR()
THIS.nmaxrow = 0
THIS.nmaxcol = 0
THIS.LISTINDEX = 0
THIS.cmdadd.ENABLED = .F.
THIS.cmdaddall.ENABLED = .F.
THIS.cmdremove.ENABLED = .F.
THIS.cmdremoveall.ENABLED = .F.
LPARAMETERS taselected
LOCAL lnsize, lnitem , lnitemid, j
IF THIS.lstselected.LISTCOUNT = 0
RETURN .F.
ENDIF
lnsize = THIS.lstselected.LISTCOUNT
IF THIS.nmaxcol > 0
DIMENSION taselected[lnSize,this.nMaxCol]
ELSE
DIMENSION taselected[lnSize]
ENDIF
FOR lnitem = 1 TO lnsize
lnitemid = THIS.lstselected.INDEXTOITEMID(lnitem)
IF THIS.nmaxcol > 0
FOR j = 1 TO THIS.nmaxcol
taselected[lnItem,j] = THIS.LIST[lnItemId,j]
NEXT
ELSE
taselected[lnItem] = THIS.LIST[lnItemId]
ENDIF
NEXT
RETURN .T.
LPARAMETERS tasource, taselected
LOCAL lnitem, lcexact
lcexact = SET('exact')
SET EXACT ON
THIS.nmaxrow = ALEN(tasource,1)
THIS.nmaxcol = ALEN(tasource,2)
IF THIS.ncoltoview = 0
THIS.ncoltoview = 1
ENDIF
DIMENSION THIS.LIST[1,1]
= ACOPY(tasource, THIS.LIST)
FOR lnitem = 1 TO THIS.nmaxrow
IF THIS.nmaxcol = 0
IF !EMPTY(THIS.LIST[lnItem])
THIS.lstsource.ADDLISTITEM(THIS.LIST[lnItem],lnitem)
ENDIF
ELSE
IF !EMPTY(THIS.LIST[lnItem, this.nColToView])
THIS.lstsource.ADDLISTITEM(THIS.LIST[lnItem, this.nColToView],lnitem)
ENDIF
ENDIF
NEXT
THIS.lstselected.CLEAR()
THIS.lstsource.LISTINDEX = 1
THIS.lstselected.LISTINDEX = 0
*-- Set selected Item
IF PARAMETERS() = 2
LOCAL lnitem, lnindex, lnitemid, lcitem, x
LOCAL lnfoundindex
FOR lnitem = 1 TO ALEN(taselected,1)
IF !EMPTY(taselected[lnItem,this.nColToView])
lnindex = ASCAN(tasource, taselected[lnItem,this.nColToView])
IF lnindex <> 0
FOR lnfoundindex=1 TO THIS.lstsource.LISTCOUNT
IF THIS.lstsource.LIST[lnFoundIndex]=taselected[lnItem,this.nColToView]
lnindex = lnfoundindex
ENDIF
NEXT
lnitemid = THIS.lstsource.INDEXTOITEMID(lnindex)
THIS.lstsource.LISTINDEX = 1
IF !EMPTY(THIS.lstsource.LIST[lnIndex])
lcitem = ALLTRIM(THIS.lstsource.LIST[lnIndex])
IF LEFT(lcitem,1) <> "\"
THIS.lstsource.LIST[lnIndex] = "\"+lcitem
THIS.lstselected.ADDLISTITEM(lcitem,lnitemid)
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
ENDIF
SET EXACT &lcexact
LOCAL lmultiselect
IF THIS.lcformclass
THISFORM.dispbegin()
ELSE
THISFORM.LOCKSCREEN = .T.
ENDIF
lmultiselect = THIS.lstsource.MULTISELECT
THIS.lstsource.MULTISELECT = .F.
THIS.cmdadd.ENABLED = (THIS.lstselected.LISTCOUNT < THIS.lstsource.LISTCOUNT)
THIS.cmdaddall.ENABLED = (THIS.lstselected.LISTCOUNT < THIS.lstsource.LISTCOUNT)
THIS.cmdremove.ENABLED = (THIS.lstselected.LISTCOUNT > 0)
THIS.cmdremoveall.ENABLED = (THIS.lstselected.LISTCOUNT > 0)
IF THIS.lstselected.LISTCOUNT < THIS.lstsource.LISTCOUNT
THIS.lstselected.LISTINDEX = 0
IF THIS.lstsource.LISTINDEX = 0
THIS.lstsource.LISTINDEX = 1
ENDIF
THIS.lstsource.ENABLED = .T.
ELSE
THIS.lstsource.LISTINDEX = 0
IF THIS.lstselected.LISTINDEX = 0
THIS.lstselected.LISTINDEX = 1
ENDIF
THIS.lstsource.ENABLED = .F.
ENDIF
THIS.lstsource.MULTISELECT = lmultiselect
THIS.lstselected.REFRESH()
THIS.lstsource.REFRESH()
IF THIS.lcformclass
THISFORM.dispend()
ELSE
THISFORM.LOCKSCREEN = .F.
ENDIF
THIS.lcformclass = TYPE("thisForm.nLockScreen") = "N"
THIS.CLEAR()
| Baseclass | Class | Object name |
|---|---|---|
| commandbutton | commandbutton | cmover.cmdAdd |
| cmover.cmdAddAll | ||
| cmover.cmdRemove | ||
| cmover.cmdRemoveAll | ||
| label | label | cmover.lblSelected |
| cmover.lblSource | ||
| listbox | listbox | cmover.lstSelected |
| cmover.lstSource |
| Name | Initial value |
|---|---|
| Caption | "" |
| FontBold | .F. |
| FontSize | 8 |
| Picture | ..\bitmap\mover\add.bmp |
| TabIndex | 3 |
LOCAL lcitem , lnindex ,lnitemid, lnlistcount
WITH THIS.PARENT.lstsource
lnlistcount = .LISTCOUNT
FOR lnitem = 1 TO lnlistcount
IF .SELECTED(lnitem)
lnitemid = .INDEXTOITEMID(lnitem)
lcitem = ALLTRIM(.LIST[lnItem])
IF LEFT(lcitem,1) <> "\"
.LIST[lnItem] = "\" + lcitem
THIS.PARENT.lstselected.ADDLISTITEM(lcitem, lnitemid)
ENDIF
ENDIF
NEXT
THIS.PARENT.REFRESH()
.SETFOCUS()
ENDWITH
| Name | Initial value |
|---|---|
| Caption | "" |
| FontBold | .F. |
| FontSize | 8 |
| Picture | ..\bitmap\mover\addall.bmp |
| TabIndex | 4 |
LOCAL lcitem , lnindex ,lnitemid, lnlistcount, osource, oselected
osource = THIS.PARENT.lstsource
oselected = THIS.PARENT.lstselected
lnlistcount = osource.LISTCOUNT
FOR lnitem = 1 TO lnlistcount
lnitemid = osource.INDEXTOITEMID(lnitem)
lcitem = ALLTRIM(osource.LIST[lnItem])
IF LEFT(lcitem,1) <> "\"
osource.LIST[lnItem] = "\" + lcitem
oselected.ADDLISTITEM(lcitem, lnitemid)
ENDIF
NEXT
osource.LISTINDEX = 0
oselected.LISTINDEX = 1
THIS.PARENT.REFRESH()
oselected.SETFOCUS()
| Name | Initial value |
|---|---|
| Caption | "" |
| FontBold | .F. |
| FontSize | 8 |
| Picture | ..\bitmap\mover\del.bmp |
| TabIndex | 5 |
LOCAL lcitem , lnindex ,lnitemid, lnlistcount, osource, oselected
osource = THIS.PARENT.lstsource
oselected = THIS.PARENT.lstselected
lnlistcount = oselected.LISTCOUNT
FOR lnitem = lnlistcount TO 1 STEP -1
IF oselected.SELECTED(lnitem)
lnitemid = oselected.INDEXTOITEMID(lnitem)
osource.LIST[oSource.ItemIdToIndex(lnItemId)] = STRTRAN(osource.LIST[oSource.ItemIdToIndex(lnItemId)],"\","")
oselected.REMOVEITEM(lnitem)
ENDIF
NEXT
THIS.PARENT.REFRESH()
oselected.SETFOCUS()
| Name | Initial value |
|---|---|
| Caption | "" |
| FontBold | .F. |
| FontSize | 8 |
| Picture | ..\bitmap\mover\delall.bmp |
| TabIndex | 6 |
LOCAL lcitem , lnindex ,lnitemid, lnlistcount, osource, oselected
osource = THIS.PARENT.lstsource
oselected = THIS.PARENT.lstselected
lnlistcount = oselected.LISTCOUNT
FOR lnitem = 1 TO lnlistcount
lnitemid = oselected.INDEXTOITEMID(lnitem)
osource.LIST[oSource.ItemIdToIndex(lnItemId)] = STRTRAN(osource.LIST[oSource.ItemIdToIndex(lnItemId)],"\","")
NEXT
oselected.CLEAR()
oselected.LISTINDEX = 0
osource.LISTINDEX = 1
osource.SETFOCUS()
THIS.PARENT.REFRESH()
| Name | Initial value |
|---|---|
| AutoSize | .T. |
| BackStyle | 0 |
| Caption | "\<Selected" |
| TabIndex | 7 |
| Name | Initial value |
|---|---|
| AutoSize | .T. |
| BackStyle | 0 |
| Caption | "\<Items" |
| TabIndex | 1 |
| Name | Initial value |
|---|---|
| MoverBars | .T. |
| TabIndex | 8 |
| Value |
THIS.INTERACTIVECHANGE()
THIS.PARENT.LISTINDEX = THIS.INDEXTOITEMID(THIS.LISTINDEX)
IF THIS.PARENT.LISTINDEX <> 0
THIS.PARENT.onselectedchange()
ENDIF
THIS.PARENT.cmdremove.CLICK()
| Name | Initial value |
|---|---|
| TabIndex | 2 |
| Value |
THIS.INTERACTIVECHANGE()
THIS.PARENT.sourcelistindex = THIS.INDEXTOITEMID(THIS.LISTINDEX)
IF THIS.PARENT.sourcelistindex <> 0
THIS.PARENT.onsourcechange()
ENDIF
THIS.PARENT.cmdadd.CLICK()
| Name | Initial value |
|---|---|
| BackStyle | 0 |
| BorderWidth | 0 |
| Name | Initial value | Comment |
|---|---|---|
| ^list[1,1] | .f. | a character string array used to access the items in a combobox or listbox control. |
| ^listselected[1,1] | .f. | |
| lcformclass | .f. | |
| listindex | 0 | index of selected item into original array |
| ncoltoview | 0 | column of array to display |
| nmaxcol | 0 | number of columns |
| nmaxrow | 0 | number of items |
| sourcelistindex | 0 |
LPARAMETERS tldontclearselected
DIMENSION THIS.LIST[1,1]
THIS.LIST[1,1] = .F.
THIS.lstsource.CLEAR()
IF !tldontclearselected
THIS.lstselected.CLEAR()
ENDIF
THIS.nmaxrow = 0
THIS.nmaxcol = 0
THIS.LISTINDEX = 0
LPARAMETERS taselected
LOCAL lnitem, lnx, j
DIMENSION taselected[1,1]
STORE .F. TO taselected
WITH THIS
FOR lni = 1 TO .lstselected.LISTCOUNT
lnitem = ASUBSCRIPT(.listselected, ASCAN(.listselected, ALLTRIM(.lstselected.LIST[lni])), 1)
IF lnitem > 0
lnx = IIF(EMPTY(taselected), 1, ALEN(taselected,1) +1)
DIMENSION taselected[lnx, max(1,.nmaxcol)]
FOR j = 1 TO .nmaxcol
taselected[lnx, j] = .listselected[lnitem, j]
NEXT
ENDIF
NEXT
ENDWITH
LPARAMETERS tasource, taselected
LOCAL lnitem, lcexact, llsetselecteddata
llsetselecteddata = PARAMETERS() >= 2
lcexact = SET('exact')
SET EXACT ON
THIS.nmaxrow = ALEN(tasource,1)
THIS.nmaxcol = ALEN(tasource,2)
IF THIS.ncoltoview = 0
THIS.ncoltoview = 1
ENDIF
ACOPY(tasource, THIS.LIST)
FOR lnitem = 1 TO THIS.nmaxrow
IF THIS.nmaxcol = 0
IF !EMPTY(THIS.LIST[lnItem])
THIS.lstsource.ADDLISTITEM(THIS.LIST[lnItem],lnitem)
ENDIF
ELSE
IF !EMPTY(THIS.LIST[lnItem, this.nColToView])
THIS.lstsource.ADDLISTITEM(THIS.LIST[lnItem, this.nColToView],lnitem)
ENDIF
ENDIF
NEXT
IF llsetselecteddata
THIS.lstselected.CLEAR()
THIS.lstsource.LISTINDEX = 1
THIS.lstselected.LISTINDEX = 0
LOCAL lcitem, lnitem, lcid
FOR lnitem = 1 TO ALEN(taselected,1)
WITH THIS
lcitem = ALLTRIM(taselected[lnItem, .nColToView])
lcid = SPACE(100) + SYS(2015)
.lstselected.ADDLISTITEM(lcitem + lcid)
DIMENSION .listselected[lnitem, max(1,.nmaxcol +1)]
FOR j = 1 TO .nmaxcol
.listselected[lnitem, j] = taselected[lnitem, j]
NEXT
.listselected[lnitem, .nmaxcol +1] = lcitem + lcid
ENDWITH
NEXT
ENDIF
SET EXACT &lcexact
LOCAL lmultiselect
IF THIS.lcformclass
THISFORM.dispbegin()
ELSE
THISFORM.LOCKSCREEN = .T.
ENDIF
lmultiselect = THIS.lstsource.MULTISELECT
THIS.lstsource.MULTISELECT = .F.
THIS.cmdremove.ENABLED = (THIS.lstselected.LISTCOUNT > 0)
THIS.cmdremoveall.ENABLED = (THIS.lstselected.LISTCOUNT > 0)
IF THIS.lstsource.LISTINDEX = 0
THIS.lstsource.LISTINDEX = 1
ENDIF
THIS.lstsource.ENABLED = .T.
THIS.lstsource.MULTISELECT = lmultiselect
THIS.lstselected.REFRESH()
THIS.lstsource.REFRESH()
IF THIS.lcformclass
THISFORM.dispend()
ELSE
THISFORM.LOCKSCREEN = .F.
ENDIF
THIS.lcformclass = TYPE("thisForm.nLockScreen") = "N"
THIS.CLEAR()
| Baseclass | Class | Object name |
|---|---|---|
| commandbutton | commandbutton | cmover2.cmdAdd |
| cmover2.cmdAddAll | ||
| cmover2.cmdRemove | ||
| cmover2.cmdRemoveAll | ||
| label | label | cmover2.lblSelected |
| cmover2.lblSource | ||
| listbox | listbox | cmover2.lstSelected |
| cmover2.lstSource |
| Name | Initial value |
|---|---|
| Caption | "" |
| FontBold | .F. |
| FontSize | 8 |
| Picture | ..\bitmap\mover\add.bmp |
| TabIndex | 3 |
LOCAL lcitem, lnitemid, lnlistcount, osource, oselected, j, lnx, lcid
osource = THIS.PARENT.lstsource
oselected = THIS.PARENT.lstselected
lnlistcount = osource.LISTCOUNT
FOR lnitem = 1 TO lnlistcount
IF osource.SELECTED(lnitem)
lcitem = ALLTRIM(osource.LIST[lnItem]) + TRIM(THIS.PARENT.LIST[lnitem,4])
WITH THIS.PARENT
lcid = SPACE(100) + SYS(2015)
oselected.ADDLISTITEM(lcitem + lcid)
lnx = IIF(EMPTY(.listselected), 1, ALEN(.listselected,1) +1)
DIMENSION .listselected[lnx, max(1,.nmaxcol +1)]
FOR j = 1 TO .nmaxcol
.listselected[lnx, j] = .LIST[lnitem, j]
NEXT
.listselected[lnx, .nmaxcol +1] = lcitem + lcid
ENDWITH
ENDIF
NEXT
THIS.PARENT.REFRESH()
osource.SETFOCUS()
| Name | Initial value |
|---|---|
| Caption | "" |
| Enabled | .F. |
| FontBold | .F. |
| FontSize | 8 |
| Picture | ..\bitmap\mover\addall.bmp |
| TabIndex | 4 |
| Visible | .F. |
LOCAL lcitem , lnindex ,lnitemid, lnlistcount, osource, oselected
osource = THIS.PARENT.lstsource
oselected = THIS.PARENT.lstselected
lnlistcount = osource.LISTCOUNT
FOR lnitem = 1 TO lnlistcount
lcfield = THIS.PARENT.LIST[lnitem,1]
IF EMPTY(oselected.LIST)
lnitemid = 0
ELSE
lnitemid = ASCAN(oselected.LIST,lcfield)
ENDIF
lcitem = ALLTRIM(osource.LIST[lnItem]) + TRIM(THIS.PARENT.LIST[lnitem,4])
IF lnitemid = 0
oselected.ADDLISTITEM(lcitem)
ELSE
oselected.ADDLISTITEM(lcitem, lnitemid)
ENDIF
NEXT
osource.LISTINDEX = 0
oselected.LISTINDEX = 1
THIS.PARENT.REFRESH()
oselected.SETFOCUS()
| Name | Initial value |
|---|---|
| Caption | "" |
| FontBold | .F. |
| FontSize | 8 |
| Picture | ..\bitmap\mover\del.bmp |
| TabIndex | 5 |
LOCAL lcitem , lnindex, lnlistcount, osource, oselected, lnx
osource = THIS.PARENT.lstsource
oselected = THIS.PARENT.lstselected
lnlistcount = oselected.LISTCOUNT
FOR lnitem = lnlistcount TO 1 STEP -1
IF oselected.SELECTED(lnitem)
WITH THIS.PARENT
lnx = ASUBSCRIPT(.listselected, ASCAN(.listselected, ALLTRIM(.lstselected.LIST[lnitem])), 1)
IF lnx <> 0
ADEL(.listselected, lnx)
DIMENSION .listselected[max(1, alen(.listselected,1) -1), max(1,.nmaxcol +1)]
ENDIF
ENDWITH
oselected.REMOVEITEM(lnitem)
ENDIF
NEXT
THIS.PARENT.REFRESH()
oselected.SETFOCUS()
| Name | Initial value |
|---|---|
| Caption | "" |
| FontBold | .F. |
| FontSize | 8 |
| Picture | ..\bitmap\mover\delall.bmp |
| TabIndex | 6 |
LOCAL lcitem , lnindex ,lnitemid, lnlistcount, osource, oselected
osource = THIS.PARENT.lstsource
oselected = THIS.PARENT.lstselected
lnlistcount = oselected.LISTCOUNT
FOR lnitem = 1 TO lnlistcount
lnitemid = oselected.INDEXTOITEMID(lnitem)
osource.LIST[oSource.ItemIdToIndex(lnItemId)] = STRTRAN(osource.LIST[oSource.ItemIdToIndex(lnItemId)],"\","")
NEXT
oselected.CLEAR()
oselected.LISTINDEX = 0
osource.LISTINDEX = 1
osource.SETFOCUS()
THIS.PARENT.REFRESH()
| Name | Initial value |
|---|---|
| AutoSize | .T. |
| BackStyle | 0 |
| Caption | "\<Selected" |
| TabIndex | 7 |
| Name | Initial value |
|---|---|
| AutoSize | .T. |
| BackStyle | 0 |
| Caption | "\<Items" |
| TabIndex | 1 |
| Name | Initial value |
|---|---|
| MoverBars | .T. |
| TabIndex | 8 |
| Value |
THIS.INTERACTIVECHANGE()
THIS.PARENT.LISTINDEX = THIS.INDEXTOITEMID(THIS.LISTINDEX)
IF THIS.PARENT.LISTINDEX <> 0
THIS.PARENT.onselectedchange()
ENDIF
THIS.PARENT.cmdremove.CLICK()
| Name | Initial value |
|---|---|
| TabIndex | 2 |
| Value |
THIS.INTERACTIVECHANGE()
THIS.PARENT.sourcelistindex = THIS.INDEXTOITEMID(THIS.LISTINDEX)
IF THIS.PARENT.sourcelistindex <> 0
THIS.PARENT.onsourcechange()
ENDIF
THIS.PARENT.cmdadd.CLICK()
| Name | Initial value |
|---|---|
| BorderColor | 0,0,0 |
| BorderWidth | 0 |
| SpecialEffect | 2 |
| _vfxclassname | CNavigator |
**__VFX_WIZARD_HEADER - 07/16/1996 07:06:13 PM
this.cmdtop.tooltiptext = TTT_CMDTOP
this.cmdprev.tooltiptext = TTT_CMDPREV
this.cmdnext.tooltiptext = TTT_CMDNEXT
this.cmdbottom.tooltiptext = TTT_CMDBOTTOM
this.cmdsearch.tooltiptext = TTT_CMDSEARCH
this.cmdmore.tooltiptext = TTT_CMDMORE
this.cmdsave.tooltiptext = TTT_CMDSAVE
this.cmdnew.tooltiptext = TTT_CMDNEW
this.cmdedit.tooltiptext = TTT_CMDEDIT
this.cmddelete.tooltiptext = TTT_CMDDELETE
this.cmdundo.tooltiptext = TTT_CMDUNDO
this.cmdclose.tooltiptext = TTT_CMDCLOSE
return .t.
**__VFX_WIZARD_FOOTER
***********************************************************
IF THISFORM.nformstatus = id_normal_mode
THIS.cmdsave.VISIBLE = .F.
THIS.cmdundo.VISIBLE = .F.
ELSE
THIS.cmdsave.VISIBLE = .T.
THIS.cmdundo.VISIBLE = .T.
ENDIF
**************************************************
THIS.cmdmore.VISIBLE = !THIS.cmdsave.VISIBLE
THIS.cmdedit.VISIBLE = !THIS.cmdsave.VISIBLE
THIS.cmddelete.VISIBLE = !THIS.cmdsave.VISIBLE
THIS.cmdnew.VISIBLE = !THIS.cmdsave.VISIBLE
THIS.cmdsearch.VISIBLE = !THIS.cmdsave.VISIBLE
**************************************************
THIS.cmdmore.ENABLED = THISFORM.lmore AND !THISFORM.lempty AND THISFORM.nformstatus = id_normal_mode
THIS.cmdedit.ENABLED = THISFORM.lcanedit AND !THISFORM.lempty AND THISFORM.nformstatus = id_normal_mode
THIS.cmddelete.ENABLED = THISFORM.lcandelete AND !THISFORM.lempty AND THISFORM.nformstatus = id_normal_mode
THIS.cmdnew.ENABLED = THISFORM.lcaninsert
THIS.cmdsearch.ENABLED =!THISFORM.lempty AND THISFORM.nformstatus = id_normal_mode
THIS.cmdclose.ENABLED = THISFORM.nformstatus = id_normal_mode
THIS.cmdtop.ENABLED = !THISFORM.lempty
THIS.cmdprev.ENABLED = THIS.cmdtop.ENABLED
THIS.cmdnext.ENABLED = THIS.cmdtop.ENABLED
THIS.cmdbottom.ENABLED = THIS.cmdtop.ENABLED
THIS.cmdnew.VISIBLE = !THIS.cmdsave.VISIBLE
THIS.cmdedit.VISIBLE = !THIS.cmdundo.VISIBLE
IF THISFORM.lempty
THIS.cmdtop.ENABLED = .F.
THIS.cmdnext.ENABLED = .F.
THIS.cmdprev.ENABLED = .F.
THIS.cmdbottom.ENABLED = .F.
THIS.cmdsearch.ENABLED = .F.
THIS.cmdmore.ENABLED = .F.
THIS.cmddelete.ENABLED = .F.
THIS.cmdedit.ENABLED = .F.
THIS.cmdnew.ENABLED = .T. AND THISFORM.lcaninsert
THIS.cmdclose.ENABLED = .T.
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
THIS.langsetup()
THIS.cmdsave.TOP = THIS.cmdnew.TOP
THIS.cmdsave.LEFT = THIS.cmdnew.LEFT
THIS.cmdundo.TOP = THIS.cmdedit.TOP
THIS.cmdundo.LEFT = THIS.cmdedit.LEFT
THIS.cmdsave.TABINDEX = 1
THIS.cmdundo.TABINDEX = 2
DODEFAULT()
| Baseclass | Class | Object name |
|---|---|---|
| commandbutton | ccommandbutton | cnavigator.cmdBottom |
| cnavigator.cmdClose | ||
| cnavigator.cmdDelete | ||
| cnavigator.cmdEdit | ||
| cnavigator.cmdMore | ||
| cnavigator.cmdNew | ||
| cnavigator.cmdNext | ||
| cnavigator.cmdPrev | ||
| cnavigator.cmdSave | ||
| cnavigator.cmdSearch | ||
| cnavigator.cmdTop | ||
| cnavigator.cmdUndo |
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\wzend.bmp |
| TabIndex | 8 |
| ToolTipText | "Bottom (Ctrl+End)" |
IF pemstatus(THISFORM,'OnBottom',5)
THISFORM.onbottom()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\close.bmp |
| TabIndex | 4 |
| ToolTipText | "Close (Esc)" |
IF THISFORM.QUERYUNLOAD()
THISFORM.RELEASE()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\wzdelete.bmp |
| TabIndex | 3 |
| ToolTipText | "Delete (Ctrl+D)" |
IF pemstatus(THISFORM,'OnDelete',5)
THISFORM.ondelete()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\wzedit.bmp |
| TabIndex | 2 |
| ToolTipText | "Edit (Ctrl+E)" |
IF pemstatus(THISFORM,'OnEdit',5)
THISFORM.onedit()
ENDIF
NODEFAULT
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\wzmore.bmp |
| TabIndex | 10 |
| ToolTipText | "More ... (F6)" |
IF pemstatus(THISFORM,'OnMore',5)
THISFORM.onmore()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\new.bmp |
| TabIndex | 1 |
| ToolTipText | "New (Ctrl+N)" |
IF pemstatus(THISFORM,'OnInsert',5)
THISFORM.oninsert()
ENDIF
NODEFAULT
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\wznext.bmp |
| TabIndex | 7 |
| ToolTipText | "Next (Ctrl+Down)" |
IF pemstatus(THISFORM,'OnNext',5)
THISFORM.onnext()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\wzback.bmp |
| TabIndex | 6 |
| ToolTipText | "Previous (Ctrl+Up)" |
IF pemstatus(THISFORM,'OnPrev',5)
THISFORM.onprev()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\save.bmp |
| TabIndex | 11 |
| ToolTipText | "Save (Ctrl+S)" |
| Visible | .F. |
IF pemstatus(THISFORM,'OnSave',5)
THISFORM.onsave()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "" |
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\wzfind.bmp |
| TabIndex | 9 |
| ToolTipText | "Search ... (Ctrl+F)" |
IF pemstatus(THISFORM,'OnSearch',5)
THISFORM.onsearch()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\wztop.bmp |
| TabIndex | 5 |
| ToolTipText | "Top (Ctrl+Home)" |
IF pemstatus(THISFORM,'OnTop',5)
THISFORM.ontop()
ENDIF
| Name | Initial value |
|---|---|
| Caption | "" |
| Picture | ..\bitmap\toolbar\wzundo.bmp |
| TabIndex | 12 |
| ToolTipText | "Undo (Ctrl+Z)" |
| Visible | .F. |
IF pemstatus(THISFORM,'OnUndo',5)
THISFORM.onundo()
ENDIF
| Name | Initial value | Comment |
|---|---|---|
| ^acargo[1,0] | .f. | |
| _vfxclassname | CObject | Internal use.Specifies the original VFX Class Name |
| extrabuffer | .f. | A user buffer |
RELEASE THIS
LOCAL lnitem
FOR lnitem = 1 TO ALEN(THIS.acargo,1)
THIS.acargo[lnItem] = .NULL.
NEXT
| Name | Initial value |
|---|---|
| BorderWidth | 0 |
| _vfxclassname | cpickdate |
| lautosetup | .T. |
| Name | Initial value | Comment |
|---|---|---|
| cpicktext | Select a date | |
| cviewparameter | .f. | viewparameter when used in the caskviewarg/pgf context |
| isdmydate | .T. | |
| lallownullwhenempty | .f. | Defines whether the control allows .NULL. to be populated to the controlsource when the selection is empty |
| ocalendar | .f. |
LPARAMETERS tddate
THIS.txtdate.VALUE = tddate
IF THIS.lallownullwhenempty
WITH THIS.txtdate
IF EMPTY(.VALUE) .AND. !ISNULL(.VALUE)
IF !EMPTY(.CONTROLSOURCE)
LOCAL llx, lcerror, lcfield
lcerror = ON("error")
llx = .F.
lcfield = IIF(AT(".", .CONTROLSOURCE) <> 0, ;
.CONTROLSOURCE, ;
ALIAS() + .CONTROLSOURCE)
ON ERROR llx = .T.
=DBGETPROP(lcfield, "field", "datatype")
ON ERROR &lcerror
IF !llx
REPLACE &lcfield WITH .NULL.
ENDIF
ENDIF
ENDIF
ENDWITH
ENDIF
IF !THIS.txtdate.READONLY AND THIS.txtdate.ENABLED
THIS.cmdpick.CLICK()
ENDIF
THIS.cpicktext=cap_frmpickdate
THIS.cmdpick.TOOLTIPTEXT=ttt_cmdpickdate
RETURN DODEFAULT()
| Baseclass | Class | Object name |
|---|---|---|
| commandbutton | ccommandbutton | cpickdate.cmdpick |
| textbox | ctextbox | cpickdate.txtDate |
| Name | Initial value |
|---|---|
| Caption | "..." |
| TabStop | .F. |
| ToolTipText | "Click to choose a date" |
DODEFAULT()
THIS.ENABLED = !THIS.PARENT.txtdate.READONLY AND THIS.PARENT.txtdate.ENABLED
LPARAMETERS nkeycode, nshiftaltctrl
IF nkeycode = -8
THIS.PARENT.cmdpick.CLICK()
ENDIF
LOCAL lcanedit
lcanedit = .T.
IF TYPE("thisForm.lAutoEdit") == "L"
IF THISFORM.lautoedit AND THISFORM.nformstatus = 0 AND !THISFORM.lempty
IF THIS.lautosetup
lcanedit = THISFORM.onedit()
ENDIF
ENDIF
ENDIF
IF lcanedit
LOCAL lcerror
m.lcerror=ON("ERROR")
ON ERROR *
DO FORM vfxclndr WITH THIS.PARENT
THIS.PARENT.txtdate.SETFOCUS()
ON ERROR &lcerror
ENDIF
| Name | Initial value |
|---|---|
| FontSize | 9 |
| Format | "DK" |
| IntegralHeight | .T. |
LPARAMETERS nkeycode, nshiftaltctrl
IF nkeycode = -8
THIS.PARENT.cmdpick.CLICK()
ENDIF
| Name | Initial value |
|---|---|
| _vfxclassname | CPickGrid |
| Name | Initial value |
|---|---|
| AutoSize | .F. |
| Caption | "" |
| DownPicture | ..\bitmap\toolbar\pushpin1.bmp |
| Picture | ..\bitmap\toolbar\pushpin0.bmp |
| Style | 1 |
| Value | .F. |
| _vfxclassname | CPushPin |
| lautosetup | .F. |
| lautosize | .F. |
THISFORM.ALWAYSONTOP = THIS.VALUE
| Name | Initial value |
|---|---|
| _vfxclassname | CRecordManager |
| Name | Initial value | Comment |
|---|---|---|
| caliasname | .f. | Specifies the alias to use as main alias |
| setfilter | .f. | Set the filter end refresh the current record buffer |
| Name | Initial value |
|---|---|
| BackColor | 192,192,192 |
| BackStyle | 0 |
| BorderWidth | 0 |
| Name | Initial value | Comment |
|---|---|---|
| ^acontrols[1,0] | .f. | Store a reference to each form's object |
| formcolor | 12632256 | System Window Color |
| hilightcolor | 16777215 | System Window Color |
| lalwaysontop | .T. | Specifies if the object is On Top |
| lautoresize | .T. | Specifies if the control is auto-resized when intialized |
| linitialized | .f. | Specifies if the control is initialized |
| ncontrolcount | 0 | Stores the number of controls in the array |
| nfactorx | 1 | |
| nfactory | 1 | |
| nfontsize | .f. | |
| nformheight | 0 | Original Form Height |
| nformwidth | 0 | Original Form Width |
| nnewheight | 0 | Height after Resize |
| nnewwidth | 0 | Width after Resize |
| shadowcolor | 8421504 | System Window Color |
THIS.VISIBLE = .T.
IF THIS.lalwaysontop
THIS.ZORDER(0)
ELSE
THIS.ZORDER(1)
ENDIF
THIS.MOVE(THISFORM.WIDTH-16, THISFORM.HEIGHT-16, 16, 16)
#DEFINE __id_objname THIS.acontrols[j,1]
#DEFINE __id_object THIS.acontrols[j,2]
#DEFINE __id_top THIS.acontrols[j,3]
#DEFINE __id_left THIS.acontrols[j,4]
#DEFINE __id_width THIS.acontrols[j,5]
#DEFINE __id_height THIS.acontrols[j,6]
LOCAL llockscreen, lndec
llockscreen = THISFORM.LOCKSCREEN
THISFORM.LOCKSCREEN = .T.
lndec = SET('decimals')
SET DECIMAL TO 9
WITH THIS
LOCAL lccomment
lccomment = .COMMENT
.COMMENT = ''
IF !.linitialized
.initcontrols()
IF !.lautoresize
.resizecontrol(.F.,.F.,.T.)
ENDIF
ELSE
.resizecontrol(.F.,.F.,.T.)
ENDIF
IF !EMPTY(.COMMENT)
** Resize the PageFrame Objects
LOCAL k, j, locontrol
FOR k = 1 TO MEMLINES(.COMMENT)
IF !EMPTY(MLINE(.COMMENT,k))
j = VAL(MLINE(.COMMENT,k))
locontrol = __id_object
locontrol.MOVE(__id_left * THIS.nfactorx,;
__id_top * THIS.nfactory,;
__id_width * THIS.nfactorx,;
__id_height * THIS.nfactory )
ENDIF
NEXT
ENDIF
.COMMENT = lccomment
.setpos()
ENDWITH
SET DECIMAL TO lndec
IF !llockscreen
THISFORM.LOCKSCREEN = .F.
ENDIF
LPARAMETERS tocontrol
LOCAL lnindex
IF "
RETURN .F.
ENDIF
WITH THIS
.ncontrolcount = .ncontrolcount + 1
lnindex = .ncontrolcount
DIMENSION .acontrols[lnIndex,10]
.acontrols[lnIndex,1] = THIS.fullobjname(tocontrol)
.acontrols[lnIndex,2] = tocontrol
.acontrols[lnIndex,3] = 1
IF pemstatus(tocontrol,"Top",5)
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
.acontrols[lnIndex,3] = tocontrol.TOP
ENDIF
ENDIF
.acontrols[lnIndex,4] = 1
IF pemstatus(tocontrol,"Left",5)
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
.acontrols[lnIndex,4] = tocontrol.LEFT
ENDIF
ENDIF
.acontrols[lnIndex,5] = 1
IF pemstatus(tocontrol,"Width",5)
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
.acontrols[lnIndex,5] = tocontrol.WIDTH
ENDIF
ENDIF
.acontrols[lnIndex,6] = 1
IF pemstatus(tocontrol,"Height",5)
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
.acontrols[lnIndex,6] = tocontrol.HEIGHT
ENDIF
ENDIF
.acontrols[lnIndex,7] = IIF(pemstatus(tocontrol,"FontSize",5),tocontrol.FONTSIZE,0)
IF pemstatus(tocontrol,'lProportionalFont',5)
IF !tocontrol.lproportionalfont
.acontrols[lnIndex,7] = 0
ENDIF
ENDIF
.acontrols[lnIndex, 8] = IIF(pemstatus(tocontrol,"ColumnWidths",5),tocontrol.COLUMNWIDTHS,'')
.acontrols[lnIndex, 9] = IIF(pemstatus(tocontrol,"Margin",5),tocontrol.MARGIN,0)
.acontrols[lnIndex,10] = THIS.getpageframe(tocontrol)
IF .lautoresize
.resizecontrol(tocontrol,lnindex)
ENDIF
ENDWITH
** If it's a container we drill down.
LOCAL lcbaseclass
lcbaseclass = LOWER(tocontrol.BASECLASS)
DO CASE
CASE lcbaseclass == "pageframe"
THIS.readpageframe(tocontrol)
CASE lcbaseclass == "page"
THIS.readpage(tocontrol)
CASE lcbaseclass == "grid"
THIS.readgrid(tocontrol)
CASE lcbaseclass == "container"
THIS.readcontainer(tocontrol)
CASE lcbaseclass == "optiongroup"
THIS.readoptgroup(tocontrol)
CASE lcbaseclass == "commandgroup"
THIS.readcmdgroup(tocontrol)
ENDCASE
LPARAMETERS tocontrol
IF THIS.ncontrolcount = 0
RETURN .F.
ENDIF
IF TYPE("toControl")=="O" AND !ISNULL(tocontrol)
LOCAL lnindex
** Seek the controls into array
lnindex = ASCAN(THIS.acontrols, THIS.fullobjname(tocontrol))
IF lnindex > 0
lnindex = ASUBSCRIPT(THIS.acontrols, lnindex, 1)
=ADEL(THIS.acontrols,lnindex)
THIS.ncontrolcount = THIS.ncontrolcount -1
IF THIS.ncontrolcount > 0
DIMENSION THIS.acontrols[this.nControlCount,10]
ELSE
DIMENSION THIS.acontrols[1]
THIS.acontrols[1] = .F.
ENDIF
ELSE
RETURN .F.
ENDIF
ENDIF
LPARAMETERS tocontrol, tnindex, tlviaformresize
#DEFINE __id_objname THIS.acontrols[j,1]
#DEFINE __id_object THIS.acontrols[j,2]
#DEFINE __id_top THIS.acontrols[j,3]
#DEFINE __id_left THIS.acontrols[j,4]
#DEFINE __id_width THIS.acontrols[j,5]
#DEFINE __id_height THIS.acontrols[j,6]
#DEFINE __id_fontsize THIS.acontrols[j,7]
#DEFINE __id_colwidth THIS.acontrols[j,8]
#DEFINE __id_pageframe THIS.acontrols[j,10]
IF THIS.ncontrolcount = 0
RETURN .F.
ENDIF
LOCAL locontrol, lnfactorx, lnfactory, lnfactorfont,;
lntabheight, lntoolbarheight
STORE 0 TO lntabheight, lntoolbarheight
IF pemstatus(THISFORM,"cntSpeedBar",5)
lntoolbarheight = THISFORM.cntspeedbar.HEIGHT
ENDIF
LOCAL lnstart, lncontrols, locontrol
lnstart = 1
lncontrols = THIS.ncontrolcount
locontrol = .NULL.
DO CASE
CASE TYPE("tnIndex") == "N" AND tnindex > 0
lnstart = MIN(tnindex,THIS.ncontrolcount)
lncontrols = lnstart
CASE TYPE("toControl")=="O" AND !ISNULL(tocontrol)
LOCAL lnindex
** Seek the controls into array
lnindex = ASCAN(THIS.acontrols, THIS.fullobjname(tocontrol))
IF lnindex > 0
lnindex = ASUBSCRIPT(THIS.acontrols, lnindex, 1)
lnstart = MIN(lnindex,THIS.ncontrolcount)
lncontrols = lnstart
ELSE
RETURN .F.
ENDIF
ENDCASE
LOCAL j, lproportional
FOR j = lnstart TO lncontrols
locontrol = __id_object
IF TYPE("this.aControls[j,10]")=="O" AND !ISNULL(THIS.acontrols[j,10])
IF pemstatus(__id_pageframe,'PageWidth',5)
lntabheight = __id_pageframe.WIDTH - __id_pageframe.PAGEWIDTH
ELSE
lntabheight = 28
ENDIF
IF !__id_pageframe.TABS
lntabheight = 0
ENDIF
ENDIF
lnfactorx = THISFORM.WIDTH / THIS.nformwidth
lnfactory = (THISFORM.HEIGHT - lntabheight - lntoolbarheight) /;
(THIS.nformheight - lntabheight - lntoolbarheight)
THIS.nfactorx = lnfactorx
THIS.nfactory = lnfactory
lnfontfactor = MIN(IIF(lnfactorx > 1,lnfactorx,(lnfactorx*2+1)/3),;
IIF(lnfactory > 1,lnfactory,(lnfactory*3+1)/4))
DO CASE
CASE "
THIS._fixtopleft(locontrol, __id_left, __id_top, __id_width, __id_height, lnfactorx, lnfactory)
THIS._resizefont(__id_fontsize, locontrol,lnfontfactor)
CASE "
THIS._fixwidthheight(locontrol, __id_left, __id_top, __id_width, __id_height, lnfactorx, lnfactory)
CASE "
THIS._movetop(locontrol, __id_left, __id_top, __id_width, __id_height, lnfactorx, lnfactory)
CASE "
THIS._movetop(locontrol, __id_left, __id_top, __id_width, __id_height, lnfactorx, lnfactory)
THIS._resizefont(__id_fontsize, locontrol,lnfontfactor)
CASE "
THIS._moveleft(locontrol, __id_left, __id_top, __id_width, __id_height, lnfactorx, lnfactory)
CASE "
THIS._moveleft(locontrol, __id_left, __id_top, __id_width, __id_height, lnfactorx, lnfactory)
THIS._resizefont(__id_fontsize, locontrol,lnfontfactor)
CASE "
THIS._sizewidth(locontrol, __id_left, __id_top, __id_width, __id_height, lnfactorx, lnfactory)
THIS._resizefont(__id_fontsize, locontrol,lnfontfactor)
CASE "
THIS._sizeheight(locontrol, __id_left, __id_top, __id_width, __id_height, lnfactorx, lnfactory)
THIS._resizefont(__id_fontsize, locontrol,lnfontfactor)
CASE "
*!* Nothing to do, no resize
OTHERWISE
THIS._proportional(locontrol, __id_left, __id_top, __id_width, __id_height, lnfactorx, lnfactory)
THIS._resizefont(__id_fontsize, locontrol,lnfontfactor)
ENDCASE
IF !EMPTY(__id_colwidth)
IF pemstatus(locontrol,'ColumnWidths',5)
locontrol.COLUMNWIDTHS = THIS.sizecolwidth(locontrol,lnfactorx, __id_colwidth)
ENDIF
ENDIF
NEXT
RETURN
* Copyright © by Devigus Engineering AG
*
* Author : Andrea De Paoli
* Date : January 1997
DECLARE INTEGER GetSysColor IN Win32API INTEGER nColorIndex
WITH THIS
.formcolor = getsyscolor(15)
.hilightcolor = getsyscolor(16)
.shadowcolor = getsyscolor(20)
ENDWITH
WITH THISFORM
IF .CONTROLCOUNT = 0
RETURN .F.
ENDIF
THIS.linitialized = .T.
LOCAL j
FOR j = 1 TO .CONTROLCOUNT
locontrol = .CONTROLS[j]
IF !COMPOBJ(THIS,locontrol) AND AT(locontrol.BASECLASS,'TimerCustom')=0
THIS.addcontrol(locontrol)
ENDIF
NEXT
ENDWITH
LPARAMETERS tocontrol
IF tocontrol.BASECLASS == 'Form'
RETURN locontrol.NAME
ENDIF
LOCAL lcfullname, locontrol
locontrol = tocontrol
lcfullname = LOWER(tocontrol.NAME)
locontrol = locontrol.PARENT
DO WHILE locontrol.BASECLASS != 'Form'
lcfullname = LOWER(locontrol.NAME)+"."+lcfullname
locontrol = locontrol.PARENT
ENDDO
lcfullname = "thisForm."+lcfullname
RETURN lcfullname
LPARAMETERS tocontrol
WITH tocontrol
IF .CONTROLCOUNT = 0
RETURN .F.
ENDIF
LOCAL j
FOR j = 1 TO .CONTROLCOUNT
locontrol = .CONTROLS[j]
IF !COMPOBJ(THIS,locontrol) AND AT(locontrol.BASECLASS,'TimerCustom')=0
THIS.addcontrol(locontrol)
ENDIF
NEXT
ENDWITH
LPARAMETERS tocontrol
WITH tocontrol
IF .CONTROLCOUNT = 0
RETURN .F.
ENDIF
LOCAL j
FOR j = 1 TO .CONTROLCOUNT
locontrol = .CONTROLS[j]
IF !COMPOBJ(THIS,locontrol) AND AT(locontrol.BASECLASS,'TimerCustom')=0
THIS.addcontrol(locontrol)
ENDIF
NEXT
ENDWITH
LPARAMETERS tocontrol
WITH tocontrol
IF .PAGECOUNT = 0
RETURN .F.
ENDIF
LOCAL j
FOR j = 1 TO .PAGECOUNT
locontrol = .PAGES[j]
IF !COMPOBJ(THIS,locontrol) AND AT(locontrol.BASECLASS,'TimerCustom')=0
THIS.addcontrol(locontrol)
ENDIF
NEXT
ENDWITH
LPARAMETERS tocontrol
LPARAMETERS tocontrol
WITH tocontrol
IF .BUTTONCOUNT = 0
RETURN .F.
ENDIF
LOCAL j
FOR j = 1 TO .BUTTONCOUNT
locontrol = .BUTTONS[j]
IF !COMPOBJ(THIS,locontrol) AND AT(locontrol.BASECLASS,'TimerCustom')=0
THIS.addcontrol(locontrol)
ENDIF
NEXT
ENDWITH
LPARAMETERS tocontrol
WITH tocontrol
IF .BUTTONCOUNT = 0
RETURN .F.
ENDIF
LOCAL j
FOR j = 1 TO .BUTTONCOUNT
locontrol = .BUTTONS[j]
IF !COMPOBJ(THIS,locontrol) AND AT(locontrol.BASECLASS,'TimerCustom')=0
THIS.addcontrol(locontrol)
ENDIF
NEXT
ENDWITH
WITH THISFORM
.MOVE(.LEFT, .TOP, THIS.nformwidth, THIS.nformheight)
ENDWITH
LPARAMETERS tocontrol, tnfactorx, tccolwidhts
IF tocontrol.COLUMNCOUNT = 1
RETURN tccolwidhts
ENDIF
LOCAL lcbuffer, lnvalue, lcretval, lncharsize, lnmaxcol, j
tccolwidhts = STRTRAN(tccolwidhts,' ','')
lcbuffer = STRTRAN(tccolwidhts,',',CHR(13))
lnvalue = 0
lcretval = ''
lnmaxcol = MIN(OCCURS(',',tccolwidhts)+1,tocontrol.COLUMNCOUNT)
IF lnmaxcol = 0
lnmaxcol = 1
ENDIF
lncharsize = (6+SYSMETRIC(5))/lnmaxcol
FOR j = 1 TO MEMLINES(lcbuffer)
IF !EMPTY(MLINE(lcbuffer,j))
lnvalue = VAL(MLINE(lcbuffer,j))
IF lnvalue > 0
lnvalue = (lnvalue+lncharsize)*tnfactorx-lncharsize
IF lnvalue < 0
lnvalue = 1
ENDIF
ENDIF
IF EMPTY(lcretval)
lcretval = ALLTRIM(STR(lnvalue))
ELSE
lcretval = lcretval + "," + ALLTRIM(STR(lnvalue))
ENDIF
ENDIF
NEXT
RETURN lcretval
LPARAMETERS tocontrol
LOCAL loparent, lopageframe
lopageframe = .NULL.
IF LOWER(tocontrol.PARENT.BASECLASS) == 'pageframe'
RETURN tocontrol.PARENT
ENDIF
IF LOWER(tocontrol.PARENT.BASECLASS) == 'form'
RETURN .NULL.
ENDIF
*!* Worse case :(
lopageframe = tocontrol
DO WHILE LOWER(lopageframe.BASECLASS) != "form"
lopageframe = lopageframe.PARENT
IF LOWER(lopageframe.BASECLASS) == 'pageframe'
EXIT
ENDIF
ENDDO
IF LOWER(lopageframe.BASECLASS) != 'pageframe'
lopageframe = .NULL.
ENDIF
RETURN lopageframe
LPARAMETERS tocontrol, tnleft, tntop, tnwidth, tnheight, ;
tnfactorx, tnfactory
LOCAL lnminheight, lnminwidth
DO CASE
CASE LOWER(tocontrol.BASECLASS) = "grid"
lnminheight = 20
lnminwidth = 20
CASE LOWER(tocontrol.BASECLASS) = "pageframe"
lnminheight = 30
lnminwidth = 30
CASE INLIST(LOWER(tocontrol.BASECLASS),"textbox","editbox")
lnminheight = 4
lnminwidth = 13
CASE INLIST(LOWER(tocontrol.BASECLASS),"line","shape")
lnminheight = 0
lnminwidth = 0
OTHERWISE
lnminheight = 4
lnminwidth = 6
ENDCASE
tnwidth = MAX(tnwidth * tnfactorx,lnminwidth)
tnheight = MAX(tnheight* tnfactory,lnminheight)
IF LOWER(tocontrol.BASECLASS) = "olecontrol"
tocontrol.TOP = tntop
tocontrol.LEFT = tnleft
tocontrol.WIDTH = tnwidth
tocontrol.HEIGHT = tnheight
ELSE
IF pemstatus(tocontrol,'Move',5)
tocontrol.MOVE(tnleft ,;
tntop ,;
tnwidth ,;
tnheight )
ELSE
IF pemstatus(tocontrol,'Width',5)
* Workaround for bug in VFP 6.0
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
tocontrol.WIDTH = tnwidth
ENDIF
ENDIF
ENDIF
ENDIF
LPARAMETERS tocontrol, tnleft, tntop, tnwidth, tnheight, ;
tnfactorx, tnfactory
LOCAL lnminheight, lnminwidth
DO CASE
CASE LOWER(tocontrol.BASECLASS) = "grid"
lnminheight = 20
lnminwidth = 20
CASE LOWER(tocontrol.BASECLASS) = "pageframe"
lnminheight = 30
lnminwidth = 30
CASE INLIST(LOWER(tocontrol.BASECLASS),"textbox","editbox")
lnminheight = 4
lnminwidth = 13
CASE INLIST(LOWER(tocontrol.BASECLASS),"line","shape")
lnminheight = 0
lnminwidth = 0
OTHERWISE
lnminheight = 4
lnminwidth = 6
ENDCASE
tnleft = tnleft * tnfactorx
tntop = tntop * tnfactory
IF LOWER(tocontrol.BASECLASS) = "olecontrol"
tocontrol.TOP = tntop
tocontrol.LEFT = tnleft
tocontrol.WIDTH = tnwidth
tocontrol.HEIGHT = tnheight
ELSE
IF pemstatus(tocontrol,'Move',5)
tocontrol.MOVE(tnleft ,;
tntop ,;
tnwidth ,;
tnheight )
ELSE
IF pemstatus(tocontrol,'Width',5)
* Workaround for bug in VFP 6.0
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
tocontrol.WIDTH = tnwidth
ENDIF
ENDIF
ENDIF
ENDIF
LPARAMETERS tocontrol, tnleft, tntop, tnwidth, tnheight, ;
tnfactorx, tnfactory
LOCAL lnminheight, lnminwidth
DO CASE
CASE LOWER(tocontrol.BASECLASS) = "grid"
lnminheight = 20
lnminwidth = 20
CASE LOWER(tocontrol.BASECLASS) = "pageframe"
lnminheight = 30
lnminwidth = 30
CASE INLIST(LOWER(tocontrol.BASECLASS),"textbox","editbox")
lnminheight = 4
lnminwidth = 13
CASE INLIST(LOWER(tocontrol.BASECLASS),"line","shape")
lnminheight = 0
lnminwidth = 0
OTHERWISE
lnminheight = 4
lnminwidth = 6
ENDCASE
tntop = tntop * tnfactory
IF LOWER(tocontrol.BASECLASS) = "olecontrol"
tocontrol.TOP = tntop
tocontrol.LEFT = tnleft
tocontrol.WIDTH = tnwidth
tocontrol.HEIGHT = tnheight
ELSE
IF pemstatus(tocontrol,'Move',5)
tocontrol.MOVE(tnleft ,;
tntop ,;
tnwidth ,;
tnheight )
ELSE
IF pemstatus(tocontrol,'Width',5)
* Workaround for bug in VFP 6.0
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
tocontrol.WIDTH = tnwidth
ENDIF
ENDIF
ENDIF
ENDIF
LPARAMETERS tocontrol, tnleft, tntop, tnwidth, tnheight, ;
tnfactorx, tnfactory
LOCAL lnminheight, lnminwidth
DO CASE
CASE LOWER(tocontrol.BASECLASS) = "grid"
lnminheight = 20
lnminwidth = 20
CASE LOWER(tocontrol.BASECLASS) = "pageframe"
lnminheight = 30
lnminwidth = 30
CASE INLIST(LOWER(tocontrol.BASECLASS),"textbox","editbox")
lnminheight = 4
lnminwidth = 13
CASE INLIST(LOWER(tocontrol.BASECLASS),"line","shape")
lnminheight = 0
lnminwidth = 0
OTHERWISE
lnminheight = 4
lnminwidth = 6
ENDCASE
tnleft = tnleft * tnfactorx
IF LOWER(tocontrol.BASECLASS) = "olecontrol"
tocontrol.TOP = tntop
tocontrol.LEFT = tnleft
tocontrol.WIDTH = tnwidth
tocontrol.HEIGHT = tnheight
ELSE
IF pemstatus(tocontrol,'Move',5)
tocontrol.MOVE(tnleft ,;
tntop ,;
tnwidth ,;
tnheight )
ELSE
IF pemstatus(tocontrol,'Width',5)
* Workaround for bug in VFP 6.0
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
tocontrol.WIDTH = tnwidth
ENDIF
ENDIF
ENDIF
ENDIF
LPARAMETERS tocontrol, tnleft, tntop, tnwidth, tnheight, ;
tnfactorx, tnfactory
LOCAL lnminheight, lnminwidth
DO CASE
CASE LOWER(tocontrol.BASECLASS) = "grid"
lnminheight = 20
lnminwidth = 20
CASE LOWER(tocontrol.BASECLASS) = "pageframe"
lnminheight = 30
lnminwidth = 30
CASE INLIST(LOWER(tocontrol.BASECLASS),"textbox","editbox")
lnminheight = 4
lnminwidth = 13
CASE INLIST(LOWER(tocontrol.BASECLASS),"line","shape")
lnminheight = 0
lnminwidth = 0
OTHERWISE
lnminheight = 4
lnminwidth = 6
ENDCASE
tnwidth = MAX(tnwidth * tnfactorx,lnminwidth)
IF LOWER(tocontrol.BASECLASS) = "olecontrol"
tocontrol.TOP = tntop
tocontrol.LEFT = tnleft
tocontrol.WIDTH = tnwidth
tocontrol.HEIGHT = tnheight
ELSE
IF pemstatus(tocontrol,'Move',5)
tocontrol.MOVE(tnleft ,;
tntop ,;
tnwidth ,;
tnheight )
ELSE
IF pemstatus(tocontrol,'Width',5)
* Workaround for bug in VFP 6.0
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
tocontrol.WIDTH = tnwidth
ENDIF
ENDIF
ENDIF
ENDIF
LPARAMETERS tocontrol, tnleft, tntop, tnwidth, tnheight, ;
tnfactorx, tnfactory
LOCAL lnminheight, lnminwidth
DO CASE
CASE LOWER(tocontrol.BASECLASS) = "grid"
lnminheight = 20
lnminwidth = 20
CASE LOWER(tocontrol.BASECLASS) = "pageframe"
lnminheight = 30
lnminwidth = 30
CASE INLIST(LOWER(tocontrol.BASECLASS),"textbox","editbox")
lnminheight = 4
lnminwidth = 13
CASE INLIST(LOWER(tocontrol.BASECLASS),"line","shape")
lnminheight = 0
lnminwidth = 0
OTHERWISE
lnminheight = 4
lnminwidth = 6
ENDCASE
tnheight = MAX(tnheight * tnfactory,lnminheight)
IF LOWER(tocontrol.BASECLASS) = "olecontrol"
tocontrol.TOP = tntop
tocontrol.LEFT = tnleft
tocontrol.WIDTH = tnwidth
tocontrol.HEIGHT = tnheight
ELSE
IF pemstatus(tocontrol,'Move',5)
tocontrol.MOVE(tnleft ,;
tntop ,;
tnwidth ,;
tnheight )
ELSE
IF pemstatus(tocontrol,'Width',5)
* Workaround for bug in VFP 6.0
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
tocontrol.WIDTH = tnwidth
ENDIF
ENDIF
ENDIF
ENDIF
LPARAMETERS tocontrol, tnleft, tntop, tnwidth, tnheight, ;
tnfactorx, tnfactory
LOCAL lnminheight, lnminwidth
DO CASE
CASE LOWER(tocontrol.BASECLASS) = "grid"
lnminheight = 20
lnminwidth = 20
CASE LOWER(tocontrol.BASECLASS) = "pageframe"
lnminheight = 30
lnminwidth = 30
CASE INLIST(LOWER(tocontrol.BASECLASS),"textbox","editbox")
lnminheight = 4
lnminwidth = 13
CASE INLIST(LOWER(tocontrol.BASECLASS),"line","shape")
lnminheight = 0
lnminwidth = 0
OTHERWISE
lnminheight = 4
lnminwidth = 6
ENDCASE
LOCAL lnfontfactor
lnfontfactor = MIN(IIF(tnfactorx > 1,tnfactorx,(tnfactorx*2+1)/3),;
IIF(tnfactory > 1,tnfactory,(tnfactory*3+1)/4))
THISFORM.FONTSIZE = THIS.nfontsize * lnfontfactor
tnleft = tnleft * tnfactorx
tntop = tntop * tnfactory
tnwidth = MAX(tnwidth * tnfactorx,lnminwidth)
tnheight = MAX(tnheight * tnfactory,lnminheight)
IF LOWER(tocontrol.BASECLASS) = "olecontrol"
tocontrol.TOP = tntop
tocontrol.LEFT = tnleft
tocontrol.WIDTH = tnwidth
tocontrol.HEIGHT = tnheight
ELSE
IF pemstatus(tocontrol,'Move',5)
tocontrol.MOVE(tnleft ,;
tntop ,;
tnwidth ,;
tnheight )
ELSE
IF pemstatus(tocontrol,'Width',5)
* Workaround for bug in VFP 6.0
IF tocontrol.BASECLASS#"Hyperlink" AND tocontrol.BASECLASS#"Activedoc"
tocontrol.WIDTH = tnwidth
ENDIF
ENDIF
ENDIF
ENDIF
LPARAMETERS tnfontsize, tocontrol, tnfontfactor
IF tnfontsize = 0
RETURN .F.
ENDIF
IF pemstatus(THISFORM,'lResizeFont',5)
IF !THISFORM.lResizeFont
RETURN .F.
ENDIF
ENDIF
IF tocontrol.BASECLASS == 'Page'
IF pemstatus(tocontrol.PARENT,'lProportionalFont',5)
IF tocontrol.PARENT.lproportionalfont
* Check for fontsize property
IF pemstatus(tocontrol,'fontsize',5)
tocontrol.FONTSIZE = MIN(tnfontsize * lnfontfactor,13)
ENDIF
ENDIF
ENDIF
ELSE
* Check for fontsize property
IF pemstatus(tocontrol,'fontsize',5)
tocontrol.FONTSIZE = tnfontsize * lnfontfactor
ENDIF
ENDIF
LOCAL j
FOR j = 1 TO THIS.ncontrolcount
THIS.acontrols[j, 2] = .NULL.
THIS.acontrols[j,10] = .NULL.
NEXT
WITH THIS
.getsystemcolors()
.BACKCOLOR = .formcolor
.line1.BORDERCOLOR = .shadowcolor
.line2.BORDERCOLOR = .hilightcolor
.line3.BORDERCOLOR = .formcolor
.line4.BORDERCOLOR = .formcolor
.line5.BORDERCOLOR = .shadowcolor
.line6.BORDERCOLOR = .hilightcolor
.line7.BORDERCOLOR = .formcolor
.line8.BORDERCOLOR = .formcolor
.line9.BORDERCOLOR = .shadowcolor
.line10.BORDERCOLOR = .hilightcolor
.line11.BORDERCOLOR = .formcolor
.line12.BORDERCOLOR = .formcolor
.nformwidth = THISFORM.WIDTH
.nformheight = THISFORM.HEIGHT
.nnewwidth = THISFORM.WIDTH
.nnewheight = THISFORM.HEIGHT
.nfontsize = THISFORM.FONTSIZE
.setpos()
.linitialized = .F.
ENDWITH
| Baseclass | Class | Object name |
|---|---|---|
| line | line | cresizectrl.Line1 |
| cresizectrl.Line10 | ||
| cresizectrl.Line11 | ||
| cresizectrl.Line12 | ||
| cresizectrl.Line2 | ||
| cresizectrl.Line3 | ||
| cresizectrl.Line4 | ||
| cresizectrl.Line5 | ||
| cresizectrl.Line6 | ||
| cresizectrl.Line7 | ||
| cresizectrl.Line8 | ||
| cresizectrl.Line9 | ||
| shape | shape | cresizectrl.oHotSpot |
| Name | Initial value |
|---|---|
| BorderColor | 255,255,255 |
| BorderStyle | 6 |
| BorderWidth | 2 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 128,128,128 |
| BorderWidth | 2 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 192,192,192 |
| BorderWidth | 1 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 192,192,192 |
| BorderWidth | 2 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 128,128,128 |
| BorderWidth | 2 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 192,192,192 |
| BorderWidth | 1 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 192,192,192 |
| BorderWidth | 2 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 255,255,255 |
| BorderStyle | 6 |
| BorderWidth | 2 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 128,128,128 |
| BorderWidth | 2 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 192,192,192 |
| BorderWidth | 1 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 192,192,192 |
| BorderWidth | 2 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BorderColor | 255,255,255 |
| BorderStyle | 6 |
| BorderWidth | 2 |
| LineSlant | "/" |
| Name | Initial value |
|---|---|
| BackStyle | 0 |
| BorderStyle | 0 |
THIS.PARENT.onoriginalsize()
**__VFX_WIZARD_HEADER - 07/16/1996 07:06:13 PM
this.cmdtop.tooltiptext = TTT_CMDTOP
this.cmdprev.tooltiptext = TTT_CMDPREV
this.cmdpreview.tooltiptext = TTT_CMDPREVIEW
this.cmdprint.tooltiptext = TTT_CMDPRINT
this.cmdnext.tooltiptext = TTT_CMDNEXT
this.cmdbottom.tooltiptext = TTT_CMDBOTTOM
this.cmdsearch.tooltiptext = TTT_CMDSEARCH
this.cmdsave.tooltiptext = TTT_CMDSAVE
this.cmdnew.tooltiptext = TTT_CMDNEW
this.cmdrecordcopy.tooltiptext = TTT_CMDRECORDCOPY
this.cmdedit.tooltiptext = TTT_CMDEDIT
this.cmddelete.tooltiptext = TTT_CMDDELETE
this.cmdundo.tooltiptext = TTT_CMDUNDO
this.cmdExit.tooltiptext = TTT_CMDCLOSE
return .t.
**__VFX_WIZARD_FOOTER
***********************************************************
DODEFAULT()
THIS.langsetup()
DODEFAULT()
LOCAL loform, lnew, lopen, lsave, lprint, lcut, lcopy, lpaste, lundo,;
lmore, LEDIT, lsearch, ldelete, ltop,lbottom,lnext,lprev,recordcopy
WITH THIS
loform = THISFORM
IF TYPE("goProgram") =="O"
lopen = goprogram.lopendialog
ENDIF
THIS.SETALL('Enabled',!lopen)
IF TYPE("loForm.lEmpty") == "L"
lnew = loform.lcaninsert
lrecordcopy = loform.lcancopy AND !loform.lempty
ltop = !loform.lempty
lbottom = !loform.lempty
lnext = !loform.lempty
lprev = !loform.lempty
.cmdsearch.ENABLED = !loform.lempty
IF !loform.lempty
LEDIT = loform.lcanedit AND loform.nformstatus = 0
ldelete = loform.lcandelete AND loform.nformstatus = 0
lprint = loform.nformstatus = 0
.cmdsearch.ENABLED = loform.nformstatus = 0
ENDIF
.cmdexit.ENABLED = loform.nformstatus = 0
lsave = loform.nformstatus # 0
lundo = loform.nformstatus # 0
ENDIF
.cmdnew.ENABLED = lnew
.cmdrecordcopy.ENABLED = lrecordcopy
.cmdsave.ENABLED = lsave
.cmdprint.ENABLED = lprint
.cmdpreview.ENABLED = lprint
.cmdundo.ENABLED = lundo
.cmdedit.ENABLED = LEDIT
.cmddelete.ENABLED = ldelete
.cmdtop.ENABLED = ltop
.cmdprev.ENABLED = lprev
.cmdnext.ENABLED = lnext
.cmdbottom.ENABLED = lbottom
ENDWITH
| Baseclass | Class | Object name |
|---|---|---|
| commandbutton | ctoolbarbutton | cspeedbar.cmdBottom |
| cspeedbar.cmdDelete | ||
| cspeedbar.cmdEdit | ||
| cspeedbar.cmdExit | ||
| cspeedbar.cmdNew | ||
| cspeedbar.cmdNext | ||
| cspeedbar.cmdPrev | ||
| cspeedbar.cmdPreview | ||
| cspeedbar.cmdPrint | ||
| cspeedbar.cmdSave | ||
| cspeedbar.cmdSearch | ||
| cspeedbar.cmdTop | ||
| cspeedbar.cmdUndo | ||
| cspeedbar.cmdrecordcopy | ||
| zzz | zzz | cspeedbar.oBorder |
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\bottom.bmp |
| TabIndex | 13 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnBottom',5)
THISFORM.onbottom()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\wzdelete.bmp |
| TabIndex | 4 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnDelete',5)
THISFORM.ondelete()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\wzedit.bmp |
| TabIndex | 3 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnEdit',5)
THISFORM.onedit()
ENDIF
NODEFAULT
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\close.bmp |
| TabIndex | 14 |
| Visible | .T. |
IF THISFORM.QUERYUNLOAD()
THISFORM.RELEASE()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\new.bmp |
| TabIndex | 1 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnInsert',5)
THISFORM.oninsert()
ENDIF
NODEFAULT
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\next.bmp |
| TabIndex | 12 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnNext',5)
THISFORM.onnext()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\prev.bmp |
| TabIndex | 11 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnPrev',5)
THISFORM.onprev()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\preview.bmp |
| TabIndex | 7 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnPrint',5)
THISFORM.onprint(.T.)
THISFORM.REFRESH()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\wzprint.bmp |
| TabIndex | 8 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnPrint',5)
THISFORM.onprint(.F.)
THISFORM.REFRESH()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\wzsave.bmp |
| TabIndex | 5 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnSave',5)
THISFORM.onsave()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\wzfind.bmp |
| TabIndex | 9 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnSearch',5)
THISFORM.onsearch()
THISFORM.REFRESH()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\top.bmp |
| TabIndex | 10 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnTop',5)
THISFORM.ontop()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\undo.bmp |
| TabIndex | 6 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnUndo',5)
THISFORM.onundo()
ENDIF
| Name | Initial value |
|---|---|
| Enabled | .T. |
| Picture | ..\bitmap\toolbar\copyreco.bmp |
| TabIndex | 2 |
| Visible | .T. |
IF pemstatus(THISFORM,'OnCopy',5)
THISFORM.oncopy()
ENDIF
NODEFAULT
| Name | Initial value |
|---|---|
| Caption | "" |
| Comment | " |
| FontBold | .F. |
| Name | Initial value |
|---|---|
| BackStyle | 1 |
| BorderWidth | 0 |
| Comment | " |
| Name | Initial value | Comment |
|---|---|---|
| ltopfix | .T. | Specifies if the control will be always aligned to the top left of the form |
DODEFAULT()
IF THIS.ltopfix
THIS.TOP = 0
THIS.LEFT = 0
ENDIF
THIS.oborder.MOVE(0,0,THIS.WIDTH,THIS.HEIGHT)
FOR j = 1 TO THIS.CONTROLCOUNT
THIS.CONTROLS[j].ZORDER(0)
NEXT
THIS.oborder.ZORDER(1)
IF THIS.ltopfix
THIS.TOP = 0
THIS.LEFT = 0
ENDIF
THIS.oborder.MOVE(0,0,THIS.WIDTH,THIS.HEIGHT)
FOR j = 1 TO THIS.CONTROLCOUNT
THIS.CONTROLS[j].ZORDER(0)
NEXT
THIS.oborder.ZORDER(1)
THIS.ZORDER(0)
| Baseclass | Class | Object name |
|---|---|---|
| shape | shape | ctoolbarcontrol.oBorder |
| Name | Initial value |
|---|---|
| BackStyle | 0 |
| Comment | " |
| SpecialEffect | 0 |