Shape控件可以画菱形吗？如果不可以，我该怎么实现可以拖放的菱形？
谢谢！ 问题点数：50、回复次数：13Top
1 楼wgku（云霄）回复于 2002-04-14 22:45:21 得分 0
可能要自己来做。用line控件数组 line to 命令吧？？
UPTop
2 楼water_j（随心所欲）回复于 2002-04-14 23:01:14 得分 0
用 Shape 控件在窗体、框架或图片框中创建下述预定义形状：矩形、正方形、椭圆形、圆形、圆角矩形或圆角正方形。
自己做吧！Top
3 楼water_j（随心所欲）回复于 2002-04-14 23:02:01 得分 5
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
Top
4 楼CFree（自由从哪派生?）回复于 2002-04-14 23:52:54 得分 0
water_j(jxp)
感谢您的回答
不过我想得到可以拖放的菱形，用画线的办法可以解决吗？
谢谢！Top
5 楼CFree（自由从哪派生?）回复于 2002-04-15 16:48:33 得分 0
UP!Top
6 楼CFree（自由从哪派生?）回复于 2002-04-17 21:55:39 得分 0
up!Top
7 楼zyl910（编程的乐趣在于编程控制硬件，与用图形学实现绚丽效果）回复于 2002-04-17 22:02:23 得分 45
你想怎样拖放？
指定那几个关键点就行了
至于坐标，响应MouseMove事件Top
8 楼water_j（随心所欲）回复于 2002-04-17 22:06:07 得分 0
继续UP！Top
9 楼CFree（自由从哪派生?）回复于 2002-04-17 22:10:49 得分 0
zyl910:可以略作解释吗？Top
10 楼CFree（自由从哪派生?）回复于 2002-04-17 22:16:45 得分 0
我想让菱形在对话框中被拖放和移动，如word中的画图，可以对“指定那几个关键点就行了，至于坐标，响应MouseMove事件”略作解释吗？如果有例子，就更好了。
可为您准备200分，谢谢！
Top
11 楼zyl910（编程的乐趣在于编程控制硬件，与用图形学实现绚丽效果）回复于 2002-04-20 14:59:23 得分 0
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
Top
12 楼CFree（自由从哪派生?）回复于 2002-04-21 12:43:25 得分 0
编译通过，但是还是不好用。
我的是VB 6 SP5，不知道有关系吗
不管怎样，感谢您的帮助！Top
13 楼zyl910（编程的乐趣在于编程控制硬件，与用图形学实现绚丽效果）回复于 2002-04-21 12:46:03 得分 0
编译通过，但是还是不好用。
====================================================================
说清楚点
出什么问题了？Top
