Page History
この例では、社員を1つのフォームからドラッグし、他のフォームにドロップします。
これがソースのフォームです。
これがターゲットのフォームです。
Ctrlキーを押されずに社員がドラッグされると、ソース・フォームからターゲット・フォームに移動されます。Ctrlキーを押された場合は、社員はソース・フォームからターゲット・フォームにコピーされます。
...
このソースをコピーしてフォームに貼り付け、コンパイルして実行してください。
...
FUNCTION options(*DIRECT)
BEGIN_
...
COM role(*
...
EXTENDS #PRIM_FORM)
...
HEIGHT(258)
...
LAYOUTMANAGER(#ATLM_1)
...
LEFT(302)
...
TOP(108)
...
VISUALSTYLE(#VS_NORM)
...
WIDTH(662)
DEFINE_
...
COM class(#PRIM_ATLM)
...
name(#ATLM_1)
DEFINE_
...
COM class(#PRIM_STBR)
...
name(#STBR_1)
...
DISPLAYPOSITION(1)
...
HEIGHT(24)
...
LEFT(0)
...
MESSAGEPOSITION(1)
...
PARENT(#COM_OWNER)
...
TABPOSITION(1)
...
TABSTOP(False)
...
TOP(207)
...
WIDTH(654)
DEFINE_
...
COM class(#PRIM_ATLI)
...
name(#ATLI_1)
...
ATTACHMENT(Bottom)
...
MANAGE(#STBR_1)
...
PARENT(#ATLM_1)
DEFINE_
...
COM class(#PRIM_LTVW)
...
name(#LTVW_1)
...
DISPLAYPOSITION(2)
...
DRAGSTYLE(Automatic)
...
FULLROWSELECT(True)
...
HEIGHT(207)
...
LEFT(0)
...
PARENT(#COM_OWNER)
...
TABPOSITION(2)
...
TOP(0)
...
WIDTH(654)
DEFINE_
...
COM class(#PRIM_ATLI)
...
name(#ATLI_2)
...
ATTACHMENT(Center)
...
MANAGE(#LTVW_1)
...
PARENT(#ATLM_1)
DEFINE_
...
COM class(#PRIM_LVCL)
...
name(#LVCL_1)
...
DISPLAYPOSITION(1)
...
PARENT(#LTVW_1)
...
SOURCE(#EMPNO)
...
WIDTH(16)
DEFINE_
...
COM class(#PRIM_LVCL)
...
name(#LVCL_2)
...
DISPLAYPOSITION(2)
...
PARENT(#LTVW_1)
...
SOURCE(#SURNAME)
...
WIDTH(20)
DEFINE_
...
COM class(#PRIM_LVCL)
...
name(#LVCL_3)
...
DISPLAYPOSITION(3)
...
PARENT(#LTVW_1)
...
SOURCE(#GIVENAME)
...
WIDTH(20)
DEFINE_
...
COM class(#PRIM_LVCL)
...
name(#LVCL_4)
...
DISPLAYPOSITION(4)
...
PARENT(#LTVW_1)
...
SOURCE(#DEPTMENT)
...
WIDTH(20)
DEFINE_COM class(#PRIM_LVCL) name(#LVCL_5) DISPLAYPOSITION(5) PARENT(#LTVW_1) SOURCE(#SECTION) WIDTH(20)
DEFINE_COM class(#DD_TARGET) name(#DD_TARGET)
...
EVTROUTINE handling(#com_owner.CreateInstance)
...
SET com(#com_owner)
...
CAPTION(*component_desc)
...
SELECT fields(#LTVW_1)
...
from_file(PSLMST)
ADD_
...
ENTRY to_list(#LTVW_1)
ENDSELECT
...
INVOKE method(#dd_target.showform)
...
INVOKE method(#com_owner.activateform)
ENDROUTINE
...
EVTROUTINE handling(#LTVW_1.StartDrag)
...
PAYLOAD(#Payload)
DEFINE_COM class(#dd_emppl) name(#Local_Payload)
...
* Create payload
SELECTLIST named(#LTVW_1)
...
CONTINUE if('#ltvw_1.currentitem.
...
selected =
...
False')
...
INVOKE method(#Local_Payload.Add_to_payload)
...
EMPLOYEE_ID(#empno)
...
EMPLOYEE_SURNAME(#surname)
...
EMPLOYEE_GIVENAME(#givename)
...
EMPLOYEE_DEPARTMENT(#deptment)
...
EMPLOYEE_SECTION(#section)
ENDSELECT
...
* Move temporary payload to Drag Manager.
* Temporary Payload is destroyed at the end of the routine
SET_REF com(#payload) to(#Local_Payload)
ENDROUTINE
...
* Check Drag result
EVTROUTINE handling(#LTVW_1.EndDrag)
...
PAYLOAD(#payload)
...
DRAGRESULT(#DragResult)
DEFINE_COM class(#dd_emppl) name(#Local_Payload) reference(*dynamic)
SET_REF com(#Local_payload) to(*dynamic #Payload)
CHANGE field(#STD_OBJ) to('#DRAGRESULT.VALUE')
IF cond('#DragResult.value = Accepted')
...
* Control key down then copying
IF cond('#sys_keybd.ControlkeyDown = False')
...
SELECTLIST named(#LTVW_1)
...
CONTINUE if('#ltvw_1.currentitem.
...
selected =
...
False')
DLT_
...
ENTRY from_list(#LTVW_1)
ENDSELECT
ENDIF
ENDIF
ENDROUTINE
...
EVTROUTINE handling(#COM_OWNER.Closing)
...
options(*
...
NOCLEARMESSAGES *NOCLEARERRORS)
...
INVOKE method(#dd_target.closeform)
ENDROUTINE
END_COM
ターゲット・フォームのソース
このソースをコピーしてフォームに貼り付け、コンパイルして実行してください。このフォームは自動的にソース・フォームから表示されます。
...
FUNCTION options(*DIRECT)
BEGIN_
...
COM role(*
...
EXTENDS #PRIM_FORM)
...
HEIGHT(256)
...
LAYOUTMANAGER(#ATLM_1)
...
LEFT(314)
...
TOP(356)
...
VISUALSTYLE(#VS_NORM)
...
WIDTH(644)
DEFINE_
...
COM class(#PRIM_ATLM)
...
name(#ATLM_1)
DEFINE_
...
COM class(#PRIM_STBR)
...
name(#STBR_1)
...
DISPLAYPOSITION(1)
...
HEIGHT(24)
...
LEFT(0)
...
MESSAGEPOSITION(1)
...
PARENT(#COM_OWNER)
...
TABPOSITION(1)
...
TABSTOP(False)
...
TOP(205)
...
WIDTH(636)
DEFINE_
...
COM class(#PRIM_ATLI)
...
name(#ATLI_1)
...
ATTACHMENT(Bottom)
...
MANAGE(#STBR_1)
...
PARENT(#ATLM_1)
DEFINE_
...
COM class(#PRIM_LTVW)
...
name(#LTVW_1)
...
DISPLAYPOSITION(2)
...
FULLROWSELECT(True)
...
HEIGHT(205)
...
LEFT(0)
...
PARENT(#COM_OWNER)
...
TABPOSITION(2)
...
TOP(0)
...
WIDTH(636)
DEFINE_
...
COM class(#PRIM_ATLI)
...
name(#ATLI_2)
...
ATTACHMENT(Center)
...
MANAGE(#LTVW_1)
...
PARENT(#ATLM_1)
DEFINE_
...
COM class(#PRIM_LVCL)
...
name(#LVCL_1)
...
DISPLAYPOSITION(1)
...
PARENT(#LTVW_1)
...
SOURCE(#EMPNO)
...
WIDTH(16)
DEFINE_
...
COM class(#PRIM_LVCL)
...
name(#LVCL_2)
...
DISPLAYPOSITION(2)
...
PARENT(#LTVW_1)
...
SOURCE(#SURNAME)
...
WIDTH(20)
DEFINE_
...
COM class(#PRIM_LVCL)
...
name(#LVCL_3)
...
DISPLAYPOSITION(3)
...
PARENT(#LTVW_1)
...
SOURCE(#GIVENAME)
...
WIDTH(20)
DEFINE_
...
COM class(#PRIM_LVCL)
...
name(#LVCL_4)
...
DISPLAYPOSITION(4)
...
PARENT(#LTVW_1)
...
SOURCE(#DEPTMENT)
...
WIDTH(20)
DEFINE_COM class(#PRIM_LVCL) name(#LVCL_5) DISPLAYPOSITION(5) PARENT(#LTVW_1) SOURCE(#SECTION) WIDTH(20)
...
EVTROUTINE handling(#com_owner.CreateInstance)
...
SET com(#com_owner)
...
CAPTION(*component_desc)
ENDROUTINE
...
EVTROUTINE handling(#ltvw_1.DragOver)
...
PAYLOAD(#payload)
...
ACCEPTDROP(#AcceptDrop)
...
DRAGCURSOR(#Cursor)
...
* If an instance of the Employee "Payload"
SET com(#Acceptdrop) VALUE(true)
IF cond('#sys_keybd.ControlkeyDown = False')
SET_REF com(#cursor) to(#dd_curmov)
ELSE
SET_REF com(#cursor) to(#dd_curcpy)
ENDIF
ENDROUTINE
...
EVTROUTINE handling(#ltvw_1.DragDrop)
...
PAYLOAD(#payload)
DEFINE_COM class(#dd_emppl) name(#Local_Payload) reference(*dynamic)
SET_REF com(#Local_Payload) to(*dynamic #Payload
...
* Get the number of items from the payload
CHANGE field(#STD_NUM) to('#Local_Payload.Payload_Items'
...
* Get the number of items data from the payload
BEGIN_
...
LOOP using(#LISTENTRY)
...
to(#STD_NUM)
...
INVOKE method(#Local_Payload.Get_Payload_Item)
...
PAYLOAD_ITEM(#listentry)
...
EMPLOYEE_ID(#empno)
...
EMPLOYEE_SURNAME(#surname)
...
EMPLOYEE_GIVENAME(#givename)
...
EMPLOYEE_DEPARTMENT(#deptment)
...
EMPLOYEE_SECTION(#section)
ADD_
...
ENTRY to_list(#LTVW_1)
END_LOOP
SET_REF com(#Local_Payload) to(*null)
ENDROUTINE
END_COM