標題: [發問] Userform 裡的 image 物件如何縮放??? [打印本頁]

---

作者: s13030029    時間: 2019-7-26 09:18     標題: Userform 裡的 image 物件如何縮放???

如題目前我的userform可以讓使用者自由縮放
但是要怎樣才能讓 image 物件也能跟著縮放???
[attach]31075[/attach]

1. Dim ocx_First_wh As New Collection
   
2. Dim Fomr_TopBarHeight
   
3.    
   
4.     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
   
5.     Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
   
6.     Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
   
7.     Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   
8.     Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
9.     Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
10.     Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    
11.     Private Const WS_MAXIMIZEBOX = &H10000
    
12.     Private Const WS_MINIMIZEBOX = &H20000
    
13.     Private Const GWL_STYLE = (-16)
    
14.     Private Const SW_SHOWMAXIMIZED = 3
    
15.     Private Const SW_SHOWNORMAL = 1
    
16.     Private Const SW_SHOWMINIMIZED = 2
    
17.     Private Const WS_THICKFRAME = &H40000
    
18.     Const SM_CXFULLSCREEN = 16
    
19.     Const SM_CYFULLSCREEN = 17
    
20.     Const HWND_TOPMOST = -1
    
21.     Const SWP_SHOWWINDOW = &H40
    
22.     Dim hWndForm As Long
    
23.     Dim IStyle As Long
    
24. 
    
25. Private Sub CommandButton1_Click()
    
26.    
    
27.     With Application.FileDialog(msoFileDialogFilePicker)
    
28.         .Filters.Add "ImageFile", "*.jpg; *.jpeg; *.mp4", 1
    
29.         .AllowMultiSelect = False
    
30.         If .Show = -1 Then
    
31.             Image1.Picture = LoadPicture(.SelectedItems(1))
    
32.         End If
    
33.     End With
    
34. 
    
35. End Sub
    
36. 
    
37. Private Sub UserForm_Initialize()
    
38. 
    
39.       hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    
40.       IStyle = GetWindowLong(hWndForm, GWL_STYLE)
    
41.       IStyle = IStyle Or WS_THICKFRAME
    
42.       IStyle = IStyle Or WS_MINIMIZEBOX
    
43.       IStyle = IStyle Or WS_MAXIMIZEBOX
    
44.       SetWindowLong hWndForm, GWL_STYLE, IStyle
    
45.       a = Height
    
46.       Height = 0
    
47.       Fomr_TopBarHeight = Height
    
48.       Fomr_TopBarHeight = Fix(Fomr_TopBarHeight)
    
49.       Height = a + 1.5
    
50. 
    
51. 
    
52.     With Frame1
    
53.         '~~> This will create a vertical scrollbar
    
54.         .ScrollBars = fmScrollBarsBoth
    
55. 
    
56.         '~~> Change the values of 2 as Per your requirements
    
57.         .ScrollHeight = .InsideHeight * 2
    
58.         .ScrollWidth = .InsideWidth * 2
    
59.     End With
    
60. 
    
61. '    imgname = ActiveWorkbook.Sheets("管制計畫表").Range("I4").Value
    
62. '    Dim imgpath As String
    
63. '    imgpath = "\\G-server\產品履歷\客戶\00.範本\產品圖面"  '指定資料夾
    
64. '    With Image1
    
65. '        .Picture = LoadPicture(imgpath & "\" & imgname & ".jpg")
    
66. '        .AutoSize = True
    
67. '        .BorderStyle = fmBorderStyleNone
    
68. '        .PictureSizeMode = fmPictureSizeModeZoom
    
69. '    End With
    
70. 
    
71. End Sub
    
72. 
    
73. Private Sub CommandButton3_Click()
    
74. Me.Image1.Height = Me.Image1.Height - 100
    
75. Me.Image1.Width = Me.Image1.Width - 100
    
76. End Sub
    
77. 
    
78. Private Sub CommandButton2_Click()
    
79. Me.Image1.Height = Me.Image1.Height + 100
    
80. Me.Image1.Width = Me.Image1.Width + 100
    
81. End Sub
    
82. 
    
83. Public Sub myShowMax()
    
84.         SetActiveWindow hWndForm
    
85.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
    
86.     End Sub
    
87. 
    
88. Private Sub UserForm_Layout()
    
89. 
    
90. ' If ocx_First_wh.Count = 0 Then
    
91. '    ocx_First_wh.Add Key:="UserForm", Item:=Array(, Array(Left, Top, Width, Height, Font.Size, ""))
    
92. '    For Each s In Controls
    
93. '        ocx_First_wh.Add Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, s.Font.Size))
    
94. '    Next
    
95.    
    
96.        Form_xy = GetSetting(ThisWorkbook.Name, Name, "Form_Size")
    
97.     If Form_xy <> "" Then
    
98.        Form_xy = Split(Form_xy + String(5, ","), ",")
    
99.        If Form_xy(5) = "max" Then
    
100.           myShowMax
     
101.        Else
     
102.           On Error Resume Next
     
103.           Move Form_xy(0), Form_xy(1), Form_xy(2), Form_xy(3)
     
104.           On Error GoTo 0
     
105.        End If
     
106.     End If
     
107.     Exit Sub
     
108. ' End If
     
109.    
     
110. Form_xy = ocx_First_wh("UserForm")(1)
     
111. Rw = Width / Form_xy(2)
     
112. Rh = (Height - Fomr_TopBarHeight) / (Form_xy(3) - Fomr_TopBarHeight)
     
113. Rwh = IIf(Rw < Rh, Rw, Rh)
     
114. 
     
115. For w = 2 To ocx_First_wh.Count
     
116.      
     
117.      Set ocx = ocx_First_wh(w)(0)
     
118.       ocx_xy = ocx_First_wh(w)(1)
     
119.      
     
120.      ocx.Left = ocx_xy(0) * Rw
     
121.       ocx.Top = ocx_xy(1) * Rh
     
122.     ocx.Width = ocx_xy(2) * Rw
     
123.    ocx.Height = ocx_xy(3) * Rh
     
124.    If TypeOf ocx Is CommandButton Then
     
125.       ocx.FontSize = ocx_xy(4) * Rwh
     
126.    Else
     
127.       ocx.FontSize = ocx_xy(4) * Rh
     
128.    End If
     
129. Next
     
130. 
     
131. On Error Resume Next
     
132. Height = Height
     
133. SaveSetting ThisWorkbook.Name, Name, "Form_Size", Join(Array(Left, Top, Width, Height, 0, IIf(Err, "max", "")), ",")
     
134. 
     
135. End Sub

複製代碼

[attach]31076[/attach]

---

作者: s13030029    時間: 2019-7-26 13:12

回復 1# s13030029
隨然不太知道UserForm_Layout程式的內容是甚麼，但是拼拼湊湊還是成功了。

1.     Dim ocx_First_wh As New Collection
   
2.     Dim Fomr_TopBarHeight
   
3.    
   
4.     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
   
5.     Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
   
6.     Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
   
7.     Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   
8.     Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
9.     Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
10.     Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    
11.     Private Const WS_MAXIMIZEBOX = &H10000
    
12.     Private Const WS_MINIMIZEBOX = &H20000
    
13.     Private Const GWL_STYLE = (-16)
    
14.     Private Const SW_SHOWMAXIMIZED = 3
    
15.     Private Const SW_SHOWNORMAL = 1
    
16.     Private Const SW_SHOWMINIMIZED = 2
    
17.     Private Const WS_THICKFRAME = &H40000
    
18.     Const SM_CXFULLSCREEN = 16
    
19.     Const SM_CYFULLSCREEN = 17
    
20.     Const HWND_TOPMOST = -1
    
21.     Const SWP_SHOWWINDOW = &H40
    
22.     Dim hWndForm As Long
    
23.     Dim IStyle As Long
    
24. 
    
25. Private Sub CommandButton1_Click()
    
26. 
    
27.     With Application.FileDialog(msoFileDialogFilePicker)
    
28.         .Filters.Add "ImageFile", "*.jpg; *.jpeg; *.mp4", 1
    
29.         .AllowMultiSelect = False
    
30.         If .Show = -1 Then
    
31.             Image1.Picture = LoadPicture(.SelectedItems(1))
    
32.         End If
    
33.     End With
    
34. 
    
35. End Sub
    
36. 
    
37. Private Sub UserForm_Initialize()
    
38. 
    
39.       hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    
40.       IStyle = GetWindowLong(hWndForm, GWL_STYLE)
    
41.       IStyle = IStyle Or WS_THICKFRAME
    
42.       IStyle = IStyle Or WS_MINIMIZEBOX
    
43.       IStyle = IStyle Or WS_MAXIMIZEBOX
    
44.       SetWindowLong hWndForm, GWL_STYLE, IStyle
    
45.       
    
46.       a = Height
    
47.       Height = 0
    
48.       Fomr_TopBarHeight = Height
    
49.       Fomr_TopBarHeight = Fix(Fomr_TopBarHeight)
    
50.       Height = a + 1.5
    
51. 
    
52.     With Frame1
    
53.         '~~> This will create a vertical scrollbar
    
54.         .ScrollBars = fmScrollBarsBoth
    
55. 
    
56.         '~~> Change the values of 2 as Per your requirements
    
57.         .ScrollHeight = .InsideHeight * 2
    
58.         .ScrollWidth = .InsideWidth * 2
    
59.     End With
    
60. 
    
61. '    imgname = ActiveWorkbook.Sheets("管制計畫表").Range("I4").Value
    
62. '    Dim imgpath As String
    
63. '    imgpath = "\\G-server\產品履歷\客戶\00.範本\產品圖面"  '指定資料夾
    
64. '    With Image1
    
65. '        .Picture = LoadPicture(imgpath & "\" & imgname & ".jpg")
    
66. '        .AutoSize = True
    
67. '        .BorderStyle = fmBorderStyleNone
    
68. '        .PictureSizeMode = fmPictureSizeModeZoom
    
69. '    End With
    
70. 
    
71. End Sub
    
72. 
    
73. Private Sub CommandButton3_Click()
    
74. Me.Image1.Height = Me.Image1.Height - 200
    
75. Me.Image1.Width = Me.Image1.Width - 200
    
76. End Sub
    
77. 
    
78. Private Sub CommandButton2_Click()
    
79. Me.Image1.Height = Me.Image1.Height + 200
    
80. Me.Image1.Width = Me.Image1.Width + 200
    
81. End Sub
    
82. 
    
83. Public Sub myShowMax()
    
84.         SetActiveWindow hWndForm
    
85.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
    
86. End Sub
    
87. 
    
88. Private Sub UserForm_Layout()
    
89. 
    
90. If ocx_First_wh.Count = 0 Then
    
91.     ocx_First_wh.Add Key:="UserForm", Item:=Array(, Array(Left, Top, Width, Height, Font.Size, ""))
    
92.    
    
93.     On Error Resume Next
    
94.     For Each s In Controls
    
95.         ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, s.Font.Size))
    
96.         If Err Then
    
97.         ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, Empty))
    
98.         End If
    
99.     Next
    
100.     On Error GoTo 0
     
101.    
     
102.        Form_xy = GetSetting(ThisWorkbook.Name, Name, "Form_Size")
     
103.     If Form_xy <> "" Then
     
104.        Form_xy = Split(Form_xy + String(5, ","), ",")
     
105.        If Form_xy(5) = "max" Then
     
106.           myShowMax
     
107.        Else
     
108.           On Error Resume Next
     
109.           Move Form_xy(0), Form_xy(1), Form_xy(2), Form_xy(3)
     
110.           On Error GoTo 0
     
111.        End If
     
112.     End If
     
113.     Exit Sub
     
114. End If
     
115. 
     
116. Form_xy = ocx_First_wh("UserForm")(1)
     
117. Rw = Width / Form_xy(2)
     
118. Rh = (Height - Fomr_TopBarHeight) / (Form_xy(3) - Fomr_TopBarHeight)
     
119. Rwh = IIf(Rw < Rh, Rw, Rh)
     
120. 
     
121. For w = 2 To ocx_First_wh.Count
     
122.      
     
123.      Set ocx = ocx_First_wh(w)(0)
     
124.       ocx_xy = ocx_First_wh(w)(1)
     
125.      
     
126.      ocx.Left = ocx_xy(0) * Rw
     
127.       ocx.Top = ocx_xy(1) * Rh
     
128.     ocx.Width = ocx_xy(2) * Rw
     
129.    ocx.Height = ocx_xy(3) * Rh
     
130.    If TypeOf ocx Is CommandButton Then
     
131.       ocx.FontSize = ocx_xy(4) * Rwh
     
132.    Else
     
133. '      ocx.FontSize = ocx_xy(4) * Rh
     
134.    End If
     
135. Next
     
136. 
     
137. On Error Resume Next
     
138. Height = Height
     
139. SaveSetting ThisWorkbook.Name, Name, "Form_Size", Join(Array(Left, Top, Width, Height, 0, IIf(Err, "max", "")), ",")
     
140. 
     
141. End Sub

複製代碼

[attach]31078[/attach]

---

作者: s13030029    時間: 2019-7-26 13:59

有高手可以幫我看看我這樣解釋對嗎???@@

1.     Dim ocx_First_wh As New Collection
   
2.     Dim Fomr_TopBarHeight
   
3.     Dim hWndForm As Long
   
4.     Dim IStyle As Long
   
5.    
   
6.     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
   
7.     Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
   
8.     Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
   
9.     Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   
10.     Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
11.     Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    
12.     Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    
13.     Private Const WS_MAXIMIZEBOX = &H10000
    
14.     Private Const WS_MINIMIZEBOX = &H20000
    
15.     Private Const GWL_STYLE = (-16)
    
16.     Private Const SW_SHOWMAXIMIZED = 3
    
17.     Private Const SW_SHOWNORMAL = 1
    
18.     Private Const SW_SHOWMINIMIZED = 2
    
19.     Private Const WS_THICKFRAME = &H40000
    
20.     Const SM_CXFULLSCREEN = 16
    
21.     Const SM_CYFULLSCREEN = 17
    
22.     Const HWND_TOPMOST = -1
    
23.     Const SWP_SHOWWINDOW = &H40
    
24.    
    
25. Private Sub CommandButton1_Click() '匯入圖面
    
26.     With Application.FileDialog(msoFileDialogFilePicker)
    
27.         .Filters.Add "ImageFile", "*.jpg; *.jpeg; *.mp4", 1
    
28.         .AllowMultiSelect = False
    
29.         If .Show = -1 Then
    
30.             Image1.Picture = LoadPicture(.SelectedItems(1))
    
31.         End If
    
32.     End With
    
33. End Sub
    
34. 
    
35. Private Sub UserForm_Initialize() '表單初始化
    
36.     'userform最大、最小化按鈕的顯示
    
37.       hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    
38.       IStyle = GetWindowLong(hWndForm, GWL_STYLE)
    
39.       IStyle = IStyle Or WS_THICKFRAME
    
40.       IStyle = IStyle Or WS_MINIMIZEBOX
    
41.       IStyle = IStyle Or WS_MAXIMIZEBOX
    
42.       SetWindowLong hWndForm, GWL_STYLE, IStyle
    
43.       '初始化視窗大小
    
44.       A = Height
    
45.       Height = 0
    
46.       Fomr_TopBarHeight = Height
    
47.       Fomr_TopBarHeight = Fix(Fomr_TopBarHeight)
    
48.       Height = A + 1.5
    
49. 
    
50.     With Frame1
    
51.          '這將創建一個垂直一個水平滾動條，fmScrollBarsHorizontal顯示水平捲軸，fmScrollBarsVertical顯示垂直捲軸，fmScrollBarsBoth顯示水平與垂直捲軸兩者。
    
52.         .ScrollBars = fmScrollBarsBoth
    
53.         '根據您的要求更改值2
    
54.         .ScrollHeight = .InsideHeight * 2
    
55.         .ScrollWidth = .InsideWidth * 2
    
56.     End With
    
57.     '根據產品編號自動從產品圖面資料夾匯入圖面
    
58.     imgname = ActiveWorkbook.Sheets("管制計畫表").Range("I4").Value
    
59.     Dim imgpath As String
    
60.     imgpath = "\\G-server\產品履歷\客戶\00.範本\產品圖面"
    
61.     With Image1
    
62.         .Picture = LoadPicture(imgpath & "\" & imgname & ".jpg")
    
63.         .AutoSize = True
    
64.         .BorderStyle = fmBorderStyleNone
    
65.         .PictureSizeMode = fmPictureSizeModeZoom
    
66.     End With
    
67.     With Frame1
    
68.         .BorderStyle = fmBorderStyleNone
    
69.         .PictureSizeMode = fmPictureSizeModeZoom
    
70.     End With
    
71. End Sub
    
72. 
    
73. Private Sub CommandButton3_Click() '圖像縮小鍵
    
74. Me.Image1.Height = Me.Image1.Height - 200
    
75. Me.Image1.Width = Me.Image1.Width - 200
    
76. End Sub
    
77. 
    
78. Private Sub CommandButton2_Click() '圖像放大鍵
    
79. Me.Image1.Height = Me.Image1.Height + 200
    
80. Me.Image1.Width = Me.Image1.Width + 200
    
81. End Sub
    
82. 
    
83. Public Sub myShowMax() 'userform 最大化
    
84.         SetActiveWindow hWndForm
    
85.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
    
86. End Sub
    
87. 
    
88. Private Sub UserForm_Layout()
    
89.     '取得目前視窗大小
    
90.     If ocx_First_wh.Count = 0 Then
    
91.         ocx_First_wh.Add Key:="UserForm", Item:=Array(, Array(Left, Top, Width, Height, Font.Size, ""))
    
92.         On Error Resume Next
    
93.         For Each s In Controls
    
94.             ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, s.Font.Size))
    
95.             If Err Then
    
96.                 ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, Empty))
    
97.             End If
    
98.         Next
    
99.         On Error GoTo 0
    
100.         Form_xy = GetSetting(ThisWorkbook.Name, Name, "Form_Size")
     
101.         '最大化視窗觸發時
     
102.         If Form_xy <> "" Then
     
103.            Form_xy = Split(Form_xy + String(5, ","), ",")
     
104.            If Form_xy(5) = "max" Then
     
105.               myShowMax
     
106.            Else
     
107.               On Error Resume Next
     
108.               Move Form_xy(0), Form_xy(1), Form_xy(2), Form_xy(3)
     
109.               On Error GoTo 0
     
110.            End If
     
111.         End If
     
112.         Exit Sub
     
113.     End If
     
114.     '計算視窗大小?????
     
115.     Form_xy = ocx_First_wh("UserForm")(1)
     
116.     Rw = Width / Form_xy(2)
     
117.     Rh = (Height - Fomr_TopBarHeight) / (Form_xy(3) - Fomr_TopBarHeight)
     
118.     Rwh = IIf(Rw < Rh, Rw, Rh)
     
119.     '當縮放userform時，裡面的物件也跟著變動
     
120.     For w = 2 To ocx_First_wh.Count
     
121.       Set ocx = ocx_First_wh(w)(0)
     
122.             ocx_xy = ocx_First_wh(w)(1)
     
123.             ocx.Left = ocx_xy(0) * Rw
     
124.             ocx.Top = ocx_xy(1) * Rh
     
125.             ocx.Width = ocx_xy(2) * Rw
     
126.             ocx.Height = ocx_xy(3) * Rh
     
127.         If TypeOf ocx Is CommandButton Then
     
128.           ocx.FontSize = ocx_xy(4) * Rwh
     
129.        Else
     
130.        End If
     
131.     Next
     
132.     '儲存目前視窗的大小
     
133.     On Error Resume Next
     
134.     Height = Height
     
135.     SaveSetting ThisWorkbook.Name, Name, "Form_Size", Join(Array(Left, Top, Width, Height, 0, IIf(Err, "max", "")), ",")
     
136. End Sub

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)