需要があるかわかりませんがお試しください。
ファイルにも出力できます。
[ここをクリックすると内容が表示されます]
コード: 全て選択
'===============================================================================
' 名 称 ：イミディエイトウインドウ（もどき）クラス
' 概 要 ：Access等のVBAでDebug.Printのイミディエイトウインドウもどきを表示
' するクラスです。
' ファイル名：DebugClass.sbp
' 作成者 ：hanchan
' ※需要があるか解りませんが、自由に手を加えてかまいません。
' ※いづれ機能を足す予定。（クリアボタンとか。。。）
' ※最大チェックを付けてないので大量に出力すると落ちるかも。
'===============================================================================
'===============================================================================
' 定数定義
'===============================================================================
Const WINDOW_CLASS_DBUGMSD = "DebugMassageWindow" 'ウインドウクラス
Const ID_BUTTON_VIEWMODE = 1 '手前に表示ボタンID
Const ID_EDIT_MSGBOX = 2 'メッセージボックスID
Const ERRMSG_NORMALITY = "正常" 'エラーメッセージ：正常
Const ERRMSG_WARNNING = "警告" 'エラーメッセージ：警告
Const ERRMSG_ABNORMALITY = "異常" 'エラーメッセージ：異常
Dim hDbgWnd As HWND 'イミディエイトウインドウ
Dim wcex As WNDCLASSEX 'ウィンドウクラス
Dim hInstance As HINSTANCE 'インスタンス
Dim bLogFilePath[MAX_PATH] As Byte 'ログファイルパス格納
Dim bLogFileName[MAX_PATH] As Byte 'ログファイル名格納
/* 出力形式列挙型 */
enum DBCD_OUTPUT
DBCD_OUTPUT_IMI_ONLY 'イミディエイトのみ
DBCD_OUTPUT_LOG_ONLY 'ログファイルのみ
DBCD_OUTPUT_ALL '両方
End Enum
/* ワーニングレベル */
enum DBCD_ERRLEVEL
DBCD_ERRLEVEL_NORMALITY = 0 '正常
DBCD_ERRLEVEL_WARNNING = 1 '警告
DBCD_ERRLEVEL_ABNORMALITY = 2 '異常
End Enum
'===============================================================================
' 名 称：イミディエイトウインドウ（もどき）クラス
' 概 要：イミディエイトウインドウを出力する
'===============================================================================
Class DebugClass
Public
'===========================================================================
' 関数名：コンストラクタ
' 説 明：コンストラクタ
' 呼 出：なし
' 引き数：なし
' 戻り値：なし
'===========================================================================
Sub DebugClass()
Dim buff[MAX_PATH] As Byte
Dim i As Long
Dim MaxLen As Long
'インスタンス取得
hInstance = GetModuleHandle(NULL)
With wcex
.cbSize = sizeof(WNDCLASSEX)
.style = CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS
.lpfnWndProc = AddressOf(DbgWndProc)
.hInstance = hInstance
.hIcon = LoadIcon(NULL, MAKEINTRESOURCE(IDI_APPLICATION))
.hIconSm = LoadIcon(NULL, MAKEINTRESOURCE(IDI_WINLOGO))
.hCursor = LoadCursor(NULL, MAKEINTRESOURCE(IDC_ARROW))
.hbrBackground = CreateSolidBrush(GetSysColor(COLOR_3DFACE))
.lpszClassName = WINDOW_CLASS_DBUGMSD
.hIconSm = LoadIcon(NULL, IDI_APPLICATION As *Byte)
End With
RegisterClassEx(wcex)
'exeパスをデフォルトのログ出力パスに設定する
ZeroMemory(buff, MAX_PATH)
MaxLen = GetModuleFileName(hInstance As DWord, buff, MAX_PATH) As Long
For i = MaxLen To 1 Step -1
If (buff = Asc("\")) Then
ZeroMemory(bLogFilePath, MAX_PATH)
memcpy(bLogFilePath, buff, i)
exit for
End If
Next i
'LogFile.logをデフォルトのログファイル名に設定する
ZeroMemory(bLogFileName, MAX_PATH)
lstrcpy(bLogFileName, "LogFile.log")
End Sub
'===========================================================================
' 関数名：Print関数
' 説 明：Debug_Printを呼び出しイミディエイトへ出力する
' 呼 出：Print(String)
' 引き数：pstrbuff As String (I/ ) 出力文字列
' 戻り値：なし
'===========================================================================
Sub Print(pstrbuff As String)
'イミディエイト出力関数を呼び出す
Debug_Print(StrPtr(pstrbuff))
End Sub
'===========================================================================
' 関数名：PrintEx関数
' 説 明：引数の内容をイミディエイト又は、ログファイルに出力する
' 呼 出：PrintEx(String, DBCD_OUTPUT, DBCD_ERRLEVEL)
' 引き数：pstrbuff As String (I/ ) 出力文字列
' pOutPutMode As DBCD_OUTPUT (I/ ) 出力形態
' pErrorLevel As DBCD_ERRLEVEL (I/ ) エラーレベル
' 戻り値： 0:正常
' -1:異常
'===========================================================================
Function PrintEx(pstrbuff As String, pOutPutMode As DBCD_OUTPUT,
pErrorLevel As DBCD_ERRLEVEL)
'出力モードがイミディエイトの場合、イミディエイトに出力する
If ((pOutPutMode = DBCD_OUTPUT_IMI_ONLY) Or _
(pOutPutMode = DBCD_OUTPUT_ALL)) Then
'イミディエイト出力関数を呼び出す
Debug_Print(StrPtr(pstrbuff))
End If
'出力モードがログファイルの場合、イミディエイトに出力する
If ((pOutPutMode = DBCD_OUTPUT_LOG_ONLY) Or _
(pOutPutMode = DBCD_OUTPUT_ALL)) Then
'ログ出力関数を呼び出す
Debug_Log(StrPtr(pstrbuff), pErrorLevel)
End If
End Function
'===========================================================================
' 関数名：SetLogFilePath関数
' 説 明：ログファイルの出力ディレクトリを設定する
' 呼 出：SetLogFilePath(String)
' 引き数：pstrbuff As String (I/ ) ログファイルパス
' 戻り値：なし
'===========================================================================
Sub SetLogFilePath(pstrbuff As String)
'ログファイルのパスを設定する
ZeroMemory(bLogFilePath, MAX_PATH)
lstrcpy(bLogFilePath, StrPtr(pstrbuff))
End Sub
'===========================================================================
' 関数名：GetLogFilePath関数
' 説 明：ログファイルの出力ディレクトリを取得する
' 呼 出：GetLogFilePath()
' 引き数：なし
' 戻り値：ログファイルパス
'===========================================================================
Function GetLogFilePath() As BytePtr
'ログファイルのパスを取得する
GetLogFilePath = VarPtr(bLogFilePath)
End Function
'===========================================================================
' 関数名：SetLogFileName関数
' 説 明：ログファイルの出力ログファイル名を設定する
' 呼 出：SetLogFileName(String)
' 引き数：pstrbuff As String (I/ ) ログファイルパス
' 戻り値：なし
'===========================================================================
Sub SetLogFileName(pstrbuff As String)
'ログファイルのパスを設定する
ZeroMemory(bLogFilePath, MAX_PATH)
lstrcpy(bLogFilePath, StrPtr(pstrbuff))
End Sub
'===========================================================================
' 関数名：GetLogFileName関数
' 説 明：ログファイルの出力ファイル名を取得する
' 呼 出：GetLogFileName()
' 引き数：なし
' 戻り値：ログファイルパス
'===========================================================================
Function GetLogFileName() As BytePtr
'ログファイルのパスを取得する
GetLogFileName = VarPtr(bLogFilePath)
End Function
Protected
'===========================================================================
' 関数名：Debug_Print関数
' 説 明：イミディエイトウインドウに文字列を出力する
' 呼 出：strMas(BytePtr)
' 引き数：strMas As BytePtr (I/ ) 出力文字列
' 戻り値：なし
'===========================================================================
Function Debug_Print(strMas As BytePtr) As Long
Dim hEdit As HANDLE
Dim lngLen As Long
Dim strBuff As String
If (hDbgWnd = 0) Then
hDbgWnd = CreateWindowEx( _
NULL, _
WINDOW_CLASS_DBUGMSD, _
"イミディエイト（もどき）", _
&H10cc0000, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
283, _
234, _
0, _
0 As HMENU, _
GetModuleHandle(0), _
0 _
)
SetWindowLong(hDbgWnd, GWL_WNDPROC, AddressOf(DbgWndProc) As Long)
SendMessage(hDbgWnd, WM_INITDIALOG, 0, 0)
End If
strBuff = MakeStr(strMas) + Chr$(13) + Chr$(10)
hEdit = GetDlgItem(hDbgWnd, ID_EDIT_MSGBOX)
lngLen = GetWindowTextLength(hEdit)
SendMessage(hEdit, EM_SETSEL, lngLen, lngLen)
SendMessage(hEdit, 194, 0, StrPtr(strBuff) As LPARAM)
SetFocus(hEdit)
End Function
'===========================================================================
' 関数名：DbgWndProc関数
' 説 明：イミディエイトウインドウコールバック
'===========================================================================
Function DbgWndProc( hWnd As Dword, Msg As Dword,
wParam As Dword, lParam As Dword ) As Long
Dim hFont_DbgWnd As HFONT
Select Case ( Msg )
Case WM_SIZE
DbgWnd_Resize(wParam,LOWORD(lParam),HIWORD(lParam))
Case WM_INITDIALOG
hFont_DbgWnd=CreateFont(
-12,0,0,0,400,0,0,0,128,3,2,1,49,"ＭＳ ゴシック")
CreateWindowEx(
&H00000000,
"BUTTON",
"手前に表示",
&H50001f03,
0,
2,
92,
28,
hWnd As HWND,
ID_BUTTON_VIEWMODE As HMENU,
GetModuleHandle(0),
0
)
SendMessage(
GetDlgItem(hWnd As HWND, ID_BUTTON_VIEWMODE),
WM_SETFONT,
hFont_DbgWnd As WPARAM,
0
)
CreateWindowEx(
&H00000200,
"EDIT",
"",
&H50200844,
0,
32,
275,
175,
hWnd As HWND,
ID_EDIT_MSGBOX As HMENU,
GetModuleHandle(0),
0
)
SendMessage(
GetDlgItem(hWnd As HWND, ID_EDIT_MSGBOX),
WM_SETFONT,
hFont_DbgWnd As WPARAM,
0
)
Case WM_DESTROY
Case WM_CLOSE
DestroyWindow(hWnd As HWND)
hDbgWnd = 0
Case WM_COMMAND
If (wParam = ID_BUTTON_VIEWMODE) Then
DbgWnd_ViewMode_Clisk()
End If
Case Else
DbgWndProc = DefWindowProc( hWnd As HWND, Msg, wParam, lParam )
Exit Function
End Select
DbgWndProc = 0
End Function
'===========================================================================
' 関数名：DbgWnd_ViewMode_Clisk関数
' 説 明：手前に表示ボタンクリックイベント
'===========================================================================
Sub DbgWnd_ViewMode_Clisk()
If SendMessage( _
GetDlgItem(hDbgWnd, ID_BUTTON_VIEWMODE), BM_GETCHECK,0,0) Then
SetWindowPos(hDbgWnd, HWND_TOPMOST As HWND,
0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
Else
SetWindowPos(hDbgWnd, HWND_NOTOPMOST As HWND,
0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
EndIf
End Sub
'===========================================================================
' 関数名：DbgWnd_Resize関数
' 説 明：イミディエイトウインドウサイズイベント
'===========================================================================
Sub DbgWnd_Resize(SizeType As Long, cx As Integer, cy As Integer)
Dim hEdit As HANDLE
Dim rc As RECT
'エディットボックスの大きさを変更する
hEdit = GetDlgItem(hDbgWnd, ID_EDIT_MSGBOX)
MoveWindow(hEdit, 0, 32, cx, cy - 32, FALSE)
'フォーカスをセット
SetFocus(hEdit)
End Sub
'===========================================================================
' 関数名：Debug_Log関数
' 説 明：ログファイルに文字列を出力する
' 呼 出：strMas(BytePtr, DBCD_ERRLEVEL)
' 引き数：strMas As BytePtr (I/ ) 出力文字列
' 戻り値：なし
'===========================================================================
Function Debug_Log(strMas As BytePtr, pErrorLevel As DBCD_ERRLEVEL) As Long
Dim byOutPutFilePath[MAX_PATH] As Byte
Dim lngPathSize As Long
Dim hFile As HANDLE
Dim buff[MAX_PATH] As Byte
Dim bDay[8] As Byte
Dim bTime[8] As Byte
Dim lngWrite As Long
Dim ret As Long
'変数初期化
Debug_Log = 0
ZeroMemory(byOutPutFilePath, MAX_PATH)
ZeroMemory(buff, MAX_PATH)
'ファイルパス作成
lngPathSize = lstrlen(bLogFilePath)
lstrcpy(byOutPutFilePath, bLogFilePath)
if (bLogFilePath[lngPathSize - 1] <> Asc("\")) Then
lstrcat(byOutPutFilePath, "\")
End If
lstrcat(byOutPutFilePath, bLogFileName)
'現在日付を取得する
ret = GetDateFormat(
LOCALE_USER_DEFAULT,
0,
ByVal 0,
"yy/MM/dd",
bDay,
8,
)
'現在時刻を取得する
ret = GetTimeFormat(
LOCALE_USER_DEFAULT,
0,
ByVal 0,
"HH:mm:ss",
bTime,
8,
)
'出力文字列を作成する
lstrcpy(buff, "[")
lstrcat(buff, bDay)
lstrcat(buff, " ")
lstrcat(buff, bTime)
lstrcat(buff, "][")
if (pErrorLevel = DBCD_ERRLEVEL_NORMALITY) Then
lstrcat(buff, ERRMSG_NORMALITY)
ElseIf (pErrorLevel = DBCD_ERRLEVEL_WARNNING) Then
lstrcat(buff, ERRMSG_WARNNING)
ElseIf (pErrorLevel = DBCD_ERRLEVEL_ABNORMALITY) Then
lstrcat(buff, ERRMSG_ABNORMALITY)
End If
lstrcat(buff, "]")
lstrcat(buff, strMas)
/* ファイルを作成する */
hFile = CreateFile(
byOutPutFilePath,
GENERIC_WRITE,
0,
ByVal 0,
OPEN_ALWAYS,
FILE_ATTRIBUTE_NORMAL,
0
)
CloseHandle(hFile)
Open byOutPutFilePath For Append As #1
Print #1, MakeStr(buff)
Close #1
End Function
End Class
/* 外部変数定義 */
Dim DebugCls As DebugClass
使用方法です。
includeして使用してください。
#ifdefで囲むとよいと思います。
[ここをクリックすると内容が表示されます]
コード: 全て選択
#define DEBUG
#ifdef DEBUG
#include "DebugClass.sbp"
#endif
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
DebugClsTest_DestroyObjects()
PostQuitMessage(0)
End Sub
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
Dim i As Long
Dim strTemp As String
i = 123
strTemp = "文字列"
#ifdef DEBUG
'イミディエイトに出力
DebugCls.Print("既定値ログファイルパス：" & MakeStr(DebugCls.GetLogFilePath()))
DebugCls.Print("既定値ログファイル名 ：" & MakeStr(DebugCls.GetLogFileName()))
DebugCls.Print("i ：" & Str$(i))
DebugCls.Print("strTemp：" & strTemp)
#endif
End Sub
Sub MainWnd_CommandButton1_Click()
#ifdef DEBUG
'PrintExイミディエイト出力
DebugCls.PrintEx(
"ボタン１がクリックされました。(イミディエイトのみに出力)",
DBCD_OUTPUT_IMI_ONLY,
DBCD_ERRLEVEL_NORMALITY)
#endif
End Sub
Sub MainWnd_CommandButton2_Click()
#ifdef DEBUG
'PrintExログファイル出力
DebugCls.PrintEx(
"ボタン２がクリックされました。(ログファイルのみに出力)",
DBCD_OUTPUT_LOG_ONLY,
DBCD_ERRLEVEL_NORMALITY)
#endif
End Sub
Sub MainWnd_CommandButton3_Click()
#ifdef DEBUG
'PrintExログ＆イミディエイト出力
DebugCls.PrintEx(
"ボタン３がクリックされました。(ログとイミディエイトに出力)",
DBCD_OUTPUT_ALL,
DBCD_ERRLEVEL_NORMALITY)
#endif
End Sub
Sub MainWnd_CommandButton4_Click()
#ifdef DEBUG
'PrintExログファイル出力（エラーレベル）
DebugCls.PrintEx(
"ボタン４がクリックされました。(警告で出力)",
DBCD_OUTPUT_LOG_ONLY,
DBCD_ERRLEVEL_WARNNING)
DebugCls.PrintEx(
"ボタン４がクリックされました。(異常で出力)",
DBCD_OUTPUT_LOG_ONLY,
DBCD_ERRLEVEL_ABNORMALITY)
#endif
End Sub