[AccessD] Allow users to change background colors

On 27 Oct 2004 at 8:04, Klos, Susan wrote:

> I have a very simple two form application that I have developed for my
> office.  Naturally, some folks don't like the colors I chose for the
> background.  I would like to give them a way of changing the colors without
> giving them access to design view.  Any ideas.  TIA.
> 

In brief: 
Store the desired colour somewhere such as a system table, set it on_load 
and provide a button to call the ChooseColor common dialog,  update the 
current background and store the new colour:

In detail:

1.  Table:  TSysFile Field: BColor - Long

2.  Create a button on the form called cmdColorChange and set the button's 
on_click to [Event procedure]

3. Paste the following into the form's module.

Option Compare Database
Option Explicit
   Private Type CHOOSECOLOR
     lStructSize As Long
     hwndOwner As Long
     hInstance As Long
     rgbResult As Long
     lpCustColors As String
     flags As Long
     lCustData As Long
     lpfnHook As Long
     lpTemplateName As String
   End Type

   Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias _
     "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long

   Dim CustomColors() As Byte

   Private Sub Form_Load()

       ReDim CustomColors(0 To 16 * 4 - 1) As Byte
       Dim i As Integer

       For i = LBound(CustomColors) To UBound(CustomColors)
           CustomColors(i) = 0
       Next i
       
       Detail.BackColor = DLookup("bcolor", "tsysfile")
 
  End Sub

Private Sub CmdColorChange_Click()
       
       Dim cc As CHOOSECOLOR
       Dim Custcolor(16) As Long
       Dim lReturn As Long
       cc.lStructSize = Len(cc)
       cc.hwndOwner = Me.Hwnd
       cc.hInstance = 0
       cc.lpCustColors = StrConv(CustomColors, vbUnicode)
       cc.flags = 0
       lReturn = ChooseColorAPI(cc)
       If lReturn <> 0 Then
           Detail.BackColor = cc.rgbResult ' Access only **********
           CurrentDb.Execute "Update tSysFile set BColor = " & cc.rgbResult
           CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
       End If

End Sub


-- 
Stuart