ورود

View Full Version : راست چین کردن منو ها



sajjad_kochekian
شنبه 17 دی 1390, 23:22 عصر
با سلام
داخل منوی فارسی دارم که با دستور ساخته ام
حالا می خواهم اون را راست چین کنم.
دستور اون را از سایت ماکروسافت بدست اوردم ولی چون که نام منو را می خواهد و منو را با دستور می سازم نمی دونم باید چی کارش کنم.
ساخت منو
Dim strMenuName As String
Dim cmdNewMenu As CommandBar

strMenuName = "ExampleMenu"

If fIsCreated(strMenuName) Then
Application.CommandBars(strMenuName).Delete
End If


'Create a new Commandbar as MenuType


Set cmdNewMenu = Application.CommandBars.Add(strMenuName, msoBarTop, True, True)
ماژول راست چین ماکرو سافت
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Const GW_CHILD = 5
Public Const WS_EX_LAYOUTRTL = &H400000
Public Const GWL_EXSTYLE = (-20)

دستور استفاده
'For ToolBar
'mhwnd = GetWindow(Toolbar1.hwnd, GW_CHILD)
'OldLong = GetWindowLong(mhwnd, GWL_EXSTYLE)
'SetWindowLong mhwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
'InvalidateRect hwnd, 0, False
لطفا دوستان که می تونند کمک کنند

Abbas Amiri
شنبه 17 دی 1390, 23:51 عصر
تابع fIsCreated را باید اضافه کرد ولی موضع اینه که CommandBar خصوصیت hWnd نداره. آدرس لینک روبده تا سری بزنیم.



Function fIsCreated(strMenuName) As Boolean

Dim intNumberMenus As Integer
Dim i As Integer

intNumberMenus = Application.CommandBars.Count

fIsCreated = False

For i = 1 To intNumberMenus
If Application.CommandBars(i).Name = strMenuName Then
fIsCreated = True
i = intNumberMenus
End If
Next

End Function

sajjad_kochekian
یک شنبه 18 دی 1390, 09:04 صبح
http://www.microsoft.com/middleeast/msdn/faq.aspx

sajjad_kochekian
دوشنبه 19 دی 1390, 17:27 عصر
از اين فانكشن اسفاده شده است.
لينك منبع را ارسال كردم

لطفا راهنمايي كنيد.

sajjad_kochekian
پنج شنبه 22 دی 1390, 16:26 عصر
کسی نیست راهنمایی کنه؟