Page History

...

BEGIN_COM role(*EXTENDS #PRIM_FORM) CAPTION('Move Employees') HEIGHT(359) LAYOUTMANAGER(#ATLM_1) LEFT(304) TOP(112) WIDTH(274)
DEFINE_COM class(#PRIM_ATLM) name(#ATLM_1)
DEFINE_COM class(#PRIM_TRVW) name(#TRVW_1) DISPLAYPOSITION(1) DRAGSTYLE(Automatic) HEIGHT(332) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(1) TOP(0) WIDTH(266)
DEFINE_COM class(#PRIM_TVCL) name(#TVCL_1) DISPLAYPOSITION(1) KEYPOSITION(1) LEVEL(1) PARENT(#TRVW_1) SORTPOSITION(1) SOURCE(#DEPTMENT)
DEFINE_COM class(#PRIM_TVCL) name(#TVCL_2) DISPLAYPOSITION(1) KEYPOSITION(1) LEVEL(2) PARENT(#TRVW_1) SORTPOSITION(1) SOURCE(#SECTION)
DEFINE_COM class(#PRIM_TVCL) name(#TVCL_3) DISPLAYPOSITION(1) KEYPOSITION(1) LEVEL(3) PARENT(#TRVW_1) SORTPOSITION(1) SOURCE(#EMPNO)
DEFINE_COM class(#PRIM_ATLI) name(#ATLI_1) ATTACHMENT(Center) MANAGE(#TRVW_1) PARENT(#ATLM_1)
DEFINE_COM class(#PRIM_STBR) name(#STBR_1) DISPLAYPOSITION(2) HEIGHT(24) LEFT(0) MESSAGEPOSITION(1) PARENT(#COM_OWNER) TABPOSITION(2) TABSTOP(False) TOP(308) WIDTH(266)
DEFINE_COM classCOM class(#PRIM_ATLI)  namename(#ATLI_4)  ATTACHMENTATTACHMENT(Bottom)  PARENTPARENT(#ATLM_1)
 
* Employee Payload object
DEFINE_COM classCOM class(#dd_emppl)  namename(#PAYLOAD)  referencereference(*dynamic)
 
DEFINE field(#W_EMPNO) reffld(#EMPNO)
DEFINE field(#W_DEPT) reffld(#DEPTMENT)
DEFINE fieldDEFINE field(#W_SECT)  reffldreffld(#SECTION)
 
EVTROUTINE handling(#com_owner.CreateInstance) options(*NOCLEARERRORS *NOCLEARMESSAGES)
* Tree view images
SET com(#tvcl_1) IMAGE(#vi_foldcl) IMAGEEXPANDED(#vi_foldop)
SET com(#tvcl_2) IMAGE(#vi_sectcl) IMAGEEXPANDED(#vi_sectop)
SET comSET com(#tvcl_3)  IMAGEIMAGE(#vi_employ)
 
* Populate Tree
SELECT fields(#TRVW_1) from_file(DEPTAB)
SELECT fields(#TRVW_1) from_file(SECTAB) with_key(#DEPTMENT)
SELECT fields(#TRVW_1) from_file(PSLMST1) with_key(#DEPTMENT #SECTION)
ADD_ENTRY to_list(#TRVW_1)
ENDSELECT
ENDSELECT
ENDSELECT
ENDROUTINE
 
* Start the drag operation.
* Only allow employees to be "dragged"
EVTROUTINE handlingEVTROUTINE handling(#TRVW_1.StartDrag)  optionsoptions(*NOCLEARMESSAGES NOCLEARMESSAGES *NOCLEARERRORS)  CONTINUECONTINUE(#continue)
 
USE builtinUSE builtin(CLR_MESSAGES)
 
* Create Payload Instance
SET_REF comREF com(#payload)  toto(*create_as #ddas #dd_emppl)
 
* Only allow employee to be dragged
IF condIF cond('#Trvw_1.currentitem.level level =  33')
 
* Add item to the payload
INVOKE method(#Payload.Add_to_payload) EMPLOYEE_ID(#empno) EMPLOYEE_DEPARTMENT(#deptment) EMPLOYEE_SECTION(#section)
ELSE
 
SET com(#continue) VALUE(false)
ENDIF
 
ENDROUTINE
 
EVTROUTINE handling(#TRVW_1.DragOver) options(*NOCLEARERRORS *NOCLEARMESSAGES) ACCEPTDROP(#acceptdrop) SHOWDROPHILIGHT(#ShowHilight)
* Show Item dragged over
SET comSET com(#showhilight)  VALUEVALUE(true)
 
* If a department, employee cannot be dropped
IF_REF comREF com(#trvw_1.currentitem)  isis_not(*null)
 
IF condIF cond('(#trvw_1.currentitem.level level *ne 1ne 1)')
 
* Allow drop and set new cursor
SET comSET com(#acceptdrop)  VALUEVALUE(true)
 
ELSE
 
* Disable drop
SET comSET com(#acceptdrop)  VALUEVALUE(False)
 
ENDIF
 
ENDIF
ENDROUTINE
 
EVTROUTINE handlingEVTROUTINE handling(#TRVW_1.DragDrop)  optionsoptions(*NOCLEARERRORS NOCLEARERRORS *NOCLEARMESSAGES)
 
* If the payload is not empty, get the payload item and add to the treeview in the new section
IF condIF cond('#Payload.Payload_Items Items *ne ne *zero')
 
* Return values in to working fields fields to compare with current item values
INVOKE methodINVOKE method(#Payload.Get_Payload_Item)  PAYLOADPAYLOAD_ITEM(1)  EMPLOYEEEMPLOYEE_ID(#empno)  EMPLOYEEEMPLOYEE_DEPARTMENT(#w_dept)  EMPLOYEEEMPLOYEE_SECTION(#w_sect)
 
* If the department and/or section have changed, do the drop
IF condIF cond('(#deptment #deptment *ne #Wne #W_dept)  or or (#section #section *ne #wne #w_sect)')
 
* Department and section values of currentitem are used
ADD_ENTRY toENTRY to_list(#TRVW_1)
 
MESSAGE msgtxtMESSAGE msgtxt('  Drop SuccessfulDrop Successful')
 
* Expand Parent items of new drop point
*  As drop can only happen on a section, department must be expanded
 
As drop can only happen on a section, department must be expanded
CHANGE field(#W_DEPT) to(#DEPTMENT)
CHANGE fieldCHANGE field(#W_SECT)  toto(#section)
 
SELECTLIST namedSELECTLIST named(#TRVW_1)
 
CONTINUE if('#w_dept *ne #deptment')
CONTINUE ifCONTINUE if('#w_sect sect *ne #sectionne #section')
 
SET comSET com(#trvw_1.currentitem)  EXPANDEDEXPANDED(true)
 
LEAVE
ENDSELECT
 
ENDIF
 
ENDIF
 
ENDROUTINE
 
EVTROUTINE handlingEVTROUTINE handling(#TRVW_1.EndDrag)  optionsoptions(*NOCLEARERRORS NOCLEARERRORS *NOCLEARMESSAGES)  DRAGRESULTDRAGRESULT(#DragResult)
 
IF condIF cond('#Dragresult.value value =  AcceptedAccepted')
 
* If the department and/or section have changed delete the source employee
IF cond('(#deptment *ne #w_dept) or (#section *ne #w_sect)')
* Get payload item details
INVOKE methodINVOKE method(#Payload.Get_Payload_Item)  PAYLOADPAYLOAD_ITEM(1)  EMPLOYEEEMPLOYEE_ID(#w_empno)  EMPLOYEEEMPLOYEE_DEPARTMENT(#w_dept)  EMPLOYEEEMPLOYEE_SECTION(#w_sect)
 
* Locate and Delete source employee
SELECTLIST named(#TRVW_1)
CONTINUE if('#w_dept *ne #deptment')
CONTINUE if('#w_sect *ne #section')
CONTINUE ifCONTINUE if('#w_empno empno *ne #empnone #empno')
 
DLT_ENTRY fromENTRY from_list(#TRVW_1)
 
LEAVE
ENDSELECT
 
ENDIF
ENDIF
ENDROUTINE
END_COM