home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vb_menu / menubmps.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-09-06  |  14.0 KB  |  402 lines
  1. VERSION 2.00
  2. Begin Form MenuBitmaps 
  3.    Caption         =   "Bitmap Menus"
  4.    ClientHeight    =   3315
  5.    ClientLeft      =   1125
  6.    ClientTop       =   1710
  7.    ClientWidth     =   5010
  8.    FontBold        =   -1  'True
  9.    FontItalic      =   0   'False
  10.    FontName        =   "Times New Roman"
  11.    FontSize        =   39.75
  12.    FontStrikethru  =   0   'False
  13.    FontUnderline   =   0   'False
  14.    Height          =   4005
  15.    Icon            =   MENUBMPS.FRX:0000
  16.    Left            =   1065
  17.    LinkMode        =   1  'Source
  18.    LinkTopic       =   "Form1"
  19.    ScaleHeight     =   3315
  20.    ScaleWidth      =   5010
  21.    Top             =   1080
  22.    Width           =   5130
  23.    Begin PictureBox Picture3 
  24.       AutoRedraw      =   -1  'True
  25.       BackColor       =   &H00FFFFFF&
  26.       FontBold        =   -1  'True
  27.       FontItalic      =   0   'False
  28.       FontName        =   "Times New Roman"
  29.       FontSize        =   60
  30.       FontStrikethru  =   0   'False
  31.       FontUnderline   =   0   'False
  32.       Height          =   585
  33.       Index           =   4
  34.       Left            =   2100
  35.       ScaleHeight     =   555
  36.       ScaleWidth      =   2010
  37.       TabIndex        =   9
  38.       Top             =   2400
  39.       Visible         =   0   'False
  40.       Width           =   2040
  41.    End
  42.    Begin PictureBox Picture1 
  43.       AutoSize        =   -1  'True
  44.       FontBold        =   -1  'True
  45.       FontItalic      =   0   'False
  46.       FontName        =   "System"
  47.       FontSize        =   9.75
  48.       FontStrikethru  =   0   'False
  49.       FontUnderline   =   0   'False
  50.       Height          =   615
  51.       Index           =   4
  52.       Left            =   0
  53.       Picture         =   MENUBMPS.FRX:0302
  54.       ScaleHeight     =   585
  55.       ScaleWidth      =   2040
  56.       TabIndex        =   2
  57.       Top             =   2400
  58.       Visible         =   0   'False
  59.       Width           =   2070
  60.    End
  61.    Begin PictureBox Picture3 
  62.       AutoRedraw      =   -1  'True
  63.       BackColor       =   &H00FFFFFF&
  64.       FontBold        =   -1  'True
  65.       FontItalic      =   0   'False
  66.       FontName        =   "Times New Roman"
  67.       FontSize        =   50.25
  68.       FontStrikethru  =   0   'False
  69.       FontUnderline   =   0   'False
  70.       Height          =   585
  71.       Index           =   3
  72.       Left            =   2070
  73.       ScaleHeight     =   555
  74.       ScaleWidth      =   2010
  75.       TabIndex        =   4
  76.       Top             =   1800
  77.       Visible         =   0   'False
  78.       Width           =   2040
  79.    End
  80.    Begin PictureBox Picture1 
  81.       AutoSize        =   -1  'True
  82.       FontBold        =   -1  'True
  83.       FontItalic      =   0   'False
  84.       FontName        =   "System"
  85.       FontSize        =   9.75
  86.       FontStrikethru  =   0   'False
  87.       FontUnderline   =   0   'False
  88.       Height          =   615
  89.       Index           =   3
  90.       Left            =   0
  91.       Picture         =   MENUBMPS.FRX:0DD8
  92.       ScaleHeight     =   585
  93.       ScaleWidth      =   2040
  94.       TabIndex        =   1
  95.       Top             =   1800
  96.       Visible         =   0   'False
  97.       Width           =   2070
  98.    End
  99.    Begin PictureBox Picture2 
  100.       AutoSize        =   -1  'True
  101.       FontBold        =   -1  'True
  102.       FontItalic      =   0   'False
  103.       FontName        =   "System"
  104.       FontSize        =   9.75
  105.       FontStrikethru  =   0   'False
  106.       FontUnderline   =   0   'False
  107.       Height          =   240
  108.       Left            =   4440
  109.       Picture         =   MENUBMPS.FRX:18AE
  110.       ScaleHeight     =   14
  111.       ScaleMode       =   3  'Pixel
  112.       ScaleWidth      =   14
  113.       TabIndex        =   3
  114.       Top             =   1350
  115.       Visible         =   0   'False
  116.       Width           =   240
  117.    End
  118.    Begin PictureBox Picture3 
  119.       AutoRedraw      =   -1  'True
  120.       BackColor       =   &H00FFFFFF&
  121.       FontBold        =   -1  'True
  122.       FontItalic      =   0   'False
  123.       FontName        =   "Times New Roman"
  124.       FontSize        =   39.75
  125.       FontStrikethru  =   0   'False
  126.       FontUnderline   =   0   'False
  127.       Height          =   585
  128.       Index           =   2
  129.       Left            =   2070
  130.       ScaleHeight     =   555
  131.       ScaleWidth      =   2010
  132.       TabIndex        =   10
  133.       Top             =   1200
  134.       Visible         =   0   'False
  135.       Width           =   2040
  136.    End
  137.    Begin PictureBox Picture1 
  138.       AutoSize        =   -1  'True
  139.       FontBold        =   -1  'True
  140.       FontItalic      =   0   'False
  141.       FontName        =   "System"
  142.       FontSize        =   9.75
  143.       FontStrikethru  =   0   'False
  144.       FontUnderline   =   0   'False
  145.       Height          =   615
  146.       Index           =   2
  147.       Left            =   0
  148.       Picture         =   MENUBMPS.FRX:1998
  149.       ScaleHeight     =   585
  150.       ScaleWidth      =   2040
  151.       TabIndex        =   5
  152.       Top             =   1200
  153.       Visible         =   0   'False
  154.       Width           =   2070
  155.    End
  156.    Begin PictureBox Picture3 
  157.       AutoRedraw      =   -1  'True
  158.       BackColor       =   &H00FFFFFF&
  159.       FontBold        =   -1  'True
  160.       FontItalic      =   0   'False
  161.       FontName        =   "Times New Roman"
  162.       FontSize        =   30
  163.       FontStrikethru  =   0   'False
  164.       FontUnderline   =   0   'False
  165.       Height          =   585
  166.       Index           =   1
  167.       Left            =   2070
  168.       ScaleHeight     =   555
  169.       ScaleWidth      =   2010
  170.       TabIndex        =   8
  171.       Top             =   600
  172.       Visible         =   0   'False
  173.       Width           =   2040
  174.    End
  175.    Begin PictureBox Picture1 
  176.       AutoSize        =   -1  'True
  177.       FontBold        =   -1  'True
  178.       FontItalic      =   0   'False
  179.       FontName        =   "System"
  180.       FontSize        =   9.75
  181.       FontStrikethru  =   0   'False
  182.       FontUnderline   =   0   'False
  183.       Height          =   615
  184.       Index           =   1
  185.       Left            =   0
  186.       Picture         =   MENUBMPS.FRX:246E
  187.       ScaleHeight     =   585
  188.       ScaleWidth      =   2040
  189.       TabIndex        =   6
  190.       Top             =   600
  191.       Visible         =   0   'False
  192.       Width           =   2070
  193.    End
  194.    Begin PictureBox Picture3 
  195.       AutoRedraw      =   -1  'True
  196.       AutoSize        =   -1  'True
  197.       BackColor       =   &H00FFFFFF&
  198.       FontBold        =   -1  'True
  199.       FontItalic      =   0   'False
  200.       FontName        =   "Times New Roman"
  201.       FontSize        =   20.25
  202.       FontStrikethru  =   0   'False
  203.       FontUnderline   =   0   'False
  204.       Height          =   795
  205.       Index           =   0
  206.       Left            =   2070
  207.       Picture         =   MENUBMPS.FRX:2F44
  208.       ScaleHeight     =   765
  209.       ScaleWidth      =   3375
  210.       TabIndex        =   7
  211.       Top             =   0
  212.       Visible         =   0   'False
  213.       Width           =   3405
  214.    End
  215.    Begin PictureBox Picture1 
  216.       AutoSize        =   -1  'True
  217.       FontBold        =   -1  'True
  218.       FontItalic      =   0   'False
  219.       FontName        =   "System"
  220.       FontSize        =   9.75
  221.       FontStrikethru  =   0   'False
  222.       FontUnderline   =   0   'False
  223.       Height          =   615
  224.       Index           =   0
  225.       Left            =   0
  226.       Picture         =   MENUBMPS.FRX:46DA
  227.       ScaleHeight     =   585
  228.       ScaleWidth      =   2040
  229.       TabIndex        =   0
  230.       Top             =   0
  231.       Visible         =   0   'False
  232.       Width           =   2070
  233.    End
  234.    Begin Menu Bitmaps 
  235.       Caption         =   "&Static"
  236.       Begin Menu SubMenu 
  237.          Caption         =   "Static Bitmap 0"
  238.          Checked         =   -1  'True
  239.          Index           =   0
  240.       End
  241.       Begin Menu SubMenu 
  242.          Caption         =   "Static Bitmap 1"
  243.          Index           =   1
  244.       End
  245.       Begin Menu SubMenu 
  246.          Caption         =   "Static Bitmap 2"
  247.          Index           =   2
  248.       End
  249.       Begin Menu SubMenu 
  250.          Caption         =   "Static Bitmap 3"
  251.          Index           =   3
  252.       End
  253.       Begin Menu SubMenu 
  254.          Caption         =   "Static Bitmap 4"
  255.          Index           =   4
  256.       End
  257.    End
  258.    Begin Menu DynamicBitmaps 
  259.       Caption         =   "&Dynamic"
  260.       Begin Menu MSubMenu 
  261.          Caption         =   "Dynamic Bitmap 0"
  262.          Index           =   0
  263.       End
  264.       Begin Menu MSubMenu 
  265.          Caption         =   "Dynamic Bitmap 1"
  266.          Index           =   1
  267.       End
  268.       Begin Menu MSubMenu 
  269.          Caption         =   "Dynamic Bitmap 2"
  270.          Checked         =   -1  'True
  271.          Index           =   2
  272.       End
  273.       Begin Menu MSubMenu 
  274.          Caption         =   "Dynamic Bitmap 3"
  275.          Index           =   3
  276.       End
  277.       Begin Menu MSubMenu 
  278.          Caption         =   "Dynamic Bitmap 4"
  279.          Index           =   4
  280.       End
  281.    End
  282.    Begin Menu CreateDynamic 
  283.       Caption         =   "&Create Dynamic Bitmaps!"
  284.    End
  285. DefInt A-Z
  286. 'Window API Function Declarations
  287. Declare Function GetMenu% Lib "user" (ByVal hwnd%)
  288. Declare Function GetSubMenu% Lib "user" (ByVal hMenu%, ByVal nPos%)
  289. Declare Function GetMenuItemID% Lib "user" (ByVal hMenu%, ByVal nPos%)
  290. Declare Function ModifyMenu% Lib "user" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%, ByVal wIDNewItem%, ByVal lpNewItem&)
  291. Declare Function SetMenuItemBitmaps% Lib "user" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%, ByVal hBitmapUnchecked%, ByVal hBitmapChecked%)
  292. Declare Function TrackPopupMenu Lib "user" (ByVal hMenu, ByVal r1, ByVal X, ByVal Y, ByVal r2, ByVal hwnd, ByVal r3&)
  293. Declare Function GetSystemMenu Lib "user" (ByVal hwnd%, ByVal revert%) As Integer
  294. Const MF_BITMAP = &H4
  295. Const CLR_MENUBAR = &H80000004
  296. Const TRUE = -1, FALSE = 0
  297. Dim TextItems$(4), LastSelection%, CurrentText%, hMenu%
  298. Sub Create_Dynamic_Menu_Bitmaps ()
  299.   For I% = 0 To 4
  300.   '* Set the width and height of the Picture controls
  301.   '* based on their corresponding Menu items caption,
  302.   '* and the Picture controls Font and FontSize.
  303.   '* DoEvents() is neccessary to make new dimension
  304.   '* values to take affect prior to exiting this Sub.
  305.     picture3(I%).Width = picture3(I%).TextWidth(MSubMenu(I%).Caption)
  306.     picture3(I%).Height = picture3(I%).TextHeight(MSubMenu(I%).Caption)
  307.     X% = DoEvents()
  308.   '* Set Backcolor of Picture control to that of the
  309.   '* current system Menu Bar color, so Dynamic bitmaps
  310.   '* will appear as normal menu items when menu bar
  311.   '* color is changed via the control panel
  312.     picture3(I%).BackColor = CLR_MENUBAR
  313.   '* Print Text onto Picture control.  This text will
  314.   '* become the bitmap.
  315.     picture3(I%).Print MSubMenu(I%).Caption
  316.   Next I%
  317. '* Obtain handle Second submenu
  318.   hSubMenu% = GetSubMenu(hMenu%, 1)
  319. '* - Set picture controls backgroup picture (Bitmap) to its Image.
  320. '*       Can't use the Image bitmap directly for some reason.
  321. '* - Get ID of sub menu
  322. '* - Replace menu text with bitmap from corresponding picture control
  323. '* - Replace bitmap for menu check mark with custom check mark bitmap
  324.   For I% = 0 To 4
  325.     picture3(I%).Picture = picture3(I%).Image
  326.     menuId% = GetMenuItemID(hSubMenu%, I%)
  327.     X% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%, CLng(picture3(I%).Picture))
  328.     X% = SetMenuItemBitmaps(hMenu%, menuId%, 0, 0, CLng(picture2.Picture))
  329.   Next I%
  330. End Sub
  331. Sub CreateDynamic_Click ()
  332.   CreateDynamic.enabled = False
  333.   Create_Dynamic_Menu_Bitmaps
  334. End Sub
  335. Sub Form_Load ()
  336. '* Obtain handle to the Forms top level menu
  337.   hMenu% = GetMenu(hwnd)
  338.   Static_Bitmaps_To_Menus
  339. '* Initial String with text displayed when menus are selected.
  340. '* (Just so something happens when a menu is selected.)
  341.    TextItems$(0) = "Writing Tools"
  342.    TextItems$(1) = "Fonts"
  343.    TextItems$(2) = "Books/Notes"
  344.    TextItems$(3) = "Printers"
  345.    TextItems$(4) = "Computers"
  346. '* Set "Dynamic" menus submenus initial Menu text values
  347. '* to Fontname + Fontsize of each menu item
  348.   For I% = 0 To 4
  349.     MSubMenu(I%).Caption = picture3(I%).FontName + Str$(picture3(I%).FontSize) + " Pnt"
  350.   Next I%
  351. End Sub
  352. Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  353.     ScaleMode = 3
  354.     InPixels = ScaleWidth
  355.     ScaleMode = 1
  356.     IX = (X + Left) \ (ScaleWidth \ InPixels)
  357.     IY = (Y + (Top + (Height - ScaleHeight - (Width - ScaleWidth)))) \ (ScaleWidth \ InPixels)
  358.     R = TrackPopupMenu(GetSubMenu(hMenu%, Button - 1), 0, IX, IY, 0, hwnd, 0)
  359. End Sub
  360. Sub Form_Paint ()
  361.   Cls
  362.   Print TextItems$(CurrentText%)
  363. End Sub
  364. Sub MSubMenu_Click (Index As Integer)
  365. Static LastSelection%
  366. '* Reset forms FontSize to selected fontsize
  367. '* and redisplay current text
  368.   FontSize = picture3(Index).FontSize
  369.   Form_Paint
  370. '* Uncheck last selected item and check selected item
  371.   MSubMenu(LastSelection%).Checked = False
  372.   MSubMenu(Index).Checked = True
  373.   LastSelection% = Index
  374. End Sub
  375. Sub Static_Bitmaps_To_Menus ()
  376. '* Obtain handle to first submenu
  377.    hSubMenu% = GetSubMenu(hMenu%, 0)
  378. '* - Get ID of each sub menu
  379. '* - Replace menu text with bitmap from corresponding picture control
  380. '* - Replace bitmap for menu check mark with custom check mark bitmap
  381.    For I% = 0 To 4
  382.      menuId% = GetMenuItemID(hSubMenu%, I%)
  383.      X% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%, CLng(picture1(I%).Picture))
  384.      X% = SetMenuItemBitmaps(hMenu%, menuId%, 0, 0, CLng(picture2.Picture))
  385.    Next I%
  386.    SubMenu(1).enabled = 0
  387.    hMenu% = GetSystemMenu(hwnd, 0)
  388.    menuId% = &HF120
  389.    X% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%, CLng(picture3(0).Picture))
  390. End Sub
  391. Sub SubMenu_Click (Index As Integer)
  392. Static LastSelection%
  393. '* Set text to that of selected menu item and
  394. '* display the new text
  395.   CurrentText% = Index
  396.   Form_Paint
  397. '* Uncheck last selected item and check seledted item
  398.   SubMenu(LastSelection%).Checked = False  'Check selected menu
  399.   SubMenu(Index).Checked = True            'UnCheck last selected menu
  400.   LastSelection% = Index                   'Save current selection
  401. End Sub
  402.