ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年9月22日(金) 11:41

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 4 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2005年12月07日(水) 00:44 
オフライン

登録日時: 2005年7月27日(水) 10:12
記事: 12
デバッグをしている際にVBAのイミディエイトウインドウのようなものが欲しくなり作成しました。
需要があるかわかりませんがお試しください。
ファイルにも出力できます。

[hide]
コード:
'===============================================================================
' 名  称    :イミディエイトウインドウ(もどき)クラス
' 概  要    :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

[/hide]

使用方法です。
includeして使用してください。
#ifdefで囲むとよいと思います。

[hide]
コード:
#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
[/hide]


通報する
ページトップ
 記事の件名:
投稿記事Posted: 2005年12月08日(木) 23:59 
どうでもいいレスですが、
DbgWnd_ViewMode_Clisk→DbgWnd_ViewMode_Clickですよね。

また、wcex構造体のhbrBackgroundメンバの指定を
コード:
          .hbrBackground = (COLOR_3DFACE + 1) As HBRUSH
と変えたほうがよいかと。
このままだとブラシハンドルのリークが起きるので。


通報する
ページトップ
   
投稿記事Posted: 2005年12月09日(金) 09:53 
オフライン

登録日時: 2005年7月27日(水) 10:12
記事: 12
指摘ありがとうございます。

> どうでもいいレスですが、
> DbgWnd_ViewMode_Clisk→DbgWnd_ViewMode_Clickですよね。
すみません。
誤字です。。。
ご指摘の通り修正しました。

> また、wcex構造体のhbrBackgroundメンバの指定を
>
コード:
          .hbrBackground = (COLOR_3DFACE + 1) As HBRUSH
> と変えたほうがよいかと。
> このままだとブラシハンドルのリークが起きるので。
知りませんでした。。。
今まで作ったの全部修正しないと行けないかも。。。

ところで、このクラスは需要はあるのかな?

[hide]
コード:
'===============================================================================
' 名  称    :イミディエイトウインドウ(もどき)クラス
' 概  要    :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

[/hide]


通報する
ページトップ
 記事の件名: すばらいい
投稿記事Posted: 2010年6月07日(月) 04:39 
便利なもの、有用なものが評価されないのはおかしい
あるべきところにあるべきはずのものが本来の場所に。


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 4 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke