tagCANDY CGI VBレスキュー(花ちゃん) - アナログ時計の作成(VB.NET) - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
アナログ時計の作成(VB.NET)
元に戻る スレッド一覧へ 記事閲覧
このページ内の検索ができます。(AND 検索や OR 検索のような複数のキーワードによる検索はできません。)

アナログ時計の作成(VB.NET) [No.235の個別表示]
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
日時: 2009/12/26 13:08
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[日付・時刻][描画・画像][応用コード]                                *
* キーワード:アナログ時計,チラツキ,ちらつき,課題,,                               *
***********************************************************************************
タイトル : 画面のちらつきを抑えたい
記 事 No : 9336
投 稿 日 : 2009/09/02(Wed) 09:55
元質問者 : 健  

時計を描画するプログラムを作っているのですが、画面の更新時にちらつきが生じて
しまいます。何か防ぐ方法はありますでしょうか。  VB2008EEです。

--------------------------------------------------------------------------------
記事No:9336 で投稿されたコードを元にエラー発生部分と記事No:9338 等で回答された
部分だけを私が修正して投稿しておきました。  
(結構、課題とかでアナログ時計の質問をよく見かけますので)
--------------------------------------------------------------------------------

Imports System.Drawing.Drawing2D

Public Class Form1
Private Sub Form1_Paint(ByVal sender As Object, _
                        ByVal e As System.Windows.Forms.PaintEventArgs _
                        ) Handles MyBase.Paint

   Dim g As Graphics = e.Graphics
   '★☆★☆★☆★☆ 今回一部修正部分 ★☆★☆★☆★☆
   g.TranslateTransform(ClientSize.Width / 2.0!, _
                        ClientSize.Height / 2.0!, MatrixOrder.Append)

   Const pai As Double = Math.PI
   Dim center As Point = New Point(0, 0)

   Dim time As DateTime = Now
   Dim secAng As Double = 2.0 * pai * time.Second / 60.0
   Dim minAng As Double = 2.0 * pai * (time.Minute + time.Second / 60.0) / 60.0
   Dim hourAng As Double = 2.0 * pai * (time.Hour + time.Minute / 60.0) / 12.0
   '★☆★☆★☆★☆ 今回一部修正部分 ★☆★☆★☆★☆
   Dim r As Integer = CType(Math.Min(ClientSize.Width, ClientSize.Height) / 2 - 5, Integer)
   Dim secHandLength As Integer = CType(0.7 * r, Integer)
   Dim minHandLength As Integer = CType(0.9 * r, Integer)
   Dim hourHandLength As Integer = CType(0.5 * r, Integer)

   Dim secHand As Point = New Point(CType(secHandLength * Math.Sin(secAng), Integer), _
                                    CType(-secHandLength * Math.Cos(secAng), Integer))
   Dim minHand As Point = New Point(CType(minHandLength * Math.Sin(minAng), Integer), _
                                    CType(-minHandLength * Math.Cos(minAng), Integer))
   Dim hourHand As Point = New Point(CType(hourHandLength * Math.Sin(hourAng), Integer), _
                                     CType(-hourHandLength * Math.Cos(hourAng), Integer))
   '★☆★☆★☆★☆ 今回一部修正部分 ★☆★☆★☆★☆
   Using RedPen As Pen = New Pen(Color.Red, 2)
      g.DrawLine(RedPen, center, secHand)
   '★☆★☆★☆★☆ 今回一部修正部分 ★☆★☆★☆★☆
   Using BlackPen As Pen = New Pen(Color.Black, 5)
     g.DrawLine(BlackPen, center, minHand)

      'Dim BlackPen As Pen = New Pen(Color.Black, 5)
      g.DrawLine(BlackPen, center, hourHand)

      Dim gaiwaku As Pen = New Pen(Color.Black, 5)
      Dim gaiwaku2 As Pen = New Pen(Color.Black, 3)
      g.DrawEllipse(gaiwaku, -r, -r, r * 2, r * 2)

      For i As Integer = 1 To 60
         Dim ang As Double = 2.0 * pai * i / 60.0
         '★☆★☆★☆★☆ 今回一部修正部分 ★☆★☆★☆★☆
         Dim r2 As Integer = CType(0.9 * r, Integer)
         If i Mod 5 <> 0 Then
            '★☆★☆★☆★☆ 今回一部修正部分 ★☆★☆★☆★☆
            r2 += CType((r - r2) / 2, Integer)
         End If
         Dim p1 As Point = New Point(CType(r * Math.Sin(ang), Integer), _
                                     CType(-r * Math.Cos(ang), Integer))
         Dim p2 As Point = New Point(CType(r2 * Math.Sin(ang), Integer), _
                                     CType(-r2 * Math.Cos(ang), Integer))
         If i Mod 5 = 0 Then
            g.DrawLine(gaiwaku, p1, p2)
         Else
            g.DrawLine(gaiwaku2, p1, p2)
         End If
      Next
   '★☆★☆★☆★☆ 今回一部修正部分 ★☆★☆★☆★☆
   End Using
   End Using
End Sub

Private previousTime As String = ""
Private Sub Timer1_Tick(ByVal sender As System.Object, _
                        ByVal e As System.EventArgs) Handles Timer1.Tick
     '   Me.Refresh()

   '★☆★☆★☆★☆ 今回追加部分 ★☆★☆★☆★☆
   Dim currentTime As String = Now().ToString("HHmmss")
   If previousTime <> currentTime Then
      previousTime = currentTime
      Me.Invalidate()
   End If
   '★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, _
                       ByVal e As System.EventArgs) Handles MyBase.Load
   Me.SetBounds(Me.Left, Me.Top, 301, 301, BoundsSpecified.Size)
   Dim path As New System.Drawing.Drawing2D.GraphicsPath()
   Me.Top = 0
   Me.Left = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width - Me.Width

   '丸を描く
   path.AddEllipse(New Rectangle(21, 30, 258, 260))
   '真ん中を丸くくりぬく
   'path.AddEllipse(New Rectangle(100, 100, 100, 100))
   Me.Region = New Region(path)

   '★☆★☆★☆★☆ 今回追加部分 ★☆★☆★☆★☆
   Timer1.Interval = 1000   '動きがぎこちない場合は、 200 位に変更して下さい
   Timer1.Enabled = True
   ' リサイズ時に自動的に再描画させる
   Me.SetStyle(ControlStyles.ResizeRedraw, True)
   'ダブル・バッファリングをONにする(これによりチラツキが改善)
   Me.DoubleBuffered = True
   '★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆
End Sub
Private Sub Form1_Click(ByVal sender As Object, _
                        ByVal e As System.EventArgs) Handles Me.Click
   Timer1.Enabled = False
   Me.Close()
End Sub
End Class

因みに、VB6.0 用のサンプルは下記のように作成しております。
 http://hanatyan.sakura.ne.jp/samplepic/vb6_535.htm

下記、MSDN に、VB.NET 2002 によるサンプルが掲載されています。
http://msdn.microsoft.com/ja-jp/library/aa289159(VS.80).aspx


  ここの掲載コードの実行図             VB6.0 用のサンプル実行結果
メンテ

Page: 1 |

 投稿フォーム               スレッド一覧へ
題  名 スレッドをトップへソート
名  前
パスワード (記事メンテ時に使用)
投稿キー (投稿時 投稿キー を入力してください)
コメント

   クッキー保存   
スレッド一覧へ