home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code2 / scg_demo / size.frm < prev    next >
Text File  |  1993-09-27  |  10KB  |  258 lines
  1. VERSION 2.00
  2. Begin Form frmResize 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Resize"
  5.    ClientHeight    =   5790
  6.    ClientLeft      =   2445
  7.    ClientTop       =   1485
  8.    ClientWidth     =   7365
  9.    ControlBox      =   0   'False
  10.    Height          =   6195
  11.    Left            =   2385
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   5790
  16.    ScaleWidth      =   7365
  17.    Top             =   1140
  18.    Width           =   7485
  19.    Begin Label Label1 
  20.       BackStyle       =   0  'Transparent
  21.       Caption         =   "Click to select and then drag a handle to resize, or drag in the middle to move."
  22.       ForeColor       =   &H00FF0000&
  23.       Height          =   615
  24.       Left            =   4440
  25.       TabIndex        =   0
  26.       Top             =   5040
  27.       Width           =   2775
  28.       WordWrap        =   -1  'True
  29.    End
  30.    Begin SCGraphic Rectangle 
  31.       AngleEnd        =   45
  32.       AngleStart      =   -90
  33.       ArrowSize       =   2  'Small
  34.       ArrowType       =   0  'None
  35.       DrawInside      =   -1  'True
  36.       FillColor       =   &H00FF00FF&
  37.       FillColor2      =   &H00FFFF00&
  38.       FillPattern     =   16  'Graduated Vertical
  39.       Height          =   2415
  40.       InhibitEraseOnRedraw=   0   'False
  41.       Left            =   2040
  42.       LineColor       =   &H0000FFFF&
  43.       LinePattern     =   0  'Solid
  44.       LineWidth       =   50
  45.       MouseEvents     =   -1  'True
  46.       NumPoints       =   5
  47.       PaletteSteps    =   50
  48.       RoundRadius     =   0
  49.       SelectByInk     =   -1  'True
  50.       ShadowColor     =   &H00000000&
  51.       ShadowDepthX    =   0
  52.       ShadowDepthY    =   0
  53.       Shape           =   0  'Rectangle
  54.       ShowOutlineOnly =   0   'False
  55.       Top             =   1560
  56.       Use256Palette   =   -1  'True
  57.       Width           =   3375
  58.    End
  59. End
  60. Option Explicit
  61. Dim nOperation As Integer     ' record move/size operation type
  62. Dim bMouseDown As Integer     ' record mouse state
  63. Dim StartX, StartY As Single  ' mouse location at the start of a move
  64. Dim bImSelected As Integer    ' record whether the object is selected or not; deselect in Form_Click
  65.                   ' keep an array of Booleans (or use an unused shape property) if you have multiple shapes
  66.  
  67. Const nHandleSize = 90        ' selection handle size (twips)
  68. Const nMoveThreshold = 200    ' mouse move threshold for auto move mode (twips)
  69.  
  70. ' Operation/handle constants
  71. Const TL = 1  ' top-left
  72. Const TC = 2  ' top-center
  73. Const TR = 3  ' top-right
  74. Const ML = 4  ' middle-left
  75. Const MR = 5  ' middle-right
  76. Const BL = 6  ' bottom-left
  77. Const BC = 7  ' bottom-center
  78. Const BR = 8  ' bottom-right
  79. Const MV = 9  ' move operation
  80.  
  81. Sub Form_Click ()
  82.     ' Deselect the selected shape if the user clicks on the form
  83.     ' Alternatively, you could deselect if the user clicks on the shape again
  84.     If bImSelected Then
  85.     bImSelected = False
  86.     ShowHandles Rectangle, False
  87.     End If
  88. End Sub
  89.  
  90. Sub Form_Load ()
  91.     bMouseDown = False   ' the mouse is up to begin with
  92.     nOperation = 0       ' no move/size operation yet
  93.     bImSelected = False  ' not selected
  94. End Sub
  95.  
  96. Sub Rectangle_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  97.     ' record MouseDown for subsequent MouseMove's
  98.     bMouseDown = True
  99.     ' record the starting mouse position so we can move relative to that spot
  100.     ' this is described in the VB3 manual on p. 283
  101.     StartX = X
  102.     StartY = Y
  103.     If bImSelected Then
  104.     nOperation = WhichHandle(Rectangle, X, Y)
  105.     ' use transparent shapes for faster redraw during mouse move
  106.     ' we'll turn gradfills back on in MouseUp
  107.     Rectangle.ShowOutlineOnly = True
  108.     ' change the mouse cursor to indicate the operation
  109.     Select Case nOperation
  110.         Case TL, BR
  111.         MousePointer = 8
  112.         Case TR, BL
  113.         MousePointer = 6
  114.         Case TC, BC
  115.         MousePointer = 7
  116.         Case ML, MR
  117.         MousePointer = 9
  118.         Case MV
  119.         MousePointer = 5
  120.     End Select
  121.     End If
  122. End Sub
  123.  
  124. Sub Rectangle_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  125.     ' nOperation records whether we are moving or sizing
  126.     Select Case nOperation
  127.     Case 0  ' no operation yet, but check for movement to enter one-click select and move mode
  128.         If (bMouseDown And Abs(StartX - X) + Abs(StartY - Y) > nMoveThreshold) Then
  129.         ' the mouse is down, the object isn't selected, but the mouse has moved a ways
  130.         ' so select the object and begin moving without requiring a mouse up
  131.         bImSelected = True
  132.         nOperation = MV  ' movement
  133.         Rectangle.ShowOutlineOnly = True
  134.         MousePointer = 5
  135.         End If
  136.     ' use Abs on height and width to avoid negative widths
  137.     Case TL  ' from top-left
  138.         Rectangle.Move Rectangle.Left + X - StartX, Rectangle.Top + Y - StartY, Abs(Rectangle.Width + StartX - X), Abs(Rectangle.Height + StartY - Y)
  139.     Case TC  ' from top-center
  140.         Rectangle.Move Rectangle.Left, Rectangle.Top + Y - StartY, Rectangle.Width, Abs(Rectangle.Height + StartY - Y)
  141.     Case TR  ' from top-right
  142.         Rectangle.Move Rectangle.Left, Rectangle.Top + Y - StartY, Abs(X), Abs(Rectangle.Height + StartY - Y)
  143.     Case ML  ' from middle-left
  144.         Rectangle.Move Rectangle.Left + X - StartX, Rectangle.Top, Abs(Rectangle.Width + StartX - X)
  145.     Case MR  ' from middle-right
  146.         Rectangle.Move Rectangle.Left, Rectangle.Top, Abs(X)
  147.     Case BL  ' from bottom-left
  148.         Rectangle.Move Rectangle.Left + X - StartX, Rectangle.Top, Abs(Rectangle.Width + StartX - X), Abs(Y)
  149.     Case BC  ' from bottom-center
  150.         Rectangle.Move Rectangle.Left, Rectangle.Top, Rectangle.Width, Abs(Y)
  151.     Case BR  ' from bottom-right
  152.         Rectangle.Move Rectangle.Left, Rectangle.Top, Abs(X), Abs(Y)
  153.     Case MV  ' move
  154.         Rectangle.Move Rectangle.Left + X - StartX, Rectangle.Top + Y - StartY
  155.     End Select
  156. End Sub
  157.  
  158. Sub Rectangle_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  159.     If nOperation = 0 Then
  160.     ' if we aren't moving or sizing yet just select
  161.     If bMouseDown Then
  162.         bImSelected = True  ' check MouseDown just in case we get an up without a down
  163.         ShowHandles Rectangle, True  ' turn on the handles
  164.     End If
  165.     Else
  166.     ' we finished a move so turn fills back on
  167.     Rectangle.ShowOutlineOnly = False
  168.     Rectangle.Refresh
  169.     ShowHandles Rectangle, True  ' restore the handles after repainting the shape
  170.     End If
  171.     MousePointer = 0   ' reset back to the default mouse pointer
  172.     bMouseDown = False
  173.     nOperation = 0
  174. End Sub
  175.  
  176. ' Display sizing handles on a control (or clear the handles)
  177. Sub ShowHandles (obj As Control, bOn As Integer)
  178.     Dim nh As Integer
  179.     Dim c As Single, r As Single, m As Single, b As Single
  180.     
  181.     nh = nHandleSize  ' just to reduce typing
  182.  
  183.     c = obj.Left + (obj.Width - nh) / 2  ' left/right center
  184.     r = obj.Left + obj.Width - nh        ' right
  185.     m = obj.Top + (obj.Height - nh) / 2  ' top/bottom middle
  186.     b = obj.Top + obj.Height - nh        ' bottom
  187.  
  188.     If bOn Then
  189.     DrawMode = 1  ' choose Black Pen or XOR (6) depending on the type of shapes and background you have
  190.     Line (obj.Left, obj.Top)-Step(nh, nh), RGB(0, 0, 0), BF
  191.     Line (c, obj.Top)-Step(nh, nh), RGB(0, 0, 0), BF
  192.     Line (r, obj.Top)-Step(nh, nh), RGB(0, 0, 0), BF
  193.     Line (obj.Left, m)-Step(nh, nh), RGB(0, 0, 0), BF
  194.     Line (r, m)-Step(nh, nh), RGB(0, 0, 0), BF
  195.     Line (obj.Left, b)-Step(nh, nh), RGB(0, 0, 0), BF
  196.     Line (c, b)-Step(nh, nh), RGB(0, 0, 0), BF
  197.     Line (r, b)-Step(nh, nh), RGB(0, 0, 0), BF
  198.     DrawMode = 1
  199.     Else
  200.     ' if you choose DrawMode = 6 above, you may be able to clean the handles
  201.     ' by redrawing them with XOR (DrawMode = 6) again and eliminate the repaint of the shape
  202.     obj.Visible = True ' repaint the object to eliminate handles
  203.     End If
  204. End Sub
  205.  
  206. ' Check the given x,y coordinates to see if the position is
  207. ' within one of the sizing handles.  A number between 0 and 9
  208. ' is returned.  0 means the position is not in the control at
  209. ' all (shouldn't happen if this was called from MouseDown).
  210. ' 9 means it is not on a sizing handle, but is in the control.
  211. ' 1 thru 8 indicate sizing handles, numbered 1,2,3 on the top;
  212. ' 4,5 in the middle and 6,7,8 along the bottom (left to right).
  213. ' Use the constants TL, TC, etc. for these values
  214. Function WhichHandle (obj As Control, X As Single, Y As Single) As Integer
  215.     Dim nh As Integer, nRet As Integer
  216.     Dim iL As Integer, iC As Integer, iR As Integer
  217.     Dim iT As Integer, iM As Integer, iB As Integer
  218.     Dim c As Single, r As Single, m As Single, b As Single
  219.     
  220.     nh = nHandleSize  ' just to reduce typing
  221.  
  222.     c = (obj.Width - nh) / 2  ' left/right center
  223.     r = obj.Width - nh        ' right
  224.     m = (obj.Height - nh) / 2  ' top/bottom middle
  225.     b = obj.Height - nh        ' bottom
  226.     
  227.     ' we could do this more elegantly with rectangles and
  228.     ' PtInRect, but this works and is probably fast even tho it's ugly
  229.     ' iL, etc. record whether the position is in one dimension of a handle
  230.     iL = False
  231.     iC = False
  232.     iR = False
  233.     iT = False
  234.     iM = False
  235.     iB = False
  236.     If (X > 0 And X < nh) Then iL = True  ' possibly in one of the left handles
  237.     If (X > c And X < c + nh) Then iC = True
  238.     If (X > r And X < r + nh) Then iR = True
  239.     If (Y > 0 And Y < nh) Then iT = True
  240.     If (Y > m And Y < m + nh) Then iM = True
  241.     If (Y > b And Y < b + nh) Then iB = True
  242.  
  243.     nRet = 0
  244.     If (iL And iT) Then nRet = TL
  245.     If (iC And iT) Then nRet = TC
  246.     If (iR And iT) Then nRet = TR
  247.     If (iL And iM) Then nRet = ML
  248.     If (iR And iM) Then nRet = MR
  249.     If (iL And iB) Then nRet = BL
  250.     If (iC And iB) Then nRet = BC
  251.     If (iR And iB) Then nRet = BR
  252.     ' if in none of the handles, double-check to make sure its in the object
  253.     If (nRet = 0 And X > 0 And X < obj.Width And Y > 0 And Y < obj.Height) Then nRet = MV
  254.  
  255.     WhichHandle = nRet
  256. End Function
  257.  
  258.