home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD121.psc / FrmMath.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-18  |  42.8 KB  |  1,291 lines
  1. VERSION 5.00
  2. Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form FrmMathGrid 
  5.    AutoRedraw      =   -1  'True
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "Plot a Mathematical Function"
  8.    ClientHeight    =   5205
  9.    ClientLeft      =   45
  10.    ClientTop       =   330
  11.    ClientWidth     =   10755
  12.    Icon            =   "FrmMath.frx":0000
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   5205
  17.    ScaleWidth      =   10755
  18.    StartUpPosition =   3  'Windows Default
  19.    Begin VB.CommandButton Command1 
  20.       Caption         =   "Calculate"
  21.       Height          =   345
  22.       Left            =   120
  23.       TabIndex        =   40
  24.       Top             =   4740
  25.       Width           =   1365
  26.    End
  27.    Begin MSComDlg.CommonDialog CDL1 
  28.       Left            =   2940
  29.       Top             =   4740
  30.       _ExtentX        =   847
  31.       _ExtentY        =   847
  32.       _Version        =   393216
  33.    End
  34.    Begin TabDlg.SSTab SSTab1 
  35.       Height          =   4575
  36.       Left            =   0
  37.       TabIndex        =   1
  38.       Top             =   60
  39.       Width           =   5715
  40.       _ExtentX        =   10081
  41.       _ExtentY        =   8070
  42.       _Version        =   393216
  43.       Style           =   1
  44.       Tabs            =   2
  45.       Tab             =   1
  46.       TabHeight       =   520
  47.       TabCaption(0)   =   "Function"
  48.       TabPicture(0)   =   "FrmMath.frx":0442
  49.       Tab(0).ControlEnabled=   0   'False
  50.       Tab(0).Control(0)=   "PicHoleColor"
  51.       Tab(0).Control(1)=   "CmbEquations"
  52.       Tab(0).Control(2)=   "Chklogged"
  53.       Tab(0).Control(3)=   "Frame1"
  54.       Tab(0).Control(4)=   "TxtExpression"
  55.       Tab(0).Control(5)=   "Label6"
  56.       Tab(0).Control(6)=   "Label5"
  57.       Tab(0).Control(7)=   "LblZinfo"
  58.       Tab(0).Control(8)=   "Label2(0)"
  59.       Tab(0).Control(9)=   "Label1(1)"
  60.       Tab(0).ControlCount=   10
  61.       TabCaption(1)   =   "Colors"
  62.       TabPicture(1)   =   "FrmMath.frx":045E
  63.       Tab(1).ControlEnabled=   -1  'True
  64.       Tab(1).Control(0)=   "Label4"
  65.       Tab(1).Control(0).Enabled=   0   'False
  66.       Tab(1).Control(1)=   "Label3"
  67.       Tab(1).Control(1).Enabled=   0   'False
  68.       Tab(1).Control(2)=   "Label2(4)"
  69.       Tab(1).Control(2).Enabled=   0   'False
  70.       Tab(1).Control(3)=   "Label2(1)"
  71.       Tab(1).Control(3).Enabled=   0   'False
  72.       Tab(1).Control(4)=   "Label7"
  73.       Tab(1).Control(4).Enabled=   0   'False
  74.       Tab(1).Control(5)=   "TxtLevels"
  75.       Tab(1).Control(5).Enabled=   0   'False
  76.       Tab(1).Control(6)=   "CmbColorSchemes"
  77.       Tab(1).Control(6).Enabled=   0   'False
  78.       Tab(1).Control(7)=   "Frame2"
  79.       Tab(1).Control(7).Enabled=   0   'False
  80.       Tab(1).Control(8)=   "CmbMix"
  81.       Tab(1).Control(8).Enabled=   0   'False
  82.       Tab(1).Control(9)=   "CmdReverse"
  83.       Tab(1).Control(9).Enabled=   0   'False
  84.       Tab(1).ControlCount=   10
  85.       Begin VB.PictureBox PicHoleColor 
  86.          BackColor       =   &H00000000&
  87.          Height          =   255
  88.          Left            =   -73800
  89.          ScaleHeight     =   195
  90.          ScaleWidth      =   1275
  91.          TabIndex        =   42
  92.          Top             =   4140
  93.          Width           =   1335
  94.       End
  95.       Begin VB.ComboBox CmbEquations 
  96.          Height          =   315
  97.          Left            =   -73020
  98.          Style           =   2  'Dropdown List
  99.          TabIndex        =   37
  100.          Top             =   1200
  101.          Width           =   3435
  102.       End
  103.       Begin VB.CheckBox Chklogged 
  104.          Caption         =   "Log Scale"
  105.          Height          =   375
  106.          Left            =   -70860
  107.          TabIndex        =   35
  108.          Top             =   4080
  109.          Width           =   1455
  110.       End
  111.       Begin VB.CommandButton CmdReverse 
  112.          Caption         =   "Reverse Colors"
  113.          Height          =   375
  114.          Left            =   120
  115.          TabIndex        =   34
  116.          Top             =   3300
  117.          Width           =   2475
  118.       End
  119.       Begin VB.ComboBox CmbMix 
  120.          Height          =   315
  121.          Left            =   120
  122.          Style           =   2  'Dropdown List
  123.          TabIndex        =   32
  124.          Top             =   1920
  125.          Width           =   2460
  126.       End
  127.       Begin VB.Frame Frame2 
  128.          ClipControls    =   0   'False
  129.          Height          =   4050
  130.          Left            =   3360
  131.          TabIndex        =   24
  132.          Top             =   480
  133.          Width           =   2085
  134.          Begin VB.PictureBox Piccolor 
  135.             BackColor       =   &H000000FF&
  136.             Height          =   3525
  137.             Left            =   900
  138.             ScaleHeight     =   3465
  139.             ScaleWidth      =   945
  140.             TabIndex        =   30
  141.             Top             =   300
  142.             Width           =   1000
  143.          End
  144.          Begin VB.CommandButton pic1 
  145.             BackColor       =   &H00FF0000&
  146.             Height          =   240
  147.             Index           =   0
  148.             Left            =   180
  149.             Style           =   1  'Graphical
  150.             TabIndex        =   29
  151.             Top             =   3585
  152.             Width           =   555
  153.          End
  154.          Begin VB.CommandButton pic1 
  155.             BackColor       =   &H0000FF00&
  156.             Height          =   240
  157.             Index           =   1
  158.             Left            =   135
  159.             Style           =   1  'Graphical
  160.             TabIndex        =   28
  161.             Top             =   1935
  162.             Width           =   555
  163.          End
  164.          Begin VB.CommandButton pic1 
  165.             BackColor       =   &H000000FF&
  166.             Height          =   240
  167.             Index           =   2
  168.             Left            =   135
  169.             Style           =   1  'Graphical
  170.             TabIndex        =   27
  171.             Top             =   300
  172.             Width           =   555
  173.          End
  174.          Begin VB.CommandButton pic1 
  175.             BackColor       =   &H00FFFF00&
  176.             Height          =   240
  177.             Index           =   3
  178.             Left            =   135
  179.             Style           =   1  'Graphical
  180.             TabIndex        =   26
  181.             Top             =   2760
  182.             Width           =   555
  183.          End
  184.          Begin VB.CommandButton pic1 
  185.             BackColor       =   &H0000FFFF&
  186.             Height          =   240
  187.             Index           =   4
  188.             Left            =   135
  189.             Style           =   1  'Graphical
  190.             TabIndex        =   25
  191.             Top             =   1125
  192.             Width           =   555
  193.          End
  194.       End
  195.       Begin VB.ComboBox CmbColorSchemes 
  196.          Height          =   315
  197.          Left            =   180
  198.          Style           =   2  'Dropdown List
  199.          TabIndex        =   21
  200.          Top             =   1020
  201.          Width           =   2415
  202.       End
  203.       Begin VB.TextBox TxtLevels 
  204.          Height          =   315
  205.          Left            =   840
  206.          TabIndex        =   20
  207.          Text            =   "20"
  208.          Top             =   2580
  209.          Width           =   675
  210.       End
  211.       Begin VB.Frame Frame1 
  212.          Caption         =   "Grid Info"
  213.          Height          =   1560
  214.          Left            =   -74880
  215.          TabIndex        =   3
  216.          Top             =   2400
  217.          Width           =   5415
  218.          Begin VB.TextBox Text1 
  219.             BeginProperty Font 
  220.                Name            =   "Arial"
  221.                Size            =   8.25
  222.                Charset         =   0
  223.                Weight          =   400
  224.                Underline       =   0   'False
  225.                Italic          =   0   'False
  226.                Strikethrough   =   0   'False
  227.             EndProperty
  228.             ForeColor       =   &H00000000&
  229.             Height          =   315
  230.             Index           =   7
  231.             Left            =   4275
  232.             MaxLength       =   12
  233.             TabIndex        =   11
  234.             Text            =   "21"
  235.             Top             =   975
  236.             Width           =   855
  237.          End
  238.          Begin VB.TextBox Text1 
  239.             BeginProperty Font 
  240.                Name            =   "Arial"
  241.                Size            =   8.25
  242.                Charset         =   0
  243.                Weight          =   400
  244.                Underline       =   0   'False
  245.                Italic          =   0   'False
  246.                Strikethrough   =   0   'False
  247.             EndProperty
  248.             Height          =   285
  249.             Index           =   4
  250.             Left            =   1050
  251.             MaxLength       =   12
  252.             TabIndex        =   10
  253.             Text            =   "-5"
  254.             Top             =   975
  255.             Width           =   855
  256.          End
  257.          Begin VB.TextBox Text1 
  258.             BeginProperty Font 
  259.                Name            =   "Arial"
  260.                Size            =   8.25
  261.                Charset         =   0
  262.                Weight          =   400
  263.                Underline       =   0   'False
  264.                Italic          =   0   'False
  265.                Strikethrough   =   0   'False
  266.             EndProperty
  267.             Height          =   315
  268.             Index           =   5
  269.             Left            =   2070
  270.             MaxLength       =   12
  271.             TabIndex        =   9
  272.             Text            =   "5"
  273.             Top             =   975
  274.             Width           =   855
  275.          End
  276.          Begin VB.TextBox Text1 
  277.             BeginProperty Font 
  278.                Name            =   "Arial"
  279.                Size            =   8.25
  280.                Charset         =   0
  281.                Weight          =   400
  282.                Underline       =   0   'False
  283.                Italic          =   0   'False
  284.                Strikethrough   =   0   'False
  285.             EndProperty
  286.             Height          =   315
  287.             Index           =   6
  288.             Left            =   3090
  289.             MaxLength       =   12
  290.             TabIndex        =   8
  291.             Text            =   "0.5"
  292.             Top             =   975
  293.             Width           =   1035
  294.          End
  295.          Begin VB.TextBox Text1 
  296.             BeginProperty Font 
  297.                Name            =   "Arial"
  298.                Size            =   8.25
  299.                Charset         =   0
  300.                Weight          =   400
  301.                Underline       =   0   'False
  302.                Italic          =   0   'False
  303.                Strikethrough   =   0   'False
  304.             EndProperty
  305.             Height          =   315
  306.             Index           =   1
  307.             Left            =   2055
  308.             MaxLength       =   12
  309.             TabIndex        =   7
  310.             Text            =   "5"
  311.             Top             =   555
  312.             Width           =   855
  313.          End
  314.          Begin VB.TextBox Text1 
  315.             BeginProperty Font 
  316.                Name            =   "Arial"
  317.                Size            =   8.25
  318.                Charset         =   0
  319.                Weight          =   400
  320.                Underline       =   0   'False
  321.                Italic          =   0   'False
  322.                Strikethrough   =   0   'False
  323.             EndProperty
  324.             ForeColor       =   &H00000000&
  325.             Height          =   315
  326.             Index           =   3
  327.             Left            =   4275
  328.             MaxLength       =   12
  329.             TabIndex        =   6
  330.             Text            =   "21"
  331.             Top             =   555
  332.             Width           =   855
  333.          End
  334.          Begin VB.TextBox Text1 
  335.             BeginProperty Font 
  336.                Name            =   "Arial"
  337.                Size            =   8.25
  338.                Charset         =   0
  339.                Weight          =   400
  340.                Underline       =   0   'False
  341.                Italic          =   0   'False
  342.                Strikethrough   =   0   'False
  343.             EndProperty
  344.             Height          =   315
  345.             Index           =   2
  346.             Left            =   3075
  347.             MaxLength       =   12
  348.             TabIndex        =   5
  349.             Text            =   "0.5"
  350.             Top             =   555
  351.             Width           =   1035
  352.          End
  353.          Begin VB.TextBox Text1 
  354.             BeginProperty Font 
  355.                Name            =   "Arial"
  356.                Size            =   8.25
  357.                Charset         =   0
  358.                Weight          =   400
  359.                Underline       =   0   'False
  360.                Italic          =   0   'False
  361.                Strikethrough   =   0   'False
  362.             EndProperty
  363.             Height          =   285
  364.             Index           =   0
  365.             Left            =   1035
  366.             MaxLength       =   12
  367.             TabIndex        =   4
  368.             Text            =   "-5"
  369.             Top             =   555
  370.             Width           =   855
  371.          End
  372.          Begin VB.Label Label1 
  373.             BackStyle       =   0  'Transparent
  374.             Caption         =   "X-direction:"
  375.             BeginProperty Font 
  376.                Name            =   "Arial"
  377.                Size            =   8.25
  378.                Charset         =   0
  379.                Weight          =   400
  380.                Underline       =   0   'False
  381.                Italic          =   0   'False
  382.                Strikethrough   =   0   'False
  383.             EndProperty
  384.             Height          =   255
  385.             Index           =   0
  386.             Left            =   90
  387.             TabIndex        =   17
  388.             Top             =   585
  389.             Width           =   1035
  390.          End
  391.          Begin VB.Label Label1 
  392.             BackStyle       =   0  'Transparent
  393.             Caption         =   "Y-direction:"
  394.             BeginProperty Font 
  395.                Name            =   "Arial"
  396.                Size            =   8.25
  397.                Charset         =   0
  398.                Weight          =   400
  399.                Underline       =   0   'False
  400.                Italic          =   0   'False
  401.                Strikethrough   =   0   'False
  402.             EndProperty
  403.             Height          =   315
  404.             Index           =   2
  405.             Left            =   90
  406.             TabIndex        =   16
  407.             Top             =   1035
  408.             Width           =   1035
  409.          End
  410.          Begin VB.Label Label1 
  411.             BackStyle       =   0  'Transparent
  412.             Caption         =   "Minimum"
  413.             BeginProperty Font 
  414.                Name            =   "Arial"
  415.                Size            =   8.25
  416.                Charset         =   0
  417.                Weight          =   400
  418.                Underline       =   0   'False
  419.                Italic          =   0   'False
  420.                Strikethrough   =   0   'False
  421.             EndProperty
  422.             Height          =   315
  423.             Index           =   3
  424.             Left            =   1095
  425.             TabIndex        =   15
  426.             Top             =   270
  427.             Width           =   915
  428.          End
  429.          Begin VB.Label Label1 
  430.             BackStyle       =   0  'Transparent
  431.             Caption         =   "Maximum"
  432.             BeginProperty Font 
  433.                Name            =   "Arial"
  434.                Size            =   8.25
  435.                Charset         =   0
  436.                Weight          =   400
  437.                Underline       =   0   'False
  438.                Italic          =   0   'False
  439.                Strikethrough   =   0   'False
  440.             EndProperty
  441.             Height          =   315
  442.             Index           =   4
  443.             Left            =   2055
  444.             TabIndex        =   14
  445.             Top             =   270
  446.             Width           =   1035
  447.          End
  448.          Begin VB.Label Label1 
  449.             BackStyle       =   0  'Transparent
  450.             Caption         =   "Spacing"
  451.             BeginProperty Font 
  452.                Name            =   "Arial"
  453.                Size            =   8.25
  454.                Charset         =   0
  455.                Weight          =   400
  456.                Underline       =   0   'False
  457.                Italic          =   0   'False
  458.                Strikethrough   =   0   'False
  459.             EndProperty
  460.             Height          =   315
  461.             Index           =   5
  462.             Left            =   3135
  463.             TabIndex        =   13
  464.             Top             =   270
  465.             Width           =   795
  466.          End
  467.          Begin VB.Label Label1 
  468.             BackStyle       =   0  'Transparent
  469.             Caption         =   "# of lines"
  470.             BeginProperty Font 
  471.                Name            =   "Arial"
  472.                Size            =   8.25
  473.                Charset         =   0
  474.                Weight          =   400
  475.                Underline       =   0   'False
  476.                Italic          =   0   'False
  477.                Strikethrough   =   0   'False
  478.             EndProperty
  479.             Height          =   315
  480.             Index           =   6
  481.             Left            =   4275
  482.             TabIndex        =   12
  483.             Top             =   270
  484.             Width           =   900
  485.          End
  486.       End
  487.       Begin VB.TextBox TxtExpression 
  488.          BeginProperty Font 
  489.             Name            =   "Arial"
  490.             Size            =   8.25
  491.             Charset         =   0
  492.             Weight          =   400
  493.             Underline       =   0   'False
  494.             Italic          =   0   'False
  495.             Strikethrough   =   0   'False
  496.          EndProperty
  497.          Height          =   345
  498.          Left            =   -74175
  499.          TabIndex        =   2
  500.          Text            =   "sin(x^2+y^2)/(x^2+y^2)"
  501.          Top             =   1860
  502.          Width           =   4575
  503.       End
  504.       Begin VB.Label Label7 
  505.          Caption         =   "Click on picture boxes to customize colors"
  506.          Height          =   435
  507.          Left            =   180
  508.          TabIndex        =   43
  509.          Top             =   3960
  510.          Width           =   2655
  511.       End
  512.       Begin VB.Label Label6 
  513.          Caption         =   "Hole Color:"
  514.          Height          =   255
  515.          Left            =   -74760
  516.          TabIndex        =   41
  517.          Top             =   4140
  518.          Width           =   1035
  519.       End
  520.       Begin VB.Label Label5 
  521.          Caption         =   "Pre-defined Equations:"
  522.          Height          =   255
  523.          Left            =   -74820
  524.          TabIndex        =   38
  525.          Top             =   1260
  526.          Width           =   1695
  527.       End
  528.       Begin VB.Label LblZinfo 
  529.          Height          =   975
  530.          Left            =   -72060
  531.          TabIndex        =   36
  532.          Top             =   3480
  533.          Width           =   2595
  534.       End
  535.       Begin VB.Label Label2 
  536.          Caption         =   "Color Mixing:"
  537.          Height          =   240
  538.          Index           =   1
  539.          Left            =   120
  540.          TabIndex        =   33
  541.          Top             =   1620
  542.          Width           =   1410
  543.       End
  544.       Begin VB.Label Label2 
  545.          Caption         =   "(2 - 200)"
  546.          Height          =   240
  547.          Index           =   4
  548.          Left            =   1740
  549.          TabIndex        =   31
  550.          Top             =   2640
  551.          Width           =   690
  552.       End
  553.       Begin VB.Label Label3 
  554.          Caption         =   "Color Schemes"
  555.          Height          =   255
  556.          Left            =   180
  557.          TabIndex        =   23
  558.          Top             =   660
  559.          Width           =   1995
  560.       End
  561.       Begin VB.Label Label4 
  562.          Caption         =   "Levels:"
  563.          Height          =   315
  564.          Left            =   180
  565.          TabIndex        =   22
  566.          Top             =   2640
  567.          Width           =   675
  568.       End
  569.       Begin VB.Label Label2 
  570.          Caption         =   "Enter an equation that is a function of x and y, or choose a pre-defined equation"
  571.          Height          =   525
  572.          Index           =   0
  573.          Left            =   -74820
  574.          TabIndex        =   19
  575.          Top             =   540
  576.          Width           =   5460
  577.       End
  578.       Begin VB.Label Label1 
  579.          Caption         =   "f(x,y) = "
  580.          Height          =   330
  581.          Index           =   1
  582.          Left            =   -74805
  583.          TabIndex        =   18
  584.          Top             =   1860
  585.          Width           =   645
  586.       End
  587.    End
  588.    Begin VB.PictureBox Picture1 
  589.       AutoRedraw      =   -1  'True
  590.       DrawMode        =   14  'Copy Pen
  591.       DrawStyle       =   6  'Inside Solid
  592.       FillStyle       =   6  'Cross
  593.       Height          =   4335
  594.       Left            =   5880
  595.       ScaleHeight     =   4275
  596.       ScaleWidth      =   4635
  597.       TabIndex        =   0
  598.       Top             =   360
  599.       Width           =   4695
  600.    End
  601.    Begin VB.Label LblChart 
  602.       Height          =   255
  603.       Left            =   5880
  604.       TabIndex        =   39
  605.       Top             =   4800
  606.       Width           =   4635
  607.    End
  608. Attribute VB_Name = "FrmMathGrid"
  609. Attribute VB_GlobalNameSpace = False
  610. Attribute VB_Creatable = False
  611. Attribute VB_PredeclaredId = True
  612. Attribute VB_Exposed = False
  613. Option Explicit
  614. Dim expr As New CExpression
  615. Dim Updating As Boolean
  616. Dim EndColors As Integer    'Number of endcolors to mix
  617. Dim RGBEnds(1 To 5, 1 To 5, 1 To 5) As Integer
  618. Dim Rcolor(1 To 200) As Integer
  619. Dim Gcolor(1 To 200) As Integer
  620. Dim Bcolor(1 To 200) As Integer
  621. Const MaxAllowedZ As Double = 1E+20
  622. Const MinAllowedZ As Double = -1E+20
  623. Const HoleValue As Double = 1E-21
  624. Public Function NumInStr(SearchFor As String, MainString As String) As Integer
  625. 'This function returns the number of occurences of a character in another string
  626. Dim i As Integer
  627. Dim Num As Integer
  628. NumInStr = 0
  629. For i = 1 To Len(MainString)
  630.   If Mid(MainString, i, 1) = SearchFor Then NumInStr = NumInStr + 1
  631. End Function
  632. Private Sub CmbColorSchemes_Click()
  633. On Error Resume Next
  634. TxtLevels = "100"
  635. Select Case CmbColorSchemes.ListIndex
  636. Case 0 'rainbow
  637.   pic1(0).BackColor = RGB(0, 0, 255)
  638.   pic1(1).BackColor = RGB(0, 255, 0)
  639.   pic1(2).BackColor = RGB(255, 0, 0)
  640.   CmbMix.ListIndex = 2
  641.   CmbMix_Click
  642. Case 1 'fiery
  643.   CmbMix.ListIndex = 3
  644.   pic1(0).BackColor = RGB(255, 255, 0)
  645.   pic1(1).BackColor = RGB(255, 0, 255)
  646.   pic1(2).BackColor = RGB(0, 255, 255)
  647.   pic1(3).BackColor = RGB(255, 0, 0)
  648.   pic1(4).BackColor = RGB(0, 0, 255)
  649.   ColorScale
  650. Case 2
  651.   CmbMix.ListIndex = 3
  652.   pic1(0).BackColor = RGB(0, 0, 128)
  653.   pic1(1).BackColor = RGB(0, 128, 0)
  654.   pic1(2).BackColor = RGB(255, 255, 0)
  655.   pic1(3).BackColor = RGB(0, 255, 255)
  656.   pic1(4).BackColor = RGB(128, 64, 64)
  657.   ColorScale
  658. Case 3
  659.   CmbMix.ListIndex = 1
  660.   pic1(0).BackColor = RGB(128, 128, 255)
  661.   pic1(1).BackColor = RGB(0, 100, 100)
  662.   pic1(2).BackColor = RGB(255, 255, 128)
  663.   ColorScale
  664. End Select
  665. End Sub
  666. Private Sub CmbEquations_Click()
  667. TxtExpression = CmbEquations.List(CmbEquations.ListIndex)
  668.  Text1(0) = -5
  669.  Text1(1) = 5
  670.  Text1(4) = -5
  671.  Text1(5) = 5
  672. Select Case CmbEquations.ListIndex
  673. Case 1
  674.   Text1(0) = 1
  675.   Text1(1) = 3
  676.   Text1(4) = 1
  677.   Text1(5) = 3
  678. Case 5
  679.   Text1(0) = -1
  680.   Text1(1) = 1
  681.   Text1(4) = 1
  682.   Text1(5) = 4
  683. Case 6
  684.   Text1(0) = -2
  685.   Text1(1) = 2
  686.   Text1(4) = -2
  687.   Text1(5) = 2
  688. Case 7
  689.   Text1(0) = 0
  690.   Text1(1) = 1
  691.   Text1(4) = 0
  692.   Text1(5) = 1
  693. Case 8
  694.   Text1(0) = 0
  695.   Text1(1) = 2.5
  696.   Text1(4) = 0
  697.   Text1(5) = 2.5
  698. End Select
  699. End Sub
  700. Private Sub CmbMix_Click()
  701. Dim Rend(0 To 4) As Integer
  702. Dim Gend(0 To 4) As Integer
  703. Dim Bend(0 To 4) As Integer
  704. Dim i As Integer
  705. Dim ColString$
  706. pic1(0).Visible = True
  707. pic1(1).Visible = True
  708. pic1(2).Visible = True
  709. Select Case CmbMix.ListIndex
  710. Case 0 '2 color
  711.   pic1(1).Visible = False
  712.   For i = 3 To 4
  713.     pic1(i).Visible = False
  714.   Next i
  715. Case 1  ' 3 color linear
  716.   For i = 3 To 4
  717.     pic1(i).Visible = False
  718.   Next i
  719. Case 2  '3 auto
  720.   For i = 3 To 4
  721.     pic1(i).Visible = False
  722.   Next i
  723. Case 3  '3 man
  724.   For i = 3 To 4
  725.     pic1(i).Visible = True
  726.   Next i
  727.     'get rgb  values
  728.      For i = 0 To 2
  729.       ColString$ = Hex(pic1(i).BackColor)
  730.       If Len(ColString$) = 2 Then
  731.         Bend(i) = 0
  732.         Gend(i) = 0
  733.         Rend(i) = HextoDecimal(ColString$)
  734.       ElseIf Len(ColString$) = 4 Then
  735.         Bend(i) = 0
  736.         Gend(i) = HextoDecimal(Left$(ColString$, 2))
  737.         Rend(i) = HextoDecimal(Right$(ColString$, 2))
  738.       ElseIf Len(ColString$) = 6 Then
  739.         Bend(i) = HextoDecimal(Left$(ColString$, 2))
  740.         Gend(i) = HextoDecimal(Mid$(ColString$, 3, 2))
  741.         Rend(i) = HextoDecimal(Right$(ColString$, 2))
  742.       End If
  743.       Next i
  744.              
  745.       For i = 3 To 4 Step 1
  746.         If Rend(i - 2) > Rend(i - 3) Then
  747.            Rend(i) = Rend(i - 2)
  748.            Else
  749.            Rend(i) = Rend(i - 3)
  750.         End If
  751.          If Gend(i - 2) > Gend(i - 3) Then
  752.            Gend(i) = Gend(i - 2)
  753.            Else
  754.            Gend(i) = Gend(i - 3)
  755.         End If
  756.          If Bend(i - 2) > Bend(i - 3) Then
  757.            Bend(i) = Bend(i - 2)
  758.            Else
  759.            Bend(i) = Bend(i - 3)
  760.         End If
  761.       Next i
  762.       For i = 3 To 4
  763.         pic1(i).BackColor = RGB(Rend(i), Gend(i), Bend(i))
  764.       Next i
  765. End Select
  766. ColorScale
  767. End Sub
  768. Private Sub CmdReverse_Click()
  769. Dim temp As Single
  770. temp = pic1(0).BackColor
  771. pic1(0).BackColor = pic1(2).BackColor
  772. pic1(2).BackColor = temp
  773. temp = pic1(3).BackColor
  774. pic1(3).BackColor = pic1(4).BackColor
  775. pic1(4).BackColor = temp
  776. ColorScale
  777. End Sub
  778. Public Sub Command1_Click()
  779. On Error Resume Next
  780. Dim i As Long, j As Long, counter As Long
  781. Dim Xval As Double
  782. Dim Yval As Double
  783. Dim nCol As Long, nRow As Long
  784. Dim dX As Double, dy As Double
  785. Dim Xmin As Double, Ymin As Double
  786. Dim Zmin As Double, Zmax As Double
  787. Dim Zval(1 To 1000000) As Double, zdat As Double
  788. Dim Msg As String
  789. Dim LogData As Boolean
  790. Dim ZLevel As Integer, Levels As Integer
  791. TxtExpression = Trim(TxtExpression)
  792. expr.Expression = TxtExpression
  793. If Len(TxtExpression.Text) > 200 Then
  794.     MsgBox "Expression cannot have more than 200 characters"
  795.     Exit Sub
  796. End If
  797. If expr.ErrorCode Then
  798.     MsgBox "Error in expression"
  799.     Exit Sub
  800. End If
  801. ColorScale
  802. nRow = CInt(Val(Text1(3)))
  803. nCol = CInt(Val(Text1(7)))
  804. dX = Val(Text1(2))
  805. dy = Val(Text1(6))
  806. Xmin = Val(Text1(0))
  807. Ymin = Val(Text1(4))
  808. LogData = (Chklogged.Value = 1)
  809. Levels = CInt(TxtLevels)
  810. If nRow * nCol > 1000000 Then
  811.   Msg = "too many data points.  The total number of points cannot exceed 1,000,000 points.  "
  812.   Msg = Msg & "Please reduce the number of rows or columns."
  813.   Exit Sub
  814. End If
  815. Zmax = MinAllowedZ
  816. Zmin = MaxAllowedZ
  817. counter = 0
  818. Me.Caption = "Calculating Grid..."
  819. For i = 1 To nRow
  820.   Xval = Xmin + (i - 1) * dX
  821.   Me.Caption = "Calculating Grid... " & CInt(i / nRow * 100) & " % Done"
  822.   For j = 1 To nCol
  823.     counter = counter + 1
  824.     Yval = Ymin + (j - 1) * dy
  825.     zdat = expr.Value(Xval, Yval)
  826.       
  827.     If expr.ErrorCode = expOK Then
  828.       
  829.       If LogData Then
  830.         If zdat > 0 Then
  831.           Zval(counter) = Log(zdat) / Log(10)
  832.         Else
  833.           Zval(counter) = HoleValue
  834.         End If
  835.       Else
  836.         Zval(counter) = zdat
  837.       End If
  838.       If Zval(counter) < Zmin Then
  839.         If Zval(counter) > MinAllowedZ Then
  840.           Zmin = Zval(counter)
  841.         Else
  842.           Zval(counter) = MinAllowedZ
  843.           Zmin = MinAllowedZ
  844.         End If
  845.       End If
  846.       If Zval(counter) > Zmax Then
  847.         If Zval(counter) < MaxAllowedZ Then
  848.           Zmax = Zval(counter)
  849.         Else
  850.           Zval(counter) = MaxAllowedZ
  851.           Zmax = MaxAllowedZ
  852.         End If
  853.       End If
  854.     Else  'there was an error in the calculation (i.e. bad input values)
  855.       Zval(counter) = HoleValue
  856.       expr.ClearError
  857.     End If
  858.   Next j
  859. Next i
  860. With Picture1
  861.   .ScaleLeft = Xmin
  862.   .ScaleWidth = (nRow - 1) * dX
  863.   .ScaleTop = Ymin + nCol * dy
  864.   .ScaleHeight = (nCol - 1) * -dy
  865. End With
  866. counter = 0
  867. With Picture1
  868.   .AutoRedraw = False
  869.   .Cls
  870.   For i = 1 To nRow
  871.      Xval = Xmin + (i - 1) * dX
  872.      Me.Caption = "Drawing plot... " & CInt(i / nRow * 100) & " % Done"
  873.      For j = 1 To nCol
  874.        counter = counter + 1
  875.        Yval = Ymin + (j - 1) * dy
  876.        'get color for z value
  877.        ZLevel = CInt(((Zval(counter) - Zmin) / (Zmax - Zmin)) * Levels)
  878.        If ZLevel = 0 Then ZLevel = 1
  879.        If ZLevel > Levels Then ZLevel = Levels
  880.        If Zval(counter) <> HoleValue Then
  881.          Picture1.Line (Xval, Yval)-(Xval + dX, Yval + dy), RGB(Rcolor(ZLevel), Gcolor(ZLevel), Bcolor(ZLevel)), BF
  882.        Else
  883.          Picture1.Line (Xval, Yval)-(Xval + dX, Yval + dy), PicHoleColor.BackColor, BF
  884.        End If
  885.      Next j
  886.   Next i
  887.   .AutoRedraw = True
  888.   DoEvents
  889. End With
  890. LblZinfo = "Z Maximum = " & NumString(Zmax, 0, 0) & Chr(13) & Chr(10) & "Z Minimum = " & NumString(Zmin, 0, 0)
  891. Me.Refresh
  892. Me.Caption = "Create Grid from Math Function"
  893. End Sub
  894. Private Sub Form_Load()
  895.  CmbMix.AddItem "2 Color Linear"
  896.  CmbMix.AddItem "3 Color Linear"
  897.  CmbMix.AddItem "3 Color Automatic Mix"
  898.  CmbMix.AddItem "3 Color Manual Mix"
  899.  CmbColorSchemes.AddItem "Rainbow"
  900.  CmbColorSchemes.AddItem "Fiery"
  901.  CmbColorSchemes.AddItem "Earth"
  902.  CmbColorSchemes.AddItem "Marine"
  903.  CmbColorSchemes.ListIndex = 0
  904.  Picture1.DrawMode = 13 'very important!!
  905. CmbEquations.AddItem "Sin(x^2 + Y^2) / (x^2 + Y^2)"
  906. CmbEquations.AddItem "COS(SIN(X*Y)) + SIN(COS(X/Y))"
  907. CmbEquations.AddItem "3*X*Y - X*X*X - Y*Y*Y"
  908. CmbEquations.AddItem "((Y*Y <=1) + (X*X >1)) * SIN(X-Y)"
  909. CmbEquations.AddItem "COS(4*(SIN(X) + COS(Y)))"
  910. CmbEquations.AddItem "Y * (Y-1) * (Y-1.1) - 10*X*X*(X*X-1)"
  911. CmbEquations.AddItem "ACOS(X*Y)"
  912. CmbEquations.AddItem "POW(POW(X, -LOG(Y)), POW(Y, -LOG(X)))"
  913. CmbEquations.AddItem "ATAN(POW(X, Y))"
  914. CmbEquations.AddItem "SIN(X*Y)"
  915. CmbEquations.AddItem "COS(X*Y)"
  916. CmbEquations.AddItem "TAN(X*Y)"
  917. CmbEquations.ListIndex = 6
  918. Text1(3) = 100
  919. Text1(7) = 100
  920. End Sub
  921. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  922. If LblChart <> "" Then LblChart = ""
  923. End Sub
  924. Private Sub Form_Unload(Cancel As Integer)
  925. Set expr = Nothing
  926. End Sub
  927. Public Function CheckNum(KeyAscii As Integer, NumText As String) As Integer
  928. On Error Resume Next
  929. Dim K As Integer
  930. 'ASCII Character constants
  931. 'Const Char0 As Integer = 48
  932. 'Const Char9 As Integer = 57
  933. 'Const CharBackSpace As Integer = 8
  934. 'Const CharTab As Integer = 9
  935. 'Const CharMinus As Integer = 45
  936. 'Const CharPeriod As Integer = 46
  937. 'Const CharEnter = 13
  938. 'const comma = 44
  939. NumText = UCase(Trim(NumText))
  940. If KeyAscii = 46 Then
  941.   If InStr(NumText, ".") > 0 Then
  942.     CheckNum = 0
  943.     Exit Function
  944.   End If
  945. End If
  946. If KeyAscii = 45 Then
  947.   If InStr(NumText, "-") > 0 Then
  948.     If Mid(NumText, InStr(NumText, "-") - 1, 1) <> "E" Then
  949.       CheckNum = 0
  950.       Exit Function
  951.     End If
  952.   End If
  953. End If
  954. If KeyAscii = 101 Or KeyAscii = 69 Then
  955.   If NumInStr("E", NumText) <> 0 Or Len(NumText) = 0 Then
  956.     CheckNum = 0
  957.     Exit Function
  958.   End If
  959. End If
  960. K = KeyAscii
  961. If (K < 48 Or K > 57) And K <> 101 And K <> 69 And K <> 46 And K <> 8 And K <> 9 And K <> 45 And K <> 13 And K <> 44 Then
  962.   CheckNum = 0
  963.   CheckNum = KeyAscii
  964. End If
  965. End Function
  966. Public Function NumString(ByVal Num, nspace As Byte, nformat As Byte) As String
  967. On Error Resume Next
  968. 'num = number to format
  969. 'nspace = nspaces  '0 = 0.01% accuracy
  970. '                  '1 = 0.001% accuracy
  971. '                  '2 = 0.0001% accuracy
  972. 'nformat - 0 = general
  973. 'start at 0.01
  974. Dim addneg As Boolean
  975. Dim B As Single
  976. B = Log(10)
  977. addneg = False
  978. If Num < 0 Then
  979.    addneg = True
  980.    Num = Abs(Num)
  981. End If
  982. If Num = 0 Then
  983.    NumString = "0.000"
  984.    Exit Function
  985. End If
  986. If nformat = 0 Then  'General notation
  987.    If nspace = 0 Then  'minimum with .01% accuracy
  988.         If Log(Num) / B < 1 Then NumString = Format(Num, "0.0000")
  989.         If (Log(Num) / B >= 1 And Log(Num) / B And Log(Num) / B < 2) Then NumString = Format(Num, "0.0#")
  990.         If (Log(Num) / B >= 2 And Log(Num) / B And Log(Num) / B < 3) Then NumString = Format(Num, "0.#")
  991.         If (Log(Num) / B >= 3 And Log(Num) / B And Log(Num) / B < 5) Then NumString = Format(Num, "0")
  992.         If Log(Num) / B >= 5 Then NumString = Format(Num, "0.00E+00")
  993.    End If
  994.    If nspace = 1 Then  'minimum with .001% accuracy
  995.         If Log(Num) / B < 1 Then NumString = Format(Num, "0.00000")
  996.         If (Log(Num) / B >= 1 And Log(Num) / B And Log(Num) / B < 2) Then NumString = Format(Num, "0.00#")
  997.         If (Log(Num) / B >= 2 And Log(Num) / B And Log(Num) / B < 3) Then NumString = Format(Num, "0.0#")
  998.         If (Log(Num) / B >= 3 And Log(Num) / B And Log(Num) / B < 5) Then NumString = Format(Num, "0.#")
  999.         If Log(Num) / B >= 5 Then NumString = Format(Num, "0.00E+00")
  1000.    End If
  1001.    If nspace = 2 Then  'minimum with .0001% accuracy
  1002.         If Log(Num) / B < 1 Then NumString = Format(Num, "0.000000")
  1003.         If (Log(Num) / B >= 1 And Log(Num) / B And Log(Num) / B < 2) Then NumString = Format(Num, "0.000#")
  1004.         If (Log(Num) / B >= 2 And Log(Num) / B And Log(Num) / B < 3) Then NumString = Format(Num, "0.00#")
  1005.         If (Log(Num) / B >= 3 And Log(Num) / B And Log(Num) / B < 5) Then NumString = Format(Num, "0.0#")
  1006.         If (Log(Num) / B >= 5 And Log(Num) / B And Log(Num) / B < 6) Then NumString = Format(Num, "0.0")
  1007.         If Log(Num) / B >= 6 Then NumString = Format(Num, "0.000E+00")
  1008.    End If
  1009.    If addneg Then NumString = "-" & NumString
  1010.    If Right$(NumString, 1) = "." Then NumString = Left(NumString, Len(NumString) - 1)
  1011.    Exit Function
  1012. End If
  1013. End Function
  1014. Private Sub pic1_Click(Index As Integer)
  1015.   On Error GoTo CancelError
  1016.   With CDL1
  1017.     .CancelError = True
  1018.     .Color = pic1(Index).BackColor
  1019.     .Flags = &H1 Or &H2
  1020.     .ShowColor
  1021.     pic1(Index).BackColor = .Color
  1022.     ColorScale
  1023.   End With
  1024. Exit Sub
  1025. CancelError:
  1026. End Sub
  1027. Private Sub Piccolor_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1028. Label7 = "Level " & CInt(Y)
  1029. End Sub
  1030. Private Sub PicHoleColor_Click()
  1031.  On Error GoTo CancelError
  1032.   With CDL1
  1033.     .CancelError = True
  1034.     .Color = PicHoleColor.BackColor
  1035.     .Flags = &H1 Or &H2
  1036.     .ShowColor
  1037.     PicHoleColor.BackColor = .Color
  1038.   End With
  1039. Exit Sub
  1040. CancelError:
  1041. End Sub
  1042. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1043. Dim zdat As Double
  1044. expr.Expression = TxtExpression
  1045. zdat = expr.Value(X, Y)
  1046. If expr.ErrorCode = expOK Then
  1047.   LblChart = "x = " & X & ", y = " & Y & ", z = " & NumString(zdat, 0, 0)
  1048.   LblChart = "x = " & X & ", y = " & Y & ", z = undefined"
  1049. End If
  1050. End Sub
  1051. Private Sub SSTab1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1052.   If LblChart <> "" Then LblChart = ""
  1053.   If Label7 <> "Click on picture boxes to customize colors" Then
  1054.     Label7 = "Click on picture boxes to customize colors"
  1055.   End If
  1056. End Sub
  1057. Private Sub Text1_Change(Index As Integer)
  1058. Dim Xrange!
  1059. Dim Yrange!
  1060. Dim temp1$
  1061. Dim ExpPos%
  1062. On Error Resume Next
  1063. If Updating Then Exit Sub
  1064. If Text1(Index).Text = "" Then Exit Sub
  1065. Text1(Index) = UCase(Text1(Index))
  1066. If Right$(Text1(Index), 1) = "E" Or Right$(Text1(Index), 1) = "-" Then
  1067.   Text1(Index).SelStart = Len(Text1(Index))
  1068.   Exit Sub
  1069. End If
  1070. ExpPos = 0
  1071. If InStr(Text1(Index), "E") <> 0 Then
  1072.   ExpPos = InStr(Text1(Index), "E")
  1073.   temp1$ = Text1(Index)
  1074.   Text1(Index) = Val(Left$(Text1(Index), ExpPos - 1)) * 10 ^ (Val(Right$(Text1(Index), Len(Text1(Index)) - ExpPos)))
  1075. End If
  1076. Xrange = Val(Text1(1)) - Val(Text1(0))
  1077. Yrange = Val(Text1(5)) - Val(Text1(4))
  1078. Updating = True
  1079. If Index = 0 Or Index = 1 Then
  1080.   If Val(Text1(0)) >= Val(Text1(1)) Or Val(Text1(3)) < 2 Then
  1081.     Text1(2) = ""
  1082.     GoTo ResetUpdate
  1083.   End If
  1084.   Text1(2) = NumString((Xrange) / (Val(Text1(3)) - 1), 0, 0)
  1085. End If
  1086. If Index = 4 Or Index = 5 Then
  1087.   If Val(Text1(4)) >= Val(Text1(5)) Or Val(Text1(7)) < 2 Then
  1088.     Text1(6) = ""
  1089.     GoTo ResetUpdate
  1090.   End If
  1091.   Text1(6) = NumString((Yrange) / (Val(Text1(7)) - 1), 0, 0)
  1092. End If
  1093. If Index = 2 Then
  1094.   If Val(Text1(2)) <= 0 Then
  1095.     Text1(3) = ""
  1096.     GoTo ResetUpdate
  1097.   End If
  1098.   Text1(3) = CInt(Xrange / Text1(2)) + 1
  1099. End If
  1100. If Index = 6 Then
  1101.   If Val(Text1(6)) <= 0 Then
  1102.     Text1(7) = ""
  1103.     GoTo ResetUpdate
  1104.   End If
  1105.   Text1(7) = CInt(Yrange / Val(Text1(6))) + 1
  1106. End If
  1107. If Index = 3 Then
  1108.   Text1(3) = CInt(Val(Text1(3)))
  1109.   If Val(Text1(3)) >= 2 Then Text1(2) = NumString((Xrange) / (Val(Text1(3)) - 1), 0, 0)
  1110. End If
  1111. If Index = 7 Then
  1112.   Text1(7) = CInt(Val(Text1(7)))
  1113.    If Val(Text1(7)) >= 2 Then Text1(6) = NumString((Yrange) / (Val(Text1(7)) - 1), 0, 0)
  1114. End If
  1115. ResetUpdate:
  1116. If ExpPos <> 0 Then Text1(Index) = temp1
  1117. Updating = False
  1118. Text1(Index).SelStart = Len(Text1(Index))
  1119. End Sub
  1120. Public Sub GetColor(Z As Double)
  1121. 'This sets the color for the Contour plot
  1122. End Sub
  1123. Public Sub ColorScale()
  1124.  Dim Rend(1 To 5) As Integer
  1125.  Dim Gend(1 To 5) As Integer
  1126.  Dim Bend(1 To 5) As Integer
  1127.  Dim EndPic As Byte
  1128.  Dim Levels As Integer, counter As Integer
  1129.  Dim End1 As Integer, End2 As Integer, End3 As Integer, i As Integer
  1130.  Dim ColString As String
  1131.  Levels = CInt(TxtLevels)
  1132.  If Levels <= 1 Or Levels > 200 Then
  1133.     TxtLevels = "100"
  1134.     Levels = 100
  1135.  End If
  1136.      
  1137.  If (CmbMix.ListIndex = 0) Or (CmbMix.ListIndex = 1) Then 'linear grades
  1138.     End1 = Int(Levels / 2)
  1139.     'get rgb  values
  1140.     For i = 0 To 2
  1141.       ColString$ = Hex(pic1(i).BackColor)
  1142.       If Len(ColString$) = 2 Then
  1143.         Bend(i + 1) = 0
  1144.         Gend(i + 1) = 0
  1145.         Rend(i + 1) = HextoDecimal(ColString$)
  1146.       ElseIf Len(ColString$) = 4 Then
  1147.         Bend(i + 1) = 0
  1148.         Gend(i + 1) = HextoDecimal(Left$(ColString$, 2))
  1149.         Rend(i + 1) = HextoDecimal(Right$(ColString$, 2))
  1150.       ElseIf Len(ColString$) = 6 Then
  1151.         Bend(i + 1) = HextoDecimal(Left$(ColString$, 2))
  1152.         Gend(i + 1) = HextoDecimal(Mid$(ColString$, 3, 2))
  1153.         Rend(i + 1) = HextoDecimal(Right$(ColString$, 2))
  1154.       End If
  1155.     Next i
  1156.      
  1157.     'Reset middle color for 2 color linear
  1158.     If CmbMix.ListIndex = 0 Then
  1159.        Bend(2) = (Bend(1) + Bend(3)) / 2
  1160.        Gend(2) = (Gend(1) + Gend(3)) / 2
  1161.        Rend(2) = (Rend(1) + Rend(3)) / 2
  1162.     End If
  1163.     'set color levels
  1164.     For i = 1 To End1
  1165.        Rcolor(i) = (i - 1) * (Rend(2) - Rend(1)) / (End1 + 1) + Rend(1)
  1166.        Gcolor(i) = (i - 1) * (Gend(2) - Gend(1)) / (End1 + 1) + Gend(1)
  1167.        Bcolor(i) = (i - 1) * (Bend(2) - Bend(1)) / (End1 + 1) + Bend(1)
  1168.     Next
  1169.     counter = 0
  1170.     For i = End1 + 1 To Levels
  1171.        counter = counter + 1
  1172.        Rcolor(i) = counter * (Rend(3) - Rend(2)) / (Levels - End1 + 1) + Rend(2)
  1173.        Gcolor(i) = counter * (Gend(3) - Gend(2)) / (Levels - End1 + 1) + Gend(2)
  1174.        Bcolor(i) = counter * (Bend(3) - Bend(2)) / (Levels - End1 + 1) + Bend(2)
  1175.     Next i
  1176.     For i = 1 To Levels
  1177.       If Rcolor(i) < 0 Then Rcolor(i) = 0
  1178.       If Gcolor(i) < 0 Then Gcolor(i) = 0
  1179.       If Bcolor(i) < 0 Then Bcolor(i) = 0
  1180.     Next i
  1181.    ElseIf CmbMix.ListIndex >= 2 Then 'Mixed Color Options
  1182.      
  1183.       End2 = Int(Levels / 2)
  1184.       End1 = Int(End2 / 2)
  1185.       End3 = End2 + Int((Levels - End2) / 2)
  1186.      'get rgb  values
  1187.          
  1188.      If CmbMix.ListIndex = 2 Then
  1189.        EndPic = 2
  1190.      Else
  1191.        EndPic = 4
  1192.      End If
  1193.      
  1194.      For i = 0 To EndPic
  1195.       ColString$ = Hex(pic1(i).BackColor)
  1196.       If Len(ColString$) = 2 Then
  1197.         Bend(i + 1) = 0
  1198.         Gend(i + 1) = 0
  1199.         Rend(i + 1) = HextoDecimal(ColString$)
  1200.       ElseIf Len(ColString$) = 4 Then
  1201.         Bend(i + 1) = 0
  1202.         Gend(i + 1) = HextoDecimal(Left$(ColString$, 2))
  1203.         Rend(i + 1) = HextoDecimal(Right$(ColString$, 2))
  1204.       ElseIf Len(ColString$) = 6 Then
  1205.         Bend(i + 1) = HextoDecimal(Left$(ColString$, 2))
  1206.         Gend(i + 1) = HextoDecimal(Mid$(ColString$, 3, 2))
  1207.         Rend(i + 1) = HextoDecimal(Right$(ColString$, 2))
  1208.       End If
  1209.     Next i
  1210.        
  1211.     If CmbMix.ListIndex = 2 Then
  1212.       'set mixed new colors
  1213.       For i = 4 To 5 Step 1
  1214.         If Rend(i - 2) > Rend(i - 3) Then
  1215.            Rend(i) = Rend(i - 2)
  1216.            Else
  1217.            Rend(i) = Rend(i - 3)
  1218.         End If
  1219.          If Gend(i - 2) > Gend(i - 3) Then
  1220.            Gend(i) = Gend(i - 2)
  1221.            Else
  1222.            Gend(i) = Gend(i - 3)
  1223.         End If
  1224.          If Bend(i - 2) > Bend(i - 3) Then
  1225.            Bend(i) = Bend(i - 2)
  1226.            Else
  1227.            Bend(i) = Bend(i - 3)
  1228.         End If
  1229.       Next i
  1230.     End If
  1231.       
  1232.      'set color levels
  1233.       For i = 1 To End1
  1234.         Rcolor(i) = (i - 1) * (Rend(4) - Rend(1)) / (End1 + 1) + Rend(1)
  1235.         Gcolor(i) = (i - 1) * (Gend(4) - Gend(1)) / (End1 + 1) + Gend(1)
  1236.         Bcolor(i) = (i - 1) * (Bend(4) - Bend(1)) / (End1 + 1) + Bend(1)
  1237.       Next
  1238.       counter = 0
  1239.       For i = End1 + 1 To End2
  1240.         counter = counter + 1
  1241.         Rcolor(i) = counter * (Rend(2) - Rend(4)) / (End2 - End1 + 1) + Rend(4)
  1242.         Gcolor(i) = counter * (Gend(2) - Gend(4)) / (End2 - End1 + 1) + Gend(4)
  1243.         Bcolor(i) = counter * (Bend(2) - Bend(4)) / (End2 - End1 + 1) + Bend(4)
  1244.       Next
  1245.       counter = 0
  1246.       For i = End2 + 1 To End3
  1247.         counter = counter + 1
  1248.         Rcolor(i) = counter * (Rend(5) - Rend(2)) / (End3 - End2 + 1) + Rend(2)
  1249.         Gcolor(i) = counter * (Gend(5) - Gend(2)) / (End3 - End2 + 1) + Gend(2)
  1250.         Bcolor(i) = counter * (Bend(5) - Bend(2)) / (End3 - End2 + 1) + Bend(2)
  1251.       Next
  1252.       counter = 0
  1253.       For i = End3 + 1 To Levels
  1254.         counter = counter + 1
  1255.         Rcolor(i) = counter * (Rend(3) - Rend(5)) / (Levels - End3 + 1) + Rend(5)
  1256.         Gcolor(i) = counter * (Gend(3) - Gend(5)) / (Levels - End3 + 1) + Gend(5)
  1257.         Bcolor(i) = counter * (Bend(3) - Bend(5)) / (Levels - End3 + 1) + Bend(5)
  1258.       Next i
  1259.      
  1260.    End If
  1261.                 
  1262.   'Draw the sample color scale
  1263.    Piccolor.ScaleTop = Levels
  1264.    Piccolor.ScaleLeft = 0
  1265.    Piccolor.ScaleWidth = 1
  1266.    Piccolor.ScaleHeight = -Levels
  1267.    Piccolor.AutoRedraw = True
  1268.    For i = 1 To Levels
  1269.      Piccolor.Line (0, i - 1)-(1, i), RGB(Rcolor(i), Gcolor(i), Bcolor(i)), BF
  1270.    Next
  1271.    DoEvents
  1272.   Piccolor.Refresh
  1273.   Me.Refresh
  1274. End Sub
  1275. Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
  1276. KeyAscii = CheckNum(KeyAscii, Text1(Index).Text)
  1277. End Sub
  1278. Public Function HextoDecimal(hexstring$) As Long
  1279.   On Error GoTo errorhandler
  1280.   HextoDecimal = CLng("&H" & hexstring)
  1281.   Exit Function
  1282. errorhandler:
  1283.   HextoDecimal = 0
  1284. End Function
  1285. Private Sub TxtLevels_KeyPress(KeyAscii As Integer)
  1286. If KeyAscii = 13 Then ColorScale
  1287. End Sub
  1288. Private Sub TxtLevels_LostFocus()
  1289. ColorScale
  1290. End Sub
  1291.