home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / basic / scgdem / frmcomp.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1993-08-10  |  16.1 KB  |  428 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. Option Explicit
  281. ' Statically record the bottom and top positions of the
  282. ' composite shapes.  They are tied to the location of the
  283. ' scroll bar in the Load event.
  284. Dim iCylBottom As Integer, iCylMaxLoc As Integer
  285. ' Draw the Cast Shadow component shape.  scgCastFont is the
  286. ' front (rectangular) shape.  scgCastShad is the shadow
  287. ' shape, which is a polyline.  iValue is a number between
  288. ' 0 and 100 indicating how high to draw the shape.
  289. ' The two shapes need to be positioned at design-time so
  290. ' their lower-left corners are congruent.
  291. Sub DrawCastShad (scgCastFront As SCGraphic, scgCastShad As SCGraphic, ByVal iValue As Integer)
  292.     Const ANGLE = 50 * PI / 180  ' angle of the cast shadow (in radians)
  293.     Dim iTop As Integer, iHeight As Integer, iWidth As Integer, iLeft As Integer
  294.     Dim fWidthRatio As Single
  295.     ' make the shapes invisible while we change various
  296.     ' properties to avoid flashing
  297.     scgCastFront.Visible = False
  298.     scgCastShad.Visible = False
  299.     ' stretch the front rect into its new position
  300.     ' where iValue is the percentage of its maximum height
  301.     iTop = iCylBottom - iValue / 100# * (iCylBottom - iCylMaxLoc)
  302.     iWidth = scgCastFront.Width
  303.     iLeft = scgCastFront.Left
  304.     iHeight = iCylBottom - iTop
  305.     ' we don't really need iLeft and iWidth, but using Move
  306.     ' is better than setting Top and Height properties individually
  307.     scgCastFront.Move iLeft, iTop, iWidth, iHeight
  308.     ' compute the containing rectangle for the cast shadow
  309.     iWidth = scgCastFront.Width + iHeight * Cos(ANGLE)
  310.     iHeight = iHeight * Sin(ANGLE)
  311.     scgCastShad.Move iLeft, iCylBottom - iHeight, iWidth, iHeight
  312.     ' calculate the ratio of the width of the rectangle
  313.     ' to the shadow to position the polygon points
  314.     fWidthRatio = scgCastFront.Width / iWidth
  315.     scgCastShad.PointX(0) = 0
  316.     scgCastShad.PointY(0) = 1000
  317.     scgCastShad.PointX(1) = 1000 * fWidthRatio
  318.     scgCastShad.PointY(1) = 1000
  319.     scgCastShad.PointX(2) = 1000
  320.     scgCastShad.PointY(2) = 0
  321.     scgCastShad.PointX(3) = 1000 * (1 - fWidthRatio)
  322.     scgCastShad.PointY(3) = 0
  323.     ' make the shapes visible agaon
  324.     scgCastFront.Visible = True
  325.     scgCastShad.Visible = True
  326. End Sub
  327. ' Draw the Cylinder composite shape.  scgCylTop is the ellipse
  328. ' at the top of the cylinder.  scgCylLeft/Right are the two
  329. ' polylines that make up the two shaded halves of the cylinder.
  330. ' iValue is a number between 0 and 100 indicating how high
  331. ' to draw the cylinder.
  332. ' The three shapes must be positioned at design-time as
  333. ' shown in the sample form.
  334. Sub DrawCylinder (scgCylTop As SCGraphic, scgCylLeft As SCGraphic, scgCylRight As SCGraphic, ByVal iValue As Integer)
  335. Dim iTop As Integer, iDepth As Integer, iHeight As Integer, fHeightPercent As Single
  336. Dim lColor As Long
  337.     ' Make the cylinder invisible while we change various
  338.     ' properties to avoid flashing.  See the VB manual on
  339.     ' p. 329 regarding the Move method and jerky motion.
  340.     scgCylTop.Visible = False
  341.     scgCylLeft.Visible = False
  342.     scgCylRight.Visible = False
  343.     ' move the ellipse at the top of the cylinder into its new position
  344.     ' where iValue is the percentage of its maximum height
  345.     iTop = iCylBottom - iValue / 100# * (iCylBottom - iCylMaxLoc)
  346.     iDepth = scgCylTop.Height
  347.     lColor = scgCylTop.FillColor
  348.     ' because of the perspective, we lose a little of the value range, so adjust
  349.     If iTop > iCylBottom - iDepth * 1.1 Then iTop = iCylBottom - iDepth * 1.1
  350.     scgCylTop.Top = iTop
  351.     ' adjust the top and height of the sides of the cylinder to match
  352.     ' the new position of the ellipse at the top (attach at the center)
  353.     iTop = iTop + iDepth / 2
  354.     iHeight = iCylBottom - iTop  ' iCylBottom is a global, fixed position
  355.     ' using Move is better than setting Top and Height properties individually
  356.     scgCylLeft.Move scgCylLeft.Left, iTop, scgCylLeft.Width, iHeight
  357.     scgCylRight.Move scgCylRight.Left, iTop, scgCylRight.Width, iHeight
  358.     ' find the percentage of the height of the ellipse to the side
  359.     fHeightPercent = iDepth / iHeight / 2#
  360.     ' position the left side with correct Bezier handles
  361.     scgCylLeft.PointX(0) = 0
  362.     scgCylLeft.PointY(0) = 0
  363.     scgCylLeft.PointX(1) = 1000
  364.     scgCylLeft.PointY(1) = 0
  365.     scgCylLeft.PointX(2) = 1000
  366.     scgCylLeft.PointY(2) = 1000
  367.     scgCylLeft.PointXOffsetOut(2) = -BEZCONIC
  368.     scgCylLeft.PointX(3) = 0
  369.     scgCylLeft.PointY(3) = 1000 * (1 - fHeightPercent)
  370.     scgCylLeft.PointYOffsetIn(3) = BEZCONIC * fHeightPercent
  371.     scgCylLeft.FillColor2 = BetweenColor(lColor, BLACK, 10)
  372.     scgCylLeft.FillColor = BetweenColor(lColor, BLACK, 50)
  373.     ' now do the right side
  374.     scgCylRight.PointX(0) = 1000
  375.     scgCylRight.PointY(0) = 0
  376.     scgCylRight.PointX(1) = 0
  377.     scgCylRight.PointY(1) = 0
  378.     scgCylRight.PointX(2) = 0
  379.     scgCylRight.PointY(2) = 1000
  380.     scgCylRight.PointXOffsetOut(2) = BEZCONIC
  381.     scgCylRight.PointX(3) = 1000
  382.     scgCylRight.PointY(3) = 1000 * (1 - fHeightPercent)
  383.     scgCylRight.PointYOffsetIn(3) = BEZCONIC * fHeightPercent
  384.     scgCylRight.FillColor = BetweenColor(lColor, BLACK, 10)
  385.     scgCylRight.FillColor2 = BetweenColor(lColor, BLACK, 50)
  386.     ' make the cylinder visible again
  387.     scgCylTop.Visible = True
  388.     scgCylLeft.Visible = True
  389.     scgCylRight.Visible = True
  390. End Sub
  391. ' Draw the analog gauge.  scgGaugeBack is the background
  392. ' circle of the gauge.  scgGaugeArrow is the arrow pointer
  393. ' indicating the current value.  iValue is a number between
  394. ' 0 and 100 indicating the location of the arrow pointer.
  395. ' The two shapes must be positioned at design time.  The
  396. ' arrow shape should be the identical location and size of
  397. ' the background circle.
  398. Sub DrawGauge (scgGaugeBack As SCGraphic, scgGaugeArrow As SCGraphic, ByVal iValue As Integer)
  399.     Const MINANGLE = 225 * PI / 180  ' arrow angle corresponding to the 0 value
  400.     Const MAXANGLE = -45 * PI / 180  ' arrow angle corresponding to the 100 value
  401.     Const SPREAD = MAXANGLE - MINANGLE
  402.     ' make the shapes invisible while we change various
  403.     ' properties to avoid flashing
  404.     scgGaugeBack.Visible = False
  405.     scgGaugeArrow.Visible = False
  406.     ' set the arrow angle according to the value
  407.     scgGaugeArrow.PointX(0) = 500    ' the base of the arrow is at the center
  408.     scgGaugeArrow.PointY(0) = 500
  409.     scgGaugeArrow.PointX(1) = 500 + 450 * Cos(MINANGLE + SPREAD * (iValue / 100#))
  410.     scgGaugeArrow.PointY(1) = 500 - 450 * Sin(MINANGLE + SPREAD * (iValue / 100#))
  411.     ' make the shapes visible agaon
  412.     scgGaugeBack.Visible = True
  413.     scgGaugeArrow.Visible = True
  414. End Sub
  415. Sub Form_Load ()
  416.     ' keep the bottom of the cylinder fixed at the bottom of the scroll bar
  417.     iCylBottom = vsbValue.Top + vsbValue.Height
  418.     ' let the cylinder grow to the height of the scroll bar
  419.     iCylMaxLoc = vsbValue.Top
  420.     ' simulate a scroll bar change to draw the initial screen
  421.     vsbValue_Change
  422. End Sub
  423. Sub vsbValue_Change ()
  424.     DrawCylinder scgCylTop, scgCylLeft, scgCylRight, vsbValue.Value
  425.     DrawCastShad scgCastFront, scgCastShad, vsbValue.Value
  426.     DrawGauge scgGaugeBack, scgGaugeArrow, vsbValue.Value
  427. End Sub
  428.