Attribute VB_Name = "Shadow"
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
'This class handles draggin a control over a form.
'Approach:
'  create a rectangle on the form, call it, say, Ghost
'  declare a control variable pointing to the control you want to drag; say Obj
'  declare a form-level variable of type Shadow, say Z
'  now, in the MouseUp, MouseDown and MouseMove events of Obj, put this code:
'  MouseDown: Z.pickUpAt Obj, Ghost, x, y
'  MouseMove: If Ghost.Visible Then Z.DragTo x, y, Confine:=True
'  MouseUp:   Z.DropAt x, y


'Deze class verzorgt het over een form slepen van een image.
'Werkwijze:
'  maak een rechthoek op het form, en benoem deze (bijv Ghost)
'  benoem het te verslepen control (bijv Ikke)
'  declareer een form-module-variabele van het type Shadow (bijv Z)
'  schrijf in de MouseUp, MouseDown en MouseMove-events van Ikke de volgende code:
'  MouseDown: Z.pickUpAt Ikke, Ghost, x, y
'  MouseMove: If Ghost.Visible Then Z.DragTo x, y, Confine:=True
'  MouseUp:   Z.DropAt x, y

Dim Agent As Control, C As Control, P As New Rectangle
'Agent points to the image (the Ghost)
'C is a pointer to the control being dragged
'P is a calculation object for the image
'
'Agent is een verwijzing naar het image
'C is een verwijzing naar het verslopen control
'P is het rekenobject voor het image

Sub PickUpAt(pc As Control, ag As Control, px As Single, py As Single)
'ROUTINE : .
'PURPOSE : .
'INPUT   : .
'OUTPUT  : .
'USES    : .
'EFFECT  : .

   'first, make a 'copy' of the control to drag
   'eerst "kopie" maken van het te verslepen control
   Set C = pc
   P.getsSizeFrom pc
   'then, put in the agent
   'dan agent inzetten
   Set Agent = ag
   P.Sizes Agent
   Agent.Visible = True
   '(x,y) defines the click position relative to the top-left corner of the control
   'so we have to shift P, otherwise its topleft will hang to the mouse instead of the click location
   '(x,y) bepaalt relatieve plaats van klikken tov control-topleft
   'dus meteen P verschuiven, anders komt-ie met topleft te hangen aan de pointer
   P.MoveBy -px, -py
End Sub

Sub DragTo(px As Single, py As Single, Optional bConfine)
'ROUTINE : .
'PURPOSE : .
'INPUT   : .
'OUTPUT  : .
'USES    : .
'EFFECT  : .

   'a thinker. This is, all in one step:
   '- shift P over the original position to the mouse pointer
   '- check for the rectangle to be still within the form
   '- if not, force within the form, if the caller wants so
   '- move the agent to the resulting location
   'een doordenker. Hier staat in een stap:
   '- verschuif P ten opzichte van de startplaats naar de pointer
   '- kijk of de verschoven rechthoek nog binnen het scherm past
   '- zo niet: dwing de rechthoek binnen het scherm, althans als de aanroeper dat nodig vindt
   '- verplaats de agent naar de gevonden positie
   P.Shifted(px, py).Within(RectOf(C), bConfine).Sizes Agent
End Sub

Sub DropAt(px As Single, py As Single)
'ROUTINE : .
'PURPOSE : .
'INPUT   : .
'OUTPUT  : .
'USES    : .
'EFFECT  : .

   'the agent is on the destination already, P still points to the original location
   'de agent staat al op de juiste plaats, P wijst nog naar de startplaats
   P.getsSizeFrom Agent
   P.Sizes C
   'we needed only Set C = Agent, but this cannot be done with controls
   'dit kwam neer op C := Agent, maar zo kun je niet met controls omgaan
   Agent.Visible = False
End Sub