Code Archive (1 Viewer)

Status
Not open for further replies.

Oldsoftboss

AWF VIP
Local time
Tomorrow, 03:25
Joined
Oct 28, 2001
Messages
2,504
Maybe we can post our bits of code here. They also can be tranfered to a separate forum at a later date.
 

Oldsoftboss

AWF VIP
Local time
Tomorrow, 03:25
Joined
Oct 28, 2001
Messages
2,504
Custom Pause, by GHudson

Here is an updated version of my Pause function... by ghudson
code:

Public Function Pause(NumberOfSeconds As Variant)
On Error GoTo Err_Pause

Dim PauseTime As Variant, Start As Variant

PauseTime = NumberOfSeconds
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop

Exit_Pause:
Exit Function

Err_Pause:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Pause

End Function

You can now vary the seconds of the pause by calling it like this...

Pause (5) 'for a five second pause
 

Oldsoftboss

AWF VIP
Local time
Tomorrow, 03:25
Joined
Oct 28, 2001
Messages
2,504
Code to have your own Icon on a form...


'place this sub in each forms "Load" event
Private Sub Form_Load()

SetFormIcon Me.hWnd, Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name))) & “\myicon.ico"
‘if the icon file is stored in the same directory as the db
‘or
SetFormIcon Me.hWnd, "C:\Icons\Icon1.ico" 'Location of icon file

End Sub

'copy below code in a new public module
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50

Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, LParam As Any) As Long

Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
Dim lIcon As Long
Dim lResult As Long
Dim X As Long, Y As Long

X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)
End Function
 

Oldsoftboss

AWF VIP
Local time
Tomorrow, 03:25
Joined
Oct 28, 2001
Messages
2,504
Changing the Background Color of the Current Record in a Continuous Form

Changing the Background Color in a continuous form is an often asked question in the Access Newsgroups. The following document shows how this can be done, and the methodology behind it.
This procedure will highlight the current row in a continuous form. Please see the notes at the end to learn what this procedure DOES NOT do.

This sample is based on the "Products" table from the Northwinds Database. Changes will be noted so you may use this code in your own form.

1. Create a new form based on the "Products" table.
2. Add all fields from the products table to the form.
3. Create the following Controls to the form

Name: CtlBack
Control Source: =IIf([SelTop]=[ctlCurrentLine],"ÛÛÛÛÛÛÛÛÛÛÛÛ",Null)

"Û" is character 0219, the easiest way to enter this is to copy and paste from here. Format the font of this control as Terminal.
Place this control on your form so that it is sized to cover the entire area where you would like the background to be. Experiment with the number of "Û" characters as well as the font height to get complete coverage.
Set the background to transparent. Set the foreground to whatever color you want your highlight color to be. Make sure the section background color is different from the highlight color.

Next, for all the controls that will have the background highlight, select them all, change the background color to the highlight color, then change the background color to transparent. (Yes, this step is necessary).

The following two controls can be placed anywhere, and be hidden. You may want to leave them visible to help in seeing how this works, then hide them when done.

Name: ctlCurrentLine
Control Source:=GetLineNumber()

Name: ctlCurrentRecord
Control Source: unbound

Add the following code behind the form:

Function GetLineNumber()
'The function "GetLineNumber" is modified from the Microsoft Knowledge Base
' (Q120913), the only difference here is that the following items have been hard
'coded:F, KeyName, KeyValue. This was done to add a slight performance
'increase. Change KeyName and KeyValue to reflect the key in your table.

Dim RS As Recordset
Dim CountLines
Dim F As Form
Dim KeyName As String
Dim KeyValue

Set F = Form
‘Set the following 2 lines to the AutoNo field
KeyName = "productid"
KeyValue = [ProductID]

On Error GoTo Err_GetLineNumber
Set RS = F.RecordsetClone
' Find the current record.
Select Case RS.Fields(KeyName).Type
' Find using numeric data type key value.
Case DB_INTEGER, DB_LONG, DB_CURRENCY, DB_SINGLE, _
DB_DOUBLE, DB_BYTE
RS.FindFirst "[" & KeyName & "] = " & KeyValue
' Find using date data type key value.
Case DB_DATE
RS.FindFirst "[" & KeyName & "] = #" & KeyValue & "#"
' Find using text data type key value.
Case DB_TEXT
RS.FindFirst "[" & KeyName & "] = '" & KeyValue & "'"
Case Else
MsgBox "ERROR: Invalid key field data type!"
Exit Function
End Select
' Loop backward, counting the lines.
Do Until RS.BOF
CountLines = CountLines + 1
RS.MovePrevious
Loop
Bye_GetLineNumber: ' Return the result.
GetLineNumber = CountLines
Exit Function
Err_GetLineNumber:
CountLines = 0
Resume Bye_GetLineNumber
End Function

Private Sub Form_Click()
Me!ctlCurrentRecord = Me.SelTop

End Sub

Private Sub Form_Current()
Me!ctlCurrentRecord = Me.SelTop
End Sub

How the code works:
When you open the form, the GetLineNumber function gets the record number for each record and assigns its value to "ctlCurrentLine". As you move from record to record, the code "Me!ctlCurrentRecord = Me.SelTop" changes the value of "ctlcurrentRecord" to the current record number (See Access help for more on "SelTop"). The code in "ctlBack" compares "SelTop" to the "ctlCurrentLine" value and only changes the highlight if the two are equal. These values will only be equal for the current record. The highlighting works by formatting the Terminal Font character 219 (a box, you can use any font box character, but Terminal is more likely to be on any machine) to the highlight color. Because all the controls on the form are transparent, this formatting shows through as a background to the controls.

Notes:
Although at first glance it may look like the control "ctlCurrentRecord" is not needed, it actually is to force the record numbers to update as you move from record to record.
The code as written will detect movement to a row from the following: a mouse or keyboard click, clicking the record selector (through Form_Click), and using the Record Navigation bar. If you move to rows through code, you may need to make modifications to highlight the row.
Performance is affected by the speed of the machine. On slower machines you will note that the individual cell highlight shows first, then the whole row becomes highlighted.
The are many things that can be done with a continuous form, such as allowing deletions, edits, additions, etc. This code generically handles navigation through the form only. To account for how your form is actually set up, you would need to modify your form to detect each of the above events, and refresh accordingly. Anytime you change the underlying records of the form, you will need to call "GetLineNumber" (one way to do this is through Form.Refresh). Since there is a performance hit in doing this, only use this for those operations that are allowed on your form.
 
D

don1

Guest
This method works but it is complicated. Besides, when distributing applications you have to include the font which has license somwhere...

Use LaBox font (royalty free) in a texbox called ctlBackground. Set Format to ' ;"AAAAAAAAAAAAAAAAAAAAAA"' (space, semicolon, quote, lots of A's, quote). If textbox Control evaluates to True, textbox will display solid line of color of Fore Color. If control evaluets to False - no color, textbox is blank.
Example: If "Me.PastDueAmount>0" in ctlBackground Control will evaluate to True, the solid color will display.
 
Status
Not open for further replies.

Users who are viewing this thread

Top Bottom