Originally posted by "marinus"...
There is this Access database. Part of it manages inventory. There is a large storage, in which crates of different stuff from different sources are stored, and in the Access database there is a form onto which this information is entered. There are 38 rows of 10 columns of crates and the height varies.
The form is graphical. You can enter a row number and it will give you a graphical view of it, which you can change by clicking the crates on and off. The crates and their positions are stored in a table. The individual crates are represented by labels, some of which will be hidden because of the varying height of the roof.
The code is horrendous. Below are the 'load' and 'save' routines:
Now, selecting a crate is done this way:
Those look like arrays, don't they? Well, they are. If you have ever programmed in VB, you might think of control arrays.
You are mistaken.
and so on, for each and every possible crate. And, because events need to be registered as well,
Private Sub Bijschrift76_click(): Call kist(0, 0): End Sub Private Sub Bijschrift77_click(): Call kist(1, 0): End Sub Private Sub Bijschrift78_click(): Call kist(2, 0): End Sub Private Sub Bijschrift79_click(): Call kist(3, 0): End Sub Private Sub Bijschrift80_click(): Call kist(4, 0): End Sub ..snip.. Private Sub Bijschrift76_DblClick(Cancel As Integer) Call kist_r(0, 0) End Sub Private Sub Bijschrift77_DblClick(Cancel As Integer) Call kist_r(1, 0) End Sub Private Sub Bijschrift78_DblClick(Cancel As Integer) Call kist_r(2, 0) End Sub ..snip..With about 80% filled, it takes about one and a half minute to come up, about fifteen seconds to switch to another row, and about five seconds for something to happen after you click one of the crates. Printing is done by turning all control elements' Visible property off except for the labels representing crates, printing the form, and turning the control elements back on.
Set knoppenlijst(0, 0) = Bijschrift76 Set knoppenlijst(1, 0) = Bijschrift77 Set knoppenlijst(2, 0) = Bijschrift78 Set knoppenlijst(3, 0) = Bijschrift79 Set knoppenlijst(4, 0) = Bijschrift80 ..snip..Private Sub kist(x%, Y%) On Error GoTo fail tdr_id_s(x%, Y%, curr_rij%) = tdrid_list.Value Dim Naam$, ras$, Perceelnr$ Call naam_en_ras_en_perceelnr(tdrid_list.Value, Naam$, ras$, Perceelnr$) If (k_(CInt(tdrid_list.Value))) = 0 Then k_(CInt(tdrid_list.Value)) = x_kleur% x_kleur% = ((x_kleur% + 1) Mod 3) + 1 End If knoppenlijst(x%, Y%).Caption = Naam$ + vbCrLf + ras$ + vbCrLf + Perceelnr$ knoppenlijst(x%, Y%).BackColor = kleuren(k_(CInt(tdrid_list.Value)), 0) knoppenlijst(x%, Y%).ForeColor = kleuren(k_(CInt(tdrid_list.Value)), 1) gewijzigd = True Exit Sub fail: Exit Sub End SubPrivate Sub kisten_van_database() Dim qd As QueryDef Set qd = CurrentDb.CreateQueryDef("kisten_laad", "SELECT x,y,z,tdrid FROM kisten") Dim rs As Recordset Set rs = qd.OpenRecordset() x_kleur% = 1 On Error GoTo x While True 'For i = 1 To rs.RecordCount x% = CInt(rs.Fields(0).Value) 'x Y% = CInt(rs.Fields(1).Value) 'y z% = CInt(rs.Fields(2).Value) 'z tdr_id_s(x%, Y%, z%) = Val(rs.Fields(3).Value) p_tdr_id_s(x%, Y%, z%) = Val(rs.Fields(3).Value) If k_(tdr_id_s(x%, Y%, z%)) = 0 Then k_(tdr_id_s(x%, Y%, z%)) = x_kleur% x_kleur% = ((x_kleur% + 1) Mod 3) + 1 End If rs.MoveNext Wend 'Next i x: rs.Close qd.Close CurrentDb.QueryDefs.Delete "kisten_laad" gewijzigd = False End Sub Private Sub kisten_naar_database() For z% = 0 To 37 For Y% = 0 To 5 For x% = 0 To 9 sqlcmd$ = "" If tdr_id_s(x%, Y%, z%) > 0 Then If Not tdr_id_s(x%, Y%, z%) = p_tdr_id_s(x%, Y%, z%) Then If p_tdr_id_s(x%, Y%, z%) > 0 Then sqlcmd$ = "UPDATE kisten " & _ " SET tdrID=" & CStr(tdr_id_s(x%, Y%, z%)) & _ " WHERE x=" & CStr(x%) & _ " AND y=" & CStr(Y%) & " AND z=" & CStr(z%) Else sqlcmd$ = "INSERT INTO kisten (x,y,z,tdrId) VALUES (" & _ CStr(x%) & "," & CStr(Y%) & "," & CStr(z%) & "," & _ CStr(tdr_id_s(x%, Y%, z%)) & ")" End If End If Else If p_tdr_id_s(x%, Y%, z%) > 0 Then sqlcmd$ = "DELETE FROM kisten WHERE x=" & CStr(x%) & _ " AND y=" & CStr(Y%) & " AND z=" & CStr(z%) End If End If If sqlcmd$ <> "" Then Application.DoCmd.RunSQL sqlcmd$ p_tdr_id_s(x%, Y%, z%) = tdr_id_s(x%, Y%, z%) 'dit lijkt me duidelijk End If Next x% Next Y% Next z% gewijzigd = False End Sub