PureBasic Forums - English

Code: Select all

DeclareModule CanvasBgi

EnableExplicit
;DisableDebugger

#NrVideoPages = 2
#FullScr = 0
#CustScr = 1
#ClipOn = #True
#ClipOff = #False
#EmptyFill = 0
#SolidFill = 1
#LineFill  = 2
#ColFill   = 3
#HatchFill = 4
#SlashFill = 5
#BkSlashFill= 6
#XHatchFill = 7
#UserFill   = 8
#NoFill     = 9
#SolidLn   = 0
#DottedLn  = 1
#DashDotLn = 2
#DashedLn  = 3
#DashDotDotLn = 4
#UserBitLn = 5
#NullLn    = 6
#Rad = #PI/180.0
#NormWidth   = 1
#DoubleWidth = 2
#TripleWidth = 3
#QuadWidth   = 4
#ThickWidth  = #TripleWidth
#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 = 0
;#OPAQUE    = 16
#BorderFlood  = 0
#SurfaceFlood = 1
#NrMaxFonts = 25
#MinCharSize = 2
#LeftText   = 0
#CenterText = 1
#RightText  = 2
#TopText    = 0
#BottomText = 1
#BaselineText = 2
#HorizDir =  0
#VertDir  = 90
#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 WINDOW
  WinMaxY.i
  WinMaxX.i
  windowWidth.i
  windowHeight.i
  winNum.i
  winHwnd.i
  title.s
  canvasnum.i
  scroller.i
EndStructure

Structure GDIMAP
  Hdc.i
  Bitmap.i
  maxX.i
  maxY.i
  bitPixel.i
  maxColors.i
  monitorWidth.i
  monitorHeight.i
  Pen.i
  Brush.i
  PenColor.i
  BrushColor.i
  lineStyle.i
  lineThickness.i
  transparentmode.b
EndStructure

Structure MEMORYIMAGE
  width.i
  height.i
  size.i
  *bits
EndStructure

Structure ViewPortType
  x1.i
  y1.i
  x2.i
  y2.i
  clip.b
EndStructure

Structure ArcCoordsType
  x.i
  y.i
  xstart.i
  ystart.i
  xend.i
  yend.i
EndStructure

Structure FillSettingsType
  pattern.i
  color.i
EndStructure

Structure LineSettingsType
  linestyle.i
  pattern.i
  thickness.i
EndStructure

Structure TextSettingsType
  font.w
  direction.w
  charsize.w
  horiz.w
  vert.w
EndStructure

Structure ThreeDPointType
  x.d
  y.d
  z.d
EndStructure

Global.GDIMAP gdi1, gdi2
Global.WINDOW gdiwin

Declare.i CreateGdiWindow(*gdiwindow.WINDOW, *NewGdiMap.GDIMAP, custWidth.i=400, custHeight.i=400, title.s="", winnum.i=0, winsize.i = #CustScr)
Declare GetRGBComponents(color.i, *r.integer, *g.integer, *b.integer, *a.integer)
Declare.i GetMaxColor()
Declare.i GetBkColor()
Declare.i GetColor()
Declare SetWriteMode(writemode.i)
Declare ResetWriteMode()
; #PS_SOLID           - A continuous solid line
; #PS_DASH            - A continuous line With dashed interruptions
; #PS_DOT              - A line With a dot interruption at every other pixel
; #PS_DASHDOT          - A combination of alternating dashed And dotted points
; #PS_DASHDOTDOT      - A combination of dash And double dotted interruptions
; #PS_NULL           -   No visible line
; #PS_INSIDEFRAME     -   A line drawn just inside of the border of a closed shape
Declare SetDrawingColor(color.i, lineStyle.i=#PS_SOLID, lineThickness.i=1)
Declare SetLineSyle(lineStyle.i)
Declare SetLinePenWidth(lineThickness.i)
Declare.i GetLinePenWidth()
Declare.i GetLinePenSyle()
Declare.i GetDrawingPenColor()
Declare.i GetFillBrushColor()
Declare SetFillBrushColor(color.i)
Declare SetBackColor(color.i)
Declare SetTextColor(color.i)
Declare SetColor(color.i)
Declare SetTransparentMode()
Declare MoveTo(x.i,y.i)
Declare Bar(x1.i,y1.i,x2.i,y2.i)
Declare SetActivePage(page.i)
Declare SetVisualPage(page.i)
Declare SetAspectRatio(xasp.i, yasp.i)
Declare GetAspectRatio(*xasp.integer, *yasp.integer)
Declare.i GetMaxX()
Declare.i GetMaxY()
Declare GetViewSettings(*viewportt.ViewPortType);
Declare GetViewPort(*viewportt.ViewPortType);
Declare.i GetXX()
Declare.i GetYY()
Declare SetFillStyle(pattern.i, color.i)
Declare SetFillPattern(Array fillpattern.b(1), color.i)
Declare ClearViewPort()
Declare SetViewPort(x1.i, y1.i, x2.i, y2.i, clip.b)
Declare ClearDevice()
Declare Ellipsee(x.i,y.i,start.i,stop.i,xradius.i,yradius.i)
Declare Arc(x.i,y.i,start.i,stop.i,radius.i)
Declare Circlee(x.i,y.i,radius.i)
Declare DrawBezier(nrpoints.i, Array polypoints.POINT(1))
Declare FillPoly(nrpoints.i, Array polypoints.POINT(1))
Declare DrawPoly(nrpoints.i, Array polypoints.POINT(1))
Declare GetArcCoords(*arccoords.ArcCoordsType)
Declare GetLineSettings(*lineinfo.LineSettingsType)
Declare PutPixel(x.i,y.i,color.i)
Declare.i GetPixel(x.i, y.i)
Declare FillRect(x1.i,y1.i,x2.i,y2.i)
Declare Bar3D(x1.i,y1.i,x2.i,y2.i, depth.i, top.i)
Declare Chord(x.i,y.i,start.i,stop.i,xradius.i,yradius.i)
Declare Rectangle(x1.l,y1.l,x2.l,y2.l)
Declare FloodFill(x.i,y.i,color.i)
Declare LineProc(x.i,y.i,param.i)
Declare LineTo(x.i,y.i)
Declare Linee(x1.i,y1.i,x2.i,y2.i)
Declare LineRel(dx.i,dy.i)
Declare MoveRel(dx.i,dy.i)
Declare FillEllipse(x.l,y.l,xradius.i,yradius.i)
Declare RotEllipse(x.i,y.i,rot.i,xradius.i,yradius.i)
;   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
Declare PlotSymbol(X.d,Y.d, Symbol.i, SymSize.i, color.i=-1)
Declare CalcAnglePoint(x1.d, y1.d, distance.d, angle.d, *endX.double, *endY.double)
Declare GetFillPattern(Array *fillpatternn.byte(1))
Declare GetFillSettings(*fillinfo.FillSettingsType)
#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, filledl.i=#False, filledr.i=#False)
Declare SetLineStyle(linestyle.i,pattern.i,thickness.i)
Declare InvertRect(x1.i,y1.i,x2.i,y2.i)
Declare Sector(x.l,y.l, start.i,stop.i,xradius.i,yradius.i)
Declare PieSlice(x.i,y.i,start.i,stop.i,radius.i)
Declare RoundRect(x1.l,y1.l,x2.l,y2.l,r.l)
Declare SetFloodMode(floodmode.l)
Declare GetTextSettings(*textinfo.TextSettingsType)
Declare SetLineWidth(thickness.i)
Declare SetLinePattern(pattern.i)
Declare SetStyleLine(linestyle.i)
Declare GetFontSettings(fontname.s, *width.integer, *height.integer, *ttfont.integer)
Declare.i EnumFontFamProc(*lpelf.LOGFONT, *lpntm.NEWTEXTMETRIC, FontType.l, param.i) ;:LPARAM
Declare.i InstallUserFont(fontname.s)
Declare InstallDefaultFonts()
Declare OutText(textstring.s)
Declare OutTextXY(x.i,y.i,textstring.s)
Declare SetTextJustify(horiz.i, vert.i)
Declare SetTextStyle(font.i,direction.l,charsize.l)
Declare SetTextFontSize(charsize.i)
Declare SetTextFont(font.i)
Declare SetTextDirection(direction.i)
Declare SetUserCharSize(nCharExtra.i,nBreakExtra.i);,dummy1.i,dummy2.i)
Declare.i TextHeightt(textstring.s)
Declare.i TextWidthh(textstring.s)
;   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
Declare PlotSymbol1(X.d,Y.d, Symbol.i, SymSize.i, color.i=-1)
Declare DrawSymbol(x.l, y.l, color.l, symbol.l, width.l, height.l)
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 GetDrawingWindowRectangle(*xy.RECT, wsthickframe.b)
Declare.b PointInDrawingWindowRectangle(x.i,y.i,*xy.RECT,wsthickframe.b)
Declare BitmapToImage(bitmap.i, imagetobefilled.i)
Declare GetImage(x1.i,y1.i,x2.i,y2.i,*bmp.BITMAP)
;   #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
Declare PutImage(x1.i,y1.i,*bmp.BITMAP,rop.i=#SRCAND)
Declare GetMemImage(x1.i,y1.i,x2.i,y2.i,*bitmap.MEMORYIMAGE)
Declare PutMemImage(x1.i,y1.i,*bitmap.MEMORYIMAGE, rop.i=#SRCAND)
Declare.i ImageSize(x1.i,y1.i,x2.i,y2.i,bitsize.i)
Declare.i MemoryImageSize(x1.i,y1.i,x2.i,y2.i,bitsize.i)
Declare UpdateBgi(winnum.i)
Declare BgiStartup(winsizex, winsizey, wintitle.s, bitsizex.i, bitsizey.i, parentwinnum.i=0) 
Declare.i IsBgiWindowOpen()

EndDeclareModule


Module CanvasBgi
  
UseJPEGImageDecoder()

Global.i Event, Thread
Global viewPort.ViewPortType,grClip.i=#Null
Global.i viewPortWidth,viewPortHeight,origX,origY,actX,actY,aspX=10000,aspY=10000,frColor,bkColor
Global.i grDirect=#True,activePage=0,visualPage
Global.i defAspectRatio, globalTemp = 0, floodMode, grFont, old_Font
Global.i grPattern  ;HBITMAP
Global.FillSettingsType fillSettings
Global.ArcCoordsType lastArcCoords
Global.LineSettingsType lineSettings
Global.TextSettingsType textSettings
Global.i grPen,old_Pen ;HPEN
Global.i grBrush,old_Brush ;HBRUSH
Global Dim fillPattern.b(8)
Global Dim instFont.s(#NrMaxFonts-1)
Global.GDIMAP grMemory

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 CreateBitmaps(*NewGdiMap.GDIMAP, xsize.i, ysize.i, bitPixel.i = 32, backGroundColor.i=#White) 
  Protected *pvBits, bmi.BITMAPINFO, dc.i, hBrush.i
  dc = CreateDC_("DISPLAY",0,0,0)
  *NewGdiMap\Hdc = CreateCompatibleDC_(0)
  bmi\bmiHeader\biSize     = SizeOf(BITMAPINFOHEADER) 
  bmi\bmiHeader\biWidth    = xsize
  bmi\bmiHeader\biHeight   = ysize
  bmi\bmiHeader\biPlanes   = 1 
  bmi\bmiHeader\biBitCount = bitPixel
  bmi\bmiHeader\biCompression = #BI_RGB 
  *NewGdiMap\Bitmap = CreateDIBSection_(*NewGdiMap\Hdc, bmi, #DIB_RGB_COLORS, @*pvBits, 0, 0)
  SelectObject_(*NewGdiMap\Hdc, *NewGdiMap\Bitmap)
  DeleteDC_(dc)
  hBrush = CreateSolidBrush_(backGroundColor)  
  SelectObject_(*NewGdiMap\Hdc, hBrush)
  Rectangle_(*NewGdiMap\Hdc, 0, 0, xsize, ysize)
  DeleteObject_(hBrush)
  *NewGdiMap\maxX = xsize
  *NewGdiMap\maxY = ysize
  *NewGdiMap\bitPixel = bitPixel
  *NewGdiMap\maxColors = 1 << bitPixel
  *NewGdiMap\monitorWidth  = GetSystemMetrics_(#SM_CXSCREEN)
  *NewGdiMap\monitorHeight = GetSystemMetrics_(#SM_CYSCREEN)
  *NewGdiMap\transparentmode = #False
  floodMode=#BorderFlood
  FillMemory(@fillPattern(0), 8, $FF, #PB_Byte)
EndProcedure

Procedure BitmapToImage(bitmap.i, imagetobefilled.i)
  StartDrawing(ImageOutput(imagetobefilled))
    DrawImage(bitmap,0,0)
  StopDrawing()
EndProcedure

Procedure GetRGBComponents(color.i, *r.integer, *g.integer, *b.integer, *a.integer)
  *r\i=Red(color)
  *g\i=Green(color)
  *b\i=Blue(color)
  *a\i=Alpha(color)
EndProcedure

Procedure.i GetMaxColor()
  ProcedureReturn gdi1\maxColors
EndProcedure

Procedure.i GetBkColor()
  ProcedureReturn bkColor
EndProcedure

Procedure.i GetColor()
  ProcedureReturn frColor
EndProcedure

Procedure SetWriteMode(writemode.i)
  Protected.i 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_(gdi1\Hdc,fnDrawMode)
  SetBkMode_(gdi1\Hdc,iBkMode)
  SetROP2_(gdi2\Hdc,fnDrawMode)
  SetBkMode_(gdi2\Hdc,iBkMode)
  GdiFlush_()
EndProcedure

Procedure ResetWriteMode()
  SetWriteMode(#CopyMode | #TRANSPARENT)
EndProcedure



; #PS_SOLID           - A continuous solid line
; #PS_DASH            - A continuous line With dashed interruptions
; #PS_DOT              - A line With a dot interruption at every other pixel
; #PS_DASHDOT          - A combination of alternating dashed And dotted points
; #PS_DASHDOTDOT      - A combination of dash And double dotted interruptions
; #PS_NULL           -   No visible line
; #PS_INSIDEFRAME     -   A line drawn just inside of the border of a closed shape
Procedure SetDrawingColor(color.i, lineStyle.i=#PS_SOLID, lineThickness.i=1)
  ;SetDCPenColor_(gdi1\Hdc, color)
  DeleteObject_(gdi1\Pen)
  gdi1\Pen = CreatePen_(lineStyle, lineThickness, color)
  SelectObject_(gdi1\Hdc, gdi1\Pen)
  gdi1\PenColor = color
  gdi1\lineStyle = lineStyle
  gdi1\lineThickness = lineThickness
  
  DeleteObject_(gdi2\Pen)
  gdi2\Pen = CreatePen_(lineStyle, lineThickness, color)
  SelectObject_(gdi2\Hdc, gdi2\Pen)
  gdi2\PenColor = color
  gdi2\lineStyle = lineStyle
  gdi2\lineThickness = lineThickness
EndProcedure

Procedure SetLineSyle(lineStyle.i)
  DeleteObject_(gdi1\Pen)
  gdi1\Pen = CreatePen_(lineStyle, gdi1\lineThickness, gdi1\PenColor)
  SelectObject_(gdi1\Hdc, gdi1\Pen)
  gdi1\lineStyle = lineStyle
  
  DeleteObject_(gdi2\Pen)
  gdi2\Pen = CreatePen_(lineStyle, gdi1\lineThickness, gdi2\PenColor)
  SelectObject_(gdi2\Hdc, gdi2\Pen)
  gdi2\lineStyle = lineStyle
EndProcedure

Procedure SetLinePenWidth(lineThickness.i)
  DeleteObject_(gdi1\Pen)
  gdi1\Pen = CreatePen_(gdi1\lineStyle, lineThickness, gdi1\PenColor)
  SelectObject_(gdi1\Hdc, gdi1\Pen)
  gdi1\lineThickness = lineThickness
  
  DeleteObject_(gdi2\Pen)
  gdi2\Pen = CreatePen_(gdi1\lineStyle, lineThickness, gdi2\PenColor)
  SelectObject_(gdi2\Hdc, gdi2\Pen)
  gdi2\lineThickness = lineThickness
EndProcedure

Procedure.i GetLinePenWidth()
  ProcedureReturn gdi1\lineThickness
EndProcedure

Procedure.i GetLinePenSyle()
  ProcedureReturn gdi1\lineStyle
EndProcedure

Procedure.i GetDrawingPenColor()
  ProcedureReturn gdi1\PenColor
EndProcedure

Procedure.i GetFillBrushColor()
  ProcedureReturn gdi1\BrushColor
EndProcedure

Procedure SetFillBrushColor(color.i)
  DeleteObject_(gdi1\Brush)
  gdi1\Brush = CreateSolidBrush_(color)  
  SelectObject_(gdi1\Hdc, gdi1\Brush)
  gdi1\BrushColor = color
  
  DeleteObject_(gdi2\Brush)
  gdi2\Brush = CreateSolidBrush_(color)  
  SelectObject_(gdi2\Hdc, gdi2\Brush)
  gdi2\BrushColor = color
EndProcedure

Procedure SetBackColor(color.i)
  SetBkColor_(gdi1\Hdc,color)
  SetBkColor_(gdi2\Hdc,color)
  bkColor=color
EndProcedure

Procedure SetTextColor(color.i)
  SetTextColor_(gdi1\Hdc, color)
  SetTextColor_(gdi2\Hdc, color)
  frColor = color
EndProcedure

Procedure SetColor(color.i)
  SetTextColor_(gdi1\Hdc, color)
  SetTextColor_(gdi2\Hdc, color)
  frColor = color
EndProcedure

Procedure SetTransparentMode()
  If gdi1\transparentmode 
    SetBkMode_(gdi1\Hdc, #OPAQUE)
    SetBkMode_(gdi2\Hdc, #OPAQUE)
  Else
    SetBkMode_(gdi1\Hdc, #TRANSPARENT)
    SetBkMode_(gdi2\Hdc, #TRANSPARENT)
  EndIf
EndProcedure

Procedure MoveTo(x.i,y.i)
  ;Protected d.POINT
  actX=x
  actY=y
  x+origX
  y+origY
  MoveToEx_(gdi1\Hdc,x,y,#Null)
  MoveToEx_(gdi2\Hdc,x,y,#Null)
  GdiFlush_()
EndProcedure

Code: Select all

Procedure Bar(x1.i,y1.i,x2.i,y2.i)
  Protected rc.RECT
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  x1 + origX
  y1 + origY
  x2 + origX
  y2 + origY
  SetRect_(rc,x1,y1,x2+1,y2+1)
  If grDirect 
    FillRect_(gdi1\Hdc,rc,grBrush) 
  EndIf
  FillRect_(gdi2\Hdc,rc,grBrush)
  GdiFlush_()
EndProcedure

Procedure SetActivePage(page.i)
  If (page >= 2) 
    page=0
  EndIf
  activePage = page
  ;SelectObject(grMemory,grBitmap[activePage]:HGDIOBJ);
  If activepage = 0
    grMemory = gdi1
    ;CopyMemory(@gdi1, @grMemory, SizeOf(GDIMAP))
  Else
    grMemory = gdi2
  EndIf  
  grDirect = Bool(activePage = visualPage)
  ResizeWindow(gdiwin\winNum, #PB_Ignore,#PB_Ignore,#PB_Ignore,#PB_Ignore)
EndProcedure

Procedure SetVisualPage(page.i)
  Protected *lpRect.RECT = #Null
  If (page >= #NrVideoPages) 
    page=0 
  EndIf
  visualPage = page
  grDirect= Bool(activePage = visualPage)
  InvalidateRect_(gdiwin\winHwnd,*lpRect,#False)
EndProcedure

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

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

Procedure.i GetMaxX()
  ProcedureReturn gdi1\maxX
EndProcedure

Procedure.i GetMaxY()
  ProcedureReturn gdi1\maxY
EndProcedure

Procedure GetViewSettings(*viewportt.ViewPortType);
  *viewportt = viewPort
EndProcedure

Procedure GetViewPort(*viewportt.ViewPortType);
  *viewportt = viewPort
EndProcedure

Procedure.i GetXX()
  ProcedureReturn actX
EndProcedure

Procedure.i GetYY()
  ProcedureReturn actY
EndProcedure

Procedure SetFillStyle(pattern.i, color.i)
  Protected lplb.LOGBRUSH
  Protected old.i
  With lplb
    \lbStyle=#BS_HATCHED;
    \lbHatch=0;
    Select pattern
      Case #SolidFill  : \lbStyle=#BS_SOLID
      Case #EmptyFill  : \lbStyle=#BS_SOLID
                        color=bkColor
      Case #LineFill   : \lbHatch=#HS_HORIZONTAL
      Case #ColFill    : \lbHatch=#HS_VERTICAL
      Case #HatchFill  : \lbHatch=#HS_CROSS
      Case #SlashFill  : \lbHatch=#HS_BDIAGONAL
      Case #BkSlashFill: \lbHatch=#HS_FDIAGONAL
      Case #XHatchFill : \lbHatch=#HS_DIAGCROSS
      Case #UserFill   : \lbStyle=#BS_PATTERN
                        \lbHatch=(grPattern)
      Case #NoFill     : \lbStyle=#BS_NULL
    Default
      ProcedureReturn
    EndSelect
    \lbColor=color
  EndWith
  fillSettings\pattern=pattern
  fillSettings\color=color
  grBrush=CreateBrushIndirect_(lplb)
  old=SelectObject_(gdi1\Hdc,grBrush) 
  SelectObject_(gdi2\Hdc,grBrush)
  If (old <> old_Brush)
    DeleteObject_(old)
  EndIf
  GdiFlush_()
EndProcedure

Procedure SetFillPattern(Array fillpattern.b(1), color.i)
  Protected.i i,j
  Protected.i col0,col1
  Protected.b b
  col1 = color
  col0 = bkcolor
  If grPattern <> #Null
    DeleteObject_(grPattern)
  EndIf
  grPattern = CreateCompatibleBitmap_(gdi1\Hdc,8,8)
  SelectObject_(gdi1\Hdc, grPattern)
  For i = 0 To 7
    b = fillpattern(i+1)
    For j = 7 To 0 Step -1
      If (b & $01) <> 0
        SetPixelV_(gdi1\Hdc,j,i,col1)
      Else
        SetPixelV_(gdi1\Hdc,j,i,col0)
      EndIf
      b = b >> 1
    Next
  Next
  SetFillStyle(#UserFill, color)
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 IsClipping()
  If grClip <> #Null
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetViewPort(x1.i, y1.i, x2.i, y2.i, clip.b)
  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(0,0)
  If (grClip <> #Null)
    SelectClipRgn_(gdi1\Hdc,#Null)
    SelectClipRgn_(gdi2\Hdc,#Null)
    DeleteObject_(grClip)
    grClip=#Null
  EndIf
  If clip
     grClip=CreateRectRgn_(x1,y1,x2+1,y2+1)
     SelectClipRgn_(gdi1\Hdc,grClip)
     SelectClipRgn_(gdi2\Hdc,grClip)
  EndIf
  GdiFlush_()
EndProcedure

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

Procedure Ellipsee(x.i,y.i,start.i,stop.i,xradius.i,yradius.i)
  Protected.i nXStartArc,nYStartArc,nXEndArc,nYEndArc
  lastArcCoords\x=x
  lastArcCoords\y=y
  x + origX
  y + origY
  nXStartArc=(((xradius)*Cos((start)*#Rad)))
  nXEndArc=(((xradius)*Cos((stop)*#Rad)))
  nYStartArc=(((yradius)*Sin((start)*#Rad)))
  nYEndArc=(((yradius)*Sin((stop)*#Rad)))
  If Not(defAspectRatio)
    xradius=Int(10000*xradius) / aspX
    yradius=Int(10000*yradius) / aspY
  EndIf
  If grDirect
    Arc_(gdi1\Hdc,x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1,x+nXStartArc,y-nYStartArc,x+nXEndArc,y-nYEndArc)
  EndIf
  Arc_(gdi2\Hdc,x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1,x+nXStartArc,y-nYStartArc,x+nXEndArc,y-nYEndArc)
  GdiFlush_()
  With lastArcCoords
    \xstart=\x+nXStartArc
    \ystart=\y-nYStartArc
    \xend=\x+nXEndArc
    \yend=\y-nYEndArc
  EndWith
EndProcedure

Procedure Arc(x.i,y.i,start.i,stop.i,radius.i)
  Ellipsee(x,y,start,stop,radius,radius)
EndProcedure

Procedure Circlee(x.i,y.i,radius.i)
  Ellipsee(x,y,0,360,radius,radius)
EndProcedure

Procedure DrawBezier(nrpoints.i, Array polypoints.POINT(1))
  If (nrpoints >= 4)
    If grDirect
      PolyBezier_(gdi1\Hdc,polypoints(),nrpoints)
    EndIf
    PolyBezier_(gdi2\Hdc,polypoints(),nrpoints);
    GdiFlush_()
  EndIf
EndProcedure

Procedure FillPoly(nrpoints.i, Array polypoints.POINT(1))
;   If Not(grEnabled)
;     ProcedureReturn
;   EndIf
  If (nrpoints >= 2)
    If grDirect 
      Polygon_(gdi1\Hdc,polypoints(),nrpoints) 
    EndIf
    Polygon_(gdi2\Hdc,polypoints(),nrpoints)
    GdiFlush_()
  EndIf
EndProcedure

Procedure DrawPoly(nrpoints.i, Array polypoints.POINT(1))
;   If Not(grEnabled)
;     ProcedureReturn
;   EndIf
  If nrpoints >= 2
    If grDirect 
      Polyline_(gdi1\Hdc,polypoints(),nrpoints)
    EndIf
    Polyline_(gdi2\Hdc,polypoints(),nrpoints)
    GdiFlush_()
  EndIf
EndProcedure

Procedure GetArcCoords(*arccoords.ArcCoordsType)
  *arccoords=lastArcCoords
EndProcedure

Procedure GetLineSettings(*lineinfo.LineSettingsType)
  *lineinfo=lineSettings
EndProcedure

Procedure PutPixel(x.i,y.i,color.i)
  x+origX
  y+origY
  If grDirect 
    SetPixelV_(gdi1\Hdc,x,y,color) 
  EndIf
  SetPixelV_(gdi2\Hdc,x,y,color)
  GdiFlush_()
EndProcedure

Procedure.i GetPixel(x.i, y.i)
  ProcedureReturn GetPixel_(gdi1\Hdc,x+origX,y+origY);
EndProcedure

Procedure FillRect(x1.i,y1.i,x2.i,y2.i)
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  x1+origX
  y1+origY
  x2+origX+1
  y2+origY+1
  If grDirect 
    Rectangle_(gdi1\Hdc,x1,y1,x2,y2) 
  EndIf
  Rectangle_(gdi2\Hdc,x1,y1,x2,y2)
  GdiFlush_()
EndProcedure

Procedure Bar3D(x1.i,y1.i,x2.i,y2.i, depth.i, top.i)
  Protected Dim pt.POINT(4)
  FillRect(x1,y1,x2,y2)
  x1 + origX
  y1 + origY
  x2 + origX
  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
    If grDirect 
      Polyline_(gdi1\Hdc,@pt(),4) 
    EndIf
    Polyline_(gdi2\Hdc,@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
      If grDirect 
        Polyline_(gdi1\Hdc,@pt(),3) 
      EndIf
      Polyline_(gdi2\Hdc,@pt(),3)
  EndIf
  GdiFlush_()
EndProcedure

Procedure Chord(x.i,y.i,start.i,stop.i,xradius.i,yradius.i)
  Protected.i nXRadial1,nYRadial1,nXRadial2,nYRadial2
  x + origX
  y + origY
  nXRadial1=(((xradius)*Cos((start)*#Rad)))
  nXRadial2=(((xradius)*Cos((stop)*#Rad)))
  nYRadial1=(((yradius)*Sin((start)*#Rad)))
  nYRadial2=(((yradius)*Sin((stop)*#Rad)))
  If Not(defAspectRatio)
    xradius=10000*Int(xradius) / aspX
    yradius=10000*Int(yradius) / aspY
  EndIf
  If grDirect
    Chord_(gdi1\Hdc,x-xradius,y-yradius,x+xradius+1,y+yradius+1,x+nXRadial1,y-nYRadial1,x+nXRadial2,y-nYRadial2)
  EndIf
  Chord_(gdi2\Hdc,x-xradius,y-yradius,x+xradius+1,y+yradius+1,x+nXRadial1,y-nYRadial1,x+nXRadial2,y-nYRadial2)
  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
  x1 + origX
  y1 + origY
  x2 + origX
  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
    If grDirect 
      Polyline_(gdi1\Hdc,@pt(),5) 
    EndIf
    Polyline_(gdi2\Hdc,@pt(),5)
  Else
    PutPixel(x1,y1,frcolor)
  EndIf
  GdiFlush_()
EndProcedure

Procedure FloodFill(x.i,y.i,color.i)
  x+origX
  y+origY
  If grDirect 
    ExtFloodFill_(gdi1\Hdc,x,y,color,floodMode) 
  EndIf
  ExtFloodFill_(gdi2\Hdc,x,y,color,floodMode)
  GdiFlush_()
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.i,y.i)
  Protected x0.i,y0.i
  x0=x
  y0=y
  x + origX
  y + origY
  With lineSettings
    If (\linestyle <> #UserFill)
      If grDirect
        LineTo_(gdi1\Hdc,x,y)
      EndIf
      LineTo_(gdi2\Hdc,x,y)
      If (\thickness = #NormWidth) 
        PutPixel(x0,y0,frColor)
      EndIf
    Else
      globalTemp=0
      LineDDA_(actX,actY,x0,y0,@LineProc(),\pattern)
    EndIf
    MoveTo(x0,y0)
  EndWith
  GdiFlush_()
EndProcedure

Procedure Linee(x1.i,y1.i,x2.i,y2.i)
  MoveTo(x1,y1)
  LineTo(x2,y2)
EndProcedure

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

Procedure MoveRel(dx.i,dy.i)
  actX+dx
  actY+dy
  MoveTo(actX,actY)
EndProcedure

Procedure FillEllipse(x.l,y.l,xradius.i,yradius.i)
  Protected fillinfo.FillSettingsType
  x + origX
  y + origY
  If defAspectRatio <> 0
    xradius = Int(10000*xradius) / aspX
    yradius = Int(10000*yradius) / aspY
  EndIf
  If grDirect
    Ellipse_(gdi1\Hdc,x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1)
  EndIf
  Ellipse_(gdi2\Hdc,x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1)
  GdiFlush_()
EndProcedure

Procedure RotEllipse(x.i,y.i,rot.i,xradius.i,yradius.i)
  Protected Dim pt.POINT(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())
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
         Circlee(xs,ys,delta) ; open circle
    Case 7
      FillEllipse(xs,ys,delta,delta) ; closed circle
    Case 8
      PutPixel(xs,ys,GetMaxColor()) ; unscaled point
  Default
  EndSelect
  MoveTo(x1,y1)
  SetColor(curcol)
  GdiFlush_()
EndProcedure

Procedure CalcAnglePoint(x1.d, y1.d, distance.d, angle.d, *endX.double, *endY.double)
  *endX\d = x1 + distance * Sin(angle)
  *endY\d = y1 + distance * Cos(angle)
EndProcedure

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

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

#SNone  = 0
#SArrow = 1
#SBox   = 2
#SCircle= 3
#SLine  = 4
#SDLine = 5
#SDCross= 6
Procedure LineCaped(x1.i, y1.i, x2.i, y2.i, left.i=#SNone, right.i=#SNone, filledl.i=#False, filledr.i=#False)
  Protected Dim polypoints.POINT(6)
  Protected fillinfo.FillSettingsType
  Protected.d rx, ry, dist
  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
        SetFillStyle(#SolidFill, frColor)
        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)
        SetFillStyle(#SolidFill, frColor)
        If filledr
          FillPoly(6, polypoints())
        Else
          DrawPoly(6, polypoints())
        EndIf
      Case #SCircle
        CalcAnglePoint(x2, y2, -dist, angle, @xx, @yy)
        GetFillSettings(@fillinfo)
        SetFillStyle(#SolidFill, frColor)
        If filledr
          FillPoly(6, polypoints())
          FillEllipse(xx,yy,dist,dist)
        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)
        MoveTo(xx1, yy1)
        LineTo(xx2, yy2)         
      Case #SDLine
        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)
      Case #SDCross
        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)
    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
        SetFillStyle(#SolidFill, frColor)
        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)
        SetFillStyle(#SolidFill, frColor)
        If filledl
          FillPoly(6, polypoints())
        Else
          DrawPoly(6, polypoints())
        EndIf
      Case #SCircle
        CalcAnglePoint(x2, y2, dist, angle, @xx, @yy)
        GetFillSettings(@fillinfo)
        SetFillStyle(#SolidFill, frColor)
        If filledl
          FillPoly(6, polypoints())
          FillEllipse(xx,yy,dist,dist)
        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)
        MoveTo(xx1, yy1)
        LineTo(xx2, yy2)         
      Case #SDLine
        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)
      Case #SDCross
        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)
    EndSelect   
  EndIf
  SetFillStyle(fillinfo\pattern, fillinfo\color)
  GdiFlush_()
EndProcedure

Procedure SetLineStyle(linestyle.i,pattern.i,thickness.i)
  Protected lgpn.LOGPEN
  Protected lstyle.i
  Protected old.i ;HGDIOBJ
  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
  With lgpn
     \lopnStyle=lstyle
     \lopnWidth\x=thickness
     \lopnColor=frColor
  EndWith
  grPen=CreatePenIndirect_(lgpn)
  old=SelectObject_(gdi1\Hdc,grPen)
  SelectObject_(gdi2\Hdc,grPen)
  If (old <> old_Pen)
    DeleteObject_(old)
  EndIf
  GdiFlush_()
EndProcedure

Procedure InvertRect(x1.i,y1.i,x2.i,y2.i)
  Protected rc.RECT
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  x1+origX
  y1+origY
  x2+origX
  y2+origY
  SetRect_(rc,x1,y1,x2+1,y2+1)
  If grDirect 
    InvertRect_(gdi1\Hdc,rc)
  EndIf
  InvertRect_(gdi2\Hdc,rc)
  GdiFlush_()
EndProcedure

Procedure Sector(x.l,y.l, start.i,stop.i,xradius.i,yradius.i)
  Protected.i nXRadial1,nYRadial1,nXRadial2,nYRadial2
  x + origX
  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
  If grDirect
    Pie_(gdi1\Hdc,x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1,x+nXRadial1,y-nYRadial1,x+nXRadial2,y-nYRadial2)
  EndIf
  Pie_(gdi2\Hdc,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 PieSlice(x.i,y.i,start.i,stop.i,radius.i)
  Sector(x,y,start,stop,radius,radius)
EndProcedure

Procedure RoundRect(x1.l,y1.l,x2.l,y2.l,r.l)
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  x1 + origX
  y1 + origY
  x2 + origX
  y2 + origY
  If grDirect
    RoundRect_(gdi1\Hdc,x1,y1,x2+1,y2+1,r,r)
  EndIf
  RoundRect_(gdi2\Hdc,x1,y1,x2+1,y2+1,r,r)
  GdiFlush_()
EndProcedure

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

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

Procedure SetLineWidth(thickness.i)
  Protected lineinfo.LineSettingsType
  GetLineSettings(lineinfo)
  SetLineStyle(lineinfo\linestyle,lineinfo\pattern,thickness)
EndProcedure

Procedure SetLinePattern(pattern.i)
  Protected lineinfo.LineSettingsType
  GetLineSettings(lineinfo)
  SetLineStyle(lineinfo\linestyle,pattern,lineinfo\thickness)
EndProcedure

Procedure SetStyleLine(linestyle.i)
  Protected lineinfo.LineSettingsType;
  GetLineSettings(lineinfo)
  SetLineStyle(linestyle,lineinfo\pattern,lineinfo\thickness)
EndProcedure


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_(gdi1\Hdc,255, @x)
  tt = Chr(len-1) + Space(255)
  GetTextFace_(gdi1\Hdc,255, @tt)
  GetTextMetrics_(gdi1\Hdc, *lptm)
  With *lptm
    *width  = \tmMaxCharWidth
    *height = \tmHeight
    *ttfont = Bool((\tmPitchAndFamily & #TMPF_TRUETYPE) <> 0)
  EndWith
  GdiFlush_()
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

Procedure.i InstallUserFont(fontname.s)
  Protected.i i, Result=-1
  Protected famName.s = ""
  famName = fontname
  globalTemp = 0
  EnumFontFamilies_(gdi1\Hdc,@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

#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

Procedure OutText(textstring.s)
  Protected lpPoint.POINT
  Protected len.i
  len = Len(textstring)
  If grDirect 
    TextOut_(gdi1\Hdc,0,0,textstring,len)
  EndIf
  TextOut_(gdi2\Hdc,0,0,textstring,len)
  GetCurrentPositionEx_(gdi2\Hdc,lpPoint)
  MoveTo(lpPoint\x-origX,lpPoint\y-origY)
  GdiFlush_()
EndProcedure

Procedure OutTextXY(x.i,y.i,textstring.s)
  Protected lpPoint.POINT
  Protected len.i
  len = Len(textstring)
  If grDirect 
    TextOut_(gdi1\Hdc,x,y,textstring,len)
  EndIf
  TextOut_(gdi2\Hdc,x,y,textstring,len)
  GetCurrentPositionEx_(gdi2\Hdc, @lpPoint)
  MoveTo(lpPoint\x-origX,lpPoint\y-origY)
  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_(gdi1\Hdc,htext | vtext | #TA_UPDATECP)
  SetTextAlign_(gdi2\Hdc,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)
    old=SelectObject_(gdi1\Hdc, grFont)
    SelectObject_(gdi2\Hdc, grFont)
    If (old <> old_Font)
      DeleteObject_(old)
    EndIf
    GdiFlush_()
  EndIf
EndProcedure

Procedure SetTextFontSize(charsize.i)
  Protected textinfo.TextSettingsType
  GetTextSettings(textinfo)
  SetTextStyle(textinfo\font,textinfo\direction,charsize)
EndProcedure

Procedure SetTextFont(font.i)
  Protected textinfo.TextSettingsType
  GetTextSettings(textinfo)
  SetTextStyle(font,textinfo\direction,textinfo\charsize)
EndProcedure

Procedure SetTextDirection(direction.i)
  Protected textinfo.TextSettingsType
  GetTextSettings(textinfo)
  SetTextStyle(textinfo\font,direction,textinfo\charsize)
EndProcedure

Procedure SetUserCharSize(nCharExtra.i,nBreakExtra.i);,dummy1.i,dummy2.i)
  SetTextCharacterExtra_(gdi1\Hdc,nCharExtra)
  SetTextCharacterExtra_(gdi2\Hdc,nCharExtra)
  SetTextJustification_(gdi1\Hdc,nBreakExtra,1)
  SetTextJustification_(gdi2\Hdc,nBreakExtra,1)
  GdiFlush_()
EndProcedure

Procedure.i TextHeightt(textstring.s)
  Protected lpSize.SIZE
  Protected len.i
  len=Len(textstring)
  GetTextExtentPoint32_(gdi1\Hdc,textstring,len,lpSize);
  GdiFlush_()
  ProcedureReturn lpSize\cy
EndProcedure

Procedure.i TextWidthh(textstring.s)
  Protected lpSize.SIZE
  Protected len.i
  len=Len(textstring)
  GetTextExtentPoint32_(gdi1\Hdc,textstring,len,lpSize)
  GdiFlush_()
  ProcedureReturn lpSize\cx
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 PlotSymbol1(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
         Circlee(xs,ys,delta) ; open circle
    Case 7
      FillEllipse(xs,ys,delta,delta) ; 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:
        Linee(x - width/2, y - height/2, x + width/2, y - height/2)
        Linee(x + width/2, y - height/2, x + width/2, y + height/2)
        Linee(x + width/2, y + height/2, x - width/2, y + height/2)
        Linee(x - width/2, y + height/2, x - width/2, y - height/2)
    Case #SYMBOLTRIANGLE:
        Linee(x - width/2, y + height/2, x, y - height/2)
        Linee(x, y - height/2, x + width/2, y + height/2)
        Linee(x + width/2, y + height/2, x - width/2, y + height/2)
    Case #SYMBOLDIAMOND:
        Linee(x - width/2, y, x, y - height/2)
        Linee(x, y - height/2, x + width/2, y)
        Linee(x + width/2, y, x, y + height/2)
        Linee(x, y + height/2, x - width/2, y)
    Case #SYMBOLCROSS:
        Linee(x - width/2, y, x + width/2, y)
        Linee(x, y - height/2, x, y + height/2)
    Case #SYMBOLXCROSS:
        Linee(x - width/2, y + height/2, x + width/2, y - height/2)
        Linee(x - width/2, y - height/2, x + width/2, y + height/2)
    Default
  EndSelect
  SetColor(currfcol)
  GdiFlush_()
EndProcedure

Procedure THREEDto2DAll(*coords.ThreeDPointType, *pan.ThreeDPointType, *centre.ThreeDPointType, *position.ThreeDPointType, zoom.d, *sx.double, *sy.double)
  Protected new.ThreeDPointType
  *coords\x + *position\x
  *coords\y + *position\y
  *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

Procedure GetDrawingWindowRectangle(*xy.RECT, wsthickframe.b)
  Protected.i cxFrame, cyFrame, cyCaption
  Protected.WINDOWPLACEMENT info
  GetWindowPlacement_(gdi1\Hdc, @info)
  cxFrame  = GetSystemMetrics_(#SM_CXFIXEDFRAME) * 2
  cyFrame  = GetSystemMetrics_(#SM_CYFIXEDFRAME) * 2
  cyCaption= GetSystemMetrics_(#SM_CYCAPTION)
  If wsthickframe
    cxFrame = GetSystemMetrics_(#SM_CXFRAME) * 2
    cyFrame = GetSystemMetrics_(#SM_CYFRAME) * 2
  EndIf
  With info\rcNormalPosition
    *xy\left  = \left
    *xy\top   = \top
    *xy\right = \right-\left-cxFrame
    *xy\bottom= \bottom-\top-cyFrame-cyCaption
  EndWith
EndProcedure

Procedure.b PointInDrawingWindowRectangle(x.i,y.i,*xy.RECT,wsthickframe.b)
  Protected.POINT iRec
  GetDrawingWindowRectangle(*xy, wsthickframe)
  ProcedureReturn Bool((x >= *xy\left) And (x <= *xy\right) And (y >= *xy\top) And (y <= *xy\bottom))
EndProcedure

Procedure GetImage(x1.i,y1.i,x2.i,y2.i,*bmp.BITMAP)
  Protected.i hdcMemDC, hbmScreen
  Protected bih.BITMAPINFOHEADER
  hdcMemDC = CreateCompatibleDC_(gdi1\Hdc)
  hbmScreen = CreateCompatibleBitmap_(gdi1\Hdc, x2-x1+1, y2-y1+1)
  SelectObject_(hdcMemDC, hbmScreen)
  BitBlt_(hdcMemDC, 0, 0, x2-x1+1, y2-y1+1, gdi1\Hdc, 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_(gdi1\Hdc, 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_(gdi1\Hdc)
  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_(gdi1\Hdc, x1, y1, *bmp\bmWidth, *bmp\bmHeight, hdcMemDC, 0, 0, rop1|#CAPTUREBLT)
  GdiFlush_()
  DeleteObject_(*hBitMap)
  DeleteObject_(hdcMemDC)
EndProcedure

Procedure.i ImageSize(x1.i,y1.i,x2.i,y2.i,bitsize.i)
  ProcedureReturn (((y2-y1) * (x2-x1) * bitsize) / 8)
EndProcedure

Procedure.i MemoryImageSize(x1.i,y1.i,x2.i,y2.i,bitsize.i)
  ProcedureReturn (((y2-y1) * (x2-x1) * bitsize) / 8) + SizeOf(MEMORYIMAGE)
EndProcedure

Procedure GetMemImage(x1.i,y1.i,x2.i,y2.i,*bitmap.MEMORYIMAGE)
  Protected.i targetDC = CreateCompatibleDC_(gdi1\Hdc)
  *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_(gdi1\Hdc, x2-x1+1, (y2-y1+1))
  SelectObject_(targetDC, *bitmap\bits)
  BitBlt_(targetDC, x1, y1, x2-x1+1, (y2-y1+1), gdi1\Hdc, x1, y1, #SRCCOPY|#CAPTUREBLT)
  GdiFlush_()
  DeleteDC_(targetDC)
  ReleaseDC_(*bitmap\bits, gdi1\Hdc)
EndProcedure

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

Procedure UpdateBgi(winnum.i)
  ResizeWindow(gdiwin\winNum, #PB_Ignore, #PB_Ignore, #PB_Ignore, #PB_Ignore)
  SetActiveWindow(winnum)
EndProcedure

Procedure Track()
  Protected.i x = WindowWidth(gdiwin\winNum), y = WindowHeight(gdiwin\winNum)
  If x > gdi1\maxX
    x = gdi1\maxX
  EndIf
  If y > gdi1\maxY
    y = gdi1\maxY
  EndIf
  ResizeGadget(gdiwin\scroller, #PB_Ignore, #PB_Ignore, x, y)  
  ResizeWindow(gdiwin\winNum, #PB_Ignore, #PB_Ignore, x, y)  
  ResizeGadget(gdiwin\canvasnum, #PB_Ignore,#PB_Ignore, #PB_Ignore,  #PB_Ignore)
EndProcedure

Procedure closeevent()
  If EventWindow() = gdiwin\winNum
    CloseWindow(gdiwin\winNum)
    gdiwin\winNum = -1
    If IsThread(Thread)
      KillThread(Thread)
    EndIf
    PostEvent(#PB_Event_CloseWindow,gdiwin\winNum,-1)
  EndIf
EndProcedure

Procedure.i IsBgiWindowOpen()
  ProcedureReturn Bool(gdiwin\winNum > 0)
EndProcedure

Procedure canvasrefresh()
  Select EventGadget() 
    Case gdiwin\canvasnum
      If StartDrawing(CanvasOutput(gdiwin\canvasnum))
        DrawImage(grMemory\Bitmap, 0, 0)
        StopDrawing()
      EndIf
  EndSelect  
  ResizeGadget(gdiwin\canvasnum, #PB_Ignore,#PB_Ignore, #PB_Ignore,  #PB_Ignore)
EndProcedure

Global parentwinnum.i=0
Procedure.i CreateGdiWindow(*gdiwindow.WINDOW, *NewGdiMap.GDIMAP, custWidth.i=400, custHeight.i=400, title.s="", winnum.i=0, winsize.i = #CustScr)
  Protected.i x
  *gdiwindow\windowWidth = custWidth
  *gdiwindow\windowHeight= custHeight
  *gdiwindow\title = title
  If *gdiwindow\windowWidth > *NewGdiMap\maxX
    *gdiwindow\windowWidth = *NewGdiMap\maxX+1
  EndIf
  If *gdiwindow\windowHeight > *NewGdiMap\maxY
    *gdiwindow\windowHeight = *NewGdiMap\maxY+1
  EndIf
  If winnum <> 0
    *gdiwindow\winNum = OpenWindow(#PB_Any, 0, 0, *gdiwindow\windowWidth, *gdiwindow\windowHeight, *gdiwindow\title, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_TitleBar | #PB_Window_SizeGadget, WindowID(winnum))
    parentwinnum = winnum
  Else
    *gdiwindow\winNum = OpenWindow(#PB_Any, 0, 0, *gdiwindow\windowWidth, *gdiwindow\windowHeight, *gdiwindow\title, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_TitleBar | #PB_Window_SizeGadget)
  EndIf
  If *gdiwindow\winNum = 0: ProcedureReturn -1 : EndIf
  *gdiwindow\scroller = ScrollAreaGadget(#PB_Any, 0, 0, *gdiwindow\windowWidth, *gdiwindow\windowHeight, *NewGdiMap\maxX, *NewGdiMap\maxY, 1, #PB_ScrollArea_BorderLess)
  *gdiwindow\winHwnd = WindowID(*gdiwindow\winNum)
  *gdiwindow\canvasnum = CanvasGadget(#PB_Any, 0, 0, *NewGdiMap\maxX, *NewGdiMap\maxY, #PB_Canvas_Border | #PB_Canvas_Keyboard)
  CloseGadgetList()  
  BindEvent(#PB_Event_SizeWindow, @Track(),gdiwin\winNum)
  BindEvent(#PB_Event_CloseWindow, @closeevent(),gdiwin\winNum)
  BindEvent(#PB_Event_Gadget, @canvasrefresh(),gdiwin\winNum)
  SetActiveGadget(*gdiwindow\canvasnum)
  ResizeWindow(gdiwin\winNum, #PB_Ignore, #PB_Ignore, custWidth, custHeight)
  PostEvent(#PB_Event_Repaint, gdiwin\winNum, gdiwin\winNum,#PB_EventType_Focus)
EndProcedure

Procedure BgiStartup(winsizex, winsizey, wintitle.s, bitsizex.i, bitsizey.i, parentwinnum.i=0)  
  CreateBitmaps(gdi1, bitsizex, bitsizey)
  CreateBitmaps(gdi2, bitsizex, bitsizey)
  grMemory = gdi1
  CreateGdiWindow(gdiwin, gdi1, winsizex, winsizey, wintitle,parentwinnum)
  InstallDefaultFonts()
  SetFillStyle(#SolidFill,#Black)
  SetTextStyle(#DefaultFont,#HorizDir,10)
  SetTextJustify(#LeftText,#TopText)
  SetUserCharSize(0,0)
  SetViewPort(0,0,GetMaxX(),GetMaxY(),#ClipOff)
  SetWriteMode(#CopyMode | #TRANSPARENT)
  SetAspectRatio(10000,10000)
  SetActivePage(0)
  SetActiveGadget(gdiwin\canvasnum)
  ;;; simulate click to redraw window
  Protected Cursor.Point
  BlockInput_(#True)
  GetCursorPos_(@Cursor)
  SetCursorPos_(WindowX(gdiwin\winNum),WindowY(gdiwin\winNum))
  mouse_event_(#MOUSEEVENTF_LEFTDOWN,0,0,0,0)
  mouse_event_(#MOUSEEVENTF_LEFTUP,0,0,0,0)
  SetCursorPos_(Cursor\x,Cursor\y)
  BlockInput_(#False)
EndProcedure

EndModule

Code: Select all

EnableExplicit

XIncludeFile "bgi3Module.pb"

UseModule CanvasBgi

Global tEvent,tQuit,twinnum

twinnum = OpenWindow(#PB_Any, 0, 0, 200, 400, "PureBasic Window", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget|#PB_Window_WindowCentered)
If twinnum
  BgiStartup(400, 400, "bgiwindow", 1200, 900)
  SetActiveWindow(gdiwin\winNum)
  ResizeWindow(gdiwin\winNum, #PB_Ignore,#PB_Ignore,#PB_Ignore,#PB_Ignore)

  SetDrawingColor(#Blue, #PS_DOT,2)
  RoundRect(100,100,300,600,30)
  SetBackColor(#Green)
  SetTextColor(#Red)
  SetTextFontSize(30)
  OutTextXY(200,200,"Hello World")

  SetBackColor(#White)
  Circlee(200,200,20)
  Linee(400,400,700,700)
  LineCaped(200,200,700,700,#SArrow,#SArrow, #True, #True)
  Rectangle(100,100,600,600)
  SetTextColor_(gdi1\Hdc, #Green)
  MoveTo(600, 600)
  Lineto(500,300)
  MoveTo(600, 600)
  SetTextFontSize(25)
  SetTextColor_(gdi1\Hdc, #Blue)
  OutTextXY(600, 600, "test1")
  RotEllipse(300,300, 85, 90, 50)
  

  Repeat
    tEvent = WaitWindowEvent()
    If tEvent = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      tQuit = 1
    EndIf
    
  Until tQuit = 1
  
EndIf

Code: Select all

twinnum = OpenWindow(#PB_Any, 0, 0, 200, 400, "PureBasic Window", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget|#PB_Window_ScreenCentered)

Code: Select all

Procedure closeevent()
  If EventWindow() = gdiwin\winNum
    CloseWindow(gdiwin\winNum)
    gdiwin\winNum = -1
    If IsThread(Thread)
      KillThread(Thread)
    EndIf
    PostEvent(#PB_Event_CloseWindow,gdiwin\winNum,-1)
  EndIf
EndProcedure

Code: Select all

Repeat
    tEvent = WaitWindowEvent()
    If EventWindow() = twinnum
      If tEvent = #PB_Event_CloseWindow  ; If the user has pressed on the close button
        tQuit = 1
      EndIf
    EndIf
   
  Until tQuit = 1

Code: Select all

Repeat
    
    If IsBgiWindowOpen()
      tEvent = WaitWindowEvent()
      If EventWindow() = twinnum
        If tEvent = #PB_Event_CloseWindow  ; If the user has pressed on the close button
          If IsBgiWindowOpen()
            CloseWindow(twinnum)
          Else
            tQuit = 1
          EndIf
        EndIf
      EndIf
    Else
      Delay(10)
    EndIf
    
  Until tQuit = 1 Or Not IsBgiWindowOpen()