[Resolvido]Experiência inesperada com o Access 2010

Pessoal escrevo esse fato só para constar e a título de informação:

Ontem me aconteceu o seguinte:

Mandei um instalador de uma aplicação para um cliente aqui mesmo na cidade onde moro, ele instalou tudo direitinho e tal, abriu a aplicação colocou as informações da empresa, entrou com o login, tudo certo, fez o cadastro de um cliente, continuando tudo certo e tal, quando ele foi abrir a tela de pesquisa para em seguida registrar uma venda para esse primeiro cliente a tela ficou toda escura segundo ele, que me contactou e precisei ir lá. Chegando vi que ele tava usando 0 2010, cheguei e reparei que a função "ReSizeForm Me" do módulo ResizeForm colocada no evento Ao Carregar do formulário havia causado isso que foi só tirar que sanou o problema, que sem a função a estética dos controles não acompanharam o formato do HD, detalhe que só é percebido e impactante aos nossos olhos de programador, do cliente não.

Agora é que vem a encabulação:

Eu havia testado isso no 2010 e não apresentou qualquer problema, como que retornei para casa e novamente testei e não apresentou qualquer coisa.

Estou até agora encafifado, será diferenças nos SGDB's?

Atualização do Oficce?

O meu tá atualizado e o dele não, ou será o inverso?

Vou começar uma investigação quanto a essa reação ocorrida, desagradável surpresa.

Dilson

Se estás a usar o módulo do Jamies Software, este não garante o correcto funcionamento no 2010. Isto segundo um amigo meu que teve esse problema num cliente também e com o 2010. Curiosamente funcionava na máquina dele.

Se precisares eu tenho um outro módulo do Peter's Software que faz a mesma coisa. Nunca o experimentei no 2010, mas no 2003 e 7, tem funcionado muito bem.

Abs

Amigo Vieira, será de grande valia, antes:

O que eu tô usando, não existe a autoria nele, veja:

O que você tem aí é diferente deste?:

Option Compare Database
Option Explicit
Private Const DESIGN_HORZRES As Long = 1024
Private Const DESIGN_VERTRES As Long = 768
Private Const DESIGN_PIXELS As Long = 96

Private Const WM_HORZRES As Long = 8
Private Const WM_VERTRES As Long = 10
Private Const WM_LOGPIXELSX As Long = 88
Private Const TITLEBAR_PIXELS As Long = 18
Private Const COMMANDBAR_PIXELS As Long = 26
Private Const COMMANDBAR_LEFT As Long = 0
Private Const COMMANDBAR_TOP As Long = 1
Private OrigWindow As tWindow


Private Type tRect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type tDisplay
Height As Long
Width As Long
DPI As Long
End Type

Private Type tWindow
Height As Long
Width As Long
End Type

Private Type tControl
Name As String
Height As Long
Width As Long
Top As Long
Left As Long
End Type

Private Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" _
() As Long

Private Declare Function WM_apiGetDC Lib "user32" Alias "GetDC" _
(ByVal hwnd As Long) As Long

Private Declare Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" _
(ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function WM_apiGetWindowRect Lib "user32.dll" Alias "GetWindowRect" _
(ByVal hwnd As Long, lpRect As tRect) As Long

Private Declare Function WM_apiMoveWindow Lib "user32.dll" 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

Private Declare Function WM_apiIsZoomed Lib "user32.dll" Alias "IsZoomed" _
(ByVal hwnd As Long) As Long

Private Function getScreenResolution() As tDisplay

Dim hDCcaps As Long
Dim lngRtn As Long

On Error Resume Next


hDCcaps = WM_apiGetDC(0)
With getScreenResolution
.Height = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)
.Width = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)
.DPI = WM_apiGetDeviceCaps(hDCcaps, WM_LOGPIXELSX)
End With
lngRtn = WM_apiReleaseDC(0, hDCcaps)

End Function


Private Function getFactor(blnVert As Boolean) As Single

Dim sngFactorP As Single

On Error Resume Next

If getScreenResolution.DPI <> 0 Then
sngFactorP = DESIGN_PIXELS / getScreenResolution.DPI
Else
sngFactorP = 1
End If
If blnVert Then
getFactor = (getScreenResolution.Height / DESIGN_VERTRES) * sngFactorP
Else
getFactor = (getScreenResolution.Width / DESIGN_HORZRES) * sngFactorP
End If

End Function


Public Sub ReSizeForm(ByVal frm As Access.Form)

Dim rectWindow As tRect
Dim lngWidth As Long
Dim lngHeight As Long
Dim sngVertFactor As Single
Dim sngHorzFactor As Single

On Error Resume Next

sngVertFactor = getFactor(True)
sngHorzFactor = getFactor(False)
Resize sngVertFactor, sngHorzFactor, frm
If WM_apiIsZoomed(frm.hwnd) = 0 Then
Access.DoCmd.RunCommand acCmdAppMaximize

Call WM_apiGetWindowRect(frm.hwnd, rectWindow)

With rectWindow
lngWidth = .Right - .Left
lngHeight = .Bottom - .Top
End With

If frm.Parent.Name = VBA.vbNullString Then
Call WM_apiMoveWindow(frm.hwnd, ((getScreenResolution.Width - _
(sngHorzFactor * lngWidth)) / 2) - getLeftOffset, _
((getScreenResolution.Height - (sngVertFactor * lngHeight)) / 2) - _
getTopOffset, lngWidth * sngHorzFactor, lngHeight * sngVertFactor, 1)
End If
End If
Set frm = Nothing

End Sub


Private Sub Resize(sngVertFactor As Single, sngHorzFactor As Single, ByVal frm As Access.Form)

Dim ctl As Access.Control
Dim arrCtls() As tControl
Dim lngI As Long
Dim lngJ As Long
Dim lngWidth As Long
Dim lngHeaderHeight As Long
Dim lngDetailHeight As Long
Dim lngFooterHeight As Long
Dim blnHeaderVisible As Boolean
Dim blnDetailVisible As Boolean
Dim blnFooterVisible As Boolean
Const FORM_MAX As Long = 31680

On Error Resume Next

With frm
.Painting = False

lngWidth = .Width * sngHorzFactor
lngHeaderHeight = .Section(Access.acHeader).Height * sngVertFactor
lngDetailHeight = .Section(Access.acDetail).Height * sngVertFactor
lngFooterHeight = .Section(Access.acFooter).Height * sngVertFactor

.Width = FORM_MAX
.Section(Access.acHeader).Height = FORM_MAX
.Section(Access.acDetail).Height = FORM_MAX
.Section(Access.acFooter).Height = FORM_MAX

blnHeaderVisible = .Section(Access.acHeader).Visible
blnDetailVisible = .Section(Access.acDetail).Visible
blnFooterVisible = .Section(Access.acFooter).Visible
.Section(Access.acHeader).Visible = False
.Section(Access.acDetail).Visible = False
.Section(Access.acFooter).Visible = False
End With

ReDim arrCtls(0)

For Each ctl In frm.Controls
If ((ctl.ControlType = Access.acTabCtl) Or _
(ctl.ControlType = Access.acOptionGroup)) Then
With arrCtls(lngI)
.Name = ctl.Name
.Height = ctl.Height
.Width = ctl.Width
.Top = ctl.Top
.Left = ctl.Left
End With
lngI = lngI + 1
ReDim Preserve arrCtls(lngI)
End If
Next ctl

For Each ctl In frm.Controls
If ctl.ControlType <> Access.acPage Then
With ctl
.Height = .Height * sngVertFactor
.Left = .Left * sngHorzFactor
.Top = .Top * sngVertFactor
.Width = .Width * sngHorzFactor
.fontsize = .fontsize * sngVertFactor

Select Case .ControlType
Case Access.acListBox
.ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor)
Case Access.acComboBox
.ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor)
.ListWidth = .ListWidth * sngHorzFactor
Case Access.acTabCtl
.TabFixedWidth = .TabFixedWidth * sngHorzFactor
.TabFixedHeight = .TabFixedHeight * sngVertFactor
End Select

End With
End If
Next ctl

For lngJ = 0 To lngI
With frm.Controls.Item(arrCtls(lngJ).Name)
.Left = arrCtls(lngJ).Left * sngHorzFactor
.Top = arrCtls(lngJ).Top * sngVertFactor
.Height = arrCtls(lngJ).Height * sngVertFactor
.Width = arrCtls(lngJ).Width * sngHorzFactor
End With
Next lngJ

With frm
.Width = lngWidth
.Section(Access.acHeader).Height = lngHeaderHeight
.Section(Access.acDetail).Height = lngDetailHeight
.Section(Access.acFooter).Height = lngFooterHeight

.Section(Access.acHeader).Visible = blnHeaderVisible
.Section(Access.acDetail).Visible = blnDetailVisible
.Section(Access.acFooter).Visible = blnFooterVisible
.Painting = True
End With
Erase arrCtls
Set ctl = Nothing

End Sub


Private Function getTopOffset() As Long

Dim cmdBar As Object
Dim lngI As Long

On Error GoTo err

For Each cmdBar In Application.CommandBars
If ((cmdBar.Visible = True) And (cmdBar.position = COMMANDBAR_TOP)) Then
lngI = lngI + 1
End If
Next cmdBar
getTopOffset = (TITLEBAR_PIXELS + (lngI * COMMANDBAR_PIXELS))

exit_fun:
Exit Function

err:

getTopOffset = TITLEBAR_PIXELS + COMMANDBAR_PIXELS
Resume exit_fun

End Function


Private Function getLeftOffset() As Long

Dim cmdBar As Object
Dim lngI As Long

On Error GoTo err

For Each cmdBar In Application.CommandBars
If ((cmdBar.Visible = True) And (cmdBar.position = COMMANDBAR_LEFT)) Then
lngI = lngI + 1
End If
Next cmdBar
getLeftOffset = (lngI * COMMANDBAR_PIXELS)

exit_fun:
Exit Function

err:

getLeftOffset = 0
Resume exit_fun

End Function


Private Function adjustColumnWidths(strColumnWidths As String, sngFactor As Single) _
As String

Dim astrColumnWidths() As String
Dim strTemp As String
Dim lngI As Long
Dim lngJ As Long


ReDim astrColumnWidths(0)
For lngI = 1 To VBA.Len(strColumnWidths)
Select Case VBA.Mid(strColumnWidths, lngI, 1)
Case Is <> ";"
astrColumnWidths(lngJ) = astrColumnWidths(lngJ) & VBA.Mid( _
strColumnWidths, lngI, 1)
Case ";"
lngJ = lngJ + 1
ReDim Preserve astrColumnWidths(lngJ)
End Select
Next lngI
lngI = 0

Do Until lngI > UBound(astrColumnWidths)
strTemp = strTemp & CSng(astrColumnWidths(lngI)) * sngFactor & ";"
lngI = lngI + 1
Loop
adjustColumnWidths = strTemp
Erase astrColumnWidths

End Function


Public Sub getOrigWindow(frm As Access.Form)

On Error Resume Next

OrigWindow.Height = frm.WindowHeight
OrigWindow.Width = frm.WindowWidth

End Sub


Public Sub RestoreWindow()

On Error Resume Next

Access.DoCmd.MoveSize , , OrigWindow.Width, OrigWindow.Height
Access.DoCmd.Save

End Sub

Foi enviado. Verifica o teu email

Implementei e tá rodando bem, espero que ele não me apronte.

Obrigado pela força Vieira.

Olá, Vieira! Vc pode me mandar o código que enviou ao Dilson? Obrigado

Mestre Vieira se puder poste no repositório de exemplos, também uso o 2010 e gostaria de testar....

Abraços...