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

Question

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

Answer 1

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

Answer 2

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 SubPrivate Sub Form_Resize
   Refresh
End Sub

Answer 3

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

Answer 4

你想怎样拖放？指定那几个关键点就行了至于坐标，响应MouseMove事件

Answer 5

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

Answer 6

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 LongPrivate Type POINTAPI
    X As Long
    Y As Long
End TypePrivate Ps(0 To 3) As POINTAPI
Private MoveP As Long
Private StepX As Long, StepY As LongPrivate Const RectX As Long = 2
Private Const RectY As Long = 2Private 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 SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MoveP = -1
End SubPrivate Sub Form_Paint()
    DrawLX
End Sub

Answer 7

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