ab.com コミュニティ

コード: 全て選択

Sub MainWnd_CommandButton1_Click()
	stp = 0 'ボタン１を押すとスタート、停止指示は０
	Dim msg As MSG
	Do
		If PeekMessage(msg, 0, 0, 0, PM_REMOVE) Then
			If msg.message = WM_QUIT Then
				PostQuitMessage(msg.wParam) 'メインのメッセージループへ再送。
				Exit Do
			End If
			TranslateMessage(msg)
			DispatchMessage(msg)
		Else
			mainloop()
		End If
	Loop While stp = 0 '停止指示が０の間は動作する、１になったら抜ける
End Sub

コード: 全て選択

Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As *SECURITY_ATTRIBUTES, bManualReset As Long, bInitialState As Long, lpName As *Char) As HANDLE
Declare Function SetEvent Lib "kernel32" (hEvent As HANDLE) As Long
Declare Function ResetEvent Lib "kernel32" (hEvent As HANDLE) As Long

Sub MessageThreadProc(hEvent As HANDLE)
	/* スレッドメッセージキューの作成 */
	Dim msg As MSG
	Do
		PostThreadMessage(GetCurrentThreadId(),WM_USER,0,0)
		If PeekMessage(msg,NULL,WM_USER,WM_USER,PM_REMOVE)=TRUE Then Exit Do
		Sleep(0)
	Loop

	/* メインスレッドに準備の完了を通知 */
	If hEvent<>NULL Then SetEvent(hEvent)

	/* スレッドメッセージループ */
	While GetMessage(msg,0,0,0)>0
		Select Case msg.message
			Case WM_USER+1
				MessageBox(0,"テスト",0,0)
		End Select
	Wend
	/* メインスレッドに終了の完了を通知 */
	If hEvent<>NULL Then SetEvent(hEvent)

	/* メインスレッドの終了 */
	ExitThread(&HE0F)
End Sub

Class CMessageThread
Private
	m_hThread As HANDLE
	m_idThread As DWord
	m_hEvent As HANDLE
Public
	Sub CMessageThread()
		/* イベントを作成 */
		m_hEvent=CreateEvent(NULL,TRUE,FALSE,NULL)

		/* スレッドを作成 */
		m_hThread=CreateThread(ByVal NULL,0,AddressOf(MessageThreadProc),m_hEvent,0,VarPtr(m_idThread))

		/* スレッドメッセージキュー作成まで待機 */
		If m_hEvent<>NULL and m_hThread<>NULL Then WaitForSingleObject(m_hEvent,INFINITE)
	End Sub
	Sub ~CMessageThread()
		If m_hEvent<>NULL Then ResetEvent(m_hEvent)

		/* スレッドへ終了を通知 */
		SendMsg(WM_QUIT,0,0)

		/* スレッド終了まで待機 */
		If m_hEvent<>NULL and m_hThread<>NULL Then WaitForSingleObject(m_hEvent,INFINITE)

		/* ハンドルを破棄 */
		If m_hEvent<>NULL Then CloseHandle(m_hEvent)
		If m_hThread<>NULL Then CloseHandle(m_hThread)
	End Sub
	Function SendMsg(dwMsg As DWord, wParam As DWord, lParam As DWord) As Long
		/* スレッドにメッセージを送信 */
		SendMsg=PostThreadMessage(m_idThread,dwMsg,wParam,lParam)
	End Function
End Class

コード: 全て選択

Dim cmt As CMessageThread

コード: 全て選択

cmt.SendMsg(WM_USER+1,0,0)

コード: 全て選択

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。

Dim hSecondThread As Long 'スレッドハンドル
Dim nSec As Long '複数スレッドで共有する変数としての例。
Dim nFlag As Long 'スレッド動作のフラグ。
Dim lpCriticalSection As CRITICAL_SECTION '排他処理のための構造体
Dim tID As Dword 'スレッドIDを格納。

'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As DWord, dwMsg As DWord, wParam As DWord, lParam As DWord) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function


'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	'排他処理のために、クリティカルの作成。
	InitializeCriticalSection( lpCriticalSection )
End Sub


Sub MainWnd_Destroy()

	'クリティカルセクションの破棄
	DeleteCriticalSection( lpCriticalSection )
	'平行動作のスレッドを破棄
	CloseHandle( hSecondThread )

	TestWnd_DestroyObjects()
	PostQuitMessage(0)
End Sub


Sub MainWnd_CommandButton1_Click()
	Dim nCount As Long
	Dim strBuf As String

	If( nFlag = FALSE )Then
		nSec = 0
		nFlag = TRUE

		'平行動作のスレッドを作成
		hSecondThread = CreateThread( ByVal NULL, NULL, AddressOf( CountUp ), NULL, NULL, VarPtr(tID) )

		SetWindowText( GetDlgItem( hMainWnd, CommandButton1 ), "今のカウントは？" )
	Else
		'複数スレッド間で共有する変数にアクセスする前に、排他処理。
		EnterCriticalSection( lpCriticalSection )
			nCount = nSec
		LeaveCriticalSection( lpCriticalSection )

		strBuf = Str$( nCount )
		SetWindowText( GetDlgItem( hMainWnd, EditBox1 ), strBuf )
	EndIf
End Sub


'平行スレッド＝平行動作で0.1秒ごとにカウントアップしてみる。
Sub CountUp()
	While( TRUE )
		Sleep 100
		'複数スレッド間で共有する変数にアクセスする前に、排他処理。
		EnterCriticalSection( lpCriticalSection )
			nSec = nSec + 1
		LeaveCriticalSection( lpCriticalSection )
	Wend
EndSub

コード: 全て選択

'---------------------------
'  Window Message Loop
'---------------------------
Dim msgMain As MSG, iResult As Long
Do
     If PeekMessage(msgMain,0,0,0,PM_NOREMOVE) Then
            iResult=GetMessage(msgMain,0,0,0)
         If iResult=0 or iResult=-1 Then Exit Do
            TranslateMessage(msgMain)
             DispatchMessage(msgMain)
     Else
            Main_Loop()
     End If
Loop
ExitProcess(0)