ايجاد فرم بدون دكمه خروج در منوبار (دكمه قرمز بالا سمت راست فرم)

[Amir Ghasemiyan]

سلام دوستان

گاهي پيش مياد ميخوايم يه فرمي داشته باشيم كه امكان بستن نداشته باشه. يا مثلا قبل از بسته شدن يكسري كارها انجام بشه.
خب براي چنين مواقعي ميتونيم فرمي داشته باشيم كه دكمه خروج نداشته باشه.
اگه چنين فرمي نياز دارين اين آموزش رو از دست ندين
اينم يه نمونه از نتيجه نهايي فرم ما

خب حالا بريم سراغ آموزش:
ابتدا يك فرم ميسازيم با هر محتوايي كه لازم داريم. سپس روي فرم كليك كرده و F7 رو ميزنيم تا وارد محيط كدنويسي فرم بشيم. (ميتونين روي فرم راست كليك كرده و گزينه view code رو بزنين)

حالا اين كدها رو به ابتداي كدها اضافه ميكنيم:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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
Const GWL_STYLE = -16
Const WS_SYSMENU = &H80000
Private Sub UserForm_Initialize()
   Dim hWnd As Long, lStyle As Long
   If Val(Application.Version) >= 9 Then
      hWnd = FindWindow("ThunderDFrame", Me.Caption)
   Else
      hWnd = FindWindow("ThunderXFrame", Me.Caption)
   End If
   lStyle = GetWindowLong(hWnd, GWL_STYLE)
   SetWindowLong hWnd, GWL_STYLE, (lStyle And Not WS_SYSMENU)
End Sub

به همين راحتي :دي
براي نمونه هم يك فرم آماده كردم كه پيوست ميكنم. اميدوارم مفيد باشه براتون

[Skynet]

با سلام و احترام

ممنونم از مطلب خوب و کاربردیتون
من فایل آپلودی شما رو امتحان کردم اما ظاهرا در سیستم من اجرا نشد! دلیل چی می تونه باشه ممنونم

[Amir Ghasemiyan]

با سلام و احترام

ممنونم از مطلب خوب و کاربردیتون
من فایل آپلودی شما رو امتحان کردم اما ظاهرا در سیستم من اجرا نشد! دلیل چی می تونه باشه ممنونم

[ATTACH=CONFIG]14438[/ATTACH]

سلام دوست عزیز
سیستم شما 64 بیتی هست احتمالا
لطفا این کد اصلاح شده برای سیستم های 64 بیتی رو امتحان بفرمایید

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const GWL_STYLE = -16
Const WS_SYSMENU = &H80000
Private Sub UserForm_Initialize()
   Dim hWnd As Long, lStyle As Long
   If Val(Application.Version) >= 9 Then
      hWnd = FindWindow("ThunderDFrame", Me.Caption)
   Else
      hWnd = FindWindow("ThunderXFrame", Me.Caption)
   End If
   lStyle = GetWindowLong(hWnd, GWL_STYLE)
   SetWindowLong hWnd, GWL_STYLE, (lStyle And Not WS_SYSMENU)
End Sub

[Skynet]

با سلام و احترام
خیلی ممنونم دوست عزیز اجرا شد ولی الان دیگه بی خیال نمیشه هر چی کلید خروج رو میزنم خارج نمیشه آخر با Ctrl+Alt+Delete بستم

برای رفع مشکل چکار باید کرد؟ خیلی ممنونم

[Amir Ghasemiyan]

با سلام و احترام
خیلی ممنونم دوست عزیز اجرا شد ولی الان دیگه بی خیال نمیشه هر چی کلید خروج رو میزنم خارج نمیشه آخر با Ctrl+Alt+Delete بستم

برای رفع مشکل چکار باید کرد؟ خیلی ممنونم

سلام
کدهای مربوط به دکمه خروج رو مشاهده کنید:

Private Sub CommandButton1_Click()
Unload UserForm1
End Sub

[Skynet]

مرسی جناب قاسمیان
من برنامه نویسی نمی دونم اگر ممکنه کد نهایی رو با آخرین ویرایش ارسال کنید ممنون میشم .

[Amir Ghasemiyan]

مرسی جناب قاسمیان
من برنامه نویسی نمی دونم اگر ممکنه کد نهایی رو با آخرین ویرایش ارسال کنید ممنون میشم .

نمونه فایل پیوست پست اول هست دوست عزیز

[Skynet]

خیلی ممنونم از شما، منظورتونو متوجه شدم

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const GWL_STYLE = -16
Const WS_SYSMENU = &H80000


Private Sub Label1_Click()


End Sub


Private Sub UserForm_Initialize()
   Dim hWnd As Long, lStyle As Long
   If Val(Application.Version) >= 9 Then
      hWnd = FindWindow("ThunderDFrame", Me.Caption)
   Else
      hWnd = FindWindow("ThunderXFrame", Me.Caption)
   End If
   lStyle = GetWindowLong(hWnd, GWL_STYLE)
   SetWindowLong hWnd, GWL_STYLE, (lStyle And Not WS_SYSMENU)
End Sub


Private Sub CommandButton1_Click()
Unload UserForm1
End Sub