Разработка специализированного программного продукта по работе со счетами-фактуры

** Code for adding record

this.Parent.OldAlias = ALIAS() &&save alias in case reverting

this.Parent.oldrec = RECNO() &&save record in case reverting

IF CURSORGETPROP("SourceType")#3 AND ;

!CURSORGETPROP("offline") AND ;

!CURSORGETPROP("SendUpdates")

=MESSAGEBOX(C_NOUPDATE_LOC)

RETURN

ENDIF

APPEND BLANK

OTHERWISE

** Code for adding record

this.Parent.OldAlias = ALIAS() &&save alias in case reverting

this.Parent.oldrec = RECNO() &&save record in case reverting

lPrimeKey = .F. &&is child key primary index

IF !EMPTY(THIS.Parent.oDataRelation)

oRel = EVAL(THIS.Parent.oDataRelation)

ENDIF

DO CASE

CASE TYPE("m.oRel") = "O" &&data environment

WITH oRel

cPapaAlias = .ParentAlias

cPapaKey = .RelationalExpr

cChildAlias = .ChildAlias

cChildKey = .ChildOrder

ENDWITH

oRel = .NULL. &&reset

CASE !EMPTY(THIS.Parent.viewkey) &&using views

cPapaAlias = ALIAS()

cPapaKey = THIS.Parent.ParentKey

cChildAlias = THIS.Parent.GridAlias

cChildKey = THIS.Parent.viewkey

* Need to check if Key field is updatable

IF CURSORGETPROP("SourceType",m.cChildAlias)#3 AND !CURSORGETPROP("offline",m.cChildAlias) AND ;

ATC(","+m.cChildKey+",",","+CURSORGETPROP("UpdatableFieldList",m.cChildAlias)+",")=0

lBadViewKey = .T.

ENDIF

OTHERWISE

cPapaAlias = ALIAS()

cPapaKey = RELATION(1)

cChildAlias = THIS.Parent.GridAlias

cChildKey = ORDER(m.cChildAlias)

ENDCASE

* Test to see if both keys are of the same data type

SELECT (THIS.Parent.GridAlias)

cGridKeyType = ""

IF EMPTY(THIS.Parent.viewkey) AND !EMPTY(m.cChildKey) &&regular table used

* Get the Child Key field since only index tag is here

* if these is an expression, then default to blank.

cTagName = ""

FOR i = 1 TO TagCount("")

IF UPPER(TAG(m.i)) == UPPER(m.cChildKey)

cTagName = KEY(m.i)

lPrimeKey = PRIMARY(m.i)

EXIT

ENDIF

ENDFOR

* Check if we have an index expression here.

IF ATC("(",m.cTagName)#0 OR ATC("+",m.cTagName)#0

cChildKey = ""

ELSE

cChildKey = m.cTagName

cGridKeyType = TYPE(m.cChildKey)

ENDIF

ENDIF

IF CURSORGETPROP("SourceType",m.cPapaAlias)#3 AND !CURSORGETPROP("offline",m.cPapaAlias) AND ;

!CURSORGETPROP("SendUpdates",m.cPapaAlias)

lNoSendParentUpdates = .T.

ENDIF

IF CURSORGETPROP("SourceType",m.cChildAlias)#3 AND !CURSORGETPROP("offline",m.cChildAlias) AND ;

!CURSORGETPROP("SendUpdates",m.cChildAlias)

lNoSendChildUpdates = .T.

ENDIF

* Check if have two views and both do not send updates

IF m.lNoSendParentUpdates AND m.lNoSendChildUpdates

=MESSAGEBOX(C_NOUPDATE_LOC)

RETURN

ENDIF

SELECT (THIS.Parent.OldAlias )

IF !EMPTY(m.cGridKeyType) AND m.cGridKeyType # TYPE(m.cPapaKey)

lBadChildKey = .T.

ENDIF

DO CASE

CASE m.lNoSendParentUpdates AND (m.lBadViewKey OR m.lBadChildKey)

=MESSAGEBOX(C_NOUPDATE_LOC)

RETURN

CASE m.lPrimeKey AND m.lNoSendParentUpdates

=MESSAGEBOX(C_NOUPDATE2_LOC)

RETURN

CASE m.lNoSendChildUpdates &&child view does not send updates

IF MESSAGEBOX(C_NOCHILDUPDATE_LOC,MB_Q_YESNO) # MB_A_YES

RETURN

ENDIF

APPEND BLANK

CASE m.lBadViewKey &&view key in not updatable

IF MESSAGEBOX(C_KEYFLDNOUPDATE_LOC,MB_Q_YESNO) # MB_A_YES

RETURN

ENDIF

APPEND BLANK

CASE m.lBadChildKey &&bad child key -- different data type from parent

IF MESSAGEBOX(C_BADCHILDKEY_LOC,MB_Q_YESNO) # MB_A_YES

RETURN

ENDIF

APPEND BLANK

OTHERWISE

* Need to check if Key field is updatable

lUpdatableParentKey = .T.

IF CURSORGETPROP("SourceType",m.cPapaAlias)#3 AND !CURSORGETPROP("offline",m.cPapaAlias) AND;

ATC(","+m.cPapaKey+",",","+CURSORGETPROP("UpdatableFieldList",m.cPapaAlias)+",")=0

* cPapaKey = ""

lUpdatableParentKey = .F.

ENDIF

* Check for expression in cPapaKey if so, then do not update record with keyvalue

IF ATC("(",m.cPapaKey)#0 OR ATC("+",m.cPapaKey)#0

cPapaKey = ""

ENDIF

nSaveSess = SET("DATASESSION")

oAddRec = CREATE("GridAddRec")

IF TYPE("m.oAddRec") # "O"

=MESSAGEBOX(C_NOOBJ_LOC)

RETURN

ENDIF

oAddRec.ChildPrimaryKey = m.lPrimeKey

oAddRec.UpdatableParentKey = m.lUpdatableParentKey

oAddRec.NoSendUpdates = m.lNoSendParentUpdates

oAddRec.KeyField = m.cPapaKey

oAddRec.KeyValue = IIF(!EMPTY(m.cPapaKey),EVAL(m.cPapaKey),"")

oAddRec.runaddform()

IF oAddRec.AddOption = OPT_CANCEL

RETURN

ENDIF

SET DATASESSION TO nSaveSess

SELECT (THIS.Parent.OldAlias)

IF TYPE("oAddRec.KeyValue") = "C"

oAddRec.KeyValue = TRIM(oAddRec.KeyValue)

ENDIF

* Add record to parent table

nSaveRec = RECNO()

IF INLIST(oAddRec.AddOption,OPT_ADD_PARENT,OPT_ADD_BOTH)

IF EMPTY(m.cPapaKey)

APPEND BLANK IN (m.cPapaAlias)

ELSE

INSERT INTO (m.cPapaAlias) ((oAddRec.KeyField)) VALUES(oAddRec.KeyValue)

ENDIF

ENDIF

nSaveRec2 = RECNO()

* Add child record

IF INLIST(oAddRec.AddOption,OPT_ADD_CHILD,OPT_ADD_BOTH)

* Need to check

GO m.nSaveRec

IF EMPTY(m.cChildKey) OR TYPE("m.cChildKey")#TYPE('oAddRec.KeyValue')

APPEND BLANK IN (m.cChildAlias)

ELSE

INSERT INTO (m.cChildAlias) ((m.cChildKey)) VALUES(oAddRec.KeyValue)

ENDIF

GO m.nSaveRec2

ENDIF

ENDCASE

ENDCASE

this.Parent.EditMode = !THIS.Parent.EditMode

this.Parent.AddMode = THIS.Parent.EditMode

this.Parent.topfile = .F.

thisform.LockScreen = .T.

this.Parent.ButtonRefresh()

this.Parent.NavRefresh()

thisform.LockScreen = .F.

ENDPROC

PROCEDURE Error

LPARAMETERS nError, cMethod, nLine

this.parent.error(m.nError, m.cMethod, m.nLine)

ENDPROC

PROCEDURE Click

#DEFINE MSGBOX_YES 6

#DEFINE C_MSGBOX1 36

#DEFINE C_DELETE_LOC "Aы oотите удалить yту запись?"

#DEFINE C_NOLOCK_LOC "Запись не может быть удалена, так как используется."

* Note: Cascading deletes should be handled via RI triggers in DBC!

IF DELETED()

RECALL

ELSE

IF MESSAGEBOX(C_DELETE_LOC,C_MSGBOX1) = MSGBOX_YES

Delete

IF THIS.Parent.UpdateRows() &&success

* Success

IF !EOF()

Skip 1

ENDIF

IF EOF() AND !BOF()

Skip -1

ENDIF

ENDIF

thisform.LockScreen = .T.

this.Parent.ButtonRefresh()

this.Parent.NavRefresh()

thisform.LockScreen = .F.

ENDIF

ENDIF

IF THISFORM.ShowWindow = 2

Activate Window (THISFORM.Name)

ENDIF

ENDPROC

PROCEDURE Error

LPARAMETERS nError, cMethod, nLine

this.parent.error(m.nError, m.cMethod, m.nLine)

ENDPROC

PROCEDURE Click

#DEFINE C_NOUPDATE_LOC "You cannot edit because the view(s) selected does not send updates."

LOCAL lNoSendParentUpdates,lNoSendChildUpdates

LOCAL aTablesUsed,nTablesUsed,i

** Reverting record

IF THIS.Parent.EditMode

IF THIS.Parent.usedataenv

SELECT (THIS.Parent.OldAlias)

IF CURSORGETPROP("Buffering")>1

=TableRevert(.T.)

ENDIF

IF !EMPTY(THIS.Parent.GridAlias)

SELECT (THIS.Parent.GridAlias)

IF CURSORGETPROP("Buffering")>1

=TableRevert(.T.)

ENDIF

ENDIF

ELSE

DIMENSION aTablesUsed[1]

m.nTablesUsed = AUSED(aTablesUsed)

FOR i = 1 TO m.nTablesUsed

IF CURSORGETPROP("Buffering",aTablesUsed[m.i,1])>1

=TableRevert(.T.,aTablesUsed[m.i,1])

ENDIF

ENDFOR

ENDIF

* Go back to original place

SELECT (THIS.Parent.OldAlias)

IF RECCOUNT() < THIS.Parent.oldrec &&added record at EOF()

GO TOP

ELSE

GO THIS.Parent.oldrec

ENDIF

ELSE

* Check to see if view allows updates

IF CURSORGETPROP("SourceType")#3 AND !CURSORGETPROP("offline") AND;

!CURSORGETPROP("SendUpdates")

lNoSendParentUpdates = .T.

ENDIF

IF !EMPTY(THIS.Parent.GridAlias) AND ;

CURSORGETPROP("SourceType",THIS.Parent.GridAlias)#3 AND ;

!CURSORGETPROP("offline",THIS.Parent.GridAlias) AND ;

!CURSORGETPROP("SendUpdates",THIS.Parent.GridAlias)

lNoSendChildUpdates= .T.

ENDIF

IF (m.lNoSendChildUpdates AND m.lNoSendParentUpdates) OR;

(EMPTY(THIS.Parent.GridAlias) AND m.lNoSendParentUpdates)

=MESSAGEBOX(C_NOUPDATE_LOC)

RETURN

ENDIF

this.Parent.OldAlias = ALIAS() &&save alias in case reverting

this.Parent.oldrec = RECNO() &&save record in case reverting

ENDIF

** Editing record

this.Parent.EditMode = !THIS.Parent.EditMode

this.Parent.AddMode = .F.

thisform.LockScreen = .T.

this.Parent.ButtonRefresh()

this.Parent.NavRefresh()

thisform.LockScreen = .F.

ENDPROC

PROCEDURE Error

LPARAMETERS nError, cMethod, nLine

this.parent.error(m.nError, m.cMethod, m.nLine)

ENDPROC

Размещено на Allbest.ru