كود لمنع المستخدم من تكبير وتصغير الفورمة بإستخدام حدود الفورمة

مرحبا اخي تفضل مطلوبك في المرفقات.. تحياتي

Test1.zip

ألف شكر ياأخى متمنيا لك مزيدا من التوفيق

Dim r As String
Dim e As String

Private Sub Form_Load()
r = Me.Height
e = Me.Width
End Sub

Private Sub Form_Resize()
On Error GoTo 11
If Me.Height > r Then
Me.Height = r
End If
If Me.Height < r Then
Me.Height = r
End If
If Me.Width > e Then
Me.Width = e
End If
If Me.Width < e Then
Me.Width = e
End If
11:
End Sub

اخي محمد كود جميل لكن اسمح لي بتعديل للمصلحة العامة :D

ينصح دائما بتقليل الشروط, و المتغيرات قدر المستطاع

وكلما كان الكود اصغر كان افضل

لذلك اظن ان الكود التالي اصح

اخي ارجو ان تتقبل النصيحة بصدر رحب فانا اعتبرك اخ لي

Const w = 3000
Const h = 3000

Private Sub Form_Resize()
Me.Height = w
Me.Width = h
End Sub

اخي super pro اتقبل النصيحة بصدر رحب عادي جداً ونحن اخوة هنا

بس انت ما فهمت ايش مطلوب الأخ علاء عبد الخالق هو يريد الفورمة ما تكبر ولا تصغر عن طريق سحبها من الحدود

والكود الذي اتيت به لا يفي بالغرض بعد ما تم تجريبة طبعاً ومن ناحية إختصار الكود ممكن اختصره في الشرط أدخل كلمة or فيصبح سطر واحد بدل سطرين وأف واحدة بدل أفين وايند اف واحدة بدل اند اف ثنتين بس الحقيقة كتبتها هكذا لتسهل الفهم .. تحياتي

اخي كنت اعلم انك ستتقبل نصيحتي

لكن اخي الكود يعمل 100%

وهو يقوم بنفس عمل الكود الذي ارفقته 100%

وهناك طريقة ايضا اصغر من الكودين وهي

تحديد خاص

BorderStyle = Fixed Dialog

للفورم

هلا والله بك ياأخي العزيز ممكن ترفق مثال يوضح كلامك بصراحة أنا جربت الكود تبعك ما نفع.. تحياتي

ده هيسبب Flickering فى الفورم , أستعمل أى كود من الأتنين دول , برشحلك التانى

'/////////////
'* In a form *
'/////////////

Option Explicit

Private Sub Form_Load()
	Call Hook(Me.hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
	Call Unhook(Me.hWnd)
End Sub

'////////////////////////
'* In a standard module *
'////////////////////////

Option Explicit

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 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 Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, _
																			ByVal wMsg As Long, _
																			ByVal wParam As Long, _
																			ByVal lParam As Long) _
																			As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
																	 Source As Any, _
																	 ByVal Length As Long)
Private Const GWL_WNDPROC = (-4)

Private Const WM_SIZING = &H214

Private Const WMSZ_LEFT = 1
Private Const WMSZ_RIGHT = 2
Private Const WMSZ_TOP = 3
Private Const WMSZ_TOPLEFT = 4
Private Const WMSZ_TOPRIGHT = 5
Private Const WMSZ_BOTTOM = 6
Private Const WMSZ_BOTTOMLEFT = 7
Private Const WMSZ_BOTTOMRIGHT = 8

Private Const MIN_WIDTH = 200  'The minimum width in pixels
Private Const MIN_HEIGHT = 200 'The minimum height in pixels
Private Const MAX_WIDTH = 500  'The maximum width in pixels
Private Const MAX_HEIGHT = 500 'The maximum height in pixels

Private Type RECT
	Left   As Long
	Top	As Long
	RIGHT  As Long
	Bottom As Long
End Type

Private mPrevProc As Long

Public Sub Hook(hWnd As Long)
	mPrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf NewWndProc)
End Sub

Public Sub Unhook(hWnd As Long)

	Call SetWindowLong(hWnd, GWL_WNDPROC, mPrevProc)
	mPrevProc = 0&

End Sub

Public Function NewWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next

Dim r As RECT

	If uMsg = WM_SIZING Then
		Call CopyMemory(r, ByVal lParam, Len(r))

		'Keep the form only at least as wide as MIN_WIDTH
		If (r.RIGHT - r.Left < MIN_WIDTH) Then
			Select Case wParam
				Case WMSZ_LEFT, WMSZ_BOTTOMLEFT, WMSZ_TOPLEFT
					r.Left = r.RIGHT - MIN_WIDTH
				Case WMSZ_RIGHT, WMSZ_BOTTOMRIGHT, WMSZ_TOPRIGHT
					r.RIGHT = r.Left + MIN_WIDTH
			End Select
		End If

		'Keep the form only at least as tall as MIN_HEIGHT
		If (r.Bottom - r.Top < MIN_HEIGHT) Then
			Select Case wParam
				Case WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT
					r.Top = r.Bottom - MIN_HEIGHT
				Case WMSZ_BOTTOM, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT
					r.Bottom = r.Top + MIN_HEIGHT
			End Select
		End If

		'Keep the form only as wide as MAX_WIDTH
		If (r.RIGHT - r.Left > MAX_WIDTH) Then
			Select Case wParam
				Case WMSZ_LEFT, WMSZ_BOTTOMLEFT, WMSZ_TOPLEFT
					r.Left = r.RIGHT - MAX_WIDTH
				Case WMSZ_RIGHT, WMSZ_BOTTOMRIGHT, WMSZ_TOPRIGHT
					r.RIGHT = r.Left + MAX_WIDTH
			End Select
		End If

		'Keep the form only as tall as MAX_HEIGHT
		If (r.Bottom - r.Top > MAX_HEIGHT) Then
			Select Case wParam
				Case WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT
					r.Top = r.Bottom - MAX_HEIGHT
				Case WMSZ_BOTTOM, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT
					r.Bottom = r.Top + MAX_HEIGHT
			End Select
		End If

		Call CopyMemory(ByVal lParam, r, Len(r))

		NewWndProc = 0&
		Exit Function
	End If


	If mPrevProc > 0& Then
		NewWndProc = CallWindowProc(mPrevProc, hWnd, uMsg, wParam, lParam)
	Else
		NewWndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
	End If

End Function

Option Explicit

'In a module

' Subclassing form size

' API's
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
Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, 

ByVal Length As Long)
Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex 

As Long, ByVal dwNewLong As Long) As Long

' Constants
Const WM_GETMINMAXINFO As Long = &H24
Global Const GWL_WNDPROC = (-4)

' Types
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

' misc variabels
Private SizeInfo As MINMAXINFO
Public lngOldProc As Long
Dim ResY As Long
Dim ResX As Long


Public Function SubClass_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal 

wParam As Long, ByVal lParam As Long) As Long

	If uMsg = WM_GETMINMAXINFO Then
		Call RtlMoveMemory(ByVal lParam, SizeInfo, LenB(SizeInfo)) ' Set the new size 

info for my form
	Else
		SubClass_Proc = CallWindowProc(lngOldProc, hWnd, uMsg, wParam, lParam) ' 

go on as normal if the uMsg isnt resizing
	End If

End Function
Public Sub SetMaxMin()
With SizeInfo
	' Maximised position
	  .ptMaxPosition.X = 100
	  .ptMaxPosition.Y = 100

	'Maximized size
	  .ptMaxSize.X = 640
	  .ptMaxSize.Y = 480

	'Maximum size with re-sizing
	  .ptMaxTrackSize.X = 640
	  .ptMaxTrackSize.Y = 480

	'Minimum size with re-sizing
	  .ptMinTrackSize.X = 320
	  .ptMinTrackSize.Y = 280

  End With
End Sub


'In the form
'At load
SetMaxMin
lngOldProc = SetWindowLongA(Me.hWnd, GWL_WNDPROC, AddressOf 

SubClass_Proc)

'At unload
SetWindowLongA Me.hWnd, GWL_WNDPROC, lngOldProc

تفضل اخي الكريم محمد VB

ex.rar