home *** CD-ROM | disk | FTP | other *** search
/ CD Direkt 1995 #1 / Image.iso / cdd / source / vbsource / scgdem / size.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1993-09-27  |  9.7 KB  |  239 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. Option Explicit
  60. Dim nOperation As Integer     ' record move/size operation type
  61. Dim bMouseDown As Integer     ' record mouse state
  62. Dim StartX, StartY As Single  ' mouse location at the start of a move
  63. Dim bImSelected As Integer    ' record whether the object is selected or not; deselect in Form_Click
  64.                   ' keep an array of Booleans (or use an unused shape property) if you have multiple shapes
  65. Const nHandleSize = 90        ' selection handle size (twips)
  66. Const nMoveThreshold = 200    ' mouse move threshold for auto move mode (twips)
  67. ' Operation/handle constants
  68. Const TL = 1  ' top-left
  69. Const TC = 2  ' top-center
  70. Const TR = 3  ' top-right
  71. Const ML = 4  ' middle-left
  72. Const MR = 5  ' middle-right
  73. Const BL = 6  ' bottom-left
  74. Const BC = 7  ' bottom-center
  75. Const BR = 8  ' bottom-right
  76. Const MV = 9  ' move operation
  77. Sub Form_Click ()
  78.     ' Deselect the selected shape if the user clicks on the form
  79.     ' Alternatively, you could deselect if the user clicks on the shape again
  80.     If bImSelected Then
  81.     bImSelected = False
  82.     ShowHandles Rectangle, False
  83.     End If
  84. End Sub
  85. Sub Form_Load ()
  86.     bMouseDown = False   ' the mouse is up to begin with
  87.     nOperation = 0       ' no move/size operation yet
  88.     bImSelected = False  ' not selected
  89. End Sub
  90. Sub Rectangle_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  91.     ' record MouseDown for subsequent MouseMove's
  92.     bMouseDown = True
  93.     ' record the starting mouse position so we can move relative to that spot
  94.     ' this is described in the VB3 manual on p. 283
  95.     StartX = X
  96.     StartY = Y
  97.     If bImSelected Then
  98.     nOperation = WhichHandle(Rectangle, X, Y)
  99.     ' use transparent shapes for faster redraw during mouse move
  100.     ' we'll turn gradfills back on in MouseUp
  101.     Rectangle.ShowOutlineOnly = True
  102.     ' change the mouse cursor to indicate the operation
  103.     Select Case nOperation
  104.         Case TL, BR
  105.         MousePointer = 8
  106.         Case TR, BL
  107.         MousePointer = 6
  108.         Case TC, BC
  109.         MousePointer = 7
  110.         Case ML, MR
  111.         MousePointer = 9
  112.         Case MV
  113.         MousePointer = 5
  114.     End Select
  115.     End If
  116. End Sub
  117. Sub Rectangle_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  118.     ' nOperation records whether we are moving or sizing
  119.     Select Case nOperation
  120.     Case 0  ' no operation yet, but check for movement to enter one-click select and move mode
  121.         If (bMouseDown And Abs(StartX - X) + Abs(StartY - Y) > nMoveThreshold) Then
  122.         ' the mouse is down, the object isn't selected, but the mouse has moved a ways
  123.         ' so select the object and begin moving without requiring a mouse up
  124.         bImSelected = True
  125.         nOperation = MV  ' movement
  126.         Rectangle.ShowOutlineOnly = True
  127.         MousePointer = 5
  128.         End If
  129.     ' use Abs on height and width to avoid negative widths
  130.     Case TL  ' from top-left
  131.         Rectangle.Move Rectangle.Left + X - StartX, Rectangle.Top + Y - StartY, Abs(Rectangle.Width + StartX - X), Abs(Rectangle.Height + StartY - Y)
  132.     Case TC  ' from top-center
  133.         Rectangle.Move Rectangle.Left, Rectangle.Top + Y - StartY, Rectangle.Width, Abs(Rectangle.Height + StartY - Y)
  134.     Case TR  ' from top-right
  135.         Rectangle.Move Rectangle.Left, Rectangle.Top + Y - StartY, Abs(X), Abs(Rectangle.Height + StartY - Y)
  136.     Case ML  ' from middle-left
  137.         Rectangle.Move Rectangle.Left + X - StartX, Rectangle.Top, Abs(Rectangle.Width + StartX - X)
  138.     Case MR  ' from middle-right
  139.         Rectangle.Move Rectangle.Left, Rectangle.Top, Abs(X)
  140.     Case BL  ' from bottom-left
  141.         Rectangle.Move Rectangle.Left + X - StartX, Rectangle.Top, Abs(Rectangle.Width + StartX - X), Abs(Y)
  142.     Case BC  ' from bottom-center
  143.         Rectangle.Move Rectangle.Left, Rectangle.Top, Rectangle.Width, Abs(Y)
  144.     Case BR  ' from bottom-right
  145.         Rectangle.Move Rectangle.Left, Rectangle.Top, Abs(X), Abs(Y)
  146.     Case MV  ' move
  147.         Rectangle.Move Rectangle.Left + X - StartX, Rectangle.Top + Y - StartY
  148.     End Select
  149. End Sub
  150. Sub Rectangle_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  151.     If nOperation = 0 Then
  152.     ' if we aren't moving or sizing yet just select
  153.     If bMouseDown Then
  154.         bImSelected = True  ' check MouseDown just in case we get an up without a down
  155.         ShowHandles Rectangle, True  ' turn on the handles
  156.     End If
  157.     Else
  158.     ' we finished a move so turn fills back on
  159.     Rectangle.ShowOutlineOnly = False
  160.     Rectangle.Refresh
  161.     ShowHandles Rectangle, True  ' restore the handles after repainting the shape
  162.     End If
  163.     MousePointer = 0   ' reset back to the default mouse pointer
  164.     bMouseDown = False
  165.     nOperation = 0
  166. End Sub
  167. ' Display sizing handles on a control (or clear the handles)
  168. Sub ShowHandles (obj As Control, bOn As Integer)
  169.     Dim nh As Integer
  170.     Dim c As Single, r As Single, m As Single, b As Single
  171.     nh = nHandleSize  ' just to reduce typing
  172.     c = obj.Left + (obj.Width - nh) / 2  ' left/right center
  173.     r = obj.Left + obj.Width - nh        ' right
  174.     m = obj.Top + (obj.Height - nh) / 2  ' top/bottom middle
  175.     b = obj.Top + obj.Height - nh        ' bottom
  176.     If bOn Then
  177.     DrawMode = 1  ' choose Black Pen or XOR (6) depending on the type of shapes and background you have
  178.     Line (obj.Left, obj.Top)-Step(nh, nh), RGB(0, 0, 0), BF
  179.     Line (c, obj.Top)-Step(nh, nh), RGB(0, 0, 0), BF
  180.     Line (r, obj.Top)-Step(nh, nh), RGB(0, 0, 0), BF
  181.     Line (obj.Left, m)-Step(nh, nh), RGB(0, 0, 0), BF
  182.     Line (r, m)-Step(nh, nh), RGB(0, 0, 0), BF
  183.     Line (obj.Left, b)-Step(nh, nh), RGB(0, 0, 0), BF
  184.     Line (c, b)-Step(nh, nh), RGB(0, 0, 0), BF
  185.     Line (r, b)-Step(nh, nh), RGB(0, 0, 0), BF
  186.     DrawMode = 1
  187.     Else
  188.     ' if you choose DrawMode = 6 above, you may be able to clean the handles
  189.     ' by redrawing them with XOR (DrawMode = 6) again and eliminate the repaint of the shape
  190.     obj.Visible = True ' repaint the object to eliminate handles
  191.     End If
  192. End Sub
  193. ' Check the given x,y coordinates to see if the position is
  194. ' within one of the sizing handles.  A number between 0 and 9
  195. ' is returned.  0 means the position is not in the control at
  196. ' all (shouldn't happen if this was called from MouseDown).
  197. ' 9 means it is not on a sizing handle, but is in the control.
  198. ' 1 thru 8 indicate sizing handles, numbered 1,2,3 on the top;
  199. ' 4,5 in the middle and 6,7,8 along the bottom (left to right).
  200. ' Use the constants TL, TC, etc. for these values
  201. Function WhichHandle (obj As Control, X As Single, Y As Single) As Integer
  202.     Dim nh As Integer, nRet As Integer
  203.     Dim iL As Integer, iC As Integer, iR As Integer
  204.     Dim iT As Integer, iM As Integer, iB As Integer
  205.     Dim c As Single, r As Single, m As Single, b As Single
  206.     nh = nHandleSize  ' just to reduce typing
  207.     c = (obj.Width - nh) / 2  ' left/right center
  208.     r = obj.Width - nh        ' right
  209.     m = (obj.Height - nh) / 2  ' top/bottom middle
  210.     b = obj.Height - nh        ' bottom
  211.     ' we could do this more elegantly with rectangles and
  212.     ' PtInRect, but this works and is probably fast even tho it's ugly
  213.     ' iL, etc. record whether the position is in one dimension of a handle
  214.     iL = False
  215.     iC = False
  216.     iR = False
  217.     iT = False
  218.     iM = False
  219.     iB = False
  220.     If (X > 0 And X < nh) Then iL = True  ' possibly in one of the left handles
  221.     If (X > c And X < c + nh) Then iC = True
  222.     If (X > r And X < r + nh) Then iR = True
  223.     If (Y > 0 And Y < nh) Then iT = True
  224.     If (Y > m And Y < m + nh) Then iM = True
  225.     If (Y > b And Y < b + nh) Then iB = True
  226.     nRet = 0
  227.     If (iL And iT) Then nRet = TL
  228.     If (iC And iT) Then nRet = TC
  229.     If (iR And iT) Then nRet = TR
  230.     If (iL And iM) Then nRet = ML
  231.     If (iR And iM) Then nRet = MR
  232.     If (iL And iB) Then nRet = BL
  233.     If (iC And iB) Then nRet = BC
  234.     If (iR And iB) Then nRet = BR
  235.     ' if in none of the handles, double-check to make sure its in the object
  236.     If (nRet = 0 And X > 0 And X < obj.Width And Y > 0 And Y < obj.Height) Then nRet = MV
  237.     WhichHandle = nRet
  238. End Function
  239.