Highlight Current Row

[RexAbandon via AccessMonster.com]

I would like to use Stephen Lebans AlternateColorDetailSection class to
highlight the current row in a continuous form. The code seems to accomodate
this option but I cannot get it to work.

Has anyone tried this?


Rex

 

[Stephen Lebans]

Post your code behind the Form you are working with.

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

 

[RexAbandon via AccessMonster.com]

Thanks for replying Stephen.

This is what I have done thus far.
I changed the default in the Class_Initialize in your clsAlternateColor
module to HighlightCurrentRow and changed the last IF statement in your
DrawRect procedure, see below.
I also changed the FrameHighlight default value to 5 and the OptionValue for
Option34 to 5 in your AlternateColor form. The current row will highlight as
long as the top row shown in the form is first record. I still have to
review more of your code to determine the 'toprow' and to make it highlight
the correct row.

Rex

Private Sub Class_Initialize()
' Default border width of frame we draw
' around the control
m_BorderWidth = 6

' Default draw Alternate Rows of Color.
m_HighlightRoworControlOrColumn = HighlightCurrentRow
'HighlightAlternateRows

' Default Alternate Color = RED
m_HighlightColor = vbRed
End Sub

Public Sub DrawRect(row As Long, RowColor As Long)
' Row is a zero based index
' RowColor is desired color
' CriControl is the control we will use if
' we are only shading behind a single control
' or we are shading an entire column.
' Draw rectangle onto our background Bitmap


' REMOVE THIS IN PRODUCTION CODE
' ADD YOUR OWN ERROR HANDLING!
On Error Resume Next


' Temp vars
Dim hNewBrush As Long
Dim rc As RECT
Dim lngLeft As Long, lngWidth As Long
' loop counter
Dim x As Long

' Create a Brush in the desired color
Select Case m_HighlightRoworControlOrColumn

Case HighlightNothing
'Do Nothing!
Exit Sub

Case HighlightColumnControl, HighlightAlternateRows
hNewBrush = apiCreateSolidBrush(m_HighlightColor) 'RGB(255, 0, 0))
'Debug.Print "created brush"

Case Else
hNewBrush = apiCreateSolidBrush(RowColor)
End Select

'Debug.Print "m_Form.Controls(Testcolumn).Left" & m_Form.Controls
("testcolumn").Left

Select Case m_HighlightRoworControlOrColumn


Case HighlightNothing
'Do Nothing!

Case HighlightControl
' Row height is independant of width
rc.Top = m_HeaderHeightPixels
rc.Top = rc.Top + (row * m_DetailRowHeight)
rc.Bottom = rc.Top + m_DetailRowHeight

'lngLeft = TwipsToPixels((m_Form.Controls("testcolumn").Left) - 1,
Horiz)
lngLeft = TwipsToPixels(m_CriteriaControl.Left - 1, Horiz)
'lngLeft = TwipsToPixels(m_CriteriaControl.Left - 1, Horiz)
'Debug.Print "lngLeft:" & lngLeft
'Debug.Print

lngWidth = TwipsToPixels((m_CriteriaControl.width) - 1, Horiz)
'lngWidth = TwipsToPixels((m_CriteriaControl.width) + 1, Horiz)
'Debug.Print "m_Form.Controls(Testcolumn).Width" & m_Form.Controls
("testcolumn").width
'Debug.Print "lngWidth:" & lngWidth
'Debug.Print
rc.Left = (lngLeft - m_BorderWidth) + m_RecordSelectorWidth
rc.Right = rc.Left + lngWidth + (m_BorderWidth * 2)

Case HighlightRow, HighlightAlternateRows, HighlightCurrentRow
' Row height is independant of width
rc.Top = m_HeaderHeightPixels
rc.Top = rc.Top + (row * m_DetailRowHeight)
rc.Bottom = rc.Top + m_DetailRowHeight

' Fill the entire row
rc.Left = 0
rc.Right = m_bmi.bmiHeader.biWidth


Case HighlightColumnControl
rc.Top = m_HeaderHeightPixels
lngWidth = TwipsToPixels((m_HighlightColumn.width) - 1, Horiz)
'lngWidth = TwipsToPixels((m_HighlightColumn.width) + 1, Horiz)
lngLeft = TwipsToPixels(m_HighlightColumn.Left - 1, Horiz)
rc.Left = (lngLeft - m_BorderWidth) + m_RecordSelectorWidth
rc.Right = rc.Left + lngWidth + (m_BorderWidth * 2)
rc.Bottom = rc.Top + ((m_Form.RecordsetClone.RecordCount + 1) -
m_TopRow) * m_DetailRowHeight

Case Else
End Select

If m_HighlightRoworControlOrColumn = HighlightAlternateRows Then
' 'Only print even numbered rows
If (row Mod 2) = 0 Then
' Draw the Rectangle
Call apiFillRect(m_hDC, rc, hNewBrush)
End If

ElseIf m_HighlightRoworControlOrColumn = HighlightCurrentRow Then
'Added this IF statement
If row = m_Form.CurrentRecord - 1 Then
Call apiFillRect(m_hDC, rc, hNewBrush) 'Draw the Rectangle
End If

Else
Call apiFillRect(m_hDC, rc, hNewBrush)
End If

Call DeleteObject(hNewBrush)

End Sub

Post your code behind the Form you are working with.

I would like to use Stephen Lebans AlternateColorDetailSection class to
highlight the current row in a continuous form. The code seems to

[quoted text clipped - 4 lines]

Rex

 

[Stephen Lebans]

Hi Rex,
I asked you to post the code behind your form. I just want to ensure you are
setting up the class correctly. Also if you start making changes to my
underlying Class then you are on your own,

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

Thanks for replying Stephen.

This is what I have done thus far.
I changed the default in the Class_Initialize in your clsAlternateColor
module to HighlightCurrentRow and changed the last IF statement in your
DrawRect procedure, see below.
I also changed the FrameHighlight default value to 5 and the OptionValue
for
Option34 to 5 in your AlternateColor form. The current row will highlight
as
long as the top row shown in the form is first record. I still have to
review more of your code to determine the 'toprow' and to make it
highlight
the correct row.

Rex

Private Sub Class_Initialize()
' Default border width of frame we draw
' around the control
m_BorderWidth = 6

' Default draw Alternate Rows of Color.
m_HighlightRoworControlOrColumn = HighlightCurrentRow
'HighlightAlternateRows

' Default Alternate Color = RED
m_HighlightColor = vbRed
End Sub

Public Sub DrawRect(row As Long, RowColor As Long)
' Row is a zero based index
' RowColor is desired color
' CriControl is the control we will use if
' we are only shading behind a single control
' or we are shading an entire column.
' Draw rectangle onto our background Bitmap


' REMOVE THIS IN PRODUCTION CODE
' ADD YOUR OWN ERROR HANDLING!
On Error Resume Next


' Temp vars
Dim hNewBrush As Long
Dim rc As RECT
Dim lngLeft As Long, lngWidth As Long
' loop counter
Dim x As Long

' Create a Brush in the desired color
Select Case m_HighlightRoworControlOrColumn

Case HighlightNothing
'Do Nothing!
Exit Sub

Case HighlightColumnControl, HighlightAlternateRows
hNewBrush = apiCreateSolidBrush(m_HighlightColor) 'RGB(255, 0, 0))
'Debug.Print "created brush"

Case Else
hNewBrush = apiCreateSolidBrush(RowColor)
End Select

'Debug.Print "m_Form.Controls(Testcolumn).Left" & m_Form.Controls
("testcolumn").Left

Select Case m_HighlightRoworControlOrColumn


Case HighlightNothing
'Do Nothing!

Case HighlightControl
' Row height is independant of width
rc.Top = m_HeaderHeightPixels
rc.Top = rc.Top + (row * m_DetailRowHeight)
rc.Bottom = rc.Top + m_DetailRowHeight

'lngLeft = TwipsToPixels((m_Form.Controls("testcolumn").Left) - 1,
Horiz)
lngLeft = TwipsToPixels(m_CriteriaControl.Left - 1, Horiz)
'lngLeft = TwipsToPixels(m_CriteriaControl.Left - 1, Horiz)
'Debug.Print "lngLeft:" & lngLeft
'Debug.Print

lngWidth = TwipsToPixels((m_CriteriaControl.width) - 1, Horiz)
'lngWidth = TwipsToPixels((m_CriteriaControl.width) + 1, Horiz)
'Debug.Print "m_Form.Controls(Testcolumn).Width" & m_Form.Controls
("testcolumn").width
'Debug.Print "lngWidth:" & lngWidth
'Debug.Print
rc.Left = (lngLeft - m_BorderWidth) + m_RecordSelectorWidth
rc.Right = rc.Left + lngWidth + (m_BorderWidth * 2)

Case HighlightRow, HighlightAlternateRows, HighlightCurrentRow
' Row height is independant of width
rc.Top = m_HeaderHeightPixels
rc.Top = rc.Top + (row * m_DetailRowHeight)
rc.Bottom = rc.Top + m_DetailRowHeight

' Fill the entire row
rc.Left = 0
rc.Right = m_bmi.bmiHeader.biWidth


Case HighlightColumnControl
rc.Top = m_HeaderHeightPixels
lngWidth = TwipsToPixels((m_HighlightColumn.width) - 1, Horiz)
'lngWidth = TwipsToPixels((m_HighlightColumn.width) + 1, Horiz)
lngLeft = TwipsToPixels(m_HighlightColumn.Left - 1, Horiz)
rc.Left = (lngLeft - m_BorderWidth) + m_RecordSelectorWidth
rc.Right = rc.Left + lngWidth + (m_BorderWidth * 2)
rc.Bottom = rc.Top + ((m_Form.RecordsetClone.RecordCount + 1) -
m_TopRow) * m_DetailRowHeight

Case Else
End Select

If m_HighlightRoworControlOrColumn = HighlightAlternateRows Then
' 'Only print even numbered rows
If (row Mod 2) = 0 Then
' Draw the Rectangle
Call apiFillRect(m_hDC, rc, hNewBrush)
End If

ElseIf m_HighlightRoworControlOrColumn = HighlightCurrentRow Then
'Added this IF statement
If row = m_Form.CurrentRecord - 1 Then
Call apiFillRect(m_hDC, rc, hNewBrush) 'Draw the Rectangle
End If

Else
Call apiFillRect(m_hDC, rc, hNewBrush)
End If

Call DeleteObject(hNewBrush)

End Sub

Post your code behind the Form you are working with.

I would like to use Stephen Lebans AlternateColorDetailSection class to
highlight the current row in a continuous form. The code seems to

[quoted text clipped - 4 lines]

Rex

 

[RexAbandon via AccessMonster.com]

Hi Stephen,

I basically took the AlternateColor form in your downloaded and added a line
at the end of the form load procedure as follows:
fbc.HighlightRoworControlOrColumn = 5

I also changed the FrameHighlight default value to 5 and the OptionValue for
Option34 to 5 in the same form.

If the underlying class is left as is, all the rows highlight, not the
current row.

The code behind the form is:

Option Compare Database
Option Explicit
' Copyright Lebans Holdings 1999 Ltd.
' Alternate Colors for each row of the Detail Section.


' Var of type our class
Private fbc As clsAlternateColor

' Temp var for the Class
Dim blRet As Boolean


Private Sub Form_Load()
If Me.RecordSelectors = False Then
DoCmd.MoveSize 0, 0, 8200, 5350
Else
DoCmd.MoveSize 0, 0, 8500, 5350
End If

' Create a new instance of our AlternateColor class
Set fbc = New clsAlternateColor

' You MUST set the Form prop
fbc.SetForm Me
fbc.HighlightRoworControlOrColumn = 5 'Added

End Sub

Private Sub Form_Resize()
If Not fbc Is Nothing Then
' We have resized. Create a New Bitmap
' to match our new Detail size.
fbc.Create
fbc.UpdateScreen
End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
' Release our reference to the class
Set fbc = Nothing
End Sub


Private Sub FrameHighlight_AfterUpdate()
' Do we highlight or not?
fbc.HighlightRoworControlOrColumn = FrameHighlight
' Redraw the screen for our new setting to take effect
fbc.UpdateScreen
End Sub



Private Sub cmdColor_Click()
On Error GoTo Err_cmdColor_Click

' Call the API Color Dialog
fbc.HighlightColor = ShowColorDialog(fbc.HighlightColor)
' Update the display
fbc.UpdateScreen


Exit_cmdColor_Click:
Exit Sub

Err_cmdColor_Click:
MsgBox Err.Description
Resume Exit_cmdColor_Click

End Sub

 

[Stephen Lebans]

Only 4 and 6 are valid inputs. Where did you come up with 5?

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

 

[RexAbandon via AccessMonster.com]

The code in the clsAlternateClass module appeared to support highlighting
the current row if HighlightRoworControlorColumn was equal to 5.

Public Property Let HighlightRoworControlOrColumn(x As Long)
' 1 is Highlight Control only.(Default in Class Initialize)
' 2 is Highlight the entire row
' 3 is the entire Column as set in the HighlightColumn prop
' 4 is Highlight the entire row but alternately
' 5 is Highlight the Current row only
m_HighlightRoworControlOrColumn = x
End Property

Only 4 and 6 are valid inputs. Where did you come up with 5?

Hi Stephen,

[quoted text clipped - 77 lines]

End Sub

 

[Stephen Lebans]

Rex I clearly state at in the comments at the top of the source code that I
am only using parts of the underlying class copied from another solution of
mine. This implementation clearly states that is an AlternateRow
highlighting solution, not a CurrentRow highlighting solution.

To highlight the current row see:
http://www.lebans.com/conditionalformatting.htm

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

The code in the clsAlternateClass module appeared to support highlighting
the current row if HighlightRoworControlorColumn was equal to 5.

Public Property Let HighlightRoworControlOrColumn(x As Long)
' 1 is Highlight Control only.(Default in Class Initialize)
' 2 is Highlight the entire row
' 3 is the entire Column as set in the HighlightColumn prop
' 4 is Highlight the entire row but alternately
' 5 is Highlight the Current row only
m_HighlightRoworControlOrColumn = x
End Property

Only 4 and 6 are valid inputs. Where did you come up with 5?

Hi Stephen,

[quoted text clipped - 77 lines]

End Sub

 

[RexAbandon via AccessMonster.com]

Sorry, missed that note. I won't bother you with anymore postings.

Rex I clearly state at in the comments at the top of the source code that I
am only using parts of the underlying class copied from another solution of
mine. This implementation clearly states that is an AlternateRow
highlighting solution, not a CurrentRow highlighting solution.

To highlight the current row see:
http://www.lebans.com/conditionalformatting.htm

The code in the clsAlternateClass module appeared to support highlighting
the current row if HighlightRoworControlorColumn was equal to 5.

[quoted text clipped - 15 lines]

 

[Stephen Lebans]

You were not bothering me as I enjoy my time in the NG's.

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

Sorry, missed that note. I won't bother you with anymore postings.

Rex I clearly state at in the comments at the top of the source code that
I
am only using parts of the underlying class copied from another solution
of
mine. This implementation clearly states that is an AlternateRow
highlighting solution, not a CurrentRow highlighting solution.

To highlight the current row see:
http://www.lebans.com/conditionalformatting.htm

The code in the clsAlternateClass module appeared to support
highlighting
the current row if HighlightRoworControlorColumn was equal to 5.

[quoted text clipped - 15 lines]

End Sub