Resize controls khi userform phóng to thu nhỏ

Resize controls khi userform phóng to thu nhỏ

Code này của Tác Giả: Nguyễn Duy Tuân - DĐ GPE, cho phép chúng ta phóng to thu nhỏ đối tượng trong form tự động khi người dùng phóng to thu... 26.8.19

Code này của Tác Giả: Nguyễn Duy Tuân - DĐ GPE, cho phép chúng ta phóng to thu nhỏ đối tượng trong form tự động khi người dùng phóng to thu nhỏ form



Code:

Private Const ZoomMin = 10
Private Const ZoomMax = 400

Public hWnd&, PrevStyle&
Dim OldWidth As Double, OldHeight As Double
Dim AllowResize As Boolean

Private Sub UserForm_Activate()
ShowWindow hWnd, SW_MAXIMIZE
End Sub

Private Sub UserForm_Initialize()
AllowResize = True
OldWidth = Width
OldHeight = Height
If Val(Application.Version) < 9 Then
hWnd = FindWindow("ThunderXFrame", Caption) 'XL97
Else
hWnd = FindWindow("ThunderDFrame", Caption) 'XL2000
End If

PrevStyle = GetWindowLong(hWnd, GWL_STYLE)
SetWindowLong hWnd, GWL_STYLE, PrevStyle _
Or WS_SIZEBOX _
Or WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX
End Sub

Private Sub UserForm_Terminate()
SetWindowLong hWnd, GWL_STYLE, PrevStyle
End Sub

Private Sub UserForm_Resize()
Dim tmpZoom As Long, CurStyle&
If Not AllowResize Then Exit Sub
CurStyle = GetWindowLong(hWnd, GWL_STYLE)
tmpZoom = Round(Width / OldWidth * 100, 0)
If tmpZoom < ZoomMin Then tmpZoom = ZoomMin
If tmpZoom > ZoomMax Then tmpZoom = ZoomMax

AllowResize = False 'Ngan khong chay UserForm_Resize khi dang thay doi size

If tmpZoom = ZoomMin Or tmpZoom = ZoomMax Then
'Neu khong phai la phong to man hinh thi co lai kich co
If Not (CurStyle And WS_MAXIMIZE) = WS_MAXIMIZE Then
Width = tmpZoom * OldWidth / 100
Height = Width * OldHeight / OldWidth
End If
End If
AllowResize = True 'Cho phep resize
Zoom = tmpZoom
End Sub

Tải File Demo: 

===================================================
Để trao đổi và hỏi đáp thêm về chủ đề này, vui lòng truy cập vào diễn đàn các bạn nhé https://thuthuataccess.com/forum/forum-21.html