اگه بخوام از كليد هاي تركيبي براي يه منو استفاده كنم مثلا
Save Ctrl+S
براي عبارت جلوي case كه بايد كاپشن منو رو بگذارم چي بنويسم؟
بين Save و Ctrl+S ؟
Printable View
اگه بخوام از كليد هاي تركيبي براي يه منو استفاده كنم مثلا
Save Ctrl+S
براي عبارت جلوي case كه بايد كاپشن منو رو بگذارم چي بنويسم؟
بين Save و Ctrl+S ؟
بين عنوان منو و كليد‌هاي تركيبي كد اسكي 9 يعني همون ثابت vbTab درج ميشه.نقل قول:
مثلا اگر ميخواي عنوان كامل كليد رو در case استفاده كني بايد اينطوري بنويسي:
يا از اين كد توي همون رويداد استفاده كن تا ديگه كليد‌هاي سريع منوها رو در نظر نگيري:کد:case "Open"+vbTab+"Ctrl+O"
اين كد بخش كليد‌هاي تركيبي منوها رو حذف ميكنه و مثل اين ميمونه كه گزينه‌هاي كليد‌هاي تركيبي ندارند.کد:Dim mCaption As String
Dim p As Long
p = InStr(mnucaption, vbTab)
If p Then
mCaption = Left(mnucaption, p - 1)
Else
mCaption = mnucaption
End If
Select Case mCaption
Case "Open..."
Case "Close"
...
End Select
وقتي تعداد منوهاي اصلي بيشتر از دوتا باشه مياد كاپشن زير منوي اول رو براي كاپشن هاي منوي اصلي (سوم و چهارم) نشون ميده
مي خواستم از كليد هاي تركيبي استفاده كنم تا شايد ديگه تكرار نشه ولي وقتي از كليد هاي تركيبي هم استفاده مي كنم دوباره تكرار
مي كنه.حتي اگه كاپشن منوي اصلي رو برابر با "" قرار بدم.
کد:Dim WithEvents usrmenu As clsMenu
Private Sub Form_Load()
Set usrmenu = New clsMenu
usrmenu.Active Me.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
usrmenu.DeActive
End Sub
Private Sub usrMenu_OnMenu(mnucaption As String)
If mnucaption = "" Then StatusBar1.SimpleText = ""
Select Case mnucaption
Case "Open..." + vbTab + "Ctrl+O"
StatusBar1.SimpleText = "Open"
Case "Close" + vbTab + "Ctrl+C"
StatusBar1.SimpleText = "Close"
Case "Exit" + vbTab + "Ctrl+Q"
StatusBar1.SimpleText = "Exit"
Case "Notepad"
StatusBar1.SimpleText = "Notepad"
Case "Cut"
StatusBar1.SimpleText = "Cut"
End Select
End Sub
متوجه نشدم منظورت چيه، بيشتر توضيح بده تا اگه ايرادي هست كلاس رو بازنويسي كنم.نقل قول:
در برنامه ايي كه خودتون نوشتيد، تعداد منوهاي اصلي 2 تا بود. اگه يكي ديگه به منوهاي اصلي اضافه كنيد مثلا Run با دو
زير منوي option و publish وقتي روي Run كليك كنم ، توضيحات اولين گزينه ي منوي اصلي يعني open رو براي
Run نشون ميده.
يا اصلا واضحتر بگم براي اينكه بشه براي منوي اصلي file يا Edit يا Run درstatusbar توضيحات نشون بدم،چي كار
كنم؟
اينو ببينيد
اینو ببین :نقل قول:
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
اينم مثه قبلياست اگه به منوي help يه زير منو اضافه بشه بازم ميشه مثه قبلي.
من از اين كلاس تو يه برنامه ايي استفاده كردم ،كه اين برنامه از كامپوننت KDtele (براي شماره گيري و ارسال فايل از طريق
خط تلفن) استفاده مي كنه،اين برنامه تا چند روز پيش كار مي كرد ولي وقتي از اين كلاس استفاده كردم كار نمي كنه. آيا استفاده
از كلاس محدوديت داره؟ يعني ممكنه با بعضي از كامپوننت ها كار نكنه؟
در صورتي كه بخوام پروژه رو با برنامه ي setup ساز نصبي كنم ،باز هم بايد اين كلاس رو تو پوشه ي system32 كپي
كنم؟يا لزومي نداره؟
کد:'In Module
Option Explicit
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam 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 GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Const MF_HILITE = &H80&
Private Const WM_MENUSELECT = &H11F
Private Const GWL_WNDPROC = -4
Public lpPrevWndProc As Long
Public gHW As Long
Public Sub Hook()
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub Unhook()
SetWindowLong gHW, GWL_WNDPROC, lpPrevWndProc
End Sub
Function AnyLit(hSubSubMenu As Long) As Long
Dim i As Long
Dim MenuCount As Long
MenuCount = GetMenuItemCount(hSubSubMenu)
For i = 0 To MenuCount - 1
If GetMenuState(hSubSubMenu, i, MF_BYPOSITION) And MF_HILITE Then
AnyLit = True
Exit Function
End If
Next i
AnyLit = False
End Function
Private Sub WalkSubMenu(hSubMenu As Long)
Dim i As Long
Dim MenuItems As Long
Dim hSubSubMenu As Long
Dim buffer As String
Dim result As Long
MenuItems = GetMenuItemCount(hSubMenu)
For i = 0 To MenuItems - 1
If GetMenuState(hSubMenu, i, MF_BYPOSITION) And MF_HILITE Then
hSubSubMenu = GetSubMenu(hSubMenu, i)
If hSubSubMenu And AnyLit(hSubSubMenu) Then
WalkSubMenu hSubSubMenu
Else
buffer = Space(255)
result = GetMenuString(hSubMenu, i, buffer, Len(buffer), MF_BYPOSITION)
buffer = Left$(buffer, result)
Form1.StatusBar1.Panels(1).Text = GetDescription(buffer)
Exit Sub
End If
End If
Next i
End Sub
Public Sub FindHilite(TheForm As Form)
Dim hMenu As Long
Dim hSubMenu As Long
Dim i As Long
Dim MenuCount As Long
Form1.StatusBar1.Panels(1).Text = ""
hMenu = GetMenu(TheForm.hwnd)
If hMenu <> 0 Then
MenuCount = GetMenuItemCount(hMenu)
For i = 0 To MenuCount - 1
If GetMenuState(hMenu, i, MF_BYPOSITION) And MF_HILITE Then
hSubMenu = GetSubMenu(hMenu, i)
WalkSubMenu hSubMenu
End If
Next i
End If
End Sub
Private Function GetDescription(MenuCaption As String) As String
Select Case MenuCaption
Case "New"
GetDescription = "New"
Case "Open"
GetDescription = "Opens"
Case "Close"
GetDescription = "Close"
Case "Cut"
GetDescription = "Cut"
Case "Copy"
GetDescription = "Copy"
Case "Paste"
GetDescription = "Paste"
Case "Components"
GetDescription = "Components"
Case "References"
GetDescription = "References"
Case "Contents"
GetDescription = "Contents"
Case "About"
GetDescription = "About"
Case Else
GetDescription = ""
End Select
End Function
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_MENUSELECT Then
FindHilite Form1
End If
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]کد:Option Explicit
Private Sub Form_Load()
gHW = Me.hwnd
Hook
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub