作成者 |
メッセージ |
|
|
便利なもの、有用なものが評価されないのはおかしい
あるべきところにあるべきはずのものが本来の場所に。
便利なもの、有用なものが評価されないのはおかしい あるべきところにあるべきはずのものが本来の場所に。
|
|
|
投稿記事 |
Posted: 2010年6月07日(月) 04:39 |
|
|
|
|
|
指摘ありがとうございます。
> どうでもいいレスですが、
> DbgWnd_ViewMode_Clisk→DbgWnd_ViewMode_Clickですよね。
すみません。
誤字です。。。
ご指摘の通り修正しました。
> また、wcex構造体のhbrBackgroundメンバの指定を
> コード: .hbrBackground = (COLOR_3DFACE + 1) As HBRUSH
> と変えたほうがよいかと。
> このままだとブラシハンドルのリークが起きるので。
知りませんでした。。。
今まで作ったの全部修正しないと行けないかも。。。
ところで、このクラスは需要はあるのかな?
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード:
'===============================================================================
' 名 称 :イミディエイトウインドウ(もどき)クラス
' 概 要 :Access等のVBAでDebug.Printのイミディエイトウインドウもどきを表示
' するクラスです。
' ファイル名:DebugClass.sbp
' 作成者 :hanchan
' 修正日 :2005.12.09
' ※需要があるか解りませんが、自由に手を加えてかまいません。
' ※いづれ機能を足す予定。(クリアボタンとか。。。)
' ※最大チェックを付けてないので大量に出力すると落ちるかも。
'===============================================================================
'===============================================================================
' 定数定義
'===============================================================================
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))
*/
.hbrBackground = (COLOR_3DFACE + 1) As HBRUSH
.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,"MS ゴシック")
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()
*/
DbgWnd_ViewMode_Click()
End If
Case Else
DbgWndProc = DefWindowProc( hWnd As HWND, Msg, wParam, lParam )
Exit Function
End Select
DbgWndProc = 0
End Function
'===========================================================================
' 関数名:DbgWnd_ViewMode_Click関数
' 説 明:手前に表示ボタンクリックイベント
'===========================================================================
/*
Sub DbgWnd_ViewMode_Clisk()
*/
Sub DbgWnd_ViewMode_Click()
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
指摘ありがとうございます。
> どうでもいいレスですが、 > DbgWnd_ViewMode_Clisk→DbgWnd_ViewMode_Clickですよね。 すみません。 誤字です。。。 ご指摘の通り修正しました。
> また、wcex構造体のhbrBackgroundメンバの指定を > [code] .hbrBackground = (COLOR_3DFACE + 1) As HBRUSH[/code] > と変えたほうがよいかと。 > このままだとブラシハンドルのリークが起きるので。 知りませんでした。。。 今まで作ったの全部修正しないと行けないかも。。。
ところで、このクラスは需要はあるのかな?
[hide][code] '=============================================================================== ' 名 称 :イミディエイトウインドウ(もどき)クラス ' 概 要 :Access等のVBAでDebug.Printのイミディエイトウインドウもどきを表示 ' するクラスです。 ' ファイル名:DebugClass.sbp ' 作成者 :hanchan ' 修正日 :2005.12.09 ' ※需要があるか解りませんが、自由に手を加えてかまいません。 ' ※いづれ機能を足す予定。(クリアボタンとか。。。) ' ※最大チェックを付けてないので大量に出力すると落ちるかも。 '===============================================================================
'=============================================================================== ' 定数定義 '=============================================================================== 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)) */ .hbrBackground = (COLOR_3DFACE + 1) As HBRUSH .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[i] = 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,"MS ゴシック")
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() */ DbgWnd_ViewMode_Click() End If Case Else DbgWndProc = DefWindowProc( hWnd As HWND, Msg, wParam, lParam ) Exit Function End Select DbgWndProc = 0 End Function
'=========================================================================== ' 関数名:DbgWnd_ViewMode_Click関数 ' 説 明:手前に表示ボタンクリックイベント '=========================================================================== /* Sub DbgWnd_ViewMode_Clisk() */ Sub DbgWnd_ViewMode_Click() 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
[/code][/hide]
|
|
|
投稿記事 |
Posted: 2005年12月09日(金) 09:53 |
|
|
|
|
|
どうでもいいレスですが、
DbgWnd_ViewMode_Clisk→DbgWnd_ViewMode_Clickですよね。
また、wcex構造体のhbrBackgroundメンバの指定を
コード: .hbrBackground = (COLOR_3DFACE + 1) As HBRUSH
と変えたほうがよいかと。
このままだとブラシハンドルのリークが起きるので。
どうでもいいレスですが、 DbgWnd_ViewMode_Clisk→DbgWnd_ViewMode_Clickですよね。
また、wcex構造体のhbrBackgroundメンバの指定を [code] .hbrBackground = (COLOR_3DFACE + 1) As HBRUSH[/code] と変えたほうがよいかと。 このままだとブラシハンドルのリークが起きるので。
|
|
|
投稿記事 |
Posted: 2005年12月08日(木) 23:59 |
|
|
|
|
|
デバッグをしている際にVBAのイミディエイトウインドウのようなものが欲しくなり作成しました。
需要があるかわかりませんがお試しください。
ファイルにも出力できます。
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]
コード:
'===============================================================================
' 名 称 :イミディエイトウインドウ(もどき)クラス
' 概 要 :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,"MS ゴシック")
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(
"ボタン1がクリックされました。(イミディエイトのみに出力)",
DBCD_OUTPUT_IMI_ONLY,
DBCD_ERRLEVEL_NORMALITY)
#endif
End Sub
Sub MainWnd_CommandButton2_Click()
#ifdef DEBUG
'PrintExログファイル出力
DebugCls.PrintEx(
"ボタン2がクリックされました。(ログファイルのみに出力)",
DBCD_OUTPUT_LOG_ONLY,
DBCD_ERRLEVEL_NORMALITY)
#endif
End Sub
Sub MainWnd_CommandButton3_Click()
#ifdef DEBUG
'PrintExログ&イミディエイト出力
DebugCls.PrintEx(
"ボタン3がクリックされました。(ログとイミディエイトに出力)",
DBCD_OUTPUT_ALL,
DBCD_ERRLEVEL_NORMALITY)
#endif
End Sub
Sub MainWnd_CommandButton4_Click()
#ifdef DEBUG
'PrintExログファイル出力(エラーレベル)
DebugCls.PrintEx(
"ボタン4がクリックされました。(警告で出力)",
DBCD_OUTPUT_LOG_ONLY,
DBCD_ERRLEVEL_WARNNING)
DebugCls.PrintEx(
"ボタン4がクリックされました。(異常で出力)",
DBCD_OUTPUT_LOG_ONLY,
DBCD_ERRLEVEL_ABNORMALITY)
#endif
End Sub
デバッグをしている際にVBAのイミディエイトウインドウのようなものが欲しくなり作成しました。 需要があるかわかりませんがお試しください。 ファイルにも出力できます。
[hide] [code] '=============================================================================== ' 名 称 :イミディエイトウインドウ(もどき)クラス ' 概 要 :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[i] = 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,"MS ゴシック")
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
[/code] [/hide]
使用方法です。 includeして使用してください。 #ifdefで囲むとよいと思います。
[hide] [code] #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( "ボタン1がクリックされました。(イミディエイトのみに出力)", DBCD_OUTPUT_IMI_ONLY, DBCD_ERRLEVEL_NORMALITY) #endif
End Sub
Sub MainWnd_CommandButton2_Click()
#ifdef DEBUG 'PrintExログファイル出力 DebugCls.PrintEx( "ボタン2がクリックされました。(ログファイルのみに出力)", DBCD_OUTPUT_LOG_ONLY, DBCD_ERRLEVEL_NORMALITY) #endif
End Sub
Sub MainWnd_CommandButton3_Click()
#ifdef DEBUG 'PrintExログ&イミディエイト出力 DebugCls.PrintEx( "ボタン3がクリックされました。(ログとイミディエイトに出力)", DBCD_OUTPUT_ALL, DBCD_ERRLEVEL_NORMALITY) #endif
End Sub
Sub MainWnd_CommandButton4_Click()
#ifdef DEBUG 'PrintExログファイル出力(エラーレベル) DebugCls.PrintEx( "ボタン4がクリックされました。(警告で出力)", DBCD_OUTPUT_LOG_ONLY, DBCD_ERRLEVEL_WARNNING)
DebugCls.PrintEx( "ボタン4がクリックされました。(異常で出力)", DBCD_OUTPUT_LOG_ONLY, DBCD_ERRLEVEL_ABNORMALITY) #endif
End Sub [/code] [/hide]
|
|
|
投稿記事 |
Posted: 2005年12月07日(水) 00:44 |
|
|
|
|