ホーム > カテゴリ > Visual Basic >

システムメニューに新しい項目を追加する

システムメニューに新しい項目を追加するサンプルです。

サンプルの実行画面

APIの宣言

[SysMenu.bas]

'☆注意事項☆
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'
'(1)絶対にデバックの「ステップイン、ステップオーバー」等で、実行しないでください。
'(2)絶対に「■」ボタンで終了しないでください。
'   (1)と(2) >>>最悪の場合、Windowsが起動しなくなる可能性があります。
'(3)システムメニューとはウインドウの左上のアイコンをクリックして、
'  表示されるメニューのことです。
'
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■


'-----------------------------------------
'システムメニューのハンドルを取得するAPI関数
'-----------------------------------------

 'hWnd:ウインドウのハンドル
 'bRevert:0か1
 
 '戻り値:システムメニューのハンドル

Public Declare Function GetSystemMenu Lib "USER32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long


'-----------------------------------
'メニュー項目の文字列を取得するAPI関数
'-----------------------------------

 'hMen:メニューのハンドル
 'wIDItem:メニューのID(SC_××でもよい)
 'lpString:文字列を格納する変数
 'nMaxCount:取得する最大値
 'wFlag:定数(MF_××参照)
 
 '戻り値:取得した文字数
Public 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
  
  
'------------------------------
'既存のメニューを操作するAPI関数
'------------------------------
  
  'hMenu:メニューのハンドル
  'nPosition:定数(SC_××参照)
  'wFlags:定数(MF_××参照)
  'wIDNewItem:コマンドID
  'lpString:システムメニューのラベル
  
  '戻り値:正常終了0以外
  
Public Declare Function ModifyMenu Lib "USER32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As String) As Long


'-----------------------------------
'メニューに新しい項目を追加するAPI関数
'-----------------------------------

 'hMenu:メニューのハンドル
 'nPosition:定数(SC_××参照)>>その上に追加
 'wFlags::MF_BYCOMMAND
 'wIDNewItem:
 'lpNewItem:項目の文字列
 
 '戻り値:正常終了0以外
 
Public Declare Function InsertMenu Lib "USER32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition&, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long


'-------------------------------------
'ウインドウに関する情報を設定するAPI関数
'-------------------------------------

 'hWnd:ウインドウのハンドル
 'nIndex:定数(GWL_××参照)
 'dwNewLong:設定する32ビット値
 
 '戻り値:直前のウインドウプロシージャのアドレス

Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long


'---------------------------------------------
'Windowsメッセージをウインドウプロシージャに渡す
'---------------------------------------------
 
 'lpPrevWndFunc:ウインドウ関数へのポインタ
 'hWnd:ウインドウのハンドル
 'Msg:メッセージ
 'wParam:パラメータ
 'lParam:パラメータ


Public 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


'---------------------------------------
'システムメニューの項目数を取得するAPI関数
'---------------------------------------

  'hMenu:システムメニューのハンドル
  
  '戻り値:システムメニューの項目数

Public Declare Function GetMenuItemCount Lib "USER32" (ByVal hMenu As Long) As Long


'------------------------------------
'メニュー項目のIDを取得するAPI関数
'------------------------------------

  'hMenu:メニューのハンドル
  'nPos:メニューの項目の位置(0から)

  '戻り値:ID
  
Public Declare Function GetMenuItemID Lib "USER32" (ByVal hMenu As Long, ByVal nPos As Long) As Long


'----
'定数
'----

Public Const SC_CLOSE = &HF060      '「閉じる」
Public Const SC_SIZE = &HF000       '「サイズ変更」
Public Const SC_MAXIMIZE = &HF030   '「最大化」
Public Const SC_RESTORE = &HF120    '「元のサイズに戻す」
Public Const SC_MINIMIZE = &HF020   '「最小化」
Public Const SC_MOVE = &HF010       '「移動」

Public Const MF_BYCOMMAND = &H0&

Public Const GWL_WNDPROC = (-4)     'ウインドウ関数

Public Const WM_SYSCOMMAND = &H112  'システムメニューを選択した


'-----
'変数
'-----
Public Address As Long              'ウインドウプロシージャのアドレス
Public MenuCount As Long            'システムメニューの数
Public MenuString() As String       'システムメニューの項目の文字列
Public MenuID() As Long             'システムメニューの項目のID

'-------------------------------------------------
'■関数名 ADDMenu
'■用途  システムメニューに新しい項目を追加する
'■引数
'         nHandle   :ウインドウのハンドル
'         Flag      :追加する位置(SC_××参照)
'         nString   :追加する文字列
'■戻り値 正常終了1
'-------------------------------------------------
Public Function ADDMenu(nHandle As Long, Flag As String, nString As String) As Long

    Static Count As Long    '追加した項目数
     
    Dim Ret As Long         '戻り値
    Dim hMen As Long        '戻り値(システムメニューのハンドル)
    Dim nLeng As Long       '戻り値(ラベルの文字数)
                  
  'システムメニューのハンドル、項目数を確保
   hMen = GetMenu(nHandle)
  '項目に追加した件数
   Count = Count + 1
  '配列を確保
   Call nRedim
  '-4097から追加する
   MenuID(MenuCount - 1) = -4097 - Count
  'メニューに新しい項目を追加する
   Ret = InsertMenu(hMen, Flag, MF_BYCOMMAND, MenuID(MenuCount - 1), nString)
  '正常に追加されたか判別
   If Ret <> 0 Then ADDMenu = 1
  '配列にメニューの情報を格納
   Call MenuItem(nHandle)
          
End Function

'----------------------------------------------
'■関数名 MenuItem
'■用途  システムメニューの情報を配列へ格納する
'■引数    nHandle :ウインドウのハンドル
'----------------------------------------------
Public Sub MenuItem(nHandle As Long)
    
  Dim lpString As String * 256      'システムメニューの文字列
  Dim hMen As Long                  '戻り値(システムメニューのハンドル)
  
   'システムメニューのハンドルと項目数を取得
    hMen = GetMenu(nHandle)
   '配列を確保
    Call nRedim
 
   For i = 0 To MenuCount - 1
      
      'システムメニューのIDを配列へ
        MenuID(i) = GetMenuItemID(hMen, i)
        
      'システムメニューのラベルを取得
        nLeng = GetMenuString(hMen, MenuID(i), lpString, Len(lpString), MF_BYCOMMAND)
      '取得したラベルを配列へ
        MenuString(i) = Left(lpString, nLeng)
   
   Next

End Sub

'--------------------
'■関数名 nRedim
'■用途  配列を確保
'--------------------
Public Sub nRedim()

ReDim MenuString(MenuCount) As String
ReDim MenuID(MenuCount) As Long

End Sub

'---------------------------------------------------
'■関数名 GetMenu
'■用途  システムメニューのハンドル、項目数を取得する
'■引数   nHandle: ウインドウのハンドル
'■戻り値 システムメニューのハンドル
'---------------------------------------------------
Public Function GetMenu(nHandle As Long) As Long
 
   'システムメニューのハンドルを確保
   hMen = GetSystemMenu(nHandle, 0)
   'システムメニューの項目数を取得
   MenuCount = GetMenuItemCount(hMen)
   '戻り値をシステムメニューのハンドルにする
   GetMenu = hMen

End Function

'---------------------------------------------------------
'■関数名 MsgProc
'■用途  システムメニューで選択された項目をMsgBoxで表示する
'■引数   nHandle: ウインドウのハンドル
'         nMsg:   Windowsのメッセージ
'         wParam: メニューID
'       lParam: パラメータ
'----------------------------------------------------------
Public Function MsgProc(ByVal nHandle As Long, ByVal nMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
  Dim i As Long
  
  'WM_SYSCOMMANDをつかまえる
    If nMsg = WM_SYSCOMMAND Then
       For i = 0 To MenuCount - 1
        'メッセージボックスに選択した項目を表示する
         If wParam = MenuID(i) Then MsgBox MenuString(i)
       Next i
   End If
  
  MsgProc = CallWindowProc(Address, nHandle, nMsg, wParam, lParam)

End Function

APIの呼び出し

[SysMenu.frm]

 Dim nString As String      '追加する文字列(""にすれば区切り線になります)

Private Sub Option1_Click(Index As Integer)
  
  Dim Ret As Long

  nString = Text1.Text

  Select Case Index
  
    Case 0
      Ret = ADDMenu(hWnd, SC_RESTORE, nString)
      If Ret = 1 Then msg ("「元のサイズに戻す」の上に")
    Case 1
      Ret = ADDMenu(hWnd, SC_MOVE, nString)
      If Ret = 1 Then msg ("「移動」の上に")
    Case 2
      Ret = ADDMenu(hWnd, SC_SIZE, nString)
      If Ret = 1 Then msg ("「サイズ変更」の上に")
    Case 3
      Ret = ADDMenu(hWnd, SC_MINIMIZE, nString)
      If Ret = 1 Then msg ("「最小化」の上に")
    Case 4
      Ret = ADDMenu(hWnd, SC_MAXIMIZE, nString)
      If Ret = 1 Then msg ("「最大化」の上に")
    Case 5
      Ret = ADDMenu(hWnd, SC_CLOSE, nString)
      If Ret = 1 Then msg ("「閉じる」の上に")
      
  End Select

End Sub

Private Sub Form_Load()
  
 '現在のメニューの情報を配列に格納する
  Call MenuItem(hWnd)
  
 'Widowsメッセージをフックします
  Address = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf MsgProc)

  
End Sub

Private Sub msg(Here As String)

MsgBox "システムメニューの" & Here & "「" & nString & "」という項目を追加しました"

End Sub

'---------------------
'ここからは終了時の処理
'---------------------
Private Sub Command1_Click()
   Form_Unload 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Dim Ret As Long
      Ret = SetWindowLong(hWnd, GWL_WNDPROC, Address)
      Unload Me
End Sub

ソースコード一式のダウンロード

vbapi_sysmenu.zip 4.19 KB (4,291 バイト)

このサンプルの動作環境について

このサンプルは 「Windows98」及び「Microsoft Visual Basic 5.0 Professional Edition」で確認しております。環境が異なる場合は正常に動作しない場合もございますのでご了承下さい。





関連記事



公開日:2015年03月04日
記事NO:00362