如何在picturebox在画个一个矩形框，并可以移动它，类似photoshop中选择框

2007-04-27 04:35:26 1.6k 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

nansa2000 墨衍会员 · AI 创作全网分发关注 + 加入社区

LatentSync：开源数字人唇形同步技术的实战部署与优化指南本文详细介绍了开源数字人唇形同步工具LatentSync的实战部署与优化全流程。从核心原理（潜在扩散模型与TREPA技术）解析，到手把手完成环境搭建、模型获取及首次推理。文章深入探讨了自定义素材处理、关键参数调优（如guidance_scale），并提供了显存不足、人脸检测失败等常见问题的解决方案与性能优化技巧，旨在帮助用户高效部署并提升生成效果。阅读详情

如何在picturebox在画个一个矩形框，并可以移动它，类似photoshop中选择框,让用户保存框内截取的图片

...全文

C++开发基础之掌握常用的三种异步编程模型以上是三种常见的C++异步编程模型，每种模型都有其适用的场景和特点。根据具体需求，你可以选择合适的模型来进行异步编程。阅读详情

nansa2000

多媒体 807 成员 8,274 内容

+ 关注 + 加入社区

切换为时间正序

犀山居士 2007-05-09

打赏
举报

把 AutoRedraw = False 改为 AutoRedraw = True，可以去掉 Private Sub Picture1_Paint()

犀山居士 2007-05-09

打赏
举报

这是我写的代码
请新建一个工程，放一个图片框控件在窗体上，不改控件名称，放入以下代码

Option Explicit

'矩形结构
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

'操作类型
Enum OpType
None = 0
Draw
Drag
End Enum

Dim rc As RECT '所画矩形
Dim ot As OpType '操作类型
Dim m_X As Long '当拖动矩形时，鼠标位置的 X 坐标
Dim m_Y As Long '当拖动矩形时，鼠标位置的 Y 坐标

Private Sub Form_Load()
ot = None
With Picture1
.ScaleMode = vbPixels
.AutoRedraw = False
.Appearance = 0
End With
End Sub

Private Sub Form_Resize()
Picture1.Move ScaleX(8, vbPixels, ScaleMode), ScaleY(8, vbPixels, ScaleMode), _
ScaleWidth - ScaleX(16, vbPixels, ScaleMode), _
ScaleHeight - ScaleY(16, vbPixels, ScaleMode)
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If vbLeftButton = (Button And vbLeftButton) Then
Select Case ot
Case OpType.None
With rc
If X > .Left And X < .Right And Y > .Top And Y < .Bottom Then
'如果已经画好了矩形，如果点击矩形范围内任意位置，则视为拖动矩形
m_X = X
m_Y = Y
ot = Drag
Else
'反之则视为重画矩形
Call DrawRect
.Left = X
.Right = X
.Top = Y
.Bottom = Y
ot = Draw
End If
End With
Case OpType.Draw
Case OpType.Drag
End Select
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If vbLeftButton = (Button And vbLeftButton) Then
With rc
Select Case ot
Case OpType.None
Case OpType.Draw
'画矩形时，先画一次清除上次画的矩形
Call DrawRect
'矩形的其中一个角不变
.Right = X
.Bottom = Y
'再画新的矩形，达到移动矩形的目的
Call DrawRect
Case OpType.Drag
'画矩形时，先画一次清除上次画的矩形
Call DrawRect
'移动整个矩形
.Left = .Left - m_X + X
.Top = .Top - m_Y + Y
.Right = .Right - m_X + X
.Bottom = .Bottom - m_Y + Y
m_X = X
m_Y = Y
'再画新的矩形，达到移动矩形的目的
Call DrawRect
End Select
End With
End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If vbLeftButton = (Button And vbLeftButton) Then
Select Case ot
Case OpType.None
Case OpType.Draw
'为了下次拖动，将矩形调整好，左边比右边的坐标小，上边比下边坐标小
Dim tmp As Long
With rc
If .Right < .Left Then
tmp = .Right
.Right = .Left
.Left = tmp
End If
If .Bottom < .Top Then
tmp = .Bottom
.Bottom = .Top
.Top = tmp
End If
End With
Case OpType.Drag
End Select
ot = None
End If
End Sub

'画矩形
Private Sub DrawRect()
With rc
If .Right = .Left Or .Bottom = .Top Then Exit Sub
Dim drMode As Integer
drMode = Picture1.DrawMode
Picture1.DrawMode = vbNotXorPen
Picture1.Line (.Left, .Top)-(.Right, .Bottom), vbRed, B
Picture1.DrawMode = drMode
End With
End Sub

'控件重画时，要重画矩形
Private Sub Picture1_Paint()
Picture1.Cls
Call DrawRect
End Sub

犀山居士 2007-05-09

打赏
举报

记住矩形的位置宽度和高度，画的时候，以vbXorPan方式，第一次只画一次，你用鼠标移动后，先画一次，就会清除以前画的，再画一次，就是新的

meritw 2007-05-08

打赏
举报

mark

laviewpbt 2007-05-08

打赏
举报

答辩后公布那个代码，大家鼓励我吧，我就是不想写论文啊！郁闷！！！！！

VBToy 2007-05-08

打赏
举报

的确，“人一定要靠自己”。不过可以参考一下这个：http://community.csdn.net/Expert/topic/5502/5502963.xml?temp=.7847559

laviewpbt 2007-05-03

打赏
举报

呵呵!

clear_zero 2007-05-03

打赏
举报

我没做过，友情帮顶

IamDeane 2007-05-03

打赏
举报

同志们拿砖头砸楼上，呵呵

laviewpbt 2007-04-27

打赏
举报

模范ＰＳ的选取框，俺以实现，不过不想公开代码，其实很简单，不超过１００行代码!呵呵

nansa2000 2007-04-27

打赏
举报

用XOR笔画没有用过，能不能指点一下啊

移动shape控件卡的很，不流畅

VBToy 2007-04-27

打赏
举报

用XOR笔画或直接用shape控件的矩形,至于如何截取图片，可以计算。

如何在picturebox在画个一个矩形框，并可以移动它，类似photoshop中选择框

相关推荐