مشكلة تغير شكل وحجم النموذج بعد النركيب

abosaad54 كتب:

السلام عليكم ورحمة الله وبركاته

بعد تركيب البرنامج على كمبيوترات اخرى وجدت اختلافا في حجم النموذج بل تشويها والسؤال كيف احافظ على شكل وحجم النموذج مهما تغيؤت الانظمة والاجهزة

السلام عليكم

قم بوضع هذه الأكواد كما هي في أي فورمة تريدها فتتكون الفورمة مناسبة لأي شاشة مهما حاولت أن تقوم بعملية الـ Resizing

Option Explicit
Private Type CtrlProportions
	HeightProportions As Single
	WidthProportions As Single
	TopProportions As Single
	LeftProportions As Single
End Type
Dim ProportionsArray() As CtrlProportions
Sub InitResizeArray()
	Dim I As Integer

	On Error Resume Next

	ReDim ProportionsArray(0 To Controls.Count - 1)

	For I = 0 To Controls.Count - 1
    	With ProportionsArray(I)
        	.HeightProportions = Controls(I).Height / ScaleHeight
        	.WidthProportions = Controls(I).Width / ScaleWidth
        	.TopProportions = Controls(I).Top / ScaleHeight
        	.LeftProportions = Controls(I).Left / ScaleWidth
    	End With
	Next I

End Sub
Sub ResizeControls()
	On Error Resume Next

	Dim I As Integer

	For I = 0 To Controls.Count - 1
    	With ProportionsArray(I)
        	' move and resize controls
        	Controls(I).Move .LeftProportions * ScaleWidth, _
        	.TopProportions * ScaleHeight, _
        	.WidthProportions * ScaleWidth, _
        	.HeightProportions * ScaleHeight
    	End With
	Next I

End Sub
'Form initialize event
Private Sub Form_Initialize()
	InitResizeArray

End Sub
'Form resize event
Sub Form_Resize()
	ResizeControls

End Sub

وهذا رابط مثال على ذلك

http://www.4shared.com/file/FPcXpcyv/resize_tools.html

Mady-AGC كتب:

السلام عليكم

قم بوضع هذه الأكواد كما هي في أي فورمة تريدها فتتكون الفورمة مناسبة لأي شاشة مهما حاولت أن تقوم بعملية الـ Resizing

Option Explicit
Private Type CtrlProportions
	HeightProportions As Single
	WidthProportions As Single
	TopProportions As Single
	LeftProportions As Single
End Type
Dim ProportionsArray() As CtrlProportions
Sub InitResizeArray()
	Dim I As Integer

	On Error Resume Next

	ReDim ProportionsArray(0 To Controls.Count - 1)

	For I = 0 To Controls.Count - 1
    	With ProportionsArray(I)
        	.HeightProportions = Controls(I).Height / ScaleHeight
        	.WidthProportions = Controls(I).Width / ScaleWidth
        	.TopProportions = Controls(I).Top / ScaleHeight
        	.LeftProportions = Controls(I).Left / ScaleWidth
    	End With
	Next I

End Sub
Sub ResizeControls()
	On Error Resume Next

	Dim I As Integer

	For I = 0 To Controls.Count - 1
    	With ProportionsArray(I)
        	' move and resize controls
        	Controls(I).Move .LeftProportions * ScaleWidth, _
        	.TopProportions * ScaleHeight, _
        	.WidthProportions * ScaleWidth, _
        	.HeightProportions * ScaleHeight
    	End With
	Next I

End Sub
'Form initialize event
Private Sub Form_Initialize()
	InitResizeArray

End Sub
'Form resize event
Sub Form_Resize()
	ResizeControls

End Sub

وهذا رابط مثال على ذلك

http://www.4shared.com/file/FPcXpcyv/resize_tools.html

شكرا جزيلا سأجرب