• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Menu_Columns_Demo: Menu có nhiều cột

Các thủ thuật liên quan đến việc xử lý ứng dụng, biểu mẫu và control
Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4763
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 518 time

Menu_Columns_Demo: Menu có nhiều cột

Gửi bàigửi bởi truongphu » T.Sáu 16/01/2009 8:29 pm

Thủ thuật: Menu_Columns_Demo
Tác giả: Sưu tầm
Mô tả: Menu_Columns_Demo: Menu có nhiều cột


Thiết kế Menu như sau:
untitled2.JPG


Mã: Chọn hết

  1.  Option Explicit
  2.   ' demo project showing how to manipulate VB menus using the API
  3.   ' by Bryan Stafford of New Vision Software® - newvision@mvps.org
  4.   ' this demo is released into the public domain "as is" without
  5.   ' warranty or guaranty of any kind.  In other words, use at
  6.   ' your own risk.
  7.  
  8.   ' API calls used
  9.   Private Declare Function GetMenu& Lib "user32" (ByVal hwnd&)
  10.   Private Declare Function GetSubMenu& Lib "user32" (ByVal hMenu&, ByVal nPos&)
  11.   Private Declare Function GetMenuItemID& Lib "user32" (ByVal hMenu&, ByVal nPos&)
  12.   Private Declare Function ModifyMenu& Lib "user32" Alias "ModifyMenuA" (ByVal hMenu&, _
  13.                           ByVal nPosition&, ByVal wFlags&, ByVal wIDNewItem&, ByVal lpString$)
  14.   Private Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex&)
  15.  
  16. Private Sub Form_Load()
  17.  
  18.   ' It seems that there is a limit to the number of menus that may be added
  19.   ' in any VB application.  I discovered this by setting the number of menus
  20.   ' in each menu array ever higher until I received an 'Out of Memory' error.
  21.   ' The error occurred at 337 items between all three menu arrays.  This does
  22.   ' not take into account the other higher level menus in the application.
  23.  
  24.   ' position the form
  25.   Move (Screen.Width \ 2) - (Width \ 2), 0
  26.  
  27.   Form_Paint ' Autoredraw is set to true so we need to call the form paint to draw the form text
  28.  
  29.   Const MF_BYPOSITION As Long = &H400&   '<--** tells modifymenu to act on the menu at the specified position
  30.   Const MF_MENUBARBREAK As Long = &H20&  '<--** tells modifymenu to add another column with a vertical separator
  31.   Const MF_MENUBREAK As Long = &H40&     '<--** tells modifymenu to add another column without a vertical separator
  32.   Const SM_CYFULLSCREEN As Long = 17&    '<--** height of client area of a maximized window
  33.   Const SM_CYMENU  As Long = 15&         '<--** height of menu
  34.  
  35.   Dim menuheight&, breakpoint&, menuhWnd&, submenuhWnd&, nextsubmenuhWnd&
  36.   Dim i&, loopnum&, loopstr$, msg$
  37.  
  38.   ' get the client area height and divide it by the height of a menu
  39.   ' to get the point where we need to *wrap* the menu to a new column
  40.   menuheight = GetSystemMetrics(SM_CYMENU)
  41.   breakpoint = (GetSystemMetrics(SM_CYFULLSCREEN) - menuheight) \ menuheight
  42.  
  43.   menuhWnd = GetMenu(hwnd) ' get the handle of the menu for *this* form
  44.  
  45.   submenuhWnd = GetSubMenu(menuhWnd, 0) ' get the handle of the first sub menu
  46.  
  47.   For i = 1 To 99  ' load the first menu array (rember, zero is already loaded)
  48.     On Error GoTo TooManyMenus
  49.     Load mnuList1(i)
  50.     On Error GoTo 0
  51.     mnuList1(i).Caption = "Menu Item " & CStr(i + 1)
  52.  
  53.                      ' if we've reached the breakpoint then add a new column with
  54.     If i Mod breakpoint = 0 Then   ' a vertical bar the proper ID must be specified
  55.  
  56.       Call ModifyMenu(submenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
  57.                               GetMenuItemID(submenuhWnd, i), "Menu Item " & CStr(i + 1))
  58.     End If
  59.   Next
  60.                    
  61.                     ' get the handle of the popup menu that is in the position
  62.   submenuhWnd = GetSubMenu(submenuhWnd, i) ' at AFTER the menus we just loaded
  63.  
  64.   For i = 1 To 9  ' load the popup sub menu array of the first menu array (rember, zero is already loaded)
  65.     On Error GoTo TooManyMenus
  66.     Load mnuList4(i)
  67.     On Error GoTo 0
  68.     mnuList4(i).Caption = "Menu Item " & CStr(i + 1)
  69.  
  70.                      ' if we've reached the breakpoint then add a new column with a vertical bar
  71.     If i Mod 5 = 0 Then                          ' the proper ID must be specified
  72.       Call ModifyMenu(submenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
  73.                                 GetMenuItemID(submenuhWnd, i), "Menu Item " & CStr(i + 1))
  74.     End If
  75.   Next
  76.  
  77.  
  78.   submenuhWnd = GetSubMenu(menuhWnd, 1) ' get the sub menu of the second top level menu (position 1)
  79.  
  80.   nextsubmenuhWnd = GetSubMenu(submenuhWnd, False) ' get the first sub menu of the sub menu
  81.  
  82.   loopnum = 1 ' set variable for trapped errors
  83.  
  84.   For i = 1 To 99  ' load the second menu array (rember, zero is already loaded)
  85.     On Error GoTo TooManyMenus
  86.     Load mnuList2(i)
  87.     On Error GoTo 0
  88.     mnuList2(i).Caption = "Menu Item " & CStr(i + 1)
  89.  
  90.                      ' if we've reached the breakpoint then add a new column with a vertical bar
  91.     If i Mod breakpoint = 0 Then                        ' the proper ID must be specified
  92.       Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
  93.                                GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))
  94.     End If
  95.   Next
  96.  
  97.   nextsubmenuhWnd = GetSubMenu(submenuhWnd, 1) ' get the second sub menu of the sub menu
  98.  
  99.   loopnum = 2 ' set variable for trapped errors
  100.  
  101.   For i = 1 To 99   ' load the third menu array (rember, zero is already loaded)
  102.     On Error GoTo TooManyMenus
  103.     Load mnuList3(i)
  104.     On Error GoTo 0
  105.     mnuList3(i).Caption = "Menu Item " & CStr(i + 1)
  106.  
  107.                       ' if we've reached the breakpoint then add a new column without a vertical bar
  108.     If i Mod breakpoint = 0 Then                       ' the proper ID must be specified
  109.       Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBREAK, _
  110.                                 GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))
  111.     End If
  112.   Next
  113.  
  114. Exit Sub
  115.  
  116. TooManyMenus:
  117.  
  118.   ' display message telling where the error occurred
  119.   Select Case loopnum
  120.     Case 0
  121.       loopstr$ = "first"
  122.     Case 1
  123.       loopstr$ = "second"
  124.     Case 2
  125.       loopstr$ = "third"
  126.   End Select
  127.  
  128.   msg$ = "Ran out of menu space while loading sub menu number " & CStr(i) & " in the " & loopstr$ & " loop."
  129.  
  130.   MsgBox msg$, 48, "ERROR!"
  131.  
  132.   On Error GoTo 0
  133.  
  134.   Exit Sub
  135.  
  136. End Sub
  137.  
  138. Private Sub Form_Paint()
  139.  
  140.   ' print the text on the form
  141.   CurrentY = 70
  142.   CurrentX = 40
  143.   Print "This application demonstrates adding columns and vertical bars to Visual Basic menus."
  144.   CurrentX = 40
  145.   Print "Explore the menus on this form to see examples of how VB menus can be *extended*."
  146.   Print
  147.   Print
  148.  
  149.   CurrentX = 40
  150.   Print "Developed by Bryan Stafford of New Vision Software® and released into the public"
  151.   CurrentX = 40
  152.   Print "domain.  This application is provided ""As Is"" with no guarantee or warranty of any"
  153.   CurrentX = 40
  154.   Print "kind.  You may redistribute this application and the source code so long as no fee is "
  155.   CurrentX = 40
  156.   Print "charged and no changes have been made.  All questions and comments are"
  157.   CurrentX = 40
  158.   Print "welcome by e-mail at:   newvision@imt.net"
  159.  
  160. End Sub
  161.  
  162. Private Sub mnuList1_Click(index As Integer)
  163.  
  164.   ' report the menu that was chosen
  165.   Dim msg$
  166.  
  167.   msg$ = "You chose item number " & CStr(index + 1) & " from the Two Level Menu"
  168.  
  169.   MsgBox msg$, 64, "Menu Columns Demo"
  170.  
  171. End Sub
  172.  
  173. Private Sub mnuList2_Click(index As Integer)
  174.  
  175.   ' report the menu that was chosen
  176.   Dim msg$
  177.  
  178.   msg$ = "You chose item number " & CStr(index + 1) & " from the first sub menu of the Three Level Menu"
  179.  
  180.   MsgBox msg$, 64, "Menu Columns Demo"
  181.  
  182. End Sub
  183.  
  184. Private Sub mnuList3_Click(index As Integer)
  185.  
  186.   ' report the menu that was chosen
  187.   Dim msg$
  188.  
  189.   msg$ = "You chose item number " & CStr(index + 1) & " from the second sub menu of the Three Level Menu"
  190.  
  191.   MsgBox msg$, 64, "Menu Columns Demo"
  192.  
  193. End Sub
  194.  
  195. Private Sub mnuList4_Click(index As Integer)
  196.  
  197.   ' report the menu that was chosen
  198.   Dim msg$
  199.  
  200.   msg$ = "You chose item number " & CStr(index + 1) & " from the popup sub menu of the Two Level Menu"
  201.  
  202.   MsgBox msg$, 64, "Menu Columns Demo"
  203.  
  204. End Sub
  205.  

Kết quả:
demo.jpg

Hay không? Cảm ơn đã đọc bài. Xin nhấn nút Thank tại đây
Tập tin đính kèm
Menu_Columns_Demo.zip
(3.17 KiB) Đã tải 546 lần


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Quay về “[VB] Ứng dụng - Form và Control”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách