¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î
Èç¹ûÄãÊÇÔÚ1024*768µÄ·Ö±æÂÊÏÂдµÄ³ÌÐò£¬¾Í°ÑÏÂÃæÄǾä¸ÄΪ
Const DesignSize = 1024£¬Èç¹ûÊÇ800*600·Ö
±æÂÊÏÂдµÄ£¬¾Í¸ÄΪConst DesignSize = 800
Ó÷¨£º°ÑÏÂÃæËùÓеĴúÂë·ÅÔÚÒ»¸öÄ£¿éÀÔÚÐèÒªÊÊÓ¦·Ö±æÂʵĴ°ÌåµÄLoadÊÂ
¼þÀï¼ÓÈëCall FormResiz_OnOpen(Me)
¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î¡î

Const DesignSize = 1024
Const DesignSize = 800

¡î¡ï¡î¡ï¡î¡ï¡î¡ï¡î¡ï¡î¡ï¡î¡ï¡î¡ï¡î¡ï

APIÐûÑÔ
Declare Function GetDesktopWindow Lib "User32" () As Long

Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long

TypeÐûÑÔ
Type RECT

x1 As Long

y1 As Long

x2 As Long

y2 As Long

End Type

¹ú±êÂëÐûÑÔ
Dim frm As Form

Dim ctrl As Control

Dim prp As Property

Dim rat As Double

Dim flgSec

Dim X As Long

Dim WinHeight As Long

Dim hWnd As Long

Dim ret As Long

Dim i As Integer

Dim R As RECT

Dim SizeL As Long

Dim SizeT As Long

Dim SizeW As Long

Dim SizeH As Long

--------------------------------------------------------------------------------

Public Function FormResiz_OnOpen(parFrm As Form, Optional perSizeL As Long, Optional perSizeT As Long, Optional perSizeW As Long, Optional perSizeH As Long)

On Error Resume Next

Set frm = parFrm

´°¿Ú¼ÝÊ»Å̵ÄÈ¡µÃ
hWnd = GetDesktopWindow()

ÏÖÔÚ·Ö±æÂÊÈ¡µÃ
ret = GetWindowRect(hWnd, R)

±ÈÀý¼ÆËã ³£Àý£ºÏÖÔÚ800 ¿ª·¢1024 800/1024 = 0.78¼Ó±¶
X = (R.x2 - R.x1)

rat = X / DesignSize

SizeL = 0: SizeT = 0: SizeW = 0: SizeH = 0

If Not IsEmpty(perSizeL) = True Then

SizeL = perSizeL * rat

SizeT = perSizeT * rat

SizeW = perSizeW * rat

SizeH = perSizeH * rat

End If

ÏÖÔÚ·Ö±æÂÊ£½¿ª·¢·Ö±æÂÊÈç¹ûÖÕÁË
If X = DesignSize Then Exit Function

If X < DesignSize Then

ϸС²ß»®Ê±¡¢¿ØÖÆ£¾²¿·Ö£¾±íµ¥µÄ´ÎÐò
Call ChangeCtrl

Call ChengeSec

Call ChangeFrm

Else

´óÞäȡʱ¡¢±íµ¥£¾²¿·Ö£¾¿ØÖƵĴÎÐò
Call ChangeFrm

Call ChengeSec

Call ChangeCtrl

End If

×îºó¡¢±íµ¥µÄʹÇåÐÂ
frm.Refresh

Exit Function

End Function

--------------------------------------------------------------------------------

Private Sub ChangeCtrl()

On Error Resume Next

¿ØÖÆת
For Each ctrl In frm.Controls
*******************************************************************************************
Ñ¡ÏÐÞÕý£¬Ô­ÖøûÓÐÕâ¶Î´úÂ룬ºóÀ´ÓиöÅóÓÑ·¢ÏÖÁËÕâ¸öBUG£¬¾ÍÊÇÑ¡ÏµÄλÖûáÆ«µÃºÜÀ÷º¦
ËùÒԾͼÓÁËÕâ¶Î´úÂëÀ´ÐÞÕý
Ö÷ÒªÊÇ"Top", "Height","Left","Width"Õ⼸¸ö²ÎÊýµÄÖµ£¬¸ù¾Ýʵ¼ÊÇé¿öÊʵ±µ÷Õû¾ÍÐÐÁË
If ctrl.ControlType = 123 Or ctrl.ControlType = 124 Then
For Each prp In ctrl.Properties
Select Case prp.Name
Case "FontSize", "DatasheetFontHeight"
prp.Value = Fix(prp.Value * rat + 0.5)
Case "FontWeight"
prp.Value = Fix((prp.Value * rat) / 100) * 100
Case "Top", "Height"
prp.Value = Fix(prp.Value * rat * 0.85)
prp.Value = Fix(prp.Value * rat)
Case "Left"
prp.Value = Fix(prp.Value * rat * 0.9)
Case "Width"
prp.Value = Fix(prp.Value * rat * 0.7)
End Select
Next prp
********************************************************************************************
Else
ÊôÐÔת
For Each prp In ctrl.Properties
´óС¡¤ÅäÖùØÓÚÊôÐÔ±»·¢ÏÖÃÇѹËõ
Select Case prp.Name
Case "FontSize", "DatasheetFontHeight"
ͨ³£¼ÆËã¼ÙÈçÐС­Çé¿öÖ®Ï嵀 +0.5 Ö®ÀàµÄ»°²»ÐèÒªÊÇ¡­µ«¡­¡¢
À¦Zo~Ma°ì·¨¡£ÉÔ΢ÐÄÇ黵ÒòΪ +0.5
prp.Value = Fix(prp.Value * rat + 0.5)
Case "FontWeight"
prp.Value = Fix((prp.Value * rat) / 100) * 100
Case "Left", "Top", "Width", "Height"
prp.Value = Fix(prp.Value * rat)
End Select
Next prp
End If
Next ctrl

End Sub

--------------------------------------------------------------------------------

Private Sub ChengeSec()

On Error GoTo Err_Disp

²¿·Öת
flgSec = True

i = 0

²»´æÔÚ²¿·ÖµÄ²ÎÕÕ´íÎó»¯Ñé³öÖÕÁË
Do Until flgSec = False

²¿·Ö±»·¢ÏÖÃǸ߶ȱä¸ü
frm.Section(i).Height = Fix(frm.Section(i).Height * rat)

i = i + 1

Loop

Exit Sub

Err_Disp:

If Err = 2462 Then

flgSec = False

Resume Next

Else

MsgBox Err.Description

End If

Resume Next

End Sub

--------------------------------------------------------------------------------

Private Sub ChangeFrm()

On Error Resume Next

±íµ¥µÄ´óС±ä¸ü

Optional²ÎÊýÊýÖµ¶ÉÏ´ÎÊÕÊ°¤Ð¡¢¶øÇÒʹºÏ£¨¼ÆËãÕýÔÚÍê±Ï£©
If SizeL > 0 Then

DoCmd.MoveSize SizeL, SizeT, SizeW, SizeH

Else

ÌرðÊÇÖ¸¶¨°¡¼ÙÈçÌß¡¢±ä¸üÁË±íµ¥µÄ´óС±íʾ

±íµ¥µÄÊôÐÔ£¨¿íÓë¸ß¶È£©
frm.Width = Fix(frm.Width * rat)

WinHeight = Fix(frm.WindowHeight * rat)

DoCmd.MoveSize , , frm.Width, WinHeight

End If

End Sub

--------------------------------------------------------------------------------
Ïà¹ØÎÄÕÂ
ûÓÐÏà¹ØÎÄÕÂ