時計を作る(デラックス版)

まずは本家のWin32講座 のStep32を読んでください。話はソレからです。

本家のプログラムは背景がありません。寂しいです。そこで背景のある時計を作ります。だからデラックス版です。
まず、ビットマップ画像を用意してください。何でもいいです。ただ、正方形が好ましいです。
今回のプログラムは、プロジェクトを作ってください。名前はclockとでもしておきます。

次にウインドウを設定します。スタイルをポップアップの枠無しにします。これで、例の青いバーが出なくなります。
ただ、これでは普通に終了させることが出来なくなります。そこで、右ダブルクリックで終了するようにします。
'右ダブルクリックで終了
Sub MainWnd_RButtonDblClick(flags As Long, x As Integer, y As Integer)
    SendMessage(hMainWnd , WM_CLOSE , 0,0)
End Sub
これだけです。

実行してみると分かりますが、このままではウインドウを動かすことが出来ません。
ウインドウを動かせるようにします。ウインドウ上でマウスが押されたときに上の青いバーを押されたことにします。
Sub MainWnd_LButtonDown(flags As Long, x As Integer, y As Integer)
    SendMessage(hMainWnd , WM_NCLBUTTONDOWN , HTCAPTION ,0)
End Sub
これで、タイトルバーの無いウインドウを一応動かせるようになります。

次に初期設定をします。
今回はウインドウの形を○にしてみます。これはリージョンを使うことで可能になります。
先にメモリデバイスコンテキストにビットマップを入れるようにしておきました。再描写のときはBitBltを呼ぶだけです。
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim hWndDC As HDC
Dim hMemDC As HDC
Dim hBmp As HBITMAP 

Const SIZE = 160
Const CENTER = SIZE/2
Const RAD = 3.1416/180

Type CLOCK
    Hou As Double
    Min As Double
    Sec As Double
End Type

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
    Dim hRgn As HRGN
    Dim rc As RECT
    rc.bottom = SIZE
    rc.right = SIZE
    'ウインドウを○にする
    hRgn = CreateEllipticRgnIndirect(rc)
    SetWindowPos(hMainWnd , NULL , 0,0,rc.right,rc.bottom , SWP_NOMOVE)
    SetWindowRgn(hMainWnd , hRgn , TRUE )
    
    '背景を作る
    hWndDC = GetDC(hMainWnd)
    hMemDC = CreateCompatibleDC(hWndDC)
    hBmp = LoadImage(GetModuleHandle(0) , "test.bmp" , IMAGE_BITMAP , SIZE,SIZE,LR_LOADFROMFILE)
    If hBmp = NULL Or hMemDC = NULL Then
        MessageBox(hMainWnd , "背景を作れなかった" , "error" , MB_OK)
    End If
    SelectObject(hMemDC , hBmp)

    'タイマー作動
    SetTimer(hMainWnd , 1 , 50 ,0)
End Sub


Sub MainWnd_Destroy()
    DeleteObject(hBmp)
    DeleteDC(hMemDC)
    ReleaseDC(hMainWnd , hWndDC)
    clock_DestroyObjects()
    PostQuitMessage(0)
End Sub

 
'再描写
Sub MainWnd_Paint(hDC As HDC)
    BitBlt(hWndDC ,0,0,SIZE,SIZE,hMemDC,0,0,SRCCOPY)
End Sub
これで、タイマー関数以外の部分は出来上がりです。
SetTimerのところをコメントアウトすれば丸いウインドウにビットマップが描写されるはずです。
最後にタイマー関数の内容を書きます。今回は時計を表示させます。
メモリDCは背景用にしたので、直接ウインドウDC(hWndDC)に針を描きます。
Sub MainWnd_Timer(TimerID As DWord)
    '時間を取得
    Dim st As SYSTEMTIME
    Dim cl As CLOCK
    Dim x As Long,y As Long
    Dim hPen As HPEN

    GetLocalTime(st)
    BitBlt(hWndDC ,0,0,SIZE,SIZE,hMemDC,0,0,SRCCOPY)

    cl.Hou = (st.wHour*30 + st.wMinute/12 -90) * RAD
    cl.Min = (st.wMinute *6 +st.wSecond/12 -90 ) * RAD
    cl.Sec = (st.wSecond *6 +st.wMilliseconds/200-90 ) * RAD

    '時針
    x = SIZE*.25 * Cos(cl.Hou)
    y = SIZE*.25 * Sin(cl.Hou)

    hPen = CreatePen(PS_SOLID , 4 , RGB(255,0,0))
    SelectObject(hWndDC , hPen)
    MoveToEx(hWndDC ,CENTER,CENTER,ByVal NULL)
    LineTo(hWndDC , CENTER + x , CENTER + y)
    DeleteObject(hPen)

    '分針
    x = SIZE*.3 * Cos(cl.Min)
    y = SIZE*.3 * Sin(cl.Min)
    hPen = CreatePen(PS_SOLID , 2 , RGB(0,255,0))
    SelectObject(hWndDC , hPen)
    MoveToEx(hWndDC ,CENTER,CENTER,ByVal NULL)
    LineTo(hWndDC , CENTER + x , CENTER + y)
    DeleteObject(hPen)

    '秒針
    x = SIZE*.4 * Cos(cl.Sec)
    y = SIZE*.4 * Sin(cl.Sec)
    hPen = CreatePen(PS_SOLID , 1 , RGB(0,0,0))
    SelectObject(hWndDC , hPen)
    MoveToEx(hWndDC ,CENTER,CENTER,ByVal NULL)
    LineTo(hWndDC , CENTER + x , CENTER + y)
    DeleteObject(hPen)
End Sub
実行画面は以下のようになります。ビットマップによって背景は変わります。
clockのスクリーンショット
ソースとexe
<<前へ ▲戻る 次へ>>
サイトマップ
(2010-04-25更新)