- 帖子
- 181
- 主題
- 5
- 精華
- 0
- 積分
- 197
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- 2000
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2014-3-9
- 最後登錄
- 2024-4-29
|
我也第一次用ZOOM
發現它有缺陷, 寬高只能同放大或縮小, 不能一邊放大另一邊縮小
只好遷就它
// ================
Dim Form_First_wh
Dim Form_Last_wh
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const GWL_STYLE = (-16)
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const WS_THICKFRAME = &H40000
Const SM_CXFULLSCREEN = 16
Const SM_CYFULLSCREEN = 17
Const HWND_TOPMOST = -1
Const SWP_SHOWWINDOW = &H40
Dim hWndForm As Long
Dim IStyle As Long
Private Sub UserForm_Initialize()
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
IStyle = GetWindowLong(hWndForm, GWL_STYLE)
IStyle = IStyle Or WS_THICKFRAME
IStyle = IStyle Or WS_MINIMIZEBOX
IStyle = IStyle Or WS_MAXIMIZEBOX
SetWindowLong hWndForm, GWL_STYLE, IStyle
Form_First_wh = Array(UserForm1.Width, UserForm1.Height)
Form_Last_wh = Form_First_wh
End Sub
Public Sub myShowMax()
SetActiveWindow hWndForm
ShowWindow hWndForm, SW_SHOWMAXIMIZED
End Sub
Private Sub UserForm_Resize()
If (Form_First_wh(1) - UserForm1.Height) * (Form_First_wh(0) - UserForm1.Width) < 0 Then
MsgBox "UserForm1.Zoom 無法支援視窗一邊放大, 另一邊卻縮小"
UserForm1.Move UserForm1.Left, UserForm1.Top, Form_Last_wh(0), Form_Last_wh(1)
Exit Sub
End If
On Error Resume Next
If Abs(Form_First_wh(1) - UserForm1.Height) > Abs(Form_First_wh(0) - UserForm1.Width) Then
UserForm1.Width = UserForm1.Height / Form_First_wh(1) * Form_First_wh(0)
Else
UserForm1.Height = UserForm1.Width / Form_First_wh(0) * Form_First_wh(1)
End If
On Error GoTo 0
Form_Last_wh = Array(UserForm1.Width, UserForm1.Height)
UserForm1.Zoom = UserForm1.Height / Form_First_wh(1) * 100
End Sub |
|
發表於 2015-5-15 17:49
| 
