ステップ32 「アナログ時計を作る」 - abwiki @ ウィキ (ActiveBasic非公式wiki)

公式で配布されているプロジェクトファイルはAB5であるため、AB5プロジェクトファイルをAB4で開くを参照。

秒針、短針、長針がついているアナログ時計を作ってみます。

今回作成するプログラムのサンプルファイルを置いておきますので、参考にしたい方はどうぞ☆
clock.zip（プロジェクトに必要なファイルがすべて入っています）

早速作ろう！

"clock" などという名前で、ノーマルウィンドウベースのプロジェクトを新規作成します。
MainWndはいじるところがないので、次はメニュー（IDは "OptionMenu"）を挿入し、以下のような構成になるよう、メニューアイテムをいれていきます。

キャプション	ID	備考
dummy	-	ポップアップ
常に前面に表示(&T)	IDM_TOPMOST	-
-	-	セパレータ
終了(&X)	IDM_EXIT	-

コーディング

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

' メモ - 以下の領域を、変数、構造体、定数、関数を宣言するための、
' グローバル領域として利用することができます。
' ----------------------------------ここから----------------------------------

Const PAI=3.14159265358979323846264
Const ID_TIMER=100

Dim st As SYSTEMTIME
Dim bTopMost As Long

' ----------------------------------ここまで----------------------------------

↑MainWnd.sbpの先頭部分です。定数、グローバル変数の宣言を行います。

Sub MainWnd_Destroy()
clock_DestroyObjects()
PostQuitMessage(0)
End Sub

↑Destroyイベントに変更点はありません。

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
'タイマー始動
SetTimer(hMainWnd,ID_TIMER,10,0)
End Sub

↑Createイベントでは、タイマーの始動を行います。

Sub MainWnd_Timer(TimerID As Long)
Dim wsec As Word
wsec=st.wSecond
GetLocalTime(st)

'秒針を動かす必要があるときは再描画する
If wsec<>st.wSecond Then InvalidateRect(hMainWnd,ByVal 0,1)
End Sub

↑Timerイベントでは、再描画要求を出します。

Sub MainWnd_Paint(hDC As Long)
Dim hPen As DWord, hOldPen As DWord
Dim pos As POINTAPI
Dim rc As RECT
Dim CenterPos As POINTAPI '針の中心位置
Dim Length_Second As Long '秒針の長さ
Dim Length_Minute As Long '短針の長さ
Dim Length_Hour As Long '長針の長さ

GetClientRect(hMainWnd,rc)

'針の中心位置
CenterPos.x=rc.right/2
CenterPos.y=rc.bottom/2

'ウィンドウの大きさをもとに、秒針、短針、長針の長さを計算
If rc.right>rc.bottom Then
Length_Second=rc.bottom/2-2
Else
Length_Second=rc.right/2-2
End If
Length_Minute=Length_Second
Length_Hour=Length_Minute*0.70


'短針
If st.wHour=12 Then st.wHour=0
hPen=CreatePen(PS_SOLID,5,RGB(255,100,0))
hOldPen=SelectObject(hDC,hPen)
pos.x=CenterPos.x+Length_Hour*Sin(st.wHour*PAI/6+st.wMinute*PAI/360)
pos.y=CenterPos.y-Length_Hour*Cos(st.wHour*PAI/6+st.wMinute*PAI/360)
MoveToEx(hDC, CenterPos.x, CenterPos.y, ByVal NULL)
LineTo(hDC, pos.x, pos.y)
SelectObject(hDC,hOldPen)
DeleteObject(hPen)

'長針
hPen=CreatePen(PS_SOLID,2,RGB(255,0,0))
hOldPen=SelectObject(hDC,hPen)
pos.x=CenterPos.x+Length_Minute*Sin(st.wMinute*PAI/30+st.wSecond*PAI/1800)
pos.y=CenterPos.y-Length_Minute*Cos(st.wMinute*PAI/30+st.wSecond*PAI/1800)
MoveToEx(hDC, CenterPos.x, CenterPos.y, ByVal NULL)
LineTo(hDC, pos.x, pos.y)
SelectObject(hDC,hOldPen)
DeleteObject(hPen)

'秒針
hPen=GetStockObject(BLACK_PEN)
hOldPen=SelectObject(hDC,hPen)
pos.x=CenterPos.x+Length_Second*Sin(st.wSecond*PAI/30)
pos.y=CenterPos.y-Length_Second*Cos(st.wSecond*PAI/30)
MoveToEx(hDC, CenterPos.x, CenterPos.y, ByVal NULL)
LineTo(hDC, pos.x, pos.y)
SelectObject(hDC,hOldPen)
End Sub

↑Paintイベントでは、長針、短針、秒針の描画を行います。
各針の描画位置は、三角関数を用いて計算しています。

Sub MainWnd_RButtonDown(flags As Long, x As Integer, y As Integer)
Dim pos As POINTAPI

pos.x=x
pos.y=y
ClientToScreen(hMainWnd,pos)

'ポップアップメニューを表示
TrackPopupMenu(hMenu_OptionMenu_0,TPM_LEFTALIGN,pos.x,pos.y,0,hMainWnd,ByVal 0)
End Sub

↑RButtonDownイベントでは、ポップアップメニューの表示を行います。
"hMenu_OptionMenu_0" というメニューハンドルは、RADツールが生成するコードで作成されたものです。

hMenu_[メニューID]_[何番目のポップアップか（0～）]

という具合になっています。

Sub MainWnd_IDM_TOPMOST_MenuClick()
Dim mii As MENUITEMINFO

mii.cbSize=Len(mii)
mii.fMask=MIIM_STATE
If bTopMost=0 Then
bTopMost=1
mii.fState=MFS_CHECKED

'最前面ウィンドウに設定
SetWindowPos(hMainWnd,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE)
Else
bTopMost=0
mii.fState=MFS_UNCHECKED

'最前面ウィンドウを解除
SetWindowPos(hMainWnd,HWND_NOTOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE)
End If

'メニューのチェック状態を設定
SetMenuItemInfo(hMenu_OptionMenu_0,IDM_TOPMOST,0,mii)
End Sub

↑「常に前面に表示」メニューがクリックされたときのイベントです。

Sub MainWnd_IDM_EXIT_MenuClick()
SendMessage(hMainWnd,WM_CLOSE,0,0)
End Sub

↑「終了」メニューがクリックされたときのイベントです。

これで作業は完了です。
ウィンドウの大きさにあわせて時計の大きさが変化し、最前面ウィンドウへの設定も行えるので、ちょっとしたデスクトップアクセサリーにはもってこいですね！（編注：いいえ）