VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト]
[新規投稿]
[新着記事]
[ワード検索]
[過去ログ]
[管理用]
| 投稿日 | ： 2004/04/08(Thu) 17:28 |
| 投稿者 | ： るしぇ |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^3: Lineコントロールでの悩み |
参考になれば…どうぞ。もともと高次方程式の概略を知るために書いたコード
なので点画ですが…直線ならLineでいいですよね。もっと簡単でいいコードに
して下さい。
' 必要コントロール PictureBox x1(picGraph) ,CommandButton x3(Command1,Command2,Command3)
Option Explicit
Private mStep As Double
Private mSpace As Integer
Private mFlag(44) As Boolean
Private Sub Command3_Click()
Dim i As Long
With Me.picGraph
' 線を引く
picGraph.Line (0, 3)-(10, 9), RGB(255, 255, 0)
' 点を描画する
PicturePSetChangeAll True
End With
End Sub
Private Sub Form_Load()
mStep = 0.3
mSpace = 5
picGraph.Scale (0, mSpace * 2 + mSpace)-(100, -(mSpace * 1 + mSpace))
Me.picGraph.AutoRedraw = True
Me.Show
Command1_Click
End Sub
Private Sub Command1_Click()
Dim i As Long
' 画面のクリア
Me.picGraph.Cls
' 強制描画
For i = 0 To UBound(mFlag)
mFlag(i) = False
Next
PicturePSetChangeAll Not mFlag(0)
End Sub
Private Function Houteisiki(ByVal ValueX As Double, ByVal Mode As Integer) As Double
With Me.picGraph
Select Case Mode
' おまけ
Case 1
If ValueX >= 0 And ValueX <= 4 Then
Houteisiki = 2 * ValueX - 2
Else
Houteisiki = 1 / 4 * ValueX + 5
End If
' １からの線
Case 11
Houteisiki = (mSpace / .ScaleWidth * 0) * ValueX + mSpace * 2
Case 12
Houteisiki = (mSpace / .ScaleWidth * -1) * ValueX + mSpace * 2
Case 13
Houteisiki = (mSpace / .ScaleWidth * -2) * ValueX + mSpace * 2
Case 14
Houteisiki = (mSpace / .ScaleWidth * -3) * ValueX + mSpace * 2
' ２からの線
Case 21
Houteisiki = (mSpace / .ScaleWidth * 1) * ValueX + mSpace * 1
Case 22
Houteisiki = (mSpace / .ScaleWidth * 0) * ValueX + mSpace * 1
Case 23
Houteisiki = (mSpace / .ScaleWidth * -1) * ValueX + mSpace * 1
Case 24
Houteisiki = (mSpace / .ScaleWidth * -2) * ValueX + mSpace * 1
' ３からの線
Case 31
Houteisiki = (mSpace / .ScaleWidth * 2) * ValueX + mSpace * 0
Case 32
Houteisiki = (mSpace / .ScaleWidth * 1) * ValueX + mSpace * 0
Case 33
Houteisiki = (mSpace / .ScaleWidth * 0) * ValueX + mSpace * 0
Case 34
Houteisiki = (mSpace / .ScaleWidth * -1) * ValueX + mSpace * 0
' ４からの線
Case 41
Houteisiki = (mSpace / .ScaleWidth * 3) * ValueX + mSpace * -1
Case 42
Houteisiki = (mSpace / .ScaleWidth * 2) * ValueX + mSpace * -1
Case 43
Houteisiki = (mSpace / .ScaleWidth * 1) * ValueX + mSpace * -1
Case 44
Houteisiki = (mSpace / .ScaleWidth * 0) * ValueX + mSpace * -1
End Select
End With
End Function
Private Sub picGraph_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
With Me.picGraph
For i = 0 To 44
Select Case i
Case 1, 11, 12, 13, 14, 21, 22, 23, 24, 31, 32, 33, 34, 41, 42, 43, 44
' 絶対値が一定範囲内の時に色変え
If Abs(Y - Houteisiki(X, i)) < Abs(.ScaleHeight) / 300 Then
PicturePSetChangeOneNo (i)
End If
Case Else
End Select
Next
End With
End Sub
Private Sub Command2_Click()
Dim wColorFlag As Boolean
Dim wChangeNo() As Integer
Dim i As Integer
Dim n As Integer
wColorFlag = Not mFlag(11)
ReDim wChangeNo(UBound(mFlag))
For i = 0 To 44
Select Case i
Case 11, 12, 13, 14
If mFlag(i) <> wColorFlag Then
wChangeNo(n) = i
n = n + 1
End If
Case Else
End Select
Next
If n = 0 Then Exit Sub
ReDim Preserve wChangeNo(n - 1)
PicturePSetChangeNo wChangeNo
End Sub
Private Sub PicturePSetChangeAll(ByVal ColorFlag As Boolean)
Dim wChangeNo() As Integer
Dim i As Integer
Dim n As Integer
ReDim wChangeNo(UBound(mFlag))
For i = 0 To 44
Select Case i
Case 1, 11, 12, 13, 14, 21, 22, 23, 24, 31, 32, 33, 34, 41, 42, 43, 44
If mFlag(i) <> ColorFlag Then
wChangeNo(n) = i
n = n + 1
End If
Case Else
End Select
Next
If n = 0 Then Exit Sub
ReDim Preserve wChangeNo(n - 1)
PicturePSetChangeNo wChangeNo
End Sub
Private Sub PicturePSetChangeOneNo(ByVal ChangeNo As Integer)
Dim wChangeNo(0) As Integer
wChangeNo(0) = ChangeNo
PicturePSetChangeNo wChangeNo
End Sub
Private Sub PicturePSetChangeNo(ByRef ChangeNo() As Integer)
Dim wX1 As Double
Dim wColors() As Long
Dim n As Integer
Dim i As Integer
' 描画色の設定
n = UBound(ChangeNo)
ReDim wColors(n)
For i = 0 To n
mFlag(ChangeNo(i)) = Not mFlag(ChangeNo(i))
wColors(i) = BooleanColor(mFlag(ChangeNo(i)))
Next
' 点の描画
With Me.picGraph
.DrawWidth = 3
wX1 = .ScaleLeft
Do While wX1 < .ScaleLeft + .ScaleWidth
For i = 0 To n
picGraph.PSet (wX1, Houteisiki(wX1, ChangeNo(i))), wColors(i)
Next
wX1 = wX1 + mStep
Loop
.DrawWidth = 1
End With
End Sub
Private Function BooleanColor(ByVal ColorFlag As Boolean) As Long
If ColorFlag Then
BooleanColor = RGB(255, 0, 0)
Else
BooleanColor = RGB(0, 0, 0)
End If
End Function
- 関連一覧ツリー
（★ をクリックするとツリー全体を一括表示します）
- 返信フォーム
（この記事に返信する場合は下記フォームから投稿して下さい）