VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 关于vb的问题?我想在程序运行时实现对类似于textbox的控件,用鼠标拖动来改变它的长宽.我应该怎样实现?谢谢!!
发表评论(0)作者:, 平台:, 阅读:10586, 日期:2000-09-19
大家网
关于vb的问题?我想在程序运行时实现对类似于textbox的控件,用鼠标拖动来改变它的长宽.我应该怎样实现?谢谢!!

1.对 于 这 个 问 题 ,我 是 创 建 了 4或 8个 pictureBox作 为 四 周 的 爪 如 果 单 击 控 件 后 则 通 过 控 件 left,top,height,width属 性 去 分 别 计 算 每 个 picture的 位 置 。 若 要 再 调 整 控 件 则 直 接 控 制 pictureBox.(要 注 意 运 用 GetCursorPos这 个 api)。

2.在窗体上放一个Text1控件,然后就用下面的代码


Private startp As Integer

Private xp As Integer, yp As Integer

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then

If X < 100 Then

startp = 1

ElseIf X > Text1.Width - 150 Then

startp = 2

End If

If Y < 100 Then

startp = startp + 4

ElseIf Y > Text1.Height - 150 Then

startp = startp + 8

End If

xp = X

yp = Y

End If

End Sub


Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim pleft, ptop, pwidth, pheight

If startp > 0 Then

With Text1

pleft = .Left

ptop = .Top

pwidth = .Width

pheight = .Height

End With

If (startp And 4) > 0 Then

ptop = ptop + Y - yp

pheight = pheight + yp - Y

ElseIf (startp And 8) > 0 Then

pheight = pheight + Y - yp

yp = Y

End If

If (startp And 1) > 0 Then

pleft = pleft + X - xp

pwidth = pwidth + xp - X

ElseIf (startp And 2) > 0 Then

pwidth = pwidth + X - xp

xp = X

End If

If pwidth < 0 Then pwidth = 0

If pheight < 0 Then pheight = 0

Text1.Move pleft, ptop, pwidth, pheight

End If

End Sub


Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then startp = 0

End Sub



一个使鼠标跑不出 picture 的程序

新建一个工程,加一 module, 并加入如下代码:


 


' API Declarations:

Private Type POINTAPI

X As Long

Y As Long

End Type

Private Type RECT

eft As Long

op As Long

ight As Long

ottom As Long

End Type

Private Declare Sub ClipCursorRect Lib "user32" Alias "ClipCursor" (lp

Rect As RECT)

Private Declare Sub ClipCursorClear Lib "user32" Alias "ClipCursor" (B

yVal lpRect As Long)

Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Lo

ng, lpPoint As POINTAPI) As Long


Public Sub RestrictCursor( _

ByVal lLeft As Long, _

ByVal lTop As Long, _

ByVal lWidth As Long, _

ByVal lHeight As Long, _

Optional ByRef oPositionTo As Object = Nothing _

)

Dim tR As RECT

Dim tP As POINTAPI


' Convert positions into a rectangle in pixels:

tR.Left = lLeft \ Screen.TwipsPerPixelX

tR.Top = lTop \ Screen.TwipsPerPixelY

tR.Right = (lLeft + lWidth) \ Screen.TwipsPerPixelX

tR.Bottom = (lLeft + lHeight) \ Screen.TwipsPerPixelY


' Validate optional parameter:

If oPositionTo Is Nothing Then Set oPositionTo = Screen

' If positions refer to an form or control, then

' convert the coordinates to the screen position:

If Not oPositionTo Is Screen Then

tP.X = tR.Left

tP.Y = tR.Top

ClientToScreen oPositionTo.hWnd, tP

tR.Left = tP.X

tR.Top = tP.Y

tP.X = tR.Right

tP.Y = tR.Bottom

ClientToScreen oPositionTo.hWnd, tP

tR.Right = tP.X

tR.Bottom = tP.Y

End If


' Set the cursor clipping rectangle:

ClipCursorRect tR


End Sub

Public Sub ClearRestrictCursor()

ClipCursorClear 0

End Sub



在窗体上加一Picture1,Check1,并加入如下代码:


 


Private Sub Check1_Click()

If (Check1.Value = Checked) Then

' Restrict the cursor so it can't move

' out of the picture:

RestrictCursor 0, 0, Picture1.Width, Picture1.Height, Picture1

Else

' Stop restricting the cursor:

ClearRestrictCursor

End If

End Sub