home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code2 / scg_demo / frmcomp.frm < prev    next >
Text File  |  1993-08-10  |  17KB  |  435 lines
  1. VERSION 2.00
  2. Begin Form frmComp 
  3.    Caption         =   "Composite Shapes"
  4.    ClientHeight    =   5790
  5.    ClientLeft      =   2445
  6.    ClientTop       =   1485
  7.    ClientWidth     =   7365
  8.    ControlBox      =   0   'False
  9.    FillColor       =   &H00FFFF00&
  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 VScrollBar vsbValue 
  20.       Height          =   4815
  21.       LargeChange     =   10
  22.       Left            =   6720
  23.       Max             =   0
  24.       Min             =   100
  25.       TabIndex        =   0
  26.       Top             =   480
  27.       Value           =   70
  28.       Width           =   255
  29.    End
  30.    Begin Label txtMin 
  31.       Alignment       =   2  'Center
  32.       BackStyle       =   0  'Transparent
  33.       Caption         =   "0"
  34.       FontBold        =   -1  'True
  35.       FontItalic      =   0   'False
  36.       FontName        =   "Times New Roman"
  37.       FontSize        =   8.25
  38.       FontStrikethru  =   0   'False
  39.       FontUnderline   =   0   'False
  40.       ForeColor       =   &H00000000&
  41.       Height          =   255
  42.       Left            =   4440
  43.       TabIndex        =   2
  44.       Top             =   2040
  45.       Width           =   375
  46.    End
  47.    Begin Label txtMax 
  48.       Alignment       =   2  'Center
  49.       BackStyle       =   0  'Transparent
  50.       Caption         =   "100"
  51.       FontBold        =   -1  'True
  52.       FontItalic      =   0   'False
  53.       FontName        =   "Times New Roman"
  54.       FontSize        =   8.25
  55.       FontStrikethru  =   0   'False
  56.       FontUnderline   =   0   'False
  57.       ForeColor       =   &H00000000&
  58.       Height          =   255
  59.       Left            =   5640
  60.       TabIndex        =   1
  61.       Top             =   2040
  62.       Width           =   375
  63.    End
  64.    Begin SCGraphic scgGaugeArrow 
  65.       AngleEnd        =   45
  66.       AngleStart      =   -90
  67.       ArrowSize       =   4  '4
  68.       ArrowType       =   1  'Forward
  69.       FillColor       =   &H00808080&
  70.       FillColor2      =   &H00000000&
  71.       FillPattern     =   0  'Solid
  72.       Height          =   2055
  73.       Left            =   4200
  74.       LineColor       =   &H0000FFFF&
  75.       LinePattern     =   0  'Solid
  76.       LineWidth       =   30
  77.       MouseEvents     =   -1  'True
  78.       NumPoints       =   2
  79.       PaletteSteps    =   20
  80.       RoundRadius     =   0
  81.       SelectByInk     =   0   'False
  82.       ShadowColor     =   &H00000000&
  83.       ShadowDepthX    =   0
  84.       ShadowDepthY    =   0
  85.       Shape           =   2  'Polyline
  86.       ShowOutlineOnly =   0   'False
  87.       Top             =   480
  88.       Use256Palette   =   -1  'True
  89.       Width           =   2055
  90.    End
  91.    Begin SCGraphic scgGaugeBack 
  92.       AngleEnd        =   45
  93.       AngleStart      =   -90
  94.       ArrowSize       =   2  'Small
  95.       ArrowType       =   0  'None
  96.       FillColor       =   &H00404000&
  97.       FillColor2      =   &H00C0C000&
  98.       FillPattern     =   16  'Graduated Vertical
  99.       Height          =   2055
  100.       Left            =   4200
  101.       LineColor       =   &H00FF80FF&
  102.       LinePattern     =   0  'Solid
  103.       LineWidth       =   30
  104.       MouseEvents     =   -1  'True
  105.       NumPoints       =   0
  106.       PaletteSteps    =   40
  107.       RoundRadius     =   0
  108.       SelectByInk     =   0   'False
  109.       ShadowColor     =   &H00000000&
  110.       ShadowDepthX    =   100
  111.       ShadowDepthY    =   100
  112.       Shape           =   1  'Ellipse
  113.       ShowOutlineOnly =   0   'False
  114.       Top             =   480
  115.       Use256Palette   =   -1  'True
  116.       Width           =   2055
  117.    End
  118.    Begin SCGraphic scgCastFront 
  119.       AngleEnd        =   45
  120.       AngleStart      =   -90
  121.       ArrowSize       =   2  'Small
  122.       ArrowType       =   0  'None
  123.       FillColor       =   &H0000FFFF&
  124.       FillColor2      =   &H00008080&
  125.       FillPattern     =   17  'Graduated Horizontal
  126.       Height          =   3255
  127.       Left            =   2760
  128.       LineColor       =   &H00C000C0&
  129.       LinePattern     =   5  'Transparent
  130.       LineWidth       =   15
  131.       MouseEvents     =   -1  'True
  132.       NumPoints       =   0
  133.       PaletteSteps    =   20
  134.       RoundRadius     =   0
  135.       SelectByInk     =   0   'False
  136.       ShadowColor     =   &H00000000&
  137.       ShadowDepthX    =   0
  138.       ShadowDepthY    =   0
  139.       Shape           =   0  'Rectangle
  140.       ShowOutlineOnly =   0   'False
  141.       Top             =   2040
  142.       Use256Palette   =   -1  'True
  143.       Width           =   735
  144.    End
  145.    Begin SCGraphic scgCastShad 
  146.       AngleEnd        =   45
  147.       AngleStart      =   -90
  148.       ArrowSize       =   2  'Small
  149.       ArrowType       =   0  'None
  150.       FillColor       =   &H00800000&
  151.       FillColor2      =   &H00000000&
  152.       FillPattern     =   16  'Graduated Vertical
  153.       Height          =   2535
  154.       Left            =   2760
  155.       LineColor       =   &H00FF0000&
  156.       LinePattern     =   5  'Transparent
  157.       LineWidth       =   15
  158.       MouseEvents     =   -1  'True
  159.       NumPoints       =   4
  160.       PaletteSteps    =   20
  161.       RoundRadius     =   0
  162.       SelectByInk     =   0   'False
  163.       ShadowColor     =   &H00000000&
  164.       ShadowDepthX    =   0
  165.       ShadowDepthY    =   0
  166.       Shape           =   3  'Polygon
  167.       ShowOutlineOnly =   0   'False
  168.       Top             =   2760
  169.       Use256Palette   =   -1  'True
  170.       Width           =   1935
  171.    End
  172.    Begin SCGraphic scgCylTop 
  173.       AngleEnd        =   45
  174.       AngleStart      =   -90
  175.       ArrowSize       =   2  'Small
  176.       ArrowType       =   0  'None
  177.       FillColor       =   &H00FF00FF&
  178.       FillColor2      =   &H00000000&
  179.       FillPattern     =   0  'Solid
  180.       Height          =   255
  181.       Left            =   960
  182.       LineColor       =   &H00FF00FF&
  183.       LinePattern     =   5  'Transparent
  184.       LineWidth       =   15
  185.       MouseEvents     =   -1  'True
  186.       NumPoints       =   0
  187.       PaletteSteps    =   20
  188.       RoundRadius     =   0
  189.       SelectByInk     =   0   'False
  190.       ShadowColor     =   &H00000000&
  191.       ShadowDepthX    =   0
  192.       ShadowDepthY    =   0
  193.       Shape           =   1  'Ellipse
  194.       ShowOutlineOnly =   0   'False
  195.       Top             =   1680
  196.       Use256Palette   =   -1  'True
  197.       Width           =   975
  198.    End
  199.    Begin SCGraphic scgCylLeft 
  200.       AngleEnd        =   45
  201.       AngleStart      =   -90
  202.       ArrowSize       =   2  'Small
  203.       ArrowType       =   0  'None
  204.       FillColor       =   &H00808080&
  205.       FillColor2      =   &H00000000&
  206.       FillPattern     =   17  'Graduated Horizontal
  207.       Height          =   3495
  208.       Left            =   960
  209.       LineColor       =   &H00FF0000&
  210.       LinePattern     =   5  'Transparent
  211.       LineWidth       =   15
  212.       MouseEvents     =   -1  'True
  213.       NumPoints       =   4
  214.       PaletteSteps    =   20
  215.       RoundRadius     =   0
  216.       SelectByInk     =   0   'False
  217.       ShadowColor     =   &H00000000&
  218.       ShadowDepthX    =   0
  219.       ShadowDepthY    =   0
  220.       Shape           =   3  'Polygon
  221.       ShowOutlineOnly =   0   'False
  222.       Top             =   1800
  223.       Use256Palette   =   -1  'True
  224.       Width           =   495
  225.    End
  226.    Begin SCGraphic scgCylRight 
  227.       AngleEnd        =   45
  228.       AngleStart      =   -90
  229.       ArrowSize       =   2  'Small
  230.       ArrowType       =   0  'None
  231.       FillColor       =   &H00808080&
  232.       FillColor2      =   &H00000000&
  233.       FillPattern     =   17  'Graduated Horizontal
  234.       Height          =   3495
  235.       Left            =   1440
  236.       LineColor       =   &H00FF0000&
  237.       LinePattern     =   5  'Transparent
  238.       LineWidth       =   15
  239.       MouseEvents     =   -1  'True
  240.       NumPoints       =   4
  241.       PaletteSteps    =   20
  242.       RoundRadius     =   0
  243.       SelectByInk     =   0   'False
  244.       ShadowColor     =   &H00000000&
  245.       ShadowDepthX    =   0
  246.       ShadowDepthY    =   0
  247.       Shape           =   3  'Polygon
  248.       ShowOutlineOnly =   0   'False
  249.       Top             =   1800
  250.       Use256Palette   =   -1  'True
  251.       Width           =   495
  252.    End
  253.    Begin SCGraphic scgCompBkg 
  254.       AngleEnd        =   45
  255.       AngleStart      =   -90
  256.       ArrowSize       =   2  'Small
  257.       ArrowType       =   0  'None
  258.       FillColor       =   &H00800000&
  259.       FillColor2      =   &H00000000&
  260.       FillPattern     =   0  'Solid
  261.       Height          =   6000
  262.       Left            =   0
  263.       LineColor       =   &H00FF0000&
  264.       LinePattern     =   5  'Transparent
  265.       LineWidth       =   15
  266.       MouseEvents     =   -1  'True
  267.       NumPoints       =   0
  268.       PaletteSteps    =   80
  269.       RoundRadius     =   0
  270.       SelectByInk     =   0   'False
  271.       ShadowColor     =   &H00000000&
  272.       ShadowDepthX    =   0
  273.       ShadowDepthY    =   0
  274.       Shape           =   0  'Rectangle
  275.       ShowOutlineOnly =   0   'False
  276.       Top             =   0
  277.       Use256Palette   =   -1  'True
  278.       Width           =   7500
  279.    End
  280. End
  281. Option Explicit
  282. ' Statically record the bottom and top positions of the
  283. ' composite shapes.  They are tied to the location of the
  284. ' scroll bar in the Load event.
  285. Dim iCylBottom As Integer, iCylMaxLoc As Integer
  286.  
  287. ' Draw the Cast Shadow component shape.  scgCastFont is the
  288. ' front (rectangular) shape.  scgCastShad is the shadow
  289. ' shape, which is a polyline.  iValue is a number between
  290. ' 0 and 100 indicating how high to draw the shape.
  291. ' The two shapes need to be positioned at design-time so
  292. ' their lower-left corners are congruent.
  293. Sub DrawCastShad (scgCastFront As SCGraphic, scgCastShad As SCGraphic, ByVal iValue As Integer)
  294.     Const ANGLE = 50 * PI / 180  ' angle of the cast shadow (in radians)
  295.     Dim iTop As Integer, iHeight As Integer, iWidth As Integer, iLeft As Integer
  296.     Dim fWidthRatio As Single
  297.     ' make the shapes invisible while we change various
  298.     ' properties to avoid flashing
  299.     scgCastFront.Visible = False
  300.     scgCastShad.Visible = False
  301.     ' stretch the front rect into its new position
  302.     ' where iValue is the percentage of its maximum height
  303.     iTop = iCylBottom - iValue / 100# * (iCylBottom - iCylMaxLoc)
  304.     iWidth = scgCastFront.Width
  305.     iLeft = scgCastFront.Left
  306.     iHeight = iCylBottom - iTop
  307.     ' we don't really need iLeft and iWidth, but using Move
  308.     ' is better than setting Top and Height properties individually
  309.     scgCastFront.Move iLeft, iTop, iWidth, iHeight
  310.     ' compute the containing rectangle for the cast shadow
  311.     iWidth = scgCastFront.Width + iHeight * Cos(ANGLE)
  312.     iHeight = iHeight * Sin(ANGLE)
  313.     scgCastShad.Move iLeft, iCylBottom - iHeight, iWidth, iHeight
  314.     ' calculate the ratio of the width of the rectangle
  315.     ' to the shadow to position the polygon points
  316.     fWidthRatio = scgCastFront.Width / iWidth
  317.     scgCastShad.PointX(0) = 0
  318.     scgCastShad.PointY(0) = 1000
  319.     scgCastShad.PointX(1) = 1000 * fWidthRatio
  320.     scgCastShad.PointY(1) = 1000
  321.     scgCastShad.PointX(2) = 1000
  322.     scgCastShad.PointY(2) = 0
  323.     scgCastShad.PointX(3) = 1000 * (1 - fWidthRatio)
  324.     scgCastShad.PointY(3) = 0
  325.     ' make the shapes visible agaon
  326.     scgCastFront.Visible = True
  327.     scgCastShad.Visible = True
  328. End Sub
  329.  
  330. ' Draw the Cylinder composite shape.  scgCylTop is the ellipse
  331. ' at the top of the cylinder.  scgCylLeft/Right are the two
  332. ' polylines that make up the two shaded halves of the cylinder.
  333. ' iValue is a number between 0 and 100 indicating how high
  334. ' to draw the cylinder.
  335. ' The three shapes must be positioned at design-time as
  336. ' shown in the sample form.
  337. Sub DrawCylinder (scgCylTop As SCGraphic, scgCylLeft As SCGraphic, scgCylRight As SCGraphic, ByVal iValue As Integer)
  338. Dim iTop As Integer, iDepth As Integer, iHeight As Integer, fHeightPercent As Single
  339. Dim lColor As Long
  340.     ' Make the cylinder invisible while we change various
  341.     ' properties to avoid flashing.  See the VB manual on
  342.     ' p. 329 regarding the Move method and jerky motion.
  343.     scgCylTop.Visible = False
  344.     scgCylLeft.Visible = False
  345.     scgCylRight.Visible = False
  346.     ' move the ellipse at the top of the cylinder into its new position
  347.     ' where iValue is the percentage of its maximum height
  348.     iTop = iCylBottom - iValue / 100# * (iCylBottom - iCylMaxLoc)
  349.     iDepth = scgCylTop.Height
  350.     lColor = scgCylTop.FillColor
  351.     ' because of the perspective, we lose a little of the value range, so adjust
  352.     If iTop > iCylBottom - iDepth * 1.1 Then iTop = iCylBottom - iDepth * 1.1
  353.     scgCylTop.Top = iTop
  354.     ' adjust the top and height of the sides of the cylinder to match
  355.     ' the new position of the ellipse at the top (attach at the center)
  356.     iTop = iTop + iDepth / 2
  357.     iHeight = iCylBottom - iTop  ' iCylBottom is a global, fixed position
  358.     ' using Move is better than setting Top and Height properties individually
  359.     scgCylLeft.Move scgCylLeft.Left, iTop, scgCylLeft.Width, iHeight
  360.     scgCylRight.Move scgCylRight.Left, iTop, scgCylRight.Width, iHeight
  361.     ' find the percentage of the height of the ellipse to the side
  362.     fHeightPercent = iDepth / iHeight / 2#
  363.     ' position the left side with correct Bezier handles
  364.     scgCylLeft.PointX(0) = 0
  365.     scgCylLeft.PointY(0) = 0
  366.     scgCylLeft.PointX(1) = 1000
  367.     scgCylLeft.PointY(1) = 0
  368.     scgCylLeft.PointX(2) = 1000
  369.     scgCylLeft.PointY(2) = 1000
  370.     scgCylLeft.PointXOffsetOut(2) = -BEZCONIC
  371.     scgCylLeft.PointX(3) = 0
  372.     scgCylLeft.PointY(3) = 1000 * (1 - fHeightPercent)
  373.     scgCylLeft.PointYOffsetIn(3) = BEZCONIC * fHeightPercent
  374.     scgCylLeft.FillColor2 = BetweenColor(lColor, BLACK, 10)
  375.     scgCylLeft.FillColor = BetweenColor(lColor, BLACK, 50)
  376.     ' now do the right side
  377.     scgCylRight.PointX(0) = 1000
  378.     scgCylRight.PointY(0) = 0
  379.     scgCylRight.PointX(1) = 0
  380.     scgCylRight.PointY(1) = 0
  381.     scgCylRight.PointX(2) = 0
  382.     scgCylRight.PointY(2) = 1000
  383.     scgCylRight.PointXOffsetOut(2) = BEZCONIC
  384.     scgCylRight.PointX(3) = 1000
  385.     scgCylRight.PointY(3) = 1000 * (1 - fHeightPercent)
  386.     scgCylRight.PointYOffsetIn(3) = BEZCONIC * fHeightPercent
  387.     scgCylRight.FillColor = BetweenColor(lColor, BLACK, 10)
  388.     scgCylRight.FillColor2 = BetweenColor(lColor, BLACK, 50)
  389.     ' make the cylinder visible again
  390.     scgCylTop.Visible = True
  391.     scgCylLeft.Visible = True
  392.     scgCylRight.Visible = True
  393. End Sub
  394.  
  395. ' Draw the analog gauge.  scgGaugeBack is the background
  396. ' circle of the gauge.  scgGaugeArrow is the arrow pointer
  397. ' indicating the current value.  iValue is a number between
  398. ' 0 and 100 indicating the location of the arrow pointer.
  399. ' The two shapes must be positioned at design time.  The
  400. ' arrow shape should be the identical location and size of
  401. ' the background circle.
  402. Sub DrawGauge (scgGaugeBack As SCGraphic, scgGaugeArrow As SCGraphic, ByVal iValue As Integer)
  403.     Const MINANGLE = 225 * PI / 180  ' arrow angle corresponding to the 0 value
  404.     Const MAXANGLE = -45 * PI / 180  ' arrow angle corresponding to the 100 value
  405.     Const SPREAD = MAXANGLE - MINANGLE
  406.     ' make the shapes invisible while we change various
  407.     ' properties to avoid flashing
  408.     scgGaugeBack.Visible = False
  409.     scgGaugeArrow.Visible = False
  410.     ' set the arrow angle according to the value
  411.     scgGaugeArrow.PointX(0) = 500    ' the base of the arrow is at the center
  412.     scgGaugeArrow.PointY(0) = 500
  413.     scgGaugeArrow.PointX(1) = 500 + 450 * Cos(MINANGLE + SPREAD * (iValue / 100#))
  414.     scgGaugeArrow.PointY(1) = 500 - 450 * Sin(MINANGLE + SPREAD * (iValue / 100#))
  415.     ' make the shapes visible agaon
  416.     scgGaugeBack.Visible = True
  417.     scgGaugeArrow.Visible = True
  418. End Sub
  419.  
  420. Sub Form_Load ()
  421.     ' keep the bottom of the cylinder fixed at the bottom of the scroll bar
  422.     iCylBottom = vsbValue.Top + vsbValue.Height
  423.     ' let the cylinder grow to the height of the scroll bar
  424.     iCylMaxLoc = vsbValue.Top
  425.     ' simulate a scroll bar change to draw the initial screen
  426.     vsbValue_Change
  427. End Sub
  428.  
  429. Sub vsbValue_Change ()
  430.     DrawCylinder scgCylTop, scgCylLeft, scgCylRight, vsbValue.Value
  431.     DrawCastShad scgCastFront, scgCastShad, vsbValue.Value
  432.     DrawGauge scgGaugeBack, scgGaugeArrow, vsbValue.Value
  433. End Sub
  434.  
  435.