Solved

Access 2003 module not working on Vista?

Posted on 2009-05-13
4
275 Views
Last Modified: 2012-05-06
Does anyone know why the attached code works on XP with Access 2003 and not on Vista with Access 2003?

Any help would be much appreciated.

Option Compare Database
Option Explicit
 
Private Const conGraphiixFolder As String * 11 = "\InterFace\"
 
Public Declare Function SetWindowRgn Lib "user32" ( _
                ByVal hWnd As Long, _
                    ByVal hRgn As Long, _
                        ByVal bRedraw As Boolean) As Long
                        
                 
Public Declare Function DeleteObject Lib "gdi32" ( _
                ByVal hObject As Long) As Long
                
                
Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
                    ByVal hDC As Long) As Long
 
Private Declare Function SelectObject Lib "gdi32" ( _
                    ByVal hDC As Long, _
                        ByVal hgdiObj As Long) As Long
 
 
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" ( _
                    ByVal hdiObj As Long, _
                        ByVal cbBuffer As Long, _
                            lpvObject As Any) As Long
 
Private Declare Function CreateRectRgn Lib "gdi32" ( _
                    ByVal nLeftRect As Long, _
                        ByVal nTopRect As Long, _
                            ByVal nRightRect As Long, _
                                ByVal nBottomRect As Long) As Long
 
 
Private Declare Function CombineRgn Lib "gdi32" ( _
                    ByVal hRgnDest As Long, _
                        ByVal hRgnSrc1 As Long, _
                            ByVal hRgnSrc2 As Long, _
                                ByVal fnCombineMode As Long) As Long
 
 
Private Declare Function DeleteDC Lib "gdi32" ( _
                    ByVal hDC As Long) As Long
 
Private Declare Function GetPixel Lib "gdi32" ( _
                    ByVal hDC As Long, _
                        ByVal nXPos As Long, _
                            ByVal nYPos As Long) As Long
 
 
Private Type typPicStructure
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
 
Private Const RGN_OR As Long = 4
 
Public Function fInitFormShape( _
                    frm As Form, _
                        stPictureName As String, _
                            TransparentColor As Long, _
                                Optional FolderPath As String, _
                                    Optional IndexCollection As Boolean) As Boolean
                            
'// dimension variables
Dim f As Form
Dim objBitmap As StdPicture
Dim hRgn As Long
 
 
'// in the event of an error process to our
'// predefined error handler
On Error GoTo Err_finitformshape
 
    '// set the new picture to scan
    Set objBitmap = fLoadShapedPicture(frm, stPictureName)
    
    '// first check if the image is found to avoid
    '// any errors down the line, if the image to be used
    '// is not a valid one then exit the function
    If objBitmap Is Nothing Then Exit Function
    
    '// create object instance
    '// of the form to be shaped
    Set f = frm
        
    '// reference the created instance
    With f
                
        '// function to create shaped region region
        '// and return the handle to the new shaped region
        '// which resides in the system's memory buffer
        hRgn = fCreateShapedRegion(objBitmap, TransparentColor)
    
        '// set the new shaped region of our form
        SetWindowRgn .hWnd, hRgn, True
        
        fInitFormShape = True
        
    End With
        
 
Exit_finitformshape:
    '// clean up
    Set f = Nothing
    Set objBitmap = Nothing
 
    '// delete region from memory
    DeleteObject hRgn
    
    Exit Function
 
Err_finitformshape:
    '// notify user of error
    MsgBox Err.NUMBER & " : " & Err.Description, vbOKOnly, "Microsoft Access Error"
    '// resume to exit the funtion
    Resume Exit_finitformshape
    
End Function
 
 
Private Function fFileExists(stFileName) As Boolean
 
'// dimension variable(s)
Dim objFSO As Object
    
    '// create FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    '// return True if file is found
    '// return False if not
    fFileExists = objFSO.FileExists(stFileName)
            
    '// clean up
    Set objFSO = Nothing
    
End Function
 
Private Function fLoadShapedPicture(frm As Form, PictureName As String) As StdPicture
 
'// dimension varible(s)
Dim stBitmapPath  As String
Dim iWidth As Integer
Dim iHeight As Integer
 
    '// assign picture name & path
    stBitmapPath = CurrentProject.Path & conGraphiixFolder & PictureName
    
    '// check for file
    If fFileExists(stBitmapPath) Then
    
        '// reference the background image control
        With frm.Controls("imgFormBG")
        
            '// load the picture to the form's
            '// background image control
            .Picture = stBitmapPath
            
            '// move image control to align to form
            '// if you ommit this you will some parts of
            '// image display the transparent color
            .top = 10
            .Left = 10
            
            '// get image dimensions
            iWidth = .ImageWidth
            iHeight = .ImageHeight
            
            '// rezise the form to match picture
            .Parent.InsideWidth = iWidth
            .Parent.InsideHeight = iHeight + 10
            
            '// resize image control to match image
            .Width = iWidth
            .Height = iHeight
            
        End With
        
        '// load and return the picture data
        Set fLoadShapedPicture = LoadPicture(stBitmapPath)
        
    Else
    
        '// notify user image was not found
        MsgBox "The background image for this form was not found.", vbOKOnly + vbInformation
    
    End If
 
End Function
 
Private Property Get fCreateShapedRegion( _
                        BitmapPicture As StdPicture, _
                            TransColor As Long) As Long
 
'// dimension variable(s)
Dim hRgn As Long
Dim tmpRgn As Long
Dim lngRow As Integer
Dim lngCol As Integer
Dim lngPosition As Integer
Dim hDC As Long
Dim pic As typPicStructure
Dim lngTransColor As Long
 
    '// assign transparent color
    lngTransColor = TransColor
 
    '// create a new memory DC(Device Context),
    '// where we will scan the picture
    hDC = CreateCompatibleDC(0)
    
    '// if the DC exist process procedure
    If hDC Then
    
        '// let the new DC select the Picture
        SelectObject hDC, BitmapPicture
        
        '// get the picture dimensions
        GetObject BitmapPicture, Len(pic), pic
        
        '// create a new empty rectangular region using the
        hRgn = CreateRectRgn(0, 0, pic.bmWidth, pic.bmHeight)
        
        '// scan the picture pixel by pixel from top to bottom
        For lngRow = 0 To pic.bmHeight
            
            '// scan the picture pixel by pixel from left to right
            For lngCol = 0 To pic.bmWidth
 
                '// scan and skip non-transparent pixels
                While lngCol <= pic.bmWidth And GetPixel(hDC, lngCol, lngRow) <> lngTransColor
                    
                    '// add 1 to the variable lngCol
                    '// and we move to the next pixel
                    lngCol = lngCol + 1
                
                Wend
                
                '// remember the position of the first transparent pixel
                lngPosition = lngCol
                
                '// scan a line for transparent pixels
                While lngCol <= pic.bmWidth And GetPixel(hDC, lngCol, lngRow) = lngTransColor
                    
                    '// add 1 to the variable lngCol
                    '// and move to the next pixel
                    lngCol = lngCol + 1
                
                Wend
                
                If lngPosition < lngCol Then
                
                    '// create a new temporary transparent region and return it's handle
                    tmpRgn = CreateRectRgn(lngPosition, lngRow, lngCol, lngRow + 1)
                    
                    '// combine the two regions
                    CombineRgn hRgn, hRgn, tmpRgn, RGN_OR
                    
                    '// release memory, delete temporary region
                    DeleteObject tmpRgn
                    
                End If
                
            Next lngCol
        Next lngRow
        
        '// return the handle to the new shaped region
        fCreateShapedRegion = hRgn
        
        '// release memory by deleting the hDc
        DeleteObject SelectObject(hDC, BitmapPicture)
        
    End If
    
    '// clean up, release memory by deleting the created DC
    DeleteDC hDC
    
End Property

Open in new window

0
Comment
Question by:weedavie
  • 2
4 Comments
 
LVL 65

Expert Comment

by:rockiroads
ID: 24373872
Im wondering whether you have hit the problem identified here
http://stackoverflow.com/questions/144774/why-does-getwindowrgn-fail-on-vista

0
 
LVL 38

Accepted Solution

by:
puppydogbuddy earned 500 total points
ID: 24374067
Does the code intract with the ms graphics filters? If so, then they are not installed when you only install Access, and may not be installed.


Take your Office CD and do a custom install;
- expand Office Shared Features
- expand converters and filters, install them.
0
 
LVL 1

Author Comment

by:weedavie
ID: 24430951
Apologies for not replying sooner, I haven't had an opportunity to test your suggestions.
I'll give it a go this afternoon / tomorrow.

Many thanks.

David
0
 
LVL 1

Author Closing Comment

by:weedavie
ID: 31580916
Many thanks, sorry for the late reply
0

Featured Post

The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article is a continuation or rather an extension from Cascading Combos (http://www.experts-exchange.com/A_5949.html) and builds on examples developed in detail there. It should be understandable alone, but I recommend reading the previous artic…
As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question