با سلـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــام
چطور می شود از درون کامپوننت کل برنامه را بست؟
با تشــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــکر :)
راه زياد داره...
Unload UserControl.Parent
(۱۸-شهریور-۱۳۹۱, ۱۸:۰۶:۲۶)Di Di نوشته است: [ -> ]براي فهميدن اينكه در حالت ديزاين تايم هستي هم مي توني از كد زير استفاده كني
کد:
Option Explicit
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Const GW_HWNDNEXT = 2
Const GW_CHILD = 5
'********************************************
'*Give it part of the window text your looking for
'*it will give you the hWnd
'*usefull for windows that text is like "[project] - microsoft visual basic [design]"
'*usage:
'*Msgbox FindWindowLike("visual basic")
'*Returns 0 if not found
'*******************************************
Function FindWindowLike(strPartOfCaption As String) As Long
Dim hWnd As Long
Dim strCurrentWindowText As String
Dim r As Integer
hWnd = GetForegroundWindow
Do Until hWnd = 0
strCurrentWindowText = Space$(255)
r = GetWindowText(hWnd, strCurrentWindowText, 255)
strCurrentWindowText = Left$(strCurrentWindowText, r)
'hWnd = GetWindow(hWnd, GW_CHILD)
If InStr(1, LCase(strCurrentWindowText), LCase(strPartOfCaption)) <> 0 Then GoTo Found
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop
Exit Function
Found:
FindWindowLike = hWnd
End Function
با سلام و تشکر فراوان من بعد از مدت ها دوباره رفتم سر کد های قدیمی
یه مشکلی بر خوردم من می خوام یک تایمر در زمان طراحی اجرا نشود و در زمان تست و بعد از کامپایل این تایمر به کار افتد و از کدی که شما لطف کردید به صورت زیر استفاده کردم
کد php:
If FindWindowLike("microsoft visual basic") <> 0 Then
If FindWindowLike("[run]") <> 0 Then
Timer1.Enabled = True
End If
ElseIf FindWindowLike("microsoft visual basic") = 0 Then
Timer1.Enabled = True
End If
با کد بالا در زمان طراحی و تست درسته ولی بعد از کامپایل اگر برنامه ی Visual Basic در حال اجرا باشد این هندل رو بر اساس اون نرم افزار می گیره و مشکل بر می خوره
چکارش کنم که بعد از کامپایل این کار رو نکنه
با تشکر فراوان
(۱۳-خرداد-۱۳۹۲, ۱۶:۴۲:۳۰)javaweb نوشته است: [ -> ] (۱۸-شهریور-۱۳۹۱, ۱۸:۰۶:۲۶)Di Di نوشته است: [ -> ]براي فهميدن اينكه در حالت ديزاين تايم هستي هم مي توني از كد زير استفاده كني
کد:
Option Explicit
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Const GW_HWNDNEXT = 2
Const GW_CHILD = 5
'********************************************
'*Give it part of the window text your looking for
'*it will give you the hWnd
'*usefull for windows that text is like "[project] - microsoft visual basic [design]"
'*usage:
'*Msgbox FindWindowLike("visual basic")
'*Returns 0 if not found
'*******************************************
Function FindWindowLike(strPartOfCaption As String) As Long
Dim hWnd As Long
Dim strCurrentWindowText As String
Dim r As Integer
hWnd = GetForegroundWindow
Do Until hWnd = 0
strCurrentWindowText = Space$(255)
r = GetWindowText(hWnd, strCurrentWindowText, 255)
strCurrentWindowText = Left$(strCurrentWindowText, r)
'hWnd = GetWindow(hWnd, GW_CHILD)
If InStr(1, LCase(strCurrentWindowText), LCase(strPartOfCaption)) <> 0 Then GoTo Found
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop
Exit Function
Found:
FindWindowLike = hWnd
End Function
با سلام و تشکر فراوان من بعد از مدت ها دوباره رفتم سر کد های قدیمی
یه مشکلی بر خوردم من می خوام یک تایمر در زمان طراحی اجرا نشود و در زمان تست و بعد از کامپایل این تایمر به کار افتد و از کدی که شما لطف کردید به صورت زیر استفاده کردم
کد php:
If FindWindowLike("microsoft visual basic") <> 0 Then
If FindWindowLike("[run]") <> 0 Then
Timer1.Enabled = True
End If
ElseIf FindWindowLike("microsoft visual basic") = 0 Then
Timer1.Enabled = True
End If
چکارش کنم که بعد از کامپایل این کار رو نکنه
با تشکر فراوان
با سلام و تشکر
ببخشید این کد بالا رو چطوری تغییر بدم تا این مشکل رفع شود؟
یا اگر راه بهتری برای انجام این کار می دونید به من بگید
با تشکــــــــــر
سلام
خوب هستيد
براي اينكه ببنيد در حالت استفاده و برنامه نويس هستيد و يا اينكه فايل اجرايي رو اجرا كرديد نياز به استفاده از api نيست
خود وي بي توانايي اين كار رو داره :
کد:
Function InIDE() As Boolean
On Error Resume Next
Err.Clear
Debug.Print 1 / 0
If Err = 0 Then
InIDE = False
Else
InIDE = True
End If
End Function
طرز كار كرد :
شي debug فقط حين برنامه نويسي موجوده . خوب اگر از اين شي استفاده كنيد و در حالت برنامه نويسي باشه عمل print اجرا ميشه و چون هر عددي تقيسم بر 0 مشكل داره خطا ايجاد ميكنه و شي err رو (err.number مقدار پيش فرض شي err) ست ميكنه به هر چيزي غير 0 ( براي مقابله با پيغام خطا از On Error Resume Next استفاده شده )
در صورتي كه در حالت اجرا فايل اجرايي باشيد چون شي debug موجود نيست عمل print انجام نميشه ( يعيني چيزي بر صفر تقسيم نميشه و خطايي به وقوع نميپيونده ) ومقدار err برابر 0 ميشه
اميدوارم كمك كنه
خیلی ممنونـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ
واقعا خیلی به من کمک کردید خیلی جالب بود
بازم تشکــــــــــــــــــــــر
با سلام و تشکر از تمام دوستان بامرام ایران ویج
نقل قول: سلام
خوب هستيد
براي اينكه ببنيد در حالت استفاده و برنامه نويس هستيد و يا اينكه فايل اجرايي رو اجرا كرديد نياز به استفاده از api نيست
خود وي بي توانايي اين كار رو داره :
کد:
کد:
Function InIDE() As Boolean
On Error Resume Next
Err.Clear
Debug.Print 1 / 0
If Err = 0 Then
InIDE = False
Else
InIDE = True
End If
End Function
شي debug فقط حين برنامه نويسي موجوده . خوب اگر از اين شي استفاده كنيد و در حالت برنامه نويسي باشه عمل print اجرا ميشه و چون هر عددي تقيسم بر 0 مشكل داره خطا ايجاد ميكنه و شي err رو (err.number مقدار پيش فرض شي err) ست ميكنه به هر چيزي غير 0 ( براي مقابله با پيغام خطا از On Error Resume Next استفاده شده )
در صورتي كه در حالت اجرا فايل اجرايي باشيد چون شي debug موجود نيست عمل print انجام نميشه ( يعيني چيزي بر صفر تقسيم نميشه و خطايي به وقوع نميپيونده ) ومقدار err برابر 0 ميشه
اميدوارم كمك كنه
واقعا کد جالبی بود ولی من می خواهم از این کد در کامپوننت استفاده کنم و InIDE در بخش کد کامپوننت هست و چون کامپوننت کامپایل می شود وسپس در برنامه ی طرف قرار می گیرد دراین حالت هیچ وقت شي debug موجود نيست عمل print انجام نميشه.
و من نمی تونم از این کد استفاده کنم
اگر من اشتباه می کنم ببخشید
آیا راحی برای فراخوانی اون شئ debug در پروژه ی کاربر به وسیله ی کامپوننت ما نیست؟
با سلام و تشکـــــــــــــــــــــــــ
ـــــــــــــــــــــــــــــــــر
چنتا سوال
1.چطوری نام پروژه ی کاربر را بگیریم؟
2.چطوری نام فورمی را که کنترل در آن قرار دارد را بگیریم؟
خیلــــــــــــــــــــــــــــــــــــــــــــی ممنونـــــــــــــــــــــــــــــــــ
ـــــــــــــــــــ
يه دونه ماژول بساز اين كدها رو بنداز توش :
کد:
Option Explicit
Private Declare Function GetWindow Lib "user32" (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal Hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Const GW_HWNDNEXT = 2
Const GW_CHILD = 5
Function FindIDE() As String
Dim Hwnd As Long
Dim strCurrentWindowText As String
Dim r As Integer
Hwnd = GetForegroundWindow
strCurrentWindowText = Space$(255)
r = GetWindowText(Hwnd, strCurrentWindowText, 255)
strCurrentWindowText = Left$(strCurrentWindowText, r)
If InStr(1, LCase(strCurrentWindowText), LCase("Microsoft Visual Basic")) <> 0 Then
FindIDE = "In [Design Time!]"
Else
FindIDE = "In [Run Time!]"
End If
End Function
Function FindPJName() As String
Dim Hwnd As Long
Dim strCurrentWindowText As String
Dim r As Integer
Hwnd = GetForegroundWindow
strCurrentWindowText = Space$(255)
r = GetWindowText(Hwnd, strCurrentWindowText, 255)
strCurrentWindowText = Left$(strCurrentWindowText, r)
'If InStr(1, LCase(strCurrentWindowText), LCase("Microsoft Visual Basic")) <> 0 Then
FindPJName = Replace(strCurrentWindowText, "- Microsoft Visual Basic [design]", "")
'Else
' FindPJName = strCurrentWindowText
'End If
End Function
سه تا دونه ليبل بنداز وسط يوزر كنترلت و اين كدها رو بريز توش!:
کد:
Private Sub UserControl_Paint()
Label1 = "Form Name : " & UserControl.Parent.Name
Label2 = "Run Mode : " & FindIDE
Label3 = "Project Name : " & FindPJName
End Sub
كامپوننت رو كامپايل كن و بندازش وسط پروژه جديد و لذت ببر!!
با سلــــــــــــــــــــــــــ
ــــــــــــــــــــام و تشکـــــــــــــــــــــــــ
ــــــــــــــــــــــــر
خیلی کد مفیدی بود و به من کمک کردید
واقعا ممنون
خودم می خواستم این کار شما رو بکنم با نام پروژه و فورم مشکل اون کد که هندل را می گرفت حل کنم که شما لطف کردید و مشکلاتمو حل کردید.
با تشکـــــــــــــــــــــــــــــــــــــــــــــــــــــ
ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــر
با سلام دوستان
میدونم در زمان اجرا نمی شه مقدار یک مشخصه را از درون خود کامپوننت نمی شه تغییر داد!میشه؟
آیا راحی برای این کار است؟
مثلا من می خواهم یک مشخصه که در هر ثانیه یکی بهش افزوده می شود ولی بعد از پایان برنامه این مشخصه مقدار اولیه خود را دارد
با تشکــــــــــــــــــــــــــــ
ــــــــــــــــــــــــــر