yohhoyの日記(別館)

もうちょい長めの技術的メモをしていきたい日記

UnVisualBasic 6.0

この記事は2001年頃に書いた文章をそのまま転記し、はてなブログ用に体裁を整えたものです。Visual Basic 6.0を前提としていますが、当時からネタ記事なので悪しからず。

プロジェクト一式はこちら: https://gist.github.com/yohhoy/3054269


まえがき

往々にしてGUI(Graphical User Interface)プログラミングではコード量が多くなり面倒なものですが、Microsoft社のVisualBasicを用いると僅かなコーディングで簡単・迅速にGUI構築することが可能になります。
しかし、VBの守備範囲を越えたことを実装する際には、どうしてもWin32API等に頼らざるを得ません。これを見越して(?)かVBには外部DLL関数を呼ぶ仕掛けが用意されています。この機能を使えばWindows上で可能なことは大抵実装できます。さらにVB5.0から導入された AddressOf演算子 を用いるとVB関数のアドレスが取得できます。つまりVBでコールバック関数が使用可能になったのです。この AddressOf演算子 の登場で、(実用上ほぼ)全てのAPI関数が利用できるようになったのです。

目的

AddressOf演算子 の登場でVBでもウインドウのサブクラス化を実現できるようになり、今までOCXやDLLに頼っていた機能を自前で実装できるようになりました。
ここまでVBで実現できるのなら、いっそVBの機能を使わず(基本制御構造は除く)にWin32APIのみでソフトを開発出来ないかと考えてみました。要するに、本来ならメニューから

[プロジェクト]→[フォームモジュールの追加]

とするだけで終わるところを、RegisterClass関数やCreateWindow関数等を用いて実装しようというのが目的です。

実装例1

とりあえず上記の目標に従って実装してみました。ただしAPI関数のDeclare宣言や型の定義、定数の定義は省いています。

Private m_hInstance As Long

Private Const WNDCLSNAME As String = "TrickyVbWndCls"
Private Const IDM_EXIT = 1

'
' Entry Point
'
Public Sub Main()
  Dim wc As WNDCLASS
  Dim hMenu As Long, hSubMenu As Long
  Dim hwnd As Long
  Dim message As MSG

  '初期化
  m_hInstance = GetModuleHandle(0)

  'ウインドウクラスを登録
  With wc
    .style = CS_VREDRAW Or CS_HREDRAW
    .lpfnWndProc = funcaddr(AddressOf WindowProc)
    .cbClsExtra = 0
    .cbWndExtra = 0
    .hinstance = m_hInstance
    .hIcon = LoadIcon(0, IDI_APPLICATION)
    .hCursor = LoadCursor(0, IDC_ARROW)
    .hbrBackground = COLOR_BTNFACE + 1
    .lpszMenuName = vbNullString
    .lpszClassName = WNDCLSNAME
  End With
  Call RegisterClass(wc)

  'メニュー作成
  hMenu = CreateMenu()
  hSubMenu = CreatePopupMenu()
  Call AppendMenu(hMenu, MF_STRING Or MF_POPUP, hSubMenu, "&File")
  Call AppendMenu(hSubMenu, MF_STRING, IDM_EXIT, "&Exit")

  'ウインドウ作成
  hwnd = CreateWindowEx(0, WNDCLSNAME, "tricky", _
                  WS_OVERLAPPEDWINDOW, _
                  CW_USEDEFAULT, CW_USEDEFAULT, _
                  CW_USEDEFAULT, CW_USEDEFAULT, _
                  0, hMenu, m_hInstance, 0)
  Call ShowWindow(hwnd, SW_SHOW)

  'メッセージループ
  Do While (GetMessage(message, 0, 0, 0))
    Call TranslateMessage(message)
    Call DispatchMessage(message)
  Loop

  'メニュー破棄
  Call DestroyMenu(hSubMenu)
  Call DestroyMenu(hMenu)

End Sub

'
' ウインドウプロシージャ
'
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
  ByVal wParam As Long, ByVal lParam As Long) As Long

  WindowProc = 0

  Select Case uMsg
  Case WM_CREATE
    '

  Case WM_COMMAND
    Select Case (wParam And &HFFFF)
    Case IDM_EXIT '[Exit]
      'ウインドウを閉じる
      Call SendMessage(hwnd, WM_CLOSE, 0, 0)
    End Select

  Case WM_DESTROY
    'アプリケーション終了
    Call PostQuitMessage(0)

  Case Else
    WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)

  End Select

End Function

Private Function funcaddr(ByVal addr As Long) As Long
  funcaddr = addr
End Function

当然のことですが、基本制御構造の If や Do While や Select Case、Call ステートメント を使用しないというのは不可能ですね。
あと、メニューはリソースにしようと思ったのですがVBのリソースエディタでは無理でした。VC++でリソース(.res)だけ作成すればどうにかなったかも…
わざわざ funcaddr()関数を作っているのは、AddressOf演算子が返す値(Long型)を変数に直接代入できなかった為です。

実装例2

ちなみに実装例1と同等のプログラムを、VB本来の手法で作ってみます。

  • メニューから[プロジェクト]→[フォームモジュールの追加]
  • 新しく作ったフォームを右クリックして[メニューエディタ]
  • キャプション:&File 名前:mnuFile [次へ]をクリック
  • キャプション:&Exit 名前:mnuFileExit [⇒]をクリック
  • [OK]で閉じる
  • フォーム上のメニューから[File]→[Exit]

開いたコードエディタ上で

Private Sub mnuFileExit_Click()
    Unload Me
End Sub

以上。
コーディング量は "Unload Me" の9文字だけ!この際 "Unload" だけでも可!

結論

餅は餅屋

付録

普通にC言語とWin32SDKで作るとこんな感じになります。

#define STRICT
#include <windows.h>

/* マクロ定義 */
#define WNDCLSNAME "TrickyVbWndCls"
#define IDM_EXIT   1

/* 関数プロトタイプ宣言 */
LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg,
  WPARAM wParam, LPARAM lParam);

/* Entry Point */
int WINAPI WinMain(
  HINSTANCE hInstance,
  HINSTANCE hPrevInstance,
  LPSTR lpCmdLine,
  int nCmdShow)
{
  WNDCLASS wc;
  HMENU hmenu, hsubmenu;
  HWND hwnd;
  MSG msg;

  /* ウインドウクラスを登録 */
  wc.style = CS_VREDRAW | CS_HREDRAW;
  wc.lpfnWndProc = WindowProc;
  wc.cbClsExtra = 0;
  wc.cbWndExtra = 0;
  wc.hInstance = hInstance;
  wc.hIcon = LoadIcon(0, IDI_APPLICATION);
  wc.hCursor = LoadCursor(0, IDC_ARROW);
  wc.hbrBackground = (HBRUSH)(COLOR_BTNFACE + 1);
  wc.lpszMenuName = NULL;
  wc.lpszClassName = WNDCLSNAME;
  RegisterClass(&wc);

  /* メニュー作成 */
  hmenu = CreateMenu();
  hsubmenu = CreatePopupMenu();
  AppendMenu(hmenu, MF_STRING|MF_POPUP, (UINT)hsubmenu, "&File");
  AppendMenu(hsubmenu, MF_STRING, IDM_EXIT, "&Exit");

  /* ウインドウ作成 */
  hwnd = CreateWindowEx(0, WNDCLSNAME, "tricky",
                        WS_OVERLAPPEDWINDOW,
                        CW_USEDEFAULT, CW_USEDEFAULT,
                        CW_USEDEFAULT, CW_USEDEFAULT,
                        0, hmenu, hInstance, 0);
  ShowWindow(hwnd, nCmdShow);

  /* メッセージループ */
  while (GetMessage(&msg, NULL, 0, 0)) {
     TranslateMessage(&msg);
     DispatchMessage(&msg);
  }

  /* メニュー破棄 */
  DestroyMenu(hsubmenu);
  DestroyMenu(hmenu);

  return 0;
}

/* ウインドウプロシージャ */
LRESULT CALLBACK WindowProc(
  HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
  switch (uMsg) {
  case WM_CREATE:
    /* ... */
    break;

  case WM_COMMAND:
    switch (LOWORD(wParam)) {
    case IDM_EXIT: /* [Exit] */
       /* ウインドウを閉じる*/
       SendMessage(hwnd, WM_CLOSE, 0, 0);
       break;
    }
    break;

  case WM_DESTROY:
    /* アプリケーション終了 */
    PostQuitMessage(0);
    break;

  default:
    return DefWindowProc(hwnd, uMsg, wParam, lParam);
  }
  return 0;
}