Building the
Control Form

To save a lot of tricky drawing I use a table to hold the track coordinates. There's then a VBA routine which draws the relevant objects onto the form. This routine will still need some work, and I may add the loco control functions as well.

The Table DwgData

Each element is given a unique reference beginning with C for a standard piece of track and P for a point. Each point has two elements representing the two possible settings. Each element then needs start and end coordinates. These are scaled by the software so can be real positions from a known datum, I've only shown a couple of points and 4 pieces of track here. Note that you can't draw curves! For the test layout I just used the ends of each Setrack curve, however I may get more sophisticated later.

The Code

There is a bit of complexity to this routine. I've tried to comment where useful

Function BuildF()

Rem Function to build Control Form

Const Fn = "Ctr"		'Form Name
Const FW = 19			'Width of drawing on form (in cm)
Const FH = 14			'Height of drawing
Const FT = 1			'Top margin
Const FL = 1			'Left margin

PM = 1440 / 2.54		'Conversion - Access uses 1440ths of an inch!

Set Dbs = CurrentDb

X1Mn = DMin("X1", "DwgData")	'We need to work out the scaling factors 
X1Mx = DMax("X1", "DwgData")
X2Mn = DMin("X2", "DwgData")
X2Mx = DMax("X2", "DwgData")
Y1Mn = DMin("Y1", "DwgData")
Y1Mx = DMax("Y1", "DwgData")
Y2Mn = DMin("Y2", "DwgData")
Y2Mx = DMax("Y2", "DwgData")

If X1Mn > X2Mn Then
DL = X2Mn
Else
DL = X1Mn
End If

If X1Mx > X2Mx Then
DW = X1Mx - DL
Else
DW = X2Mx - DL
End If

If Y1Mx > Y2Mx Then
DT = Y1Mx
Else
DT = Y2Mx
End If

If X1Mn > X2Mn Then
DH = DT - Y2Mn
Else
DH = DT - Y1Mn
End If

If DH / FH > DW / FW Then
DV = DH / FH				'DV is the resulting scaling factor for the coordinates
Else
DV = DW / FW
End If

SelQ = "Select * from DwgData"
Set Rst = Dbs.OpenRecordset(SelQ)
While Not Rst.EOF
  LX1 = (Rst.X1 - DL) / DV		'Calculate the scaled coordinates for the element
  LX2 = (Rst.X2 - DL) / DV
  LY1 = (DT - Rst.Y1) / DV		
  LY2 = (DT - Rst.Y2) / DV
  If LX1 > LX2 Then			'Access form controls are located by the left hand end, top, width and height and slant
    LL = LX2
    LW = LX1 - LX2
    X = 2
  Else
    LL = LX1
    LW = LX2 - LX1
    X = 1
  End If
  If LY1 > LY2 Then
    LT = LY2
    LH = LY1 - LY2
    Y = 2
  Else
    LT = LY1
    LH = LY2 - LY1
    Y = 1
  End If
  If X = Y Then
    SLT = False
  Else
    SLT = True
  End If
  LNN = Rst.Ref

  Set Ctrl = CreateControl(Fn, acLine, acDetail, , , (FL + LL) * PM, (FT + LT) * PM, LW * PM, LH * PM)
  Ctrl.Name = LNN
  Forms(Fn).Controls(LNN).LineSlant = SLT
  Forms(Fn).Controls(LNN).BorderWidth = 2
  If Left(LNN, 1) = "P" And Right(LNN, 1) = "B" Then
    Forms(Fn).Controls(LNN).BorderColor = 64250			'Inactive route on point is yellow
  Else
    Forms(Fn).Controls(LNN).BorderColor = 64000			'Everything else is green
  End If

  If Left(LNN, 1) = "P" And Right(LNN, 1) = "A" Then		'Add a command button to each point
    BL = LL
    BT = LT + 0.75
    BW = 0.75
    BH = 0.5
    BNN = "PT" & Mid(LNN, 2, 2)
    Set Ctrl = CreateControl(Fn, acCommandButton, acDetail, , , (FL + BL) * PM, (FT + BT) * PM, BW * PM, BH * PM)
    Ctrl.Name = BNN
    Forms(Fn).Controls(BNN).OnClick = "=SetP(" & Mid(LNN, 2, 2) & ")"		'Calls the SetP routine
    Forms(Fn).Controls(BNN).Caption = Mid(LNN, 2, 2)
  End If

  Rst.MoveNext
Wend
Rst.Close

End Function

Back | Home | Up