VB6サンプルを作成してみました。
私の変換がおかしいでしょうか、Menuの終了からでないと、プロセスが残ります。
終了するときは×をクリックせず、Menuの終了から終了するようにしてください。
これはあくまでサンプルです。(心無いツッコミはご遠慮ください!)
・フォームと標準モジュールを含んだプロジェクトを作成してください。
・サンプルは「C:\SoftAd.DLL」があることが前提です。
・フォームには、メニューを必要とします。
キャプション:終了(&E)
名前:mnuEnd
'--------------------------------------------
'Form1
'--------------------------------------------
Option Explicit
Private myWnd As Long
Private Sub Form_Load()
myWnd = Me.hWnd
Call SA_Initialize(Me.hWnd, 0, FC_AD, 30000) '//SoftAdd
glngWndProc = _
SetWindowLong(myWnd, _
GWL_WNDPROC, _
AddressOf WinProc _
)
Me.Show
Me.Refresh
End Sub
Private Sub mnuEnd_Click()
Unload Me
End Sub
'--------------------------------------------
'Module1
'--------------------------------------------
Option Explicit
Public Const GWL_WNDPROC As Long = (-4)
Private Const WM_PAINT As Long = &HF
Private Const WM_DESTROY As Long = &H2
Private Const WM_MEASUREITEM As Long = &H2C
Private Const WM_DRAWITEM As Long = &H2B
Private Const DT_CENTER As Long = &H1
Private Const DT_VCENTER As Long = &H4
Private Const DT_SINGLELINE As Long = &H20
Public Const FC_EXIT As Long = 100
Public Const FC_AD As Long = 200
Public glngWndProc As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type PAINTSTRUCT
hdc As Long
fErase As Long
rcPaint As RECT
fRestore As Long
fIncUpdate As Long
rgbReserved(32) As Byte
End Type
Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function BeginPaint Lib "user32" (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function EndPaint Lib "user32" (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long
Public Declare Function SA_Initialize Lib "c:\SoftAd.dll" (ByVal hWnd As Long, ByVal hMenu As Long, ByVal fc As Long, ByVal softId As Long) As Long
Public Declare Sub SA_Cleanup Lib "c:\SoftAd.dll" ()
Public Declare Sub SA_InitMenuItem Lib "c:\SoftAd.dll" (ByVal lpDRAWITEMSTRUCT As Long)
Public Declare Sub SA_DrawMenuItem Lib "c:\SoftAd.dll" (ByVal lpDRAWITEMSTRUCT As Long)
Public Function WinProc( _
ByVal hWnd As Long, _
ByVal iMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long
WinProc = False
Select Case iMsg
Case WM_PAINT
Dim ps As PAINTSTRUCT
Dim hdc As Long
Dim rc As RECT
hdc = BeginPaint(hWnd, ps)
Call GetClientRect(hWnd, rc)
Call DrawText(hdc, "Hello World!", -1, rc, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE)
Call EndPaint(hWnd, ps)
Case WM_DESTROY
Call SA_Cleanup '//SoftAdd
Call SetWindowLong(hWnd, GWL_WNDPROC, glngWndProc)
Case WM_MEASUREITEM
Call SA_InitMenuItem(ByVal lParam) '//SoftAdd
Case WM_DRAWITEM
Call SA_DrawMenuItem(ByVal lParam) '//SoftAdd
End Select
WinProc = DefWindowProc(hWnd, iMsg, wParam, lParam)
Call CallWindowProc(glngWndProc, hWnd, iMsg, wParam, lParam)
End Function
お礼
回答ありがとうございましたm(__)m 自作ソフトでは「Case WM_PAINT」以下がいらなかったので、その部分を削除したのですが、メニューバーからツールバーまでの間が２行程度空いてしまいました。 色々やってみます。 ありがとうございました。