サンプル投稿用掲示板 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 用のサンプル実行結果
 |
