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

CFree 2002-04-14 10:40:13
谢谢!
...全文
208 13 打赏 收藏 举报
写回复
13 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
zyl910 2002-04-21
编译通过,但是还是不好用。
====================================================================
说清楚点
出什么问题了?
  • 打赏
  • 举报
回复
CFree 2002-04-21
编译通过,但是还是不好用。
我的是VB 6 SP5,不知道有关系吗
不管怎样,感谢您的帮助!
  • 打赏
  • 举报
回复
zyl910 2002-04-20
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 2002-04-17
我想让菱形在对话框中被拖放和移动,如word中的画图,可以对“指定那几个关键点就行了,至于坐标,响应MouseMove事件”略作解释吗?如果有例子,就更好了。

可为您准备200分,谢谢!
  • 打赏
  • 举报
回复
CFree 2002-04-17
zyl910:可以略作解释吗?
  • 打赏
  • 举报
回复
water_j 2002-04-17
继续UP!
  • 打赏
  • 举报
回复
zyl910 2002-04-17
你想怎样拖放?

指定那几个关键点就行了

至于坐标,响应MouseMove事件
  • 打赏
  • 举报
回复
CFree 2002-04-17
up!
  • 打赏
  • 举报
回复
CFree 2002-04-15
UP!
  • 打赏
  • 举报
回复
CFree 2002-04-14
water_j(jxp)
感谢您的回答
不过我想得到可以拖放的菱形,用画线的办法可以解决吗?
谢谢!
  • 打赏
  • 举报
回复
water_j 2002-04-14
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

  • 打赏
  • 举报
回复
water_j 2002-04-14
用 Shape 控件在窗体、框架或图片框中创建下述预定义形状:矩形、正方形、椭圆形、圆形、圆角矩形或圆角正方形。

自己做吧!
  • 打赏
  • 举报
回复
wgku 2002-04-14
可能要自己来做。用line控件数组 line to 命令吧??

UP
  • 打赏
  • 举报
回复
相关推荐
发帖
控件

1434

社区成员

VB 控件
社区管理员
  • 控件
加入社区
帖子事件
创建了帖子
2002-04-14 10:40
社区公告
暂无公告