PureBasic Forums - English

Code: Select all

DeclareModule MINIBGI
  EnableExplicit 
 
; update constants
  #UpdateOff = 0
  #UpdateOn  = 1
  #UpdateNow = 2
 
; clipping constants
  #ClipOn  = 1
  #ClipOff = 0
 
; drawing modes on screen
  #CopyMode =  0
  #XorMode  =  1
  #OrMode   =  2
  #AndMode  =  3
  #NotMode  =  4
  #NotScrMode =  5
  #NotXorMode =  6
  #NotOrMode  =  7
  #NotAndMode =  8
  #InvColAndMode =  9
  #InvColOrMode  = 10
  #InvScrAndMode = 11
  #InvScrOrMode  = 12
  #BlackMode = 13
  #WhiteMode = 14
  #EmptyMode = 15
  #TRANSPARENT_ = $00
  #OPAQUE_    = 16
 
; drawing style For lines
  #SolidLn   = 0
  #DottedLn  = 1
  #DashDotLn = 2
  #DashedLn  = 3
  #DashDotDotLn = 4
  #UserBitLn = 5
  #NullLn    = 6
 
; thick constants For lines
  #NormWidth   = 1
  #DoubleWidth = 2
  #TripleWidth = 3
  #QuadWidth   = 4
  #ThickWidth  = #TripleWidth
 
; filling patterns
  #EmptyFill = 0
  #SolidFill = 1
  #LineFill  = 2
  #ColFill   = 3
  #HatchFill = 4
  #SlashFill = 5
  #BkSlashFill= 6
  #XHatchFill = 7
  #UserFill   = 8
  #NoFill     = 9
 
; Bar3D constants
  #TopOn  = 1
  #TopOff = 0
 
; flood mode constants
  #BorderFlood  = 0
  #SurfaceFlood = 1
 
; justify constants For text
  #LeftText   = 0
  #CenterText = 1
  #RightText  = 2
  #TopText    = 0
  #BottomText = 1
  #BaselineText = 2
 
; direction constants For text
  #HorizDir =  0
  #VertDir  = 90
 
; font constants For text
  #CourierNewFont   = 0
  #MSSansSerifFont  = 1
  #TimesNewRomanFont= 2
  #ArialFont   = 3
  #DefaultFont = #CourierNewFont
  #ItalicFont  = $1000
  #UnderlineFont = $0100
  #BoldFont    = $0010
 
; Symbols for graphs
  #SYMBOLRECTANGLE = 1
  #SYMBOLTRIANGLE  = 2
  #SYMBOLDIAMOND   = 3
  #SYMBOLCROSS     = 4
  #SYMBOLXCROSS    = 5
  #SYMBOLNONE      = 0
 
  #CAPTUREBLT = $40000000 ; Necessary for BitBlt to get layered windows if present on screen
  #NOMIRRORBITMAP = $80000000 ; Do not Mirror the bitmap in this call
 
  Structure ViewPortType
    x1.w
    y1.w
    x2.w
    y2.w
    clip.l ;  BOOLEAN
  EndStructure
 
  Structure PointType
     x.l
     y.l 
  EndStructure

  Structure ThreeDPointType
    x.d
    y.d
    z.d
  EndStructure
 
  Structure LineSettingsType
    linestyle.w
    pattern.w
    thickness.w
  EndStructure
 
  Structure ArcCoordsType
    x.l
    y.l
    xstart.i
    ystart.i
    xend.i
    yend.i
  EndStructure
 
  Structure FillSettingsType
    pattern.w
    color.l
  EndStructure
 
  Structure TextSettingsType
    font.w
    direction.w
    charsize.w
    horiz.w
    vert.w
  EndStructure
 
  Structure BGIimage
    width.i
    height.i
    size.i
    *bits
  EndStructure
 
  Macro INC(i,j=1)
    i + j
  EndMacro
  Macro DEC(i,j=1)
    i - j
  EndMacro
 
 
 
; initialization exported routines

; Clears the entire graphics screen using ClearViewPort routine. See that routine For details. Current pointer is reset
; at (0,0), that is top-left corner of the screen.
Declare ClearDevice()

; Closes the graphics window And releases all resources related To it. The parent console window is shown again in foreground
; (If any). You can Restore back the graphics window using SetGraphMode Or InitGraph.
Declare CloseGraph()

; Use CloseGraph To close the graphics window.
Declare.i InitGraph(WinX.l, WinY.l, title.s, Color.i=#Black, BackColor.i=#White)

; Sets the dimensions of the graphics window To be created by InitGraph. In this Case you must use mCustom graphics mode. (width)
; is the width And (height) is the height in pixels of the window client area. Returns the PB window number.

; screen management exported routines

Declare ClearDeviceWithColor(color.l)
Declare ClearViewPortWithColor(color.l)

; Clears the current viewport. The current background color is used As filling color. The pointer is set at (0,0),
; that is top-left corner of the viewport. See also SetViewPort And SetBkColor For more details.
Declare ClearViewPort()

Declare GetAspectRatio(*xasp.word, *yasp.word)

; Returns the maximum x-coordinate (horizontal) in pixels. This equals the client area width minus 1. Maximum is placed on the
; right side.
Declare.i GetMaxX()

; Returns the maximum y-coordinate (vertical) in pixels. This equals the client area height minus 1. Maximum is placed on the
; bottom side.
Declare.i GetMaxY()

; Returns the current viewport And clipping settings in (viewport). You can change these settings using SetViewPort.
Declare GetViewSettings(*tviewport.ViewPortType)

; Returns the x-coordinate of the current position of the graphical pointer in pixels. It ranges between 0 And GetMaxX.
; It increases from left To right.
Declare.i GetXX()

; Returns the y-coordinate of the current position of the graphical pointer in pixels. It ranges between 0 And GetMaxY.
; It increases from top To bottom.
Declare.i GetYY()

; Sets the aspect ratio of the screen To the ratio given by xasp/yasp. It affects only routines For circular shapes. Does Not
; have a practical use other than backward compatibility With BP. Default values are (10000,10000). See also GetAspectRatio.
Declare SetAspectRatio(xasp,yasp.i)

; Sets the current output viewport To the rectangle defined by the top-left corner (x1,y1) And the bottom-right corner (x2,y2).
; If (clip) is true, anything drawn outside the viewport will be clipped (Not drawn). Coordinates specified after this call are
; relative To the top-left corner of the viewport. Cursor position is reset To (0,0). The following clipping constants are defined:
; ClipOn = #true
; ClipOff = #false
Declare SetViewPort(x1.l,y1.l,x2.l,y2.l, clip.l)  ; BOOLEAN

; It specifies what binary operation is performed when drawing on screen. Argument (writemode) has two components. First
; component is the foreground mix mode. It affects contours (including lines) And filled shapes (excluding Bar). Can be one of
; the following pre-defined constants:
; CopyMode - pixels are simply copied onto the screen
; XorMode - pixels are combination of the drawing color And screen color, but Not in both (logical XOr)
; OrMode - pixels are combination of the drawing color And screen color (logical Or)
; AndMode - pixels are combination of the colors common To both the drawing And screen (logical And)
; NotMode - pixels are the inverse of the drawing color (logical Not)
; NotScrMode - pixels are the inverse of the screen color
; NotXorMode - pixels are the inverse of the XorMode color
; NotOrMode - pixels are the inverse of the OrMode color
; NotAndMode - pixels are the inverse of the AndMode color
; InvColAndMode - pixels are combination of the colors common To both the screen And the inverse of drawing color
; InvColOrMode - pixels are combination of the screen color And the inverse of drawing color
; InvScrAndMode - pixels are combination of the colors common To both the drawing And the inverse of screen color
; InvScrOrMode - pixels are combination of the drawing color And the inverse of screen color
; BlackMode - pixels are always 0
; WhiteMode - pixels are always 1
; EmptyMode - screen pixels remain unchanged
; Second component is the background mix mode. It affects only texts. Can be one of the following two pre-defined constants:
; Transparent - screen remains untouched (As in BP graph unit)
; Opaque - screen is filled With the current background color before the text is drawn
; Argument (writemode) is an Or-ed combination of the foreground And background mix modes. By Default it equals CopyMode Or Transparent.
; SetWriteMode does Not perform well on palette-based drivers, especially If the palette was Not retrived by GetSystemPalette
; routine. Anyway, because the palette is just a logical one you must use UpdateGraph routine To assure that the screen has the
; same color composition As the active page.
; You can use InvertRect To perform logical Not operations over the screen content.
Declare SetWriteMode(writemode.l)

; color management exported routines

; Returns the current background color. This is a palette entry For palette-based drivers And an absolute RGB color For
; non-palette driver. Use SetBkColor To set a new color.
Declare.l GetBkColor()

; Returns the current drawing color. This is a palette entry For palette-based drivers And an absolute RGB color For
; non-palette driver. Use SetColor To set a new color.
Declare.l GetColor()

; Returns the highest color which can be set With SetColor Or other routines that accept colors. Depending on palette, this
; color is Not always White. All colors between 0 And GetMaxColor are guarantied To be valid.
; it equals FFFFFFH.
Declare.l GetMaxColor()

; Gets the pixel color of the point at position (x,y). This is a palette entry For palette-based drivers And an absolute RGB
; color For non-palette driver. To set a new color For the pixel use PutPixel.
Declare.l GetPixel(x.l,y.l)

; Returns the (Red,Green,Blue) intensity components of the color (color) in (r), (g), (b) variables. Their values range
; between 0 And 255. For example, Black returns (0,0,0). See also GetRGBColor. Parameter (color) is a palette index in
; palette-based drivers And a true RGB color For the non-palette driver.
Declare GetRGBComponents(color.l, *r.long,*g.long,*b.long, *t.long=#Null)

; Returns a maximum of 256 colors from Windows system palette. This is the palette initialized by the operating system at
; start-up. You have no guaranty that this palette is the same across all systems. In fact, it"s not.
;Declare GetSystemPalette(*palette.PaletteType)
; Sets the background color To (color). Check SetColor To learn about color values.
; The background color is the color used To clear portions of the screen (Or the entire viewport). It is also used As dual color
; in filling patterns. SetBkColor affects only subsequent drawings. Default color is Black.
Declare SetBkColor(color.l)

; Sets the foreground color To (color). For palette-based drivers the value of (color) is an index into the palette. For
; non-palette driver (color) stores a 24 bits RGB value encoded in hexadecimal form. The low-order byte contains a value For
; the relative intensity of red, the second byte contains a value For green And the third byte contains a value For blue
; (ex 0000FFH is Red). In both cases, pre-defined color names can be used instead of pure numbers. Consult InitGraph about graphics
; drivers And the section Alphabetical color names. See GetNamesPalette routine For more details on colors.
; The foreground color is the color used For drawing contours, lines And text. Other primitives have different ways To specify
; the color. Default color is White.
Declare SetColor(color.l)

; drawing primitives exported routines

; Draws part of a circle With center at (x,y), radius (radius), starting from angle (start), stopping at angle (stop).
; These angles are measured counter-clockwise. It uses current foreground color. To draw an entire circle use Circle.
Declare Arc(x.l,y.l, start.l,stop.l,radius.l)
; Draws a complete circle With center at (x,y) And radius (radius). To draw part of a circle use Arc.
; Circle is a particular Case of Ellipse.
Declare Circles(x.l,y.l, radius.l)
; Draws one Or more cubic Bezier curves, using the current foreground color. A Bezier curve is defined by two endpoints And
; two control points in between. A number of 3N+1 vertices will Define exactly N Bezier curves. The arguments are the same As in
; DrawPoly. It can be used To draw irregular curves, but a particular Case is a rotated ellipse. See RotEllipse For details.
Declare DrawBezier(nrpoints.i, Array *polypoints.PointType(1))
; Draws a polygon With (nrpoints) corner points, using the current foreground color And line style. Argument (polypoints)
; should be an Array of type PointType containing at least (nrpoints) records. No check is performed. The last corner point is
; Not drawn. It is usually faster that using several LineTo calls.
Declare DrawPoly(nrpoints.i, Array *polypoints.PointType(1))
; Draws part of an ellipse With center at (x,y). Arguments (xradius) And (yradius) are the horizontal And vertical radii of the
; ellipse, (start) And (stop) are the starting And stopping angles of the arc of the ellipse. They are measured counter-clockwise
; from the x-axis (3 o’clock is equal To 0 degrees). It uses current foreground color. To draw part of a circle use Arc.
; To draw a rotated ellipse use RotEllipse.
Declare Ellipses(x.l,y.l, start.l,stop.l,xradius.l,yradius.l)
Declare GetArcCoords(*arccoords.ArcCoordsType)
; Returns the current line settings in (lineinfo). That is, line style, pattern And thickness, As set by SetLineStyle.
Declare GetLineSettings(*lineinfo.LineSettingsType)
; Draws a line starting from (x1,y1) To (x2,y2), using the current foregroung color And line style. The current position is
; moved To (x2,y2). See LineTo For more details.
Declare Lines(x1.l,y1.l,x2.l,y2.l)
; Draws a line starting from the current pointer position To the Point (dx,dy), relative To the current position, using the
; current foreground color And line style. The current position is moved To the endpoint of the line. See LineTo For more details.
Declare LineRel(dx.l,dy.l)
; Draws a line starting from the current pointer position To the Point (x,y), using the current foregroung color And line style.
; The current position is moved To (x,y).
; Use SetLineStyle routine To set the line attributes And SetColor To set its color. Use MoveTo To change the current pointer
; position. To draw a line With absolute coordinates use Line routine instead.
Declare LineTo(x.l,y.l)
; Moves the pointer To coordinates (dx,dy), relative To the current pointer position. See MoveTo For more details.
Declare MoveRel(dx.l,dy.l)
; Moves the pointer To coordinates (x,y) which are viewport-relative. See SetViewPort For more details. Only the following
; routines use Or move the current pointer:
; ClearDevice
; ClearViewPort
; GraphDefaults
; Line
; LineRel
; LineTo
; MoveRel
; MoveTo
; OutText
; OutTextXY
; SetViewPort
; No check is made regarding coordinates range.
Declare MoveTo(x.l,y.l)
; Puts a point at position (x,y) using color (color). Check SetColor To learn about color values. Use GetPixel To retrive a
; pixel color.
Declare PutPixel(x.l,y.l, color.l)
; Draws a rectangle defined by the top-left corner (x1,y1) And the bottom-right corner (x2,y2). It uses the current foreground
; color And line style. To draw a filled rectangle use FillRect.
; Rectangle is a particular Case of DrawPoly.
Declare Rectangle(x1.l,y1.l,x2.l,y2.l)
; Draws a rotated ellipse With center at (x,y). Arguments (xradius) And (yradius) are the horizontal And vertical radii of the
; ellipse, (rot) defines the rotation angle measured counter-clockwise in degrees. It uses current foreground color. It is
; implemented using DrawBezier.
Declare RotEllipse(x.l,y.l,rot.i, xradius.i,yradius.i)
; Sets the drawing style For lines. The (linestyle) is one of the following constants:
; SolidLn - solid line
; DashedLn - dashed line
; DottedLn - dotted line
; DashDotLn - alternating dashes And dots line
; DashDotDotLn - dashes And double dots line
; UserBitLn - user defined line
; NullLn - invisible line
; If UserBitLn is specified then (pattern) should contain the 16-bit pattern. In all another cases (pattern) is ignored. The
; parameter (thickness) indicates how thick the line should be:
; NormWidth - one pixel width
; DoubleWidth - two pixels width
; TripleWidth - three pixels width
; QuadWidth - four pixels width
; ThickWidth=TripleWidth
; If (thickness) <> NormWidth then (linestyle) is ignored And the line is drawn solid, due To Windows GDI limitations.
; (thickness) is ignored For UserBitLn style because of missing implementation. Use SetColor To set the line color.
Declare SetLineStyle(linestyle.i,pattern.l,thickness.i)

; filled drawings exported routines

; Draws And fills a rectangle With opposite corners at (x1,y1) And (x2,y2), using the current fill style And color.
; This rectangle has no border. Use FillRect To draw a filled rectangle With border.
Declare Bar(x1.l,y1.l,x2.l,y2.l)
; Draws And fills a 3-dimensional bar With opposite corners of the front facet at (x1,y1) And (x2,y2). It uses the
; current foreground color. Only front facet is filled With the current fill style And color. Argument (depth) specifies
; the number of pixels used To show the depth of the bar. If (top) is true, then a 3-dimensional top is drawn.
; Its pre-defined values are
; TopOn = true
; TopOff = false
; Use Bar To draw a 2-dimensional bar.
Declare Bar3D(x1.l,y1.l,x2.l,y2.l, depth.l, top.l, col.l)  ; BOOLEAN
; Draws And fills a chord (a region bounded by the intersection of an ellipse And a line segment - called a secant).
; It uses the current foreground color And fill style. The arguments have the same meaning As in Ellipse. To draw a
; sector of an ellipse use Sector.
Declare Chord(x.l,y.l, start.i,stop.i,xradius.i,yradius.i)
; Draws And fills an entire ellipse With center at (x,y). Arguments (xradius) And (yradius) are the horizontal And vertical
; radii of the ellipse. It uses the current foreground color And fill style. To draw a sector of an ellipse use Sector.
Declare FillEllipse(x.l,y.l,xradius.i,yradius.i, col.l=-1)
; Draws And fills a polygon, using the current foreground color, line And fill style. The arguments are the same As in DrawPoly.
; The polygon is closed automatically by drawing a line from the last vertex To the first.
Declare FillPoly(nrpoints.i, Array *polypoints.PointType(1))
; Draws And fills a rectangle, using the current foreground color, line And fill style. The arguments are the same As in Rectangle.
; To draw a borderless rectangle use Bar instead.
; FillRect is a particular Case of FillPoly.
Declare FillRect(x1.l,y1.l,x2.l,y2.l, col.l=-1)
; Fills a region surrounding the Point (x,y) Until a color-condition is met. This condition depends on (color) And the flood mode.
; This mode is set With SetFloodMode routine.
; There are some reasons this routine might fail:
; (1) the filling could Not be completed (out of memory) - unlikely
; (2) the specified point has the boundary color specified by the (color)
; parameter (in BorderFlood mode)
; (3) the specified point does Not have the color specified by (color)
; parameter (in SurfaceFlood mode)
; (4) the point is outside the current viewport, that is, it is Not visible
; See SetFloodMode For details.
Declare FloodFill(x.l,y.l, color.l)
; Returns in (fillpattern) the current fill-pattern Array. This was set using SetFillPattern routine.
Declare GetFillPattern(Array *fillpatternn.byte(1))   ;FillPatternType
; Returns the current fill-settings in (fillinfo). This Structure contains the fill pattern And color, As set by SetFillStyle routine
Declare GetFillSettings(*fillinfo.FillSettingsType)
; Performs a logical Not operation on the color values For each pixel in the specified rectangle defined by coordinates (x1,y1,x2,y2).
; On monochrome driver, InvertRect makes white pixels black And black pixels white. On color drivers, the inversion depends on
; how colors are generated. Calling InvertRect twice For the same rectangle restores the display To its previous colors. It does
; Not perform well on palette-based drivers. See also SetWriteMode.
Declare InvertRect(x1.l,y1.l,x2.l,y2.l)
; Draws And fills a circular sector (a region bounded by the intersection of a circle And two radials - called pie slice).
; It uses the current foreground color And fill style. The arguments have the same meaning As in Arc. To draw an entire disk
; use FillEllipse.
; PieSlice is a particular Case of Sector
Declare PieSlice(x.l,y.l, start.i,stop.i,radius.l)
; Draws And fills a rectangle With rounded corners, using the current foreground color, fill style And color. The argument (r)
; is the radius of a circle used To draw the corners. The other parameters are the same As in Rectangle.
Declare RoundRect(x1.l,y1.l,x2.l,y2.l,r.l)
; Draws And fills an elliptical sector (a region bounded by the intersection of an ellipse And two radials). It uses the
; current foreground color And fill style. The arguments have the same meaning As in Ellipse. To draw a sector of a circle use PieSlice.
Declare Sector(x.l,y.l, start.i,stop.i,xradius.i,yradius.i)
; Selects a user-defined fill pattern which will be used in SetFillStyle routine With UserFill hatch set. The pattern is an 8x8
; raster, corresponding To the 64 bits in (fillpattern). Foreground pattern color is set To (color). Default is White. Background
; pattern color is the background color selected by SetBkColor. Check SetColor To learn more about colors.
; Before returning it calls SetFillStyle routine To put the pattern into effect.
Declare SetFillPattern(Array fillpattern.b(1), color.l)  ; FillPatternType
; Sets the filling pattern And color For filled drawings routines. Argument (pattern) can be one of the following constants:
; EmptyFill - background color hatch
; SolidFill - solid hatch
; LineFill - horizontal hatch
; ColFill - vertical hatch
; HatchFill - horizontal And vertical cross-hatch
; SlashFill - 45-degree upward, left-To-right hatch
; BkSlashFill - 45-degree downward, left-To-right hatch
; XHatchFill - 45-degree cross-hatch
; UserFill - user-defined hatch
; NoFill - no hatch
; If (pattern) equals UserFill, the user-defined pattern set by SetFillPattern becomes the active pattern. In this Case, the
; argument (color) is ignored. Parameter (color) is used To fill the shapes. Default is White. Check SetColor To learn about
; color values.
Declare SetFillStyle(pattern.l, color.l)
; Sets the mode in witch flood-fills are performed With FloodFill routine. Argument (floodmode) has the following pre-defined
; values:
; BorderFlood - the fill area is bounded by the color specified in FloodFill filling begins at the specified point and continues
; in all directions Until it reaches the color bounding the area this is the default.
; SurfaceFlood - the fill area is defined by the color that is specified in FloodFill filling begins at the specified point and
; continues in all directions over all adjacent regions containing the specified color this mode is useful for
; filling areas With multicolored boundaries
; See also FloodFill routine.
Declare SetFloodMode(floodmode.l)

; text And font handling exported routines

; Retrieves some information about the current selected font. First argument contains the full registered name of the font
; (ex. "Courier New"). It is the same name used by routine InstallUserFont when the font was installed. Variables (width) And
; (height) contain the maximum dimensions of the characters in the font. If you want To retrive the dimensions of specific
; characters use TextWidth And TextHeight routines. Boolean argument (ttfont) specify If the technology of this font is a
; TrueType one. If so, the text can be rotated on screen using SetTextStyle routine. Otherwise, it cannot be rotated.
Declare GetFontSettings(fontname.s, *width.integer, *height.integer, *ttfont.integer)    ; BOOLEAN
; Returns the current font And text settings in argument (textinfo). This contains the font type, direction, magnification,
; horizontal And vertical alignment, As set by SetTextStyle And SetTextJustify routines.
Declare GetTextSettings(*textinfo.TextSettingsType)
; Installs a new font And returns its index into the installed font table. This index can be used With SetTextStyle To enable
; the font For texts. The parameter (fontname) must be a valid family font name registered into the system (ex: " Fixedsys").
; The name IS Case sensitive. If the font cannot be registered, InstallUserFont will Return -1.
; InitGraph installs several fonts using this routine. Default font is set To "Courier New". Other installed fonts are listed in
; section Font constants For text. For more info about fonts see SetTextStyle.
Declare.i InstallUserFont(fontname.s)
; Puts (textstring) on the screen, at the current pointer position, using the current font And text settings. The current
; position is moved To the End of the text. Use SetTextStyle To change font style And SetTextJustify To change text alignment.
; To put text on an absolute location use OutTextXY instead.
Declare OutText(textstring.s, color.l = -1, bcol.l = -1)
; Puts (textstring) on the screen, at the coordinates (x,y), using the current font And text settings. The current position is
; moved To the End of the text. See OutText For more details.
Declare OutTextXY(x.l, y.l, textstring.s, color.l = -1, bcol.l = -1)
; It controls the placement of new text, relative To the cursor position. Argument (horiz) controls horizontal placement, And
; can be one of the following pre-defined constants:
; LeftText - text is set left of the pointer
; CenterText - text is set centered horizontally on the pointer
; RightText - text is set To the right of the pointer
; Argument (vert) controls the vertical placement of the text. Its value can be one of the following pre-defined constants:
; TopText - text is placed above the pointer
; BottomText - text is placed under the pointer
; BaselineText - text is placed relative To its base line
; Default text placement is LeftText And TopText.
Declare SetTextJustify(horiz.i,vert.i)
; It controls the style of text To be put on the screen. Pre-defined constants For (font) are:
; CourierNewFont - Courier New font
; MSSansSerifFont - MS Sans Serif font
; TimesNewRomanFont - Times New Roman font
; ArialFont - Arial font
; DefaultFont=CourierNewFont
; Besides, any successfully installed user font can be used insted. See InstallUserFont For details. All these fonts can be Or-ed
; With the following additional styles To change their appearance:
; ItalicFont - italic font
; UnderlineFont - underlined font
; BoldFont - bold font
; Argument (direction) sets the direction of text. It can be any positive value in degrees Or one of the following constants:
; HorizDir = 0
; VertDir = 90
; Between 1 And 5, (charsize) represents the magnification of the characters With a standard font size of 8 pixels. Above 6 it
; represents an absolute font size. Default is set To 16.
; Be aware that some fonts (including pre-defined) do Not support all these styles. See GetFontSettings routine For more details.
; Use SetColor To set text color.
Declare SetTextStyle(font.i,direction.l,charsize.l)
; First argument (nCharExtra) sets the intercharacter spacing in text And the second one (nBreakExtra) sets the amount of space
; reserved For Break character. The other ones are dummy arguments (Not used). This is a major incompatibility With BP graph unit.
; Default values are zero.
; See SetTextStyle For other text styles.
Declare SetUserCharSize(nCharExtra.i,nBreakExtra.i,dummy1.i,dummy2.i)
; Returns the height (in pixels) of the (textstring) in the current font style. This value might be altered by a call To
; SetTextStyle Or SetUserCharSize.
Declare.i TextHeights(textstring.s)
; Returns the width (in pixels) of the (textstring) in the current font style. This value might be altered by a call To
; SetTextStyle Or SetUserCharSize.
Declare.i TextWidths(textstring.s)

Declare THREEDto2DAll(*coords.ThreeDPointType, *pan.ThreeDPointType, *centre.ThreeDPointType, *position.ThreeDPointType, zoom.d, *sx.double, *sy.double)
Declare THREEDto2D(*coords.ThreeDPointType, zoom.d, *sx.double, *sy.double)
Declare DrawSymbol(x.l, y.l, color.l, symbol.l, width.l, height.l)

; caret format: block Or underline
Global CaretBlock.i = 1
; caret blink rate in tenths OF a second
Global BlinkRate.i = 2

Declare DrawCaret(nr.i)
Declare TextSettings()

#PLUS             = 1
#BOX              = 2
#CROSS_X_LIKE     = 3
#TRIANGLE         = 4
#INVERTEDTRIANGLE = 5
#OPENCIRCLE       = 6
#FILLEDCIRCLE     = 7
#DOT              = 8
Declare PlotSymbol(X.d,Y.d, Symbol.i, SymSize.i, color.i=-1)

#SNone  = 0
#SArrow = 1
#SBox   = 2
#SCircle= 3
#SLine  = 4
#SDLine = 5
#SDCross= 6
Declare LineCaped(x1.i, y1.i, x2.i, y2.i, left.i=#SNone, right.i=#SNone, colr.l=-1, coll.l=-1, filledl.i=#False, filledr.i=#False)

Declare IsClipping() ; returns #true/#false

; get handles to the outside
Declare.i GetDC()
Declare.i GetHWND()
; Retains the content of the windows
Declare   ReSetWindowSize(width.l,height.l)
; Places a copy of the screen area given by rectangle With coordinates (x1,y1,x2,y2) in the
; variable (bitmap). This variable must have enough room To accomodate the image (use ImageSize
; To get the exact size). Afterwards the image can be put back on screen using PutImage.
; The format of bitmap is hardcoded To 24 bits per pixel, so it is driver independent. In fact
; (bitmap) will contain the complete Structure of a BMP image And can be saved on disk And loaded
; into your favourite image viewer.
Declare   GetImage(x1.i,y1.i,x2.i,y2.i,*bitmap.BGIimage)
; Places the image from (bitmap) on the screen at (x1,y1). Argument (bit) determines how the bitmap will be placed. Pre-defined
; values are:
;   CopyPut  - copies the bitmap directly To the screen
;   XorPut   - combines the colors of the bitmap And the screen by using the logical XOr operator
;   OrPut    - combines the colors of the bitmap And the screen by using the logical Or operator
;   AndPut   - combines the colors of the bitmap And the screen by using the logical And operator
;   NotPut   - copies the inverted bitmap To the screen
;   NotOrPut - combines the colors of the bitmap And the screen by using the logical Or operator
;              and then inverts the resultant color
;   InvBitOrPut  - combines the colors of the inverted bitmap With the colors of the screen by
;                  using the logical Or operator
;   InvScrAndPut - combines the inverted colors of the screen With the colors of the bitmap by
;                  using the logical And operator
;   NormalPut = CopyPut
; With PutImage you can put on screen any external BMP image having 32 bits format.
Declare   PutImage(x1.i,y1.i, *bitmap.BGIimage,rop.i=#SRCAND)

;Sets the visual page To be displayed onto the graphics window. For more info see 
;SetActivePage routine. UpdateGraph uses this routine To force screen refreshes.
;Declare SetVisualPage(page.i)

;Sets the active page where all drawings are performed. If different than visual page, 
;these drawings do Not appear on screen.
;Declare SetActivePage(page.i)

EndDeclareModule

Code: Select all

Module MINIBGI
EnableExplicit

CompilerIf #PB_Compiler_Unicode = #True
  Import "gdi32.lib"
    LineDDA(x1, y1, x2, y2, *callback, lParam)
  EndImport
CompilerElse
  Macro LineDDA
    LineDD_
  EndMacro
CompilerEndIf


#NrVideoPages = 4
#Rad = #PI/180.0
#NrMaxFonts = 25
#MinCharSize = 2

Global.i screenWidth,screenHeight, hWnd, defAspectRatio, windownumber
Global.i customWidth,customHeight, windowWidth,windowHeight, NrDefFonts = 4
Global.l windowStyle,maxX,maxY,origX,origY,actX,actY,aspX,aspY
Global.l grPen, grBrush, grFont, grPattern,frcolor,bkcolor,visual_page=0
Global.l viewPortWidth,viewPortHeight,floodMode, globalTemp,active_page=0
Global.s grTitle = "NONAME"
Global   Dim instFont.s(#NrMaxFonts-1)
Global   *grClip.long = #Null
Global   lineSettings.LineSettingsType
Global   fillSettings.FillSettingsType
Global   textSettings.TextSettingsType
Global   Dim fillPattern.b(8)
Global   viewPort.ViewPortType
Global   lastArcCoords.ArcCoordsType
Global   ps.paintstruct
Global.l Dim hWDC(1), memDC


Procedure SwapRGB(Color)
  ProcedureReturn ((Color & $FF) << 16) | (Color & $FF00) | ((Color & $FF0000) >> 16)
EndProcedure

;- Macros

Macro VISPAGE_NOT_EQU_ACT(action)
  If visual_page <> active_page 
			action
  EndIf
EndMacro

Macro VISPAGE_EQU_ACT(action)
  If visual_page = active_page
			action
  EndIf
EndMacro

Macro RGB(Red, Green, Blue)
  (((Blue << 8 + Green) << 8 ) + Red )
EndMacro

Macro FastRed(Color)
  Color & 255
EndMacro

Macro FastGreen(Color)
  (Color & 65535) >> 8
EndMacro

Macro FastBlue(Color)
  (Color & 16777215) >> 16
EndMacro

Procedure.b LOBYTE(w.w)
    ProcedureReturn w & $0FF
EndProcedure
 
Procedure.b HIBYTE(w.w)
    ProcedureReturn (w >> 8) & $0FF
EndProcedure
 
Procedure.w LOWORD(l.l)
    ProcedureReturn l & $0FFFF
EndProcedure
 
Procedure.w HIWORD(l.l)
    ProcedureReturn (l >> 16) & $0FFFF
EndProcedure
 
Procedure.i EnumFontFamProc(*lpelf.LOGFONT, *lpntm.NEWTEXTMETRIC, FontType.l, param.i) ;:LPARAM
  globalTemp = 1   ; we got here IF at least one font from the family font exists
  ProcedureReturn 0
EndProcedure

#NrDefFonts = 4
Procedure InstallDefaultFonts()
  Protected Dim DefaultFont.s(#NrDefFonts-1)
  Protected i.i
  DefaultFont(0) = "Courier New"
  DefaultFont(1) = "MS Sans Serif"
  DefaultFont(2) = "Times New Roman"
  DefaultFont(3) = "Arial"
  For i = 0 To #NrMaxFonts-1
    instFont(i) = ""
  Next
  For i=0 To #NrDefFonts-1
    InstallUserFont(DefaultFont(i))
  Next
EndProcedure

;initialization routines

Procedure.i GetDC()
   ProcedureReturn hWDC(0)
EndProcedure

Procedure.i GetHWND()
   ProcedureReturn hWnd
EndProcedure

Procedure MakeBitMap(*bitmap.BITMAPINFO, window_DC.i)
  Protected bmii.BITMAPINFO
  Protected *pbits
  bmii\bmiHeader\biSize = SizeOf(BITMAPINFO)
  bmii\bmiHeader\biWidth = screenWidth
  bmii\bmiHeader\biHeight =  -screenHeight  ; Order pixels from top to bottom
  bmii\bmiHeader\biPlanes = 1
  bmii\bmiHeader\biBitCount = 32  ; last byte not used, 32 bit for alignment
  bmii\bmiHeader\biCompression = #BI_RGB
  bmii\bmiHeader\biSizeImage = 0
  bmii\bmiHeader\biXPelsPerMeter = 0
  bmii\bmiHeader\biYPelsPerMeter = 0
  bmii\bmiHeader\biClrUsed = 0
  bmii\bmiHeader\biClrImportant = 0
  bmii\bmiColors[0]\rgbBlue = 0
  bmii\bmiColors[0]\rgbGreen = 0
  bmii\bmiColors[0]\rgbRed = 0
  bmii\bmiColors[0]\rgbReserved = 0
  ; Create DIB section To always give direct access To pixels 
  *bitmap = CreateDIBSection_(window_DC, bmii, #DIB_RGB_COLORS, @*pbits, #Null, 0)
EndProcedure

Procedure MainCallback(hWnd, uMsg, wParam, lParam)
  Protected Result = #PB_ProcessPureBasicEvents
  Protected grRect.RECT

   Select uMsg               
     Case #WM_PAINT
        If GetUpdateRect_(hWnd,grRect, #False)
          If *grClip <> #Null
            SelectClipRgn_(hWnd,#Null)
          EndIf
          BeginPaint_(hWnd,@ps)
            BitBlt_(hWDC(0),grRect\left,grRect\top,grRect\right-grRect\left+1,grRect\bottom-grRect\top+1,memDC,grRect\left,grRect\top, #SRCCOPY)
          EndPaint_(hWnd,@ps)
          If *grClip <> #Null
            SelectClipRgn_(hWDC(0), *grClip)
          EndIf
        EndIf
        ProcedureReturn 0
    Case #WM_DESTROY
      DeleteObject_(grPattern)
      DeleteObject_(grPen)
      DeleteObject_(grBrush)
      DeleteObject_(grFont)
      SetViewPort(0,0,maxX,maxY,#ClipOff)
      DeleteDC_(memDC)
      DeleteDC_(hWDC(0))
    Case #WM_ERASEBKGND
      ProcedureReturn 1
   EndSelect   
   ProcedureReturn Result
EndProcedure

Procedure.i InitGraph(WinX.l, WinY.l, title.s, Color.i=#Black, BackColor.i=#White)
  Protected grRect.RECT, ret.i
  Protected Event.l
  windownumber = OpenWindow(#PB_Any, 0, 0, WinX, WinY, title, #PB_Window_NoGadgets|#PB_Window_SystemMenu)
  If Not windownumber
    ProcedureReturn -1
  EndIf
  hWnd   = WindowID(windownumber)
  GetClientRect_(hWnd, grRect)
  maxX        = grRect\right-1
  maxY        = grRect\bottom-1
  screenWidth = WinX
  screenHeight= WinY
  SetWindowCallback(@MainCallback(), windownumber)
  hWDC(0)   = GetDC_(hWnd)
  hWDC(1)   = CreateCompatibleDC_(hWDC(0))
  memDC     = CreateCompatibleDC_(#Null)
  SelectObject_(hWDC(0),memDC)
  SetColor(Color)
  SetBkColor(BackColor)
  InstallDefaultFonts()
  lineSettings\linestyle = #SolidLn
  lineSettings\pattern = 0
  lineSettings\thickness = #NormWidth
  FillMemory(@fillPattern(0), 8, $FF)
  SetFillPattern(fillPattern(),#White)
  SetFillStyle(#SolidFill,#White)
  SetTextStyle(#DefaultFont,#HorizDir,16)
  SetTextJustify(#LeftText,#TopText)
  SetUserCharSize(0,0,0,0)
  SetViewPort(0,0,maxX,maxY,#ClipOff)
  SetWriteMode(#CopyMode | #TRANSPARENT_)
  defAspectRatio = SetAspectRatio(10000,10000)
  floodMode = #BorderFlood
  If title <> ""
    grTitle = title
  EndIf
  ShowWindow_(hWnd,#SW_SHOWNORMAL)
  SetViewPort(0, 0, maxX, maxY, #ClipOff)
  ClearViewPort()
  If title <> ""
    grTitle = title
  EndIf
  SetWindowTitle(windownumber, grTitle)
  SetForegroundWindow_(hWnd)
  SetActiveWindow(windownumber)
  PostEvent(#PB_Event_CloseWindow)
  Repeat
    Event = WaitWindowEvent()
    Repeat
      Event = WaitWindowEvent()
      Select Event
;         Case #PB_Event_Repaint
;           StartDrawing(WindowOutput(windownumber))
;             DrawImage(ImageID(imagenumber), WinX, WinY)
;           StopDrawing()   
        Case #PB_Event_CloseWindow
          ret = #False
      EndSelect
    Until Event = #PB_Event_CloseWindow
  Until ret = #False
  ProcedureReturn windownumber
EndProcedure

Procedure CloseGraph()
  DeleteObject_(grPattern)
  DeleteObject_(grPen)
  SetViewPort(0,0,maxX,maxY,#ClipOff)
EndProcedure

Procedure GetImage(x1.i,y1.i,x2.i,y2.i,*bmp.BITMAP)
  Protected.i hdcMemDC, hbmScreen
  Protected bih.BITMAPINFOHEADER
  hdcMemDC = CreateCompatibleDC_(hWDC(0))
  hbmScreen = CreateCompatibleBitmap_(hWDC(0), x2-x1+1, y2-y1+1)
  SelectObject_(hdcMemDC, hbmScreen)
  BitBlt_(hdcMemDC, 0, 0, x2-x1+1, y2-y1+1, hWDC(0), x1, y1, #SRCCOPY|#CAPTUREBLT)
  GetObject_(hbmScreen, SizeOf(BITMAP), *bmp)
  bih\biSize = SizeOf(BITMAPINFOHEADER)
  bih\biHeight = *bmp\bmHeight
  bih\biWidth = *bmp\bmWidth
  bih\biPlanes = 1
  bih\biBitCount = *bmp\bmBitsPixel
  bih\biCompression = #BI_RGB
  bih\biSizeImage = 0
  bih\biXPelsPerMeter = 0
  bih\biYPelsPerMeter = 0
  bih\biClrUsed = 0
  bih\biClrImportant = 0
  *bmp\bmBits = AllocateMemory(*bmp\bmWidth * *bmp\bmHeight * ((*bmp\bmBitsPixel + 7) / 8))
  GetDIBits_(hWDC(0), hbmScreen, 0, *bmp\bmHeight, *bmp\bmBits, @bih, #DIB_RGB_COLORS)
  GdiFlush_()
  DeleteObject_(hbmScreen)
  DeleteObject_(hdcMemDC)
EndProcedure

;   #CopyMode =  0
;   #XorMode  =  1
;   #OrMode   =  2
;   #AndMode  =  3
;   #NotMode  =  4
;   #NotScrMode =  5
;   #NotXorMode =  6
;   #NotOrMode  =  7
;   #NotAndMode =  8
;   #InvColAndMode =  9
;   #InvColOrMode  = 10
;   #InvScrAndMode = 11
;   #InvScrOrMode  = 12
;   #BlackMode = 13
;   #WhiteMode = 14
;   #EmptyMode = 15
;   #TRANSPARENT_ = $00
;   #OPAQUE_    = 16

Procedure PutImage(x1.i,y1.i,*bmp.BITMAP,rop.i=#SRCAND)
  Protected.i hdcMemDC,rop1
  Protected bih.BITMAPINFOHEADER
  Protected *hBitMap.BITMAP
  Protected *ppvBits
  Select rop
    Case #CopyMode      : rop1 = #SRCCOPY       
    Case #XorMode       : rop1 = #SRCPAINT      
    Case #OrMode        : rop1 = #SRCAND        
    Case #AndMode       : rop1 = #SRCINVERT     
    Case #NotMode       : rop1 = #SRCERASE      
    Case #NotScrMode    : rop1 = #NOTSRCCOPY    
    Case #NotXorMode    : rop1 = #NOTSRCERASE   
    Case #NotOrMode     : rop1 = #MERGECOPY     
    Case #NotAndMode    : rop1 = #MERGEPAINT    
    Case #InvColAndMode : rop1 = #PATCOPY       
    Case #InvColOrMode  : rop1 = #PATPAINT      
    Case #InvScrAndMode : rop1 = #PATINVERT     
    Case #InvScrOrMode  : rop1 = #DSTINVERT     
    Case #BlackMode     : rop1 = #BLACKNESS     
    Case #WhiteMode     : rop1 = #WHITENESS     
    Case #EmptyMode     : rop1 = #NOMIRRORBITMAP
    Default
      ProcedureReturn
  EndSelect
  hdcMemDC = CreateCompatibleDC_(hWDC(0))
  bih\biSize = SizeOf(BITMAPINFOHEADER)
  bih\biHeight = *bmp\bmHeight
  bih\biWidth = *bmp\bmWidth
  bih\biPlanes = 1
  bih\biBitCount = *bmp\bmBitsPixel
  bih\biCompression = #BI_RGB
  bih\biSizeImage = 0
  bih\biXPelsPerMeter = 0
  bih\biYPelsPerMeter = 0
  bih\biClrUsed = 0
  bih\biClrImportant = 0
  *hBitMap = CreateDIBSection_(hdcMemDC, @bih, #DIB_RGB_COLORS, @*ppvBits, #Null, 0)
  CopyMemory(*bmp\bmBits, *ppvBits, MemorySize(*bmp\bmBits))
  SelectObject_(hdcMemDC, *hBitMap)
  BitBlt_(hWDC(0), x1, y1, *bmp\bmWidth, *bmp\bmHeight, hdcMemDC, 0, 0, rop1|#CAPTUREBLT)
  GdiFlush_()
  DeleteObject_(*hBitMap)
  DeleteObject_(hdcMemDC)
EndProcedure

Procedure GetMemImage(x1.i,y1.i,x2.i,y2.i,*bitmap.BGIimage)
  Protected.i targetDC = CreateCompatibleDC_(hWDC(0))
  *bitmap\width  = x2-x1+1
  *bitmap\height = (y2-y1+1) ; Otherwise colors in the buffer will be backwards, "bottom-up" which we don't want
  *bitmap\bits = CreateCompatibleBitmap_(hWDC(0), x2-x1+1, (y2-y1+1))
  SelectObject_(targetDC, *bitmap\bits)
  BitBlt_(targetDC, x1, y1, x2-x1+1, (y2-y1+1), hWDC(0), x1, y1, #SRCCOPY|#CAPTUREBLT)
  GdiFlush_()
  DeleteDC_(targetDC)
  ReleaseDC_(*bitmap\bits, hWDC(0))
EndProcedure

Procedure PutMemImage(x1.i,y1.i,*bitmap.BGIimage, rop.i=#SRCAND)
  Protected.i tempDC
  tempDC = CreateCompatibleDC_(hWDC(0))
  SelectObject_(tempDC, @*bitmap\bits)
  BitBlt_(hWDC(0), x1, y1, *bitmap\width, *bitmap\height, tempDC, 0, 0, rop|#CAPTUREBLT)
  GdiFlush_()
  DeleteDC_(tempDC)
  ;ReleaseDC_(*bitmap\bits, hWDC(0))
EndProcedure

Procedure ReSetWindowSize(width.l,height.l)
  Protected grRect.RECT, screenWidthOld.i, screenHeightOld.i, *bminew.BITMAPINFO
  Protected bitmap.BGIimage, *oldBitmap.BITMAPINFO
  screenWidthOld = screenWidth
  screenHeightOld = screenHeight
  screenWidth = width
  screenHeight = height
  GetMemImage(0,0,maxX,maxY,@bitmap)
  ;SetWindowPos_(hWnd,0,0,0,width,height,#SWP_NOMOVE|#SWP_NOZORDER|#SWP_NOACTIVATE);
  ResizeWindow(windownumber, 0, 0, width, height)
  SetWindowColor(windownumber, #White)
  GetClientRect_(hWnd, grRect)
  maxX       = grRect\right-1
  maxY       = grRect\bottom-1
  DeleteDC_(memDC)
  DeleteDC_(hWDC(0))
  hWDC(0)      = GetDC_(hWnd)
  memDC     = CreateCompatibleDC_(#Null)
  *oldBitmap = GetCurrentObject_(memDC, #OBJ_BITMAP)
  SelectObject_(hWDC(0),memDC)
  MakeBitMap(*bminew, hWDC(0))
  SetBkColor_(hWDC(0),#White)
  BitBlt_(*bminew,grRect\left,grRect\top,grRect\right-grRect\left+1,grRect\bottom-grRect\top+1,hWDC(0),grRect\left,grRect\top,#SRCCOPY)
  ClearDevice() 
  GdiFlush_()
  DeleteObject_(*bminew)
  ShowWindow_(hWnd,#SW_SHOWNORMAL)
  PutMemImage(0,0, @bitmap)
  SetViewPort(0, 0, maxX, maxY, #ClipOff)
  SetActiveWindow(windownumber)
EndProcedure

; screen management routines

Procedure ClearDevice()
  Protected old_ViewPort.ViewPortType
  old_ViewPort = viewPort
  SetViewPort(0, 0, maxX, maxY, #ClipOff)
  ClearViewPort()
  With old_ViewPort
    SetViewPort(\x1,\y1,\x2,\y2, \clip)
  EndWith
  GdiFlush_()
EndProcedure

Procedure ClearDeviceWithColor(color.l)
  Protected.l bcol = GetBkColor()
  SetBkColor(color)
  ClearDevice()
  SetBkColor(bcol)
EndProcedure

Procedure ClearViewPortWithColor(color.l)
  Protected.l bcol = GetBkColor()
  SetBkColor(color)
  ClearViewPort()
  SetBkColor(bcol)
EndProcedure

Procedure ClearViewPort()
  Protected old_FillSettings.FillSettingsType
  MoveTo(0,0)
  old_FillSettings = fillSettings
  SetFillStyle(#SolidFill, bkcolor)
  Bar(0,0,viewPortWidth,viewPortHeight)
  With old_FillSettings
    SetFillStyle(\pattern, \color)
  EndWith
  GdiFlush_()
EndProcedure

Procedure GetAspectRatio(*xasp.integer,*yasp.integer)
  *xasp = aspX
  *yasp = aspY
EndProcedure

Procedure.i GetMaxX()
  ProcedureReturn maxX
EndProcedure

Procedure.i GetMaxY()
  ProcedureReturn maxY
EndProcedure

Procedure GetViewSettings(*tviewport.ViewPortType)
  *tviewport  =  viewPort
EndProcedure

Procedure.i GetXX()
  ProcedureReturn actX
EndProcedure

Procedure.i GetYY()
  ProcedureReturn actY
EndProcedure

Procedure SetAspectRatio(xasp.i,yasp.i)
  aspX = xasp
  aspY = yasp
  defAspectRatio = Bool(Bool(xasp = 10000) And Bool(yasp = 10000))
EndProcedure

Procedure IsClipping()
  If *grClip <> #Null
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetViewPort(x1.l,y1.l,x2.l,y2.l, clip.l)  ;BOOLEAN
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  viewPort\x1 = x1
  viewPort\y1 = y1
  viewPort\x2 = x2
  viewPort\y2 = y2
  viewPort\clip = clip
  viewPortWidth = x2-x1
  viewPortHeight = y2-y1
  origX = x1
  origY = y1
  ; MoveTo(x1,y1) ; MoveTo(0,0)
  If *grClip <> #Null
    SelectClipRgn_(hWDC(0),#Null)
    DeleteObject_(*grClip)
    *grClip = #Null
  EndIf
  If clip = #True
    *grClip = CreateRectRgn_(x1,y1,x2+1,y2+1)
    SelectClipRgn_(hWDC(0), *grClip)
    MoveTo(x1,y1)
  Else
    MoveTo(0,0)
  EndIf
EndProcedure

Procedure SetWriteMode(writemode.l)
  Protected.l fnDrawMode,iBkMode
  fnDrawMode = writemode % $10
  iBkMode = (writemode / $10) << 4
  Select fnDrawMode
    Case #CopyMode     : fnDrawMode = #R2_COPYPEN
    Case #XorMode      : fnDrawMode = #R2_XORPEN
    Case #OrMode       : fnDrawMode = #R2_MERGEPEN
    Case #AndMode      : fnDrawMode = #R2_MASKPEN
    Case #NotMode      : fnDrawMode = #R2_NOTCOPYPEN
    Case #NotScrMode   : fnDrawMode = #R2_NOT
    Case #NotXorMode   : fnDrawMode = #R2_NOTXORPEN
    Case #NotOrMode    : fnDrawMode = #R2_NOTMERGEPEN
    Case #NotAndMode   : fnDrawMode = #R2_NOTMASKPEN
    Case #InvColAndMode: fnDrawMode = #R2_MASKNOTPEN
    Case #InvColOrMode : fnDrawMode = #R2_MERGENOTPEN
    Case #InvScrAndMode: fnDrawMode = #R2_MASKPENNOT
    Case #InvScrOrMode : fnDrawMode = #R2_MERGEPENNOT
    Case #BlackMode    : fnDrawMode = #R2_BLACK
    Case #WhiteMode    : fnDrawMode = #R2_WHITE
    Case #EmptyMode    : fnDrawMode = #R2_NOP
  Default
    ProcedureReturn
  EndSelect
  Select iBkMode
    Case #TRANSPARENT_: iBkMode = #TRANSPARENT
    Case #OPAQUE_     : iBkMode = #OPAQUE
  Default
    ProcedureReturn
  EndSelect
  SetROP2_(hWDC(0),fnDrawMode)
  SetBkMode_(hWDC(0),iBkMode)
  GdiFlush_()
EndProcedure

; color management routines

Procedure.l GetBkColor()
  ProcedureReturn bkcolor
EndProcedure

Procedure.l GetColor()
  ProcedureReturn frcolor
EndProcedure

Procedure.l GetMaxColor()
  ProcedureReturn $0FFFFFF
EndProcedure

Procedure.l GetPixel(x.l,y.l)
  Protected Result.i
  Result = GetPixel_(hWDC(0),x+origX,y+origY)
  GdiFlush_()
  ProcedureReturn Result
EndProcedure

Procedure GetRGBComponents(color.l, *r.long,*g.long,*b.long, *t.long=#Null)
  Protected pe.PALETTEENTRY
  *r = Red(color)
  *g = Green(color)
  *b = Blue(color)
EndProcedure

Procedure SetBkColor(color.l)
  bkcolor = color
  SetBkColor_(hWDC(0), color)
  GdiFlush_()
EndProcedure

Procedure SetColor(color.l)
  frcolor = color
  SetTextColor_(hWDC(0), color)
  GdiFlush_()
  SetLineStyle(lineSettings\linestyle, lineSettings\pattern, lineSettings\thickness)
EndProcedure

; drawing primitives routines

Procedure Arc(x.l,y.l, start.l,stop.l,radius.l)
  Ellipses(x,y,start,stop,radius,radius)
EndProcedure

Procedure Circles(x.l,y.l, radius.l)
  Ellipses(x,y,0,360,radius,radius)
EndProcedure

Procedure DrawBezier(nrpoints.i, Array *polypoints.PointType(1))
  Protected.i size,i
  If nrpoints >= 4
    PolyBezier_(hWDC(0), *polypoints(), nrpoints)
  EndIf
  GdiFlush_()
EndProcedure

Procedure DrawPoly(nrpoints.i, Array *polypoints.PointType(1))
  Protected.i size,i
  If nrpoints < 2
    ProcedureReturn
  EndIf
  Polyline_(hWDC(0),*polypoints(),nrpoints)
  GdiFlush_()
EndProcedure

Procedure Ellipses(x.l, y.l, start.l,stop.l,xradius.l,yradius.l)
  Protected.i nXStartArc,nYStartArc,nXEndArc,nYEndArc
  lastArcCoords\x = x
  lastArcCoords\y = y
  INC(x,origX)
  INC(y,origY)
  nXStartArc = Round(xradius * Cos(start*#Rad), #PB_Round_Nearest)
  nXEndArc   = Round(xradius * Cos(stop*#Rad), #PB_Round_Nearest)
  nYStartArc = Round(yradius * Sin(start*#Rad), #PB_Round_Nearest)
  nYEndArc   = Round(yradius * Sin(stop*#Rad), #PB_Round_Nearest)
  If defAspectRatio = 0
    xradius = Int(10000*xradius) / aspX;
    yradius = Int(10000*yradius) / aspY
  EndIf
  Arc_(hWDC(0),x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1,x+nXStartArc,y-nYStartArc,x+nXEndArc,y-nYEndArc)
  With lastArcCoords
    \xstart = \x+nXStartArc
    \ystart = \y-nYStartArc
    \xend   = \x+nXEndArc
    \yend   = \y-nYEndArc     
  EndWith
  GdiFlush_()
EndProcedure

Procedure GetArcCoords(*arccoords.ArcCoordsType)
  CopyStructure(@lastArcCoords, *arccoords, ArcCoordsType)
EndProcedure

Procedure GetLineSettings(*lineinfo.LineSettingsType)
  CopyStructure(@lineSettings, *lineinfo, LineSettingsType)
EndProcedure

Procedure CalcAnglePoint(x1.d, y1.d, distance.d, angle.d, *endX.double, *endY.double)
  Protected.d ang = angle ;* (4/180)
  *endX\d = x1 + distance * Sin(ang)
  *endY\d = y1 + distance * Cos(ang)
EndProcedure

Procedure LineCaped(x1.i, y1.i, x2.i, y2.i, left.i=#SNone, right.i=#SNone, colr.l=-1, coll.l=-1, filledl.i=#False, filledr.i=#False)
  Protected Dim polypoints.PointType(6)
  Protected fillinfo.FillSettingsType
  Protected.d rx, ry, dist
  Protected.l ccol
  Protected.d angle, xx, yy
  Protected.d xx1, yy1, xx2, yy2
  Protected.d xx3, yy3, xx4, yy4
  Protected.d xx5, yy5, xx6, yy6
  If (x1=x2) And (y1=y2)
    ProcedureReturn
  EndIf
  MoveTo(x1,y1)
  LineTo(x2,y2)
  rx=((x1-x2)*50) / (x1 + (x2 - x1))
  ry=((y1-y2)*50) / (y1 + (y2 - y1))
  dist = Pow(((x2+(rx-(ry * 0.5))*(1/3)) - (x2+(rx+(ry * 0.5))*(1/3))), 2)
  dist + Pow((y2+((rx * 0.5)+ry)*(1/3)) - (y2+(-(rx * 0.5)+ry)*(1/3)), 2)
  dist = Round(Sqr(dist), #PB_Round_Nearest) / 2
  angle=ATan2(y2 - y1, x2 - x1) ; * (180 / 3.14) ;4 = pi
  If (x1=x2) And (y1=y2)
    ProcedureReturn
  EndIf
  If right <> #SNone
    Select right
      Case #SArrow
        GetFillSettings(@fillinfo)
        CalcAnglePoint(x2, y2, -dist, angle, @xx, @yy)
        CalcAnglePoint(x2, y2-dist, -dist, angle, @xx1, @yy1)
        CalcAnglePoint(x2-1, y2+dist, -dist, angle, @xx2, @yy2)
        polypoints(0)\x = xx1
        polypoints(0)\y = yy1
        polypoints(1)\x = xx2
        polypoints(1)\y = yy2
        polypoints(2)\x = x2
        polypoints(2)\y = y2
        polypoints(3)\x = xx1
        polypoints(3)\y = yy1
        If colr <> -1
          SetFillStyle(#SolidFill, colr)
        Else
          SetFillStyle(#SolidFill, frColor)
        EndIf
        If filledr
          FillPoly(4, polypoints())
        Else
          DrawPoly(4, polypoints())
        EndIf
      Case #SBox
        CalcAnglePoint(x2, y2, -dist, angle, @xx, @yy)
        CalcAnglePoint(xx, yy-dist, 0, angle, @xx1, @yy1)
        CalcAnglePoint(xx, yy+dist, 0, angle, @xx2, @yy2)
        CalcAnglePoint(x2, y2-dist, 0, angle, @xx3, @yy3)
        CalcAnglePoint(x2, y2+dist, 0, angle, @xx4, @yy4)       
        polypoints(0)\x = xx1
        polypoints(0)\y = yy1
        polypoints(1)\x = xx2
        polypoints(1)\y = yy2
        polypoints(2)\x = xx2
        polypoints(2)\y = yy2
        polypoints(3)\x = xx4
        polypoints(3)\y = yy4
        polypoints(4)\x = xx3
        polypoints(4)\y = yy3
        polypoints(5)\x = xx1
        polypoints(5)\y = yy1
        GetFillSettings(@fillinfo)
        If colr <> -1
          SetFillStyle(#SolidFill, colr)
        Else
          SetFillStyle(#SolidFill, frColor)
        EndIf
        If filledr
          FillPoly(6, polypoints())
        Else
          DrawPoly(6, polypoints())
        EndIf
      Case #SCircle
        CalcAnglePoint(x2, y2, -dist, angle, @xx, @yy)
        GetFillSettings(@fillinfo)
        If colr <> -1
          SetFillStyle(#SolidFill, colr)
        Else
          SetFillStyle(#SolidFill, frColor)
        EndIf
        If filledr
          FillPoly(6, polypoints())
          If colr <> -1
            FillEllipse(xx,yy,dist,dist,colr)
          Else
            FillEllipse(xx,yy,dist,dist,frColor)
          EndIf         
        Else
          PlotSymbol(xx, yy, 6, dist)
        EndIf
      Case #SLine
        GetFillSettings(@fillinfo)
        CalcAnglePoint(x2, y2-dist, 0, angle, @xx1, @yy1)
        CalcAnglePoint(x2, y2+dist, 0, angle, @xx2, @yy2)
        If colr <> -1
          ccol = GetColor()
          SetColor(colr)
        EndIf         
        MoveTo(xx1, yy1)
        LineTo(xx2, yy2)         
        If colr <> -1
          SetColor(ccol)
        EndIf         
      Case #SDLine
        If colr <> -1
          ccol = GetColor()
          SetColor(colr)
        EndIf         
        GetFillSettings(@fillinfo)
        CalcAnglePoint(x2, y2-dist, 0, angle, @xx1, @yy1)
        CalcAnglePoint(x2, y2+dist, 0, angle, @xx2, @yy2)
        CalcAnglePoint(x2, y2, -1, angle, @xx, @yy)
        CalcAnglePoint(xx, yy-dist, 0, angle, @xx3, @yy3)
        CalcAnglePoint(xx, yy+dist, 0, angle, @xx4, @yy4)
        MoveTo(xx1, yy1)
        LineTo(xx2, yy2)         
        MoveTo(xx3, yy3)
        LineTo(xx4, yy4)
        If colr <> -1
          SetColor(ccol)
        EndIf
      Case #SDCross
        If colr <> -1
          ccol = GetColor()
          SetColor(colr)
        EndIf         
        GetFillSettings(@fillinfo)
        CalcAnglePoint(x2, y2-dist, 0, angle, @xx1, @yy1)
        CalcAnglePoint(x2, y2+dist, 0, angle, @xx2, @yy2)
        CalcAnglePoint(x2, y2, -1, angle, @xx, @yy)
        CalcAnglePoint(xx, yy-dist, 0, angle, @xx3, @yy3)
        CalcAnglePoint(xx, yy+dist, 0, angle, @xx4, @yy4)
        MoveTo(x2-dist,y2-dist)
        LineRel(2*dist,2*dist)
        MoveRel(-2*dist,0)
        LineRel(2*dist,-2*dist)
        If colr <> -1
          SetColor(ccol)
        EndIf
    EndSelect
  EndIf

  If left <> #SNone
    Swap x1,x2 : Swap y1,y2
    Select left
      Case #SArrow
        GetFillSettings(@fillinfo)
        CalcAnglePoint(x2, y2, dist, angle, @xx, @yy)
        CalcAnglePoint(x2, y2-dist, dist, angle, @xx1, @yy1)
        CalcAnglePoint(x2-1, y2+dist, dist, angle, @xx2, @yy2)
        polypoints(0)\x = xx1
        polypoints(0)\y = yy1
        polypoints(1)\x = xx2
        polypoints(1)\y = yy2
        polypoints(2)\x = x2
        polypoints(2)\y = y2
        polypoints(3)\x = xx1
        polypoints(3)\y = yy1
        If coll <> -1
          SetFillStyle(#SolidFill, coll)
        Else
          SetFillStyle(#SolidFill, frColor)
        EndIf
        If filledl
          FillPoly(4, polypoints())
        Else
          DrawPoly(4, polypoints())
        EndIf
      Case #SBox
        CalcAnglePoint(x2, y2, dist, angle, @xx, @yy)
        CalcAnglePoint(xx, yy-dist, 0, angle, @xx1, @yy1)
        CalcAnglePoint(xx, yy+dist, 0, angle, @xx2, @yy2)
        CalcAnglePoint(x2, y2-dist, 0, angle, @xx3, @yy3)
        CalcAnglePoint(x2, y2+dist, 0, angle, @xx4, @yy4)       
        polypoints(0)\x = xx1
        polypoints(0)\y = yy1
        polypoints(1)\x = xx2
        polypoints(1)\y = yy2
        polypoints(2)\x = xx2
        polypoints(2)\y = yy2
        polypoints(3)\x = xx4
        polypoints(3)\y = yy4
        polypoints(4)\x = xx3
        polypoints(4)\y = yy3
        polypoints(5)\x = xx1
        polypoints(5)\y = yy1
        GetFillSettings(@fillinfo)
        If coll <> -1
          SetFillStyle(#SolidFill, coll)
        Else
          SetFillStyle(#SolidFill, frColor)
        EndIf
        If filledl
          FillPoly(6, polypoints())
        Else
          DrawPoly(6, polypoints())
        EndIf
      Case #SCircle
        CalcAnglePoint(x2, y2, dist, angle, @xx, @yy)
        GetFillSettings(@fillinfo)
        If coll <> -1
          SetFillStyle(#SolidFill, coll)
        Else
          SetFillStyle(#SolidFill, frColor)
        EndIf
        If filledl
          FillPoly(6, polypoints())
          If coll <> -1
            FillEllipse(xx,yy,dist,dist,coll)
          Else
            FillEllipse(xx,yy,dist,dist,frColor)
          EndIf         
        Else
          PlotSymbol(xx, yy, 6, dist)
        EndIf
      Case #SLine
        GetFillSettings(@fillinfo)
        CalcAnglePoint(x2, y2-dist, 0, angle, @xx1, @yy1)
        CalcAnglePoint(x2, y2+dist, 0, angle, @xx2, @yy2)
        If coll <> -1
          ccol = GetColor()
          SetColor(coll)
        EndIf         
        MoveTo(xx1, yy1)
        LineTo(xx2, yy2)         
        If coll <> -1
          SetColor(ccol)
        EndIf         
      Case #SDLine
        If coll <> -1
          ccol = GetColor()
          SetColor(coll)
        EndIf         
        GetFillSettings(@fillinfo)
        CalcAnglePoint(x2, y2-dist, 0, angle, @xx1, @yy1)
        CalcAnglePoint(x2, y2+dist, 0, angle, @xx2, @yy2)
        CalcAnglePoint(x2, y2, 1, angle, @xx, @yy)
        CalcAnglePoint(xx, yy-dist, 0, angle, @xx3, @yy3)
        CalcAnglePoint(xx, yy+dist, 0, angle, @xx4, @yy4)
        MoveTo(xx1, yy1)
        LineTo(xx2, yy2)         
        MoveTo(xx3, yy3)
        LineTo(xx4, yy4)
        If coll <> -1
          SetColor(ccol)
        EndIf
      Case #SDCross
        If coll <> -1
          ccol = GetColor()
          SetColor(coll)
        EndIf         
        GetFillSettings(@fillinfo)
        CalcAnglePoint(x2, y2-dist, 0, angle, @xx1, @yy1)
        CalcAnglePoint(x2, y2+dist, 0, angle, @xx2, @yy2)
        CalcAnglePoint(x2, y2, 1, angle, @xx, @yy)
        CalcAnglePoint(xx, yy-dist, 0, angle, @xx3, @yy3)
        CalcAnglePoint(xx, yy+dist, 0, angle, @xx4, @yy4)
        MoveTo(x2-dist,y2-dist)
        LineRel(2*dist,2*dist)
        MoveRel(-2*dist,0)
        LineRel(2*dist,-2*dist)
        If coll <> -1
          SetColor(ccol)
        EndIf
    EndSelect   
  EndIf
  SetFillStyle(fillinfo\pattern, fillinfo\color)
  GdiFlush_()
EndProcedure

Procedure Lines(x1.l,y1.l,x2.l,y2.l)
  MoveTo(x1,y1)
  LineTo(x2,y2)
EndProcedure

Procedure LineRel(dx.l,dy.l)
  LineTo(actX+dx,actY+dy)
EndProcedure

Procedure LineProc(x.i,y.i,param.i)
  param = param >> globalTemp
  If (param.i & $0001) <> 0
    PutPixel(x,y,frColor)
  EndIf
  globalTemp = (globalTemp+1) % 16
EndProcedure

Procedure LineTo(x.l,y.l)
  Protected.i x0,y0
  x0 = x
  y0 = y
  INC(x, origX)
  INC(y, origY)
  With lineSettings
    If \linestyle <> #UserBitLn
      LineTo_(hWDC(0),x,y)
      GdiFlush_()
      If \thickness = #NormWidth
        PutPixel(x0,y0,frColor)
      EndIf
    Else
      globalTemp = 0
      LineDDA(actX,actY,x0,y0,@LineProc(),\pattern)
      GdiFlush_()
    EndIf
    MoveTo(x0,y0)
  EndWith
  GdiFlush_()
EndProcedure

Procedure MoveRel(dx.l,dy.l)
  INC(actX, dx)
  INC(actY, dy)
  MoveTo(actX,actY)
EndProcedure

Procedure MoveTo(x.l,y.l)
  Protected d.POINT
  actX = x
  actY = y
  INC(x, origX)
  INC(y, origY)
  MoveToEx_(hWDC(0),x,y,d)
  GdiFlush_()
EndProcedure

Procedure PutPixel(x.l,y.l, color.l)
  INC(x, origX)
  INC(y, origY)
  SetPixelV_(hWDC(0),x,y,color)
  GdiFlush_()
EndProcedure

Procedure Rectangle(x1.l,y1.l,x2.l,y2.l)
  Protected Dim pt.POINT(5)
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  INC(x1, origX)
  INC(y1, origY)
  INC(x2, origX)
  INC(y2, origY)
  If (x1 <> x2) Or (y1 <> y2)
    pt(0)\x = x1: pt(0)\y = y1
    pt(1)\x = x2: pt(1)\y = y1
    pt(2)\x = x2: pt(2)\y = y2
    pt(3)\x = x1: pt(3)\y = y2
    pt(4)\x = x1: pt(4)\y = y1
    Polyline_(hWDC(0), @pt(),5)
  Else
    PutPixel(x1,y1,frcolor)
  EndIf
  GdiFlush_()
EndProcedure

Procedure RotEllipse(x.l,y.l,rot.i,xradius.i,yradius.i)
  Protected Dim pt.PointType(7)
  Protected.d cosrot,sinrot
  Protected.i x1,y1,i
  xradius = Round(1.3333*xradius, #PB_Round_Nearest)
  cosrot = Cos(rot*#Rad): sinrot = Sin(rot*#Rad)
  pt(0)\x = 0:        pt(0)\y = -Int(yradius)
  pt(1)\x =  xradius: pt(1)\y = -Int(yradius)
  pt(2)\x =  xradius: pt(2)\y =  (yradius)
  pt(3)\x = 0:        pt(3)\y =  (yradius)
  pt(4)\x = -Int(xradius): pt(4)\y =  (yradius)
  pt(5)\x = -Int(xradius): pt(5)\y = -Int(yradius)
  pt(6)\x = 0:        pt(6)\y = -Int(yradius)
  For i = 0 To 6
     x1 = pt(i)\x: y1 = pt(i)\y ; perform rotation
     pt(i)\x = x+Round( x1*cosrot+y1*sinrot, #PB_Round_Nearest)
     pt(i)\y = y+Round(-x1*sinrot+y1*cosrot, #PB_Round_Nearest)
  Next
  DrawBezier(7, pt())
  GdiFlush_()
EndProcedure

Procedure SetLineStyle(linestyle.i,pattern.l,thickness.i)
  Protected lgpn.LOGPEN
  Protected old.l
  Protected lstyle.l
;   DeleteObject_(grPen)
;   ReleaseDC_(hWnd, hWDC(0))
  hWDC(0) = GetDC_(hWnd)
  Select linestyle
    Case #SolidLn          : lstyle = #PS_SOLID
    Case #DashedLn         : lstyle = #PS_DASH
    Case #DottedLn         : lstyle = #PS_DOT
    Case #DashDotLn        : lstyle = #PS_DASHDOT
    Case #DashDotDotLn     : lstyle = #PS_DASHDOTDOT
    Case #UserBitLn,#NullLn: lstyle = #PS_NULL
  Default
    ProcedureReturn
  EndSelect
  lineSettings\linestyle = linestyle
  lineSettings\pattern   = pattern
  lineSettings\thickness = thickness
  lgpn\lopnStyle   = lstyle
  lgpn\lopnWidth\x = thickness
  lgpn\lopnColor   = frcolor
  grPen = CreatePenIndirect_(lgpn)
  SelectObject_(hWDC(0), grPen)
  GdiFlush_()
EndProcedure

;filled drawings routines

Procedure Bar(x1.l,y1.l,x2.l,y2.l)
  Protected rc.RECT
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  INC(x1, origX)
  INC(y1, origY)
  INC(x2, origX)
  INC(y2, origY)
  SetRect_(@rc,x1,y1,x2+1,y2+1)
  FillRect_(hWDC(0),@rc,@grBrush)
  GdiFlush_()
EndProcedure

Procedure Bar3D(x1.l,y1.l,x2.l,y2.l, depth.l, top.l, col.l)
  Protected Dim pt.POINT(4)
  FillRect(x1,y1,x2,y2, col)
  INC(x1, origX)
  INC(y1, origY)
  INC(x2, origX)
  INC(y2, origY)
  If top <> 0
    pt(0)\x = x1:            pt(0)\y = y1
    pt(1)\x = x1+Int(depth): pt(1)\y = y1-Int(depth)
    pt(2)\x = x2+Int(depth): pt(2)\y = y1-Int(depth)
    pt(3)\x = x2:            pt(3)\y = y1
    Polyline_(hWDC(0),@pt(),4)
  EndIf
  If depth <> 0
     pt(0)\x = x2+Int(depth): pt(0)\y = y1-Int(depth)
     pt(1)\x = x2+Int(depth): pt(1)\y = y2-Int(depth)
     pt(2)\x = x2:            pt(2)\y = y2
     Polyline_(hWDC(0),@pt(),3)
  EndIf
  GdiFlush_()
EndProcedure

Procedure Chord(x.l,y.l, start.i,stop.i,xradius.i,yradius.i)
  Protected.i nXRadial1,nYRadial1,nXRadial2,nYRadial2
  INC(x, origX)
  INC(y, origY)
  nXRadial1 = Round(xradius*Cos(start*#Rad), #PB_Round_Nearest): nXRadial2 = Round(xradius*Cos(stop*#Rad), #PB_Round_Nearest)
  nYRadial1 = Round(yradius*Sin(start*#Rad), #PB_Round_Nearest): nYRadial2 = Round(yradius*Sin(stop*#Rad), #PB_Round_Nearest)
  If defAspectRatio  = 0
    xradius = 10000*Int(xradius) / aspX: yradius = 10000*Int(yradius) / aspY
  EndIf
  Chord_(hWDC(0),x-xradius,y-yradius,x+xradius+1,y+yradius+1,x+nXRadial1,y-nYRadial1,x+nXRadial2,y-nYRadial2)
  GdiFlush_()
EndProcedure

Procedure FillEllipse(x.l,y.l,xradius.i,yradius.i, col.l=-1)
  Protected fillinfo.FillSettingsType
  INC(x, origX)
  INC(y, origY)
  If defAspectRatio <> 0
    xradius = Int(10000*xradius) / aspX;
    yradius = Int(10000*yradius) / aspY
  EndIf
  If col <> -1
    GetFillSettings(@fillinfo)
    SetFillStyle(fillinfo\pattern, col)
  EndIf
  Ellipse_(hWDC(0),x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1)
  If col <> -1
    SetFillStyle(fillinfo\pattern, fillinfo\color)
  EndIf
  GdiFlush_()
EndProcedure

Procedure FillPoly(nrpoints.i, Array *polypoints.PointType(1))
  Protected.i size,i
  If nrpoints >= 2
    SetPolyFillMode_(hWDC(0), 2)
    Polygon_(hWDC(0), *polypoints(), nrpoints)
  EndIf
  GdiFlush_()
EndProcedure

Procedure FillRect(x1.l,y1.l,x2.l,y2.l, col.l=-1)
  Protected fillinfo.FillSettingsType
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  INC(x1, origX)
  INC(y1, origY)
  INC(x2, origX+1)
  INC(y2, origY+1)
  If col <> -1
    GetFillSettings(@fillinfo)
    SetFillStyle(fillinfo\pattern, col)
  EndIf
  Rectangle_(hWDC(0),x1,y1,x2,y2)
  If col <> -1
    SetFillStyle(fillinfo\pattern, fillinfo\color)
  EndIf
  GdiFlush_()
EndProcedure

Procedure FloodFill(x.l,y.l, color.l)
  INC(x, origX)
  INC(y, origY)
  ExtFloodFill_(hWDC(0),x,y,color,floodMode)
  GdiFlush_()
EndProcedure

Procedure GetFillPattern(Array *fillpatternn.byte(1))
  CopyArray(*fillPatternn(), fillpattern())
EndProcedure

Procedure GetFillSettings(*fillinfo.FillSettingsType)
  CopyStructure(@fillSettings, *fillinfo, FillSettingsType)
EndProcedure

Procedure InvertRect(x1.l,y1.l,x2.l,y2.l)
  Protected rc.RECT
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  INC(x1, origX)
  INC(y1, origY)
  INC(x2, origX)
  INC(y2, origY)
  SetRect_(@rc,x1,y1,x2+1,y2+1)
  InvertRect_(hWDC(0), @rc)
  GdiFlush_()
EndProcedure

Procedure PieSlice(x.l,y.l, start.i,stop.i,radius.l)
  Sector(x,y,start,stop,radius,radius)
  GdiFlush_()
EndProcedure

Procedure RoundRect(x1.l,y1.l,x2.l,y2.l,r.l)
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  INC(x1, origX)
  INC(y1, origY)
  INC(x2, origX)
  INC(y2, origY)
  RoundRect_(hWDC(0),x1,y1,x2+1,y2+1,r,r)
  GdiFlush_()
EndProcedure

Procedure Sector(x.l,y.l, start.i,stop.i,xradius.i,yradius.i)
  Protected.i nXRadial1,nYRadial1,nXRadial2,nYRadial2
  INC(x, origX)
  INC(y, origY)
  nXRadial1 = Round(xradius*Cos(start*#Rad), #PB_Round_Nearest)
  nXRadial2 = Round(xradius*Cos(stop*#Rad), #PB_Round_Nearest)
  nYRadial1 = Round(yradius*Sin(start*#Rad), #PB_Round_Nearest)
  nYRadial2 = Round(yradius*Sin(stop*#Rad), #PB_Round_Nearest)
  If defAspectRatio <> 0
    xradius = Int(10000*xradius) / aspX : yradius = Int(10000*yradius) / aspY
  EndIf
  Pie_(hWDC(0),x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1,x+nXRadial1,y-nYRadial1,x+nXRadial2,y-nYRadial2)
  GdiFlush_()
EndProcedure

Procedure SetFillPattern(Array fillpattern.b(1), color.l)
  Protected.i i,j
  Protected.i col0,col1
  Protected.b b
  col1 = color
  col0 = bkcolor
  If grPattern <> #Null
    DeleteObject_(grPattern)
  EndIf
  grPattern = CreateCompatibleBitmap_(hWDC(0),8,8)
  SelectObject_(hWDC(0), grPattern)
  For i = 0 To 7
    b = fillpattern(i+1)
    For j = 7 To 0 Step -1
      If (b & $01) <> 0
        SetPixelV_(hWDC(0),j,i,col1)
      Else
        SetPixelV_(hWDC(0),j,i,col0)
      EndIf
      b = b >> 1
    Next
  Next
  SetFillStyle(#UserFill, color)
EndProcedure

Procedure SetFillStyle(pattern.l, color.l)
  Protected lplb.LOGBRUSH
  lplb\lbStyle = #BS_HATCHED
  lplb\lbHatch = 0
  Select pattern
    Case #SolidFill  : lplb\lbStyle = #BS_SOLID
    Case #EmptyFill  : lplb\lbStyle = #BS_SOLID
                       color = bkcolor
    Case #LineFill   : lplb\lbHatch = #HS_HORIZONTAL
    Case #ColFill    : lplb\lbHatch = #HS_VERTICAL
    Case #HatchFill  : lplb\lbHatch = #HS_CROSS
    Case #SlashFill  : lplb\lbHatch = #HS_BDIAGONAL
    Case #BkSlashFill: lplb\lbHatch = #HS_FDIAGONAL
    Case #XHatchFill : lplb\lbHatch = #HS_DIAGCROSS
    Case #UserFill   : lplb\lbStyle = #BS_PATTERN
                       lplb\lbHatch = grPattern
    Case #NoFill     : lplb\lbStyle = #BS_NULL
  Default
    ProcedureReturn
  EndSelect
  lplb\lbColor = color
  fillSettings\pattern = pattern
  fillSettings\color = color
  DeleteObject_(grBrush)
  grBrush = CreateBrushIndirect_(@lplb)
  SelectObject_(hWDC(0), grBrush)
  GdiFlush_()
EndProcedure

Procedure SetFloodMode(floodmode.l)
  Select floodmode
    Case #BorderFlood : floodMode = #FLOODFILLBORDER
    Case #SurfaceFlood: floodMode = #FLOODFILLSURFACE
  EndSelect
EndProcedure

;text And font handling routines

Procedure GetFontSettings(fontname.s, *width.integer, *height.integer, *ttfont.integer)
  Protected *lptm.TEXTMETRIC
  Protected len.i
  Protected x.s = Space(255), tt.s = ""
  len = GetTextFace_(hWDC(0),255, @x)
  tt = Chr(len-1) + Space(255)
  GetTextFace_(hWDC(0),255, @tt)
  GetTextMetrics_(hWDC(0), *lptm)
  With *lptm
    *width  = \tmMaxCharWidth
    *height = \tmHeight
    *ttfont = Bool((\tmPitchAndFamily & #TMPF_TRUETYPE) <> 0)
  EndWith
  GdiFlush_()
EndProcedure

Procedure GetTextSettings(*textinfo.TextSettingsType)
  *textinfo = textSettings
EndProcedure

Procedure.i InstallUserFont(fontname.s)
  Protected.i i, Result=-1
  Protected famName.s = ""
  famName = fontname
  globalTemp = 0
  EnumFontFamilies_(hWDC(0),@famName,@EnumFontFamProc(),0)
  If globalTemp = 1
    For i = 0 To #NrMaxFonts-1
      If instFont(i) = ""
        instFont(i) = fontname
        Result = i
        Break
      EndIf
    Next
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure OutText(textstring.s, color.l = -1, bcol.l = -1)
  Protected backcoltmp.l = GetBkColor()
  If color = -1
    SetTextColor_(hWDC(0), frcolor)
  Else
    SetTextColor_(hWDC(0), color)
  EndIf
  If bcol = -1
    SetBkColor_(hWDC(0), bkcolor)
  Else
    SetBkColor_(hWDC(0), bcol)
  EndIf
  MoveTo(actX, actY)
  TextOut_(hWDC(0),actX,actY,@textstring,Len(textstring))
  If bcol <> -1
    SetBkColor_(hWDC(0), backcoltmp)
  EndIf
  GdiFlush_()
EndProcedure

Procedure OutTextXY(x.l, y.l, textstring.s, color.l = -1, bcol.l = -1)
  Protected backcoltmp.l = GetBkColor()
  Protected tttt.i
  If color = -1
    SetTextColor_(hWDC(0), frcolor)
  Else
    SetTextColor_(hWDC(0), color)
  EndIf
  If bcol = -1
    SetBkColor_(hWDC(0), bkcolor)
  Else
    SetBkColor_(hWDC(0), bcol)
  EndIf
  MoveTo(x, y)
  TextOut_(hWDC(0), x, y, @textstring, Len(textstring))
  If bcol <> -1
    SetBkColor_(hWDC(0), backcoltmp)
  EndIf
  GdiFlush_()
EndProcedure

Procedure SetTextJustify(horiz.i, vert.i)
  Protected.i htext,vtext
  Select horiz
    Case #LeftText  : htext = #TA_LEFT
    Case #CenterText: htext = #TA_CENTER
    Case #RightText : htext = #TA_RIGHT
  Default
    ProcedureReturn
  EndSelect
  Select vert
    Case #TopText     : vtext = #TA_TOP
    Case #BottomText  : vtext = #TA_BOTTOM
    Case #BaselineText: vtext = #TA_BASELINE
  Default
    ProcedureReturn
  EndSelect
  textSettings\horiz = horiz
  textSettings\vert = vert
  SetTextAlign_(hWDC(0),htext | vtext | #TA_UPDATECP)
  GdiFlush_()
EndProcedure

Procedure SetTextStyle(font.i,direction.l,charsize.l)
  Protected.b loByte,hiByte
  Protected.b nrfont
  Protected fontname.s = ""
  Protected lplf.LOGFONT
  Protected old.i
  loByte = LOBYTE(LOWORD(font))
  hiByte = HIBYTE(HIWORD(font))
  nrfont = loByte % $10
  If (nrfont>=0) And (nrfont <= #NrMaxFonts-1)
    fontname = instFont(nrfont)
  Else
    fontname = ""
  EndIf
  If fontname <> ""
    textSettings\font = font
    textSettings\direction = direction
    textSettings\charsize = charsize
    If charsize <= #MinCharSize
      charsize = charsize + #MinCharSize
    EndIf
    lplf\lfHeight = charsize
    lplf\lfWidth = 0
    lplf\lfEscapement = 10 * direction
    lplf\lfOrientation = 10 * direction
    lplf\lfItalic = #False
    lplf\lfWeight = (#FW_BOLD - #FW_NORMAL) * (loByte / $10) + #FW_NORMAL
    If (hiByte / $10) > 0
      lplf\lfItalic = 1
    EndIf
    lplf\lfUnderline = 0
    If (hiByte / $10) > 0
      lplf\lfUnderline = 1
    EndIf
    lplf\lfStrikeOut = 0
    lplf\lfCharSet = #DEFAULT_CHARSET
    lplf\lfOutPrecision = #OUT_DEFAULT_PRECIS
    lplf\lfClipPrecision = #CLIP_DEFAULT_PRECIS
    lplf\lfQuality = #DEFAULT_QUALITY
    lplf\lfPitchAndFamily = #DEFAULT_PITCH | #FF_DONTCARE
    PokeS(@lplf\lfFaceName[0], fontname)
    grFont = CreateFontIndirect_(@lplf)
    SelectObject_(hWDC(0), grFont)
    GdiFlush_()
  EndIf
EndProcedure

Procedure SetUserCharSize(nCharExtra.i,nBreakExtra.i,dummy1.i,dummy2.i)
  SetTextCharacterExtra_(hWDC(0),nCharExtra)
  SetTextJustification_(hWDC(0),nBreakExtra,1)
EndProcedure

Procedure.i TextHeights(textstring.s)
  Protected lpSize.SIZE
  Protected len.i
  len = Len(textstring)
  GetTextExtentPoint32_(hWDC(0),@textstring,len, @lpSize)
  ProcedureReturn lpSize\cy
EndProcedure

Procedure.i TextWidths(textstring.s)
  Protected lpSize.SIZE
  Protected len.i
  len = Len(textstring)
  GetTextExtentPoint32_(hWDC(0),@textstring,len, @lpSize)
  ProcedureReturn lpSize\cx
EndProcedure

Procedure THREEDto2DAll(*coords.ThreeDPointType, *pan.ThreeDPointType, *centre.ThreeDPointType, *position.ThreeDPointType, zoom.d, *sx.double, *sy.double)
  Protected new.ThreeDPointType
  INC(*coords\x, *position\x)
  INC(*coords\y, *position\y)
  INC(*coords\z, *position\z)
  new\x  =  *coords\x*Cos(*pan\x) - *coords\z*Sin(*pan\x)
  new\z  =  *coords\x*Sin(*pan\x) + *coords\z*Cos(*pan\x)
  new\y  =  *coords\y*Cos(*pan\y) - new\z*Sin(*pan\y)
  *coords\z  =  new\y*Cos(*pan\y) - new\z*Sin(*pan\y)
  *coords\x  =  new\x*Cos(*pan\z) - new\y*Sin(*pan\z)
  *coords\y  =  new\x*Sin(*pan\z) + new\y*Cos(*pan\z)
  If *coords\z > 0.0
    *sx  =  *coords\x / *coords\z * zoom + *centre\x
    *sy  =  *coords\y / *coords\z * zoom + *centre\y
  Else
    *sx  =  *coords\x * zoom + *centre\x
    *sy  =  *coords\y * zoom + *centre\y
  EndIf
EndProcedure

Procedure THREEDto2D(*coords.ThreeDPointType, zoom.d, *sx.double, *sy.double)
    *sx  =  *coords\x / *coords\z * zoom
    *sy  =  *coords\y / *coords\z * zoom
EndProcedure


;   Plots a Symbol, scaled by SymSize, centered at world coordinates
;   X,Y; available Symbols are:
;     1  - plus
;     2  - box
;     3  - cross (x-like)
;     4  - triangle
;     5  - inverted triangle
;     6  - open circle
;     7  - filled circle
;     8  - dot
Procedure PlotSymbol(X.d,Y.d, Symbol.i, SymSize.i, color.i=-1)
  Protected.i del = 1
  Protected.i xs,ys,delta,x1,y1
  Protected.i curcol
  x1 = GetXX()
  y1 = GetYY()
  curcol = GetColor()
  If color <> -1
    SetColor(color)
  EndIf
  xs=X : ys=Y
  delta = del*SymSize;
  Select Symbol
    Case 1   ; plus
         MoveTo(xs-delta,ys)
         LineRel(2*delta,0)
         MoveRel(-delta,-delta)
         LineRel(0,2*delta)
    Case 2   ; box
         MoveTo(xs-delta,ys-delta)
         LineRel(2*delta,0)
         LineRel(0,2*delta)
         LineRel(-2*delta,0)
         LineRel(0,-2*delta)
    Case 3   ; cross
         MoveTo(xs-delta,ys-delta)
         LineRel(2*delta,2*delta)
         MoveRel(-2*delta,0)
         LineRel(2*delta,-2*delta)
    Case 4:   ; triangle
         MoveTo(xs,Int(ys-delta-delta / 3))
         LineRel(-delta,2*delta)
         LineRel(2*delta,0)
         LineRel(-delta,-2*delta)
    Case 5   ; inverted triangle
         MoveTo(xs,Int(ys+delta+delta / 3))
         LineRel(-delta,-2*delta)
         LineRel(2*delta,0)
         LineRel(-delta,2*delta)
    Case 6
         Circles(xs,ys,delta) ; open circle
    Case 7
      FillEllipse(xs,ys,delta,delta, color) ; closed circle
    Case 8
      PutPixel(xs,ys,GetMaxColor()) ; unscaled point
  Default
  EndSelect
  MoveTo(x1,y1)
  SetColor(curcol)
  GdiFlush_()
EndProcedure

Procedure DrawSymbol(x.l, y.l, color.l, symbol.l, width.l, height.l)
  Protected currfcol.l = GetColor()
  SetColor(color)
  Select symbol
    Case #SYMBOLRECTANGLE:
        lines(x - width/2, y - height/2, x + width/2, y - height/2)
        lines(x + width/2, y - height/2, x + width/2, y + height/2)
        lines(x + width/2, y + height/2, x - width/2, y + height/2)
        lines(x - width/2, y + height/2, x - width/2, y - height/2)
    Case #SYMBOLTRIANGLE:
        lines(x - width/2, y + height/2, x, y - height/2)
        lines(x, y - height/2, x + width/2, y + height/2)
        lines(x + width/2, y + height/2, x - width/2, y + height/2)
    Case #SYMBOLDIAMOND:
        lines(x - width/2, y, x, y - height/2)
        lines(x, y - height/2, x + width/2, y)
        lines(x + width/2, y, x, y + height/2)
        lines(x, y + height/2, x - width/2, y)
    Case #SYMBOLCROSS:
        lines(x - width/2, y, x + width/2, y)
        lines(x, y - height/2, x, y + height/2)
    Case #SYMBOLXCROSS:
        lines(x - width/2, y + height/2, x + width/2, y - height/2)
        lines(x - width/2, y - height/2, x + width/2, y + height/2)
    Default
  EndSelect
  SetColor(currfcol)
  GdiFlush_()
EndProcedure

Global old_TextSettings.TextSettingsType
Global.i textX,textY,textW,textH

Procedure DrawCaret(nr.i)
  Select nr
    Case 0: SetFillStyle(#SolidFill,GetBkColor())
    Case 1: SetFillStyle(#SolidFill,GetColor())
  EndSelect
  If (CaretBlock <> 0) Or (nr = 0)
    Bar(textX,textY,textX+textW,textY+textH)
  Else
    Bar(textX,textY+textH-1,textX+textW,textY+textH)
  EndIf
  GdiFlush_()
EndProcedure

Procedure TextSettings()
  Protected viewport.ViewPortType
  With old_TextSettings
    SetTextStyle(#DefaultFont | (\font / $10) << 4,0, \charsize)  ; keep font format
    SetTextJustify(#LeftText, #TopText)
  EndWith
  textX = GetX()
  textY = GetY()
  textW = TextWidths("W")
  textH = TextHeights("H")
  GetViewSettings(viewport)
  With viewport
    maxX = \x2-\x1
    maxY = \y2-\y1
  EndWith
EndProcedure

Procedure SetVisualPage(page.i)
;   Protected pos.POINT
;   If active_page = visual_page
; 		SelectObject_(hWDC(1), hBitmap(visual_page))
; 		SelectClipRgn_(hWDC(1), #Null)
;     BitBlt_(hdc(1), -viewPort\x1, -viewPort\y1, windowWidth, windowHeight, hdc(0), -viewPort\x2, -viewPort\y2, #SRCCOPY)
; 		SelectClipRgn_(hWDC(1), *grClip)
; 		GetCurrentPositionEx_(hWDC(0), @pos)
; 		MoveToEx_(hWDC(1), pos\x, pos\y, #Null)
;   EndIf
;   SelectClipRgn_(hWDC(0), #Null)
;   SelectClipRgn_(hWDC(1), #Null)
;   SelectObject_(hWDC(1), hBitmap(page))
;   BitBlt_(hWDC(0), -viewPort\x1, -viewPort\y1, windowWidth, windowHeight, hdc(1), -viewPort\x2, -viewPort\y2, #SRCCOPY)
;   SelectClipRgn_(hWDC(0), *grClip)
;   SelectClipRgn_(hWDC(1), *grClip)
;   If page <> active_page
; 		SelectObject_(hWDC(1), hBitmap(active_page))
;   EndIf
;   If active_page <> visual_page
; 		GetCurrentPositionEx_(hWDC(1), @pos)
; 		MoveToEx_(hWDC(0), pos\x, pos\y, #Null)
;   EndIf
;   visual_page = page
EndProcedure
 
Procedure SetActivePage(page.i)
; 		SelectObject_(hdc(1), hBitmap(page))
;     If active_page = visual_page
; 			Protected pos.POINT
; 			GetCurrentPositionEx_(hdc(0), @pos)
; 			MoveToEx_(hdc(1), pos\x, pos\y, #Null)
;     EndIf
;     active_page = page
EndProcedure

EndModule

Code: Select all

XIncludeFile "MINIBGI.pbi"

DeclareModule MINIPLOT
  EnableExplicit  
  
#MAXINTEGER = 65535
  
#FillCircles = 0
#Circles     = 1
#FillRect    = 3

;   sets clipping of plotting on: i.e. only within actual plot region
;   delimited by XMin->XMax And YMin->YMax
Declare SetClipOn()

;   sets clipping of plotting off: i.e. can plot anywhere on the screen,
;   but window is still delimited by XMin->XMax And YMin->YMax
Declare SetClipOff()

;   clears a status line at the very top of the screen;
;   you have To be in graphics mode For this To work.
Declare Clear_StatusLine()


;   writes out a status line "Message" after clearing the status line
;   you have To be in graphics mode For this To work.
Declare Write_StatusLine(Message.s)


;   defines constants (XAxisScale,YAxisScale,ConstX,ConstY) which are used
;   To convert To And from world And window coordinate systems.
Declare Setscale(WXMin.d,WXMax.d,WYMin.d,WYMax.d)

;performs transformation from world coordinates to window (screen) coordinates
Declare World_to_Window(x.d,y.d, *XScreen.integer, *YScreen.integer)


;   performs transformation from window (screen) coordinates To world
;   coordinates
Declare Window_to_World(XScreen.i,YScreen.i, *x.double, *y.double)

;  move graphics cursor To world coordinate X,Y
Declare Move(X.d,Y.d)

;   draw line from present position of graphics cursor To world
;   coordinate X,Y; use BGI Declare SetLineStyle to change from
;   solid To dotted, dashed, etc
Declare Draw(X.d,Y.d)
Declare Draw_Symbol(X.d,Y.d, symbol.l, width.l, color.l=-1)

;   move graphics cursor a relative distance (in world coordinates) from
;   present position
Declare RelMove(X.d,Y.d)


;   draw line from present position of graphics cursor To a new
;   position given by the relative distance X,Y (in world coordinates)
;   use BGI Declare SetLineStyle To change from solid To dotted,
;   dashed, etc
Declare RelDraw(X.d,Y.d)


;   Draws tick marks For "axes" And "frame" With minor tick intervals
;   every XTick,YTick, And major ticks every XMajor,YMajor minor ticks.
;   Tick_Proc checks If x And y axes are running the conventional directions
;   (i.e. xmin->max is left To right And ymin->ymax is up) And acts accordingly;
;   This routine is only used internally by HiGraf.
;Declare Tick_Proc(Xarg.d,Yarg.d,XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)
Declare Tick_Proc(Xarg.d, Yarg.d, XTick.d, YTick.d, XMajor.i, YMajor.i, GridOn.i)


;   draws a frame around box determined by XMin,XMax And YMin,YMax;
;   put minor ticks every XTick,YTick interval With major ticks every
;   XMajor,YMajor multiples of XTick,YTick; if GridOn = TRUE a grid
;   is drawn
Declare Frame(XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)


;  puts STRING Labl at the top of the plot
Declare TopTitle(Labl.s)

;   labels x axis With STRING Labl; Label_Axes sets up variable MaxLabHeight
;   which is used For XAxisTitle offset; if you haven't called Label_Axes,
;   Setup_Graph has initialized MaxLabHeight To 0;
Declare XAxisTitle(Labl.s)

;   labels y axis With STRING Labl; Label_Axes sets up variable MaxLabLength
;   which is used For YAxisTitle offset; if you haven't called Label_Axes,
;   Setup_Graph has initialized MaxLabLength To 0;
Declare YAxisTitle(Labl.s)

;   This Declare draws a label at position X,Y in world coordinates;
;   the variables "Font,Direction,Size,XJust,YJust" are just As in the
;   BGI description For Turbo Pascal graphics:
;   Font,Direction, And Size are set by a BGI proc "SetTextStyle" And
;   XJust,YJust are set by a BGI proc "SetTextJustify"
Declare Draw_Label(X.d,Y.d, Strng.s,Font.i,Direction.i,Size.i, XJust.i,YJust.i)

;   Draws a pair of axes through XOrg,YOrg With minor tick intervals
;   XTick,YTick, And major ticks every XMajor,YMajor minor tick
;   intervals; if the flag GridOn = TRUE then a grid is drawn
Declare Axes(XOrg.d,YOrg.d,XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)

;   Labels axes at intervals LabelX, LabelY; by convention you may
;   want this To be :
;       LabelX = XMajor*XTick
;       LabelY = YMajor*YTick
;   in your program
Declare Label_Axes(LabelX.d,LabelY.d,textsize.i=10)
;   Declare To set up the graph limits.
;   The world coordinate limits are XMin, XMax, YMin, And YMax.
;   The window limits are WXMin, WXMax, WYMin, WYMax expressed As
;   fractions (of 1,i.e. 0.95 etc) of the maximum screen limits.
Declare Setup_Graph(XMin.d,XMax.d,YMin.d,YMax.d, WXMin.d,WXMax.d,WYMin.d,WYMax.d,logx.b,logy.b)

;   Plots a Symbol, scaled by SymSize, centered at world coordinates
;   X,Y; error bar on X,Y are sigx and sigy; available Symbols are:
;     1  - plus
;     2  - box
;     3  - cross (x-like)
;     4  - triangle
;     5  - inverted triangle
;     6  - open circle
;     7  - filled circle
;     8  - dot
Declare PlotData(x.d,sigx.d,y,sigy.d, Symbol.i, SymSize.i, color.i)
  
EndDeclareModule

Module MINIPLOT
EnableExplicit

UseModule MINIBGI
Global.l Dim Custom_LineStyle(5)
Global.d XWorldMin, XWorldMax,YWorldMin, YWorldMax ; global variables for world limits 
Global.i XWindMin, XWindMax, YWindMin, YWindMax ; global variables for window limits 
Global.i XViewMax,YViewMax ; viewport limits 
Global.d XAxisScale, YAxisScale ; factors for converting 
Global.i ConstX, ConstY       ; to screen coordinates 
Global.b XAxisLog, YAxisLog ; global variables for axis type 
Global.i MaxLabLength ; y axis label length in pixels; used To calculate y axis title offset 
Global.i MaxLabHeight ; x axis label height in pixels; used To calculate x axis title offset 
Global.i MaxColor ; store GetMaxColor value 

;   sets clipping of plotting on: i.e. only within actual plot region
;   delimited by XMin->XMax And YMin->YMax
Procedure SetClipOn()
  SetViewPort(XWindMin,YWindMin,XWindMax,YWindMax,#ClipOn)
EndProcedure

;   sets clipping of plotting off: i.e. can plot anywhere on the screen,
;   but window is still delimited by XMin->XMax And YMin->YMax
Procedure SetClipOff()
  SetViewPort(XWindMin,YWindMin,XWindMax,YWindMax,#ClipOff)
EndProcedure

;   clears a status line at the very top of the screen;
;   you have To be in graphics mode For this To work.
Procedure Clear_StatusLine()
  Protected.i Status_Width = 12 ; is status line 12 pixels tall? 
  SetViewPort(0,0,GetMaxX(),GetMaxY(),#ClipOff)
  SetFillStyle(#EmptyFill,GetMaxColor())
  Bar(0,0,GetMaxX(),Status_Width)
  SetClipOn()
EndProcedure


;   writes out a status line "Message" after clearing the status line
;   you have To be in graphics mode For this To work.
Procedure Write_StatusLine(Message.s)
  Clear_StatusLine()
  SetViewPort(0,0,GetMaxX(),GetMaxY(),#ClipOff)
  SetTextStyle(#ArialFont,#HorizDir,6)
  SetTextJustify(#LeftText,#TopText)
  MoveTo(0,0)
  OutText(Message)
  SetClipOn()
  MoveTo(1,2)
EndProcedure


;   defines constants (XAxisScale,YAxisScale,ConstX,ConstY) which are used
;   To convert To And from world And window coordinate systems.
Procedure Setscale(WXMin.d,WXMax.d,WYMin.d,WYMax.d)
  XWindMin = Round(WXMin*GetMaxX()/100.0, #PB_Round_Down)
  XWindMax = Round(WXMax*GetMaxX()/100.0, #PB_Round_Down)
  YWindMin = Round(WYMin*GetMaxY()/100.0, #PB_Round_Down)
  YWindMax = Round(WYMax*GetMaxY()/100.0, #PB_Round_Down)
  XViewMax = XWindMax-XWindMin
  YViewMax = YWindMax-YWindMin
  If XAxisLog
    XAxisScale = XViewMax /(Log10(XWorldMax)-Log10(XWorldMin))
    ConstX = -Round(Log10(XWorldMin)*XAxisScale, #PB_Round_Down)
  Else
    XAxisScale = XViewMax/(XWorldMax-XWorldMin)
    ConstX = -Round(XWorldMin*XAxisScale, #PB_Round_Down)
  EndIf
  If YAxisLog
    YAxisScale = YViewMax/(Log10(YWorldMin)-Log10(YWorldMax))
    ConstY = -Round(Log10(YWorldMax)*YAxisScale, #PB_Round_Down)
  Else
    YAxisScale = YViewMax/(YWorldMin-YWorldMax)
    ConstY = -Round(YWorldMax*YAxisScale, #PB_Round_Down)
  EndIf
EndProcedure

;performs transformation from world coordinates to window (screen) coordinates
Procedure World_to_Window(x.d,y.d, *XScreen.integer, *YScreen.integer)
  Protected.d temp
  Protected.i isign
  If XAxisLog
    If (x > 0.0) 
      x = Log10(x)
    Else
      x = Log10(XWorldMin)
    EndIf
  EndIf
  If YAxisLog
    If (y > 0.0) 
      y = Log10(y)
    Else
      y = Log10(YWorldMin)
    EndIf
  EndIf
  temp = x * XAxisScale + ConstX
  isign = Sign(temp)
  
  If isign*temp < #MAXINTEGER
    *XScreen\i = Round(temp, #PB_Round_Down)
  Else
    *XScreen\i = isign*#MAXINTEGER
  EndIf
  
  temp = y * YAxisScale + ConstY
  isign = Sign(temp)
  
  If isign*temp < #MAXINTEGER
    *YScreen\i = Round(temp, #PB_Round_Down)
  Else
    *YScreen\i = isign*#MAXINTEGER
  EndIf
EndProcedure


;   performs transformation from window (screen) coordinates To world
;   coordinates
Procedure Window_to_World(XScreen.i,YScreen.i, *x.double, *y.double)
  *x\d = (1.0*XScreen-ConstX)/XAxisScale
  *y\d = (1.0*YScreen-ConstY)/YAxisScale
  If XAxisLog
    *x\d = Pow(10.0,*x\d) 
  EndIf
  If YAxisLog
    *y\d = Pow(10.0,*y\d) 
  EndIf
EndProcedure

Procedure Draw_Symbol(X.d,Y.d, symbol.l, width.l, color.l=-1)
  Protected.i xs,ys
  World_to_Window(X,Y,@xs,@ys)
  LineTo(xs,ys)
  Select symbol
    Case #FillCircles
      FillEllipse(xs,ys,width,width,color)
    Case #Circles
      Circles(xs,ys,width)
    Case #FillRect
      If color = -1
        color = GetColor()
      EndIf
      FillRect(xs-width,ys-width,xs+width,ys+width,color)
  EndSelect
EndProcedure

;   draw line from present position of graphics cursor To world
;   coordinate X,Y; use BGI procedure SetLineStyle to change from
;   solid To dotted, dashed, etc
Procedure Draw(X.d,Y.d)
  Protected xs.i,ys.i
  World_to_Window(X,Y,@xs,@ys)
  LineTo(xs,ys)
EndProcedure

;   draw line from present position of graphics cursor To a new
;   position given by the relative distance X,Y (in world coordinates)
;   use BGI Procedure SetLineStyle To change from solid To dotted,
;   dashed, etc
Procedure RelDraw(X.d,Y.d)
  Protected xs.i,ys.i
  World_to_Window(X,Y,@xs,@ys)
  LineRel(xs,ys)
EndProcedure

;  move graphics cursor To world coordinate X,Y
Procedure Move(X.d,Y.d)
  Protected xs.i,ys.i
  World_to_Window(X,Y,@xs,@ys)
  MoveTo(xs,ys)
EndProcedure

;   move graphics cursor a relative distance (in world coordinates) from
;   present position
Procedure RelMove(X.d,Y.d)
  Protected xs.i,ys.i
  World_to_Window(X,Y,@xs,@ys)
  MoveRel(xs,ys)
EndProcedure

;   Draws tick marks For "axes" And "frame" With minor tick intervals
;   every XTick,YTick, And major ticks every XMajor,YMajor minor ticks.
;   Tick_Proc checks If x And y axes are running the conventional directions
;   (i.e. xmin->max is left To right And ymin->ymax is up) And acts accordingly;
;   This routine is only used internally by HiGraf.

Procedure Tick_Proc(Xarg.d,Yarg.d,XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.i)
  Protected.d XTick_scale = 0.015     ; scale factors for tick lengths 
  Protected.d YTick_scale = 0.005
  Protected.d x, y, decade, tempmin, tempmax
  Protected.i ticklen, i
  ; draw x axis tick marks 
  ticklen = Round(XTick_scale*GetMaxY(), #PB_Round_Down)
  If XWorldMin <= XWorldMax  ; normal axis direction 
    tempmin = XWorldMin
    tempmax = XWorldMax
  Else ; axis is reversed from normal 
    tempmin = XWorldMax
    tempmax = XWorldMin
  EndIf
  If XAxisLog  ; x axis is logarithmic
    decade = Pow(10.0,Log(tempmin)) ; get next lower decade 
    While (decade <= tempmax)
      Move(decade, Yarg)
      LineRel(0, 2 * ticklen)
      LineRel(0, -4 * ticklen)
       If GridOn
         Move(decade, YWorldMin)
         Draw(decade, YWorldMax)
       EndIf
       For i = 3 To 9
        x = decade * i
        If GridOn = #True
          SetLineStyle(#DottedLn, 0, 1) ; fine dotted line 
          Move(x, YWorldMin)
          Draw(x, YWorldMax)
          SetLineStyle(#SolidLn,0,#NormWidth)
        EndIf
        If x <= tempmax
          Move(x,Yarg)
          LineRel(0, ticklen)
          LineRel(0, -2 * ticklen)
        EndIf
       Next
      decade = decade * 10.0
    Wend
  ElseIf XTick > 0.0  ; x axis is linear 
    x = tempmin+XTick
    i = 1
    Repeat
      Move(x,Yarg)
      If (i % XMajor) = 0
        LineRel(0,2*ticklen)
        LineRel(0,-4*ticklen)
      Else
        LineRel(0,ticklen)
        LineRel(0,-2*ticklen)
      EndIf
      If GridOn = #True
        If (i % XMajor) <> 0
          SetLineStyle(#DottedLn,0,1)  
        EndIf ; fine dotted line 
        Move(x,YWorldMin)
        Draw(x,YWorldMax)
        SetLineStyle(#SolidLn,0,#NormWidth)
      EndIf
      INC(x, XTick)
      INC(i)
    Until (x > tempmax)
  EndIf ; ELSE IF (XTick... 
  ; draw y axis tick marks 
  ticklen = Round(YTick_scale*GetMaxX(), #PB_Round_Down)
  If YWorldMin <= YWorldMax  ; normal axis direction 
    tempmin = YWorldMin
    tempmax = YWorldMax
  Else ; axis is reversed from normal 
    tempmin = YWorldMax
    tempmax = YWorldMin
  EndIf 
  If YAxisLog  ; y axis is logarithmic 
    decade = Pow(10.0,Log(tempmin)) ; get next lowest decade 
    While (decade <= tempmax)
      Move(Xarg,decade)
      LineRel(-2*ticklen,0)
      LineRel(4*ticklen,0)
      If GridOn
        Move(XWorldMin,decade)
        Draw(XWorldMax,decade)
      EndIf
      For i = 3 To 9
        y = decade*i
        If y <= tempmax
          Move(Xarg,y)
          LineRel(-ticklen,0)
          LineRel(2*ticklen,0)
        EndIf
        If GridOn = #True
          SetLineStyle(#DottedLn,0,1) ; fine dotted line 
          Move(XWorldMin,y)
          Draw(XWorldMax,y)
          SetLineStyle(#SolidLn,0,#NormWidth)
        EndIf
      Next
      decade = decade*10.0
    Wend
  ElseIf YTick > 0.0  ; y axis is linear 
    y = tempmin+YTick
    i = 1
    Repeat
      Move(Xarg,y)
      If (i % YMajor) = 0
        LineRel(-2*ticklen,0)
        LineRel(4*ticklen,0)
      Else
        LineRel(-ticklen,0)
        LineRel(2*ticklen,0)
      EndIf
      If GridOn = #True
        If (i % YMajor) <> 0
          SetLineStyle(#DottedLn,0,1) 
        Else
        EndIf ; fine dotted line 
        Move(XWorldMin,y)
        Draw(XWorldMax,y)
        SetLineStyle(#SolidLn,0,#NormWidth)
      EndIf
      INC(y,YTick)
      INC(i)
    Until y > tempmax
  EndIf
EndProcedure

; Procedure Tick_Proc(Xarg.d, Yarg.d, XTick.d, YTick.d, XMajor.i, YMajor.i, GridOn.i)
;  
;   Protected.d XTick_scale = 0.015     ; scale factors for tick lengths
;   Protected.d YTick_scale = 0.005
;   Protected.d x, y, decade, tempmin, tempmax
;   Protected.i ticklen, i
;  
;   ; draw x axis tick marks
;   ticklen = Round(XTick_scale * GetMaxY(), #PB_Round_Up)
;   If XWorldMin <= XWorldMax  ; normal axis direction
;     tempmin = XWorldMin
;     tempmax = XWorldMax
;   Else ; axis is reversed from normal
;     tempmin = XWorldMax
;     tempmax = XWorldMin
;   EndIf
;   If XAxisLog  ; x axis is logarithmic
;     decade = Pow(10.0,Log(tempmin)) ; get next lower decade
;     Repeat
;       Move(decade,Yarg)
;       LineRel(0,2*ticklen)
;       LineRel(0,-4*ticklen)
;       If GridOn
;         Move(decade,YWorldMin)
;         Draw(decade,YWorldMax)
;       EndIf
;       For i =  2 To 9
;         x = decade*i
;         If x<= tempmax
;           Move(x,Yarg)
;           LineRel(0,ticklen)
;           LineRel(0,-2*ticklen)
;         EndIf
;         If GridOn
;           SetLineStyle(#DottedLn,0,1) ; fine dotted line
;           Move(x,YWorldMin)
;           Draw(x,YWorldMax)
;           SetLineStyle(#SolidLn,0,#NormWidth)
;         EndIf
;       Next
;       decade = decade*10.0
;     Until (decade > tempmax)
;   ElseIf XTick > 0.0  ; x axis is linear
;    
;     x = tempmin
;     While x < tempmin + XTick
;       If Int(x) % XMajor <> 0
;         x = Int(x) + 1
;       Else
;         Break
;       EndIf
;     Wend
;    
;     Repeat
;       Move(x,Yarg)
;       If (Int(x) % XMajor) = 0
;         LineRel(0,2*ticklen)
;         LineRel(0,-4*ticklen)
;       Else
;         LineRel(0,ticklen)
;         LineRel(0,-2*ticklen)
;       EndIf
;       If GridOn
;         If (Int(x) % XMajor) <> 0
;           SetLineStyle(#DottedLn, 0, 1)  ; fine dotted line
;         Else
;           SetLineStyle(#SolidLn, 0, #NormWidth)
;         EndIf
;         Move(x, YWorldMin)
;         Draw(x, YWorldMax)
;       EndIf
;       INC(x, XTick)
;     Until (x >= tempmax)
;    
;   EndIf ; ELSE IF (XTick...
;   ; draw y axis tick marks
;   ticklen = Round(YTick_scale*GetMaxX(), #PB_Round_Up)
;   If YWorldMin <= YWorldMax  ; normal axis direction
;     tempmin = YWorldMin
;     tempmax = YWorldMax
;   Else ; axis is reversed from normal
;     tempmin = YWorldMax
;     tempmax = YWorldMin
;   EndIf
;   If YAxisLog  ; y axis is logarithmic
;     decade = Pow(10.0,Log(tempmin)) ; get next lowest decade
;     Repeat
;       Move(Xarg,decade)
;       LineRel(-2*ticklen,0)
;       LineRel(4*ticklen,0)
;       If GridOn
;         Move(XWorldMin,decade)
;         Draw(XWorldMax,decade)
;       EndIf
;       For i = 2 To 9
;         y = decade*i
;         If y <= tempmax
;           Move(Xarg,y)
;           LineRel(-ticklen,0)
;           LineRel(2*ticklen,0)
;         EndIf
;         If GridOn
;           SetLineStyle(#DottedLn,0,1) ; fine dotted line
;           Move(XWorldMin,y)
;           Draw(XWorldMax,y)
;           SetLineStyle(#SolidLn,0,#NormWidth)
;         EndIf
;       Next
;       decade = decade*10.0
;     Until (decade > tempmax)
;   ElseIf YTick > 0.0  ; y axis is linear
;    
;     y = tempmin
;     While y < tempmin + YTick
;       If Int(y) % YMajor <> 0
;         y = Int(y) + 1
;       Else
;         Break
;       EndIf
;     Wend
;    
;     Repeat
;       Move(Xarg, y)
;       If (Int(y) % YMajor) = 0
;         LineRel(-2*ticklen,0)
;         LineRel(4*ticklen,0)
;       Else
;         LineRel(-ticklen,0)
;         LineRel(2*ticklen,0)
;       EndIf
;       If GridOn
;         If (Int(y) % YMajor) <> 0
;           SetLineStyle(#DottedLn, 0, 1) ; fine dotted line
;         Else
;           SetLineStyle(#SolidLn, 0, #NormWidth)
;         EndIf
;         Move(XWorldMin, y)
;         Draw(XWorldMax, y)
;       EndIf
;       INC(y, YTick)
;     Until y > tempmax
;    
;   EndIf
; EndProcedure


;   draws a frame around box determined by XMin,XMax And YMin,YMax;
;   put minor ticks every XTick,YTick interval With major ticks every
;   XMajor,YMajor multiples of XTick,YTick; if GridOn = TRUE a grid
;   is drawn
Procedure Frame(XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)
  SetClipOff()
  ; draw frame around world 
  Move(XWorldMin,YWorldMin)
  Draw(XWorldMax,YWorldMin)
  Draw(XWorldMax,YWorldMax)
  Draw(XWorldMin,YWorldMax)
  Draw(XWorldMin,YWorldMin)
  SetClipOn()
  ; add tick marks 
  Tick_Proc(XWorldMin,YWorldMin,XTick,YTick,XMajor,YMajor,GridOn)
  Tick_Proc(XWorldMax,YWorldMax,XTick,YTick,XMajor,YMajor,GridOn)
EndProcedure


Procedure.s Remove_Zeros(Strng.s)
  Protected.i i,j,z
  Protected.s tmp1,tmp2
  Protected.s signs
  Strng = Trim(Strng)
  i = Len(Strng)
  If (Mid(Strng,i-3,i) = "E+0") Or (Mid(Strng,i-3,i) = "E-0")
    Strng = Mid(Strng,0,i-4)
    i = Len(Strng)
  ElseIf (Mid(Strng,i-4,i) = "E+00") Or (Mid(Strng,i-4,i) = "E-00")
    Strng = Mid(Strng,0,i-5)
    i = Len(Strng)
  ElseIf (Mid(Strng,i-5,i) = "E+000") Or (Mid(Strng,i-5,i) = "E-000")
    Strng = Mid(Strng,0,i-6)
    i = Len(Strng)
  ElseIf (Mid(Strng,i-6,i) = "E+0000") Or (Mid(Strng,i-6,i) = "E-0000")
    Strng = Mid(Strng,0,i-7)
    i = Len(Strng)
  EndIf
  z = FindString(Strng, "E", 1, #PB_String_NoCase)
  If z > 0 
    tmp1 = Mid(Strng,0,z-1)
    If Mid(Strng,z+1,1) = "+" 
      signs = "E+"
      tmp2 = Mid(Strng,z+2,i)
    ElseIf Mid(Strng,z+1,1) = "-" 
      signs = "E-"
      tmp2 = Mid(Strng,z+2,i)
    Else
      tmp2 = Mid(Strng,z+1,i)
    EndIf
    i = Len(tmp1)
    If i > 0 
      While i > 0
        If (Mid(tmp1,i-1,1) = " ") Or (Mid(tmp1,i-1,1) = "0") 
          ;tmp1[i-1] = Chr(0)
          tmp1 = Mid(tmp1,0,i)
          DEC(i)
        Else
          Break
        EndIf
      Wend
    EndIf
    i = Len(tmp1)
    If Mid(tmp1,i-1,1) = "." 
      tmp1 = Mid(tmp1,0,i-2)
    EndIf
    ; start exponent 
    i = -1
    j = Len(tmp2)
    If j > 0 
      While i < j
        If (Mid(tmp2,i+1,1) = " ") Or (Mid(tmp2,i+1,1) = "0") 
          INC(i)
        Else
          Break
        EndIf
      Wend
    EndIf
    If i >= 0 
      tmp2 = Mid(tmp2,i+1,j)
    EndIf
    tmp1 = tmp1 + signs
    tmp1 = tmp1 + tmp2
    Strng = tmp1;
  Else          ; regular number such as 20.0000
    z = FindString(Strng, ".", 1, #PB_String_NoCase)
    If z > 0 
      i = Len(Strng)
      If i > 0 
        While i > 0
          If (Mid(Strng,i,1) = " ") Or (Mid(Strng,i,1) = "0") 
            Strng = Mid(Strng,0,i-1)
            DEC(i)
          Else
            Break
          EndIf
        Wend
      EndIf
      i = Len(Strng)
      If z>0
        ;check for numbers such as -0.302
        tmp1 = Mid(Strng,1,z-1)   ;-0
        tmp2 = Mid(Strng,z+1,i)   ; 302
        If tmp2 = ""
          ProcedureReturn tmp1
        EndIf
        i = Len(tmp1)
        While i > 0
          If (Mid(tmp1,i,1) = " ") Or (Mid(tmp1,i,1) = "0") 
            tmp1 = Mid(tmp1, 0, i-1)
            DEC(i)
          Else
            Break
          EndIf
        Wend
        i = Len(tmp2)
        While i > 0
          If (Mid(tmp2,i,1) = " ") Or (Mid(tmp2,i,1) = "0") 
            tmp2 = Mid(tmp2,0,i-1)
            DEC(i)
          Else
            Break
          EndIf
        Wend
        If tmp2 <> ""
          Strng = tmp1 + "." + tmp2
        Else
          Strng = tmp1
        EndIf
        If Strng = ""
          Strng = "0"
        EndIf
      EndIf
    EndIf
  EndIf
  ProcedureReturn Strng
EndProcedure

;  puts STRING Labl at the top of the plot
Procedure TopTitle(Labl.s)
  Protected.i scale = 24
  Protected.i xw,yw
  SetClipOff()
  xw = Int(XViewMax / 2)  - (Len(Labl)/2)
  yw = -scale
  SetTextStyle(#CourierNewFont,#HorizDir, 16)
  SetTextJustify(#CenterText,#BottomText)
  OutTextXY(xw, yw, Labl)
  SetClipOn()
EndProcedure

;   labels x axis With STRING Labl; Label_Axes sets up variable MaxLabHeight
;   which is used For XAxisTitle offset; if you haven't called Label_Axes,
;   Setup_Graph has initialized MaxLabHeight To 0;
Procedure XAxisTitle(Labl.s)
  Protected.i scale = 12
  Protected.i xw,yw
  SetClipOff()
  xw = Int(XViewMax / 2)
  yw = YViewMax+MaxLabHeight+scale+16;
  SetTextStyle(#CourierNewFont,#HorizDir,16)
  SetTextJustify(#CenterText,#TopText)
  OutTextXY(xw,yw,Labl)
  SetClipOn()
EndProcedure

;   labels y axis With STRING Labl; Label_Axes sets up variable MaxLabLength
;   which is used For YAxisTitle offset; if you haven't called Label_Axes,
;   Setup_Graph has initialized MaxLabLength To 0;
Procedure YAxisTitle(Labl.s)
  Protected.i scale = 40
  Protected.i xw,yw
  SetClipOff()
  xw = -MaxLabLength-scale ; adjust position for length of y axis number labels 
  yw = Int(YViewMax / 2)
  SetTextStyle(#CourierNewFont, #VertDir, 16)
  SetTextJustify(#RightText, #CenterText)
  OutTextXY(xw,yw,Labl)
  SetClipOn()
EndProcedure

;   This Procedure draws a label at position X,Y in world coordinates;
;   the variables "Font,Direction,Size,XJust,YJust" are just As in the
;   BGI description For Turbo Pascal graphics:
;   Font,Direction, And Size are set by a BGI proc "SetTextStyle" And
;   XJust,YJust are set by a BGI proc "SetTextJustify"
Procedure Draw_Label(X.d,Y.d, Strng.s,Font.i,Direction.i,Size.i, XJust.i,YJust.i)
  Protected.i xw,yw
  SetTextJustify(XJust,YJust)
  SetTextStyle(Font,Direction,Size)
  World_to_Window(X,Y,@xw,@yw)
  OutTextXY(xw,yw,Strng)
EndProcedure

;   Draws a pair of axes through XOrg,YOrg With minor tick intervals
;   XTick,YTick, And major ticks every XMajor,YMajor minor tick
;   intervals; if the flag GridOn = TRUE then a grid is drawn
Procedure Axes(XOrg.d,YOrg.d,XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)
  SetClipOn()
  Move(XOrg,YWorldMin) 
  Draw(XOrg,YWorldMax)  ; x axis 
  Move(XWorldMin,YOrg) 
  Draw(XWorldMax,YOrg)  ; y axis 
  Tick_Proc(XOrg,YOrg,XTick,YTick,XMajor,YMajor,GridOn) ; draw tick marks 
EndProcedure

;   Labels axes at intervals LabelX, LabelY; by convention you may
;   want this To be :
;       LabelX = XMajor*XTick
;       LabelY = YMajor*YTick
;   in your program
Procedure Label_Axes(LabelX.d,LabelY.d, textsize.i=10)
  Protected.i x_location = 8  ; factors for positioning labels 
  Protected.i y_location = 8
  Protected.i xloc,yloc,templength,tempheight
  Protected.d tempminx,tempmaxx,tempminy,tempmaxy
  Protected.d x,y
  Protected.s labl
  SetClipOff()
  SetTextStyle(#TimesNewRomanFont,#HorizDir,textsize)
  If XWorldMin <= XWorldMax  ; regular axis direction 
    If XAxisLog
    ; adjust limits to ensure end labels are shown 
      World_to_Window(XWorldMin,YWorldMin,@xloc,@yloc)
      Window_to_World(xloc-1,yloc,@tempminx,@y)
      World_to_Window(XWorldMax,YWorldMin,@xloc,@yloc)
      Window_to_World(xloc+1,yloc,@tempmaxx,@y)
    Else ; X axis is linear 
      tempminx = XWorldMin
      tempmaxx = XWorldMax
    EndIf
  Else ; reversed axis direction 
    If XAxisLog
    ; adjust limits to ensure end labels are shown 
      World_to_Window(XWorldMax,YWorldMin,@xloc,@yloc)
      Window_to_World(xloc+1,yloc,@tempminx,@y)
      World_to_Window(XWorldMin,YWorldMin,@xloc,@yloc)
      Window_to_World(xloc-1,yloc,@tempmaxx,@y)
    Else ; X axis is linear 
      tempminx = XWorldMax
      tempmaxx = XWorldMin
    EndIf
  EndIf

  If YWorldMin <= YWorldMax  ; regular axis direction 
    If YAxisLog
    ; adjust limits to ensure end labels are shown 
      World_to_Window(XWorldMin,YWorldMin,@xloc,@yloc)
      Window_to_World(xloc,yloc+1,@x,@tempminy)
      World_to_Window(XWorldMin,YWorldMax,@xloc,@yloc)
      Window_to_World(xloc,yloc-1,@x,@tempmaxy)
    Else ; Y axis is linear 
     tempminy = YWorldMin
     tempmaxy = YWorldMax
    EndIf
  Else ; reversed axis direction 
    If YAxisLog
    ; adjust limits to ensure end labels are shown 
      World_to_Window(XWorldMin,YWorldMax,@xloc,@yloc)
      Window_to_World(xloc,yloc-1,@x,@tempminy)
      World_to_Window(XWorldMin,YWorldMin,@xloc,@yloc)
      Window_to_World(xloc,yloc+1,@x,@tempmaxy)
    Else ; Y axis is linear 
      tempminy = YWorldMax
      tempmaxy = YWorldMin
    EndIf
  EndIf
  ; label x axis 
  MaxLabHeight = 0; ; initialize this offset for XAxisTitle 
  tempheight = 0;
  SetTextJustify(#CenterText, #TopText) ; do this just once for linear axis 
  x = tempminx
  If XAxisLog 
    x = Pow(10.0,Log10(tempminx))
  EndIf
  While x <= tempmaxx
    If XAxisLog
      labl = StrD(Log10(x), 3) ; was 6
    Else
      labl = StrD(x, 3) ; was 5
    EndIf
    labl = Remove_Zeros(labl)
    World_to_Window(x,YWorldMin,@xloc,@yloc)
    If XAxisLog  ; do an exponentiated label 
      If (x >= tempminx) And (x <= tempmaxx)
        SetTextJustify(#CenterText, #TopText)
        INC(yloc, y_location+13) ; position the "10" 
        OutTextXY(xloc,yloc,"10")
        tempheight = TextHeights("10") + Int(TextHeights(labl)-4)
        DEC(yloc, Int(tempheight / 2))
        INC(xloc, Int(TextWidths("10") / 2) + 3)
        tempheight = Int(tempheight / 2) + Int(TextHeights(labl)) ; pixel height of label 
        SetTextJustify(#LeftText,#TopText)
        OutTextXY(xloc,yloc,labl)
      EndIf ; IF ((x >= tempminx... 
      x = x*10.0
    Else ; straight linear label 
      INC(yloc,y_location)
      OutTextXY(xloc,yloc,labl)
      tempheight = TextHeights(labl)
      INC(x+LabelX)
    EndIf ; IF (XAxisLog)... 
    If tempheight > MaxLabHeight
      MaxLabHeight = tempheight
    EndIf
  Wend ; WHILE 
  ; label y axis 
  MaxLabLength = 0 ; initialize this offset for YAxisTitle 
  templength = 0
  SetTextJustify(#RightText,#CenterText)
  y = tempminy
  If YAxisLog 
    y = Pow(10.0,Log10(tempminy))
  EndIf
  While y <= tempmaxy
    If YAxisLog
      labl = StrD(Log10(y), 3) ; was 6
    Else
      labl = StrD(y, 3) ; was 5
    EndIf
    labl = Remove_Zeros(labl)
    World_to_Window(XWorldMin,y,@xloc,@yloc)
    If YAxisLog  ; do an exponentiated label 
      If (y >= tempminy) And (y <= tempmaxy)
        SetTextJustify(#RightText,#CenterText)
        templength = TextWidths("10") + Int(TextWidths(labl)/2)
        DEC(xloc,x_location-templength) ; position the "10" 
        OutTextXY(xloc,yloc,"10")
        templength = templength + Int(TextWidths(labl)) ; pixel width of label 
        DEC(yloc,Int(TextHeights("10") / 2))
        INC(xloc,2)
        SetTextJustify(#LeftText,#CenterText)
        OutTextXY(xloc,yloc,labl)
      EndIf ; IF ((y >= tempminy... 
      y = y * 10.0
    Else ; straight linear label 
      DEC(xloc,x_location)
      OutTextXY(xloc,yloc,labl)
      templength = TextWidths(labl)
      INC(y,LabelY)
    EndIf
    If (templength > MaxLabLength)  
      MaxLabLength = templength 
    EndIf
  Wend
  ; restore defaults 
  SetClipOn()
EndProcedure

;   Procedure To set up the graph limits.
;   The world coordinate limits are XMin, XMax, YMin, And YMax.
;   The window limits are WXMin, WXMax, WYMin, WYMax expressed As
;   fractions (of 1,i.e. 0.95 etc) of the maximum screen limits.
Procedure Setup_Graph(XMin.d,XMax.d,YMin.d,YMax.d, WXMin.d,WXMax.d,WYMin.d,WYMax.d,logx.b,logy.b)
   If logx = #True
     XAxisLog = #True
   Else 
     XAxisLog = #False 
   EndIf
   If logy = #True
     YAxisLog = #True
   Else 
     YAxisLog = #False 
   EndIf
  ; set global variables for other graphics routines. 
  XWorldMin = XMin
  XWorldMax = XMax
  YWorldMin = YMin
  YWorldMax = YMax
  Setscale(WXMin,WXMax,WYMin,WYMax)
  ; initialize some global constants just in case Label_Axes is not called 
  MaxLabLength = 0
  MaxLabHeight = 0
  ; set up defaults for graphics parameters 
  SetClipOn()
  Custom_LineStyle(0) = $0FFFF
  Custom_LineStyle(1) = $5555
  Custom_LineStyle(2) = $0F0F
  Custom_LineStyle(3) = $1111
  Custom_LineStyle(4) = $1010
EndProcedure


;   Plots a Symbol, scaled by SymSize, centered at world coordinates
;   X,Y; available Symbols are:
;     1  - plus
;     2  - box
;     3  - cross (x-like)
;     4  - triangle
;     5  - inverted triangle
;     6  - open circle
;     7  - filled circle
;     8  - dot
Procedure PlotPoint(X.d,Y.d, Symbol.i, SymSize.i, color.i)
  Protected.i del = 1
  Protected.i xs,ys,delta,x1,y1
  Protected.i curcol
  x1 = GetXX() 
  y1 = GetYY()
  curcol = GetColor()
  SetColor(color)
  World_to_Window(X,Y,@xs,@ys)
  delta = del*SymSize;
  Select Symbol
    Case 1   ; plus 
         MoveTo(xs-delta,ys)
         LineRel(2*delta,0)
         MoveRel(-delta,-delta)
         LineRel(0,2*delta)
    Case 2   ; box 
         MoveTo(xs-delta,ys-delta)
         LineRel(2*delta,0)
         LineRel(0,2*delta)
         LineRel(-2*delta,0)
         LineRel(0,-2*delta)
    Case 3   ; cross 
         MoveTo(xs-delta,ys-delta)
         LineRel(2*delta,2*delta)
         MoveRel(-2*delta,0)
         LineRel(2*delta,-2*delta)
    Case 4:   ; triangle 
         MoveTo(xs,Int(ys-delta-delta / 3))
         LineRel(-delta,2*delta)
         LineRel(2*delta,0)
         LineRel(-delta,-2*delta)
    Case 5   ; inverted triangle 
         MoveTo(xs,Int(ys+delta+delta / 3))
         LineRel(-delta,-2*delta)
         LineRel(2*delta,0)
         LineRel(-delta,2*delta)
    Case 6 
         Circles(xs,ys,delta) ; open circle 
    Case 7 
      FillEllipse(xs,ys,delta,delta, color) ; closed circle 
    Case 8 
      PutPixel(xs,ys,GetMaxColor()) ; unscaled point 
  Default
  EndSelect
  MoveTo(x1,y1)
  SetColor(curcol)
EndProcedure

;   Plots a Symbol, scaled by SymSize, centered at world coordinates
;   X,Y; error bar on X,Y are sigx and sigy; available Symbols are:
;     1  - plus
;     2  - box
;     3  - cross (x-like)
;     4  - triangle
;     5  - inverted triangle
;     6  - open circle
;     7  - filled circle
;     8  - dot
Procedure PlotData(x.d,sigx.d,y,sigy.d, Symbol.i, SymSize.i, color.i)
  Protected.i del = 1
  Protected.i xs,ys,delta,xx,yy
  PlotPoint(x,y,Symbol,SymSize, color)
  delta = del*SymSize
  xx = GetXX() 
  yy = GetYY()
  If (sigx > 0.0)  ; do x error bar 
    Move(x+sigx,y)
    Draw(x-sigx,y)
    World_to_Window(x+sigx,y,@xs,@ys)
    MoveTo(xs,ys-delta)
    LineRel(0,2*delta)
    World_to_Window(x-sigx,y,@xs,@ys)
    MoveTo(xs,ys-delta)
    LineRel(0,2*delta)
  EndIf
  If (sigy > 0.0)  ; do y error bar 
    Move(x,y+sigy)
    Draw(x,y-sigy)
    World_to_Window(x,y+sigy,@xs,@ys)
    MoveTo(xs-delta,ys)
    LineRel(2*delta,0)
    World_to_Window(x,y-sigy,@xs,@ys)
    MoveTo(xs-delta,ys)
    LineRel(2*delta,0)
  EndIf
  MoveTo(xx,yy)
EndProcedure

EndModule

Code: Select all

XIncludeFile "MINIPLOT.pbi"
XIncludeFile "MINIBGI.pbi"

UseModule MINIPLOT
UseModule MINIBGI
EnableExplicit 

Procedure.d sinc(x.d)
If x=0.0 
  ProcedureReturn 1.0 
Else 
  ProcedureReturn Sin(x/(x*x))
EndIf
EndProcedure

Global x.d,xwin=800, ywin=800
Global Event.i, Quit.i, wnum.i,MaxX.i,MaxY.i,MaxRadius.i

InitGraph(xwin, ywin, "tester")
Setup_Graph(-5.0, 20.0, -0.5, 2.5, 10.0, 85.0, 10.0, 85.0, #False, #False)
SetColor(#Black)
Frame(1.0,0.1,5,5,#True)
SetColor(#Red)
Axes(1.0,1.0,5.0,5.0,5,5,#True)
SetColor(#Black)
Label_Axes(1.0,0.5)
TopTitle("Sinc Function")
XAxisTitle("x (radians)")
YAxisTitle("Sin(x/x*x)")

x = -50
SetColor(#Blue)
SetClipOn()
Move(x,sinc(x))
x = x + 0.5
Repeat
  ;Draw(x,sinc(x)+1)
  Draw_Symbol(x, sinc(x)+1, #FillRect, 3, #Red)
  INC(x, 0.5)
Until x > 80
SetClipOff()
  
   
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      Quit = 1
    EndIf
  Until Quit = 1
;EndIf

End   ; All the opened windows are closed automatically by PureBasic

Code: Select all

XIncludeFile "MINIBGI.pbi"
;[color=#FF0000]XIncludeFile "colors.pbi"[/color]

Procedure.l RGB_(r.l, g.l, b.l)
    ProcedureReturn ((b << 16) | (g << 8) | r) ;| $02000000
EndProcedure
  
UseModule MINIBGI
 x.i = #Red

EnableExplicit 


Global Event.i, Quit.i, wnum.i,MaxX.i,MaxY.i,MaxRadius.i
Global.i x1,x2,y1,y2, imagehook.i, windowrect.i
wnum = InitGraph(600, 600, "tester")
If wnum
  SetColor(#Black)
  SetBkColor(#White)
  ClearDevice()
  ClearViewPort()
  
  SetColor(#AlizarinCrimson)
  SetFillStyle(#HatchFill,  #BeauBlue)
  ;SetLineStyle(#SolidLn, #SolidFill, 1)
  ;SetBkColor(#AlizarinCrimson)
  MaxX=GetMaxX(): MaxY=GetMaxY()
  MaxRadius = MaxY / 10
  FillEllipse((MaxX)-100,(MaxY)-100,(MaxRadius),(MaxRadius),#DeepLemon)

  ;SetFillStyle(#NoFill, #ArmyGreen)    
  SetColor(#ArmyGreen)
  ;SetFillStyle(#HatchFill, #BeauBlue)
  ;SetLineStyle(#SolidLn, #SolidFill, 1)
  Lines(250, 250,400, 400)
                      ;$00F5C71A  
  DrawSymbol(200, 200, #DeepLemon, #SYMBOLRECTANGLE, 30, 30)
  
  SetFillStyle(#NoFill, #ArmyGreen) 
  SetColor(#AlizarinCrimson)
  SetFillStyle(#HatchFill,  #DeepLemon)
  ;SetLineStyle(#SolidLn, #SolidFill, 1)
  Sector(100,100, 20,90, 220,20)
  
  SetColor(#AlizarinCrimson)
  ;SetBkColor(#White)
  OutTextXY(10,10, "dlfdsf dsf sd kdlsfs fkdsf dsf ds")
  SetColor(#AlizarinCrimson)
  Sleep_(800)
  ReSetWindowSize(800, 800)
  LineCaped(300, 100, 490, 200, #SArrow, #SCircle, #Green, #Blue, #True, #True)
  MaxX=GetMaxX(): MaxY=GetMaxY()
  MaxRadius = MaxY / 10
  FillEllipse((MaxX)-100,(MaxY)-100,(MaxRadius),(MaxRadius),#DeepLemon)

  ;Rectangle(300, 100, 490, 200)
  ;RotEllipse(300, 100,45,20,30)
  ;Sector(300, 100, 10,90,40,40)
  ;Bar3D(300, 100, 490, 200, 50, 30, #Green)
  SetColor(#AlizarinCrimson)
  SetFillStyle(#HatchFill, #ArmyGreen) 
  ;InvertRect(300, 100, 490, 200)
  ;OutTextXY(100,200, "dlfdsf dsf sd kdlsfs fkdsf dsf ds")
  
;   imagehook = GetImageNumber()
;   windowrect = GetHWND()
;   Debug "Image Height = " + ImageHeight(imagehook) + " mm"
;   Debug "Image Width = " + ImageWidth(imagehook) + " mm" 
;   Debug "Screen Horizontal resolution = " + WindowHeight(windowrect) + " dpi"
;   Debug "Screen Vertical resolution = " + WindowWidth(windowrect) + " dpi"
  
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      Quit = 1
    EndIf
  Until Quit = 1
  CloseGraph()
EndIf

End   ; All the opened windows are closed automatically by PureBasic