Note that in WinChangedHandler, in case that object has moved (ie
"flt_x(i)<>newx Or flt_y(i)<>newy"), the only code executed is Print.......
It becomes very very more difficult if there are Delete or Update or Insert
statements to do, because as soon as one of these statements runs, the
selection changes, so new SelChangedHandler fires, and new WinChangedHandler
fires, etc...whereas the first WinChangedHandler is not yet finished ! Well,
in this case MI crashes.
(not true with Select statement, due to Noselect clause !!!)
But there is a way to avoid that. The WinChangedHandler could become
something like that :
.........
.........
ObjFound:
sel_obj = Selection + ".Obj"
newx = ObjectGeography(sel_obj, OBJ_GEO_POINTX)
newy = ObjectGeography(sel_obj, OBJ_GEO_POINTY)
If flt_x(i)<>newx Or flt_y(i)<>newy Then
''''''''''''''''''''''''''''''''''''''
' MUST BE THE FIRST TWO LINES AFTER IF
''''''''''''''''''''''''''''''''''''''
flt_x(i)=newx
flt_y(i)=newy
''''''''''''''''''''''''''''''''''''''
Print "number : " + SEL_TMP.number + " name : " +
SEL_TMP.name + " MOVED !"
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
Fetch Rec 1 From SEL_TMP
End If
Update....................
Insert ...................
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
============================================================================
================
By this way, even if Update or Insert statements generate another
SelChangeHandler or WinChangedHandler,
The test "If flt_x(i)<>newx Or flt_y(i)<>newy Then" don't match and no
action made.
Christophe
-----Message d'origine-----
De : Christophe Brabant [mailto:[EMAIL PROTECTED]
Envoy� : vendredi 10 juin 2005 12:50
� : [email protected]
Objet : MI-L The method I use to detect objects moved with mouse : 2nd try
(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
---------------------------------------------------------------------
List hosting provided by Directions Magazine | www.directionsmag.com |
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Message number: 16777
