Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Sci/Eng XY Plot routine for PBCC

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Sci/Eng XY Plot routine for PBCC

    This routine plots any number of well behaved curves with a common set of x-coordinates on a bitmap, which serves as an intermediate product that may be displayed on the screen, send to a printer, or saved to disk for later use.

    It is intended for scientific and engineering purposes, or in general for those applications where simple needs should be served with simple means, and where more elaborate plotting packages would provide an overkill on options.

    Plot sizes and positions may be specified as a fraction of window size or printable page size, which enables easy positioning of plots, and makes the routine very suitable to display or print multiple plots at the time.
    All axis values are in scientific notation. Two color sets are included, one for use on the screen and the other for use on paper.

    The routine was written for PBCC, but should work equally well with PBWIN.
    A marked section of the code may be extracted to be used as an include file.

    Arie Verheul


    Code:
     
     
     
    #Compile Exe
    #Dim All
     
    '........................................................................................
    '
    '
    '
    '
    '
    '           XY PLOT ROUTINE FOR SCIENTIFIC / ENGINEERING PURPOSES
    '
    '                          written for PBCC
    '
    '                        Arie Verheul, may 2008
    '
    '
    ' This routine plots any number of well behaved curves with a common set of x-coordinates
    ' on a bitmap, which serves as an intermediate product that may be displayed on the screen,
    ' send to a printer, or saved to disk for later use.
    '
    ' It is intended for scientific and engineering purposes, or in general for those
    ' applications where simple needs should be served with simple means, and where more
    ' elaborate plotting packages would provide an overkill on options.
    '
    ' Plot sizes and positions may be specified as a fraction of window size or printable
    ' page size, which enables easy positioning of plots, and makes the routine very
    ' suitable to display or print multiple plots at the time.
    ' All axis values are in scientific notation.
    ' Two color sets are included, one for use on the screen and the other for use on paper.
    '
    ' The routine was written for PBCC, but should work equally well with PBWIN.
    '
    '
    '
    '
    '                               GENERAL DESCRIPTION
    '
    ' 1. Plot Array
    '
    ' The coordinates of the curve(s) to be plotted must be contained in a
    ' single precision array :
    '
    '     PlotArray (PointCount, NumCurves)
    '
    '     PlotArray (N, 0)    contains x-coordinates
    '     PlotArray (N, I)    contains y-coordinates of curve I  (1 <= I <= NumCurves)
    '
    '
    ' 2. Plot Parameters
    '
    ' The design goal has been to keep the number of settings as small as possible.
    ' All plot settings are stored in a Type variable <XY_Parmset>, which is specific for
    ' a given plot. If several plots are to be displayed simultaneously, each plot needs
    ' its own <XY_Parmset> variable. Most parameter values are supplied automatically by
    ' the subs XY_AutoRange, XY_SetParms, and XY_SetAxis.
    '
    ' To display a plot on the screen, or send it to the printer, the calling application
    ' or the user needs to provide values for:
    '
    '     PParms.BitmapWidth  > bitmap size
    '     PParms.BitmapHeight
    '     PParms.InsPt_X      > insertion point, for screen or printer
    '     PParms.InsPt_Y
    '     PParms.Destination  > destination of bitmap (screen is default)
    '
    ' Optionally may be specified
    '
    '     PParms.Capture      > capture
    '     PParms.TextSize     > textSize  (if nothing specified the default size is used)
    '     PParms.LineWidth    > lineWidth (If Nothing specified the default width is used)
    '     PParms.GridStyle    > use gridlines or tickmarks  (gridlines is default)
    '
    ' If nothing at all is specified, default values are used, and the plot will fill the
    ' whole window, or the whole printable page.
    '
    ' Bitmap size and insertion point may be specified as a fraction of the size of the
    ' destination window or printable page, or in pixels.
    '
    ' If BitmapWidth <= 30 it is assumed that Bitmap size and insertion point are specified
    ' as fractions of window size or printable page size, or in cm or inches in the case of a
    ' disk file. If BitmapWidth > 30 it is assumed that size and insertion point are specified
    ' in pixels.
    '
    ' The routine can work with either cm or inches, according to the %LengthUnits setting.
    '
    '
    ' 3. Plot to screen
    '
    ' After filling in the <PParms> variable, a plot may be displayed on the screen with :
    '
    '     XY_DrawPlot PParms, PlotArray()
    '
    ' To replot with different scale settings, it is sufficient to change the values of :
    '
    '     PParms.PlotMax(I)   I = 0 > x-axis, I = 1 > y-axis
    '     PParms.PlotMin(I)
    '
    ' and call again :
    '
    '     XY_DrawPlot PParms, PlotArray()
    '
    ' If odd settings are entered, they may be rounded to produce a proper axis division.
    ' As long as new plots are placed on top of existing ones, there is no need to redraw
    ' the screen when updating plots.
    ' The routine uses one Global variable <hWnd> which should hold the window handle.
    '
    '
    ' 4. Print a plot
    '
    ' It may be careful to copy the <PParms> variable before using it for printing,
    ' as some values will be changed. New values need to be provided for:
    '
    '     PParms.BitmapWidth      > bitmap size
    '     PParms.BitmapHeight
    '     PParms.InsPt_X          > insertion point
    '     PParms.InsPt_Y
    '     PParms.Destination
    '
    ' being the sizes and positions as desired on the printer page.
    ' Apart from this some internal changes are made.
    '
    ' Printing is achieved by :
    '
    '     XPrint Attach ....
    '
    '         XY_DrawPlot PParms, PlotArray ()
    '         ......
    '         To be repeated for each plot to be printed on the given page
    '
    '     XPrint Close
    '
    ' Note that there is 64 MB limit to bitmap size, that may restrict possible
    ' plotsize or resolution.
    '
    '
    ' 5. Save bitmap to file
    '
    ' The bitmap may be saved to a disk file for later use in an application like a word
    ' processor or presentation software. Values need to be specified for :
     
    '     PParms.BitmapWidth  > bitmap size
    '     PParms.BitmapHeight
    '     PParms.Resolution   > desired resolution
    '     PParms.Destination  > save with screen colors or save with paper colors
    '
    ' Bitmapsize may be specified in cm or inches, according to the %LengthUnits setting,
    ' or in pixels. If BitmapWidth > 30, pixels are assumed, else it is assumed that
    ' dimensions are in inches or cm.
    ' For <PParms.Destination> two options are available, one using screen colors, and the
    ' other using paper colors.
    '
    '
    '........................................................................................
    '
    '           Start of include section XY_Plot
    '
    '          (This section may be taken out and used as an include file)
    '
    '........................................................................................
     
    %Length_Inch = 0                    ' Lenght units to be used
    %Length_cm   = 1
     
    %LengthUnits  = %Length_cm
     
    ' ........................................................................................
     
    %XY_DisplayOnScreen      = 0        ' PParms.Destination
    %XY_SendToPrinter        = 1
    %XY_SaveWithScreenColors = 2
    %XY_SaveWithPaperColors  = 3
     
    ' ........................................................................................
     
    %XY_GridLines  = 0                  ' PParms.GridStyle
    %XY_TickMarks  = 1
     
    ' ........................................................................................
     
    $XY_TextFont       = "Georgia"      ' Font to be used both on screen and for printer
    %XY_TextSize       = 8              ' Reference text height
    %XY_LabelLength    = 10             ' Max. length of axis labels
     
    ' ........................................................................................
     
    Type XY_ParmSet                ' Index (0) refers to x-axis, index (1) to y-axis
     
      '.... Internal variables,    do not touch
     
      AxisMax(1)    As Single    ' Max/Min values, as printed along axis
      AxisMin(1)    As Single
      AxisInt(1)    As Single    ' Interval used to subdivide axis
      AxisExp(1)    As Integer   ' PlotMax = AxisMax * 10^AxisExp
      PlotMargin    As Integer   ' Width of margin in pixels
     
      '.... External variables,    may be, or need to be set
     
      PlotMax(1)    As Single    ' Max/Min plot values for both axis, as manually set
      PlotMin(1)    As Single    ' or determined by XY_AutoRange
     
      BitmapHeight  As Single    ' Total width and height of bitmap
      BitmapWidth   As Single    ' Single !, should hold relative values
     
      InsPt_X       As Single    ' Insertion point of left-top corner
      InsPt_Y       As Single    ' Single !, should hold relative values
     
      Resolution    As Long      ' Screen or printer resolution in ppi
     
      LineWidth     As Byte      ' Specified line width, optional
      TextSize      As Byte      ' Specified text height, optional
     
      Destination   As Byte      ' %XY_DisplayOnScreen, %XY_SendToPrinter
                                 ' %XY_SaveWithScreenColors, %XY_SaveWithPaperColors
     
      GridStyle     As Byte      ' %XY_GridLines, %XY_TickMarks
     
      RangeSet      As Byte      ' XY_Autorange flag
     
      Capture       As Asciiz*33 ' Plot Capture
     
    End Type
     
    ' ........................................................................................
     
    ' Declarations
     
    ' Sub to be called by the main program
     
    Declare Sub XY_DrawPlot (PParms As XY_ParmSet, PlotArray () As Single)
     
    ' Subs and functions for internal use
     
    Declare Sub      XY_AutoRange       (PParms As XY_ParmSet, PlotArray() As Single)
    Declare Function GetPathName         As String
    Declare Function ScreenResolution    As Long
    Declare Sub      XY_SetAxis         (PParms As XY_ParmSet)
    Declare Sub      XY_SetLocalCoord   (PParms As XY_ParmSet, CoordSystem As Long)
    Declare Sub      XY_SetParms        (PParms As XY_ParmSet)
     
    ' Windows functions
     
    Declare Function GetBkColor    Lib "GDI32.DLL" Alias "GetBkColor"   (_
                                 ByVal hdc As Dword) As Dword
     
    Declare Function GetDeviceCaps Lib "GDI32.DLL" Alias "GetDeviceCaps"(_
                                 ByVal hdc As Dword, ByVal nIndex As Long) As Long
     
    ' ........................................................................................
     
    Global hWnd As Dword
     
    ' ........................................................................................
     
    Sub XY_DrawPlot (PParms As XY_ParmSet, PlotArray () As Single)
     
      ' Performs all drawing and transfers bitmap to its destination
     
      Dim   TraceColor(4)                    As Dword
      Local PlotBGColor, BorderColor         As Dword
      Local FrameColor, GridColor, TextColor As Dword
      Local hBmp, hDC                        As Dword
      Local LineWidth, TextSize              As Long
      Local PlotWidth, PlotHeight            As Long
      Local Axis, N, I                       As Long
      Local X, Y, TickLength                 As Single
      Local TextWidth, TextHeight, CharWidth As Single
      Local AxisLabel, FormatString          As Asciiz * %XY_LabelLength
     
      ' ...............................................................................
     
      ' Update PParms variable
     
      ' XY_Autorange only to be performed the first time
     
      If IsFalse PParms.RangeSet Then XY_AutoRange PParms, PlotArray()
     
      XY_SetParms PParms
     
      XY_SetAxis PParms
     
      ' ...............................................................................
     
      ' Set colors
     
      ' Color values may be edited as needed  (BGR format)
     
      Select Case PParms.Destination And 1
     
      Case 0  ' Screen colors
     
          TraceColor(1) = &H00B0FF      ' TraceColor(1) comes first
          TraceColor(2) = &H80F0C0
          TraceColor(3) = &HFFA050
          TraceColor(0) = &HF04000
     
          PlotBGColor   = %Black
          FrameColor    = %White
          GridColor     = &H707070
          TextColor     = &HD0FF80
     
          Graphic Attach hWnd, 0        ' Set border color to background
          Graphic Get DC To hDc
          BorderColor = GetBkColor (hDC)
     
      Case 1  ' Paper colors
     
          TraceColor(1) = %Red          ' TraceColor(1) comes first
          TraceColor(2) = &H500050
          TraceColor(3) = &H000060
          TraceColor(0) = &H600000
     
          PlotBGColor   = %White
          BorderColor   = %White
          FrameColor    = %Black
          GridColor     = %Gray
          TextColor     = %Black
     
      End Select
     
      ' ..............................................................................
     
      ' Optionally PParms.LineWidth and PParms.TextSize may be specified
      ' If nothing specified for Line width and Text size then use defaults
     
      LineWidth = IIf (PParms.LineWidth, PParms.LineWidth, PParms.Resolution / 150)
      TextSize  = IIf (PParms.TextSize, PParms.TextSize , %XY_TextSize * PParms.Resolution /85)
     
      ' ..............................................................................
     
      'Setup bitmap
     
      Graphic Bitmap New  PParms.BitmapWidth, PParms.BitmapHeight To hBmp
      Graphic Attach      hBmp, 0
      Graphic Color       FrameColor, PlotBGColor
      Graphic Clear
     
      Graphic Font        $XY_TextFont, TextSize, 0
      Graphic Chr Size To CharWidth, TextHeight
     
      PParms.PlotMargin = (%XY_LabelLength * CharWidth)   ' Charwidth determines margin
     
      PlotWidth         = PParms.BitmapWidth  - 2 * PParms.PlotMargin
      PlotHeight        = PParms.BitmapHeight - 2 * PParms.PlotMargin
     
      TickLength        = PParms.Resolution / 12
     
      ' .................................................................................
     
      ' Draw vertical grid lines
     
      ' GridStyle = 0  draws gridlines
      ' GridStyle = 1  draws tickmarks
     
      XY_SetLocalCoord PParms, 1
     
      Graphic Width 1
     
      If PParms.GridStyle Then        ' Tick marks
          Graphic Line (0, 0)-(0, PlotHeight), GridColor   ' First draw vertical zero axis
          Graphic Width LineWidth                          ' Set linewidth for tickmarks
      End If
     
      ' Using Single values for counting involves some risk of rounding problems
      ' To make sure that all items are drawn, a margin of AxisInt/2 is used in end value
     
      For X = (PParms.AxisMin(0)) + PParms.AxisInt(0) To _
              (PParms.AxisMax(0)) - PParms.AxisInt(0) /2 Step PParms.AxisInt(0)
     
          If PParms.GridStyle Then   ' Draw tick marks
     
              Graphic Line (X,0)-(X, TickLength), FrameColor
              Graphic Line (X, PlotHeight)-(X, PlotHeight - TickLength), FrameColor
     
          Else                        ' Draw grid
              Graphic Line (X, 0)-(X, PlotHeight), GridColor
          End If
      Next
     
      ' ..................................................................................
     
      ' Draw horizontal grid lines
     
      XY_SetLocalCoord PParms, 2
     
      Graphic Width 1
     
      If PParms.GridStyle Then        ' Tick marks
          Graphic Line (0, 0)-(PlotWidth, 0), GridColor    ' First draw Horizontal zero axis
          Graphic Width LineWidth                          ' Set linewidth for tickmarks
      End If
     
      For Y = (PParms.AxisMin(1)) + PParms.AxisInt(1) To _
              (PParms.AxisMax(1)) - PParms.AxisInt(1) /2 Step PParms.AxisInt(1)
     
          If PParms.GridStyle Then    ' Draw tick marks
              Graphic Line (0,Y)-(TickLength,Y), FrameColor
              Graphic Line (PlotWidth,Y)-(PlotWidth - TickLength,Y), FrameColor
     
          Else                        ' Draw grid
              Graphic Line (0, Y)-(PlotWidth, Y), GridColor
          End If
      Next
     
      ' ..................................................................................
     
      ' Draw curves
     
      XY_SetLocalCoord PParms, 4
     
      Graphic Width LineWidth
     
      For I = 1 To UBound (PlotArray, 2)                       ' Draw all curves in array
          Graphic Set Pos (PlotArray (0,0), PlotArray (0,I))
     
          For N = 1 To UBound (PlotArray, 1)                   ' Draw all line segments
              Graphic Line -(PlotArray(N,0), PlotArray(N,I)), TraceColor(I Mod 4)
          Next
      Next
     
      ' ...................................................................................
     
      ' Clipping : Draw four blocks around plot area to clip excess curve segments
     
      XY_SetLocalCoord PParms, 0
     
      Graphic Color FrameColor, BorderColor
     
      ' Left
      Graphic Box (0,PParms.BitmapHeight)-(PParms.PlotMargin, 0),_
                   0, BorderColor,BorderColor
      ' Right
      Graphic Box (PParms.BitmapWidth - PParms.PlotMargin + 1, PParms.BitmapHeight)-_
                  (PParms.BitmapWidth, 0), 0, BorderColor,BorderColor
      ' Top
      Graphic Box (0,PParms.BitmapHeight)-_
                  (PParms.BitmapWidth, PParms.BitmapHeight - PParms.PlotMargin),_
                   0, BorderColor,BorderColor
      ' Bottom
      Graphic Box (0,PParms.PlotMargin)-_
                  (PParms.BitmapWidth,0), 0, BorderColor,BorderColor
     
      ' Draw frame around plot area
      Graphic Box (PParms.Plotmargin, PParms.BitmapHeight - PParms.PlotMargin)-_
                  (PParms.Bitmapwidth - PParms.PlotMargin + 1, PParms.PlotMargin - 1),_
                   0, FrameColor
     
      ' .................................................................................
     
      ' Print axis values
     
      For Axis = 0 To 1
     
          XY_SetLocalCoord PParms, Axis + 1
     
          Graphic Color TextColor, BorderColor
     
          If Frac (PParms.AxisInt(Axis)) Then FormatString = "##.#" Else FormatString = "##"
     
          For X = (PParms.AxisMin(Axis)) To _
                  (PParms.AxisMax(Axis)) + PParms.AxisInt(Axis) /2 Step PParms.AxisInt(Axis)
     
              AxisLabel = Using$( FormatString, X)
     
              If Abs (X) < PParms.AxisInt(Axis) / 100 Then AxisLabel = "0" ' Round zero to "0"
     
              Graphic Text Size AxisLabel To TextWidth, TextHeight
     
              If Axis Then
                  Graphic Set Pos (- TextWidth - CharWidth, X + .7 * TextHeight)   ' Y axis
              Else
                  Graphic Set Pos (X - TextWidth / 2,  - .2 * TextHeight)          ' X axis
              End If
     
              Graphic Print AxisLabel;
          Next
     
          ' ...............................................................................
     
          ' Print exponent only if nonzero
     
          If PParms.AxisExp(Axis) Then
              If Axis Then                 ' Move to position for exponent, for Y axis only
                  Graphic Set Pos (0, PParms.AxisMax(1) + 1.2 * TextHeight)
              End If
     
              Graphic Print         "  x 10";
              Graphic Set Pos Step (0, .5 * Textheight)     ' Move upwards
              Graphic Print         PParms.AxisExp(Axis);
          End If
     
      Next
     
      ' ...................................................................................
     
      ' Print capture
     
      XY_SetLocalCoord PParms, 0
     
      Graphic Text Size PParms.Capture To TextWidth, TextHeight
      Graphic Set Pos  (PParms.BitmapWidth - PParms.PlotMargin - TextWidth,_
                        PParms.BitmapHeight - PParms.PlotMargin + 1.2 * TextHeight)
      Graphic Print     PParms.Capture
     
      ' ...................................................................................
     
      ' Copy bitmap to destination
     
      Select Case PParms.Destination
     
      Case 0
     
          Graphic Attach hWnd, 0
          Graphic Copy   hBmp, 0 To (PParms.InsPt_X, PParms.InsPt_Y)
     
      Case 1
     
          XPrint Copy hBmp, 0 To (PParms.InsPt_X, PParms.InsPt_Y)
     
      Case 2,3
     
          Graphic Save GetPathName
     
      End Select
     
      ' Delete bitmap after use
     
      Graphic Attach hBmp, 0
      Graphic Bitmap End
     
    End Sub
     
    ' ........................................................................................
     
    Sub XY_AutoRange (PParms As XY_ParmSet, PlotArray() As Single)
     
      Dim   PlotArrayPtr        As Single Pointer
      Local ArrayMin, ArrayMax  As Single
      Local Axis, N             As Long
      Local Istart, Iend, Ilast As Long
     
      ' ....................................................................................
     
      ' Determine extreme values of curves
     
      ' Treat 2-D array as 1-D array, to conveniently investigate all curves at once
      ' Ilast is 1-D index of last element in array
     
      Ilast = (UBound (PlotArray, 1) + 1) * (UBound (PlotArray, 2) + 1) - 1
     
      PlotArrayPtr = VarPtr (PlotArray (0,0))
     
      For Axis = 0 To 1                                       ' 0 : x-axis, 1 : y-axis
     
          Istart = IIf (Axis, UBound (PlotArray, 1) + 1, 0)   ' First element to investigate
          Iend   = IIf (Axis, Ilast, UBound (PlotArray, 1))   ' Last  element to investigate
     
          ArrayMax = @PlotArrayPtr[Istart]                    ' Initialise Max/Min
          ArrayMin = ArrayMax
     
          For N = Istart + 1 To Iend
              ArrayMax = Max (@PlotArrayPtr[N], ArrayMax)
              ArrayMin = Min (@PlotArrayPtr[N], ArrayMin)
          Next
     
          PParms.PlotMax(Axis) = ArrayMax                     ' Store results
          PParms.PlotMin(Axis) = ArrayMin
      Next
     
      PParms.RangeSet = 1
     
    End Sub
     
    ' ........................................................................................
     
    Function GetPathName As String
     
      ' As this sub is provisional, filenames are not checked for overwriting existing ones
     
      Local SavePath As String, I As Long
      Local InputRow, InputCol, InputLen As Long
     
      InputRow = 8      ' Location and length of input field
      InputCol = 16
      InputLen = 50
     
      Do
          Locate InputRow, InputCol
          Color  1, 15, InputLen
          Input  "Path + File Name : "; Savepath
          SavePath = Trim$(SavePath)
     
      Loop Until SavePath <> ""
     
      I = InStr(SavePath, ".")                        ' to make sure extension is .bmp
      If I Then SavePath = Left$(SavePath, I - 1)     ' remove extension (if any)
      SavePath = SavePath + ".bmp"                    ' and replace with .bmp
     
      Color  15, 0
      Locate InputRow, InputCol
      Print String$ (InputLen, 32);                   ' remove input box
     
      Locate InputRow, InputCol
      Print "Bitmap saved to " + SavePath;            ' print confirmation message
     
      Sleep 2000                                      ' allow reading of message
     
      Locate InputRow, InputCol
      Print String$ (InputLen, 32);                   ' remove message
     
      Function = SavePath
     
    End Function
     
    ' ........................................................................................
     
    Function ScreenResolution As Long
     
      Local H, Ypixels As Long, hDC As Dword
     
      ' As screen resolution is expressed in points per logical inch,
      ' the obtained value is only approximate
     
      Graphic Attach      hWnd,0
      Graphic Get DC   To hDC
      Desktop Get Size To Ypixels, Ypixels   ' screen height in pixels
      H  = GetDeviceCaps(hDC, 6)             ' screen height in logical millimeters
     
      Function = 25.4 * Ypixels / H
     
    End Function
     
    ' ........................................................................................
     
    Sub XY_SetAxis (PParms As XY_ParmSet)
     
      ' Calculates suitable range and sub divisions for both axis
     
      Local N, Axis      As Long
      Local LargestValue As Single
      Dim   Extreme(1)   As Single
     
      For Axis = 0 To 1
     
          If PParms.PlotMax(Axis) = PParms.PlotMin(Axis) Then ' Handle Error condition
              Incr PParms.PlotMax(Axis)
              Decr PParms.PlotMin(Axis)
          End If
     
          LargestValue = Max (Abs(PParms.PlotMin(Axis)), Abs(PParms.PlotMax(Axis)))
     
          PParms.AxisExp(Axis) = Int(Log10(LargestValue))
     
          Do
              Extreme(0) = PParms.PlotMin(Axis) / 10 ^ PParms.AxisExp(Axis)
              Extreme(1) = PParms.PlotMax(Axis) / 10 ^ PParms.AxisExp(Axis)
     
              ' If range is too small then decrement exponent
     
              If Extreme(1) - Extreme(0) < 2 Then Decr PParms.AxisExp(Axis) Else Exit Loop
          Loop
     
          For N = 0 To 1      ' Perform rounding
                              ' If less than .1 off nearest round value, round to that value
                              ' Else round to next lower or higher value
     
              Extreme(N) = IIf(Abs(Extreme(N) - CInt(Extreme(N))) < .1,_
                               CInt(Extreme(N)), Int(Extreme(N)) +  N)
          Next
     
          Select Case (Extreme(1) - Extreme(0))      ' Determine scale division
     
              Case 2    : PParms.AxisInt(Axis) = .2
     
              Case 3,4  : PParms.AxisInt(Axis) = .5
     
              Case >= 10: PParms.AxisInt(Axis) = 2
     
                          ' If odd end value then make it even for proper scale layout
     
                           If CInt(Extreme(0)) Mod 2 Then Decr Extreme(0)
                           If CInt(Extreme(1)) Mod 2 Then Incr Extreme(1)
     
              Case Else : PParms.AxisInt(Axis) = 1
     
          End Select
     
          PParms.AxisMax(Axis) = Extreme (1)     ' Store results
          PParms.AxisMin(Axis) = Extreme (0)
     
          ' Update PlotMax/PlotMin values, as they are further used in SetCoordinates
     
          PParms.PlotMax(Axis) = PParms.AxisMax(Axis)*10^PParms.AxisExp(Axis)
          PParms.PlotMin(Axis) = PParms.AxisMin(Axis)*10^PParms.AxisExp(Axis)
     
      Next
     
    End Sub
     
    ' ........................................................................................
     
    Sub XY_SetLocalCoord (PParms As XY_ParmSet, CoordSystem As Long)
     
      ' Sets various local coordinate systems for plot area
     
      Local Xo, Yo, X1, Y1                 As Single
      Local PlotWidth, PlotHeight          As Single
      Local PlotLeft, PlotBottom           As Single
      Local Kx, Ky, X_LT, Y_LT, X_RB, Y_RB As Single
     
      ' X_LT, Y_LT, X_RB, Y_RB refer to corner points of bitmap
     
      ' All other coordinates refer to plot area within bitmap
     
      '   Xo, Yo     value assigned to origin
      '   X1         x-value assigned to right bottom corner of plot area
      '   Y1         y-value assigned to left top corner of plot area
     
      ' Reset coordinates to pixelcoordinates with origin at left-bottom corner
     
      Graphic Scale (0, PParms.BitmapHeight) - (PParms.BitmapWidth, 0)
     
      PlotWidth  = PParms.BitmapWidth  - 2 * PParms.PlotMargin    ' calculate size of plot area
      PlotHeight = PParms.BitmapHeight - 2 * PParms.PlotMargin
      PlotLeft   = PParms.PlotMargin                              ' position of plot area
      PlotBottom = PParms.PlotMargin                              ' left-bottom corner
     
      Select Case CoordSystem
     
          Case 1 : Xo = PParms.AxisMin(0) : X1 = PParms.AxisMax(0)
                   Yo = 0                 : Y1 = PlotHeight
     
          Case 2 : Xo = 0                 : X1 = PlotWidth
                   Yo = PParms.AxisMin(1) : Y1 = PParms.AxisMax(1)
     
          Case 4 : Xo = PParms.PlotMin(0) : X1 = PParms.PlotMax(0)
                   Yo = PParms.PlotMin(1) : Y1 = PParms.PlotMax(1)
     
          Case Else : Exit Sub
      End Select
     
      Kx   = (X1 - Xo) / PlotWidth              ' Ratio World to Pixel
      Ky   = (Y1 - Yo) / PlotHeight
     
      X_LT = Xo - Kx * PlotLeft                 ' Coordinates for Left-Top and
      Y_RB = Yo - Ky * PlotBottom               ' Right-Bottom corner of bitmap
     
      Y_LT = Y_RB + Ky * PParms.BitmapHeight
      X_RB = X_LT + Kx * PParms.BitmapWidth
     
      Graphic Scale (X_LT, Y_LT) - (X_RB, Y_RB)
     
    End Sub
     
      ' ..................................................................................
     
    Sub XY_SetParms (PParms As XY_ParmSet)
     
      Local W, H As Single
      Local DPI As Long
     
      If (PParms.BitmapWidth  = 0) Or (PParms.BitmapHeight = 0) Then  ' No size specified
     
          W = IIf (PParms.Destination < 2, 1, 600)
     
          PParms.BitmapWidth  = W     ' Default: if no size is specified
          PParms.BitmapHeight = W     ' the plot will fill the whole window or page,
                                      ' or if written to file be 600 x 600 pixels
      End If
     
      ' Set or convert plot parameters
     
      Select Case PParms.Destination
     
          Case 0   ' Screen
     
              Graphic Attach        hWnd, 0
              Graphic Get Client To W, H
              Graphic Get PPI To DPI, DPI
     
              PParms.Resolution = ScreenResolution * 120 / DPI
     
          ' Remark : there is a difference in text height at the same resolution
          ' between screen and printer. This might have to do with the DPI setting.
          ' Although not really understood, the above line seems to solve this.
     
          Case 1   ' Printer
     
              XPrint Get Client To W,H
              XPrint Get PPI    To PParms.Resolution, PParms.Resolution
     
          Case 2,3   ' Disk file
     
              If PParms.Resolution = 0 Then PParms.Resolution = 300 ' Default
     
              ' convert to pixels/cm, if applicable
              W = IIf (%LengthUnits, PParms.Resolution / 2.54 , PParms.Resolution)
              H = W
     
      End Select
     
      If PParms.Bitmapwidth > 30 Then Exit Sub  ' Sizes are already in pixels
     
      PParms.BitmapWidth  = PParms.BitmapWidth  * W
      PParms.BitmapHeight = PParms.BitmapHeight * H
     
      PParms.InsPt_X      = PParms.InsPt_X * W
      PParms.InsPt_Y      = PParms.InsPt_Y * H
     
    End Sub
     
    ' ........................................................................................
     
    ' End of include section
     
    ' ........................................................................................
     
    ' Main Program continues from here
     
    ' ........................................................................................
     
    Declare Function PlotMenu (PParms As XY_ParmSet, PlotArray() As Single) As Long
    Declare Sub      SetRange (PParms As XY_ParmSet, PlotArray() As Single, Axis As Long)
     
    ' ........................................................................................
     
    Function PBMain () As Long
     
      Local A, B, Z As Single
      Local PointCount, NumCurves, N, I As Long
     
      ' ...................................................................................
     
      ' Set up screen
     
      Graphic Window "",40,40,950,500 To hWnd
      Graphic Attach hWnd, 0
      Graphic Color  %White, &H200000
      Graphic Clear
     
      Console Set Screen  9,80
      Console Set Loc    40,542
      Console Name      "XY-Plot"
      Color              15,0
      Cls
     
      ' ..................................................................................
     
      ' make XY Plot 1
     
      PointCount = 200
      NumCurves  = 4
     
      Dim PlotData1 (PointCount, NumCurves) As Single
      Dim PParms1 As XY_ParmSet
     
      A = 5e-5                             ' Produce some data to be plotted
      B = 1e5                              ' for curves 1 to Numcurves
     
      For I = 1 To NumCurves               ' y(x) = A * x^3 + B
          A = 1.5 * A
     
          For N = 0 To PointCount
              PlotData1 (N,0) = 3 * (N - .5 * Pointcount)    ' x coordinates
              PlotData1 (N,I) = A * PlotData1 (N,0)^3 + B    ' y coordinates
          Next
      Next
     
      ' Fill PParms variable
     
      ' Defaults used : Ususally the defaults will do, but may be changed if needed
     
      ' PParms1.Destination  = 0          Send to screen
      ' PParms1.GridStyle    = 0          Grid lines
      ' PParms1.LineWith     = 0          Use default
      ' PParms1.Textsize     = 0          Use default
     
      ' Specified values : Bitmap Width, Height and Insertion Point are needed
     
      PParms1.BitmapHeight = 1             ' Plot across full height and half width
      PParms1.BitmapWidth  = .5
     
      PParms1.InsPt_X      = 0             ' Specify insertion point relative to window size
      PParms1.InsPt_Y      = 0
     
      PParms1.Capture      = "XY Plot 1"   ' Provide capture
     
      XY_DrawPlot PParms1, PlotData1()     ' Draw bitmap and copy it to the screen
     
    ' ........................................................................................
     
      ' XY Plot 2
     
      PointCount = 300
     
      Dim PlotData2 (PointCount, 1) As Single
      Dim PParms2 As XY_ParmSet
     
      For N = 0 To PointCount                         ' Produce some data to be plotted
          Z = N / 20
     
          PlotData2(N,0) = 1e-4 * Sin(Z)              ' x(z) = 1e-4 * sin(z)
          PlotData2(N,1) = 1e-1 * Sin(Z) * Sin(Z/2)   ' y(z) = 1e-1 * sin(z) * sin (z/2)
      Next
     
      ' Fill PParms variable
     
      ' Defaults used
     
      ' PParms2.Destination  = 0          Send to screen
      ' PParms1.LineWith     = 0          Use default
      ' PParms1.Textsize     = 0          Use default
     
      ' Specified values
     
      PParms2.BitmapHeight = 1            ' Plot across full height and half width
      PParms2.BitmapWidth  = .5
     
      PParms2.InsPt_X      = .5           ' Specify insertion point relative to window size
      PParms2.InsPt_Y      = 0
     
      PParms2.GridStyle    = %XY_TickMarks
      PParms2.Capture      = "XY Plot 2"  ' Provide capture
     
      XY_DrawPlot PParms2, PlotData2()    ' Draw bitmap and copy it to the screen
     
      ' ...................................................................................
     
      ' Menu
     
      Do
          Console Set Focus
     
          Select Case PlotMenu (PParms1, PlotData1())
     
          Case 1 : SetRange PParms1, PlotData1(), 0   ' Set X-range
     
          Case 2 : SetRange PParms1, PlotData1(), 1   ' Set Y-range
     
          Case 3 ' Print both plots
     
              XPrint Attach Choose, "XY-Plot"                 ' Connect to printer
     
              Dim PrinterParms1 As XY_ParmSet, PrinterParms2 As XY_ParmSet
     
                  PrinterParms1 = PParms1                     ' Copy variables
                  PrinterParms2 = PParms2                     ' to preserve original
     
                  PrinterParms1.Destination  = %XY_SendToPrinter
                  PrinterParms1.BitmapWidth  = .5             ' Plot size half width
                  PrinterParms1.BitmapHeight = 1/3            ' times 1/3 height
                                                              ' of printable area
                  PrinterParms1.InsPt_X      = 0
                  PrinterParms1.InsPt_Y      = 0
     
                  PrinterParms2.Destination  = %XY_SendToPrinter
                  PrinterParms2.BitmapWidth  = .5
                  PrinterParms2.BitmapHeight = 1/3
     
                  PrinterParms2.InsPt_X      = .5
                  PrinterParms2.InsPt_Y      = 0
     
                  XY_DrawPlot PrinterParms1, PlotData1()
                  XY_DrawPlot PrinterParms2, PlotData2()
     
              XPrint Close                                    ' Close printerconnection
     
          Case 4 ' Save Plot1 to disk file
     
              Dim SaveParms As XY_ParmSet
                                                              ' Copy variable
                  SaveParms = PParms1                         ' to preserve original
     
                  SaveParms.Destination  = %XY_SaveWithPaperColors
     
                  SaveParms.BitmapWidth  = 10                 ' Final size 10 x 10 cm
                  SaveParms.BitmapHeight = 10
                  SaveParms.Resolution   = 300                ' at 300 ppi
     
                  XY_DrawPLot SaveParms, PlotData1()
     
          End Select
      Loop
     
    End Function
     
    ' ........................................................................................
     
    Sub SetRange (PParms As XY_ParmSet, PlotArray() As Single, Axis As Long)
     
      Local Prompt As String
      Local InputRow, InputCol, InputLen As Long
      Local AxisMin, AxisMax As Single
     
      InputRow = 2          ' Location and length of input field
      InputCol = 18
      InputLen = 40
     
      Prompt = "X Range (Min,Max) : "
     
      If Axis Then Mid$(Prompt,1) = "Y"
     
      Locate InputRow + 2 * Axis, InputCol
      Color  1,15,InputLen
      Print  Prompt;
      Input  AxisMin, AxisMax
     
      If AxisMin <> AxisMax Then    'Valid values
     
          If AxisMin > AxisMax Then Swap AxisMin, AxisMax
     
          PParms.PlotMin(Axis) = AxisMin
          PParms.PlotMax(Axis) = AxisMax
      Else
          PParms.RangeSet = 0                ' Reset flag to perform AutoRange
      End If
     
      XY_DrawPlot PParms, PlotArray()
     
      Locate InputRow + 2 * Axis,InputCol
      Color 15,0
      Print String$(InputLen,32);            ' Remove input window
     
    End Sub
     
    ' ........................................................................................
     
    Function PlotMenu (PParms As XY_ParmSet, PlotArray() As Single) As Long
     
      Local N As Long, Entry As String
     
      For N = 1 To 9                   ' Print menu box and text
          Locate N,1: Color 14,4,13    ' Print coloured beam
     
          If IsFalse (N Mod 2) Then    ' At even positions print menu item
              Locate ,2
              Print Choose$(N/2,"Set X Range","Set Y Range","Print Plot","Disk File");
          End If
      Next
     
      Color 15,0
     
      Mouse On
      Mouse 1
     
      Do
          If MouseStat Then
              Entry = WaitKey$         ' Dummy operation to remove buffer content
     
              If MouseX <= 13 And IsFalse (MouseY Mod 2) Then  ' Is mouse cursor in menu area ?
                   Function = MouseY / 2
                   Exit Loop
              End If
          End If
      Loop
     
    End Function
     
    ' ........................................................................................

  • #2
    Oops, posted in wrong forum.

    Naughty Naughty Fingers!
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      Originally posted by Michael Mattias View Post
      Naughty Naughty Fingers!
      [censored by myself] :add_twinkle: :ashamed: :saythat: :d

      "Y'all be cool now ya hear !" {Dukes of Hazard 1984 (?)}
      Eddy

      Comment

      Working...
      X