[ 
|../../index.htm#lansa/l4wdev06_0695.htm]
現在地:
2.23.2 例1: ツリー内で社員を移動
この例には、部門、セクション、社員のツリー・ビューがあります。ドラッグ・アンド・ドロップにより社員をセクション間で移動できます。
社員をドラッグ・アンド・ドロップするツリーのソース
このソースをコピーしてフォームに貼り付け、コンパイルして実行してください。この例が動作するためには、DD_EMPPL Payloadのソースを再利用可能パーツとしてコンパイルしておく必要があります。
FUNCTION options(*DIRECT)
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 class(#PRIM_ATLI) name(#ATLI_4) ATTACHMENT(Bottom) PARENT(#ATLM_1) * Employee Payload object DEFINE_COM class(#dd_emppl) name(#PAYLOAD) reference(*dynamic) DEFINE field(#W_EMPNO) reffld(#EMPNO) DEFINE field(#W_DEPT) reffld(#DEPTMENT) DEFINE field(#W_SECT) reffld(#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 com(#tvcl_3) IMAGE(#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 handling(#TRVW_1.StartDrag) options(*NOCLEARMESSAGES *NOCLEARERRORS) CONTINUE(#continue) USE builtin(CLR_MESSAGES) * Create Payload Instance SET_REF com(#payload) to(*create_as #dd_emppl) * Only allow employee to be dragged IF cond('#Trvw_1.currentitem.level = 3') * 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 com(#showhilight) VALUE(true) * If a department, employee cannot be dropped IF_REF com(#trvw_1.currentitem) is_not(*null) IF cond('(#trvw_1.currentitem.level *ne 1)') * Allow drop and set new cursor SET com(#acceptdrop) VALUE(true) ELSE * Disable drop SET com(#acceptdrop) VALUE(False) ENDIF ENDIF ENDROUTINE EVTROUTINE handling(#TRVW_1.DragDrop) options(*NOCLEARERRORS *NOCLEARMESSAGES) * If the payload is not empty, get the payload item and add to the treeview in the new section IF cond('#Payload.Payload_Items *ne *zero') * Return values in to working fields fields to compare with current item values INVOKE method(#Payload.Get_Payload_Item) PAYLOAD_ITEM(1) EMPLOYEE_ID(#empno) EMPLOYEE_DEPARTMENT(#w_dept) EMPLOYEE_SECTION(#w_sect) * If the department and/or section have changed, do the drop IF cond('(#deptment *ne #W_dept) or (#section *ne #w_sect)') * Department and section values of currentitem are used ADD_ENTRY to_list(#TRVW_1) MESSAGE msgtxt(' Drop Successful') * Expand Parent items of new drop point * As drop can only happen on a section, department must be expanded CHANGE field(#W_DEPT) to(#DEPTMENT) CHANGE field(#W_SECT) to(#section) SELECTLIST named(#TRVW_1) CONTINUE if('#w_dept *ne #deptment') CONTINUE if('#w_sect *ne #section') SET com(#trvw_1.currentitem) EXPANDED(true) LEAVE ENDSELECT ENDIF ENDIF ENDROUTINE EVTROUTINE handling(#TRVW_1.EndDrag) options(*NOCLEARERRORS *NOCLEARMESSAGES) DRAGRESULT(#DragResult) IF cond('#Dragresult.value = Accepted') * 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 method(#Payload.Get_Payload_Item) PAYLOAD_ITEM(1) EMPLOYEE_ID(#w_empno) EMPLOYEE_DEPARTMENT(#w_dept) EMPLOYEE_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 if('#w_empno *ne #empno') DLT_ENTRY from_list(#TRVW_1) LEAVE ENDSELECT ENDIF ENDIF ENDROUTINE END_COM
[ |../../index.htm#lansa/l4wdev06_0695.htm]