منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

نسخة كاملة : تعطيل MDIForm Maximized
أنت حالياً تتصفح نسخة خفيفة من المنتدى . مشاهدة نسخة كاملة مع جميع الأشكال الجمالية .
الله يرحم والديكم بغيت كود تعطيل maximize MDIForm ماابيها تكبر ابي على حجمها الي عملته انا انا استخدم 2006 فيجوال بيسك
.....

منقول


ضع هذا الكود في حدث Load الخاص بـ MDIForm
كود :
Call DisableFormResize(Me)


ضع هذا الكود في Module مستقل لوحده
كود :
Option Explicit

' API declarations
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
Private Const WS_CAPTION = &HC00000
Private Const WS_THICKFRAME = &H40000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const SC_Close As Long = &HF060&
Private Const SC_MAXIMIZE = &HF030&
Private Const SC_MINIMIZE = &HF020&
Private Const MIIM_STATE As Long = &H1&
Private Const MIIM_ID As Long = &H2&
Private Const MFS_GRAYED As Long = &H3&
Private Const WM_NCACTIVATE As Long = &H86
Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


Public Sub DisableFormResize(Frm As Form)
    'init
    Dim style As Long
    Dim hMenu As Long
    Dim MII As MENUITEMINFO
    Dim lngMenuID As Long
    Const xSC_MAXIMIZE As Long = -11

    'set window style to disable form resize
    style = GetWindowLong(Frm.hwnd, GWL_STYLE)
    
    style = style And Not WS_THICKFRAME
    style = style And Not WS_MAXIMIZEBOX
    
    'apply new window style to form
    style = SetWindowLong(Frm.hwnd, GWL_STYLE, style)
    
    'disable form's `maximize` button
    On Error Resume Next
    
    ' Retrieve a handle to the system menu
    hMenu = GetSystemMenu(Frm.hwnd, 0)
    
    ' Retrieve the menu item information for the maximize menu item/button
    With MII
        .cbSize = Len(MII)
        .dwTypeData = String(80, 0)
        .cch = Len(.dwTypeData)
        .fMask = MIIM_STATE
        .wID = SC_MAXIMIZE
    End With
    If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Sub
    
    ' Switch the ID of the menu item so that VB can not undo the action itself
    With MII
        lngMenuID = .wID
        .wID = xSC_MAXIMIZE
        .fMask = MIIM_ID
    End With
    If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then Exit Sub
    
    ' Set the enabled / disabled state of the menu item
    With MII
        .fState = (.fState Or MFS_GRAYED)
        .fMask = MIIM_STATE
    End With
    If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Sub
    
    ' Activate the non-client area of the window to update the titlebar, and
    ' draw the close button in its new state.
    SendMessage Frm.hwnd, WM_NCACTIVATE, True, 0
    
    ' this is to refresh the form
    Frm.Width = Frm.Width - 1
    Frm.Width = Frm.Width + 1
End Sub

.....
(05-07-14, 05:53 PM)vbnet كتب : [ -> ].....

منقول


ضع هذا الكود في MDIForm
كود :
Private Sub Form_Load()
    Call DisableFormResize(Me)
    
End Sub


ضع هذا الكود في Module مستقل لوحده
كود :
Option Explicit

' API declarations
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
Private Const WS_CAPTION = &HC00000
Private Const WS_THICKFRAME = &H40000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const SC_Close As Long = &HF060&
Private Const SC_MAXIMIZE = &HF030&
Private Const SC_MINIMIZE = &HF020&
Private Const MIIM_STATE As Long = &H1&
Private Const MIIM_ID As Long = &H2&
Private Const MFS_GRAYED As Long = &H3&
Private Const WM_NCACTIVATE As Long = &H86
Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


Public Sub DisableFormResize(Frm As Form)
    'init
    Dim style As Long
    Dim hMenu As Long
    Dim MII As MENUITEMINFO
    Dim lngMenuID As Long
    Const xSC_MAXIMIZE As Long = -11

    'set window style to disable form resize
    style = GetWindowLong(Frm.hwnd, GWL_STYLE)
    
    style = style And Not WS_THICKFRAME
    style = style And Not WS_MAXIMIZEBOX
    
    'apply new window style to form
    style = SetWindowLong(Frm.hwnd, GWL_STYLE, style)
    
    'disable form's `maximize` button
    On Error Resume Next
    
    ' Retrieve a handle to the system menu
    hMenu = GetSystemMenu(Frm.hwnd, 0)
    
    ' Retrieve the menu item information for the maximize menu item/button
    With MII
        .cbSize = Len(MII)
        .dwTypeData = String(80, 0)
        .cch = Len(.dwTypeData)
        .fMask = MIIM_STATE
        .wID = SC_MAXIMIZE
    End With
    If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Sub
    
    ' Switch the ID of the menu item so that VB can not undo the action itself
    With MII
        lngMenuID = .wID
        .wID = xSC_MAXIMIZE
        .fMask = MIIM_ID
    End With
    If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then Exit Sub
    
    ' Set the enabled / disabled state of the menu item
    With MII
        .fState = (.fState Or MFS_GRAYED)
        .fMask = MIIM_STATE
    End With
    If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Sub
    
    ' Activate the non-client area of the window to update the titlebar, and
    ' draw the close button in its new state.
    SendMessage Frm.hwnd, WM_NCACTIVATE, True, 0
    
    ' this is to refresh the form
    Frm.Width = Frm.Width - 1
    Frm.Width = Frm.Width + 1
End Sub

.....

ما اشتغل معي الكود
اخونا vbnet يقصد الكود بالشكل التالى


PHP كود :
Private Sub MDIForm_Load()
 
Call DisableFormResize(Me)
End Sub 
(06-07-14, 06:04 AM)WAEL ABED كتب : [ -> ]اخونا vbnet يقصد الكود بالشكل التالى


PHP كود :
Private Sub MDIForm_Load()
 
Call DisableFormResize(Me)
End Sub 

حبيبي انا بستخدم 2006
خلاص ارسل المشروع ليتم التعديل عليه