Private Sub MoveHorizontally(ByVal sngX As Single)
Dim lngNewX As Long
Dim testNewX As Long
Dim found As Byte
found = 0
Erase arrConflictRanges()
Dim x As Byte
Dim NumberOfConflicts As Byte
'determine number of conflicts(extra jobs on row)
NumberOfConflicts = IsMoreThanOneJob(objThisControl.Tag) - 1
lngNewX = objThisControl.Left + sngX - sngOldX
If NumberOfConflicts <> 0 Then
ReDim arrConflictRanges(NumberOfConflicts, 2)
'load known conflicts
GetConflictRanges objThisControl.Name, objThisControl.Tag, arrConflictRanges(), NumberOfConflicts
For x = 1 To NumberOfConflicts
Debug.Print "oldCursorValue:" & objThisControl.Left + sngX - sngOldX
If found = 0 Then
'check conflicts against now
testNewX = IsBetweenRange(arrConflictRanges(x, 1), arrConflictRanges(x, 2), objThisControl.Left + sngX - sngOldX, objThisControl.Left + objThisControl.Width + sngX - sngOldX, objThisControl.Width)
If testNewX <> lngNewX Then
found = 1
lngNewX = testNewX
Else
found = 0
End If
End If
Debug.Print "NewCursorValue:" & lngNewX
Next x
With objThisControl
'lngNewX = .Left + sngX - sngOldX
'if withint left and right boundaries proceed
If lngNewX >= lngMinLeft And lngNewX <= lngMaxRight - .Width Then
.Left = lngNewX
'if not check...too far left set to x left
ElseIf lngNewX < lngMinLeft Then
.Left = lngMinLeft
'if not check...too far right set to x right
ElseIf lngNewX > lngMaxRight - .Width Then
.Left = lngMaxRight - .Width
End If
End With
Else
With objThisControl
'lngNewX = .Left + sngX - sngOldX
'if withint left and right boundaries proceed
If lngNewX >= lngMinLeft And lngNewX <= lngMaxRight - .Width Then
.Left = lngNewX
'if not check...too far left set to x left
ElseIf lngNewX < lngMinLeft Then
.Left = lngMinLeft
'if not check...too far right set to x right
ElseIf lngNewX > lngMaxRight - .Width Then
.Left = lngMaxRight - .Width
End If
End With
End If
End Sub
Private Function IsMoreThanOneJob(MachineType As String) As Integer
Dim UseTable As String
UseTable = "tblPlantAssignments"
With CurrentDb.OpenRecordset(" Select *" & _
" From " & UseTable & _
" Where MachineTypeFK = '" & MachineType & "'")
.MoveLast
'Debug.Print .RecordCount
IsMoreThanOneJob = .RecordCount
End With
End Function
Private Sub GetConflictRanges(ByVal BarName As String, ByVal MachineName As String, ByRef CurrentArray() As Long, ArrayLength As Byte)
Dim UseTable As String
UseTable = "tblPlantAssignments"
Dim x As Integer
With CurrentDb.OpenRecordset("SELECT * " & _
"From " & UseTable & _
" WHERE (MachineTypeFK = '" & MachineName & "') AND (ControlHandle <> '" & BarName & "')")
.MoveFirst
For x = 1 To ArrayLength
CurrentArray(x, 1) = StartDateLeft(!StartDate)
CurrentArray(x, 2) = FinshDateRight(!FinishDate)
Debug.Print "array start result:" & CurrentArray(x, 1)
Debug.Print "array finish result:" & CurrentArray(x, 2)
.MoveNext
Next x
End With
End Sub
Private Function StartDateLeft(Start As Date) As Long
Dim Width As Long
Dim GridLeft As Long
Dim ctl As Control
Dim x As Integer
Dim SeekDate As Date
SeekDate = Day(Start) & "-" & Month(Start) & "-" & Year(Start)
x = 1
For x = 1 To conNumDays
If SeekDate = Forms!frmSampleForecasting("DaysOFWeek_" & x).Caption & "-" & Forms!frmSampleForecasting("DaysOFWeek_" & x).Tag Then
Set ctl = Forms!frmSampleForecasting("DaysOFWeek_" & x)
End If
Next x
If Not IsNull(ctl) Then
GridLeft = Forms!frmSampleForecasting!ctlDayGridSubform.Left
Width = Forms!frmSampleForecasting!DaysOFWeek_1.Width
'Debug.Print "StartDateLeft:" & ctl.Left + Width + GridLeft
StartDateLeft = ctl.Left - GridLeft
Else
StartDateLeft = 0
End If
End Function
Private Function FinshDateRight(Finish As Date) As Long
Dim Width As Long
Dim GridLeft As Long
Dim ctl As Control
Dim x As Integer
Dim SeekDate As Date
SeekDate = Day(Finish) & "-" & Month(Finish) & "-" & Year(Finish)
x = 1
For x = 1 To conNumDays
If SeekDate = Forms!frmSampleForecasting("DaysOFWeek_" & x).Caption & "-" & Forms!frmSampleForecasting("DaysOFWeek_" & x).Tag Then
Set ctl = Forms!frmSampleForecasting("DaysOFWeek_" & x)
End If
Next x
If Not IsNull(ctl) Then
GridLeft = Forms!frmSampleForecasting!ctlDayGridSubform.Left
Width = Forms!frmSampleForecasting!DaysOFWeek_1.Width
FinshDateRight = ctl.Left - GridLeft ' + Width
Else
FinshDateRight = 0
End If
End Function
Private Function IsBetweenRange(ByVal ConflictLeft As Long, _
ByVal ConflictRight As Long, _
ByVal InitialValueLeft As Long, _
ByVal InitialValueRight As Long, _
ByVal BarLeft As Long) As Long
'debug.Print "Initial Value:" & InitialValue
If (InitialValueLeft >= ConflictLeft And InitialValueLeft <= ConflictRight) Or (InitialValueRight >= ConflictLeft And InitialValueRight <= ConflictRight) Then
If Abs(ConflictLeft - InitialValueLeft) < Abs(ConflictRight - InitialValueRight) Then
IsBetweenRange = ConflictLeft - BarLeft ' + Forms!frmSampleForecasting!DaysOFWeek_1.Width
Else
IsBetweenRange = ConflictRight + Forms!frmSampleForecasting!DaysOFWeek_1.Width
End If
Else
If initalvalueleft <= ConflictLeft And InitialValueRight >= ConflictRight Then
If Abs(ConflictLeft - InitialValueLeft) < Abs(ConflictRight - InitialValueRight) Then
IsBetweenRange = ConflictLeft - BarLeft ' + Forms!frmSampleForecasting!DaysOFWeek_1.Width
Else
IsBetweenRange = ConflictRight + Forms!frmSampleForecasting!DaysOFWeek_1.Width
End If
End If
IsBetweenRange = InitialValueLeft
End If
End Function
