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