' This is to prevent the user from selecting the first column
ApptList.ColumnIndex = 2
End Sub
Sub ApptList_DragCell (Split As Integer, Row As Long, Col As Integer)
' This event is intitiating when the user drags the mouse with
' the right mouse button depressed. If the user is in column 2
' and there is an appointment then initiate dragging
If Col = 2 Then
ApptList.RowIndex = Row
If InStr(ApptList.Text, ":") <> 0 Then
DragRow = ApptList.RowIndex
ApptList.RefreshRow = 0
ApptList.DragIcon = MoveIcon.DragIcon
BeginDragMode ApptList, MASK_OLDAPPT
End If
End If
End Sub
Sub ApptList_DragDrop (Source As Control, X As Single, Y As Single)
' Drop a new appointment or existing appointment at a new
' row position.
Dim aText As String
Dim i%
If Not EndDragMode(MASK_NEWAPPT Or MASK_OLDAPPT) Then Exit Sub
' Check the location of the drag and drop
ApptList.PointX = X
ApptList.PointY = Y
GridDropRow = ApptList.RowAtPoint
' If new appointment add to grid otherwise change appt time
If DragType = MASK_NEWAPPT Then
ApptList.RowIndex = GridDropRow
ApptInfo(GridDropRow) = Source.Tag & ": "
ApptList.RefreshRow = 0
ApptEdit
Else
aText = ApptList.ColumnText(1)
ApptList.RowIndex = DragRow
i% = ChangeApptTime(TimeValue(aText))
End If
' Clear drag row
DragRow = 0
ApptText.SetFocus
End Sub
Sub ApptList_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
' When dragging over the grid, both new and old appointments
' are considered.
If Not DragValid(Source, MASK_NEWAPPT Or MASK_OLDAPPT, State) Then
Exit Sub
End If
' Find location in the grid
ApptList.PointX = X
ApptList.PointY = Y
' If leaving the grid set the rowindex back to the where dragging
' started, else move the RowIndex with the drag icon.
Select Case State
Case LEAVE
ApptList.RowIndex = DragRow
Case Else
GridDropRow = ApptList.RowAtPoint
' If RowAtPoint is valid then move the RowIndex
If ApptList.RowAtPoint <> -1 Then
ApptList.RowIndex = ApptList.RowAtPoint
End If
End Select
End Sub
Sub ApptList_Fetch (Row As Long, Col As Integer, Value As String)
' This event is the main display mechanism in callback mode
' If in column 1 display the times. If in column 2 query the
' ApptInfo array and display all appointments
If Col = 1 Then
Value = ApptTimes(Row)
ElseIf Col = 2 Then
Value = ApptInfo(Row)
End If
End Sub
Sub ApptList_FetchAttributes (Status As Integer, Split As Integer, Row As Long, Col As Integer, FgColor As Long, BgColor As Long, FontStyle As Integer)
' This event lets us set attributes for given cells. In this case
' if the current cell has an appointment then highlight it in
' green and white.
If InStr(ApptList.Text, ":") Then
If Status = GFS_CURCELL Then
BgColor = LTGREEN
FgColor = WHITE
End If
End If
' If dragging is occuring then highlight the cell being
' dragged from in blue and white.
If DragRow = Row Then
BgColor = BLUE
FgColor = WHITE
End If
End Sub
Sub ApptList_MarkChange (Row As Long, IsMarked As Integer)
' In TrueGrid Pro you can now use multiple selection
' callback mode. The code in the MarkChange event
' causes a select array to be updated
ApptSelect(Row) = ApptSelect(Row) Xor True
ApptList.RefreshRow = Row
End Sub
Sub ApptList_QueryMark (Row As Long, IsMarked As Integer)
' Here the grid checks to see if it should highlight a
' given row. We provide it our array that we maintain
' in MarkChange.
IsMarked = ApptSelect(Row)
End Sub
Sub ApptList_RowChange ()
' If a RowChange occurs call ApptEdit to update Post-it area
ApptEdit
End Sub
Sub ApptText_DragDrop (Source As Control, X As Single, Y As Single)
valid% = EndDragMode(MASK_NONE)
End Sub
Sub ApptText_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
valid% = DragValid(Source, MASK_NONE, State)
End Sub
Sub ApptTime_DragDrop (Source As Control, X As Single, Y As Single)
valid% = EndDragMode(MASK_NONE)
End Sub
Sub ApptTime_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
valid% = DragValid(Source, MASK_NONE, State)
End Sub
Sub ApptTime_ValidationError (InvalidText As String, StartPosition As Integer)
' Check for valid time if user manually changes time
MsgBox "Invalid time"
ApptTime.SetFocus
End Sub
Sub ApptType_DragDrop (Source As Control, X As Single, Y As Single)
' Accept a drop only for a NEWAPPT icon, otherwise the
' operation will be cancelled.
If EndDragMode(MASK_NEWAPPT) Then
ApptType.Text = Source.Tag
End If
End Sub
Sub ApptType_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
valid% = DragValid(Source, MASK_NEWAPPT, State)
End Sub
Sub ApptType_KeyPress (KeyAscii As Integer)
' Don't allow a colon to be entered, since we use a colon to
' separate the appointment "kind" from the text.
If KeyAscii = Asc(":") Then
Beep
KeyAscii = 0
End If
End Sub
Sub BeginDragMode (ctl As Control, objType As Integer)
' Whenever a drag is about to start, this routine is called.
' The type mask of the drag is flagged, and we remember that
' dragging is in progress. This routine MUST be matched
' by an EndDragMode function call.
DragType = objType
Dragging = True
' Change the highlight color for the current cell to blue and white
' while dragging is occuring
ApptList.ParamBackColor = BLUE
ApptList.ParamForeColor = WHITE
ApptList.ColumnSetStatusAttr(2) = GFS_CURCELL
' Start the drag process
ctl.Drag BEGIN_DRAG
End Sub
Function ChangeApptTime (newtime As Variant) As Integer
' Given a new time for an appointment at the current row, this
' routine moves the appointment to the new location in the
' grid.
Dim trow As Integer
Dim oldAppt As String
trow = TimeRow(newtime)
' If we're already there, then do nothing and return False,
' indicating no row change occurred.
If trow = ApptList.RowIndex Then
ChangeApptTime = False
Exit Function
End If
' If the user entered in invalid time print an error
If trow > ApptList.Rows Or trow < 0 Then
ChangeApptTime = False
MsgBox "Invalid time"
Exit Function
End If
ChangeApptTime = True
' Actually move the row.
oldAppt = ApptList.Text
ApptInfo(ApptList.RowIndex) = ""
ApptList.RefreshRow = 0
ApptList.RowIndex = trow
ApptInfo(ApptList.RowIndex) = oldAppt
ApptList.RefreshRow = 0
ApptEdit ' move the data to the post-it area
End Function
Function DragValid (src As Control, mask As Integer, State As Integer) As Integer
' This function is called by an object's DragOver event to
' automatically change the drag cursor to the "no drop"
' cursor if necessary. It also returns True if the object
' can legally be dropped according to the input mask.
If (mask And DragType) Then
DragValid = True
Exit Function
End If
' This is not a valid drag. Return False, but also change the
' object's drag icon to the NoDrag icon (remembering the old
' value for later restore when we exit this object).
DragValid = False
Select Case State
Case ENTER
' Entering, remember old icon
SaveIcon.DragIcon = src.DragIcon
src.DragIcon = NoDrag.DragIcon
Case LEAVE
' Exiting, restore old icon
src.DragIcon = SaveIcon.DragIcon
End Select
End Function
Function EndDragMode (mask As Integer) As Integer
' This function is called when a drag has ended, either
' successfully or unsuccessfully. This routine removes any
' user feedback related to the drag operation and returns
' TRUE if the passed mask matches the dragged object.
' Set Current cell colors back to previous settings
ApptList.ParamBackColor = INHERIT_COLOR
ApptList.ParamForeColor = INHERIT_COLOR
ApptList.ColumnSetStatusAttr(2) = GFS_CURCELL
Select Case DragType
Case MASK_NEWAPPT
' If a "new appointment" icon was dragged, change the
' frame background to LTGREY again so that the drag
' is officially over.
KindFrame(DragIndex).BackColor = LTGREY
Case MASK_OLDAPPT
' If this is an item dragged from the grid, refresh
' the grid in case the drag ended outside the grid
' frame (and the inverted row remains).
End Select
Dragging = False
EndDragMode = (mask And DragType) <> 0
End Function
Sub ExitMenuOption_Click ()
'Unload forms and exit
Unload About
Unload ApptForm
End
End Sub
Sub Form_DragDrop (Source As Control, X As Single, Y As Single)
' Ignore drops which occur on the form
valid% = EndDragMode(MASK_NONE)
End Sub
Sub Form_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
' Assure that the "no drop" icon is displayed when passing
' over the form.
valid% = DragValid(Source, MASK_NONE, State)
End Sub
Sub Form_Load ()
Dim curTime As Variant
Dim curRow As Integer
Dim rowMax As Integer
' Fill the leftmost column with appointment times.
curRow = 1
For curTime = Prefs.timeStart To Prefs.timeEnd Step Prefs.timeIncrement
