VBでペイントのように円を描く方法は？

質問

WindowsXP,VB6,SP5で開発しています。

PictureBoxに円を描きたいのですが、できずに困っています。
詳しく説明すると、最初にクリックした点からドラッグした時に、
点線で円を表示させて、最後にクリックボタンを離した時に実線にしたいんです。

何か良い方法はありませんでしょうか？
どうぞ、よろしくお願いしますm(_ _)m

回答No.4

ttyp03 · ベストアンサー

作ってみました。
ドラッグ中の円の表示の仕方は単にドラッグ開始位置から半径を広げているだけなので、そこらへんは適当に修正してください。

Option Explicit

Dim sx As Integer
Dim sy As Integer
Dim px As Integer
Dim py As Integer

Private Sub Form_Load()
sx = -1
sy = -1
End Sub

Private Sub Pic1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
sx = X
sy = Y
px = -1
py = -1
End Sub

Private Sub Pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If sx = -1 Then Exit Sub
Pic1.DrawStyle = vbDot
Pic1.DrawMode = vbInvert
If px <> -1 Then
Pic1.Circle (sx, sy), Abs(px - sx) / 2, RGB(0, 0, 0)
End If
Pic1.Circle (sx, sy), Abs(X - sx) / 2, RGB(0, 0, 0)
px = X
py = Y
End Sub

Private Sub Pic1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pic1.DrawStyle = vbSolid
Pic1.DrawMode = vbCopyPen
Pic1.Circle (sx, sy), Abs(X - sx) / 2, RGB(0, 0, 0)
sx = -1
sy = -1
End Sub

回答No.3

xcrOSgS2wY

円が残るのは、サンプルプログラムの中で使っている変数のうち、CX,CY,RをDimし忘れているせいでは。

補足

ご回答ありがとうございます。

おっしゃる通り、Dimしたら軌跡は残らなくなりました。
でも、1つ円を書いた後に2つ目を描こうとすると、1つ目が消えてしまいます。
消えないようにできないのでしょうか？

回答No.2

laputart

まずPictureBoxの名前をPic1に変更　
Backcolorを白にします。
途中の円を点線にするにはまだ出来ませんが途中の色を赤にして
完了すると黒にするやり方は以下でどうですか。

AX BY MouseDownで開始する座標
BX BY MouseMoveでドラッグ中のマウス座標
CX CY は円の中心
R 半径
MD 0 = 開始以前
　　　1 = ドラッグ中
クリックにイベントを発生させるとうまくいかないのでMouseUpを使います
完成した円は別にデータとして記憶しないと別の作業で削除されます。
（この部分のプログラムは作成していません）

以下が私の作成してテストプログラムです。

Private Sub Form_Load()
MD = 0
AX = -1
AY = -1
End Sub
Private Sub Pic1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MD = 0 Then
AX = X
AY = Y
MD = 1
End If
End Sub

Private Sub Pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MD = 1 Then
Pic1.Circle (CX, CY), R, RGB(255, 255, 255)
BX = X
BY = Y
CX = (AX + BX) / 2
CY = (AY + BY) / 2
R = Sqr((CX - BX) ^ 2 + (CY - BY) ^ 2)
Pic1.Circle (CX, CY), R, RGB(255, 0, 0)
End If
End Sub
Private Sub Pic1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MD = 1 Then
Pic1.Circle (CX, CY), R, RGB(255, 255, 255)
BX = X
BY = Y
CX = (AX + BX) / 2
CY = (AY + BY) / 2
R = Sqr((CX - BX) ^ 2 + (CY - BY) ^ 2)
Pic1.Circle (CX, CY), R, RGB(0, 0, 0)
End If
MD = 0
AX = -1
AY = -1
End Sub

補足

ご回答ありがとうございます。
早速やってみましたが、うまくいきませんでした。
ドラッグしているときに描画させる円がずっと残って、軌跡ができてしまいます(ToT)

回答No.1

sakura-pon

ここを参考に。
http://homepage1.nifty.com/rucio/main/dotnet/Samples/dnSampleGraphics.htm

参考URL：

http://homepage1.nifty.com/rucio/main/dotnet/Samples/dnSampleGraphics.htm