2024/05/25

フォーム上のGDI描画アナログ時計




１．背景

以前「図形で作るアナログ時計」で、ワークシート上に「図形を使った時計」の作成方法を紹介しましたが、今回はユーザーフォーム上に描画するアナログ時計を紹介します。
技術的には、アナログ時計の針や数字などは「GDI（Graphic Device Interface）」を使ってフォーム上に描画をしています。また時を刻む方法としては、今回「Do～Loop法」「OnTime法」「SetTimer法（Win32API関数）」の３種を紹介します。
アナログ時計は、デジタル時計と比較し午前・午後の区別こそ出来ませんが、針の傾きを一瞬見ただけで凡その時刻が把握出来るメリットがあります。今回のプログラムはExcelアドインにしておく事で、他ブックを作業している傍らに表示させておくことも可能ですので、良ければ参考にして下さい。

２．アナログ時計の概要

「サンプルファイル」では、図０１のようにSheet1上にボタンを３つ配置しています。ボタンをクリックするとアナログ時計が表示されます。フォームはモードレスで起動していますので、ワークシート作業をしながらでも時計を見る事が可能です。
サンプルファイル上での時計表示
図０１
なお時計本体（UserForm1）は１種類です。ボタン毎にコードを分けている訳では無く、起動ボタンに紐付けられた標準モジュール内の３種の「時を刻む方法」で動かしています。なお方法ごとにメリット・デメリットがあり、時計としてベストの方法を選ぶのは難しいですが、比較については「まとめ」を参考にして下さい。

２－１．時計の外観

表示する時計の寸法関係の設計は、図０２のようにしました。「時計の直径」を基準とし、針の長さや数字の大きさを連動するようにしていますので、内部の定数（ClockSize）の値を変更すれば、ほぼ相似形で時計サイズを変更できます。
時計のサイズ的な仕様
図０２
また時計の表示には、今回GDIを使っています。GDI関数には非常に多くの種類がありますが、今回はその内の図０３に示したような関数を使って描画を行いました。GDIの詳細は「フォーム上に図形や文字をGDI描画」の項を参照下さい。
時計の描画に使われているGDI関数
図０３
時計の描画の順番としては、「外周の点」→「数字」→「針」→「中心軸」としています。順番の入れ替えは可能ですが、描画の重なる部分があるので、どちらを前面に描画すべきかを考えてこのような順番にしています。
なお、他のGDI関数を使って同じ時計を描画することも可能ですし、工夫する事でより見易い時計にすることも出来ます。

２－２．時を刻む方法

時計の針を動かす方法として、今回は以下の様に「毎秒ごとに描画を指示」→「現時刻の時計を描画」としました。役割分担としては、指示する側を標準モジュールに置き、現時刻の時計の描画はユーザーフォーム側で完結させています。
時計の針を毎秒動かす方法
図０４
標準モジュール側の「毎秒の描画指示」には、いくつかの手法が考えられます。今回は以下の３種とし、それぞれをシート上のボタンから起動できるようにしました。
　ボタン１「Do～Loop法」：Do～Loopの間で現時刻を調べ、1秒毎に時計描画の更新を指示
　ボタン２「OnTime法」：自プロシージャの再帰呼び出しを現時刻の1秒後に予約。その中で時計描画の更新を指示
　ボタン３「SetTimer法」：起動時に1秒毎にプロシージャ実行を予約。呼び出し先で時計描画の更新を指示
「時を刻む方法」の詳細については「時を刻むプログラム」で紹介していきますが、それぞれメリット・デメリットがあります。

３．アナログ時計描画のプログラム

時計の描画はユーザーフォームのみで完結しています。単独でUserForm1を起動（VBEでの実行等）すると、起動時の時刻で時計が表示されます。
ですので、標準モジュール側から１秒ごとに「描画の書き換え」を指示する事で、時を刻んでいる時計に見えるようになります。

３－１．フォームのレイアウト

今回は、ユーザーフォームのサイズもそのままでOKですし、フォーム上にコントロール類も配置しません。フォームのサイズはフォームモジュール側から時計のサイズに合わせて変更し、GDIでの描画もフォームの台紙上に直接行います。
フォームのレイアウト
図０５

３－２．フォームモジュール

３－２－１．宣言部

今回はGDI描画を行いますので、Win32API関数の宣言文が必要になります。今回使っているのは以下の関数です。
なおPCの画面拡大率で時計のサイズが変わってきますので、その関係の関数も含まれています。
種類役割関数名今回の利用場所
描画対象のﾊﾝﾄﾞﾙ対象ハンドルを取得FindWindowﾕｰｻﾞｰﾌｫｰﾑのﾊﾝﾄﾞﾙ取得
ﾃﾞﾊﾞｲｽｺﾝﾃｷｽﾄ(DC)を取得GetDCﾌｫｰﾑのｸﾗｲｱﾝﾄ領域のDC取得
DCの解放ReleaseDCDCの解放
描画道具の作成ペンを作成CreatePen短針･長針･秒針の太さ設定
塗りつぶしブラシを作成CreateSolidBrush時計中心の円の塗りつぶし
ﾌｫﾝﾄを作成CreateFont数字のサイズ
道具の選択･解除指定ｵﾌﾞｼﾞｪｸﾄを選択SelectObject描画道具選択
ｵﾌﾞｼﾞｪｸﾄを削除し解放DeleteObject描画道具削除
描画現在位置の変更MoveToEx短針･長針･秒針の描画
直線を描画LineTo
楕円を描画Ellipse時計中心の円
点の描画SetPixel外周の60個の点
文字を描画TextOut数字の描画
文字の背景ﾓｰﾄﾞSetBkMode数字の背景を透明化
画面拡大率ﾃﾞｽｸﾄｯﾌﾟのﾊﾝﾄﾞﾙを取得GetDesktopWindow画面拡大率を時計ｻｲｽﾞに反映
ﾃﾞﾊﾞｲｽ固有情報を取得GetDeviceCaps
図０６
以下が関数宣言ですが、Excelの「32ビット版」と「64ビット版」とでは関数の宣言文が若干異なります（「PtrSafe」の有無）。しかし下記のように「#If Win64 Then ～ #Else ～ #End If」と場合分けすることで、どのビット版でもOKとなります。
なお各関数の引数などについては、「フォーム上に図形や文字をGDI描画」の項を参照下さい。
  1. '==========　⇩(1)　Win32API関数の宣言 ============
  2. #If Win64 Then
  4. 　'描画対象のハンドル
  5. 　Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
  6. 　　　(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
  7. 　Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
  8. 　Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long
  9. 　'描画道具の作成
  10. 　Private Declare PtrSafe Function CreatePen Lib "gdi32" _
  11. 　　　(ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As LongPtr
  12. 　Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPtr
  13. 　Private Declare PtrSafe Function CreateFont Lib "gdi32" Alias "CreateFontA" _
  14. 　　　(ByVal h As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, _
  15. 　　　ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, _
  16. 　　　ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
  17. 　'道具の選択・解除
  18. 　Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
  19. 　Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
  20. 　'描画
  21. 　Private Declare PtrSafe Function MoveToEx Lib "gdi32" _
  22. 　　　(ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
  23. 　Private Declare PtrSafe Function LineTo Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long
  24. 　Private Declare PtrSafe Function Ellipse Lib "gdi32" _
  25. 　　　(ByVal hdc As LongPtr, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  26. 　Private Declare PtrSafe Function SetPixel Lib "gdi32" _
  27. 　　　(ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  28. 　Private Declare PtrSafe Function TextOut Lib "gdi32" Alias "TextOutA" _
  29. 　　　(ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
  30. 　Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hdc As LongPtr, ByVal nBkMode As Long) As Long
  31. 　'画面拡大率
  32. 　Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
  33. 　Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
  35. #Else
  37. 　'描画対象のハンドル
  38. 　Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  39. 　　　(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
  40. 　Private Declare Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
  41. 　Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long
  42. 　'描画道具の作成
  43. 　Private Declare Function CreatePen Lib "gdi32" _
  44. 　　　(ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As LongPtr
  45. 　Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPtr
  46. 　Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" _
  47. 　　　(ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, _
  48. 　　　ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, _
  49. 　　　ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
  50. 　'道具の選択・解除
  51. 　Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
  52. 　Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
  53. 　'描画
  54. 　Private Declare Function MoveToEx Lib "gdi32" _
  55. 　　　(ByVal hdc As LongPtr, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
  56. 　Private Declare Function LineTo Lib "gdi32" (ByVal hdc As LongPtr, ByVal X As Long, ByVal Y As Long) As Long
  57. 　Private Declare Function Ellipse Lib "gdi32" _
  58. 　　　(ByVal hdc As LongPtr, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  59. 　Private Declare Function SetPixel Lib "gdi32" _
  60. 　　　(ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  61. 　Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _
  62. 　　　(ByVal hdc As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
  63. 　Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As LongPtr, ByVal nBkMode As Long) As Long
  64. 　'画面拡大率
  65. 　Private Declare Function GetDesktopWindow Lib "User32" () As Long
  66. 　Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
  68. #End If
図０７
例えば図０７の２０～２１行目「Private Declare PtrSafe Function MoveToEx Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long」は線を描画する際の「始点を移動」する関数ですが、その第４引数のlpPointには「元の現在位置」が戻ってくる仕組みになっています。
その元の現在位置を活用しない場合でも、第４引数には「POINTAPI構造体の変数」を指定する必要があります。それ以前に、POINTAPI構造体の宣言をしておかないと２０～２１行目の宣言文がエラーとなってしまいます。
ですので、以下のようにPOINTAPI構造体の宣言を行います。
ちなみに要素のxyは位置（ピクセル単位）を表しており、xは横（水平）方向・yは縦（垂直）方向です。
  1. '==========　⇩(2)　点座標構造体の宣言 ============
  2. Private Type POINTAPI
  3. 　x As Long
  4. 　y As Long
  5. End Type
図０８
以下は、フォームモジュール内で使用する変数・定数の宣言です。
  1. '==========　⇩(3)　モジュール変数・定数の宣言 ============
  2. Private hWnd As LongPtr 　　 'UserFormｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ
  3. Private hdc As LongPtr 　　 'UserFormｳｨﾝﾄﾞｳのﾃﾞﾊﾞｲｽｺﾝﾃｷｽﾄ
  5. Private hPen1 As LongPtr 　　 '短針(論理ペン)
  6. Private hPen2 As LongPtr 　　 '長針(論理ペン)
  7. Private hPen3 As LongPtr 　　 '秒針(論理ペン)
  8. Private hBrush As LongPtr 　 '中心軸(論理ブラシ)
  9. Private hFont1 As LongPtr 　　 '数字(論理Font)
  10. Private hFont2 As LongPtr 　　 '外周点(論理Font)
  12. Private Const ClockSize As Double = 140 　 '時計のサイズ（ポイント単位）
  13. Private Const Mgn As Double = 5 　　　　　 '時計範囲との余白(Margin)
  14. Private Const Pi As Double = 3.1415 　　　 '円周率
  16. Private Clock_X0 As Double 　　　 '時計中心のX座標（ポイント単位）
  17. Private Clock_Y0 As Double 　　　 '時計中心のY座標（ポイント単位）
  19. Private DispRatio As Double 　　 'ディスプレイ拡大率
図０９
１０１行目「Private Const ClockSize As Double = 140」、１０２行目「Private Const Mgn As Double = 5」は、図０２の「時計の直径」と「ユーザーフォームとの余白」に対応しています。
１０３行目「Private Const Pi As Double = 3.1415」は円周率を定数化しています。
１０５～１０６行目の変数「Clock_X0」「Clock_Y0」は、時計中心（ポイント単位）です。描画の際に多用されますのでモジュール変数としています。
１０８行目の変数「DispRatio」は、実行しているPCの画面拡大率です。GDIとは直接関係ありませんが、時計をどの拡大率でもほぼ同じサイズに見せるためには必要な補正値です。今回は、描画位置・サイズの計算に使用しています。

３－２－２．起動部

３－２－２－１．Initializeイベント
ユーザーフォームが起動する際には下記のInitializeイベントプロシージャがまず呼び出されます。
  1. '==========　⇩(4)　Initializeイベント ============
  2. Private Sub UserForm_Initialize()
  3. 　Me.Width = (ClockSize + Mgn * 2) + (Me.Width - Me.InsideWidth) 　　 'フォームの幅設定
  4. 　Me.Height = (ClockSize + Mgn * 2) + (Me.Height - Me.InsideHeight) 　 'フォームの高さ設定
  6. 　DispRatio = LogicalPixcel / 96 　 '画面拡大率の計算
  8. 　hWnd = FindWindow("ThunderDFrame", Me.Caption) 　 'ｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ取得
  9. 　hdc = GetDC(hWnd) 　　　　　　 'DC取得
  11. 　hPen1 = CreatePen(0, 6, RGB(0, 0, 0)) 　　 'ペン太さ6+黒色(短針)
  12. 　hPen2 = CreatePen(0, 3, RGB(0, 0, 0)) 　　 'ペン太さ3+黒色(長針)
  13. 　hPen3 = CreatePen(0, 1, RGB(0, 0, 0)) 　　 'ペン太さ1+黒色(秒針)
  14. 　hBrush = CreateSolidBrush(RGB(255, 255, 255)) 　 '白色で塗りつぶし(中心の丸)
  15. 　hFont1 = CreateFont(ClockSize / 10 * (DispRatio / 0.75), 0, 0, 0, 0, False, False, False, 0, 0, 0, 0, 0, "")
  16. 　hFont2 = CreateFont(ClockSize / 10 * (DispRatio / 0.75), 0, 0, 0, 0, False, False, False, 128, 0, 0, 0, 0, "")
  17. 　　　　　　 '↑ (hFont1)時計の数字のサイズは、時計直径の1/10とした
  18. 　Call CalcCenter 　 '←時計中心の計算
  20. End Sub
図１０
１２２行目「Me.Width = (ClockSize + Mgn * 2) + (Me.Width - Me.InsideWidth)」では、フォームの横サイズを設定しています。図０９の１０１行目で指定した「時計のサイズ（ClockSize）」に対し１０２行目の余白（Mgn）を考慮したサイズにしています。但しWidthは、フォームの「外側の幅」ですので、時計を描画する範囲（＝クライアント領域）を確保するために「外枠の幅（Me.Width - Me.InsideWidth）」をプラスします。
１２３行目「Me.Height = (ClockSize + Mgn * 2) + (Me.Height - Me.InsideHeight)」はフォームの縦サイズの設定です。内容は横サイズと同じです。
１２５行目「DispRatio = LogicalPixcel / 96」は、画面拡大率の計算です。右辺の「LogicalPixcel」はユーザー定義関数で、図１１を呼び出し「１論理インチあたりのピクセル数」を戻すものです。使用しているPCのディスプレイの拡大率が100%であれば96という値が戻りますので、「96」で割り算をし「画面拡大率」とします。その画面拡大率をモジュール変数のDispRatioに代入しています。
１２７行目「hWnd = FindWindow("ThunderDFrame", Me.Caption)」では、FindWindow関数で対象ウィンドウ（ここではユーザーフォーム）のハンドルを取得しています。引数には、ユーザーフォームを表す「"ThunderDFrame"」と、ユーザーフォーム名「Me.Caption」を指定しています。
１２８行目「hdc = GetDC(hWnd)」では、ユーザーフォームのデバイスコンテキスト（Device Contexts）ハンドルを取得しています。GetDC関数を使うことで、クライアント領域のDCハンドルとなります。なお今回は使っていませんが、GetWindowDC関数を使うと「クライアント領域＋非クライアント領域」のDCが得られる事になります。
１３０行目「hPen1 = CreatePen(0, 6, RGB(0, 0, 0))」は、論理ペンのハンドルを取得しています。第１引数に「0（定数＝PS_SOLID）」を指定することで実線、第２引数に「6」を指定することで幅6ピクセルの線、第３引数に「RGB(0, 0, 0)」を指定することで線の色は黒色となります。このペンは「時計の短針」として使用します。
同様に１３１行目は幅を3ピクセルにする事で「時計の長針」、１３２行目は幅を1ピクセルとすることで「秒針」として使っています。
１３３行目「hBrush = CreateSolidBrush(RGB(255, 255, 255))」は論理ブラシの設定で、引数に「RGB(255, 255, 255)」を指定することで「白色の塗りつぶし」としています。中心の時計軸の色として使用します（時計軸の外周の線は黒色の「既定の論理ペン種」です）。
１３４行目「hFont1 = CreateFont(ClockSize / 10 * (DispRatio / 0.75), 0, 0, 0, 0, False, False, False, 0, 0, 0, 0, 0, "")」は論理フォントの設定で、時計の数字描画に使用します。
多くの引数がありますが、今回は第１引数に「ClockSize / 10 * (DispRatio / 0.75)」を指定することで、文字高さを「時計直径（ClockSize）の1/10」としました。なお、ここでは１２５行目で計算した「画面拡大率（DispRatio）」を使って文字サイズの補正を行っています。
１３５行目「hFont2 = CreateFont(ClockSize / 10 * (DispRatio / 0.75), 0, 0, 0, 0, False, False, False, 128, 0, 0, 0, 0, "")」は、１３４行目とほぼ一緒ですが、こちらはShift-JISのフォントとするため、第９引数を「128」としています。時計外周の点を文字として描画する場合に使用します。
ちなみに１３４行目の第９引数「0」はANSI文字（英語）という意味になります。
１３７行目「Call CalcCenter」は図１２を呼び出し、以降の描画処理内で使用する「時計中心位置」の計算を行っています。
３－２－２－２．画面拡大率の計算
図１０の１２５行目から呼び出されるユーザー定義関数が以下です。「１論理インチあたりのピクセル数」を計算し、戻り値としています。
  1. '==========　⇩(5)　Initializeイベント ============
  2. Private Function LogicalPixcel() As Long
  3. 　Const LOGPIXELSX As Long = 88 　 'スクリーン密度（水平方向）
  4. 　Dim hWndDesk As Long 　 '←デスクトップのウィンドウハンドル
  5. 　Dim hDCDesk As LongPtr 　 '←デバイスコンテキスト
  7. 　hWndDesk = GetDesktopWindow()
  8. 　hDCDesk = GetDC(hWndDesk)
  9. 　LogicalPixcel = GetDeviceCaps(hDCDesk, LOGPIXELSX)
  11. 　Call ReleaseDC(hWndDesk, hDCDesk)
  12. End Function
図１１
１５６行目「hWndDesk = GetDesktopWindow()」では、デスクトップのウィンドウハンドルを取得します。
１５７行目「hDCDesk = GetDC(hWndDesk)」で、デスクトップのデバイスコンテキストを取得します。
１５８行目「LogicalPixcel = GetDeviceCaps(hDCDesk, LOGPIXELSX)」では、第２引数に１５２行目で定数宣言した「スクリーン密度（LOGPIXELSX）」を指定して「論理インチ当りの画面のピクセル数」を取得し、関数プロシージャの戻り値とします。
１６０行目「Call ReleaseDC(hWndDesk, hDCDesk)」では、デスクトップのデバイスコンテキストを解放し、他のアプリから使用できるようにしています。
３－２－２－３．時計中心の計算
図１０の１３７行目から呼び出されるのが以下です。時計中心（＝ユーザーフォームの中心）の座標位置（ここではポイント単位）をモジュール変数（Clock_X0、Clock_Y0）に代入しています。
  1. '==========　⇩(6)　Initializeイベント ============
  2. Sub CalcCenter()
  3. 　Clock_X0 = (Me.InsideWidth / 2)
  4. 　Clock_Y0 = (Me.InsideHeight / 2)
  5. End Sub
図１２
１７２行目「Clock_X0 = (Me.InsideWidth / 2)」では、時計を描画できる範囲（クライアント領域）での水平方向の中心を求めるため、フォーム内側の寸法「InsideWidth」を半分にすることで「中心（Clock_X0）」としています。
１７３行目「Clock_Y0 = (Me.InsideHeight / 2)」は、同様にY方向の中心（Clock_Y0）を求めています。
３－２－２－４．Activateイベント
フォームが表示される際に呼び出されるのが、以下のActivateイベントプロシージャです。
  1. '==========　⇩(7)　Activateイベント ============
  2. Private Sub UserForm_Activate()
  3. 　Call makeClock
  4. End Sub
図１３
１８２行目「Call makeClock」では、図１４のmakeClockプロシージャを呼び出し「現時刻のアナログ時計」を描画します。
なおDo～Loop法では、シート上のボタン押下（UFstart1を実行）後すぐにmakeClockプロシージャを呼び出しますので、１８２行目は必須ではありません。
またOnTime法も「次の１秒後の実行予約」をした後に、すぐmakeClockプロシージャを呼び出しますので、同様に不要です。
しかしSetTimer法では「１秒後のmakeClockプロシージャ実行を予約」するところから始まりますので、１８２行目が無いと「何もないフォームが１秒間表示」される事になります。
今回Activateイベント内に時計描画処理を入れたのは、SetTimer法の事もありますが、ユーザーフォームのみの起動でも時計を表示（時は刻みませんが）させたかった為です。

３－２－３．現時刻のアナログ時計を表示

フォーム起動時に図１３の１８２行目から呼び出されると共に、標準モジュールから定期的に呼び出されるのが以下です。呼び出されることにより「現時刻のアナログ時計」を描画・更新します。
  1. '==========　⇩(8)　現時刻のアナログ時計の表示 ============
  2. Public Sub makeClock()
  4. 　Me.Repaint 　　　　 '描画準備
  6. 　Call makePoint1 　　　　 '外周の点の描画
  7. 　Call makeNum 　　　　　 '文字盤（数字）を描画
  8. 　Call makeTime(Time()) 　 '時計の針を描画
  9. 　Call makeCenter 　　　　 '中心の時計軸を描画
  11. '　Me.Caption = Format(Now(), "yyyy/mm/dd hh:nn:ss")
  12. End Sub
図１４
１９３行目「Me.Repaint」では、描画の準備をしています。
フォーム起動時に図１３から呼び出される際には、起動～描画が一連の動作になります。この一連の動作では「Repaint無し」でGDI描画をしてもフォーム上には時計は反映されません。Repaintメソッドを実行することで「制御を一旦O/Sに戻す」ような効果が発生し、時計が描画されるようになります。
また標準モジュール側からこのプロシージャが呼び出される際には、Repaintメソッドで「古い時計の描画を消去」してから新たな時計を描画することで、時計が動いているように見える事になります。
１９５～１９８行目では、時計を外側から順番に描画していきます。この順番にしたのは「もし描画が重なっても、一番重要な針の描画が一番上」になるようにするためです。
１９５行目「Call makePoint1」では図１６を呼び出し、時計外周の点を描画しています。
１９６行目「makeNum」では図２３を呼び出し、時計の数字を描画しています。
１９７行目「makeTime(Time()) 」では図２７を呼び出し、現時刻での時計の針を描画しています。引数には「Time()」と現時刻値を渡し、この時刻を元に時計の針の角度を決めています。
なお「Call makeTime(Now()) 」と引数をNow()としても、内部的には日時データから時・分・秒の値を切り出して計算していますので、Time()の時と同じ結果になります。
１９８行目「makeCenter」では図３２を呼び出し、時計中央の時計軸を描画しています。
なお今回の時計はアナログのみですが、もし「デジタル時計」も併行して表示したい場合は、見え消しの２００行目「Me.Caption = Format(Now(), "yyyy/mm/dd hh:nn:ss")」のようにする事で、下図のようにフォームタイトルなどにデジタル日時を表示することも可能です。
アナログ時計とデジタル時計の併行表示
図１５

３－２－４．外周の点の描画

図１４の１９５行目から呼び出される「外周の点」を描画するのが下記コードです。SetPixel関数を使い、ピクセルの色を変更して点を作っています。
  1. '==========　⇩(9)　外周の点の描画（ピクセル描画） ============
  2. Sub makePoint1()
  3. 　Dim i As Integer 　　　 '外周の点の数（今回60個）
  4. 　Dim Xp As Double 　　　 '点のX座標(単位Point)
  5. 　Dim Yp As Double 　　　 '点のY座標(単位Point)
  6. 　Dim h As Integer 　　　 '点の周りの水平方向
  7. 　Dim v As Integer 　　　 '点の周りの垂直方向
  8. 　Dim Pwide As Integer 　 '点の周りを何周盛るか
  10. 　For i = 0 To 59
  12. 　　Pwide = 0
  13. 　　If (i Mod 5) = 0 Then Pwide = 1
  15. 　　Xp = Clock_X0 + ClockSize / 2 * Sin(i * Pi / 30)
  16. 　　Yp = Clock_Y0 - ClockSize / 2 * Cos(i * Pi / 30)
  18. 　　For h = -1 * Pwide To Pwide
  19. 　　　For v = -1 * Pwide To Pwide
  20. 　　　　Call SetPixel(hdc, CLng(Xp * DispRatio / 0.75) + h, CLng(Yp * DispRatio / 0.75) + v, RGB(0, 0, 0))
  21. 　　　Next v
  22. 　　Next h
  24. 　Next i
  25. End Sub
図１６
外周の点は６０個ありますので、２１９行目「For i = 0 To 59」で６０個の点を描画させています。
今回の時計では「数字のところは大きな点」「数字以外のところは小さな点」とするため、５個飛びに点のサイズを変えます。そのサイズを変える変数がPwideです。今回、小さな点の時はPwide=0（1×1 ピクセル）、大きな点の時はPwide=1（3×3 ピクセル）とします。
点の大きさの変え方は、下図のように「中心点の周囲にピクセルを盛る」形としています。盛る周の数がPwideとなります。
外周点の大きさの変え方
図１７
２２１行目「Pwide = 0」は、まず全ての点を小さな点として設定します。次に２２２行目「If (i Mod 5) = 0 Then Pwide = 1」で、５個飛びに大きな点にしています。
２２４～２２５行目は外周点の座標位置の計算です。この計算式について下図で説明します。
外周点の座標計算手順
図１８
まず時計中心は、X座標はClock_X0、Y座標はClock_Y0です。また時計直径（＝外周点の直径）は、図０９の１０１行目で定数ClockSizeとしています。
次に１周360°はラジアンで言うと2π（パイ）、半周（180°）ではπ（≒3.1415･･･）です。２１９行目で「１周（360°）＝60点」としていますので、１つの点当たりの角度は「π÷30」となります。
図１８は2時のところの角度での例ですが、点の数でいうと10点目です。ですので角度は「10×π÷30」ということになります。この値を「A」とします。
時計中心から点までの直線距離は、時計直径の半分（ClockSize/2）です。
2時の点と時計中心とを「水平・垂直の線」及び「直線」で結ぶと、２つの直角三角形（図１８の①と②）が出来ます。直角三角形の角度（ここではA）と斜辺の長さ（ClockSize/2）が分かっていれば、Sin(A)・Cos(A)を使って他の辺の長さを求めることができます。
これがX方向の差分・Y方向の差分となり、時計中心にプラスマイナスすることで「点のXY座標位置」を取得できます。
この考え方から外周の点の位置は、ポイント単位で以下の様になります。
X座標位置　２２４行目「Xp = Clock_X0 + ClockSize / 2 * Sin(i * Pi / 30)」
Y座標位置　２２５行目「Yp = Clock_Y0 - ClockSize / 2 * Cos(i * Pi / 30)」
２２７～２３１行目では、カウンタ変数h（horizontal）とカウンタ変数v（vertical）を「マイナスPwide ～ プラスPwide」まで振っています。例えばPwide=1の場合は「カウンタ変数hを -1・0・+1」「カウンタ変数vを -1・0・+1」と動かします。
２２９行目「Call SetPixel(hdc, CLng(Xp * DispRatio / 0.75) + h, CLng(Yp * DispRatio / 0.75) + v, RGB(0, 0, 0))」では、GDIのSetPixel関数を使って１点ずつピクセルの色を変更しています。
第１引数「hdc」はデバイスコンテキスト（≒ユーザーフォームのクライアント領域）のハンドルです。
第２～３引数は、色を変更するXY座標（ピクセル単位）で、図１８のような考え方で取得したXp・Yp値を「ポイント→ピクセル」に変換して指定しています。なお点のサイズを変更するため、X座標に対しては変数hを、Y座標に対しては変数vを足し合わせています。
ここでピクセル単位での座標位置を一旦「CLng関数」で整数値にしてからh・v値を足していますが、これについては以下の「よりみち」を参照下さい。
第４引数「RGB(0, 0, 0)」は、第２～３引数で指定した座標のピクセルの「色（ここでは黒色）」を指定します。
寄り道(換算工程での描画位置のズレ)
図１６の２２９行目は、CLngの無い単純な「Call SetPixel(hdc, Xp * DispRatio / 0.75 + h, Yp * DispRatio / 0.75 + v, RGB(0, 0, 0))」でも良いように思えます。図０７の２６行目（API関数の宣言文）でも分かるように、SetPixel関数の第２～３引数は「Long型」の設定ですので、「Xp * DispRatio / 0.75 + h」等の計算でいくら小数点が出ようと「勝手に整数に丸められる」はずです。
しかしこの単純な式を使った場合、図０９の１０１行目のClockSize定数の値を「140 → 142」に変更すると、以下のような描画現象が発生します。
外周点の描画の異常
図１９
数字の場所の外周点は「3×3ピクセルの大きな点」にしているのですが、12時のところの点が「真ん中の3ピクセルが抜けてしまった点」となっているのが分かるかと思います。
（Excel2021 × 画面拡大率=1。フォームの枠太さにも影響を受けるので、Excelのバージョンによっても異なると思います）
この時の、12時のところの点のX方向の「中央部分」の座標位置（Xp）は、
「Clock_X0 + ClockSize / 2 * Sin(i * Pi / 30) → 76.125 + 0 → ピクセル化 → 76.125 / 0.75 → 101.5」
という計算結果となり、点を太くするために「この値に -1、+0、+1 を加え」ています。加えた結果は「100.5、101.5、102.5」となるのですが、この小数点値をVBA上で整数（Long型）に直すと「100、102、102」となるのです。
普通に考えれば四捨五入で「101、102、103」なのですが、小数値を整数に直す（≒CLng関数を適用）と「小数点がちょうど 0.5 の時は、偶数側の整数にする」というルールが適用されるのです。
以上の原理により、3×3の点の中央（101ピクセルの分）が抜けてしまうため、対策は必要です。今回２つの方法を考えました。
１つ目は、図１６の２２９行目「･･･, CLng(Xp * DispRatio / 0.75) + h, CLng(Yp * DispRatio / 0.75) + v,･･･」のように、「最初に、中央部分の座標位置を整数化」しておく方法です。今回の例で言えば「101.5 → 102」にしてから「-1、+0、+1 を加え」るのです。これでしたら「101、102、103」となり、3×3の太い点が描画されます。
２つ目は「･･･, Int(Xp * DispRatio / 0.75 + h + 0.5), Int(Yp * DispRatio / 0.75 + v + 0.5),･･･ 」と、「値に0.5を足してから Int で整数化」することで、「100.5 → 101、101.5 → 102、102.5 → 103」と普通の四捨五入の結果を得る方法です。
CLng法・Int法のどちらでも良いと思います。但し、ClockSize=141の場合は「Xp * DispRatio / 0.75 = 100.5」「Yp * DispRatio / 0.75 = 6.5」という計算結果となり、下図のように「手法により、大きい点の位置が縦横に1ピクセルずれる」結果となります。アナログ時計の描画では、ここまでの正確さは不要でしょうが、１ピクセルの位置が重要な意味を持つ場合には気を付ける必要があります。
CLng法とInt法での描画の違い
図２０
なお12時以外の点では、このような現象は発生しません。90°や180°・270°でも発生しそうですが、π（パイ）の値を図０９の１０３行目のように「3.1415」と丸めた値を定数としているために、ゼロ（＝12時の場所）以外のSin・Cosの計算結果では、キリの良い値は得られないためです（稀に発生する可能性もあるかもしれませんが）。

上記のように「ピクセルの色を変更」して点を描画するのでは無く、文字の「・」（S-JISコード＝165（0xA5））を外周の点として描画する方法が以下になります。
  1. '==========　⇩(10)　外周の点の描画（文字で描画） ============
  2. Sub makePoint2()
  3. 　Dim i As Integer 　　 '外周の点の数
  4. 　Dim Xp As Double 　　 '「・」の文字を描画するX座標(単位Point)
  5. 　Dim Yp As Double 　　 '「・」の文字を描画するY座標(単位Point)
  6. 　Dim Previous_Font As LongPtr 　　 '元の文字フォント
  7. 　Dim Previous_BkMode As Long 　　 '元の文字背景モード
  9. 　Previous_Font = SelectObject(hdc, hFont2)
  10. 　Previous_BkMode = SetBkMode(hdc, 1)
  12. 　For i = 0 To 59
  13. 　　Xp = Clock_X0 + ClockSize / 2 * Sin(i * Pi / 30) - ClockSize / 10 / 2 / 2
  14. 　　Yp = Clock_Y0 - ClockSize / 2 * Cos(i * Pi / 30) - ClockSize / 10 / 2
  16. 　　Call TextOut(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75, Chr(165), 1)
  17. 　Next i
  19. 　Call SetBkMode(hdc, Previous_BkMode)
  20. 　Call SelectObject(hdc, Previous_Font)
  21. End Sub
図２１
２５８行目「Previous_Font = SelectObject(hdc, hFont2)」では、図１０の１３５行目で作成した日本語フォント（hFont2）のハンドルを選択しています。
２５９行目「Previous_BkMode = SetBkMode(hdc, 1)」では、文字背景モードを透明に設定しています。
２６１～２６６行目のFor～Nextでは、６０個の外周点を描画しています。
２６２行目「Xp = Clock_X0 + ClockSize / 2 * Sin(i * Pi / 30) - ClockSize / 10 / 2 / 2」は「・」という文字を描画するX方向の座標位置です。
右辺の前半「Clock_X0 + ClockSize / 2 * Sin(i * Pi / 30)」は、SetPixel関数で描画した時の図１６の２２４行目と同じですが、その値に対して「- ClockSize / 10 / 2 / 2」を補正しています。これは、下図のように「点の表示位置（＝狙った位置）」と「文字を表示する座標位置（文字の左上角）」が異なるためです。
点の文字を描画する座標位置
図２２
今回の文字高さは、図１０の１３５行目で「ClockSize/10（ポイント単位）」と設定しています。半角文字の幅は「高さの約半分」ですので、その中心を得るために更に半分にし「- ClockSize / 10 / 2 / 2」を補正します。
同様に２６３行目「Yp = Clock_Y0 - ClockSize / 2 * Cos(i * Pi / 30) - ClockSize / 10 / 2」はY方向の座標位置で、文字高さ「ClockSize/10（ポイント単位）」を半分にし「- ClockSize / 10 / 2」を補正します。
但し図２２でも分かるように、「・」の位置は文字の範囲（白背景枠）のピッタリ真ん中という訳では無い（横幅×2 < 高さ）ようなので、多少のズレは発生してしまいます。 と言って図１０の１３５行目を「hFont2 = CreateFont(ClockSize / 10 * (DispRatio / 0.75), ClockSize / 10 * (DispRatio / 0.75) / 2, 0, 0, 0, False, False, False, 128, 0, 0, 0, 0, "")」と、横幅を強制的に高さの半分に指定してしまうと、点の文字が横広がりになってしまい、見栄えが悪くなります。
２６５行目「Call TextOut(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75, Chr(165), 1)」では、TextOut関数で文字を描画しています。第１引数はフォームのデバイスコンテキストのハンドルを指定します。第２・第３引数は、２６２ ～２６３行目で計算した「文字の左上角のXY座標位置」をピクセル単位で指定します。
第４引数は描画する文字で、今回は「Chr(165)」としています。もちろん文字列として「"･"」としてもOKですが、書き写し時のミスを防ぐため「Shift-JISのコード」をChr関数で文字列に変換させています。
第５引数は描画する文字の文字数（半角＝１、全角＝２）です。Chr(165)は半角ですので「1」文字となります。
点の描画が完了したら、２６８行目「Call SetBkMode(hdc, Previous_BkMode)」で文字の背景モードを元に戻し（透明→白色）、２６９行目「Call SelectObject(hdc, Previous_Font)」でフォントを既定に戻しています。
なおこの手法だと、SetPixel関数で１ピクセルずつ描画するような「細かい描画は難しい」ことになります。フォントサイズを極小にする等の手段は残っているにせよ、結構な手間と事前調査（実際にどの位置に描画されるか等）が必要と思います。

３－２－５．数字の描画

図１４の１９６行目から呼び出されるのが下記です。時計の数字を描画する役目です。
  1. '==========　⇩(11)　数字の描画 ============
  2. Sub makeNum()
  3. 　Const Rnum As Single = 0.85 　　 '時計全体に対する数字の描画位置
  4. 　Dim i As Integer 　　　　 '描画する数字の数
  5. 　Dim Xp As Double 　　　　 '描画するX座標(単位Point)
  6. 　Dim Yp As Double 　　　　 '描画するY座標(単位Point)
  7. 　Dim FontL As Byte 　　　　 '表示する文字数
  8. 　Dim Previous_Font As LongPtr 　　 '元の文字フォント
  9. 　Dim Previous_BkMode As Long 　　 '元の文字背景モード
  11. 　Previous_Font = SelectObject(hdc, hFont1)
  12. 　Previous_BkMode = SetBkMode(hdc, 1)
  14. 　For i = 1 To 12
  15. 　　FontL = Len(CStr(i))
  16. 　　Xp = Clock_X0 + ClockSize / 2 * Rnum * Sin(i * Pi / 6) - ClockSize / 10 * FontL / 2 / 2
  17. 　　Yp = Clock_Y0 - ClockSize / 2 * Rnum * Cos(i * Pi / 6) - ClockSize / 10 / 2
  19. 　　Call TextOut(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75, CStr(i), FontL)
  20. 　Next i
  22. 　Call SetBkMode(hdc, Previous_BkMode)
  23. 　Call SelectObject(hdc, Previous_Font)
  24. End Sub
図２３
まず、時計の数字を時計全体のどこに描画するかを決めているのが、２８２行目「Const Rnum As Single = 0.85」です。全体のレイアウトでは図２４のようになります。もちろんモジュール定数として宣言部（図０９）で宣言してもOKです。
時計全体に対する数字の位置
図２４
２９０行目「Previous_Font = SelectObject(hdc, hFont1)」では、図１０の１３４行目で作成したANSIフォント（hFont1）のハンドルを選択しています。
２９１行目「Previous_BkMode = SetBkMode(hdc, 1)」では、文字背景モードを透明に設定しています。
２９３～２９９行目では、「１」～「１２」の数字を描画しています。
２９３行目「For i = 1 To 12」で、カウンタ変数ｉを数字の数だけ回します。この変数ｉが「描画する数字」となります。
２９４行目「FontL = Len(CStr(i))」では、描画しようとする数字の桁数（１桁か２桁か）を調べています。If文をつかったり、「FontL = Int(i/10) + 1」としてもOKです。
２９５行目「Xp = Clock_X0 + ClockSize / 2 * Rnum * Sin(i * Pi / 6) - ClockSize / 10 * FontL / 2 / 2」は、描画する数字の右上角のX座標位置（ここではポイント単位）を計算しています。
1桁の数字と2桁の数字では、指定する座標の位置が異なるので、実際に数字を描画した図２５で説明していきます。
1桁と2桁の数字の指定位置の違い
図２５
まず数字の高さは、論理フォント作成（図１０の１３４行目）の際「ClockSize / 10」と指定していて「1桁も2桁も同じ」です。
次に「幅」です。まず1桁の数字（図２５で言えば「1」）については、半角文字なので「高さの約半分」です。図２４で言えば0.85の所に数字の中心を描画したければ、X方向は文字幅（ClockSize / 10 / 2）の半分、Y方向は文字高さ（lockSize / 10）の半分を補正すれば良いことになります。
一方2桁は、図２５の「11」という文字を１つの塊として考えると、幅は半角×2で「1桁の時の倍」になると考えられます。実際描画したもので確認してみても、図２５のように「2桁の幅は1桁の約２倍（≒高さと幅が同じくらい）」に見えます。
この場合のX方向の補正は、文字幅（ClockSize / 10 / 2 * 2）の半分となります。
この1桁と2桁が混ざっている状況で、処理の数式を１つにまとめるために、２９４行目で取得した変数FontL（文字数）を使って「 - ClockSize / 10 * FontL / 2 / 2」を補正値としています。
２９６行目「Yp = Clock_Y0 - ClockSize / 2 * Rnum * Cos(i * Pi / 6) - ClockSize / 10 / 2」は、数字を描画するY座標位置です。上述したように数字の高さは1桁でも2桁でも同じなので、高さの半分を補正「 - ClockSize / 10 / 2」しています。
２９８行目「Call TextOut(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75, CStr(i), FontL)」では、TextOut関数で数字を文字として描画しています。第１引数はフォームのデバイスコンテキストのハンドルを指定します。第２・第３引数は「文字の左上角のXY座標位置」をピクセル単位で指定します。
第４引数は描画する文字ですので、「CStr(i)」と数字を文字に変換してから指定しています。
第５引数は描画する文字の文字数です。２９４行目で数字の桁数を変数FontLに代入していますので、その変数を指定します。
数字の描画が完了したら、３０１行目「Call SetBkMode(hdc, Previous_BkMode)」で文字の背景モードを元に戻し（透明→白色）、３０２行目「Call SelectObject(hdc, Previous_Font)」でフォントを既定に戻しています。
なお数字の描画では言語として「ANSI」を使いましたが、その理由は下図のように「ANSIは文字枠のほぼ中央に文字が描画される（≒枠～文字のバランスが良い？）」ため、文字枠基準で描画している今回には適しているだろうと判断しました。
もちろんフォントの感じにも好みがあるので、「ANSI（hPen1ペン種）」「S-JIS（hPen2ペン種）」どちらでもOKです。
（但し図２１の「外周点を文字で描画」の場合は、「・」はANSIでは文字化けしますのでS-JISのみとなります。）
数字のANSIとS-JISの違い
図２６
また、数字の色は既定（黒色）のまま使用していますが、もし色を変えたい場合は２９０～２９１行目あたりで「SetTextColor(hdc, RGB(255, 0, 0))」などと文字色変更をして下さい（今回はAPI関数の宣言をしていません）。もちろん３０１～３０２行目あたりで元に戻す必要があります。

３－２－６．時計の針の描画

図１４の１９７行目から呼び出されるのが下記です。引数として「現時刻」を受け取ります。この現時刻の元は、今回Time()としましたので、0～1未満の値という事になります。
  1. '==========　⇩(12)　時計の針の計算 ============
  2. Public Sub makeTime(Disp_Time As Date) 　 'Disp_Timeには、現時刻「Time()」が渡される
  3. 　Dim L As Double 　　　 '針の長さ（ピクセル）
  4. 　Dim Rad As Double 　　 '針の角度（ラジアン）
  6. 　L = ClockSize / 2 * 0.7 　　 '秒針長さ
  7. 　Rad = 2 * Pi * Second(Disp_Time) / 60
  8. 　Call makeClockHand1(hPen3, L, Rad)
  10. 　L = ClockSize / 2 * 0.5 　　 '短針長さ
  11. 　Rad = 2 * Pi * (Hour(Disp_Time) + Minute(Disp_Time) / 60) / 12
  12. 　Call makeClockHand1(hPen1, L, Rad)
  14. 　L = ClockSize / 2 * 0.9 　　 '長針長さ
  15. 　Rad = 2 * Pi * (Minute(Disp_Time) + Int(Second(Disp_Time) / 20) * 20 / 60) / 60
  16. 　Call makeClockHand1(hPen2, L, Rad)
  18. End Sub
図２７
３２５～３２７行目は、秒針の長さと角度の計算です。
３２５行目「L = ClockSize / 2 * 0.7」では、秒針の長さを「時計の半径の70%の長さ」にしています。この長さの割合は、自宅に掛かっている時計を見て決めました。
３２６行目「Rad = 2 * Pi * Second(Disp_Time) / 60」は、12時をゼロとした秒針の角度を計算しています。まず右辺の「Second(Disp_Time)」で、現時刻の「秒」を取得します。秒針にとって1周（＝360°）は60秒ですので、秒を60で除算する事で1周に対する割合となります。一方、1周（＝360°）はラジアンで考えると「2 × π（パイ）」ですので、ラジアンでの角度は「2 * Pi * Second(Disp_Time) / 60」ということになります。
３２７行目「Call makeClockHand1(hPen3, L, Rad)」では、図２８のmakeClockHand1プロシージャを呼び出し、実際に秒針を描画させます。
第１引数には、図１０の１３２行目で設定した論理ペン「hPeen3」を指定しています。この論理ペンには、「実線＋太さ1ピクセル＋黒色」の設定がしてあります。第２引数には３２５行目で計算した針の長さを、第３引数には３２６行目で計算した針の角度を指定します。
３２９～３３１行目は、短針の長さと角度の計算です。
３２９行目「L = ClockSize / 2 * 0.5」では、短針の長さを「時計の半径の50%の長さ」にしています。
３３０行目「Rad = 2 * Pi * (Hour(Disp_Time) + Minute(Disp_Time) / 60) / 12」は、短針の角度を計算しています。「時」をHour関数で取り出すと、時計の1周は12時間ですので「Hour(Disp_Time) / 12」となるのですが、実際の時計では短針と言えども分単位・秒単位で少しずつ動いています。今回は分単位の動きを短針に盛り込むため「+ Minute(Disp_Time) / 60」の角度分だけ短針角度に加算しています。
３３１行目「Call makeClockHand1(hPen1, L, Rad)」では、第１引数に図１０の１３０行目で設定した論理ペン（実線＋太さ6ピクセル＋黒色）を指定して、時計針の描画プロシージャを呼び出しています。
３３３～３３５行目は、長針の長さと角度の計算です。
３３３行目「L = ClockSize / 2 * 0.9」では、長針の長さを「時計の半径の90%の長さ」にしています。
３３４行目「Rad = 2 * Pi * (Minute(Disp_Time) + Int(Second(Disp_Time) / 20) * 20 / 60) / 60」は、長針の角度を計算しています。「分」をMinute関数で取り出すと、時計の1周は60分なので「Minute(Disp_Time) / 60」となるのですが、今回は「20秒毎に分針を動かす」事とし、「+ Int(Second(Disp_Time) / 20) * 20 / 60」を分の計算に加算しています。
３３５行目「Call makeClockHand1(hPen2, L, Rad)」では、第１引数に図１０の１３１行目で設定した論理ペン（実線＋太さ3ピクセル＋黒色）を指定して、時計針の描画プロシージャを呼び出しています。
図２７の３２７行目・３３１行目・３３５行目から呼び出されるのが下記です。ペンの種類・針の長さ・針の角度の情報を受け取り、実際に針を描画しています。
  1. '==========　⇩(13)　時計針の描画１ ============
  2. Sub makeClockHand1(hPen As LongPtr, L As Double, Rad As Double)
  3. 　Dim lpPoint As POINTAPI 　 '元の現在位置座標
  4. 　Dim Xp As Double 　　　　 '時計針の先端X座標
  5. 　Dim Yp As Double 　　　　 '時計針の先端Y座標
  6. 　Dim Previous_Pen As LongPtr 　 '元のペン種
  8. 　Previous_Pen = SelectObject(hdc, hPen)
  10. '「中心から長い側の針」
  11. 　Call MoveToEx(hdc, Clock_X0 * DispRatio / 0.75, Clock_Y0 * DispRatio / 0.75, lpPoint) 　 '始点移動
  12. 　Xp = Clock_X0 + L * Sin(Rad)
  13. 　Yp = Clock_Y0 - L * Cos(Rad)
  14. 　Call LineTo(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75) 　 '終点まで描画
  16. '「中心からのはみ出し分」
  17. 　Call MoveToEx(hdc, Clock_X0 * DispRatio / 0.75, Clock_Y0 * DispRatio / 0.75, lpPoint) 　 '始点移動
  18. 　Xp = Clock_X0 + L / 4 * Sin(Rad + Pi)
  19. 　Yp = Clock_Y0 - L / 4 * Cos(Rad + Pi)
  20. '　Xp = Clock_X0 - L / 4 * Sin(Rad)
  21. '　Yp = Clock_Y0 + L / 4 * Cos(Rad)
  22. 　Call LineTo(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75) 　 '終点まで描画
  24. 　Call SelectObject(hdc, Previous_Pen)
  26. End Sub
図２８
受け取る値は「hPen（描画線のペン種）」「L（中心から針先端までの長さ）」「Rad（時計針の角度）」の３つです。
３５７行目「Previous_Pen = SelectObject(hdc, hPen)」では、受け取ったペン種（hPen）を描画道具として選択しています。
３６０～３６３行目は、時計中心から針先端までの直線を描画する部分です。
まず３６０行目「Call MoveToEx(hdc, Clock_X0 * DispRatio / 0.75, Clock_Y0 * DispRatio / 0.75, lpPoint)」で、描画の現在位置を時計中心に移動させています。第１引数はフォームのクライアント領域のデバイスコンテキスト（DC）ハンドルを指定します。
第２・第３引数は、移動先のXY座標（ピクセル単位）です。ここでは「時計中心から針先端に向かって直線を描画」しますので、XY座標は時計中心を指定します。時計中心は図１２で既に計算済みですが、この値はポイント単位ですのでピクセル値に変換をする必要があります。ポイントをピクセルに変換するには「ピクセル値 = ポイント値 × ディスプレイ拡大率 / 0.75 」という計算をしますので、X座標は「Clock_X0 * DispRatio / 0.75」、Y座標は「Clock_Y0 * DispRatio / 0.75」となります。
MoveToEx関数は、実行することで指定先の座標に移動するのですが、実行後は第４引数に「元の現在座標」が戻ることになります。今回元の現在位置は使用しませんが、引数には「POINTAPI構造体の変数」を指定しておく必要があります。そこで３５２行目「Dim lpPoint As POINTAPI」でPOINTAPI構造体の変数を宣言しておき、第４引数に変数lpPointを指定します。
３６１行目「Xp = Clock_X0 + L * Sin(Rad)」は、時計針の先端座標（ポイント単位）を計算しています。この計算は、図１８の①の三角形の辺の長さの計算と同じで、斜辺＝「L」及び角度＝「Rad」で置き換えれば良いことになります。
３６２行目「Yp = Clock_Y0 - L * Cos(Rad)」も同様に、図１８の②の三角形の計算でY方向の差分が求まります。あとは、時計中心座標に対するプラスマイナスを考えれば良いことになります。
３６３行目「Call LineTo(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75)」は、第２・第３引数に終点のXY座標位置を指定することで線を描画しています。座標位置は３６１～３６２行目で計算したXp・Yp値（ポイント単位）をピクセル単位に変換し指定しています。
３６０～３６３行目の針の描画処理だけでも、一応時計としては完成します。３６３行目までを実行した姿は下図の一番左のようになります。
時計の針のしっぽ有無の形状と作成方法
図２９
但し実際の時計を見てみると、図２９の中央のように「多くの時計の針は、時計軸の反対側に少しはみ出ている」ことに気が付きます。今回これを勝手に「シッポ」と呼びますが、このシッポを描画するのが３６６～３７１行目になります。
なお、シッポの長さは図２９の一番右側のように「長い側の針（長さ＝L）①」に対し1/4（右図の②）の長さとしています。
まず「時計軸の反対側の座標」をどのように計算すれば良いかを図３０の長針で考えます。ここでは時計は10:10を指しています。
時計の針のしっぽの座標位置の考え方
図３０
長い方の針の先端座標は、３６１～３６２行目のように時計中心に対する補正分として、X方向は「+ L * Sin(Rad)」、Y方向は「- L * Cos(Rad)」です。
逆側のシッポは、角度的に言えば「長い方の針に対して、180°（＝π（パイ）ラジアン）ズレた位置にいる」ので、指定角度「Rad」を「Rad + Pi」とすれば良いことになります。なおシッポの長さはL/4ですので、X方向の補正分は「 + L / 4 * Sin(Rad + Pi)」、Y方向の補正分は「- L / 4 * Cos(Rad + Pi)」としたのが３６７～３６８行目の座標計算です。
別な考え方も出来ます。長い方の針を水平・垂直の線で囲むと図３０の赤い三角形が２つ（①と②）出来ることになります。この三角形の１つの角度がRadなので、差分の値が X方向「L * Sin(Rad)」、Y方向「L * Cos(Rad)」となるのですが、シッポの方はその２個の三角形を時計中心に対し180°回転させた位置（緑色の２個の三角形③④）に来ることになります。
その緑色の２個の三角形（③と④）は、斜辺の長さがもし同じだとすれば、赤色の三角形（①と②）と全く一緒であることが分かります。今回のシッポの長さは長い方の1/4ですので、差分の値もX方向「L / 4 * Sin(Rad)」、Y方向「L / 4 * Cos(Rad)」となります。
但し緑色の三角形は、赤色の三角形に対し時計中心の逆側になりますので、プラスマイナスも逆になり、X方向「Clock_X0 - L / 4 * Sin(Rad)」Y方向「Clock_Y0 + L / 4 * Cos(Rad)」となります。これが見え消しにしてある３６９～３７０行目です。
３６７～３６８行目、３６９～３７０行目のどちらの座標計算式を使っても、同じ結果が得られます。
そのXY座標位置（ポイント単位）を使って、「時計中心からシッポ先端までの描画」をしているのが３７１行目「Call LineTo(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75)」です。ポイントからピクセルに変換するため「* DispRatio / 0.75」を乗算しています。
なおペンの現在位置は、３６３行目を実行した後は「長い方の針の先端」に移動してしまっています。そのため３７１行目のLineToで描画する前に、３６６行目「Call MoveToEx(hdc, Clock_X0 * DispRatio / 0.75, Clock_Y0 * DispRatio / 0.75, lpPoint)」で、再び時計中心に移動させておく必要があります。
長い方の針＋シッポの描画が完了したら、３７３行目「Call SelectObject(hdc, Previous_Pen)」で、既定のペンに戻します。
図２８では、長い方の針とシッポを別々に描画しましたが、もちろん１回で描画することも可能です。下記は「シッポの先端」を始点にし、「長い方の針の先端」を終点にして線を描画するものです。
  1. '==========　⇩(14)　時計針の描画２ ============
  2. Sub makeClockHand2(hPen As LongPtr, L As Double, Rad As Double)
  3. 　Dim lpPoint As POINTAPI 　 '元の現在位置座標
  4. 　Dim Xp As Double 　　　　 '時計針の先端X座標
  5. 　Dim Yp As Double 　　　　 '時計針の先端Y座標
  6. 　Dim Previous_Pen As LongPtr 　 '元のペン種
  8. 　Previous_Pen = SelectObject(hdc, hPen)
  10. '始点（シッポの先端）移動
  11. 　Xp = Clock_X0 - L / 4 * Sin(Rad)
  12. 　Yp = Clock_Y0 + L / 4 * Cos(Rad)
  13. 　Call MoveToEx(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75, lpPoint)
  15. '終点（針の長い方の先端）まで描画
  16. 　Xp = Clock_X0 + L * Sin(Rad)
  17. 　Yp = Clock_Y0 - L * Cos(Rad)
  18. 　Call LineTo(hdc, Xp * DispRatio / 0.75, Yp * DispRatio / 0.75) 　　 '直線描画(終点定義)
  20. 　Call SelectObject(hdc, Previous_Pen)
  22. End Sub
図３１
４００～４０２行目では、始点をシッポの先端に移動させています。座標計算は図２８の３６９～３７０行目（見え消し部分）と同じです。
４０５～４０７行目では、時計針の先端を終点にして線を描画しています。この時の座標計算は図２８の３６１～３６２行目と同じです。

３－２－７．時計中心の描画

図１４の１９８行目から呼び出されるのが下記です。時計中心に時計軸（円形）を描画しています。
  1. '==========　⇩(15)　時計軸の描画 ============
  2. Sub makeCenter()
  3. 　Const Size As Integer = 6 　　　　 '時計軸の半径（ピクセル単位）
  4. 　Dim Xx As Double '(単位Pix) 　　　 '時計軸の中心X座標（ピクセル単位）
  5. 　Dim Yx As Double '(単位Pix) 　　　 '時計軸の中心Y座標（ピクセル単位）
  6. 　Dim Previous_Brush As LongPtr 　　 '元のブラシ種
  8. 　Previous_Brush = SelectObject(hdc, hBrush)
  10. 　Xx = Clock_X0 * DispRatio / 0.75
  11. 　Yx = Clock_Y0 * DispRatio / 0.75
  12. 　Call Ellipse(hdc, Xx - Size, Yx - Size, Xx + Size, Yx + Size)
  14. 　Call SelectObject(hdc, Previous_Brush)
  16. End Sub
図３２
４３２行目「Const Size As Integer = 6」は、図３３のように「時計軸の半径」をピクセル単位で指定しています。もちろんモジュール先頭部分でモジュール定数として宣言してもOKです。
時計の針のしっぽの座標位置の考え方
図３３
４３７行目「Previous_Brush = SelectObject(hdc, hBrush)」は、、図１０の１３３行目で作成したブラシ種を選択します。
４３９行目「Xx = Clock_X0 * DispRatio / 0.75」は、図１２の１７２行目で計算した「時計中心」のX座標（ポイント単位）を「ピクセル単位」に変換して変数Xxに代入しています。４４０行目「Yx = Clock_Y0 * DispRatio / 0.75」はY座標で、内容はX座標と同じです。
４４１行目「Call Ellipse(hdc, Xx - Size, Yx - Size, Xx + Size, Yx + Size)」ではEllipse関数を使って、円を描画しています。第１引数にはフォームのクライアント領域のデバイスコンテキストハンドルを指定します。
第２～５引数は、描画する円に外接する四角形の左上隅の座標（第２引数にX座標、第３引数にY座標）・右下隅の座標（第４引数にX座標、第５引数にY座標））を指定します。今回は図３３の右側のように、時計中心（＝円中心）の（Xx, Yx）に対して円の半径（＝Size値）をプラスマイナスした「四角形」を指定することになります。
なお、ここで描画される円形の内部は「４３７行目で指定したhBrushの白色の塗りつぶし」ですが、ペン種は指定していないため、既定のペン（黒色の実線＋太さ1ピクセル）で円の外形が描画されています。
円の描画が完了したら、４４３行目「Call SelectObject(hdc, Previous_Brush)」でブラシを元に戻します。

３－２－８．終了処理

フォームの右上の×印をクリックし、フォームが閉じられる時に発生するイベントが以下になります。なおフォーム終了時は「QueryClose」→「Terminate」の順でイベントが発生しますので、今回の場合はどちらで終了処理をしてもOKです。
  1. '==========　⇩(16)　終了処理 ============
  2. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  3. 　Clock_On = False
  5. 　Call DeleteObject(hPen1)
  6. 　Call DeleteObject(hPen2)
  7. 　Call DeleteObject(hPen3)
  8. 　Call DeleteObject(hBrush)
  9. 　Call DeleteObject(hFont1)
  10. 　Call DeleteObject(hFont2)
  12. 　Call ReleaseDC(hWnd, hdc)
  13. End Sub
図３４
４６２行目「Clock_On = False」は、パブリック変数（標準モジュールの先頭部でPublic宣言した変数）である「Clock_On」をFalse（＝時計をOFF）にしています。このパブリック変数の変化を受けて、標準モジュール側での時計の時刻更新処理の継続・中止を判断させます。
４６４～４６９行目では、図１０の１３０～１３５行目で作成したペン種・ブラシ種・フォント種を削除しています。
例えば４６４行目「Call DeleteObject(hPen1)」は、図１０の１３０行目で作成したペン種のハンドル（hPen1）を引数にして、ペン種のオブジェクトを削除します。
４７１行目「Call ReleaseDC(hWnd, hdc)」は、図１０の１２８行目で取得した「フォームのデバイスコンテキスト（DC）のハンドル」を削除しています。
これらの「道具の削除」および「DCの削除」は、プログラム終了時には必須項目です。しかしフォームの異常終了時には、この終了処理が実行されない事になります。この場合、どのような状況になるかまでは分かりませんでした。

４．時を刻むプログラム

４－１．ワークシート

「サンプルファイル」のSheet1上には３つのボタンがあります。そのボタンには以下のように、それぞれ「標準モジュールに置いた UFstart1・UFstart2・UFstart3」のマクロが登録されています。
シート上のボタンと実行マクロの関連付け
図３５

４－２．標準モジュール

  1. '==========　⇩(17)　標準モジュールの宣言部 ============
  2. Public Clock_On As Boolean 　 '全てのプロシージャで使用
  4. Dim Timer_ID As LongPtr 　　　 'UFstart3、TimerProc3のみで使用
  6. #If Win64 Then 　　　 'UFstart3、TimerProc3のみで使用
  7. 　Private Declare PtrSafe Function SetTimer Lib "user32" _
  8. 　　(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
  9. 　Private Declare PtrSafe Function KillTimer Lib "user32" _
  10. 　　(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
  11. #Else
  12. 　Private Declare Function SetTimer Lib "user32" _
  13. 　　(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
  14. 　Private Declare Function KillTimer Lib "user32" _
  15. 　　(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
  16. #End If
図３６
４８１行目「Public Clock_On As Boolean」は、プログラム全体で使用するパブリック変数の宣言です。時計が表示されている間は「Clock_On = True」、表示されていない時は「Clock_On = False」としています。時計の表示・非表示を感知する変数ですので、今回３種類の手法の全てで使用しています。
４８３行目「Dim Timer_ID As Long」は、ボタン3の「SetTimer関数での時刻制御」で使用する変数です。
また４８５～４９５行目の「SetTimer関数」「KillTimer関数」のWin32API関数宣言もボタン3 のみで使用します。
４８６～４８７行目はSetTimer関数の宣言で、指定したミリ秒ごとに特定のプロシージャを実行するものです。
４８８～４８９行目は、SetTimer関数での予約を取り消すKillTimer関数です。
Excelのビット違い（32ビット、64ビット）の、どちらでも動かせるように「#If Win64 Then～#Else～#End If」で分岐しています。

４－２－１．Do～Loop法

もっとも簡単と思われるのが、Do～Loopを回しながら時間のタイミングを計る方法です。フォーム側とのやりとりは、以下のような形になります。
Do～Loop法での時の刻み方の考え方
図３７
但しこの方法は、動作中（今回の場合は時計表示中）にCPUの負荷が相当上がりますし、Do～Loop間に「DoEvents」を入れ忘れると永久ループになりますので注意が必要です。
シート上の「ボタン1」から呼び出されるのが、以下のUFstart1プロシージャです。
  1. '==========　⇩(18)　Do～Loop法 ============
  2. Public Sub UFstart1()
  3. 　Dim T As Date 　　 '時計を表示させた時の時刻
  5. 　UserForm1.Show vbModeless
  7. 　Clock_On = True
  9. 　Do While Clock_On = True And UserForm1.Visible = True
  11. 　　If Not T = Time() Then
  12. 　　　T = Time()
  13. 　　　Call UserForm1.makeClock
  14. 　　End If
  16. 　　DoEvents: DoEvents
  17. 　Loop
  19. End Sub
図３８
５１４行目「UserForm1.Show vbModeless」は、ユーザーフォームを「モードレス」で起動しています。モードレスのため、フォーム（アナログ時計）表示中でもワークシート上の作業が可能となります。なお今回は「時計の動きを標準モジュール側から制御」しているため、もし「モーダル」でフォームを起動してしまうとコードの実行が５１４行目でストップしてしまう事になり「動かない時計」となってしまいます。ですので、今回は特に「モードレス」での起動が必須です。
５１６行目「Clock_On = True」では、図３６の４８１行目で宣言したグローバル変数Clock_OnをTrue（＝時計が表示されている状態）にしています。この変数がTrueになることで、５１８～５２６行目のDo～Loopが回り続けます。
寄り道(Clock_ONをTrueに変更する場所)
今回、ユーザーフォーム（アナログ時計）の表示フラグとして変数Clock_Onを設けています。変数宣言はBoolean型で行っています（図３６の４８１行目）ので、初期既定値はFalseです。
そして、UserForm1.Showでフォームを起動した後の５１６行目「Clock_On = True」で時計ONにし、フォームが閉じられる時に図３４の４６２行目「Clock_On = False」で時計OFFの設定をしています。
まずTrueにするタイミングですが、標準モジュール側では無くフォームモジュール側でも良いです。但しフォームモジュール内でTrueにする場合は、「Initializeイベント内」でなくてはなりません。
その確認の為に、今回の「Do～Loop法」の実行順序を調べた結果が以下になります。赤線が実行される順番を表しています。
標準モジュールとフォームモジュールの実行順序
図３９
標準モジュール側のUserForm.ShowによりフォームがLoadされますが、実行されるのはInitializeイベントのみで、すぐに標準モジュールに制御は戻ってきてしまいます。その後Do～Loop内に入り、初回のIf～End IfはT値が既定のゼロですのでフォームのmakeClockプロシージャが呼び出されるため、初回の「アナログ時計」が描画されます。
その後DoEventsにより一時的にO/Sに制御が戻された時に、初めてフォームのActivateイベント（Layoutイベントがあれば、Activateの前に実行される）が実行される事になります。
Clock_On変数値のチェックが行われるのはDo～Loopの入口ですので、それよりも前に実行されているInitializeイベント内で「Clock_On = True」を行っておく必要があるのです。

５１８行目「Do While Clock_On = True And UserForm1.Visible = True」では、Do～Loopが回り続ける条件を「While Clock_On = True And UserForm1.Visible = True」と設定しています。
１つ目の条件が５１６行目で値をTrueに設定した「Clock_On = True」です。このClock_On変数は、ユーザーフォーム（＝時計）が表示されている間はTrueであるため、Do～Loopが回り続ける事になります。
２つ目の条件「UserForm1.Visible = True」は「ユーザーフォームが表示されている時」と言う意味です。１つ目も２つ目もほぼ同じ意味に見えますが、詳しくは下記「よりみち」で説明します。
寄り道(Do～Loopを回し続ける条件)
５１８行目のDo～Loopを回す条件を、今回は「While Clock_On = True And UserForm1.Visible = True」としました。以下の２つの式を「And」で結んでいるので、両方とも成立している間は回り続ける事になります。
（逆に言うと、どちらかが不成立の場合にはDo～Loopが終了します。）
　① Clock_On = True
　② UserForm1.Visible = True
①は「フォーム起動中」である事をプログラマー側が設定しているフラグです。一方②はフォームのプロパティを調べて「フォームが起動しているか否か」を調べるものです。
正常に動いているのであれば、①のみのDo～Loop条件で良いと思います。しかし「もしフォームが何らかの原因で途中でダウン」してしまった時には変数Clock_OnはTrueのままとなっていますので、Do～Loopが停止しない事になってしまいます。
②はその補助的存在ともいえます。
一方、実は②だけでもDo～Loopの条件としては成立します。しかし②を確認するためには「ユーザーフォームのLoad（＝Initializeイベントの実行）」が必要となり、「起動しているか否かを調べるために、わざわざ起動させる」ような動作となってしまいます。
今回、条件を①＋②とすることで、結局「ユーザーフォームを右上×印で閉じた後、再びLoadして閉じているかを確認」しているのですが、私としては「あくまでもプログラマーの意思でDo～Loopを終わらせ、異常時のためにフォームのVisibleを調べている」というスタンスが良いのでは？と考え、このようにしました。

５２０～５２３行目のIf～End If は、時刻が次の秒を指しているか否かを判断し、次の秒になっていれば５２１～５２２行目を実行させてアナログ時計を表示させています。
まず５２０行目「If Not T = Time() Then」では、変数Tと現在時刻を比べ「異なっているか否か」を調べています。変数Tには５２１行目「T = Time()」で「時計を描画した時の時刻」が収められており、かつ変数Tは５１２行目で Date型として宣言していますので「秒単位」の精度です。
つまり「１秒ごとに『Not T = Time()』の条件が整う」ことになります。
なお初めてIf文を通る時には「変数T＝既定のゼロ」ですので、必ず５２１～５２２行目が実行される事になります。
５２０行目の条件が整ったら、５２１行目「T = Time()」でその時刻を変数Tに代入し、５２２行目「Call UserForm1.makeClock」でフォームのmakeClockプロシージャ（図１４）を呼び出し、GDIで時計の全ての描画を更新（≒1秒進んだ時刻を指すアナログ時計となる）します。
５２５行目「DoEvents: DoEvents」は、制御をO/Sに戻し、ユーザー側の操作（シート作業やフォームの移動など）が可能となります。
このDo～Loop法での時計の精度を「秒を刻む間隔」と言う見方で調べてみると、以下のようになります。
ほぼ「1-0.01～1+0.01」の範囲に収まっており、アナログ時計としては充分そうな気がします。
また平均値がミリ秒単位でもジャスト1秒となっている事からも分かるように、再描画のタイミングがズレていく傾向も見られませんので、秒飛び（一気に２秒以上針が動く）はほぼ無さそうです。
Do-Loopでの1秒のバラツキグラフ
図４０

４－２－２．OnTime法

OnTimeメソッドで１秒ごとに自分自身を呼び出しながら時計の描画を更新するのが下記のOnTime法です。
OnTime法での時の刻み方の考え方
図４１
この方法は、他の処理の影響を受けてOnTimeの呼び出し実時刻が遅れる場合があります。時計で言えば「秒飛び（≒針がしばらく動かず、その後針が２秒以上動く）」の現象が出る可能性があります。
また「ワークシートのセル編集中」はOnTimeで予約したプロシージャが呼び出されず、時計がストップしてしまいます。しかしCPU負荷は上がらないメリットもあります。
シート上の「ボタン2」から呼び出されるのが、以下のUFstart2プロシージャです。
  1. '==========　⇩(19)　OnTime法 ============
  2. Public Sub UFstart2()
  3. 　UserForm1.Show vbModeless
  5. 　Clock_On = True
  7. 　Call TimerProc2
  8. End Sub
図４２
５４２行目「UserForm1.Show vbModeless」でユーザーフォームをモードレスで起動し、５４４行目「Clock_On = True」でグローバル変数Clock_OnをTrueに変更しています。
そして５４６行目「Call TimerProc2」で下記図４３を呼び出します。これがTimerProc2の「最初の呼び出し」となります。
図４２の５４６行目から呼び出され、また自分自身から再帰呼び出されるのが下記の「TimerProc2」プロシージャです。
  1. '==========　⇩(20)　OnTimeで呼び出されるプロシージャ ============
  2. Public Sub TimerProc2()
  4. 　If Clock_On = False Or UserForm1.Visible = False Then
  5. 　　Exit Sub
  6. 　End If
  8. 　Application.OnTim Now() + TimeValue("00:00:01"), "TimerProc2"
  9. 　Call UserForm1.makeClock
  11. End Sub
図４３
５６３～５６５行目のIf～End Ifでは、フォーム（≒時計）が表示されているか否かを調査し、終了または非表示であれば「新たなOnTime予約をせずに終了」させています。
５６３行目「If Clock_On = False Or UserForm1.Visible = False Then」の２つの条件式「Clock_On = False」「UserForm1.Visible = False」はDo～Loop法の時と同じ（よりみち参照）で、「プログラマーの意思による停止」または「意図せずにフォームがダウン」した時に、５６４行目「Exit Sub」で「再帰呼び出しのループ」から抜け出します。
フォーム（時計）が表示されている間は、５６７～５６８行目が実行されます。
５６７行目「Application.OnTime Now() + TimeValue("00:00:01"), "TimerProc2"」で、指定プロシージャの実行予約をします。OnTimeメソッドの第１引数には「実行する時刻」を、第２引数には実行するプロシージャ名を指定します。
まず実行時刻は、今回1秒ごとに時計の針を進めるのですから「Now() + TimeValue("00:00:01")」とし、1秒後に自分自身を再帰呼び出しする予約をします。
実行するプロシージャは自分自身ですから「"TimerProc2"」とします。
５６８行目「Call UserForm1.makeClock」では、ユーザーフォームのmakeClockプロシージャ（図１４）を呼び出し、時計の表示を更新させます。
寄り道(OnTimeに指定する時刻)
図４３の５６７行目「Application.OnTime Now() + TimeValue("00:00:01"), "TimerProc2"」では、現時刻として「Now()」を使用しています。この代わりに「Time()」を使っても良さそうに思えます。
Time()の範囲は「0～1未満」の値で、最も大きい値は「23:59:59」です。この値に「00:00:01」を加えると、数値としては原則「1」となります。
Date型では「1未満」は時刻のみと見てくれますが、「1以上」は日付＋時刻と認識します。つまり1は「1899年12月31日 午前0時」という日付＋時刻となります。
この値＝1をOnTimeに指定してしまうと、過去の日時を指定した事になってしまい「OnTimeメソッドは指定したプロシージャ（この場合は自分自身）を即座に実行」します。すると呼び出した先のプロシージャで再びOnTimeに値＝1を指定してしまい・・・とプロシージャ実行の連鎖が起こります。
現象としては、「12:59:59」になった直後から高速で連続して時計描画が更新され、マウスのマークが慌ただしく点滅します。しかし「00:00:00」になると普通に戻り、また１秒ごとに時を刻みます。
つまり「0時前の1秒間だけ、異常な状況」となります。真夜中だしあまり影響ないような気もしますが、「Now()」の方が安心です。

このOnTime法での時計精度を、図４０と同様に「秒を刻む間隔」で調べてみると以下のようになります。
OnTimeでの1秒のバラツキグラフ
図４４
全体としては１±0.05くらいには入っていますが、赤矢印のように「時々早かったり遅かったり」する事があります。
原因の１つは、Excel以外も含めた他の実行タスクとOnTimeの実行が重なった事が考えられますが、早まる原因にはなりそうにありません。
そこで見方を変えて、計測開始時点を時刻の基準とした「時を刻む時刻の遅れ進み推移」を見てみたのが下記です。
OnTimeでの描画更新指示の遅れ進み推移グラフ
図４５
このグラフを見る限りでは、徐々にタイミングが遅れた後で急に元にもどったり、急に遅れたりする現象が見られます。実行の遅れは、他のタスクを優先した可能性がありますし、急に戻るのも他のタスクが終わった為かもしれません。他にもOnTimeには遅れたり進んだりする原因があるのかもしれませんが、確かめる方法も分からず、良くわかりませんでした。
しかし図４４での平均値は1秒ジャストであることから、全体としては「フラフラしていても、秒飛びが起こる事は少ない」ように見受けられます。これはOnTimeに対して「Now()関数」で実行時刻を指定（図４７参照）している為なのかもしれません。
寄り道(OnTimeに指定するデータ型)
図４３の５６７行目を見て「Application.OnTime Evaluate("Now()") + CDbl(TimeValue("00:00:01")), "TimerProc2"」の方が「より精度が良くなる」と思われた方もいると思います。Date型→Double型になって値の精度が向上するからです。私も最初そう思いました。
しかし試してみると全く逆で、以下のように「Double型で指定すると、圧倒的に精度が悪くなり、秒飛びが多発」する結果となります。秒飛びの発生頻度は４秒に1回平均（もう少し状態の良い時もあります）ですから、ひどいものです。
OnTimeにDouble型日付を使った場合の描画更新指示の遅れ進み推移グラフ
図４６
この原因の１つとして考えられるのが、指定する実行時刻をDate型にした時とDouble型にした時の違いです。
OnTimeの指定時刻がDate型とDouble型とでどう異なるか
図４７
予約時刻にOnTimeメソッドがプロシージャを実行しようとしても、他のタスクの影響を受けて実際の実行時刻が遅れてしまう事は多々あります。しかし予約時刻を「Now() + ･･･」と指定すれば、Date型ですので秒単位の制御となり、図４７の左側のように「秒単位の正時から1秒後」を予約することになります。
一方「Evaluate("Now()") + ･･･」の形で指定してしまうと、図４７の右側のように「その瞬間から1秒後」を予約することになり、徐々に遅れていく事につながります。
また「OnTimeに指定した時刻」と「実際に実行された時刻」を比べてみたのが図４８です。
OnTimeの指定時刻に対する実行時刻の遅れグラフの比較
図４８
まずDouble型の方は、全体の30%近くが１秒以上遅れて予約したプロシージャが実行されています。また途中のデータがほとんど無いのも異様です。
もう一つ言えることは、Date型（左側図）は約+0.24秒が実行時刻の遅れの最大値であるのに対し、Double型（右側図）は（ゼロ付近の山として）約+0.06秒の遅れしかありません。
Date型とDouble型を同時に実行した訳では無く、他タスク等の割り込みの状況も影響しているのでしょうが、もしかしたら
「OnTimeに『正時の秒時刻から外れた時刻を指定』すると、動作が不安定になる」のかもしれません。
このように「Evaluate("Now()") + ･･･」という形でOnTimeメソッドに時刻予約をすると、予期せぬ結果が出る可能性がありそうです。OnTimeの使い方は少し違いますが、別項の「処理を一定時間停止させる」でも大きく外れる値が見受けられた（少しレベルが違いそうですが）ので、OnTimeメソッドではDouble型はあまり使わない方が良さそうです。

４－２－３．SetTimer法

Win32API関数のSetTimerに「実行時間の間隔」と「実行プロシージャ」を登録しておくことで、O/S側からの指示で定期的に時計の描画更新をするのが、下記のSetTimer法です。
SetTimer法での時の刻み方の考え方
図４９
この方法は、指定した時間間隔よりも「徐々に遅れが生じる」傾向があるようです。今回私のPCでは「1秒／160秒」くらいになりますので、約３分に1回の秒飛びが発生する計算になります。
またこの関数は扱いが難しいみたいで、様々なサイトで「Excelがクラッシュ」などとの情報が上がっています。私も今回、フォームモジュール側からSetTimer関数を動かしてみたら何回もExcelが強制終了してしまいました。危険と隣り合わせの便利な関数なので、本サンプルファイルを試す場合も、大切なファイルは閉じてからにして下さい。
なおCPUの負荷は上がりません。
まずSetTimer法で使用するWin32API関数の内容を整理します。
役割関数名宣言
引数引数の内容構造体戻り値
ﾀｲﾏｰを
作成		SetTimer Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
hWnd
nIDEvent
uElapse
lpTimerFunc		ｳｨﾝﾄﾞｳのﾊﾝﾄﾞﾙ
ﾀｲﾏｰ識別子
ﾀｲﾑｱｳﾄ値(ﾐﾘ秒)
呼び出す関数へのﾎﾟｲﾝﾀ		ー成功=ﾀｲﾏｰ識別子
失敗=0
ﾀｲﾏｰを
破棄		KillTimerDeclare PtrSafe Function KillTimer Lib "user32" _
(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
hWnd
nIDEvent		ｳｨﾝﾄﾞｳのﾊﾝﾄﾞﾙ
SetTimerの戻り値		ー成功=ｾﾞﾛ以外
失敗=0
図５０
SetTimer関数は、タイマー（一定時間ごとに関数などを実行）を作成する機能です。４つの引数を渡す必要があります。
第１引数「ウィンドウのハンドル」は、タイマーに関連するウィンドウのハンドルを指定します。その際第２引数「タイマー識別子」は1以上の値を指定します。
第１引数にゼロを指定した時には、どのウィンドウにも関連付けられていないタイマーが作成され、その際には第２引数は無視されます。
寄り道(SetTimerのハンドルにゼロを指定した時の第２引数値)
あるサイトによると、①「タイマー作成の後、異なるところから第２引数と同一値を使ってSetTimer関数を実行されるとタイマーが置き換えられてしまうので、第１引数にゼロを指定した際には、第２引数はゼロを指定するのが望ましい」とあります。
一方多くのサイトでは、②「第１引数をゼロにした場合は、第２引数は１（以上）」でサンプルコードを紹介しています。
試してみると「第１引数にゼロを指定すると第２引数は全く無視」されるのは確かみたいで、SetTimer関数は第２引数とは無関係の値を戻してきます。逆に第１引数に「ユーザーフォームのハンドル」を指定し、第２引数に適当な値を指定すると、戻り値は「第２引数の値」となります。
タイマーを置き換える際には、それ以前にタイマー作成した時の「本当のタイマー識別子（SetTimer関数の戻り値）」を第２引数に指定する必要があるはずなので、無視されるタイマー識別子は関係無いと思われます。
と言って「第１引数＝ゼロ ＋ 第２引数＝ゼロ」でも問題なく動きますので、①②のどちらも間違ってない とも言えます。

第３引数は「実行間隔をミリ秒単位」で指定します。指定範囲は「10（0.010秒）～2,147,483,647（24日強：Long型のプラス側のMax値）」のようで、この範囲を外れた場合は、最小または最大値に置き換えられるようです。
第４引数は「実行するプロシージャ」のポインターです。C言語などではポインターは良く使われ「メモリ上の番地」という意味になります。VBAでは「AddressOf演算子」を使って「プロシージャのアドレス」を取得できますので、その値を渡します。
なおAddressOfで取得できるのは「標準モジュールに置いてあるプロシージャ」のみのようです。引数付きのプロシージャの場合は、この手法は無理かもしれません。
KillTimer関数は、SetTimerで作成したタイマーを破棄するものです。タイマーは作成したら必ず破棄しないと、メモリー上に残り良く無い影響を及ぼすようです。
第１引数「ウィンドウのハンドル」には、SetTimerと同じウィンドウハンドルを指定します。どのウィンドウにも関連付けられていないタイマーの場合は、ゼロ値となります。
第２引数には、タイマー作成時の「タイマー識別子」を指定します。
シート上の「ボタン3」から呼び出されるのが、以下のUFstart3プロシージャです。
  1. '==========　⇩(21)　SetTimer法 ============
  2. Public Sub UFstart3()
  3. 　UserForm1.Show vbModeless
  5. 　Clock_On = True
  7. 　Timer_ID = SetTimer(0, 1, 1000, AddressOf TimerProc3)
  9. End Sub
図５１
５８２行目「UserForm1.Show vbModeless」でユーザーフォームをモードレスで起動し、５８４行目「Clock_On = True」でグローバル変数Clock_OnをTrueに変更しています。
５８６行目「Timer_ID = SetTimer(0, 1, 1000, AddressOf TimerProc3)」では、タイマーを作成しています。
今回「どのウィンドウにも関連付けられていないタイマー」とするため、第１引数はゼロとしています。
第２引数は、第１引数をゼロとしているので「無視」されますが、とりあえず他サイトに倣って「1」としています。
第３引数は時間の間隔で、今回は１秒ごとに時を刻むため1000ミリ秒（＝1秒）としています。
第４引数は、指定時間ごとに実行するプロシージャのポインターを指定します。今回は「TimerProc3プロシージャ（図５２）」なので、そのポインターを得るために「AddressOf演算子に続けてプロシージャ名」を指定します。
SetTimer関数の戻り値は「タイマー識別子」です。この値は、KillTimer関数で不要になったタイマーを破棄するのに必要ですので、モジュール変数のTimer_IDにタイマー識別子を代入しておきます。
寄り道(Excelのタイマー作成)
今回はSetTimer関数の第１引数をゼロとし「どのウィンドウにも関連付けられていないタイマー」としましたが、例えばユーザーフォームのハンドルを「hwnd = FindWindow("ThunderDFrame", UserForm1.Caption)」で取得し、そのハンドル値を使って「SetTimer(hwnd, 123, ･･･」のようにしても動きます。
その場合はSetTimer関数の戻り値をTimer_IDのような変数で受け取らなくても、タイマー識別子は「ユーザーが指定した値（ここでは、値＝123）」ですので、終了時には「Call KillTimer(hwnd, 123)」とすれば良いことになります。
しかし試してみると、ユーザーフォームを閉じた時点で「ユーザーフォームのハンドルが消える＝SetTimerが無効になる」ためか、「呼び出されるはずの関数（ここではTimerProc3）」が呼び出されずに終了してしまいます。つまりKillTimerを実行する必要が無い？ことになります。この手法は便利なのかもしれませんが、ちょっと心配も残ります。
ウィンドウハンドルをユーザーフォームでは無く「Excel本体」にした場合は少し状況が変わります。「hwnd = FindWindow("XLMAIN", vbNullString)」とExcel本体のハンドルを取得し、上記と同様に「SetTimer(hwnd, 123, ･･･」とすることでも、ちゃんと正常に動きます。
終了時は「ユーザーフォームは閉じるが、Excelは閉じない ＝Excel本体のハンドルは生きている ＝ タイマーも生きている」ので、TimerProc3プロシージャ内の「Call KillTimer(hwnd, 123)」が実行されてタイマーが破棄されます。

図５１の５８６行目のSetTimer関数により作成されたタイマーで、１秒ごとに呼び出されるのが下記です。
  1. '==========　⇩(22)　SetTimerで呼び出されるプロシージャ ============
  2. Public Sub TimerProc3()
  3. 　On Error Resume Next
  5. 　　If Clock_On = False Or UserForm1.Visible = False Then
  6. 　　　Call KillTimer(0, Timer_ID)
  7. 　　Else
  8. 　　　Call UserForm1.makeClock
  9. 　　End If
  11. 　On Error GoTo 0
  12. End Sub
図５２
６０４行目「If Clock_On = False Or UserForm1.Visible = False Then」の２つの条件式「Clock_On = False」「UserForm1.Visible = False」はDo～Loop法・OnTime法の時と同じ（よりみち参照）で、「プログラマーの意思による停止」または「意図せずにフォームがダウン」した時に、６０５行目「Call KillTimer(0, Timer_ID)」でタイマーを破棄し、時計の描画を中止します。
今回のタイマーは「どのウィンドウにも関連付けられていないタイマー」ですので、KillTimer関数の第１引数にはゼロを指定し、第２引数には図５１の５８６行目で得た変数「Timer_ID（タイマー識別子）」を指定します。
変数Clock_On = True 且つ UserForm1も表示されている状態の時は、６０７行目「Call UserForm1.makeClock」を実行し、時計を描画します。１秒ごとにO/S側から、このTimerProc3プロシージャが呼び出され、６０７行目を実行することで「時計が１秒ごとに動いている」ように見えます。
なおTimerProc3プロシージャ内で何らかのエラーが発生すると、O/S絡みのためか「Excelが強制終了」してしまいます。ですので安全のために６０２行目「On Error Resume Next」を入れて、エラーをスルーさせています。これで全てが防げるとは思いませんが、試しにTimerProc3内で「Err.Raise」でエラーを発生させてみても、６０２行目があることで強制終了はしない事は確認出来ました。
またエラー処理はTimerProc3内のみとする為、６１０行目「On Error GoTo 0」で通常時に戻しています。
このSetTimer法での時計の精度を、図４０・図４４と同様に「秒を刻む間隔」で調べたのが以下になります。
SetTimerでの1秒のバラツキグラフ
図５３
バラツキも少なく、一見良さそうに見えます。しかし平均値を見ると「1000ミリ秒で設定したのに、実際は1007ミリ秒」の間隔になっています。この現象を目に見えるようにする為、実際に描画をした時刻を時系列で見てみます。
以下は、描画を行った時刻をミリ秒単位で調べ、秒単位の正時に対してどれだけズレているかを調べたものです。
SetTimerでの実描画時刻の推移
図５４
グラフでも分かるように「どんどんズレていく」データとなっています。計測のたびに傾きは変わるのですが「100 ～ 160秒で1秒ズレる」感じです。図５４を計測している途中では、横軸90（秒）くらいの場所で秒飛びが発生しているのも確認できました。
このズレの原因を調べるため、PCのタイマー精度をtimeBeginPeriod関数を使って「15.6ミリ秒 → 1ミリ秒」に変更して計測してみると、ズレ量は「1秒／約200秒」と少しだけ良くなります。またO/S側からExcel上のプロシージャへのアクセスに必要な時間もあるのでしょうが、これは「徐々に」遅れる現象にはならない気がします。
あとは、SetTimer内部での処理が「1秒経過を確認→プロシージャを呼び出し→次の1秒をセット」みたいな順序だとすれば、少しずつズレが発生する気はしますが、ミリ秒単位になるとも思えません。
原因は不明ながら対策としては、例えば「200ミリ秒ごとにプロシージャを呼び出す」ようにすれば、誤差は「１-0 ～ １+0.2」秒に収まるはずです。但し、描画される時計の時刻はDate型の正時の秒単位ですので、同じ時計を何度も書き換えてしまいチラチラしてしまうのが難点です。

５．まとめ

以上の内容をザッとまとめると以下のようになるかと思います。精度の数値は私のPCのものなので、参考値として下さい。
Do～Loop法OnTime法SetTimer法
精度秒間隔±0.01秒±0.25秒±0.02秒
表示時刻±0.015秒±0.2秒-0～+1秒
秒飛びほぼ無しほぼ無さそう100～160秒毎に発生
(改善策あり)
Excelの
作業への
影響		セル編集中時計は正常動作時計は停止時計は正常動作
ﾏｳｽ形状不変
PC負荷大小小
図５５
精度には２種類あると思います。１つは秒間隔の精度で、OnTime法だけはある程度のバラツキを覚悟する必要があります。
もう１つの精度は、表示されているアナログ時計が指している時刻精度で、SetTimer法では１秒ズレている可能性があります。しかしアナログ時計なので、許される範囲かもしれません。
とは言っても「秒飛び」は時計としては欠陥ですので、SetTimer法には難が残る気がします（「0.2秒毎に呼び出す」等の手法で秒飛びを無くす事は可能そうです）。
時計を表示させながら通常はExcelの作業をするかと思いますが、その作業に支障をきたしてしまっては元も子もありません。
セル編集中はOnTime法では時計が停止してしまうため、時計の機能としては疑問符が付きます。
マウスの形状は、Do～Loop法では「＋印」になってしまいますが、セル編集を１回行うと元に戻ります。OnTime法は針が動くたびに「バックグラウンドで作業中」の印になり、ちょっと気になるかもしれません。
またDo～Loop法ではCPU負荷が結構増加するので、パワーの小さなPCではつらいかもしれません。
どの手法にもメリット・デメリットがあります。もし私が選ぶのでしたら、SetTimer法かもしれません。Do～Loop法はCPU負荷が上がり作業中のExcelへの影響が大きそうですし、セル編集中の時間が長い私にしてみると、その間に時間が止まってしまうOnTime法も「あまり役に立たない時計」と思ってしまうかもしれません。
但しSetTimer法はExcelがダウンしてしまう可能性を秘めているため、ちょっと心配が残ります。定期的なファイル保存が必要そうです。
なおGDIで描画するアナログ時計についてですが、秒毎にチラつく場合とチラつかない場合があるようです。何が影響しているのかは把握できませんでした。
なおチラツキ対策の１つとして、時計として不変の「外周の点」と「数字」をLabelコントロールで描画する方法で「描画の書き換え範囲を狭くする」方法も試してはみました。しかし感覚的には変化は無い感じです。

６．アドインとしてExcelにマクロを登録

このマクロ付ファイル（サンプルファイル）をExcelのアドインに登録することで、今回の「ユーザーフォーム上のアナログ時計」を他のブック使用時でも呼び出して使うことが出来ます。アドイン方法については「年賀状リスト等の宛名検索と追記　アドイン登録」を参照下さい。

アプリ実例・関連する項目

「処理を一定時間停止させる」
「フォーム上に図形や文字をGDI描画」

サンプルファイル

フフォーム上のGDI描画アナログ時計（it-086.xlsm）
セキュリティ向上を目的として「インターネット経由でダウンロードしたOfficeファイル（Excel等）のマクロは、既定でブロック」されるようにOfficeアプリケーションの既定動作が変更になりました。（2022年4月より切替開始）
解除の方法については「ダウンロードファイルのブロック解除方法」を参照下さい。