Formサイズの最小値

質問

環境
VB6.0
ResizerというOCX

Formのサイズを可変にしています。
小さくできる最小値を設定したいのですが、
どのように出来ますか？
Form_Resizeに、
if me.width < '最小値' then
me.width = '最小値'
end if

としたら、最小値より小さくしようとして戻すので、
画面がチカチカします。
Resizerで簡単にできませんか？

回答No.2

noname#185804 · ベストアンサー

Resizerについては分かりませんが
ResizerにEnabledプロパティはありますか？
あれば下記のようにResizeされた時に
Enabled=Falseされても改善されませんか？
Private Sub Form_Resize()
If Not Me.WindowState = vbMinimized Then
　If Me.Width < '最小値' Then
　　Resizer.Enabled = False
　　Me.Width = '最小値'
　End If
End If
End Sub
Resizerでサイズ制限が出来るのならその方が良いのですが。

お礼

ありがとうございます。

Resizerでは出来なかったのですが、
Me.enabled = false
を入れてできました。

ただし、他の方が作成した実現できているソースを見ると、
Form_Resizerには何も書かれていません。
でも、最小値でぴたりと止ります。
比較しても、、ResizerのHelpを見てもわかりませんでした…。
今回はこれで対応しました。

回答No.3

KenKen_SP

> Resizerでは出来なかったのですが、
> Me.enabled = false
> を入れてできました。

Me.Enabled = False にして、その後どうやってフォームを操作するので
しょうか？ 何か技があるんですか？

ともあれ解決したなら良かったですね^^

> Form_Resizerには何も書かれていません。

サブクラス化によるサイズ制限のサンプルがありましたので、蛇足になり
ますが一応提示しておきます。お試しになる場合は不意に終了しない様に
くれぐれもご注意下さい。

' // 標準モジュール ------------------------------------------------------------

Option Explicit

' フォームのサイズ制限
Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" ( _
　　ByRef pDest As Any, _
　　ByRef pSrc As Any, _
　　ByVal iSize As Long)
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
　　ByVal lpPrevWndFunc As Long, _
　　ByVal hwnd As Long, _
　　ByVal Msg As Long, _
　　ByVal wParam As Long, _
　　ByVal lParam As Long _
) As Long

Private Const WM_GETMINMAXINFO = &H24

Private Type POINTAPI
　　x As Long
　　y As Long
End Type

Private Type MINMAXINFO
　　ptReserved　　 As POINTAPI
　　ptMaxSize　　　As POINTAPI
　　ptMaxPosition　As POINTAPI
　　ptMinTrackSize As POINTAPI
　　ptMaxTrackSize As POINTAPI
End Type

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 GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
　　ByVal hwnd As Long, _
　　ByVal nIndex As Long) As Long

Private Const GWL_WNDPROC = (-4)

Private PreWndProcAddress As Long
Private Limit_hWnd　　　　As Long
Private LimitSize　　　　 As POINTAPI

Public Function WndProc( _
　　ByVal hwnd As Long, _
　　ByVal iMsg As Long, _
　　ByVal wParam As Long, _
　　ByVal lParam As Long) As Long

　　Dim ret　　　　 As Long
　　Dim MINMAX　　　As MINMAXINFO
　　If iMsg = WM_GETMINMAXINFO And Limit_hWnd = hwnd Then
　　　　memcpy MINMAX, ByVal lParam, LenB(MINMAX)
　　　　With MINMAX
　　　　　　.ptMinTrackSize.x = LimitSize.x
　　　　　　.ptMinTrackSize.y = LimitSize.y
　　　　End With
　　　　memcpy ByVal lParam, MINMAX, LenB(MINMAX)
　　　　ret = 0&
　　Else
　　　　ret = CallWindowProc(PreWndProcAddress, hwnd, iMsg, wParam, lParam)
　　End If
　　WndProc = ret

End Function

Public Sub LimitStart( _
　　ByVal hwnd As Long, _
　　ByVal MinX As Long, _
　　ByVal MinY As Long)

　　LimitEnd
　　If hwnd <> 0 Then
　　　　LimitSize.x = MinX
　　　　LimitSize.y = MinY
　　　　Limit_hWnd = hwnd
　　　　PreWndProcAddress = GetWindowLong(hwnd, GWL_WNDPROC)
　　　　SetWindowLong hwnd, GWL_WNDPROC, AddressOf WndProc
　　End If
End Sub

Public Sub LimitEnd()
　　If Limit_hWnd <> 0 Then
　　　　SetWindowLong Limit_hWnd, GWL_WNDPROC, PreWndProcAddress
　　　　Limit_hWnd = 0
　　End If
End Sub

' // フォームモジュール ------------------------------------------------------

Private Sub Form_Load()
　　Dim MinX As Long, MaxX As Long
　　MinX = Me.Width / Screen.TwipsPerPixelX
　　MinY = Me.Height / Screen.TwipsPerPixelY
　　Call LimitStart(Me.hwnd, MinX, MinY)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
　　' 必ず最後に呼び出して下さい。
　　Call LimitEnd
End Sub

お礼

ありがとうございます。

Me.Enabled = False
にして、最小値を設定したらすぐにTrueに戻しています。
これで、ちらつきはなくなりました。

今回、サブクラス化は試していませんが、
時間が取れるときに、絶対試してみます。
今後のためにも。

ありがとうございました。

回答No.1

KenKen_SP

こんにちは。

Resizer というのは使ったことがありませんので分かりませんが、ドキュメントを
読めば少なくともその OCX で可能かどうかぐらいはわかるのでは？

VB では通常ご質問文にあるようなコードでフォームのサイズ制限をしますけど、
チラツキがどうしても気になるのであれば、サブクラス化するしかないと思います。

WM_GETMINMAXINFO ＋ VB 辺りで ウェブ検索すればサンプルが見つかると思います。
あまりお勧めできませんが...

お礼

ありがとうございます。

調べてみます。