هل يمكن ايقاف او تغيير سلوك زر التصغير فى نافذة اكسس الرئيسية

[طير البحر]

هل يمكن ايقاف عمل زر التصغير فى نافذة اكسس
او تغييره سلوكه ليصبح windowrestor مثل الزر المجاور له
لا اقصد النماذج
انما نافذة تطبيق اكسس
ارجوكم هذا مهم بالنسبة لي 
حاولت عن طريق api لكن بدون نتيجة فعالة

 

[Foksh]

لا اعتقد ذلك .

[طير البحر]

Option Compare Database
Option Explicit
' ÎÇÕ ÈÇáÊÍßã Ýì ÙåæÑ æÇÎÝÇÁ ÇÒÑÇ ÇáÊßÈíÑ æÇáÊÕÛíÑ æÇáÇÛáÇÞ  ÇßÓÓ

Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nindex As Long, ByVal dwnewlong As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nindex As Long) As Long

Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_CLOSEBOX = &H80000
Private Const GWL_STYLE = (-16)
' ÎÇÕ ÈÇáÛÇÁ æÙíÝÉ ÒÑ ÇÛáÇÞ ÇßÓÓ
Public Const SC_CLOSE = &HF060
Public Const MF_BYCOMMAND = &H0

Public Declare PtrSafe Function GetSystemMenu Lib "user32" _
                                      (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare PtrSafe Function DeleteMenu Lib "user32" _
                                   (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long)

Sub DisableMinimizeButton()
    Dim hwnd As Long
    Dim M As Long

    hwnd = Application.hWndAccessApp
    M = GetWindowLong(hwnd, GWL_STYLE)
    M = M And Not WS_MINIMIZEBOX
    Call SetWindowLong(hwnd, GWL_STYLE, M)
End Sub

Sub RestoreMinimizeButton()
    Dim hwnd As Long
    Dim M As Long

    hwnd = Application.hWndAccessApp
    M = GetWindowLong(hwnd, GWL_STYLE)
    M = M Or WS_MINIMIZEBOX
    Call SetWindowLong(hwnd, GWL_STYLE, M)
End Sub
'----------------------------------------------------------------------------------------
' الكود الخاص بالغاء وظيفة زر اغلاق اكسس واستعادته ضعه فى حدث فتح النموذج الرئيسي او حيثما شئت

Sub DisableCloseButtonfunction()

Dim hwnd As Long

Const SC_CLOSE = &HF060
Const MF_BYCOMMAND = &H0

 hwnd = Application.hWndAccessApp
    Dim hMenu As Long
    hMenu = GetSystemMenu(hwnd, 0&)
    If hMenu Then
     DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND  'Disable the Close button ááÇáÛÇÁ
        '   DrawMenuBar (hwnd) 'Repaint the MenuBar ááÊÔÛíá
    End If
    End Sub
    
    Sub enableCloseButtonfunction()
Dim hwnd As Long

Const SC_CLOSE = &HF060
Const MF_BYCOMMAND = &H0

 hwnd = Application.hWndAccessApp
    Dim hMenu As Long
    hMenu = GetSystemMenu(hwnd, 0&)
    If hMenu Then
     '   DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND  'Disable the Close button ááÇáÛÇÁ
        DrawMenuBar (hwnd) 'Repaint the MenuBar ááÊÔÛíá
    End If
    End Sub

'-----------------------------------------------------------------------------------------------

هذا هو الحل للفائده 

[Foksh]

عمل جيد أخي @طير البحر  

ودعماً لمحاولتك ، هذا الجزء الخاص بزر RestoreDown

Sub DisableRestoreDownButton()
    Dim hwnd As Long
    Dim M As Long

    hwnd = Application.hWndAccessApp
    M = GetWindowLong(hwnd, GWL_STYLE)
    M = M And Not WS_MAXIMIZEBOX
    Call SetWindowLong(hwnd, GWL_STYLE, M)
End Sub

Sub RestoreRestoreDownButton()
    Dim hwnd As Long
    Dim M As Long

    hwnd = Application.hWndAccessApp
    M = GetWindowLong(hwnd, GWL_STYLE)
    M = M Or WS_MAXIMIZEBOX
    Call SetWindowLong(hwnd, GWL_STYLE, M)
End Sub

بعد إذنك لاحظت وجود خطأ في الجزء المسؤول عن أعادة تفعيل زر اغلاق الآكسيس :-

أرجو التعديل من هذا الجزء 

    Sub enableCloseButtonfunction()
Dim hwnd As Long

Const SC_CLOSE = &HF060
Const MF_BYCOMMAND = &H0

 hwnd = Application.hWndAccessApp
    Dim hMenu As Long
    hMenu = GetSystemMenu(hwnd, 0&)
    If hMenu Then
     '   DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND  'Disable the Close button ááÇáÛÇÁ
        DrawMenuBar (hwnd) 'Repaint the MenuBar ááÊÔÛíá
    End If
    End Sub

إلى هذا الجزء

    Sub enableCloseButtonfunction()
Dim hwnd As Long

Const SC_CLOSE = &HF060
Const MF_BYCOMMAND = &H0

 hwnd = Application.hWndAccessApp
    Dim hMenu As Long
    hMenu = GetSystemMenu(hwnd, 1&)
    If hMenu Then
        DrawMenuBar (hwnd)
    End If
    End Sub

 

تم تعديل April 22 بواسطه Foksh
إضافة كود

[طير البحر]

8 minutes ago, Foksh said:

عمل جيد أخي @طير البحر  

ودعماً لمحاولتك ، هذا الجزء الخاص بزر RestoreDown

Sub DisableRestoreDownButton()
    Dim hwnd As Long
    Dim M As Long

    hwnd = Application.hWndAccessApp
    M = GetWindowLong(hwnd, GWL_STYLE)
    M = M And Not WS_MAXIMIZEBOX
    Call SetWindowLong(hwnd, GWL_STYLE, M)
End Sub

Sub RestoreRestoreDownButton()
    Dim hwnd As Long
    Dim M As Long

    hwnd = Application.hWndAccessApp
    M = GetWindowLong(hwnd, GWL_STYLE)
    M = M Or WS_MAXIMIZEBOX
    Call SetWindowLong(hwnd, GWL_STYLE, M)
End Sub

بعد إذنك لاحظت وجود خطأ في الجزء المسؤول عن أعادة تفعيل زر اغلاق الآكسيس :-

أرجو التعديل من هذا الجزء 

    Sub enableCloseButtonfunction()
Dim hwnd As Long

Const SC_CLOSE = &HF060
Const MF_BYCOMMAND = &H0

 hwnd = Application.hWndAccessApp
    Dim hMenu As Long
    hMenu = GetSystemMenu(hwnd, 0&)
    If hMenu Then
     '   DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND  'Disable the Close button ááÇáÛÇÁ
        DrawMenuBar (hwnd) 'Repaint the MenuBar ááÊÔÛíá
    End If
    End Sub

إلى هذا الجزء

    Sub enableCloseButtonfunction()
Dim hwnd As Long

Const SC_CLOSE = &HF060
Const MF_BYCOMMAND = &H0

 hwnd = Application.hWndAccessApp
    Dim hMenu As Long
    hMenu = GetSystemMenu(hwnd, 1&)
    If hMenu Then
        DrawMenuBar (hwnd)
    End If
    End Sub

 

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

تم تعديل April 22 بواسطه طير البحر

[Foksh]

3 دقائق مضت, طير البحر said:

ملاحظتك صحيحة لكن السطر الذي تشير اليه معطل

😉

اقصد هذا السطر يا صديقي

hMenu = GetSystemMenu(hwnd, 1&)

 

[طير البحر]

2 minutes ago, Foksh said:

😉

اقصد هذا السطر يا صديقي

hMenu = GetSystemMenu(hwnd, 1&)

 

تسلم