اعادة تحجيم الفورم وكل المحتويات

[gavan]

مرحبا بكم من جديد 

لقد قمت بتكوين برنامج بسيط ولكن صادفنى مشكلة غريبة بعض الشيء , عند نقل البرنامج من جهاز حجم شاشته 15.6 اي الريزليوشن 768*1366 -- الى جهاز شاشته اكبر 22 انج اي الريزليوشن  1080*1920

يتغير حجم محتويات بعض النماذج و يحصل فيه تداخلات , و البعض الاخر يبقى كما هو ,مع العلم انى اخذت موديول لاعادة التحجيم في حدث onLoad ووضعت الامر resizeform 1366*768 في كلا النموذجين , وعندما اقوم بتحويل resizeform 1366*768 الى resizeform 1920*1080 بدون maximize يحل المشكلة ولكن لا يملى الشاشة

في المثال المرفق نموذج Welcom ثابت في جميع الشاشات , و النموذج EditeEmployer يحدث به مشاكل في الجهاز الشاشة الكبيرة ,فهل يوجد تفسير وشكرا لكم

120.accdb

[Foksh]

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

 

وهذه بعض المواضيع التي تتحدث عن نفس طلبك في منتدانا 😊 .

الموضوع الأول

الموضوع الثاني

[kkhalifa1960]

تفضل أخي هذا حل سريع كما بالصورة .

[safaa salem5]

اتفضل

ممكن تدينى افضل اجابه

😜😄

120.accdb

[gavan]

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

[safaa salem5]

5 hours ago, gavan said:

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

😊فى همزه سقطت من حضرتك من أسمى

وبعدين كدا طلب حضرتك اختلف اعمل موضوع جديد والأساتذة الافاضل هيردو على حضرتك 

[gavan]

الاخت صفاء كل التحية الك ، بس بعد التجربة لم احصل على المطلوب ،حيث كل النماذج اصبحت اكثر خربطة من المحتويات ، ارفق لكي صورة من الشاشة ، تحياتي

[Eng.Qassim]

اعتقد المشكلة لديك في ال Anchor

حاول ان تطبق فكرة الاستاذ @kkhalifa1960

[gavan]

مرحبا بكم من جديد , ولكي لا اطول عليكم بالكلام لقد قمت بالتالي 

في المثال في اول مشاركة يوجد وحدة نمطية باسم Resize يتم استدعائها من الفورم في حدث OnLoad

لقد قمت بالكثير من المحاولات لكي اطبق تحويل البرنامج من شاشات الابتوب قياس 15.6 بدقة 1366* 768 الى كومبيوترات ذات شاشات اكبر مقاسا 23 او 24 انج بدقة 1920*1080 ولا يحدث فيه اي تداخل في محتويات النموذج او النموذج ككل ولكني وصلت الى فكرة جيدة ارجوا من الكل ممن يعانون في مثل هذه المشاكل وبكل بساطة قمت بالاتي:

تحديد جميع محتويات النموذج و من ثم الارتساء Anchor الى Top Left 

ومن ثم من حدث OnLoad للفورم استدعي الدالة resizeform 1366*768 ومن ثم تحتها Docmd.maximize ,, ستكون النتائج مذهلة جرب و ادعيلي

تحياتي لكم يالغوالي

[ابوخليل]

في 21‏/12‏/2023 at 23:12, gavan said:

ومن ثم من حدث OnLoad للفورم استدعي الدالة resizeform 1366*768 ومن ثم تحتها Docmd.maximize ,, ستكون النتائج مذهلة جرب و ادعيلي

جزاك الله خير

ولكن لما تنقل البرنامج الى جهاز آخر تختلف دقة اشاشة فيه فأنت مضطر للدخول وتغيير الارقام

لنفرض انك بعثت البرنامج لشخص آخر

لذا الافضل ان نجعل البرنامج يغير الارقام آليا بناء على دقة شاشة الجهاز الجديد

استبدل كودك بهذا :

resizefrom Me, DisplaySize(0), DisplaySize(1)

 

[gavan]

استاذي القدير، تحية طيبة، و الف شكر على معلوماتك القيمة جدا، حبيت أوضح فكرة، فانا طبقت الفكرة على جهازين الأول لابتوب حجمه ستاندر 15.6, والثاني ديسكتوب حجمه، ٢٤، وكانت النتائج مذهلة، ف بالنسبة إلى فكرتك ساطبقها اكيد لان ستكون بها نتائج مذهله، و بالتالي سنضطر إلى شرح النتائج،. تحياتي يالغالي

[gavan]

في 20‏/1‏/2024 at 08:49, ابوخليل said:

جزاك الله خير

ولكن لما تنقل البرنامج الى جهاز آخر تختلف دقة اشاشة فيه فأنت مضطر للدخول وتغيير الارقام

لنفرض انك بعثت البرنامج لشخص آخر

لذا الافضل ان نجعل البرنامج يغير الارقام آليا بناء على دقة شاشة الجهاز الجديد

استبدل كودك بهذا :

resizefrom Me, DisplaySize(0), DisplaySize(1)

 

استاذنا القدير ابو خليل لك كل التحية ولكل الأعضاء الكرام في هذا الصرح الرائع 🌹🌹

صح عندما اعطي البرنامج إلى شخص آخر يتغير المقاسات لبعض النماذج والبعض لا، وبالتالي ارجع لإدخال الأرقام من جديد

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

[abouelhassan]

نحتاج هذا الموضوع 

[Foksh]

انا عن نفسي قمت باستخدام مشاركة الأخت @safaa salem5 في هذه المشاركة والأمر ناجح معي بنسبة 99% 

[gavan]

طار الموضوع من فكري ههههههههه خربطت لقد قمت بتجربة (لا اعرف صح ولا طبقتها بشكل خاطئ) اتمنى ان تشاركوني بها يا حبايبي 

لقد قمت بتكوين موديول Resize وهو 

Option Compare Database

Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Function resizefrom(frm As Form, bestw As Integer, besth As Integer)

On Error Resume Next

wrate = DisplaySize(0) / bestw

hrate = DisplaySize(1) / besth

frm.InsideWidth = frm.InsideWidth * wrate

frm.InsideHeight = frm.InsideHeight * hrate

Dim fc As Control

For Each fc In frm.Controls

fc.Top = fc.Top * hrate

fc.Left = fc.Left * wrate

fc.Width = fc.Width * wrate

fc.Height = fc.Height * hrate

fc.FontSize = fc.FontSize * wrate

Next

End Function

و استدعيتها من الفورم عند التحميل هكذا 

resizefrom Me, DisplaySize(0), DisplaySize(1)
DoCmd.Maximize

الامر الى الان طبيعي عند دقة الشاشة 1336*768.

عندما اغير دقة الشاشة الى 800*600 هنا تبدا المعركة (على فرض انني اعطيت البرنامج الى شخص اخر شاشته 600*800)

يتغير محتويات الفورم كما في الصورة ادناه.

اليس من المفروض يتوسط و يتحجم كل المحتويات في الفورم حسب الدقة الجديدة 600*800 ؟؟ ام انا مخطئ ,تحياتي لكم 

 

[Foksh]

12 دقائق مضت, gavan said:

اليس من المفروض يتوسط و يتحجم كل المحتويات في الفورم حسب الدقة الجديدة 600*800 ؟؟ ام انا مخطئ ,تحياتي لكم 

 

هنا المشكلة يا صديقي ، تكمن في اختلاف الدقة من كمبيوتر إلى آخر ,, على العموم مشكور على المحاولة اللطيفة ,,
 

بعد تجربته على ملف خاص كانت نسبة النجاح في تحقيق الهدف 85% مقارنة مع الكود الذي أشرت إليه سابقاً ..

[gavan]

مرحبا بالغوالي و لعى راسهم الاخ Foksh الحبيب والله 

اخي الحبيب انا لم اقم بتجربة فقط ,بل قمت بالكثير منها على سبيل المثال , قمت باستدعاء الدالة من الفورم عند التحميل بهذا الشكل 

resizefrom Me, 1366, 768 
DoCmd.Maximize

في كومبوتر شاشة 24 انج اعتقد الرزيليوشن 1950*1443 يعني دقة عالية 

كانت النتائج مذهلة وكانك بكل المقاييس توسيط و تحجيم و كل شيئ , ولكن فجأة عند غلق النموذج و فتحه تضاعف حجم المحتويات واصبح غير مرتب ,

قمت بعدها بحذف دالة الاستدعاء resizefrom Me, 1366, 768  ,,,, وابقيت فقط على DoCmd.Maximize اصبحت النتائج جيدة وكانني قمت بالتصيميم على ذلك الكومبيوتر 24 انج ابو الريزليوشن  1950*1443 , فهل من تفسير ؟؟؟ ولك مني اجمل سلام 

[Foksh]

4 دقائق مضت, gavan said:

1366, 768

موضوع تحديد القياسات مشكلة عند تحديدها ,, اقرأ هذا الموضوع قد يفيدك لأخونا @طير البحر ..

 

[ابو جودي]

يمكنكم الاطلاع على هذا المرفق 

 

https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=129345

[gavan]

اخي ابو جودي تحية طيبة

هل بالامكان تحويل الكود الى موديول و استدعائها من قبل النموذج اكون شاكرا لك 

[gavan]

يا جماعة الخير السلام عليكم 

مو راضيين نخلص السالفة الا ما نوصل لحل ,هههههههههه تحياتي الكم يالغاليين في هذا الملتقى الرائع

اخوتي من خلال تجربتي على تحجيم النماذج و كيفية التخلص من مشكلة تغير مقاس الشاشات وصلت الى النتائج التالية :

من خلال الوحدة النمطية هذه 

Option Compare Database

Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Function resizefrom(frm As Form, bestw As Integer, besth As Integer)

On Error Resume Next

wrate = DisplaySize(0) / bestw

hrate = DisplaySize(1) / besth

frm.InsideWidth = frm.InsideWidth * wrate

frm.InsideHeight = frm.InsideHeight * hrate

Dim fc As Control

For Each fc In frm.Controls

fc.Top = fc.Top * hrate

fc.Left = fc.Left * wrate

fc.Width = fc.Width * wrate

fc.Height = fc.Height * hrate

fc.FontSize = fc.FontSize * wrate

Next

End Function

واستدعائها من خلال النموذج عند التحميل بالشكل الاتي :

resizefrom Me, 1366, 768 
DoCmd.Maximize

نحصل على ناتئج جيدة جدا سواء في مقاس (600*800) او (1024*768) او (1280*720) او (1366*768) حيث تم تصميم البرنامج على اخر مقاس وهو (1366*768)

ونتوصل هنا الى شيء مفاده ان:

1-بهذه الوحدة النمطية

2-وتصميم على مقاس (1366*768) 

3- واستدعائها بهذه الطريقة المذكورة

من هذا القياس و الى القياسات الاصغر لاتوجد اي مشاكل و البرنامج يعمل بشكل ممتاز , فقط يجب ملاحظة انه النماذج التي لا تحصل على تكبير كامل للشاشة (DoCmd.Maximize) , يجب ان تحتوي على استدعاء هكذا (resizefrom Me, 1366, 768 ) لكي تحصل على افضل النتائج .

هذة الفكرة انقلها لكم من خلال تجربتي الشخصية و الحصول على نتائج جيدة , ارجوا نشر الموضوع ليستفيد منه اكبر عدد من الاعظاء في حال تم تجربته من قبل اعظاء المنتدى الرائع❤️

[Foksh]

1 ساعه مضت, gavan said:

resizefrom Me, 1366, 768 

نعود هنا لنقطة النقاش والمعضلة ..

وهي أنك كمصمم للبرنامج ستكون ملزم بتحديد القياسات ( حجم الشاشة ) !! وهذا الأمر إلى حد ما منافٍ للمنطق والمعقول .

حاول بلورة الموضوع من خلال ان تجعل الفورم يتعرف على قياسات الشاشة بشكل تلقائي وديناميكي ،،

سأدلك على موضوع لي سابق كنت قد توجهت به إلى طريقة للتعرف على قياسات الشاشة بشكل تلقائي في هذا الموضوع 😉 .

[ابو جودي]

20 ساعات مضت, gavan said:

اخي ابو جودي تحية طيبة

هل بالامكان تحويل الكود الى موديول و استدعائها من قبل النموذج اكون شاكرا لك 

تدلل

انشئ موديول واعطه مثلا الاسم basResizeControls وضع به الكود الاتى 

Option Compare Database
Option Explicit

' Constants
Const FONT_ZOOM_PERCENT_CHANGE As Double = 0.1 ' Percentage change for font zoom

' Variables
Private fontZoom As Double ' Current font zoom level
Private ctrlKeyIsPressed As Boolean ' Flag to indicate if the Ctrl key is pressed

' Enum to represent control tag indices
Private Enum ControlTag
    FromLeft = 0
    FromTop
    ControlWidth
    ControlHeight
    OriginalFontSize
    OriginalControlHeight
End Enum

' Log error message to debug or a specified location
Private Sub LogError(errMsg As String)
    ' Modify this part to log errors as needed, e.g., in a table or text file
    Debug.Print "Error: " & errMsg
End Sub

' Save control positions to their Tag properties
Public Sub SaveControlPositionsToTags(frm As Form)
    On Error GoTo ErrorHandler

    Dim ctl As Control
    Dim ctlLeft As String
    Dim ctlTop As String
    Dim ctlWidth As String
    Dim ctlHeight As String
    Dim ctlOriginalFontSize As String
    Dim ctlOriginalControlHeight As String

    For Each ctl In frm.Controls
        ctlLeft = CStr(Round(ctl.Left / frm.Width, 2)) ' Calculate relative left position
        ctlTop = CStr(Round(ctl.Top / frm.Section(ctl.Section).Height, 2)) ' Calculate relative top position
        ctlWidth = CStr(Round(ctl.Width / frm.Width, 2)) ' Calculate relative width
        ctlHeight = CStr(Round(ctl.Height / frm.Section(ctl.Section).Height, 2)) ' Calculate relative height

        ' Capture original font size and control height for specific control types
        Select Case ctl.ControlType
            Case acLabel, acCommandButton, acTextBox, acComboBox, acListBox, acTabCtl, acToggleButton
                ctlOriginalFontSize = ctl.FontSize
                ctlOriginalControlHeight = ctl.Height
        End Select

        ' Store the calculated values in the Tag property
        ctl.Tag = ctlLeft & ":" & ctlTop & ":" & ctlWidth & ":" & ctlHeight & ":" & ctlOriginalFontSize & ":" & ctlOriginalControlHeight
    Next

    ' Store proportional heights for header and footer sections
    frm.Section(acHeader).Tag = CStr(Round(frm.Section(acHeader).Height / (frm.Section(acHeader).Height + frm.Section(acDetail).Height + frm.Section(acFooter).Height), 2))
    frm.Section(acFooter).Tag = CStr(Round(frm.Section(acFooter).Height / (frm.Section(acHeader).Height + frm.Section(acDetail).Height + frm.Section(acFooter).Height), 2))

    Exit Sub

ErrorHandler:
    LogError "SaveControlPositionsToTags: " & Err.Description
    Resume Next
End Sub

' Reposition controls based on their stored Tag properties and current font zoom
Public Sub RepositionControls(frm As Form, fontZoom As Double)
    On Error GoTo ErrorHandler

    Dim formDetailHeight As Long
    Dim tagArray() As String

    ' Calculate the detail section height
    formDetailHeight = frm.WindowHeight - frm.Section(acHeader).Height - frm.Section(acFooter).Height

    Dim ctl As Control
    For Each ctl In frm.Controls
        If ctl.Tag <> "" Then
            tagArray = Split(ctl.Tag, ":") ' Split the Tag property into an array
            If ctl.Section = acDetail Then
                ctl.Move frm.WindowWidth * CDbl(tagArray(ControlTag.FromLeft)), _
                         formDetailHeight * CDbl(tagArray(ControlTag.FromTop)), _
                         frm.WindowWidth * CDbl(tagArray(ControlTag.ControlWidth)), _
                         formDetailHeight * CDbl(tagArray(ControlTag.ControlHeight))
            Else
                ctl.Move frm.WindowWidth * CDbl(tagArray(ControlTag.FromLeft)), _
                         frm.Section(ctl.Section).Height * CDbl(tagArray(ControlTag.FromTop)), _
                         frm.WindowWidth * CDbl(tagArray(ControlTag.ControlWidth)), _
                         frm.Section(ctl.Section).Height * CDbl(tagArray(ControlTag.ControlHeight))
            End If

            ' Adjust font sizes for specific control types
            Select Case ctl.ControlType
                Case acLabel, acCommandButton, acTextBox, acComboBox, acListBox, acTabCtl, acToggleButton
                    ctl.FontSize = Round(CDbl(tagArray(ControlTag.OriginalFontSize)) * (ctl.Height / CDbl(tagArray(ControlTag.OriginalControlHeight))) * fontZoom)
            End Select
        End If
    Next

    Exit Sub

ErrorHandler:
    LogError "RepositionControls: " & Err.Description
    Resume Next
End Sub

' Initialize the form by saving control positions
Public Sub InitForm(frm As Form)
    On Error GoTo ErrorHandler

    fontZoom = 1 ' Set initial font zoom level
    SaveControlPositionsToTags frm

    Exit Sub

ErrorHandler:
    LogError "InitForm: " & Err.Description
    Resume Next
End Sub

' Handle the mouse wheel event to zoom in/out if Ctrl key is pressed
Public Sub HandleMouseWheel(frm As Form, ByVal Page As Boolean, ByVal Count As Long)
    On Error GoTo ErrorHandler

    If ctrlKeyIsPressed Then
        If Count < 0 Then
            fontZoom = fontZoom + FONT_ZOOM_PERCENT_CHANGE ' Increase font zoom
            RepositionControls frm, fontZoom
        ElseIf Count > 0 Then
            fontZoom = fontZoom - FONT_ZOOM_PERCENT_CHANGE ' Decrease font zoom
            RepositionControls frm, fontZoom
        End If
    End If

    Exit Sub

ErrorHandler:
    LogError "HandleMouseWheel: " & Err.Description
    Resume Next
End Sub

' Handle the form resize event
Public Sub HandleResize(frm As Form)
    On Error GoTo ErrorHandler

    ' Adjust header and footer heights proportionally
    frm.Section(acHeader).Height = frm.WindowHeight * CDbl(frm.Section(acHeader).Tag)
    frm.Section(acFooter).Height = frm.WindowHeight * CDbl(frm.Section(acFooter).Tag)
    RepositionControls frm, fontZoom

    Exit Sub

ErrorHandler:
    LogError "HandleResize: " & Err.Description
    Resume Next
End Sub

' Handle key up event to reset Ctrl key flag
Public Sub HandleKeyUp()
    ctrlKeyIsPressed = False
End Sub

' Handle key down event to manage font zooming with + and - keys
Public Sub HandleKeyDown(frm As Form, KeyCode As Integer, Shift As Integer)
    On Error GoTo ErrorHandler

    Dim shiftKeyPressed As Boolean
    shiftKeyPressed = (Shift And acShiftMask) > 0

    If shiftKeyPressed Then
        Select Case KeyCode
            Case vbKeyAdd
                fontZoom = fontZoom + FONT_ZOOM_PERCENT_CHANGE ' Increase font zoom
                RepositionControls frm, fontZoom
                KeyCode = 0 ' Prevent the "+" symbol from showing up in text boxes
            Case vbKeySubtract
                fontZoom = fontZoom - FONT_ZOOM_PERCENT_CHANGE ' Decrease font zoom
                RepositionControls frm, fontZoom
                KeyCode = 0 ' Prevent the "-" symbol from showing up in text boxes
        End Select
    End If

    ' Check if Ctrl key is pressed
    If (Shift And acCtrlMask) > 0 Then
        ctrlKeyIsPressed = True
    End If

    Exit Sub

ErrorHandler:
    LogError "HandleKeyDown: " & Err.Description
    Resume Next
End Sub

وفى النموذج يتم الاستدعاء من خلال
 

Private Sub Form_Load()
    Call InitForm(Me)
End Sub

Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
    Call HandleMouseWheel(Me, Page, Count)
End Sub

Private Sub Form_Resize()
    Call HandleResize(Me)
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    Call HandleKeyUp
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Call HandleKeyDown(Me, KeyCode, Shift)
End Sub

وان اردت اضافة  DoCmd.Maximize  فى الحدث Form_Load يمكنك ذلك

 

[Moosak]

2 ساعات مضت, ابو جودي said:

انشئ موديول واعطه مثلا الاسم basResizeControls وضع به الكود الاتى 

هذا يستحق المكتبة العامرة والمكتبة تستحقه 😄🌹

[gavan]

اخي الكريم ابو جودي فرغت المكتبات حتى تسع للكود هههههههه امزح اغاتي 

رفعت لك الملف حتى تستكشف ما الغلط بالموضوع , في اول الامر طلع الفورم فاظي , بعدين اشرت الى بعض الحقول و سويت بيهم  Arrange ضهروا ولكن بس خطوط , فممكن تشوف المرفق و تشرحلى لماذا حدث ذلك , تحياتي

بطريقة الاستاذ ابو جودي.accdb