Give the Access Windows a defined size
I have a small form that I want to be displayed. If I start the application, the access window should be of a defined size so it doesn't need the full screen for that tiny form. The clue is, that I want to know, if it is possible not to first launch the application maximized to resize it by code. That would have an ugly effect. Maybe a small exe-File that launches Access with special parameters and forces access to open in a specified size could do this job.
If it's not possible I need the code for doing this after the program is running.
Thanx in advance
If it's not possible I need the code for doing this after the program is running.
Thanx in advance
ASKER
Adjusted points to 99
ASKER
Adjusted points to 200
I don't know of anyway to change the size before it starts, but I can show you how to resize the window.
Below are the declarations required and the functions (think I got them all, if not yell). These are back from Access 1.1 days, but I have converted them to 32 bit calls and they work fine under 95/98.
To resize the window after Access starts, call wu_SetAccessSize from your autoexec macro. The first two arguments are for the cord of the top left of the window. The next two are for the size that you want.
JimD.
Declare Function wu_GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Integer
Declare Function wu_GetParent Lib "user32" Alias "GetParent" (ByVal hwin%) As Integer
Declare Function wu_IsZoomed Lib "user32" Alias "IsZoomed" (ByVal hwnd&) As Integer
Declare Function wu_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd&, ByVal i%) As Integer
Declare Function wu_MoveWindow Lib "user32" Alias "MoveWindow" (ByVal hwin%, ByVal X%, ByVal y%, ByVal dx%, ByVal dy%, ByVal fRepaint%) As Integer
'-------------------------
' FUNCTION : wu_SetAccessSize
'
' PURPOSE : Sizes the Access window to the specified coordinates.
' Coordinates should be given in pixels.
'-------------------------
Function wu_SetAccessSize(X%, y%, dx%, dy%) As Integer
Dim hwnd As Long, f As Integer
hwnd& = wu_GetAccessHwnd()
If (wu_IsZoomed(hwnd&)) Then
f% = wu_ShowWindow(hwnd&, WU_SW_RESTORE)
End If
f% = wu_MoveWindow(hwnd&, X%, y%, dx%, dy%, True)
wu_SetAccessSize = f%
End Function
'-------------------------
' FUNCTION : wu_GetAccessHwnd()
'
' PURPOSE : Returns the handle of the Access window.
'-------------------------
Function wu_GetAccessHwnd() As Integer
Dim hwnd As Long
hwnd& = wu_GetActiveWindow()
While ((wu_StWindowClass(hwnd&) <> WU_WC_ACCESS) And (hwnd& <> 0))
hwnd& = wu_GetParent(hwnd&)
Wend
wu_GetAccessHwnd = hwnd&
End Function
'-------------------------
' FUNCTION : wu_StWindowClass
'
' PURPOSE : A simple cover function to the Windows API call.
'-------------------------
Function wu_StWindowClass(hwnd As Long) As String
Const cchMax = 255
Dim stBuff As String * cchMax, cch As Integer
cch% = wu_GetClassName(hwnd, stBuff, cchMax)
If (hwnd& = 0) Then
wu_StWindowClass = ""
Else
wu_StWindowClass = (Left$(stBuff, cch%))
End If
End Function
Below are the declarations required and the functions (think I got them all, if not yell). These are back from Access 1.1 days, but I have converted them to 32 bit calls and they work fine under 95/98.
To resize the window after Access starts, call wu_SetAccessSize from your autoexec macro. The first two arguments are for the cord of the top left of the window. The next two are for the size that you want.
JimD.
Declare Function wu_GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Integer
Declare Function wu_GetParent Lib "user32" Alias "GetParent" (ByVal hwin%) As Integer
Declare Function wu_IsZoomed Lib "user32" Alias "IsZoomed" (ByVal hwnd&) As Integer
Declare Function wu_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd&, ByVal i%) As Integer
Declare Function wu_MoveWindow Lib "user32" Alias "MoveWindow" (ByVal hwin%, ByVal X%, ByVal y%, ByVal dx%, ByVal dy%, ByVal fRepaint%) As Integer
'-------------------------
' FUNCTION : wu_SetAccessSize
'
' PURPOSE : Sizes the Access window to the specified coordinates.
' Coordinates should be given in pixels.
'-------------------------
Function wu_SetAccessSize(X%, y%, dx%, dy%) As Integer
Dim hwnd As Long, f As Integer
hwnd& = wu_GetAccessHwnd()
If (wu_IsZoomed(hwnd&)) Then
f% = wu_ShowWindow(hwnd&, WU_SW_RESTORE)
End If
f% = wu_MoveWindow(hwnd&, X%, y%, dx%, dy%, True)
wu_SetAccessSize = f%
End Function
'-------------------------
' FUNCTION : wu_GetAccessHwnd()
'
' PURPOSE : Returns the handle of the Access window.
'-------------------------
Function wu_GetAccessHwnd() As Integer
Dim hwnd As Long
hwnd& = wu_GetActiveWindow()
While ((wu_StWindowClass(hwnd&) <> WU_WC_ACCESS) And (hwnd& <> 0))
hwnd& = wu_GetParent(hwnd&)
Wend
wu_GetAccessHwnd = hwnd&
End Function
'-------------------------
' FUNCTION : wu_StWindowClass
'
' PURPOSE : A simple cover function to the Windows API call.
'-------------------------
Function wu_StWindowClass(hwnd As Long) As String
Const cchMax = 255
Dim stBuff As String * cchMax, cch As Integer
cch% = wu_GetClassName(hwnd, stBuff, cchMax)
If (hwnd& = 0) Then
wu_StWindowClass = ""
Else
wu_StWindowClass = (Left$(stBuff, cch%))
End If
End Function
Doesn't 32-bit windows support specifying whether the window is to be opened maximized, restored, or minimized, (for instance, as an option in the shortcut that is used to open it?
ASKER
Sorry, JDettman, but your code doesn't work. Seems as if the function wu_GetClassName is not defined.
ASKER
Hello, BrianWren.
You got it!
Thats the way it must work. Do you have any ideas about the code?
You got it!
Thats the way it must work. Do you have any ideas about the code?
Here's the declare for it. Sorry I missed it. Probably would have been better if I EMailed the whole module to you.
Declare Function wu_GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
JimD.
Declare Function wu_GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
JimD.
How are you opening this DB? A click in the Windows menu system? Code from another app? What action is it that runs the db?
Brian
Brian
Have code that saves the cooridinates of the form on close, and in the on open event, it retreives those values. I write the values to the system registry, but you could also save them to a table if you wanted. It not only will save the size of the form, but the location of the form.
Once you have the module that saves the coords and gets the coords, it is 1 oline of code in the on open, and one line of code in the on close.
This is the code from my code module
Option Compare Database 'Use database order for string comparisons
Option Explicit
' Under the Win95 shell (either Win95 or WinNT)
' there's a 2 pixel border. If you need to run on
' the WinNT 3.51 shell, you'll need to find the
' version number, and adjust these values accordingly.
' Store rectangle coordinates.
Type adhTypeRect
X1 As Long
Y1 As Long
X2 As Long
Y2 As Long
End Type
Declare Function adh_apiGetParent Lib "user32" _
Alias "GetParent" (ByVal hwnd As Long) As Long
Declare Function adh_apiGetWindowRect Lib "user32" _
Alias "GetWindowRect" (ByVal hwnd As Long, _
lpRect As adhTypeRect) As Long
Declare Function adh_apiMoveWindow Lib "user32" _
Alias "MoveWindow" (ByVal hwnd As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Const adhcBorderWidthX = 2
Const adhcBorderWidthY = 2
Const str_REG_NAME_KEY_m As String = "SOFTWARE\ResearcherTool\F
Const adhcTop = "Top"
Const adhcLeft = "Left"
Const adhcRight = "Right"
Const adhcBottom = "Bottom"
Private Sub GetFormSize(frm As Form, rct As adhTypeRect)
' Fill in rct with the coordinates of the window.
Dim hWndParent As Long
Dim rctParent As adhTypeRect
' Find the position of the window in question, in
' relation to its parent window (the Access desktop,
' the MDIClient window).
hWndParent = adh_apiGetParent(frm.hwnd)
' Get the coordinates of the current window and its parent.
adh_apiGetWindowRect frm.hwnd, rct
' Catch the case where the form is Popup (that is,
' its parent is NOT the Access main window.) In that
' case, don't subtract off the coordinates of the
' Access MDIClient window.
If hWndParent <> Application.hWndAccessApp Then
adh_apiGetWindowRect hWndParent, rctParent
' Subtract off the left and top parent coordinates, since you
' need coordinates relative to the parent for the adh_apiMoveWindow()
' function call.
With rct
.X1 = .X1 - rctParent.X1
.Y1 = .Y1 - rctParent.Y1
.X2 = .X2 - rctParent.X1
.Y2 = .Y2 - rctParent.Y1
End With
End If
End Sub
Function GetCoords(frm As Form)
' This is the entry point for retrieving form info.
' Call this from the form's Open event.
Dim rct As adhTypeRect
Dim strName As String
Dim var As Variant
On Error GoTo GetCoordsErr
' Use the name of the application as the highest
' level, and the form's name as the next level.
' This way, you could have multiple forms in the same
' app use this code.
strName = frm.Name
With rct
var = RegGetKeyValue_var(regHKey
If var <> Empty Then
.Y1 = var
End If
var = RegGetKeyValue_var(regHKey
If var <> Empty Then
.X1 = var
End If
var = RegGetKeyValue_var(regHKey
If var <> Empty Then
.Y2 = var
End If
var = RegGetKeyValue_var(regHKey
If var <> Empty Then
.X2 = var
End If
' Only muck with the form's size if
' you get values for bottom and right
' that make sense.
If .X2 > 0 And .Y2 > 0 Then
Call SetFormSize(frm, rct)
End If
End With
GetCoordsExit:
Exit Function
GetCoordsErr:
msgbox "Unable to retrieve all coordinates.", _
vbInformation, "Get Coords"
Resume GetCoordsExit
End Function
Function SaveCoords(frm As Form)
' This is the entry point for saving form info.
' Call this from the form's Close event.
Dim rct As adhTypeRect
Dim strName As String
On Error GoTo SaveCoordsErr
' Get the form's current size and position.
GetFormSize frm, rct
strName = frm.Name
' Use the name of the application as the highest
' level, and the form's name as the next level.
' This way, you could have multiple forms in the same
' app use this code.
With rct
If RegCreateNewKey_f(regHKeyL
RegSetKeyValue_f regHKeyLocalMachine, str_REG_NAME_KEY_m & strName, adhcTop, .Y1, regSZ
RegSetKeyValue_f regHKeyLocalMachine, str_REG_NAME_KEY_m & strName, adhcLeft, .X1, regSZ
RegSetKeyValue_f regHKeyLocalMachine, str_REG_NAME_KEY_m & strName, adhcBottom, .Y2, regSZ
RegSetKeyValue_f regHKeyLocalMachine, str_REG_NAME_KEY_m & strName, adhcRight, .X2, regSZ
End If
End With
SaveCoordsExit:
Exit Function
SaveCoordsErr:
msgbox "Unable to save all coordinates.", _
vbInformation, "Save Coords"
Resume SaveCoordsExit
End Function
Private Sub SetFormSize(frm As Form, rct As adhTypeRect)
Dim intWidth As Integer
Dim intHeight As Integer
Dim intSuccess As Integer
With rct
intWidth = (.X2 - .X1)
intHeight = (.Y2 - .Y1)
' No sense even trying if either is less than 0.
If (intWidth > 0) And (intHeight > 0) Then
' You would think the MoveSize action
' would work here, but that requires actually
' SELECTING the window first. That seemed like
' too much work, when this procedure will
' move/size ANY window.
intSuccess = adh_apiMoveWindow(frm.hwnd
.X1 - adhcBorderWidthX, .Y1 - adhcBorderWidthY, _
intWidth, intHeight, True)
End If
End With
End Sub
Once you have the module that saves the coords and gets the coords, it is 1 oline of code in the on open, and one line of code in the on close.
This is the code from my code module
Option Compare Database 'Use database order for string comparisons
Option Explicit
' Under the Win95 shell (either Win95 or WinNT)
' there's a 2 pixel border. If you need to run on
' the WinNT 3.51 shell, you'll need to find the
' version number, and adjust these values accordingly.
' Store rectangle coordinates.
Type adhTypeRect
X1 As Long
Y1 As Long
X2 As Long
Y2 As Long
End Type
Declare Function adh_apiGetParent Lib "user32" _
Alias "GetParent" (ByVal hwnd As Long) As Long
Declare Function adh_apiGetWindowRect Lib "user32" _
Alias "GetWindowRect" (ByVal hwnd As Long, _
lpRect As adhTypeRect) As Long
Declare Function adh_apiMoveWindow Lib "user32" _
Alias "MoveWindow" (ByVal hwnd As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Const adhcBorderWidthX = 2
Const adhcBorderWidthY = 2
Const str_REG_NAME_KEY_m As String = "SOFTWARE\ResearcherTool\F
Const adhcTop = "Top"
Const adhcLeft = "Left"
Const adhcRight = "Right"
Const adhcBottom = "Bottom"
Private Sub GetFormSize(frm As Form, rct As adhTypeRect)
' Fill in rct with the coordinates of the window.
Dim hWndParent As Long
Dim rctParent As adhTypeRect
' Find the position of the window in question, in
' relation to its parent window (the Access desktop,
' the MDIClient window).
hWndParent = adh_apiGetParent(frm.hwnd)
' Get the coordinates of the current window and its parent.
adh_apiGetWindowRect frm.hwnd, rct
' Catch the case where the form is Popup (that is,
' its parent is NOT the Access main window.) In that
' case, don't subtract off the coordinates of the
' Access MDIClient window.
If hWndParent <> Application.hWndAccessApp Then
adh_apiGetWindowRect hWndParent, rctParent
' Subtract off the left and top parent coordinates, since you
' need coordinates relative to the parent for the adh_apiMoveWindow()
' function call.
With rct
.X1 = .X1 - rctParent.X1
.Y1 = .Y1 - rctParent.Y1
.X2 = .X2 - rctParent.X1
.Y2 = .Y2 - rctParent.Y1
End With
End If
End Sub
Function GetCoords(frm As Form)
' This is the entry point for retrieving form info.
' Call this from the form's Open event.
Dim rct As adhTypeRect
Dim strName As String
Dim var As Variant
On Error GoTo GetCoordsErr
' Use the name of the application as the highest
' level, and the form's name as the next level.
' This way, you could have multiple forms in the same
' app use this code.
strName = frm.Name
With rct
var = RegGetKeyValue_var(regHKey
If var <> Empty Then
.Y1 = var
End If
var = RegGetKeyValue_var(regHKey
If var <> Empty Then
.X1 = var
End If
var = RegGetKeyValue_var(regHKey
If var <> Empty Then
.Y2 = var
End If
var = RegGetKeyValue_var(regHKey
If var <> Empty Then
.X2 = var
End If
' Only muck with the form's size if
' you get values for bottom and right
' that make sense.
If .X2 > 0 And .Y2 > 0 Then
Call SetFormSize(frm, rct)
End If
End With
GetCoordsExit:
Exit Function
GetCoordsErr:
msgbox "Unable to retrieve all coordinates.", _
vbInformation, "Get Coords"
Resume GetCoordsExit
End Function
Function SaveCoords(frm As Form)
' This is the entry point for saving form info.
' Call this from the form's Close event.
Dim rct As adhTypeRect
Dim strName As String
On Error GoTo SaveCoordsErr
' Get the form's current size and position.
GetFormSize frm, rct
strName = frm.Name
' Use the name of the application as the highest
' level, and the form's name as the next level.
' This way, you could have multiple forms in the same
' app use this code.
With rct
If RegCreateNewKey_f(regHKeyL
RegSetKeyValue_f regHKeyLocalMachine, str_REG_NAME_KEY_m & strName, adhcTop, .Y1, regSZ
RegSetKeyValue_f regHKeyLocalMachine, str_REG_NAME_KEY_m & strName, adhcLeft, .X1, regSZ
RegSetKeyValue_f regHKeyLocalMachine, str_REG_NAME_KEY_m & strName, adhcBottom, .Y2, regSZ
RegSetKeyValue_f regHKeyLocalMachine, str_REG_NAME_KEY_m & strName, adhcRight, .X2, regSZ
End If
End With
SaveCoordsExit:
Exit Function
SaveCoordsErr:
msgbox "Unable to save all coordinates.", _
vbInformation, "Save Coords"
Resume SaveCoordsExit
End Function
Private Sub SetFormSize(frm As Form, rct As adhTypeRect)
Dim intWidth As Integer
Dim intHeight As Integer
Dim intSuccess As Integer
With rct
intWidth = (.X2 - .X1)
intHeight = (.Y2 - .Y1)
' No sense even trying if either is less than 0.
If (intWidth > 0) And (intHeight > 0) Then
' You would think the MoveSize action
' would work here, but that requires actually
' SELECTING the window first. That seemed like
' too much work, when this procedure will
' move/size ANY window.
intSuccess = adh_apiMoveWindow(frm.hwnd
.X1 - adhcBorderWidthX, .Y1 - adhcBorderWidthY, _
intWidth, intHeight, True)
End If
End With
End Sub
Firesteve:
If you would be so kind as to submit your suggestions as Comments, cas1 can accept your Comment as the answer, but you don't wind up locking the question. There might be a better answer than yours, you see.
In fact, the question wasn't how to size a form, it was how to size MSACCESS.EXE's parent window, as I read it.
I also recomend taking the adh_ off the front of the function declares, (stands for what: "Access Do-Hoppers?"). It makes for a lot less typing, and it is easier to read the code later...
Brian
If you would be so kind as to submit your suggestions as Comments, cas1 can accept your Comment as the answer, but you don't wind up locking the question. There might be a better answer than yours, you see.
In fact, the question wasn't how to size a form, it was how to size MSACCESS.EXE's parent window, as I read it.
I also recomend taking the adh_ off the front of the function declares, (stands for what: "Access Do-Hoppers?"). It makes for a lot less typing, and it is easier to read the code later...
Brian
ASKER
Thanx for your respond. I am back from vacation since today and have to check out your ideas first, ok?
ASKER
To BrainWren:
I can open the db the way that I want. I think about a tiny visual basic exe-file that opens and runs may db with the recommended parameters. But how exactly I don't know...
I can open the db the way that I want. I think about a tiny visual basic exe-file that opens and runs may db with the recommended parameters. But how exactly I don't know...
ASKER
Sorry, but BrainWren is right: My problem is not the form's size but the msaccess.exe
Brian,
The "adh" is the tag for code that comes with the "Access Developers Handbook" published by Sybex.
The ADH contains a lot of usefull code.
JimD.
The "adh" is the tag for code that comes with the "Access Developers Handbook" published by Sybex.
The ADH contains a lot of usefull code.
JimD.
--------------------------
JDettman:
I knew that the prefix was from a book title, I only think that it's useful to remove those tags... (so much typing, you know...)
cas1
I haven't tried this, but supose you set up a shortcut that specified opening the application "Run: Normal Window", and then used whatever, VB, to run the shortcut?
But also, this code from JDettman:
Function wu_SetAccessSize(X%, y%, dx%, dy%) As Integer
Dim hwnd As Long, f As Integer
hwnd& = wu_GetAccessHwnd()
If (wu_IsZoomed(hwnd&)) Then
f% = wu_ShowWindow(hwnd&, WU_SW_RESTORE)
End If
f% = wu_MoveWindow(hwnd&, X%, y%, dx%, dy%, True)
wu_SetAccessSize = f%
End Function
should do the trick. You could even remove the If
Function wu_SetAccessSize(X%, y%, dx%, dy%) As Integer
Dim hWnd As Long, f As Integer
hWnd& = wu_GetAccessHwnd()
f% = wu_ShowWindow(hwnd&, WU_SW_RESTORE)
f% = wu_MoveWindow(hwnd&, X%, y%, dx%, dy%, True)
wu_SetAccessSize = f%
.
.
.
Brian
JDettman:
I knew that the prefix was from a book title, I only think that it's useful to remove those tags... (so much typing, you know...)
cas1
I haven't tried this, but supose you set up a shortcut that specified opening the application "Run: Normal Window", and then used whatever, VB, to run the shortcut?
But also, this code from JDettman:
Function wu_SetAccessSize(X%, y%, dx%, dy%) As Integer
Dim hwnd As Long, f As Integer
hwnd& = wu_GetAccessHwnd()
If (wu_IsZoomed(hwnd&)) Then
f% = wu_ShowWindow(hwnd&, WU_SW_RESTORE)
End If
f% = wu_MoveWindow(hwnd&, X%, y%, dx%, dy%, True)
wu_SetAccessSize = f%
End Function
should do the trick. You could even remove the If
Function wu_SetAccessSize(X%, y%, dx%, dy%) As Integer
Dim hWnd As Long, f As Integer
hWnd& = wu_GetAccessHwnd()
f% = wu_ShowWindow(hwnd&, WU_SW_RESTORE)
f% = wu_MoveWindow(hwnd&, X%, y%, dx%, dy%, True)
wu_SetAccessSize = f%
.
.
.
Brian
ASKER
Sounds good but I always need an example. Sorry for my stupidness but I am not very familiar with windows api
Lets say my app's name is test.mdb and I want it to be opend with the fixed size of 200 x 200.
Lets say my app's name is test.mdb and I want it to be opend with the fixed size of 200 x 200.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
ok, raymer
nevertheless you helped me a lot
nevertheless you helped me a lot
Hey thanks for the 800 points ;-)
Those were the first points I ever earned for answering questions online...
This is kind of fun.
Ray Mercer
www.shrinwrapvb.com
Those were the first points I ever earned for answering questions online...
This is kind of fun.
Ray Mercer
www.shrinwrapvb.com
ASKER