الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

مقاس الشاشة

مغلق
بدأه ريم السعودية في 8 سبتمبر 2007 · 9 رد · 1,377 مشاهدة · في قواعد بيانات Microsoft Access
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

عملت برنامج على جهاز محمول 15 بوصة وعندما قمت بنسخ البرنامج على جهاز محمول حجم الشاشة 14 بوصة لم تضهر الشاشة كاملة نصف شاشة بعض الايقونات غير ظاهر

كيف اضبط البرنامج على مقاس شاشة 14 بوصة واقل اواكبر

#2

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

أخت ريم .. اعملي الأتي

1 - أضيفي لبرنامجك modules جديد اسمه modResizeForm

انسخي هذا الكود الطويل نوعا ما للمودويل

Option Compare Database
Option Explicit
Private Const DESIGN_HORZRES As Long = 1024
Private Const DESIGN_VERTRES As Long = 768
Private Const DESIGN_PIXELS As Long = 96

Private Const WM_HORZRES As Long = 8
Private Const WM_VERTRES As Long = 10
Private Const WM_LOGPIXELSX As Long = 88
Private Const TITLEBAR_PIXELS As Long = 18
Private Const COMMANDBAR_PIXELS As Long = 26
Private Const COMMANDBAR_LEFT As Long = 0
Private Const COMMANDBAR_TOP As Long = 1
Private OrigWindow As tWindow

Private Type tRect
	left As Long
	Top As Long
	right As Long
	bottom As Long
End Type

Private Type tDisplay
	Height As Long
	Width As Long
	DPI As Long
End Type

Private Type tWindow
	Height As Long
	Width As Long
End Type

Private Type tControl
	Name As String
	Height As Long
	Width As Long
	Top As Long
	left As Long
End Type


Private Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" _
() As Long

Private Declare Function WM_apiGetDC Lib "user32" Alias "GetDC" _
(ByVal hwnd As Long) As Long

Private Declare Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" _
(ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function WM_apiGetWindowRect Lib "user32.dll" Alias "GetWindowRect" _
(ByVal hwnd As Long, lpRect As tRect) As Long

Private Declare Function WM_apiMoveWindow Lib "user32.dll" Alias "MoveWindow" _
(ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Private Declare Function WM_apiIsZoomed Lib "user32.dll" Alias "IsZoomed" _
(ByVal hwnd As Long) As Long

Private Function getScreenResolution() As tDisplay

Dim hDCcaps As Long
Dim lngRtn As Long

On Error Resume Next

	hDCcaps = WM_apiGetDC(0)
	With getScreenResolution
		.Height = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)
		.Width = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)
		.DPI = WM_apiGetDeviceCaps(hDCcaps, WM_LOGPIXELSX)
	End With
	lngRtn = WM_apiReleaseDC(0, hDCcaps)

End Function

Private Function getFactor(blnVert As Boolean) As Single

Dim sngFactorP As Single

On Error Resume Next

	If getScreenResolution.DPI <> 0 Then
		sngFactorP = DESIGN_PIXELS / getScreenResolution.DPI
	Else
		sngFactorP = 1
	End If
	If blnVert Then
		getFactor = (getScreenResolution.Height / DESIGN_VERTRES) * sngFactorP
	Else
		getFactor = (getScreenResolution.Width / DESIGN_HORZRES) * sngFactorP
	End If

End Function

Public Sub ReSizeForm(ByVal frm As Access.Form)

Dim rectWindow As tRect
Dim lngWidth As Long
Dim lngHeight As Long
Dim sngVertFactor As Single
Dim sngHorzFactor As Single
Dim sngFontFactor As Single

On Error Resume Next

	sngVertFactor = getFactor(True)
	sngHorzFactor = getFactor(False)

	sngFontFactor = VBA.IIf(sngHorzFactor < sngVertFactor, sngHorzFactor, sngVertFactor)
	Resize sngVertFactor, sngHorzFactor, sngFontFactor, frm
	If WM_apiIsZoomed(frm.hwnd) = 0 Then
		Access.DoCmd.RunCommand acCmdAppMaximize

		Call WM_apiGetWindowRect(frm.hwnd, rectWindow)

		With rectWindow
			lngWidth = .right - .left
			lngHeight = .bottom - .Top
		End With

		If frm.Parent.Name = VBA.vbNullString Then
			Call WM_apiMoveWindow(frm.hwnd, ((getScreenResolution.Width - _
			(sngHorzFactor * lngWidth)) / 2) - getLeftOffset, _
			((getScreenResolution.Height - (sngVertFactor * lngHeight)) / 2) - _
			getTopOffset, lngWidth * sngHorzFactor, lngHeight * sngVertFactor, 1)
		End If
	End If
	Set frm = Nothing

End Sub

Private Sub Resize(sngVertFactor As Single, sngHorzFactor As Single, sngFontFactor As _
Single, ByVal frm As Access.Form)

Dim ctl As Access.Control
Dim arrCtls() As tControl
Dim lngI As Long
Dim lngJ As Long
Dim lngWidth As Long
Dim lngHeaderHeight As Long
Dim lngDetailHeight As Long
Dim lngFooterHeight As Long
Dim blnHeaderVisible As Boolean
Dim blnDetailVisible As Boolean
Dim blnFooterVisible As Boolean
Const FORM_MAX As Long = 31680

On Error Resume Next

	With frm
		.Painting = False
		lngWidth = .Width * sngHorzFactor
		lngHeaderHeight = .Section(Access.acHeader).Height * sngVertFactor
		lngDetailHeight = .Section(Access.acDetail).Height * sngVertFactor
		lngFooterHeight = .Section(Access.acFooter).Height * sngVertFactor

		.Width = FORM_MAX
		.Section(Access.acHeader).Height = FORM_MAX
		.Section(Access.acDetail).Height = FORM_MAX
		.Section(Access.acFooter).Height = FORM_MAX

		blnHeaderVisible = .Section(Access.acHeader).Visible
		blnDetailVisible = .Section(Access.acDetail).Visible
		blnFooterVisible = .Section(Access.acFooter).Visible
		.Section(Access.acHeader).Visible = False
		.Section(Access.acDetail).Visible = False
		.Section(Access.acFooter).Visible = False
	End With
	ReDim arrCtls(0)
	For Each ctl In frm.Controls
		If ((ctl.ControlType = Access.acTabCtl) Or _
		(ctl.ControlType = Access.acOptionGroup)) Then
			With arrCtls(lngI)
				.Name = ctl.Name
				.Height = ctl.Height
				.Width = ctl.Width
				.Top = ctl.Top
				.left = ctl.left
			End With
			lngI = lngI + 1
			ReDim Preserve arrCtls(lngI)
		End If
	Next ctl

	For Each ctl In frm.Controls
		If ctl.ControlType <> Access.acPage Then
			With ctl
				.Height = .Height * sngVertFactor
				.left = .left * sngHorzFactor
				.Top = .Top * sngVertFactor
				.Width = .Width * sngHorzFactor
				.FontSize = .FontSize * sngFontFactor

				Select Case .ControlType
					Case Access.acListBox
						.ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor)
					Case Access.acComboBox
						.ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor)
						.ListWidth = .ListWidth * sngHorzFactor
					Case Access.acTabCtl
						.TabFixedWidth = .TabFixedWidth * sngHorzFactor
						.TabFixedHeight = .TabFixedHeight * sngVertFactor
				End Select

			End With
		End If
	Next ctl

	For lngJ = 0 To lngI
		With frm.Controls.Item(arrCtls(lngJ).Name)
			.left = arrCtls(lngJ).left * sngHorzFactor
			.Top = arrCtls(lngJ).Top * sngVertFactor
			.Height = arrCtls(lngJ).Height * sngVertFactor
			.Width = arrCtls(lngJ).Width * sngHorzFactor
		End With
	Next lngJ
	With frm
		.Width = lngWidth
		.Section(Access.acHeader).Height = lngHeaderHeight
		.Section(Access.acDetail).Height = lngDetailHeight
		.Section(Access.acFooter).Height = lngFooterHeight
		.Section(Access.acHeader).Visible = blnHeaderVisible
		.Section(Access.acDetail).Visible = blnDetailVisible
		.Section(Access.acFooter).Visible = blnFooterVisible
		.Painting = True
	End With
	Erase arrCtls
	Set ctl = Nothing

End Sub

Private Function getTopOffset() As Long

Dim cmdBar As Object
Dim lngI As Long

On Error GoTo err

	 For Each cmdBar In Application.CommandBars
		If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_TOP)) Then
			lngI = lngI + 1
		End If
	 Next cmdBar
	 getTopOffset = (TITLEBAR_PIXELS + (lngI * COMMANDBAR_PIXELS))

exit_fun:
	Exit Function

err:
	getTopOffset = TITLEBAR_PIXELS + COMMANDBAR_PIXELS
	Resume exit_fun

End Function

Private Function getLeftOffset() As Long

Dim cmdBar As Object
Dim lngI As Long

On Error GoTo err

	 For Each cmdBar In Application.CommandBars
		If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_LEFT)) Then
			lngI = lngI + 1
		End If
	 Next cmdBar
	 getLeftOffset = (lngI * COMMANDBAR_PIXELS)

exit_fun:
	Exit Function

err:
	getLeftOffset = 0
	Resume exit_fun

End Function

Private Function adjustColumnWidths(strColumnWidths As String, sngFactor As Single) As String
On Error GoTo Err_adjustColumnWidths

Dim astrColumnWidths() As String
Dim strTemp As String
Dim lngI As Long
Dim lngJ As Long

	ReDim astrColumnWidths(0)
	For lngI = 1 To VBA.Len(strColumnWidths)
		Select Case VBA.Mid(strColumnWidths, lngI, 1)
			Case Is <> ";"
				astrColumnWidths(lngJ) = astrColumnWidths(lngJ) & VBA.Mid( _
				strColumnWidths, lngI, 1)
			Case ";"
				lngJ = lngJ + 1
				ReDim Preserve astrColumnWidths(lngJ)
		End Select
	Next lngI
	lngI = 0
	strTemp = VBA.vbNullString
	Do Until lngI > UBound(astrColumnWidths)
		If Not IsNull(astrColumnWidths(lngI)) And astrColumnWidths(lngI) <> "" Then
			strTemp = strTemp & CSng(astrColumnWidths(lngI)) * sngFactor & ";"
		End If
		lngI = lngI + 1
	Loop
	adjustColumnWidths = strTemp
	Erase astrColumnWidths

Exit_adjustColumnWidths:
	On Error Resume Next
	Exit Function

Err_adjustColumnWidths:
	Erase astrColumnWidths 'Destroy array.
	Resume Exit_adjustColumnWidths

End Function

Public Sub getOrigWindow(frm As Access.Form)

On Error Resume Next

	OrigWindow.Height = frm.WindowHeight
	OrigWindow.Width = frm.WindowWidth

End Sub

Public Sub RestoreWindow()

On Error Resume Next

	Access.DoCmd.MoveSize , , OrigWindow.Width, OrigWindow.Height
	Access.DoCmd.Save

End Sub

مع مراعاة تغيير المتغيرين DESIGN_HORZRES و DESIGN_VERTRES

الواردة في أعلا المودويل لمقاس الشاشة التي صمم بها البرنامج أصلا وهي هنا بالبكسل

وفي الفورم - عند حدث فتح ضعي هذا الكود

ReSizeForm Me

في كل فورم من البرنامج وهي استدعاء لوظيفة التحجيم ...... إن شاء الله يسير كل شيء معاك تمام التمام

واليك المثال المرفق بما سبق .. أجري التجربة عليه تلاحظين أنه يناسب جميع المقاسات

أو بالاصح يكيف حجمه مع مقاس الشاشة ....... والسلام

أخوك / EKSEER

ReSizeForm.rar

تم تعديل هذه المشاركة بواسطة ekseer في 8 سبتمبر 2007 في 19:53

#3

مشكور اخي حل اكثر من رائع

10000شكر

لكن عند استفسار لكي تتضح الصورة عندي

1- كيف عدل المتغيرات لتناسب مقاس شاشة محمول 14 بوصة كم المتغيرات التي اضعها في المتغير

2- بعد تعديل المتغيرات للتناسب مع 14 بوصة هل سوف تتناسب مع باقي مقاس الشاشات الاخري 15 و 17

3- هل هناك فرق بين شاشة المحمول والشاشات المسطحة و الشاشات غير المسطحة هل سوف يتناسب التعديل معها

#4

أشكرك أخي إكسير على هذا الموضوع الجميل .... :)

لدي سؤال أرجو الإجابة عليه ...

أنا أريد أن يتم تحجيم الفورم حسب ال Resolution للشاشة ... فهل يمكن استدعاؤه بالكود ووضعه في المتغيرين DESIGN_HORZRES و DESIGN_VERTRES ؟

تم تعديل هذه المشاركة بواسطة Dream_Works في 9 سبتمبر 2007 في 11:37

200px-Dreamworks.jpg
#5

زاد الله من علمه وفضله أخي إكسير على هذا الموضوع الهام .

ابو آلاء كتب:
زادك الله من علمه وفضله أخي إكسير على هذا الموضوع الهام .
#6

بارك الله فيك اخي اكسير مثال جميل جدا

اخي الفاضل Dream_Works

اليك ما طلبت

zaChangeResolution2006.rar

مواضيع ذات صلة

اعادة تحجيم النماذج

/index.php?showtopic=110309

تغيير دقة الشاشة اذا كانت مخالفة

/index.php?showtopic=134307

post-15367-087183200%201340344597.gif

بعض من المواضيــع الممـيزه

post-15367-027053900%201340345097.gif

#7

روووووووووعة ....

الله يعطيكِ العافية يا أستاذة .... ملفات كهذه يمكن الاحتفاظ بها كمراجع ... (h)

200px-Dreamworks.jpg
#8

مشكور اخي حل اكثر من رائع

10000شكر

لكن عند استفسار لكي تتضح الصورة عندي

1- كيف عدل المتغيرات لتناسب مقاس شاشة محمول 14 بوصة كم المتغيرات التي اضعها في المتغير

2- بعد تعديل المتغيرات للتناسب مع 14 بوصة هل سوف تتناسب مع باقي مقاس الشاشات الاخري 15 و 17

3- هل هناك فرق بين شاشة المحمول والشاشات المسطحة و الشاشات غير المسطحة هل سوف يتناسب التعديل معها

#9

الاخت الفاضلة / السلام عليكم ورحمة الله

التساؤل الأول /

المقصود بتغير قيم المتغيرين المشار اليهما في الموديويل

هو باختصار ( دقة الشاشة ) وليس طولها أو مقاسها وللوصول لدقة الشاشة

أذهبي لأي مكان فارغ على سطح المكتب أنقري زر الماوس اليمين تظهر لك قائمة منسدلة

أختاري خصائص سيظهر لك مربع الحوار خصائص العرض اذهبي لإعدادات وفيها تظهر لك ذقة الشاشة مثل الارقام التالية :

1024 × 768

640 × 480

800×600

1152 864

وغيرها بالطبع - المطلوب أن تضبطي المتغيرين في المودويل على حسب الجهاز والدقة التي صممتي بها البرنامج أصلا فقط

التساؤل الثاني والثالث / نعم سيضبط حجمه على جميع أجهزة العرض إن شاء الله ولا أعتقد أن هناك فرق بين شاشة المحمول والشاشات الاخرى

فيما يتعلق بدقة العرض ..... أي أن الفورم سيضبط حجمه على جميع أجهزة العرض إن شاء الله

ekseer

#10

مشكور دائما نجد عند الحلول 10000000 شكر

هذا الموضوع مغلق.

مواضيع مشابهة