Shape控件可以画菱形吗？如果不可以，我该怎么实现可以拖放的菱形？

[CFree]

谢谢！

[wgku]

可能要自己来做。用line控件数组 line to 命令吧？？

UP

[water_j]

用 Shape 控件在窗体、框架或图片框中创建下述预定义形状：矩形、正方形、椭圆形、圆形、圆角矩形或圆角正方形。

自己做吧！

[water_j]

Paint 事件示例
本例将画出一个与一个窗体各边的中点相交的菱形，并且当窗体的大小改变时，菱型也随着自动调整。要尝试这个例子，可将代码粘贴到一个窗体的声明部分，然后按 F5 键并调整窗体的大小。

Private Sub Form_Paint ()
Dim HalfX, HalfY ' 声明变量.
HalfX = ScaleLeft + ScaleWidth / 2 ' 设置到宽度的一半。
HalfY = ScaleTop + ScaleHeight / 2 ' 设置到高度的一半。
' 画一个菱形。
Line (ScaleLeft, HalfY) - (HalfX, ScaleTop)
Line -(ScaleWidth + ScaleLeft, HalfY)
Line -(HalfX, ScaleHeight + ScaleTop)
Line -(ScaleLeft, HalfY)
End Sub

Private Sub Form_Resize
Refresh
End Sub

[CFree]

water_j(jxp)
感谢您的回答
不过我想得到可以拖放的菱形，用画线的办法可以解决吗？
谢谢！

[CFree]

UP!

[CFree]

up!

[zyl910]

你想怎样拖放？

指定那几个关键点就行了

至于坐标，响应MouseMove事件

[water_j]

继续UP！

[CFree]

zyl910:可以略作解释吗？

[CFree]

我想让菱形在对话框中被拖放和移动，如word中的画图，可以对“指定那几个关键点就行了，至于坐标，响应MouseMove事件”略作解释吗？如果有例子，就更好了。

可为您准备200分，谢谢！

[zyl910]

VERSION 5.00
Begin VB.Form FrmMain
Caption = "菱形"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 213
ScaleMode = 3 'Pixel
ScaleWidth = 312
StartUpPosition = 3 '窗口缺省
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Ps(0 To 3) As POINTAPI
Private MoveP As Long
Private StepX As Long, StepY As Long

Private Const RectX As Long = 2
Private Const RectY As Long = 2

Private Sub DrawLX()
Dim I As Long

Me.Cls

Polygon Me.hdc, Ps(0), 4

For I = 0 To 3
Me.Line (Ps(I).X - RectX, Ps(I).Y - RectY)-Step(RectX * 2, RectY * 2), &HA00000, BF
Next I

'Me.Refresh

End Sub

Private Sub Form_Load()
'Me.AutoRedraw = True
Me.FillColor = &HFF
Me.FillStyle = vbCross

Ps(0).X = 70
Ps(0).Y = 10

Ps(1).X = 10
Ps(1).Y = 70

Ps(2).X = 70
Ps(2).Y = 130

Ps(3).X = 130
Ps(3).Y = 70

MoveP = -1

DrawLX

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim I As Long

If Button = vbKeyLButton Then
For I = 0 To 3
If Abs(X - Ps(I).X) <= RectX And Abs(Y - Ps(I).Y) < RectY Then
StepX = X - Ps(I).X
StepY = Y - Ps(I).Y
MoveP = I

Exit For

End If
Next I
End If

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim I As Long

If Button = 0 Then
For I = 0 To 3
If Abs(X - Ps(I).X) <= RectX And Abs(Y - Ps(I).Y) < RectY Then
Me.MousePointer = vbCrosshair
Exit Sub
End If
Next I
Me.MousePointer = vbDefault
End If

If MoveP >= 0 And MoveP <= 3 Then
Ps(MoveP).X = X - StepX
Ps(MoveP).Y = Y - StepY
DrawLX
End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MoveP = -1
End Sub

Private Sub Form_Paint()
DrawLX
End Sub

[CFree]

编译通过，但是还是不好用。
我的是VB 6 SP5，不知道有关系吗
不管怎样，感谢您的帮助！

[zyl910]

编译通过，但是还是不好用。
====================================================================
说清楚点
出什么问题了？