PDA

توجه ! این یک نسخه آرشیو شده میباشد و در این حالت شما عکسی را مشاهده نمیکنید برای مشاهده کامل متن و عکسها بر روی لینک مقابل کلیک کنید : ايجاد فرم بدون دكمه خروج در منوبار (دكمه قرمز بالا سمت راست فرم)


Amir Ghasemiyan
2014/12/04, 00:05
سلام دوستان

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


5165

خب حالا بريم سراغ آموزش:
ابتدا يك فرم ميسازيم با هر محتوايي كه لازم داريم. سپس روي فرم كليك كرده و 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
2017/03/08, 21:37
با سلام و احترام

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

14438
Amir Ghasemiyan
2017/03/09, 01:12
با سلام و احترام

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

14438

سلام دوست عزیز
سیستم شما 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
2017/03/09, 23:14
با سلام و احترام
خیلی ممنونم دوست عزیز اجرا شد ولی الان دیگه بی خیال نمیشه هر چی کلید خروج رو میزنم خارج نمیشه آخر با Ctrl+Alt+Delete بستم
:d
برای رفع مشکل چکار باید کرد؟ خیلی ممنونم
Amir Ghasemiyan
2017/03/10, 00:04
با سلام و احترام
خیلی ممنونم دوست عزیز اجرا شد ولی الان دیگه بی خیال نمیشه هر چی کلید خروج رو میزنم خارج نمیشه آخر با Ctrl+Alt+Delete بستم
:d
برای رفع مشکل چکار باید کرد؟ خیلی ممنونم

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


Private Sub CommandButton1_Click()
Unload UserForm1
End Sub
Skynet
2017/03/10, 00:12
مرسی جناب قاسمیان
من برنامه نویسی نمی دونم اگر ممکنه کد نهایی رو با آخرین ویرایش ارسال کنید ممنون میشم .
Amir Ghasemiyan
2017/03/10, 11:11
مرسی جناب قاسمیان
من برنامه نویسی نمی دونم اگر ممکنه کد نهایی رو با آخرین ویرایش ارسال کنید ممنون میشم .

نمونه فایل پیوست پست اول هست دوست عزیز
Skynet
2017/03/10, 14:34
خیلی ممنونم از شما، منظورتونو متوجه شدم

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