(this time I don't use attachment !!!)
The complete code is :
============================================================================
=============
Include "../mapbasic.def"
Include "../menu.def"
Include "../icons.def"
Declare Sub Main
Declare Sub WinChangedHandler
Declare Sub SelChangedHandler
Declare Sub TestMoveDisplaySymbols
Declare Sub QuitTestMove
Dim sel_rowid,
rowid_obj(0)
As Integer
Dim flt_x(0),
flt_y(0)
As Float
'=======
Sub Main
'=======
OnError Goto ErreurMain
Create ButtonPad "Test Move" As
PushButton
Icon MI_ICON_ARROW
Calling TestMoveDisplaySymbols
PushButton
Icon MI_ICON_ARROW
Calling QuitTestMove
HelpMsg "Close the application."
Position (9.15,4.75) Units "in"
Width 4
Show
Exit Sub
ErreurMain:
Note "Error into Sub Main : " + Error$()
End Sub
'=========================
Sub TestMoveDisplaySymbols
'=========================
Dim myobj
As Object
Dim i_size,
r1,
r2,
r3
As Integer
OnError Goto ErrorTestMoveDisplaySymbols
i_size=0
Create Table MY_SYMBOLS
( number Integer,
name Char(20))
File "c:\temp\my_symbols"
Type DBF
Insert Into MY_SYMBOLS (number, name) Values(1, "first symbol")
r1 = TableInfo(MY_SYMBOLS, TAB_INFO_NROWS)
Insert Into MY_SYMBOLS (number, name) Values(2, "second symbol")
r2 = TableInfo(MY_SYMBOLS, TAB_INFO_NROWS)
Insert Into MY_SYMBOLS (number, name) Values(3, "third symbol")
r3 = TableInfo(MY_SYMBOLS, TAB_INFO_NROWS)
Create Map For MY_SYMBOLS CoordSys Earth Projection 1,0
Create Point Into Variable myobj (10, 10) Symbol MakeSymbol(10+30,
RED, 28)
Update MY_SYMBOLS Set Obj=myobj Where RowId=r1
i_size = Ubound(rowid_obj)+1
ReDim rowid_obj(i_size)
rowid_obj(i_size)=r1
ReDim flt_x(i_size)
flt_x(i_size)=10
ReDim flt_y(i_size)
flt_y(i_size)=10
Create Point Into Variable myobj (11, 11) Symbol MakeSymbol(11+30,
BLUE, 28)
Update MY_SYMBOLS Set Obj=myobj Where RowId=r2
i_size = Ubound(rowid_obj)+1
ReDim rowid_obj(i_size)
rowid_obj(i_size)=r2
ReDim flt_x(i_size)
flt_x(i_size)=11
ReDim flt_y(i_size)
flt_y(i_size)=11
Create Point Into Variable myobj (12, 12) Symbol MakeSymbol(12+30,
GREEN, 28)
Update MY_SYMBOLS Set Obj=myobj Where RowId=r3
i_size = Ubound(rowid_obj)+1
ReDim rowid_obj(i_size)
rowid_obj(i_size)=r3
ReDim flt_x(i_size)
flt_x(i_size)=12
ReDim flt_y(i_size)
flt_y(i_size)=12
Add Map Layer MY_SYMBOLS
Set Map Zoom Entire Layer 1
Run Menu Command M_ANALYZE_UNSELECT
Commit Table MY_SYMBOLS
Exit Sub
ErrorTestMoveDisplaySymbols:
Note "Error into Sub TestMoveDisplaySymbols: " + Error$()
End Sub
'====================
Sub SelChangedHandler
'====================
'''''''''''''''''''''''''''''''''''''
' WARNING : no Dialog, Print, or Note
'''''''''''''''''''''''''''''''''''''
OnError Goto ErrorSelChangedHandler
sel_rowid = CommandInfo(CMD_INFO_ROWID)
Exit Sub
ErrorSelChangedHandler:
Resume Next
End Sub
'====================
Sub WinChangedHandler
'====================
Dim i,
i_nb_found
As Integer
Dim sel_obj
As Alias
Dim tablename
As String
Dim newx,
newy
As Float
OnError Goto ErrorWinChangedHandler
For i=1 To Ubound(rowid_obj)
If rowid_obj(i)=sel_rowid Then
Goto ObjFound
End If
Next
Run Menu Command M_ANALYZE_UNSELECT
Exit Sub
ObjFound:
tablename = SelectionInfo(SEL_INFO_TABLENAME)
Select * From tablename Where RowId=sel_rowid Into SEL_TMP Noselect
i_nb_found = TableInfo(SEL_TMP, TAB_INFO_NROWS)
If i_nb_found = 1 Then
'it means that sel_obj must be ALIAS type at this point
sel_obj = Selection + ".Obj"
Fetch Rec 1 From SEL_TMP
newx = ObjectGeography(sel_obj, OBJ_GEO_POINTX)
newy = ObjectGeography(sel_obj, OBJ_GEO_POINTY)
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' counter "i" MUST NOT BE changed since "Goto ObjFound"
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
If flt_x(i)<>newx Or flt_y(i)<>newy Then
Print "number : " + SEL_TMP.number + " name : " +
SEL_TMP.name + " MOVED !"
flt_x(i)=newx
flt_y(i)=newy
End If
End If
Run Menu Command M_ANALYZE_UNSELECT
sel_rowid=-1 ' to avoid the other times WinChangedHandler fires
Exit Sub
ErrorWinChangedHandler:
Note "Error into Sub WinChangedHandler : " + Error$()
Resume Next
End Sub
'===============
Sub QuitTestMove
'===============
OnError Goto ErreurQuitTestMove
Close Table MY_SYMBOLS
Alter ButtonPad "Test Move" Destroy
End Program
Exit Sub
ErreurQuitTestMove:
Note "Error into Sub QuitTestMove: " + Error$()
End Sub
============================================================================
==
This method works only for objects that are created by the appliaction
itself, because rowids must be stored when objects are created.
Let me know what you think about that.
Christophe
