Create or copy controls at RunTime (1 Viewer)

I know this question has been asked by several people but here's the problem. I am creating a scheduling calendar. The form is just made up of rectangles and a few labels but the challenging part is I want to show the events stretching across the days that it is scheduled.

Almost like the outlook calendar would. Any idea's are appreciated as I don't know which way to go with this.

Thanks,

TheChazm

P.S. I have tried the add controls thing which does not work and I also have tried something else that if its in design view then it will add but this is the front end so it will be a accde file.

As you've discovered you cannot add controls at runtime except in design view, and as you correctly pointed out a *.*de file cannot have new controls added to it at all. I think you might be reaching a bit beyond Accesses graphical capabilities in this instance, I really can't think of a way where you could draw any number of events across multiple days like in Outlook short of trying to leverage the GDI+ API's and if you're using those proficiently you probably aren't programming in Access.

You may need to go a bit lower tech. Maybe some of the moderators have more experience but that's my two cents.

Thanks for the reply. What I have done so far is created two hundred label objects on the form marked as hidden very small in size. When I run my code to parse through the events it then grabs one of the already created available labels and size's, positions, and labels with the colors predesignated. This seems to be working out pretty well. I also plan on using transparency roughly 80 percent on all of them as well.

I know I would normally develop something like this in visual studio as an ocx then using it in access or whatever but my computer is shot( stupid toshiba over heating because of poor cooling design ) but I think I have a shot here. Its not like the user is going to have over 754 events in one month anyway. We will see.

Thanks Again,

TheChazm

surely you want to try and change this into a continuous form based on a query, of some sort.

Do you know something I don't? Because how would you wrap controls that would extend past your date on the right in a continuous form? Here is the code I created today wrapping controls and sizing them with vba.

Option Compare Database
Function LenMonth() As Long
Dim Dstart As Date, Dfinish As Date, dayOne As Date

dayOne = Format(DateValue(Format(Now, "m") & "/1/" & Format(Now, "yyyy")), "mm/dd/yyyy")
Dstart = DateValue(Month(dayOne) & "/1/" & Year(dayOne))
Dfinish = DateAdd("m", 1, Dstart)
LenMonth = Dfinish - Dstart
End Function
Function NextMonthDays(lngTotalDays As Long) As String
Dim Dstart As Date, Dfinish As Date, dayOne As Date

dayOne = Format(DateValue(Format(Now, "m") & "/1/" & Format(Now, "yyyy")), "mm/dd/yyyy")
Dstart = DateValue(Month(dayOne) & "/1/" & Year(dayOne))
NextMonthDays = Format(DateAdd("d", lngTotalDays - 1, Dstart), "d")
If NextMonthDays = "1" Then
NextMonthDays = Format(DateAdd("d", lngTotalDays - 1, Dstart), "mmm") & " 1"
End If

End Function
Function BuildEvents()
Dim RStblPersonnel_Events As DAO.Recordset, lngEvents As Long, ctrlCurrent As Label, ctrlCheck As Label, Dstart As Date, Dend As Date, lngEventChecker As Long, lngModifiedTop As Long
Dim ctrlExpand As Label, ctrlExpand2 As Label, lngRightBlock As Long, lngLengthofControl As Long, lngRemainingLength As Long, bControlAvailable As Boolean, i As Long
Dim lngNumberOfControlsUsed As Long
Set db = CurrentDb
Set RStblPersonnel_Events = db.OpenRecordset("select * From [tblPersonnel Events] Order By [End Event] DESC")
RStblPersonnel_Events.MoveLast
RStblPersonnel_Events.MoveFirst
lngEvents = RStblPersonnel_Events.RecordCount
lngNumberOfControlsUsed = lngEvents
Do While RStblPersonnel_Events.EOF = False
lngEventChecker = RStblPersonnel_Events.RecordCount
Set ctrlCurrent = Forms![frmcalendarnew].Controls("lblEvent" & lngEvents)
With ctrlCurrent
'// Setting the Caption of the Event Label
.Caption = RStblPersonnel_Events("Personnel Number") & " - " & RStblPersonnel_Events("Event") & " - " & RStblPersonnel_Events("Start Event") & "-" & RStblPersonnel_Events("End Event")

'// Getting Event Dates
Dstart = RStblPersonnel_Events("Start Event")
Dend = RStblPersonnel_Events("End Event")

'// Finding where to put the top of the Event Label
If lngEvents = RStblPersonnel_Events.RecordCount Then
.Top = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top
Else
Do While lngEventChecker <> lngEvents
Set ctrlCheck = Forms![frmcalendarnew].Controls("lblEvent" & lngEventChecker)
With ctrlCheck
If .Top = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top Then
If .Left = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Left Then
lngModifiedTop = .Top + .Height
Else
lngModifiedTop = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top
End If
Else
If .Left = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Left Then
lngModifiedTop = lngModifiedTop + .Height
Else
lngModifiedTop = lngModifiedTop
End If
End If
End With
Set ctrlCheck = Nothing
lngEventChecker = lngEventChecker - 1
Loop

.Top = lngModifiedTop
lngModifiedTop = 0
End If

'// Setting the Left of the Event Label
.Left = Forms![frmcalendarnew].Controls("lbl" & Format(Dstart, "d")).Left

'// Get the length to the end of the row date
If Format(Dstart, "d") > 7 Then
If Format(Dstart, "d") > 14 Then
If Format(Dstart, "d") > 21 Then
If Format(Dstart, "d") > 28 Then
lngRightBlock = Forms![frmcalendarnew].Controls("B" & LenMonth).Left + Forms![frmcalendarnew].Controls("B" & LenMonth).Width
Else
lngRightBlock = Forms![frmcalendarnew].Controls("B28").Left + Forms![frmcalendarnew].Controls("B28").Width
End If

Else
lngRightBlock = Forms![frmcalendarnew].Controls("B21").Left + Forms![frmcalendarnew].Controls("B21").Width
End If

Else
lngRightBlock = Forms![frmcalendarnew].Controls("B14").Left + Forms![frmcalendarnew].Controls("B14").Width
End If

Else
lngRightBlock = Forms![frmcalendarnew].Controls("B7").Left + Forms![frmcalendarnew].Controls("B7").Width
End If

'// Now use the right block data to see if control will extend over and set the correct width
lngLengthofControl = DateDiff("d", Dstart, Dend) * Forms![frmcalendarnew].Controls("B1").Width
If .Left + lngLengthofControl > lngRightBlock Then
lngRemainingLength = (.Left + lngLengthofControl) - lngRightBlock
.Width = lngLengthofControl - lngRemainingLength + 200
Else
.Width = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Width * DateDiff("d", Dstart, Dend)
End If

'// Sets the height of Event Label
.Height = Forms![frmcalendarnew].Controls("lbl" & Format(Dstart, "d")).Height

'// Makes the Event Label Visable
.Visible = True
End With

'// Clears the control
Set ctrlCurrent = Nothing

'// If remaining Length is present then start another control to lap over
If lngRemainingLength > 0 Then
'// Find a control that is Available
lngNumberOfControlsUsed = lngNumberOfControlsUsed + 1
'// This takes a control available outside of the reserved ones
Set ctrlExpand = Forms![frmcalendarnew].Controls("lblevent" & lngNumberOfControlsUsed)

'// Now start setting and checking Event Labels
With ctrlExpand
.Caption = RStblPersonnel_Events("Personnel Number") & " - " & RStblPersonnel_Events("Event") & " - " & RStblPersonnel_Events("Start Event") & "-" & RStblPersonnel_Events("End Event")

End With
Set ctrlExpand = Nothing
End If
lngEvents = lngEvents - 1
RStblPersonnel_Events.MoveNext
Loop
End Function

Its not done yet obviously but its working good so far with a few events I put in a table.

TheChazm

lol Just broke it but like I said still in the works

you can't - but maybe there is a way of achieving a different look and feel with a continuous form.

eg - maybe show a single week, and have navigation buttons to show a different week.

Just thought it's a lot easier than creating and managing an enormous number of controls.

I expect a form with hundreds of controls will not open very quickly either.

Yea I apprecaite the backup on this. Its really complicated because I designed a program thats actually moduler in the sence its completely portable and that I can pull seperate whole projects into the one front end connecting to what I need dynamically. Then only verifying the projects entegrity when the front end is open. I have so far

School Coordinator
Zone Inspection
Project Management
Personnel Management

Which also downloads from other systems and websites.

The Calendar is supposed to pull in pretty much everything and allow for the supervisors to visually see the projects and assignments, any type of event with who they are in charge of, and anyone thats scheduled for schools during that timeframe.

This also will allow them to assigned personnel to jobs based on their qualifications and seeing the personnel schedule all in one shot.

Its a bit steep but I am trying my best.

Thanks Again,

TheChazm

Minor correction: The following code is the correct way. My bad :/

If lngEvents = RStblPersonnel_Events.RecordCount Then
.Top = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top
Else
Do While lngEventChecker <> lngEvents
Set ctrlCheck = Forms![frmcalendarnew].Controls("lblEvent" & lngEventChecker)
With ctrlCheck
If .Top = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top Then
If .Left = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Left Then
lngModifiedTop = .Top + .Height
Else
lngModifiedTop = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top
End If
Else
If .Left = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Left Then
lngModifiedTop = lngModifiedTop + .Height
Else
lngModifiedTop = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top
End If
End If
End With
Set ctrlCheck = Nothing
lngEventChecker = lngEventChecker - 1
Loop

.Top = lngModifiedTop
lngModifiedTop = 0
End If