Has anyone gotten the VBA code to work that Ken Getz published online in his article “Screen Resolution, Resolved!” It is supposed to solve the problem of transferring a database to computers with different resolution settings, but I can’t get it to work. Would anyone be willing to take a look at what I have done and tell me where I am going wrong. I am working in Access 2000. This is my first project in Access.
Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Resolution Solution
- Thread starter 1deadman
- Start date
There are lots of people that would probably be willing. Post the error and the chunk of code that is causing the error and we can probably help... Terry
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
- Thread starter
- #3
The instructions say to create a class with the following code:
Option Explicit
' FormResize Class module
' Change this constant to True if you want to
' see error messages.
#Const DEBUGGING = False
' ==================================
' Windows API declarations.
' ==================================
Private Declare Function GetDesktopWindow _
Lib "user32" () As Long
Private Declare Function GetDeviceCaps _
Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC _
Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC _
Lib "user32" _
(ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Const HORZRES = 8 ' Horizontal width in pixels
Private Const VERTRES = 10 ' Vertical width in pixels
Private Const LOGPIXELSX = 88 ' Logical pixels/inch in X
Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y
Private Const TWIPSPERINCH = 1440
Private Const TWIPSPERPOINT = 20
Private Type POINTAPI
x As Long
y As Long
End Type
Private mptScreen As POINTAPI
Private mptScreenInPoints As POINTAPI
Public Sub RescaleForm( _
YourForm As Object, _
OriginalX As Long, _
OriginalY As Long, _
Optional CenterForm As Boolean = True)
' Called from the Initialize event of forms.
' Attempts to scale the form appropriately
' for the given screen size, as compared
' to the size screen on which it was designed.
Dim decScale As Variant
On Error GoTo HandleErrors
decScale = GetScreenScale(OriginalX, OriginalY)
' If you don't want forms to expand (they were created on a
' lower-resolution device than the current device), but only
' shrink (they were created on a higher-resolution device
' than the current device), then use the next line instead
' of the current If...Then line.
'If (decScale < 1) Then
If (decScale <> 1) Then
' Set Width, Height, and Zoom properties.
YourForm.Width = YourForm.Width * decScale
YourForm.Height = YourForm.Height * decScale
YourForm.Zoom = decScale * 100
' If you don't want to center the
' form (if you're about to move it
' somewhere else, for example) you
' can skip this code by setting the
' CenterForm parameter to be False.
If CenterForm Then
YourForm.Move _
(mptScreenInPoints.x - YourForm.Width) / 2, _
(mptScreenInPoints.y - YourForm.Height) / 2
End If
End If
ExitHere:
Exit Sub
HandleErrors:
Select Case Err.Number
Case Else
Call HandleError("FormResize.RescaleForm", _
Err.Number, Err.Description)
End Select
Resume ExitHere
End Sub
Private Function GetScreenScale( _
OriginalX As Long, OriginalY As Long) As Variant
Dim decFactorX As Variant
Dim decFactorY As Variant
On Error GoTo HandleErrors
' Fill in the mptScreen info.
Call GetScreenInfo
' Get the ratio of the current screen
' size to the design-time screen size.
decFactorX = CDec(mptScreen.x / OriginalX)
decFactorY = CDec(mptScreen.y / OriginalY)
' You only get one scaling factor on these
' forms. You could use the Max, or the
' average, or the min. I went with the
' Max value of the two.
GetScreenScale = Max(decFactorX, decFactorY)
ExitHere:
Exit Function
HandleErrors:
Select Case Err.Number
Case Else
Call HandleError("FormResize.GetScreenScale", _
Err.Number, Err.Description)
Resume ExitHere
End Select
End Function
Private Sub GetScreenInfo()
' This procedure fills in the module variables:
' mptScreen, mptScreenInPoints
On Error GoTo HandleErrors
Dim ptCurrentDPI As POINTAPI
Dim ptTwipsPerPixel As POINTAPI
Dim lngDC As Long
Dim hWnd As Long
On Error GoTo HandleErrors
hWnd = GetDesktopWindow()
lngDC = GetDC(hWnd)
' If the call to GetDC didn't fail (and it had
' better not, or things are really busted),
' then get the info.
If lngDC <> 0 Then
' How many pixels per logical inch?
With ptCurrentDPI
.x = GetDeviceCaps(lngDC, LOGPIXELSX)
.y = GetDeviceCaps(lngDC, LOGPIXELSY)
End With
' How many twips per pixel?
With ptTwipsPerPixel
.x = TWIPSPERINCH / ptCurrentDPI.x
.y = TWIPSPERINCH / ptCurrentDPI.y
End With
' What's the current screen resolution?
With mptScreen
.x = GetDeviceCaps(lngDC, HORZRES)
.y = GetDeviceCaps(lngDC, VERTRES)
End With
' What's the screen resolution in points? (For
' use when centering the form.)
With mptScreenInPoints
.x = mptScreen.x * ptTwipsPerPixel.x / TWIPSPERPOINT
.y = mptScreen.y * ptTwipsPerPixel.y / TWIPSPERPOINT
End With
' Release the information context.
Call ReleaseDC(hWnd, lngDC)
End If
ExitHere:
Exit Sub
HandleErrors:
Select Case Err.Number
Case Else
Call HandleError("FormResize.GetScreenInfo", _
Err.Number, Err.Description)
End Select
Resume ExitHere
End Sub
Private Function Max( _
varValue1 As Variant, varValue2 As Variant) As Variant
If varValue1 > varValue2 Then
Max = varValue1
Else
Max = varValue2
End If
End Function
Private Sub HandleError(strName As String, _
lngNumber As Long, strDescription As String)
#If DEBUGGING Then
MsgBox "Error: " & strDescription & _
" (" & lngNumber & "
", vbExclamation, strName
' Trigger a breakpoint. Remove this
' if you don't want a breakpoint here.
Debug.Assert False
#End If
End Sub
Then you are suppose to BEGIN QUOTE--Call the class' RescaleForm method from your form's Initialize event. The RescaleForm method takes four parameters:
· YourForm: A reference to your form. You cannot use the generic UserForm type here (which means you can't pass the built-in Me keyword); you must use the specific type for your form. This is unfortunate, but it's the way VBA forms work. You'll find a discussion of why you must pass the exact form reference later in this article.
· OriginalX: A long integer containing the original width of your screen when you designed the form. Generally, 640, 800, 1024, or 1280.
· OriginalY: A long integer containing the original height of your screen when you designed the form. Generally, 480, 600, 768, or 1024.
· CenterForm (optional, default True): A Boolean value indicating whether you want to have the code center the form for you. Normally, VBA forms open centered, and once you modify the size, the code must center the form manually. If you're going to position the form to some specific location, in the form's Activate event, you might set this to False to save a little time. No point centering the form and then moving it somewhere else.
For example, if you have a form named UserForm1 that you designed on a 1024x768 screen, add code like this to the form's Initialize event procedure:
With New FormResize
.RescaleForm UserForm1, 1024, 768
End With
END OF QUOTE
The following is from one of my forms:
Option Explicit
Dim frmCoupons As Form_frmCoupons
Private Sub Form_Initialize()
With New FormResize
.RescaleForm frmCoupons, 1024, 768
End With
End Sub
I'm not getting any errors, it just does not do what it is supposed to do which is change the size of the forms in relation to a change in resolution.
Sorry for the long post, but you asked for it.
Option Explicit
' FormResize Class module
' Change this constant to True if you want to
' see error messages.
#Const DEBUGGING = False
' ==================================
' Windows API declarations.
' ==================================
Private Declare Function GetDesktopWindow _
Lib "user32" () As Long
Private Declare Function GetDeviceCaps _
Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC _
Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC _
Lib "user32" _
(ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Const HORZRES = 8 ' Horizontal width in pixels
Private Const VERTRES = 10 ' Vertical width in pixels
Private Const LOGPIXELSX = 88 ' Logical pixels/inch in X
Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y
Private Const TWIPSPERINCH = 1440
Private Const TWIPSPERPOINT = 20
Private Type POINTAPI
x As Long
y As Long
End Type
Private mptScreen As POINTAPI
Private mptScreenInPoints As POINTAPI
Public Sub RescaleForm( _
YourForm As Object, _
OriginalX As Long, _
OriginalY As Long, _
Optional CenterForm As Boolean = True)
' Called from the Initialize event of forms.
' Attempts to scale the form appropriately
' for the given screen size, as compared
' to the size screen on which it was designed.
Dim decScale As Variant
On Error GoTo HandleErrors
decScale = GetScreenScale(OriginalX, OriginalY)
' If you don't want forms to expand (they were created on a
' lower-resolution device than the current device), but only
' shrink (they were created on a higher-resolution device
' than the current device), then use the next line instead
' of the current If...Then line.
'If (decScale < 1) Then
If (decScale <> 1) Then
' Set Width, Height, and Zoom properties.
YourForm.Width = YourForm.Width * decScale
YourForm.Height = YourForm.Height * decScale
YourForm.Zoom = decScale * 100
' If you don't want to center the
' form (if you're about to move it
' somewhere else, for example) you
' can skip this code by setting the
' CenterForm parameter to be False.
If CenterForm Then
YourForm.Move _
(mptScreenInPoints.x - YourForm.Width) / 2, _
(mptScreenInPoints.y - YourForm.Height) / 2
End If
End If
ExitHere:
Exit Sub
HandleErrors:
Select Case Err.Number
Case Else
Call HandleError("FormResize.RescaleForm", _
Err.Number, Err.Description)
End Select
Resume ExitHere
End Sub
Private Function GetScreenScale( _
OriginalX As Long, OriginalY As Long) As Variant
Dim decFactorX As Variant
Dim decFactorY As Variant
On Error GoTo HandleErrors
' Fill in the mptScreen info.
Call GetScreenInfo
' Get the ratio of the current screen
' size to the design-time screen size.
decFactorX = CDec(mptScreen.x / OriginalX)
decFactorY = CDec(mptScreen.y / OriginalY)
' You only get one scaling factor on these
' forms. You could use the Max, or the
' average, or the min. I went with the
' Max value of the two.
GetScreenScale = Max(decFactorX, decFactorY)
ExitHere:
Exit Function
HandleErrors:
Select Case Err.Number
Case Else
Call HandleError("FormResize.GetScreenScale", _
Err.Number, Err.Description)
Resume ExitHere
End Select
End Function
Private Sub GetScreenInfo()
' This procedure fills in the module variables:
' mptScreen, mptScreenInPoints
On Error GoTo HandleErrors
Dim ptCurrentDPI As POINTAPI
Dim ptTwipsPerPixel As POINTAPI
Dim lngDC As Long
Dim hWnd As Long
On Error GoTo HandleErrors
hWnd = GetDesktopWindow()
lngDC = GetDC(hWnd)
' If the call to GetDC didn't fail (and it had
' better not, or things are really busted),
' then get the info.
If lngDC <> 0 Then
' How many pixels per logical inch?
With ptCurrentDPI
.x = GetDeviceCaps(lngDC, LOGPIXELSX)
.y = GetDeviceCaps(lngDC, LOGPIXELSY)
End With
' How many twips per pixel?
With ptTwipsPerPixel
.x = TWIPSPERINCH / ptCurrentDPI.x
.y = TWIPSPERINCH / ptCurrentDPI.y
End With
' What's the current screen resolution?
With mptScreen
.x = GetDeviceCaps(lngDC, HORZRES)
.y = GetDeviceCaps(lngDC, VERTRES)
End With
' What's the screen resolution in points? (For
' use when centering the form.)
With mptScreenInPoints
.x = mptScreen.x * ptTwipsPerPixel.x / TWIPSPERPOINT
.y = mptScreen.y * ptTwipsPerPixel.y / TWIPSPERPOINT
End With
' Release the information context.
Call ReleaseDC(hWnd, lngDC)
End If
ExitHere:
Exit Sub
HandleErrors:
Select Case Err.Number
Case Else
Call HandleError("FormResize.GetScreenInfo", _
Err.Number, Err.Description)
End Select
Resume ExitHere
End Sub
Private Function Max( _
varValue1 As Variant, varValue2 As Variant) As Variant
If varValue1 > varValue2 Then
Max = varValue1
Else
Max = varValue2
End If
End Function
Private Sub HandleError(strName As String, _
lngNumber As Long, strDescription As String)
#If DEBUGGING Then
MsgBox "Error: " & strDescription & _
" (" & lngNumber & "
", vbExclamation, strName' Trigger a breakpoint. Remove this
' if you don't want a breakpoint here.
Debug.Assert False
#End If
End Sub
Then you are suppose to BEGIN QUOTE--Call the class' RescaleForm method from your form's Initialize event. The RescaleForm method takes four parameters:
· YourForm: A reference to your form. You cannot use the generic UserForm type here (which means you can't pass the built-in Me keyword); you must use the specific type for your form. This is unfortunate, but it's the way VBA forms work. You'll find a discussion of why you must pass the exact form reference later in this article.
· OriginalX: A long integer containing the original width of your screen when you designed the form. Generally, 640, 800, 1024, or 1280.
· OriginalY: A long integer containing the original height of your screen when you designed the form. Generally, 480, 600, 768, or 1024.
· CenterForm (optional, default True): A Boolean value indicating whether you want to have the code center the form for you. Normally, VBA forms open centered, and once you modify the size, the code must center the form manually. If you're going to position the form to some specific location, in the form's Activate event, you might set this to False to save a little time. No point centering the form and then moving it somewhere else.
For example, if you have a form named UserForm1 that you designed on a 1024x768 screen, add code like this to the form's Initialize event procedure:
With New FormResize
.RescaleForm UserForm1, 1024, 768
End With
END OF QUOTE
The following is from one of my forms:
Option Explicit
Dim frmCoupons As Form_frmCoupons
Private Sub Form_Initialize()
With New FormResize
.RescaleForm frmCoupons, 1024, 768
End With
End Sub
I'm not getting any errors, it just does not do what it is supposed to do which is change the size of the forms in relation to a change in resolution.
Sorry for the long post, but you asked for it.
When you created this form, did you create it on a system at 1024 X 768? If so, do you really expect it to resize? Terry
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
- Thread starter
- #5
That's the plan. The form was created at 1024 x 768. Supposably, it doesn't matter what size resolution you create in, this will resize the form to the current users resolution and screen size. I'm not a big code writer (actualy, I'm not a code writer at all) and the code that I have offered is straight from the author mentioned above. The only thing that I know of that I did different was the line:
Dim frmCoupons As Form_frmCoupons
which I put in because VB was highlighting frmCoupons in the WITH statement and telling me that the variable wasn't defined. Any Clues???
Dim frmCoupons As Form_frmCoupons
which I put in because VB was highlighting frmCoupons in the WITH statement and telling me that the variable wasn't defined. Any Clues???
Okay, I guess I wasn't very clear. When you created this form, you did it on a machine that the resolution was set to 1024 X 768. Now you added the resize code and are testing it out. Is your current resolution 1024 X 768 or did you resize it to something (800 X 600)? If you didn't change the PC's resolution, the form is going to look the same... Terry
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
- Thread starter
- #7
I changed the res to 640x480 and another, I think 800x600 and the forms didn't change to fit in the screen. I also dumped to my laptop with out them resizing to fit as well. In the authors code, he uses "YourForm". Do you think that I should have to put in my form name or does creating the class take care of that. I don't know what creating a class did for me. As I said before, i'm pretty ignorant at this.
- Thread starter
- #8
If you reply quickly (before I leave), I can email a zip file from the book... Terry
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
Sorry, I know I didn't give you much time, but I am out of here for the weekend. I have an email created to send to you, but I won't be able to send it until Monday. Until then, if you can get a hold of the Access 97 (or 2000) Developer's Handbook by Litwin, Getz and Gilbert (SYBEX) the code is there in chapter 8. Otherwise, post your address on Monday morning and I will send it then.
NOTE: You may not want to post it before then, sometimes you will get email from others. Once I send to you, I'll have the site admins remove your address from the post. Terry
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
NOTE: You may not want to post it before then, sometimes you will get email from others. Once I send to you, I'll have the site admins remove your address from the post. Terry
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
- Thread starter
- #11
Well, it's now Monday (in Texas too...). Nah, took a couple of days off. Let me know when I can send this zip file to you...
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
**************************
* General Disclaimor - Please read *
**************************
Please make sure your post is in the CORRECT forum, has a descriptive title, gives as much detail to the problem as possible, and has examples of expected results. This will enable me and others to help you faster...
- Status
Similar threads
- Locked
- Question
- Locked
- Question