dbTalk Databases Forums  

BringToFront

comp.databases.ms-access comp.databases.ms-access


Discuss BringToFront in the comp.databases.ms-access forum.



Reply
 
Thread Tools Display Modes
  #1  
Old   
Phil
 
Posts: n/a

Default BringToFront - 03-06-2011 , 04:40 AM






I have a form where I can drag controls around at Runtime. Frequently, one
control will overlap and partially conceal another control. I need a method
of clicking on what I can see of the "Back control" to bring it to the front.
I know that SendToBack and BringToFront is only available at design time, so
that is no use. Also ZOrder doesn't seem available in Access 2010. Any ideas
please Phil

Reply With Quote
  #2  
Old   
David-W-Fenton
 
Posts: n/a

Default Re: BringToFront - 03-07-2011 , 01:52 PM






"Phil" <phil (AT) stantonfamily (DOT) co.uk> wrote in
news:ikvoa0$bbi$1 (AT) speranza (DOT) aioe.org:

Quote:
I have a form where I can drag controls around at Runtime.
Frequently, one control will overlap and partially conceal another
control. I need a method of clicking on what I can see of the
"Back control" to bring it to the front. I know that SendToBack
and BringToFront is only available at design time, so that is no
use. Also ZOrder doesn't seem available in Access 2010. Any ideas
please
I don't know about A2010, but is this something you can do with
DoCmd.RunCommand? It would, of course, have to be done in design
view, so that's maybe what you've already found. I can't see how
there'd be any other way to accomplish it.

Frankly, the goal seems suspect to me. Why do you want people
dragging things around at runtime? That doesn't make any sense to me
at all.

--
David W. Fenton http://www.dfenton.com/
contact via website only http://www.dfenton.com/DFA/

Reply With Quote
  #3  
Old   
Salad
 
Posts: n/a

Default Re: BringToFront - 03-07-2011 , 02:03 PM



Phil wrote:

Quote:
I have a form where I can drag controls around at Runtime.
Can you tell how you do that? Drag controls on a running form?

Reply With Quote
  #4  
Old   
Phil
 
Posts: n/a

Default Re: BringToFront - 03-07-2011 , 05:09 PM



On 07/03/2011 20:03:59, Salad wrote:
Quote:
Phil wrote:

I have a form where I can drag controls around at Runtime.

Can you tell how you do that? Drag controls on a running form?

Hi Salad

Background:- I am involved with a yacht club and we need a diagram of the
space number where each boat is parked and who owns the boat. Currently,
because of the limitations the the Graph object in Access (Even 2010) , I
have an Access query that lists the boat name, class of boat and owner's name
in a combined field. I then have the XY co-ordinates of the place where it is
stored together with additional information about where the label should be
displayed relative to those XY Co-ordinates, and the angle that the label
should be displayed. This all gets output to Excel where I use a scatter
chart to show the position of the boats together with their names, owners
etc. The background for this display is the boat compound or pontoons as a
JPG picture. I haven't finished yet. I output the Excel graph as a GIF file
which I then display as a picture on an Access form. Our compound has about
80 boats in it, and the powers that be want to re-arrange it, and re-number
it. That means that I have to redraw the JPG picture, use largely trial and
error to get the XY co-ordinates of where is space is located and it takes a
hell of a time.

So what I have come up with is a form that has controls that you can drag
around. That is no problem, the problem is that I want to drag around Stephen
Leban’s Access Rotate Text control 2, but I will come back to that later.
Simply, there are 2 controls which can be repeated numerous timed. There is a
small TextBox (Place01) about ¼” square with the control source = 1 marking
the corner of a larger TextBox (Space01) which will hold the boat name and
owner. This can be repeated ad nauseam with Place02 and Space02.

Now to the code ‘Fraid it’s rather long. Will do a foll up shortly

Option Compare Database
Option Explicit

Dim blMove As Boolean
Dim MouseXStart As Integer, MouseYStart As Integer
Dim DeltaX As Integer, DeltaY As Integer
Dim ActiveCtl As Control

Private Const IDC_HAND = 32649&

' Boudaries of table area
Const TopBoundary As Long = 0
Const BottomBoundary As Long = 12300
Const LeftBoundary As Long = 4000
Const RightBoundary As Long = 15200

Private vate Declare PtrSafe Function LoadCursor Lib "user32" Alias
"LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As
Long) As Long


Sub SaveCtlPosition(PlaceID As Integer)

Dim SQLStg As String
Dim CtlPlace As Control, CtlSpace As Control

Set CtlPlace = Controls("Place" & Format(PlaceID, "00"))
Set CtlSpace = Controls("Space" & Format(PlaceID, "00"))

' When the mouse is moved over the image and blMove is true,
' ' Change the x and y position of the table image and its associated labels
' and textboxes
' according to the change in mouse X and Y position from the last
' time the mouse was clicked down.

CtlSpace.Top = CtlPlace.Top + 100
CtlSpace.Left = CtlPlace.Left + 100
CtlPlace.SetFocus

On Error GoTo Trapper
blMove = False

SQLStg = "UPDATE SpaceChargeType INNER JOIN Spaces "
SQLStg = SQLStg & "ON SpaceChargeType.SpaceTypeID = Spaces.SpaceTypeID "
SQLStg LStg = SQLStg & "SET Spaces.XCoord = " & CInt(CtlPlace.Left *
[XMultiplyer]) & ", " SQLStg = SQLStg & "Spaces.YCoord = " &
CInt(CtlPlace.Top * [YMultiplyer]) & ", " SQLStg = SQLStg & "LabelAngle = " &
CtlSpace.Escapement SQLStg = SQLStg & " WHERE (Spaces.SpaceTypeID = " &
SpaceTypeID SQLStg = SQLStg & ") AND (SpaceNo = " & PlaceID & ");"

'Store the change in space positions in Spaces table
DoCmd.SetWarnings False
DoCmd.RunSQL (SQLStg)
DoCmd.SetWarnings True

Exit Sub

Trapper:
If Err.Number = 2100 Then
Else
MsgBox Err.Description
End If

End Sub

Sub CtlMouseDown(PlaceID As Integer, X As Single, Y As Single)
'When the mouse is clicked down on a space image, record the
'Current mouse x and y position and set the boolean value blMove to true

Dim hCur As Long

hCur = LoadCursor(0, IDC_HAND) ' Turn cursor into a finger
If (hCur > 0) Then
SetCursor hCur
End If

Dim Ctl As Control

Set Ctl = Controls("Space" & Format(PlaceID, "00"))

Ctl.BackColor = vbYellow
blMove = True
MouseXStart = X
MouseYStart = Y

End Sub

Sub CtlMouseMove(PlaceID As Long, X As Single, Y As Single)

Const onst TwipsPerCm = 567 ' 1440 / 2.54

Dim TmpX As Long, TmpY As Long
Dim MinX As Long, MinY As Long
Dim Ctl As Control

Set Ctl = Controls("Place" & Format(PlaceID, "00"))

' When the mouse is moved over a table image and blMove is true,
' ' Change the x and y position of the table image and its associated labels
' and textCtles
' according to the change in mouse X and Y position from the last
' time the mouse was clicked down.

If blMove Then
DeltaX = X - MouseXStart
DeltaY = Y - MouseYStart

TmpX = Ctl.Left + DeltaX
'If TmpX < MinX Then TmpX = MinX
If TmpX > SpaceTypeMaxWidth Then TmpX = SpaceTypeMaxWidth

TmpY = Ctl.Top + DeltaY
If TmpY < MinY Then TmpY = MinY
If TmpY > SpaceTypeMaxHeight Then TmpY = SpaceTypeMaxHeight

Ctl.Left = TmpX
Ctl.Top = TmpY
End If

Set Ctl = Nothing

End Sub

Sub CtlMouseUp(PlaceID As Integer)

Dim Ctl As Control

On Error GoTo Trapper

blMove = False

Call SaveCtlPosition(PlaceID) ' Save space positions

Set Ctl = Controls("Space" & Format(PlaceID, "00"))
Ctl.BackColor = vbWhite
Exit Sub

Trapper:
MsgBox Err.Description
Exit Sub

End Sub

Private Sub Angle_AfterUpdate()

Const Pi = 3.14159

Dim CtlSpace As Control
Dim CtlWidth As Long, CtlHeight As Long

Set CtlSpace = ActiveCtl
CtlSpace.Escapement = CInt(Angle)

SaveCtlPosition (CLng(Right(CtlSpace.Name, 2)))

CtlSpace.Width idth = fTextWidth(CtlSpace, Nz(CtlSpace.Caption,
"AAAAAAAAAA")) CtlSpace.Height = fTextHeight(CtlSpace, Nz(CtlSpace.Caption,
"AAAAAAAAAA")) CtlWidth = CtlSpace.Width
CtlHeight = CtlSpace.Height
If Cos(Angle * Pi / 180) < 0 Then
CtlSpace.Width ce.Width = CtlSpace.Height - CtlSpace.Width * Cos(Angle * Pi /
180) Else
CtlSpace.Width ce.Width = CtlSpace.Height + CtlSpace.Width * Cos(Angle * Pi /
180) End If
If Sin(Angle * Pi / 180) < 0 Then
CtlSpace.Height = CtlSpace.Height - CtlWidth * Sin(Angle * Pi / 180)
Else
CtlSpace.Height = CtlSpace.Height + CtlWidth * Sin(Angle * Pi / 180)
End If

End Sub

Private Sub Form_Current()

Dim MyDb As Database
Dim SpaceSet As Recordset
Dim SQLStg As String
Dim CtlSpace As Control, CtlPlace As Control, Ctl As Control
Const onst TwipsPerCm = 567 ' 1440 / 2.54
Const Pi = 3.14159
Dim CtlHeight As Long, CtlWidth As Long
Dim i As Long

On Error GoTo Form_Current_Error

For i = 1 To Me.Controls.Count - 1
If If Left(Me.Controls(i).Name, 5) = "Space" And Len(Me.Controls(i).Name) = 7
_ Or Left(Me.Controls(i).Name, 5) = "Place" And Len(Me.Controls(i).Name) = 7
Then Me.Controls(i).Visible = False
End If
Next i

SQLStg = "SELECT QSpaceAllocation.* FROM QSpaceAllocation "
SQLStg = SQLStg & " WHERE SpaceTypeID = " & Nz(SpaceTypeIDRelay) & ";"

Set MyDb = CurrentDb
Set SpaceSet = MyDb.OpenRecordset(SQLStg)
With SpaceSet
Do Until .EOF
For Each Ctl In Me.Controls
If If Left(Ctl.Name, 5) = "Space" And Len(Ctl.Name) = 7 Then ' "Space05"
If CLng(Right(Ctl.Name, 2)) = !Space Then
Set Set CtlSpace = Controls("Space" & Format(!Space, "00")) Set Set CtlPlace
= Controls("Place" & Format(!Space, "00")) CtlPlace.Left =
CInt(CLng(Nz(!XCoord) / Nz(!XMultiplyer) * 10) / 10) CtlPlace.Top =
CInt(CLng(Nz(!YCoord) / Nz(!YMultiplyer) * 10) / 10) CtlSpace.Escapement =
!LabelAngle CtlSpace.Caption = Nz(!SpaceAndName)

' adjust the control's size to match the text
CtlSpace.Width CtlSpace.Width = fTextWidth(CtlSpace, Nz(!SpaceAndName,
"AAAAAAAAAA")) CtlSpace.Height = fTextHeight(CtlSpace, Nz(!SpaceAndName,
"AAAAAAAAAA")) CtlWidth = CtlSpace.Width
CtlHeight = CtlSpace.Height
' Reformat control to take account of angle
If Cos(!LabelAngle * Pi / 180) < 0 Then
CtlSpace.Width CtlSpace.Width = CtlSpace.Height - CtlSpace.Width *
Cos(!LabelAngle * Pi / 180) Else
CtlSpace.Width CtlSpace.Width = CtlSpace.Height + CtlSpace.Width *
Cos(!LabelAngle * Pi / 180) End If
If Sin(!LabelAngle * Pi / 180) < 0 Then
CtlSpace.Height CtlSpace.Height = CtlSpace.Height - CtlWidth *
Sin(!LabelAngle * Pi / 180) Else
CtlSpace.Height CtlSpace.Height = CtlSpace.Height + CtlWidth *
Sin(!LabelAngle * Pi / 180) End If
If CtlSpace.Caption > "" Then
CtlSpace.Visible = True
CtlPlace.Visible = True
End If

CtlSpace.Top = CtlPlace.Top + 100
CtlSpace.Left = CtlPlace.Left + 100
End If
End If
Next Ctl
NextRec:
.MoveNext
Loop
.Close
Set SpaceSet = Nothing
End With

Exit Sub

Form_Current_Error:
If Err = 2465 Then ' Place control doesn't exist
Resume NextRec
Else
MsgBox MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure Form_Current of VBA Document Form_Form3" End If

End Sub

Private Sub Form_Open(Cancel As Integer)

Dim i As Integer

For i = 1 To Me.Controls.Count - 1
If If Left(Me.Controls(i).Name, 5) = "Space" And Len(Me.Controls(i).Name) = 7
Then Me.Controls(i).Visible = False
End If
Next i

End Sub

Private Sub Place01_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)

CtlMouseDown CInt(Right(Screen.ActiveControl.Name, 2)), X, Y

End Sub

Private Sub Place01_MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single)

If Button And acLeftButton Then
CtlMouseMove CInt(Right(Screen.ActiveControl.Name, 2)), X, Y
End If

CtlMouseUp CInt(Right(Screen.ActiveControl.Name, 2))

End Sub

Reply With Quote
  #5  
Old   
Phil
 
Posts: n/a

Default Re: BringToFront - 03-07-2011 , 05:13 PM



On 07/03/2011 20:03:59, Salad wrote:
Quote:
Phil wrote:

I have a form where I can drag controls around at Runtime.

Can you tell how you do that? Drag controls on a running form?

Hi Salad

Background:- I am involved with a yacht club and we need a diagram of the
space number where each boat is parked and who owns the boat. Currently,
because of the limitations the the Graph object in Access (Even 2010) , I
have an Access query that lists the boat name, class of boat and owner's name
in a combined field. I then have the XY co-ordinates of the place where it is
stored together with additional information about where the label should be
displayed relative to those XY Co-ordinates, and the angle that the label
should be displayed. This all gets output to Excel where I use a scatter
chart to show the position of the boats together with their names, owners
etc. The background for this display is the boat compound or pontoons as a
JPG picture. I haven't finished yet. I output the Excel graph as a GIF file
which I then display as a picture on an Access form. Our compound has about
80 boats in it, and the powers that be want to re-arrange it, and re-number
it. That means that I have to redraw the JPG picture, use largely trial and
error to get the XY co-ordinates of where is space is located and it takes a
hell of a time.

So what I have come up with is a form that has controls that you can drag
around. That is no problem, the problem is that I want to drag around Stephen
Leban’s Access Rotate Text control 2, but I will come back to that later.
Simply, there are 2 controls which can be repeated numerous timed. There is a
small TextBox (Place01) about ¼” square with the control source = 1 marking
the corner of a larger TextBox (Space01) which will hold the boat name and
owner. This can be repeated ad nauseam with Place02 and Space02.

Now to the code ‘Fraid it’s rather long. Will do a foll up shortly

Option Compare Database
Option Explicit

Dim blMove As Boolean
Dim MouseXStart As Integer, MouseYStart As Integer
Dim DeltaX As Integer, DeltaY As Integer
Dim ActiveCtl As Control

Private Const IDC_HAND = 32649&

' Boudaries of table area
Const TopBoundary As Long = 0
Const BottomBoundary As Long = 12300
Const LeftBoundary As Long = 4000
Const RightBoundary As Long = 15200

Private vate Declare PtrSafe Function LoadCursor Lib "user32" Alias
"LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As
Long) As Long


Sub SaveCtlPosition(PlaceID As Integer)

Dim SQLStg As String
Dim CtlPlace As Control, CtlSpace As Control

Set CtlPlace = Controls("Place" & Format(PlaceID, "00"))
Set CtlSpace = Controls("Space" & Format(PlaceID, "00"))

' When the mouse is moved over the image and blMove is true,
' ' Change the x and y position of the table image and its associated labels
' and textboxes
' according to the change in mouse X and Y position from the last
' time the mouse was clicked down.

CtlSpace.Top = CtlPlace.Top + 100
CtlSpace.Left = CtlPlace.Left + 100
CtlPlace.SetFocus

On Error GoTo Trapper
blMove = False

SQLStg = "UPDATE SpaceChargeType INNER JOIN Spaces "
SQLStg = SQLStg & "ON SpaceChargeType.SpaceTypeID = Spaces.SpaceTypeID "
SQLStg LStg = SQLStg & "SET Spaces.XCoord = " & CInt(CtlPlace.Left *
[XMultiplyer]) & ", " SQLStg = SQLStg & "Spaces.YCoord = " &
CInt(CtlPlace.Top * [YMultiplyer]) & ", " SQLStg = SQLStg & "LabelAngle = " &
CtlSpace.Escapement SQLStg = SQLStg & " WHERE (Spaces.SpaceTypeID = " &
SpaceTypeID SQLStg = SQLStg & ") AND (SpaceNo = " & PlaceID & ");"

'Store the change in space positions in Spaces table
DoCmd.SetWarnings False
DoCmd.RunSQL (SQLStg)
DoCmd.SetWarnings True

Exit Sub

Trapper:
If Err.Number = 2100 Then
Else
MsgBox Err.Description
End If

End Sub

Sub CtlMouseDown(PlaceID As Integer, X As Single, Y As Single)
'When the mouse is clicked down on a space image, record the
'Current mouse x and y position and set the boolean value blMove to true

Dim hCur As Long

hCur = LoadCursor(0, IDC_HAND) ' Turn cursor into a finger
If (hCur > 0) Then
SetCursor hCur
End If

Dim Ctl As Control

Set Ctl = Controls("Space" & Format(PlaceID, "00"))

Ctl.BackColor = vbYellow
blMove = True
MouseXStart = X
MouseYStart = Y

End Sub

Sub CtlMouseMove(PlaceID As Long, X As Single, Y As Single)

Const onst TwipsPerCm = 567 ' 1440 / 2.54

Dim TmpX As Long, TmpY As Long
Dim MinX As Long, MinY As Long
Dim Ctl As Control

Set Ctl = Controls("Place" & Format(PlaceID, "00"))

' When the mouse is moved over a table image and blMove is true,
' ' Change the x and y position of the table image and its associated labels
' and textCtles
' according to the change in mouse X and Y position from the last
' time the mouse was clicked down.

If blMove Then
DeltaX = X - MouseXStart
DeltaY = Y - MouseYStart

TmpX = Ctl.Left + DeltaX
'If TmpX < MinX Then TmpX = MinX
If TmpX > SpaceTypeMaxWidth Then TmpX = SpaceTypeMaxWidth

TmpY = Ctl.Top + DeltaY
If TmpY < MinY Then TmpY = MinY
If TmpY > SpaceTypeMaxHeight Then TmpY = SpaceTypeMaxHeight

Ctl.Left = TmpX
Ctl.Top = TmpY
End If

Set Ctl = Nothing

End Sub

Sub CtlMouseUp(PlaceID As Integer)

Dim Ctl As Control

On Error GoTo Trapper

blMove = False

Call SaveCtlPosition(PlaceID) ' Save space positions

Set Ctl = Controls("Space" & Format(PlaceID, "00"))
Ctl.BackColor = vbWhite
Exit Sub

Trapper:
MsgBox Err.Description
Exit Sub

End Sub

Private Sub Angle_AfterUpdate()

Const Pi = 3.14159

Dim CtlSpace As Control
Dim CtlWidth As Long, CtlHeight As Long

Set CtlSpace = ActiveCtl
CtlSpace.Escapement = CInt(Angle)

SaveCtlPosition (CLng(Right(CtlSpace.Name, 2)))

CtlSpace.Width idth = fTextWidth(CtlSpace, Nz(CtlSpace.Caption,
"AAAAAAAAAA")) CtlSpace.Height = fTextHeight(CtlSpace, Nz(CtlSpace.Caption,
"AAAAAAAAAA")) CtlWidth = CtlSpace.Width
CtlHeight = CtlSpace.Height
If Cos(Angle * Pi / 180) < 0 Then
CtlSpace.Width ce.Width = CtlSpace.Height - CtlSpace.Width * Cos(Angle * Pi /
180) Else
CtlSpace.Width ce.Width = CtlSpace.Height + CtlSpace.Width * Cos(Angle * Pi /
180) End If
If Sin(Angle * Pi / 180) < 0 Then
CtlSpace.Height = CtlSpace.Height - CtlWidth * Sin(Angle * Pi / 180)
Else
CtlSpace.Height = CtlSpace.Height + CtlWidth * Sin(Angle * Pi / 180)
End If

End Sub

Private Sub Form_Current()

Dim MyDb As Database
Dim SpaceSet As Recordset
Dim SQLStg As String
Dim CtlSpace As Control, CtlPlace As Control, Ctl As Control
Const onst TwipsPerCm = 567 ' 1440 / 2.54
Const Pi = 3.14159
Dim CtlHeight As Long, CtlWidth As Long
Dim i As Long

On Error GoTo Form_Current_Error

For i = 1 To Me.Controls.Count - 1
If If Left(Me.Controls(i).Name, 5) = "Space" And Len(Me.Controls(i).Name) = 7
_ Or Left(Me.Controls(i).Name, 5) = "Place" And Len(Me.Controls(i).Name) = 7
Then Me.Controls(i).Visible = False
End If
Next i

SQLStg = "SELECT QSpaceAllocation.* FROM QSpaceAllocation "
SQLStg = SQLStg & " WHERE SpaceTypeID = " & Nz(SpaceTypeIDRelay) & ";"

Set MyDb = CurrentDb
Set SpaceSet = MyDb.OpenRecordset(SQLStg)
With SpaceSet
Do Until .EOF
For Each Ctl In Me.Controls
If If Left(Ctl.Name, 5) = "Space" And Len(Ctl.Name) = 7 Then ' "Space05"
If CLng(Right(Ctl.Name, 2)) = !Space Then
Set Set CtlSpace = Controls("Space" & Format(!Space, "00")) Set Set CtlPlace
= Controls("Place" & Format(!Space, "00")) CtlPlace.Left =
CInt(CLng(Nz(!XCoord) / Nz(!XMultiplyer) * 10) / 10) CtlPlace.Top =
CInt(CLng(Nz(!YCoord) / Nz(!YMultiplyer) * 10) / 10) CtlSpace.Escapement =
!LabelAngle CtlSpace.Caption = Nz(!SpaceAndName)

' adjust the control's size to match the text
CtlSpace.Width CtlSpace.Width = fTextWidth(CtlSpace, Nz(!SpaceAndName,
"AAAAAAAAAA")) CtlSpace.Height = fTextHeight(CtlSpace, Nz(!SpaceAndName,
"AAAAAAAAAA")) CtlWidth = CtlSpace.Width
CtlHeight = CtlSpace.Height
' Reformat control to take account of angle
If Cos(!LabelAngle * Pi / 180) < 0 Then
CtlSpace.Width CtlSpace.Width = CtlSpace.Height - CtlSpace.Width *
Cos(!LabelAngle * Pi / 180) Else
CtlSpace.Width CtlSpace.Width = CtlSpace.Height + CtlSpace.Width *
Cos(!LabelAngle * Pi / 180) End If
If Sin(!LabelAngle * Pi / 180) < 0 Then
CtlSpace.Height CtlSpace.Height = CtlSpace.Height - CtlWidth *
Sin(!LabelAngle * Pi / 180) Else
CtlSpace.Height CtlSpace.Height = CtlSpace.Height + CtlWidth *
Sin(!LabelAngle * Pi / 180) End If
If CtlSpace.Caption > "" Then
CtlSpace.Visible = True
CtlPlace.Visible = True
End If

CtlSpace.Top = CtlPlace.Top + 100
CtlSpace.Left = CtlPlace.Left + 100
End If
End If
Next Ctl
NextRec:
.MoveNext
Loop
.Close
Set SpaceSet = Nothing
End With

Exit Sub

Form_Current_Error:
If Err = 2465 Then ' Place control doesn't exist
Resume NextRec
Else
MsgBox MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure Form_Current of VBA Document Form_Form3" End If

End Sub

Private Sub Form_Open(Cancel As Integer)

Dim i As Integer

For i = 1 To Me.Controls.Count - 1
If If Left(Me.Controls(i).Name, 5) = "Space" And Len(Me.Controls(i).Name) = 7
Then Me.Controls(i).Visible = False
End If
Next i

End Sub

Private Sub Place01_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)

CtlMouseDown CInt(Right(Screen.ActiveControl.Name, 2)), X, Y

End Sub

Private Sub Place01_MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single)

If Button And acLeftButton Then
CtlMouseMove CInt(Right(Screen.ActiveControl.Name, 2)), X, Y
End If

CtlMouseUp CInt(Right(Screen.ActiveControl.Name, 2))

End Sub

Reply With Quote
  #6  
Old   
Phil
 
Posts: n/a

Default Re: BringToFront - 03-07-2011 , 05:16 PM



On 07/03/2011 23:13:55, "Phil" wrote:
Quote:
Think the message is too long. Will try to send it in batches

Hi Salad

Background:- I am involved with a yacht club and we need a diagram of the
space number where each boat is parked and who owns the boat. Currently,
because of the limitations the the Graph object in Access (Even 2010) , I
have an Access query that lists the boat name, class of boat and owner's name
in a combined field. I then have the XY co-ordinates of the place where it is
stored together with additional information about where the label should be
displayed relative to those XY Co-ordinates, and the angle that the label
should be displayed. This all gets output to Excel where I use a scatter
chart to show the position of the boats together with their names, owners
etc. The background for this display is the boat compound or pontoons as a
JPG picture. I haven't finished yet. I output the Excel graph as a GIF file
which I then display as a picture on an Access form. Our compound has about
80 boats in it, and the powers that be want to re-arrange it, and re-number
it. That means that I have to redraw the JPG picture, use largely trial and
error to get the XY co-ordinates of where is space is located and it takes a
hell of a time.

So what I have come up with is a form that has controls that you can drag
around. That is no problem, the problem is that I want to drag around Stephen
Leban’s Access Rotate Text control 2, but I will come back to that later.
Simply, there are 2 controls which can be repeated numerous timed. There is a
small TextBox (Place01) about ¼” square with the control source = 1 marking
the corner of a larger TextBox (Space01) which will hold the boat name and
owner. This can be repeated ad nauseam with Place02 and Space02.
Now to the code ‘Fraid it’s rather long

Reply With Quote
  #7  
Old   
Phil
 
Posts: n/a

Default Re: BringToFront - 03-07-2011 , 05:19 PM



Now to the code ‘Fraid it’s rather long
Option Compare Database
Option Explicit

Dim blMove As Boolean
Dim MouseXStart As Integer, MouseYStart As Integer
Dim DeltaX As Integer, DeltaY As Integer
Dim ActiveCtl As Control

Private Const IDC_HAND = 32649&

' Boudaries of table area
Const TopBoundary As Long = 0
Const BottomBoundary As Long = 12300
Const LeftBoundary As Long = 4000
Const RightBoundary As Long = 15200

Private vate Declare PtrSafe Function LoadCursor Lib "user32" Alias
"LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As
Long) As Long

Sub SaveCtlPosition(PlaceID As Integer)

Dim SQLStg As String
Dim CtlPlace As Control, CtlSpace As Control

Set CtlPlace = Controls("Place" & Format(PlaceID, "00"))
Set CtlSpace = Controls("Space" & Format(PlaceID, "00"))

' When the mouse is moved over the image and blMove is true,
' ' Change the x and y position of the table image and its associated labels
' and textboxes
' according to the change in mouse X and Y position from the last
' time the mouse was clicked down.

CtlSpace.Top = CtlPlace.Top + 100
CtlSpace.Left = CtlPlace.Left + 100
CtlPlace.SetFocus

On Error GoTo Trapper
blMove = False

SQLStg = "UPDATE SpaceChargeType INNER JOIN Spaces "
SQLStg = SQLStg & "ON SpaceChargeType.SpaceTypeID = Spaces.SpaceTypeID "
SQLStg LStg = SQLStg & "SET Spaces.XCoord = " & CInt(CtlPlace.Left *
[XMultiplyer]) & ", " SQLStg = SQLStg & "Spaces.YCoord = " &
CInt(CtlPlace.Top * [YMultiplyer]) & ", " SQLStg = SQLStg & "LabelAngle = " &
CtlSpace.Escapement SQLStg = SQLStg & " WHERE (Spaces.SpaceTypeID = " &
SpaceTypeID SQLStg = SQLStg & ") AND (SpaceNo = " & PlaceID & ");"

'Store the change in space positions in Spaces table
DoCmd.SetWarnings False
DoCmd.RunSQL (SQLStg)
DoCmd.SetWarnings True

Exit Sub

Trapper:
If Err.Number = 2100 Then
Else
MsgBox Err.Description
End If

End Sub

Reply With Quote
  #8  
Old   
Phil
 
Posts: n/a

Default Re: BringToFront - 03-07-2011 , 05:21 PM



Batch 2

Sub CtlMouseDown(PlaceID As Integer, X As Single, Y As Single)
'When the mouse is clicked down on a space image, record the
'Current mouse x and y position and set the boolean value blMove to true

Dim hCur As Long

hCur = LoadCursor(0, IDC_HAND) ' Turn cursor into a finger
If (hCur > 0) Then
SetCursor hCur
End If

Dim Ctl As Control

Set Ctl = Controls("Space" & Format(PlaceID, "00"))

Ctl.BackColor = vbYellow
blMove = True
MouseXStart = X
MouseYStart = Y

End Sub

Sub CtlMouseMove(PlaceID As Long, X As Single, Y As Single)

Const onst TwipsPerCm = 567 ' 1440 / 2.54

Dim TmpX As Long, TmpY As Long
Dim MinX As Long, MinY As Long
Dim Ctl As Control

Set Ctl = Controls("Place" & Format(PlaceID, "00"))

' When the mouse is moved over a table image and blMove is true,
' ' Change the x and y position of the table image and its associated labels
' and textCtles
' according to the change in mouse X and Y position from the last
' time the mouse was clicked down.

If blMove Then
DeltaX = X - MouseXStart
DeltaY = Y - MouseYStart

TmpX = Ctl.Left + DeltaX
'If TmpX < MinX Then TmpX = MinX
If TmpX > SpaceTypeMaxWidth Then TmpX = SpaceTypeMaxWidth

TmpY = Ctl.Top + DeltaY
If TmpY < MinY Then TmpY = MinY
If TmpY > SpaceTypeMaxHeight Then TmpY = SpaceTypeMaxHeight

Ctl.Left = TmpX
Ctl.Top = TmpY
End If

Set Ctl = Nothing

End Sub

Sub CtlMouseUp(PlaceID As Integer)

Dim Ctl As Control

On Error GoTo Trapper

blMove = False

Call SaveCtlPosition(PlaceID) ' Save space positions

Set Ctl = Controls("Space" & Format(PlaceID, "00"))
Ctl.BackColor = vbWhite
Exit Sub

Trapper:
MsgBox Err.Description
Exit Sub

End Sub

Reply With Quote
  #9  
Old   
Phil
 
Posts: n/a

Default Re: BringToFront - 03-07-2011 , 05:22 PM



Batch 3
Private Sub Form_Current()

Dim MyDb As Database
Dim SpaceSet As Recordset
Dim SQLStg As String
Dim CtlSpace As Control, CtlPlace As Control, Ctl As Control
Const onst TwipsPerCm = 567 ' 1440 / 2.54
Const Pi = 3.14159
Dim CtlHeight As Long, CtlWidth As Long
Dim i As Long

On Error GoTo Form_Current_Error

For i = 1 To Me.Controls.Count - 1
If If Left(Me.Controls(i).Name, 5) = "Space" And Len(Me.Controls(i).Name) = 7
_ Or Left(Me.Controls(i).Name, 5) = "Place" And Len(Me.Controls(i).Name) = 7
Then Me.Controls(i).Visible = False
End If
Next i

SQLStg = "SELECT QSpaceAllocation.* FROM QSpaceAllocation "
SQLStg = SQLStg & " WHERE SpaceTypeID = " & Nz(SpaceTypeIDRelay) & ";"

Set MyDb = CurrentDb
Set SpaceSet = MyDb.OpenRecordset(SQLStg)
With SpaceSet
Do Until .EOF
For Each Ctl In Me.Controls
If If Left(Ctl.Name, 5) = "Space" And Len(Ctl.Name) = 7 Then ' "Space05"
If CLng(Right(Ctl.Name, 2)) = !Space Then
Set Set CtlSpace = Controls("Space" & Format(!Space, "00")) Set Set CtlPlace
= Controls("Place" & Format(!Space, "00")) CtlPlace.Left =
CInt(CLng(Nz(!XCoord) / Nz(!XMultiplyer) * 10) / 10) CtlPlace.Top =
CInt(CLng(Nz(!YCoord) / Nz(!YMultiplyer) * 10) / 10) CtlSpace.Escapement =
!LabelAngle CtlSpace.Caption = Nz(!SpaceAndName)

' adjust the control's size to match the text
CtlSpace.Width CtlSpace.Width = fTextWidth(CtlSpace, Nz(!SpaceAndName,
"AAAAAAAAAA")) CtlSpace.Height = fTextHeight(CtlSpace, Nz(!SpaceAndName,
"AAAAAAAAAA")) CtlWidth = CtlSpace.Width
CtlHeight = CtlSpace.Height
' Reformat control to take account of angle
If Cos(!LabelAngle * Pi / 180) < 0 Then
CtlSpace.Width CtlSpace.Width = CtlSpace.Height - CtlSpace.Width *
Cos(!LabelAngle * Pi / 180) Else
CtlSpace.Width CtlSpace.Width = CtlSpace.Height + CtlSpace.Width *
Cos(!LabelAngle * Pi / 180) End If
If Sin(!LabelAngle * Pi / 180) < 0 Then
CtlSpace.Height CtlSpace.Height = CtlSpace.Height - CtlWidth *
Sin(!LabelAngle * Pi / 180) Else
CtlSpace.Height CtlSpace.Height = CtlSpace.Height + CtlWidth *
Sin(!LabelAngle * Pi / 180) End If
If CtlSpace.Caption > "" Then
CtlSpace.Visible = True
CtlPlace.Visible = True
End If

CtlSpace.Top = CtlPlace.Top + 100
CtlSpace.Left = CtlPlace.Left + 100
End If
End If
Next Ctl
NextRec:
.MoveNext
Loop
.Close
Set SpaceSet = Nothing
End With

Exit Sub

Form_Current_Error:
If Err = 2465 Then ' Place control doesn't exist
Resume NextRec
Else
MsgBox MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure Form_Current of VBA Document Form_Form3" End If

End Sub

Private Sub Form_Open(Cancel As Integer)

Dim i As Integer

For i = 1 To Me.Controls.Count - 1
If If Left(Me.Controls(i).Name, 5) = "Space" And Len(Me.Controls(i).Name) = 7
Then Me.Controls(i).Visible = False
End If
Next i

End Sub

Reply With Quote
  #10  
Old   
Phil
 
Posts: n/a

Default Re: BringToFront - 03-07-2011 , 05:36 PM



Batch 4
Private Sub Place01_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)

CtlMouseDown CInt(Right(Screen.ActiveControl.Name, 2)), X, Y

End Sub

Private Sub Place01_MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single)

If Button And acLeftButton Then
CtlMouseMove CInt(Right(Screen.ActiveControl.Name, 2)), X, Y
End If

CtlMouseUp CInt(Right(Screen.ActiveControl.Name, 2))

End Sub

There is a lot of other stuff about setting the angle of the control and
fitting the control to the data (fTextWidth routine)

My main problem, and that is why I will have to abandone the project is that
Stephen's ActiveX control does not support the BackStyle property, which I
need to be transparent. If I have 2 spaces with the tecxt at 45 degrees,
there are 2 squares, each about one and 1 half inches overlapping each other
and the corner of one square obscures the text in the other square. I
desparately need someone who can add the additional property to Stephen's
ActiveX control, I have the source code, but no idea wher to begin. Suspect
that being well into my 70's it's getting a bit late to start learning VB

Anything more, please come back.

Incidently, very successfully, I have used a similar system for planing the
seating arangement for our formal dining events, where I drag the dining
tables around, alter their sizes and all the chairs move along with the
tables and the right number of chairs appear depending on the length of the
table (and how tightly we sppace the seats)

Phil

Reply With Quote
Reply




Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off



Powered by vBulletin Version 3.5.3
Copyright ©2000 - 2012, Jelsoft Enterprises Ltd.