home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / GL101.ZIP / GLLIBR.PRG < prev    next >
Encoding:
Text File  |  1991-06-27  |  63.5 KB  |  1,236 lines
  1. *.............................................................................
  2. *
  3. *   Program Name: GLLIBR.PRG       Created By: Global Technologies Corporation
  4. *   Date Created: 06/05/90           Language: Clipper 5.0
  5. *   Time Created: 11:27:44             Author: Bill French
  6. *
  7. *   The Graphics Language - Copyright (c) 1990,1991 - Bits Per Second Ltd.
  8. *            In Association With Global Technologies Corporation
  9. *
  10. *.............................................................................
  11. #include "gllibr.ch"
  12.  
  13. static _screens_[MaxScreens][6]                  // declare the screen array
  14. static _handles_[MaxHandles][10]                 // declare the object array
  15. static _eshadow_ := "n+/b"                       // declare the default shadow color
  16. static _icnfile_ := ""                           // current icon file
  17. static _dgepath_ := ""                           // declare the dge resources path
  18. static _icnwidt_ 
  19. static _icnheig_ 
  20.  
  21. // __SetGraphics() ------------------------------------------------------------
  22. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  23. //    Description: Initialize graphics mode and establish system variables
  24. // Mapped Command: SET GRAPHICS
  25. FUNCTION __SetGraphics(mode)
  26.    local screen, handle
  27.    mode := if(mode == NIL, FALSE, mode)
  28.    if mode                                       // is it on or off? (TRUE = on)
  29.       sethires(0)                                // graphics mode
  30.       for screen := 1 to MaxScreens              // establish a blank screen array
  31.          _screens_[screen,1] := NullInteger      // upper left row
  32.          _screens_[screen,2] := NullInteger      // upper left column
  33.          _screens_[screen,3] := NullInteger      // lower right row
  34.          _screens_[screen,4] := NullInteger      // lower right column
  35.          _screens_[screen,5] := NullInteger      // dGE handle
  36.          _screens_[screen,6] := NullString       // GL memvar
  37.       next                                       // for n := 1 to MaxHandles
  38.       for handle := 1 to MaxHandles              // establish a blank object array
  39.          _handles_[handle,1] := NullInteger      // upper left row
  40.          _handles_[handle,2] := NullInteger      // upper left column
  41.          _handles_[handle,3] := NullInteger      // lower right row
  42.          _handles_[handle,4] := NullInteger      // lower right column
  43.          _handles_[handle,5] := NullString       // object text
  44.          _handles_[handle,6] := NullInteger      // object type
  45.          _handles_[handle,7] := ShadowOff        // shadow
  46.          _handles_[handle,8] := NullString       // object name
  47.          _handles_[handle,9] := InactiveObject   // status (inactive)
  48.       next                                       // for n := 1 to MaxHandles
  49.       _icnwidt_ := getfontinf(2)/PointsPerColumn // get the icon width
  50.       _icnheig_ := getfontinf(3)/PointsPerLine   // get the icon height
  51.    else
  52.       settext()                                  // text mode
  53.    endif                                         // if off                                        // if were leaving
  54. RETURN(Void)
  55.  
  56. // __SetVideo() ---------------------------------------------------------------
  57. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  58. //    Description: Set the dGE video mode for EGA of VGA
  59. // Mapped Command: SET VIDEO TO
  60. FUNCTION __SetVideo(video)
  61.    do case
  62.    case upper(video) == "EGA"                    // ega mode
  63.       setvideo(6)
  64.    case upper(video) == "VGA"                    // vga mode
  65.       setvideo(7)
  66.    otherwise                                     // default to ega mode
  67.       setvideo(6)
  68.    endcase
  69. RETURN(Void)
  70.  
  71. // __SetResources() -----------------------------------------------------------
  72. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  73. //    Description: Set the dGE resource search path
  74. // Mapped Command: SET DGE RESOURCES TO
  75. FUNCTION __SetResources(path)
  76.    path := if(empty(path),"",path + "\")
  77.    path := if(empty(path),getenv("DGE") + "\",path)
  78.    _dgepath_ := path
  79. RETURN(_dgepath_)
  80.  
  81. // __SetPalette() -------------------------------------------------------------
  82. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  83. //    Description: Set the graphics screen background color
  84. // Mapped Command: SET PALETTE BACKGROUND
  85. FUNCTION __SetPalette(color,bright)
  86.    setcolor(setcolor())
  87.    setpal(__PalWordToColor(bright + color),0,0)  // set the palette background
  88. RETURN(Void)
  89.  
  90. // __ClearGScreen() -----------------------------------------------------------
  91. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  92. //    Description: Clear the graphics screen
  93. // Mapped Command: CLEAR GRAPHICS SCREEN
  94. FUNCTION __ClearGScreen()
  95.    clrscreen()                                   // clear the graphics screen
  96. RETURN(Void)
  97.  
  98. // __ClearGWindow() -----------------------------------------------------------
  99. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  100. //    Description: Clear a window area in the graphics screen
  101. // Mapped Command: CLEAR GRAPHICS WINDOW
  102. FUNCTION __ClearGWindow(Pos1_a,Pos1_b,Pos2_a,Pos2_b,bevel)
  103.    if bevel
  104.       clrwin(__XdGE(Pos1_b-.325),__YdGE(Pos2_a+.15),__XdGE(Pos2_b+.325),__YdGE(Pos1_a-.15))
  105.    else
  106.       clrwin(__XdGE(Pos1_b),__YdGE(Pos2_a),__XdGE(Pos2_b),__YdGE(Pos1_a))
  107.    endif                                         // if bevel
  108. RETURN(Void)
  109.  
  110. // __ResetGArray() ------------------------------------------------------------
  111. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  112. //    Description: Reset the dGE internal array
  113. // Mapped Command: RESET GRAPHICS ARRAY
  114. FUNCTION __ResetGArray()
  115.    datareset()                                   // reset the dGE data array
  116. RETURN(Void)
  117.  
  118. // __ScaleGArray() ------------------------------------------------------------
  119. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  120. //    Description: Adjust the scale of data
  121. // Mapped Command: SCALE GRAPHICS ARRAY
  122. FUNCTION __ScaleGArray(percent)
  123.    datapc(percent)                               // scale the dGE data array
  124. RETURN(Void)
  125.  
  126. // __SetDrawArea() ------------------------------------------------------------
  127. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  128. //    Description: Restrict drawing to a window area
  129. // Mapped Command: SET DRAWING AREA
  130. FUNCTION __SetDrawArea(Pos1a,Pos1b,Pos2a,Pos2b)
  131.    if Pos1a == NIL
  132.       clipwin(0,0,1350,1000)
  133.    else
  134.       clipwin(__XdGE(Pos1b),__YdGE(Pos2a),__XdGE(Pos2b),__YdGE(Pos1a))
  135.    endif                                         // if pos1a == nil
  136. RETURN(Void)
  137.  
  138. // __SaveGScreen() ------------------------------------------------------------
  139. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  140. //    Description: Save an area of the graphics screen
  141. // Mapped Command: SAVE GRAPHICS SCREEN
  142. FUNCTION __SaveGScreen(label,Pos1a,Pos1b,Pos2a,Pos2b)
  143.    local handle
  144.    local screen := __UnusedScreen(label)
  145.    if screen > 0
  146.       handle = snapcopy(__XdGE(Pos1b),__YdGE(Pos2a),__XdGE(Pos2b),__YdGE(Pos1a),0)
  147.       if handle != 0
  148.          _screens_[screen,1] := Pos1a            // upper left row
  149.          _screens_[screen,2] := Pos1b            // upper left column
  150.          _screens_[screen,3] := Pos2a            // lower right row
  151.          _screens_[screen,4] := Pos2b            // lower right column
  152.          _screens_[screen,5] := handle           // dGE video handle
  153.          _screens_[screen,6] := label            // screen label
  154.       else
  155.          __HandleError(NoMemoryLeft,label)
  156.       endif
  157.    else
  158.       __HandleError(NoHandlesLeft,label)
  159.    endif
  160. RETURN(screen)
  161.  
  162. // __RestGScreen() ------------------------------------------------------------
  163. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  164. //    Description: Restore a saved area of the graphics screen
  165. // Mapped Command: RESTORE GRAPHICS SCREEN
  166. FUNCTION __RestGScreen(label)
  167.    local Pos1a, Pos1b, Pos2a, Pos2b, Handle
  168.    local screen := __ScanScreens(label)
  169.    if screen > 0
  170.       Pos1a  := _screens_[screen,1]           // upper left row
  171.       Pos1b  := _screens_[screen,2]           // upper left column
  172.       Pos2a  := _screens_[screen,3]           // upper left row
  173.       Pos2b  := _screens_[screen,4]           // upper left column
  174.       handle := _screens_[screen,5]           // dGE handle
  175.       if handle != 0
  176.          snappaste(__XdGE(Pos1b),__YdGE(Pos2a),handle)
  177.          snapkill(handle)
  178.          _screens_[screen,1] := NullInteger   // upper left row
  179.          _screens_[screen,2] := NullInteger   // upper left column
  180.          _screens_[screen,3] := NullInteger   // lower right row
  181.          _screens_[screen,4] := NullInteger   // lower right column
  182.          _screens_[screen,5] := NullInteger   // dGE handle
  183.          _screens_[screen,6] := NullString    // GL memvar
  184.       else
  185.          __HandleError(NoHandlesLeft,screen)
  186.       endif
  187.    else
  188.       __HandleError(NoSuchHandle,label)
  189.    endif
  190. RETURN(Void)
  191.  
  192. // __UnusedScreen() -----------------------------------------------------------
  193. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  194. //    Description: Find a free screen handle
  195. // Mapped Command: 
  196. FUNCTION __UnusedScreen(label)
  197.    local n
  198.    for n := 1 to MaxScreens
  199.       if empty(_screens_[n,6])
  200.          retu(n)
  201.       endif                                      // if _handles_[n,8] := object
  202.    next                                          // for n := 1 to MaxHandles
  203. RETURN(0)
  204.  
  205. // __ScanScreens() ------------------------------------------------------------
  206. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  207. //    Description: Find the handle of a specified screen label
  208. // Mapped Command: 
  209. FUNCTION __ScanScreens(label)
  210.    local n
  211.    for n := 1 to MaxScreens
  212.       if _screens_[n,6] == label
  213.          retu(n)
  214.       endif                                      // if _handles_[n,8] := object
  215.    next                                          // for n := 1 to MaxHandles
  216. RETURN(0)
  217.  
  218. // __ShadeArea() --------------------------------------------------------------
  219. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  220. //    Description: Fill an enclosed area
  221. // Mapped Command: SHADE AREA AT
  222. FUNCTION __ShadeArea(x,y,pattern)
  223.    shade(__XdGE(y),__YdGE(x),if(pattern == NIL,0,pattern),__DgeColor(setcolor()))
  224. RETURN(Void)
  225.  
  226. // __DrawFrame() --------------------------------------------------------------
  227. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  228. //    Description: Draw box
  229. // Mapped Command: DRAW BOX FROM
  230. FUNCTION __DrawFrame(x1,y1,x2,y2,pattern,bevel)
  231.    pattern := if(pattern == NIL,64,pattern)
  232.    if bevel
  233.       __DrawBevel(x1,y1,x2-x1,y2-y1,pattern)
  234.    else
  235.       boxfill(__XdGE(y1),__YdGE(x2),__XdGE_(y2-y1),__YdGE_(x2-x1),pattern,__DgeColor(setcolor()))
  236.    endif                                         // if bevel
  237. RETURN(Void)
  238.  
  239. // __DrawCircle() -------------------------------------------------------------
  240. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  241. //    Description: Draw a circle
  242. // Mapped Command: DRAW CIRCLE AT
  243. FUNCTION __DrawCircle(x,y,radius)
  244.    drawcircle(__XdGE(y),__YdGE(x),__XdGE_(radius),0,360,0,0,__DgeColor(setcolor()))
  245. RETURN(Void)
  246.  
  247. // __DrawLine() ---------------------------------------------------------------
  248. // TecGuide-> {Function Ref::Graphical Functions::UDF} {SOURCE}
  249. //    Description: Draw a line
  250. // Mapped Command: DRAW LINE FROM
  251. FUNCTION __DrawLine(Pos1_a,Pos1_b,Pos2_a,Pos2_b,style)
  252.    drawline(__XdGE(Pos1_b),__YdGE(Pos1_a),__XdGE(Pos2_b),__YdGE(Pos2_a),0,if(style == NIL,0,style),__DgeColor(setcolor()))
  253. RETURN(Void)
  254.  
  255. // __SetCSet() ----------------------------------------------------------------
  256. // TecGuide-> {Function Ref::String Functions::UDF} {SOURCE}
  257. //    Description: Set the current character set
  258. // Mapped Command: SET CHARACTER SET
  259. FUNCTION __SetCSet(type,size)
  260.    type := upper(substr(type,1,4))               // get the character type
  261.    size := upper(substr(size,1,4))               // get the character size
  262.    do case                                       // evaluate the type
  263.    case type == "SYST"                           // standard dge character sets
  264.       do case
  265.       case size == "SMAL" .and. file(_dgepath_+"DGE1EGA.CHR")
  266.          loadcset(0,_dgepath_+"DGE1EGA.CHR")
  267.       case (size == "LARG" .or. size == "STAN" .or. size == "STD") .and. file(_dgepath_+"DGE0EGA.CHR")
  268.          loadcset(0,_dgepath_+"DGE0EGA.CHR")
  269.       case size == "0906" .and. file(_dgepath_+"DGE0906.STX")
  270.          loadcset(0,_dgepath_+"DGE0906.STX")
  271.       case size == "1106" .and. file(_dgepath_+"DGE1106.STX")
  272.          loadcset(0,_dgepath_+"DGE1106.STX")
  273.       case size == "1108" .and. file(_dgepath_+"DGE1108.STX")
  274.          loadcset(0,_dgepath_+"DGE1108.STX")
  275.       case size == "1608" .and. file(_dgepath_+"DGE1608.STX")
  276.          loadcset(0,_dgepath_+"DGE1608.STX")
  277.       case size == "1609" .and. file(_dgepath_+"DGE1609.STX")
  278.          loadcset(0,_dgepath_+"DGE1609.STX")
  279.       endcase
  280.    case type == "ROMA"                           // roman character sets
  281.       do case
  282.       case size == "1628" .and. file(_dgepath_+"RMN1628.STX")
  283.          loadcset(0,_dgepath_+"RMN1628.STX")
  284.       case size == "1914" .and. file(_dgepath_+"RMN1914.STX")
  285.          loadcset(0,_dgepath_+"RMN1914.STX")
  286.       case size == "2828" .and. file(_dgepath_+"RMN2828.STX")
  287.          loadcset(0,_dgepath_+"RMN2828.STX")
  288.       case size == "3828" .and. file(_dgepath_+"RMN3828.STX")
  289.          loadcset(0,_dgepath_+"RMN3828.STX")
  290.       case size == "5742" .and. file(_dgepath_+"RMN5742.STX")
  291.          loadcset(0,_dgepath_+"RMN5742.STX")
  292.       endcase
  293.    case type == "SWIS"                           // swiss character sets
  294.       do case
  295.       case size == "1425" .and. file(_dgepath_+"SWI1425.STX")
  296.          loadcset(0,_dgepath_+"SWI1425.STX")
  297.       case size == "1713" .and. file(_dgepath_+"SWI1713.STX")
  298.          loadcset(0,_dgepath_+"SWI1713.STX")
  299.       case size == "2525" .and. file(_dgepath_+"SWI2525.STX")
  300.          loadcset(0,_dgepath_+"SWI2525.STX")
  301.       case size == "3325" .and. file(_dgepath_+"SWI3325.STX")
  302.          loadcset(0,_dgepath_+"SWI3325.STX")
  303.       case size == "4937" .and. file(_dgepath_+"SWI4937.STX")
  304.          loadcset(0,_dgepath_+"SWI4937.STX")
  305.       endcase
  306.    endcase
  307. RETURN(Void)
  308.  
  309. // __DrawText() ---------------------------------------------------------------
  310. // TecGuide-> {Function Ref::String Functions::UDF} {SOURCE}
  311. //    Description: Draw graphical text
  312. // Mapped Command: DRAW <string> AT
  313. FUNCTION __DrawText(text,x,y,type,size,vertical,center,rightjust)
  314.    local mode
  315.    vertical  := if(vertical == NIL,0,vertical)   // determine positioning
  316.    center    := if(center == NIL,0,center)       // horizontal positioning (center)
  317.    rightjust := if(rightjust == NIL,0,rightjust) // horizontal positioning (right just)
  318.    mode      := vertical + center + rightjust    // calculate the display mode
  319.    __SetCSet(if(type == NIL,"",type),if(size == NIL,"",size))
  320.    saystring(__XdGE(y),__YdGE(x),4,mode,__DgeColor(setcolor()),text)
  321. RETURN(Void)
  322.  
  323. // __SetDelimiter() -----------------------------------------------------------
  324. // TecGuide-> {Function Ref::String Functions::UDF} {SOURCE}
  325. //    Description: Set the string input delimiters
  326. // Mapped Command: SET PROMPT DELIMITER
  327. FUNCTION __SetDelimiter(chr)
  328.    setdelim(chr)                                 // set the get delimiter
  329. RETURN(Void)
  330.  
  331. // __SetIcon() ----------------------------------------------------------------
  332. // TecGuide-> {Function Ref::Icon Functions::UDF} {SOURCE}
  333. //    Description: Set the current icon file
  334. // Mapped Command: SET ICON
  335. FUNCTION __SetIcon(iconfile)
  336.    if iconfile == NIL                            // if no file name was passed
  337.       loadicon("")                               // clear the icon file in dGE
  338.       _icnfile_ := ""                            // reset the static variable
  339.    else                                          // otherwise...
  340.       loadicon(_dgepath_+iconfile)               // load the file that was specified and set the static variable
  341.       _icnfile_ := if(len(_dgepath_) > 0,_dgepath_ + iconfile,iconfile)
  342.    endif                                         // if iconfile == nil
  343. RETURN(_icnfile_)
  344.  
  345. // __DrawStdIcon() ------------------------------------------------------------
  346. // TecGuide-> {Function Ref::Icon Functions::UDF} {SOURCE}
  347. //    Description: Draw internal icon
  348. // Mapped Command: DRAW STD ICON <icon>
  349. FUNCTION __DrawStdIcon(icon,x,y,vector,xor)
  350.    local mode
  351.    vector  := if(vector == NIL,FALSE,vector)
  352.    xor     := if(xor == NIL,FALSE,xor)
  353.    mode    := 0                                  // establish cartesion drawing mode
  354.    mode    := mode + if(vector,1,0)              // vector drawing mode
  355.    mode    := mode + if(xor,16,0)                // vector drawing mode
  356.    drawicon(__XdGE(y),__YdGE(x),mode,icon,__DgeColor(setcolor()))
  357. RETURN(Void)
  358.  
  359. // __DrawSuperIcon() ----------------------------------------------------------
  360. // TecGuide-> {Function Ref::Icon Functions::UDF} {SOURCE}
  361. //    Description: Draw super icon
  362. // Mapped Command: DRAW SUPER ICON <icon>
  363. FUNCTION __DrawSuperIcon(icon,x,y,vector,replace,or,black,inverse,composite,p1,p2,p3,p4)
  364.    local mode := 0                               // establish cartesian drawing mode
  365.    vector  := if(vector == NIL,FALSE,vector)
  366.    or      := if(or == NIL,FALSE,or)
  367.    black   := if(black == NIL,FALSE,black)
  368.    inverse := if(inverse == NIL,FALSE,inverse)
  369.    mode    := mode + if(vector,1,0)              // vector drawing mode
  370.    mode    := mode + if(or,8,0)                  // xor mode
  371.    mode    := mode + if(black,32,0)              // black mode
  372.    mode    := mode + if(inverse,64,0)            // inverse mode
  373.    icon    := icon + 16
  374.    do case
  375.    case composite == TRUE
  376.       replace := if(replace == NIL,FALSE,replace)
  377.       mode    := mode + if(replace,4,0)          // replace mode
  378.       drawicon(__XdGE(y-(_icnwidt_/2)),__YdGE(x+(_icnheig_/2)),mode,icon+0,__DgeColor(setcolor()))
  379.       drawicon(__XdGE(y-(_icnwidt_/2)),__YdGE(x-(_icnheig_/2)),mode,icon+1,__DgeColor(setcolor()))
  380.       drawicon(__XdGE(y+(_icnwidt_/2)),__YdGE(x+(_icnheig_/2)),mode,icon+2,__DgeColor(setcolor()))
  381.       drawicon(__XdGE(y+(_icnwidt_/2)),__YdGE(x-(_icnheig_/2)),mode,icon+3,__DgeColor(setcolor()))
  382.    case p1 != NIL
  383.       replace := if(replace == NIL,FALSE,replace)
  384.       mode    := mode + 4                        // replace mode
  385.       drawicon(__XdGE(y),__YdGE(x),mode,icon+0,p1)
  386.       drawicon(__XdGE(y),__YdGE(x),mode,icon+1,p2)
  387.       drawicon(__XdGE(y),__YdGE(x),mode,icon+2,p3)
  388.       drawicon(__XdGE(y),__YdGE(x),mode,icon+3,p4)
  389.    otherwise
  390.       replace := if(replace == NIL,FALSE,replace)
  391.       mode    := mode + if(replace,4,0)          // replace mode
  392.       drawicon(__XdGE(y),__YdGE(x),mode,icon,__DgeColor(setcolor()))
  393.    endcase
  394. RETURN(Void)
  395.  
  396. // __SetPrintDevice() ---------------------------------------------------------
  397. // TecGuide-> {Function Ref::Printer Functions::UDF} {SOURCE}
  398. //    Description: Establish the print device and channel
  399. // Mapped Command: SET GRAPHICS PRINT
  400. FUNCTION __SetPrintDevice(lpt1,lpt2,lpt3,com1,com2)
  401.    do case
  402.    case lpt1                                     // lpt1
  403.       prndev(0,1)
  404.    case lpt2                                     // lpt2
  405.       prndev(0,2)
  406.    case lpt3                                     // lpt3
  407.       prndev(0,3)
  408.    case com1                                     // com1
  409.       prndev(1,1)
  410.    case com2                                     // com2
  411.       prndev(1,2)
  412.    endcase
  413. RETURN(Void)
  414.  
  415. // __PrintMatrix() ------------------------------------------------------------
  416. // TecGuide-> {Function Ref::Printer Functions::UDF} {SOURCE}
  417. //    Description: Print screen to a matrix printer
  418. //    dGE functions: printscr()
  419. // Mapped Command: PRINT IMAGE TO MATRIX
  420. FUNCTION __PrintMatrix()
  421.    printscrn()
  422. RETURN(Void)
  423.  
  424. // __PrintLaser() -------------------------------------------------------------
  425. // TecGuide-> {Function Ref::Printer Functions::UDF} {SOURCE}
  426. //    Description: Print screen to a laser printer
  427. // Mapped Command: PRINT IMAGE TO LASER
  428. FUNCTION __PrintLaser(reset,formfeed,aspect,paintjet,bwpaintjet,landscape,reverse,hoffset,voffset,density)
  429.    local mode := reset+formfeed+aspect+paintjet+bwpaintjet+landscape+reverse
  430.    hoffset    := if(hoffset == NIL,0,hoffset)
  431.    voffset    := if(voffset == NIL,0,voffset)
  432.    density    := if(density == NIL,0,density)
  433.    printpcl(mode,hoffset,voffset,density)
  434. RETURN(Void)
  435.  
  436. // __PrintPostScript() --------------------------------------------------------
  437. // TecGuide-> {Function Ref::Printer Functions::UDF} {SOURCE}
  438. //    Description: Print screen to a postscript printer
  439. // Mapped Command: PRINT IMAGE TO POSTSCRIPT
  440. FUNCTION __PrintPostScript(landscape,reverse,hoffset,voffset,hscale,vscale,density)
  441.    local mode := landscape + reverse
  442.    hoffset    := if(hoffset == NIL,0,hoffset)
  443.    voffset    := if(voffset == NIL,0,voffset)
  444.    hscale     := if(hscale  == NIL,0,hscale )
  445.    vscale     := if(vscale  == NIL,0,vscale )
  446.    density    := if(density == NIL,0,density)
  447.    printps(mode,hoffset,voffset,hscale,vscale,density)
  448. RETURN(Void)
  449.  
  450. // __SetVectorPrint() ----------------------------------------------------------
  451. // TecGuide-> {Function Ref::Printer Functions::UDF} {SOURCE}
  452. //    Description: Toggle vector printing ON or OFF
  453. // Mapped Command: SET VECTOR PRINT
  454. FUNCTION __SetVectorPrint(command,hoffset,voffset,hlength,units,vscale,orient,postscript,window,color,pattern,noeject)
  455.    local mode
  456.    command := if(command == NIL,2,command)
  457.    if command == 1
  458.       hoffset := if(hoffset == NIL,0,hoffset)    // horizontal offset
  459.       voffset := if(voffset == NIL,0,voffset)    // vertical offset
  460.       hlength := if(hlength == NIL,1350,hlength) // default to 1350 pixels
  461.       units   := if(units == NIL,"MMS",upper(units))  // default to mms
  462.       do case                                    // convert units to integer
  463.       case units == "MMS"
  464.          units := 0
  465.       case units == "POIN" .or. units == "1/72"
  466.          units := 1
  467.       case units == "1/100"
  468.          units := 2
  469.       endcase
  470.       vscale  := if(vscale == NIL,100,vscale)    // default to no change in scale
  471.       mode    := 1                               // pcl5 (default)
  472.       mode    := mode + postscript               // postscript
  473.       mode    := mode + window                   // clipping window
  474.       mode    := mode + color                    // color printing
  475.       mode    := mode + pattern                  // pattern priority
  476.       vpon(hoffset,voffset,hlength,units,vscale,orient,mode)  // issue the print off function
  477.    else
  478.       vpoff(noeject)                             // issue the print off function
  479.    endif
  480. RETURN(Void)
  481.  
  482. // __SetGMouse() --------------------------------------------------------------
  483. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  484. //    Description: Initialize the mouse and set the cursor type
  485. // Mapped Command: SET MOUSE
  486. FUNCTION __SetGMouse(status,cursor)
  487.    do case                                       // evaluate the requested cursor type
  488.    case cursor == NIL                            // if no cursor was specified
  489.       if status                                  // if ON
  490.          if mreset() > 0                         // mouse reset, return number of buttons
  491.             mcuron()                             // display the mouse cursor
  492.          else
  493.             __RunTimeError(NoMouseDriver,"SET MOUSE ON","__SetGMouse()")
  494.          endif                                   // if mreset() > 0                         // mouse reset, return number of buttons
  495.       else                                       // otherwise
  496.          mcuroff()                               // hide the mouse cursor
  497.       endif                                      // if status (SET MOUSE ON)
  498.    case status == NIL                            // if no status was selected
  499.       mcurtype(cursor)                           // assume the cursor type is being selected
  500.    endcase
  501. RETURN(Void)
  502.  
  503. // __DefineMouseWindow() ------------------------------------------------------
  504. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  505. //    Description: Set the area where the mouse can freely move
  506. // Mapped Command: DEFINE MOUSE WINDOW FROM
  507. FUNCTION __DefineMouseWindow(Pos1_a,Pos1_b,Pos2_a,Pos2_b)
  508.    msetwin(__XdGE(Pos1_b),__YdGE(Pos2_a),__XdGE(Pos2_b-1),__YdGE(Pos1_a-1))
  509. RETURN(Void)
  510.  
  511. // __FixMousePosition() -------------------------------------------------------
  512. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  513. //    Description: Move the mouse cursor to a new position
  514. //    dGE functions: mfixpos()
  515. // Mapped Command: FIX MOUSE POSITION AT
  516. FUNCTION __FixMousePosition(x,y)
  517.    mfixpos(__XdGE(y),__YdGE(x))                  // establish a specific mouse position
  518. RETURN(Void)
  519.  
  520. // __SetEventShadow() ---------------------------------------------------------
  521. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  522. //    Description: Set objct shadow color
  523. // Mapped Command: SET EVENT SHADOW TO <color>
  524. FUNCTION __SetEventShadow(color)
  525.    _eshadow_ := if(color == NIL,"w/n",color)     // set the object shadow color
  526. RETURN(Void)
  527.  
  528. // __DefEventRegion() ---------------------------------------------------------
  529. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  530. //    Description: Define a click region object
  531. // Mapped Command: DEFINE EVENT <label> FROM
  532. FUNCTION __DefEventRegion(label,Pos1_a,Pos1_b,Pos2_a,Pos2_b,activate)
  533.    local handle := __ScanObjects(label)          // see if we can find the object
  534.    handle := if(handle == 0,__FindUnusedHandle(label),handle)
  535.    if __HandleInRange(handle) > 0                // if the handle is valid
  536.       _handles_[handle,01] := Pos1_a
  537.       _handles_[handle,02] := Pos1_b
  538.       _handles_[handle,03] := Pos2_a
  539.       _handles_[handle,04] := Pos2_b
  540.       _handles_[handle,05] := NullString         // n/a in this object type
  541.       _handles_[handle,06] := EventRegionObject  // object type
  542.       _handles_[handle,07] := ShadowOff          // shadow
  543.       _handles_[handle,08] := label              // object name
  544.       _handles_[handle,09] := InactiveObject     // status
  545.       _handles_[handle,10] := NullInteger        // dGE icon number (0 through 7)
  546.       if activate
  547.          __ActEventRegion(label)
  548.       endif
  549.    else                                          // otherwise handle was invalid
  550.       __HandleError(NoHandlesLeft,label)         // branch to handle error routine
  551.    endif                                         // if handle > 0 .and. handle <= maxobjects      // if successful in gettong a get area
  552. RETURN(Void)
  553.  
  554. // __ActEventRegion() ---------------------------------------------------------
  555. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  556. //    Description: Toggles event region to active status
  557. // Mapped Command: ACTIVATE EVENT <label>
  558. FUNCTION __ActEventRegion(label)
  559.    local handle := __ScanObjects(label)          // get a handle if possible
  560.    if handle > 0                                 // find out if the button exists
  561.       _handles_[handle,9] := ActiveObject        // status (active)
  562.       do case
  563.       case _handles_[handle,06] == EventRegionObject
  564.          msethot(handle, ;
  565.             __XdGE(_handles_[handle,2]), ;
  566.             __YdGE(_handles_[handle,3]), ;
  567.             __XdGE_((_handles_[handle,4] - _handles_[handle,2])), ;
  568.             __YdGE_((_handles_[handle,3] - _handles_[handle,1])))
  569.       case _handles_[handle,06] == IconButtonObject
  570.          __ActIconButton(label)
  571.       case _handles_[handle,06] == TextButtonObject
  572.          * ...
  573.       endcase
  574.    else                                          // otherwise the button doesn't exists
  575.       __HandleError(NoSuchLabel,label)           // process the error
  576.    endif
  577. RETURN(Void)
  578.  
  579. // __FlaEventRegion() ---------------------------------------------------------
  580. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  581. //    Description: Redraw an event object for flash effect (default activates)
  582. // Mapped Command: FLASH EVENT <label>
  583. FUNCTION __FlaEventRegion(label)
  584.    local handle := __ScanObjects(label)          // if the button does indeed exits
  585.    if __HandleInRange(handle) > 0                // if we have a valid handle
  586.       do case
  587.       case _handles_[handle,06] == EventRegionObject
  588.          msethot(handle,0,0,0,0)                 // clear the mouse hot region
  589.       case _handles_[handle,06] == IconButtonObject
  590.          __ClrIconButton(handle)                 // clear the icon from the screen
  591.          __ActIconButton(label)                  // redisplay the icon
  592.       case _handles_[handle,06] == TextButtonObject
  593.          * ...
  594.       endcase
  595.    else                                          // apparently there is no object by that name
  596.       __HandleError(NoSuchLabel,label)           // branch to the handle error routine
  597.    endif                                         // if handle > 0 .and. handle <= maxobjects      // if successful in gettong a get area
  598. RETURN(Void)
  599.  
  600. // __MovEventRegion() ---------------------------------------------------------
  601. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  602. //    Description: Moves, activates and redisplays the specified event object
  603. // Mapped Command: MOVE EVENT <label>
  604. FUNCTION __MovEventRegion(label,Pos1,Pos2,activate,deactivate)
  605.    local handle := __ScanObjects(label)          // get a handle if possible
  606.    local PrevPos1, PrevPos2, currcolor
  607.    if handle > 0                                 // find out if the button exists
  608.       PrevPos1 := _handles_[handle,1]            // save the old position
  609.       PrevPos2 := _handles_[handle,2]            // save the old position
  610.       _handles_[handle,1] := Pos1                // status (active)
  611.       _handles_[handle,2] := Pos2                // status (active)
  612.       _handles_[handle,9] := if(activate == NIL,_handles_[handle,9],ActiveObject)
  613.       _handles_[handle,9] := if(deactivate == NIL,_handles_[handle,9],InactiveObject)
  614.       do case
  615.       case _handles_[handle,06] == EventRegionObject
  616.          _handles_[handle,3] := _handles_[handle,3] + (Pos1 - PrevPos1)
  617.          _handles_[handle,4] := _handles_[handle,4] + (Pos2 - PrevPos2)
  618.       case _handles_[handle,06] == IconButtonObject
  619.          msethot(handle, ;
  620.             __XdGE(_handles_[handle,2] - (_icnwidt_/2)), ;
  621.             __YdGE((_handles_[handle,1] + _icnheig_) - (_icnheig_/2)), ;
  622.             __XdGE_(_icnwidt_), ;
  623.             __YdGE_(_icnheig_))
  624.          if _handles_[handle,7]                  // if a shadow has been selected, display shadow
  625.             currcolor := setcolor()              // save the current color
  626.             setcolor(_eshadow_)                  // set color to the shadow color and draw the shadow box
  627.             loadicon(_dgepath_ + "gllibr.ico")
  628.             __DrawSuperIcon(0,_handles_[handle,1]+IconShadowOffsetD,_handles_[handle,2]+IconShadowOffsetR)
  629.             loadicon(_icnfile_)
  630.             setcolor(currcolor)                  // restore the Clipper color
  631.          endif                                   // if shadow
  632.          __DrawSuperIcon(_handles_[handle,10],_handles_[handle,1],_handles_[handle,2])
  633.       case _handles_[handle,06] == TextButtonObject
  634.          * ...
  635.       endcase
  636.    else                                          // otherwise the button doesn't exists
  637.       __HandleError(NoSuchLabel,label)           // process the error
  638.    endif
  639. RETURN(Void)
  640.  
  641. // __DeaEventRegion() ---------------------------------------------------------
  642. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  643. //    Description: Toggles event region to inactive status
  644. // Mapped Command: DEACTIVATE EVENT <label>
  645. FUNCTION __DeaEventRegion(label,clr)
  646.    local handle := __ScanObjects(label)          // get a handle if possible
  647.    if handle > 0                                 // if the object does indeed exist
  648.       _handles_[handle,9] := InactiveObject      // status (inactive)
  649.       do case
  650.       case _handles_[handle,06] == EventRegionObject
  651.          msethot(handle,0,0,0,0)                 // clear the mouse hot region
  652.       case _handles_[handle,06] == IconButtonObject
  653.          __DeaIconButton(label,clr)
  654.       case _handles_[handle,06] == TextButtonObject
  655.          * ...
  656.       endcase
  657.    else                                          // otherwise it's an invalid object
  658.       __HandleError(NoSuchLabel,label)           // branch to the handle error routine
  659.    endif
  660. RETURN(Void)
  661.  
  662. // __RelEventRegion() ---------------------------------------------------------
  663. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  664. //    Description: 
  665. // Mapped Command: RELEASE EVENT <label>
  666. FUNCTION __RelEventRegion(label)
  667.    local handle := __ScanObjects(label)          // if the button does indeed exits
  668.    if handle > 0                                 // if we have a valid handle ID
  669.       do case
  670.       case _handles_[handle,06] == EventRegionObject
  671.          * do nothing...                         // no need to clear anything
  672.       case _handles_[handle,06] == IconButtonObject
  673.          __ClrIconButton(handle)                 // clear the icon from the screen
  674.       case _handles_[handle,06] == TextButtonObject
  675.          * __ClrTextButton(handle)               // clear the text from the screen
  676.       endcase
  677.       _handles_[handle,01] := 0                  // upper left row
  678.       _handles_[handle,02] := 0                  // upper left column
  679.       _handles_[handle,03] := 0                  // lower right row
  680.       _handles_[handle,04] := 0                  // lower right column
  681.       _handles_[handle,05] := NullString         // object text
  682.       _handles_[handle,06] := 0                  // object type
  683.       _handles_[handle,07] := ShadowOff          // shadow
  684.       _handles_[handle,08] := NullString         // object name
  685.       _handles_[handle,09] := InactiveObject     // status (inactive)
  686.       _handles_[handle,10] := NullInteger        // dGE icon number (0 through 7)
  687.    else                                          // apparently there is no object by that name
  688.       __HandleError(NoSuchLabel,label)           // branch to the handle error routine
  689.    endif                                         // if handle > 0 .and. handle <= maxobjects      // if successful in gettong a get area
  690. RETURN(Void)
  691.  
  692. // __DefIconButton() ----------------------------------------------------------
  693. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  694. //    Description: Define and optionally activate a super icon button
  695. // Mapped Command: DEFINE EVENT <label> AT
  696. FUNCTION __DefIconButton(label,Pos1,Pos2,icon,activate,shadow)
  697.    local handle := __ScanObjects(label)          // see if we can find the object
  698.    handle := if(handle == 0,__FindUnusedHandle(label),handle)
  699.    if __HandleInRange(handle) > 0                // if the handle is valid
  700.       _handles_[handle,01] := (Pos1)
  701.       _handles_[handle,02] := (Pos2)
  702.       _handles_[handle,03] := 0
  703.       _handles_[handle,04] := 0
  704.       _handles_[handle,05] := NullString         // n/a in this object type
  705.       _handles_[handle,06] := IconButtonObject   // object type
  706.       _handles_[handle,07] := shadow             // shadow
  707.       _handles_[handle,08] := label              // object name
  708.       _handles_[handle,09] := InactiveObject     // status
  709.       _handles_[handle,10] := icon               // dGE icon number (0 through 7)
  710.       if activate
  711.          __ActIconButton(label)
  712.       endif
  713.    else                                          // otherwise handle was invalid
  714.       __HandleError(NoHandlesLeft,label)         // branch to handle error routine
  715.    endif                                         // if handle > 0 .and. handle <= maxobjects      // if successful in gettong a get area
  716. RETURN(Void)
  717.  
  718. // __ActIconButton() ----------------------------------------------------------
  719. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  720. //    Description: Toggles the button to active and displays it
  721. // Mapped Command:
  722. FUNCTION __ActIconButton(label)
  723.    local currcolor
  724.    local handle := __ScanObjects(label)          // get a handle if possible
  725.    if handle > 0                                 // find out if the button exists
  726.       _handles_[handle,9] := ActiveObject        // status (active)
  727.       msethot(handle, ;
  728.          __XdGE(_handles_[handle,2] - (_icnwidt_/2)), ;
  729.          __YdGE((_handles_[handle,1] + _icnheig_) - (_icnheig_/2)), ;
  730.          __XdGE_(_icnwidt_), ;
  731.          __YdGE_(_icnheig_))
  732.       if _handles_[handle,7]                     // if a shadow has been selected, display shadow
  733.          currcolor := setcolor()                 // save the current color
  734.          setcolor(_eshadow_)                     // set color to the shadow color and draw the shadow box
  735.          loadicon(_dgepath_ + "gllibr.ico")
  736.          __DrawSuperIcon(0,_handles_[handle,1]+IconShadowOffsetD,_handles_[handle,2]+IconShadowOffsetR)
  737.          loadicon(_icnfile_)
  738.          setcolor(currcolor)                     // restore the Clipper color
  739.       endif                                      // if shadow
  740.       __DrawSuperIcon(_handles_[handle,10],_handles_[handle,1],_handles_[handle,2])
  741.    else                                          // otherwise the button doesn't exists
  742.       __HandleError(NoSuchLabel,label)           // process the error
  743.    endif
  744. RETURN(Void)
  745.  
  746. // __DeaIconButton() ----------------------------------------------------------
  747. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  748. //    Description: Toggles a button off
  749. // Mapped Command:
  750. FUNCTION __DeaIconButton(label,clr)
  751.    local handle := __ScanObjects(label)          // get a handle if possible
  752.    if handle > 0                                 // if the object does indeed exist
  753.       _handles_[handle,9] := InactiveObject      // status (inactive)
  754.       msethot(handle,0,0,0,0)                    // clear the mouse hot region
  755.       if clr                                     // deactivate and clear from the array
  756.          __ClrIconButton(handle)                 // clear the icon from the screen
  757.       endif
  758.    else                                          // otherwise it's an invalid object
  759.       __HandleError(NoSuchLabel,label)           // branch to the handle error routine
  760.    endif
  761. RETURN(Void)
  762.  
  763. // __ClrIconButton() ----------------------------------------------------------
  764. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  765. //    Description: Clear an icon from the screen given the handle ID
  766. // Mapped Command: 
  767. FUNCTION __ClrIconButton(handle)
  768.    clrwin(__XdGE(_handles_[handle,2])-__XdGE_(_icnwidt_/2),;
  769.       __YdGE(_handles_[handle,1])-__YdGE_((_icnheig_/2)+IconShadowOffsetD+.1),;
  770.       __XdGE(_handles_[handle,2])+__XdGE_((_icnwidt_/2)+IconShadowOffsetR+.1),;
  771.       __YdGE(_handles_[handle,1])+__YdGE_(_icnheig_/2))
  772. RETURN(Void)
  773.  
  774. // __WaitForEvent() -----------------------------------------------------------
  775. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  776. //    Description: Get a mouse click and return the handle number
  777. // Mapped Command: WAIT EVENT TO
  778. FUNCTION __WaitForEvent(flash)
  779.    local handle, label
  780.    flash  := if(flash == NIL,TRUE,flash)         // are we going to flash the object on selection
  781.    do while TRUE                                 // loop until the mouse has been clicked
  782.       do while TRUE                              // loop until the mouse has been clicked
  783.          if mstatus() == 1                       // if the mouse has been clicked
  784.             exit                                 // exit from the loop
  785.          endif                                   // mstatus() == 1
  786.       enddo                                      // continue looping
  787.       handle := mgethot()                        // get the handle where it was clicked (may be zero)
  788.       if handle > 0                              // if the click was in a hot region
  789.          if _handles_[handle,9] == ActiveObject  // if the object selected is active
  790.             label := __FindObject(handle)        // determine the object name of the handle that was clicked
  791.             if flash                             // if a flash has been requested on selection
  792.                __FlaEventRegion(label)           // flash the object with the shadow
  793.             endif                                // if flash
  794.             retu(label)                          // return the handle label
  795.          endif
  796.       endif                                      // if _handles_[handle,?]
  797.    enddo                                         // do while true                                 // loop until the mouse has been clicked
  798. RETURN("")                                       // return a blank label
  799.  
  800. // __WaitForClick() -----------------------------------------------------------
  801. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  802. //    Description: Get a mouse click from a specified object area
  803. // Mapped Command: WAIT EVENT <label>
  804. FUNCTION __WaitForClick(label,deactivate,release,noflash)
  805.    local handle  := __ScanObjects(label)         // get the handle for this object
  806.    if __HandleInRange(handle) > 0                // if the handle is valid
  807.       noflash := if(noflash == NIL,FALSE,noflash)  // are we going to flash the object on selection
  808.       do while TRUE                              // loop until the region specified was clicked in
  809.          if mstatus() == 1 .and. handle == mgethot()
  810.             exit                                 // exit when the region is clicked
  811.          endif                                   // if mstatus() == 1 .and. region == mgethot()
  812.       enddo                                      // continue looping
  813.       if deactivate
  814.          __DeaEventRegion(label,FALSE)
  815.       endif                                      // if deactivate
  816.       if release
  817.          __RelEventRegion(label)
  818.       endif                                      // if release
  819.    else
  820.       __Handleerror(NoSuchLabel,label,procname())
  821.    endif                                         // if __handleinrange()
  822. RETURN("")                                       // return a blank label
  823.  
  824. // __HandleError() ------------------------------------------------------------
  825. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  826. //    Description: Display handle error and quit
  827. // Mapped Command: 
  828. FUNCTION __HandleError(error,label,procname)
  829.    procname := if(procname == NIL,"Unknown Proc",procname)
  830.    settext()
  831.    clear screen
  832.    do case
  833.    case error == NoSuchLabel
  834.       ? procname + ": No such label: " + label + "!"
  835.    case error == NoLabelsLeft
  836.       ? procname + ": No handles left to create label: " + label + "!"
  837.    case error == NoMemoryLeft
  838.       ? procname + ": No video memory left to create screen save: " + label + "!"
  839.    endcase
  840.    quit
  841. RETURN(Void)
  842.  
  843. // __HandleInRange() ----------------------------------------------------------
  844. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  845. //    Description: Determine if handle number is in valid range
  846. // Mapped Command: 
  847. FUNCTION __HandleInRange(handle)
  848. RETURN(if(handle >=1 .and. handle <= MaxHandles,1,0))
  849.  
  850. // __FindUnusedHandle() -------------------------------------------------------
  851. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  852. //    Description: Find the next free handle
  853. // Mapped Command: 
  854. FUNCTION __FindUnusedHandle()
  855.    local n
  856.    for n := 1 to MaxHandles
  857.       if empty(_handles_[n,8])
  858.          retu(n)
  859.       endif                                      // if _handles_[n,8] := object
  860.    next                                          // for n := 1 to MaxHandles
  861. RETURN(0)
  862.  
  863. // __ScanObjects() ------------------------------------------------------------
  864. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  865. //    Description: Find the handle of a specified object
  866. // Mapped Command: 
  867. FUNCTION __ScanObjects(object)
  868.    local n
  869.    for n := 1 to MaxHandles
  870.       if _handles_[n,8] == object
  871.          retu(n)
  872.       endif                                      // if _handles_[n,8] := object
  873.    next                                          // for n := 1 to MaxHandles
  874. RETURN(0)
  875.  
  876. // __FindObject() -------------------------------------------------------------
  877. // TecGuide-> {Function Ref::Event Functions::UDF} {SOURCE}
  878. //    Description: Find the object of a specified handle
  879. // Mapped Command: 
  880. FUNCTION __FindObject(handle)
  881. RETURN(if(handle>0 .and. handle<=MaxHandles,_handles_[handle,8],""))
  882.  
  883. // __DrawBarChart() -----------------------------------------------------------
  884. // TecGuide-> {Function Ref::Business Functions::UDF} {SOURCE}
  885. //    Description: Draw a bar chart
  886. // Mapped Command: DRAW BAR CHART AT
  887. FUNCTION __DrawBarChart(Pos1,Pos2,dbf,field,label,width,height,division,filter,solid,dotted,dashed,box,pat,color,three_d,horiz)
  888.    local n, select_, xlabeltxt, ylabeltxt, maxvalue, divisions, scalefact, increment
  889.    local gmode := three_d + horiz                // calculate the chart mode
  890.    local amode := solid + dotted + dashed + box  // calculate the axis mode
  891.    local pattern := 1                            // establish a pattern increment
  892.    label     := if(label == NIL,"",label)        // establish X axes label default
  893.    width     := if(width == NIL,BarChartWidth,width)  // establish chart width
  894.    height    := if(height == NIL,BarChartHeight,height)  // establish chart height
  895.    color     := if(color == NIL,"",color)
  896.    if " " $ color .and. "BRIG" $ upper(color)
  897.       color := substr(color,at("BRIG",upper(color)))
  898.       color := ltrim(substr(color,at(" ",color)))
  899.       color := "bright " + trim(substr(color,1,at(" ",color)))
  900.    else
  901.       if " " $ color
  902.          color := trim(substr(color,1,at(" ",color)))
  903.       endif                                      // if " " $ color
  904.    endif                                         // if " " $ color .and. "brig" $ upper(color)
  905.    select_   := select()                         // save the current area
  906.    xlabeltxt := ylabeltxt := ""                  // establish the label text memvar
  907.    use &dbf new                                  // open the plot database
  908.    datareset()                                   // clear the dGE data array
  909.    if filter != NIL                              // are we filtering the dbf?
  910.       set filter to &filter                      // establish a filter
  911.       go top                                     // reset the database pointer
  912.    endif                                         // if filter != nil
  913.    maxvalue := &field                            // start with the first value
  914.    n := 1                                        // establish a bar counter
  915.    do while .not. eof()                          // loop through all the valid records
  916.       maxvalue := if(&field > maxvalue,&field,maxvalue)  // get the max value
  917.       skip                                       // next valid record
  918.       n ++                                       // increment the bar counter
  919.    enddo
  920.    maxvalue  := 1.10 * maxvalue                  // increase the max by 10%
  921.    division  := if(division == NIL,maxvalue/4,division)
  922.    divisions := int(maxvalue/division)           // establish default dependent value
  923.    scalefact := __YdGE_(height+2)/maxvalue
  924.    for n := 1 to divisions - 1                   // create the y label text
  925.       ylabeltxt := ylabeltxt + str(division * n,5)
  926.    next
  927.    n := 1                                        // establish a bar counter
  928.    go top
  929.    do while .not. eof()                          // loop through all the valid records
  930.       datastore(scalefact * &field,if(pat,pattern,0),0,if(empty(color),__DgeColor(setcolor()),__WordToColor(color)))
  931.       pattern := if(pattern == 20,1,pattern+1)   // increment the pattern
  932.       if len(label) > 0
  933.          xlabeltxt := xlabeltxt + &label         // accumulate the label string
  934.       endif
  935.       n ++                                       // increment the bar counter
  936.       skip                                       // next valid record
  937.    enddo
  938.    increment := __XdGE(width)/n                  // calculate the increment
  939.    xyaxes(__XdGE(Pos2-2),__YdGE(Pos1+.5),__XdGE_(width),__YdGE_(height+2),n,divisions,amode,__DgeColor(setcolor()))
  940.    labelx(__XdGE(Pos2+.75),__YdGE(Pos1+2),increment,if(len(label)>0,len(&label),0),0,BarXLabels,__DgeColor(setcolor()),xlabeltxt)
  941.    labely(__XdGE(Pos2-(5 + 2.5)),__YdGE(Pos1-1),__YdGE_(height+2)/divisions,5,0,0,__DgeColor(setcolor()),ylabeltxt)
  942.    bargraph(__XdGE(Pos2),__YdGE(Pos1),increment,gmode,1)  // display the bar chart
  943.    use                                           // close plot database
  944.    select(select_)                               // restore area
  945. RETURN(Void)
  946.  
  947. // __DrawXYChart() ------------------------------------------------------------
  948. // TecGuide-> {Function Ref::Business Functions::UDF} {SOURCE}
  949. //    Description: Draw an XY chart
  950. // Mapped Command: DRAW XY CHART AT
  951. FUNCTION __DrawXYChart(Pos1,Pos2,dbf,field,label,width,height,division,filter,solid,dotted,dashed,box,col)
  952.    local n, maxvalue, divisions, scalefact, increment
  953.    local amode := solid + dotted + dashed + box  // calculate the axis mode
  954.    local select_ := select()                     // save the current area  
  955.    local color := 1                              // establish acolor increment
  956.    local xlabeltxt := ""                         // establish the xlabel text memvar
  957.    local ylabeltxt := ""                         // establish the ylabel text memvar
  958.    label     := if(label == NIL,"",label)        // establish X axes label default
  959.    width     := if(width == NIL,BarChartWidth,width)  // establish chart width
  960.    height    := if(height == NIL,BarChartHeight,height)  // establish chart height
  961.    use &dbf new                                  // open the plot database
  962.    datareset()                                   // clear the dGE data array
  963.    if filter != NIL                              // are we filtering the dbf?
  964.       set filter to &filter                      // establish a filter
  965.       go top                                     // reset the database pointer
  966.    endif                                         // if filter != nil
  967.    maxvalue := &field                            // start with the first value
  968.    n := 1                                        // establish a bar counter
  969.    do while .not. eof()                          // loop through all the valid records
  970.       maxvalue := if(&field > maxvalue,&field,maxvalue)  // get the max value
  971.       skip                                       // next valid record
  972.       n ++                                       // increment the bar counter
  973.    enddo
  974.    maxvalue  := 1.10 * maxvalue                  // increase the max by 10%
  975.    division  := if(division == NIL,maxvalue/4,division)
  976.    divisions := int(maxvalue/division)           // establish default dependent value
  977.    scalefact := __YdGE_(height+2)/maxvalue
  978.    for n := 1 to divisions - 1                   // create the y label text
  979.       ylabeltxt := ylabeltxt + str(division * n,5)
  980.    next
  981.    n := 1                                        // establish a bar counter
  982.    go top
  983.    do while .not. eof()                          // loop through all the valid records
  984.       datastore(scalefact * &field,0,0,0)
  985.       color := if(color == 20,1,if(color == 7,color+2,color+1))
  986.       if len(label) > 0
  987.          xlabeltxt := xlabeltxt + &label         // accumulate the label string
  988.       endif
  989.       n ++                                       // increment the bar counter
  990.       skip                                       // next valid record
  991.    enddo
  992.    increment := __XdGE(width)/n                  // calculate the increment
  993.    xyaxes(__XdGE(Pos2-2),__YdGE(Pos1+.5),__XdGE_(width),__YdGE_(height+2),n,divisions,amode,__DgeColor(setcolor()))
  994.    labelx(__XdGE(Pos2+.75),__YdGE(Pos1+2),increment,if(len(label)>0,len(&label),0),0,BarXLabels,__DgeColor(setcolor()),xlabeltxt)
  995.    labely(__XdGE(Pos2-(5 + 2.5)),__YdGE(Pos1-1),__YdGE_(height+2)/divisions,5,0,0,__DgeColor(setcolor()),ylabeltxt)
  996.    xygraph(__XdGE(Pos2),__YdGE(Pos1),increment,0,__DgeColor(setcolor()))  // display the bar chart
  997.    use                                           // close plot database
  998.    select(select_)                               // restore area
  999. RETURN(Void)
  1000.  
  1001. // __DrawPieChart() -----------------------------------------------------------
  1002. // TecGuide-> {Function Ref::Business Functions::UDF} {SOURCE}
  1003. //    Description: Draw a pie chart
  1004. // Mapped Command: DRAW PIE CHART AT
  1005. FUNCTION __DrawPieChart(Pos1,Pos2,dbf,field,filter,pat,col,label,offset,slice,radius,percent,noconnect)
  1006.    local n, maxvalue, divisions, scalefact, increment
  1007.    local pattern := 1                            // establish the beginning pattern
  1008.    local color   := 2                            // establish the beginning color
  1009.    local select_ := select()                     // save the current area 
  1010.    local labeltxt:= ""                           // establish a blank label accumulator
  1011.    label   := if(label == NIL,"",label)          // get the specified label (not sure if this has to be a field)
  1012.    offset  := if(offset == NIL,PieLabelOffSet,offset)  // set the offset if not specified
  1013.    slice   := if(slice == NIL,0,slice)           // pie slice to explode
  1014.    radius  := if(radius == NIL,PieChartRadius,radius)  // determine the radius, default to 20
  1015.    use &dbf new                                  // open the plot database
  1016.    datareset()                                   // clear the dGE daya array
  1017.    if filter != NIL                              // is there a filter statement?
  1018.       set filter to &filter                      // set the requested filter
  1019.       go top                                     // reset the database pointer
  1020.    endif                                         // if filter != nil
  1021.    maxvalue := &field                            // start with the first value in the plot field
  1022.    n := 1                                        // establish a bar counter
  1023.    do while .not. eof()                          // loop through all the valid records
  1024.       maxvalue := if(&field > maxvalue,&field,maxvalue)  // get the max value of each slice
  1025.       skip                                       // next valid record
  1026.       n ++                                       // increment the slice counter
  1027.    enddo                                         // keep doing it 'till the eof()
  1028.    go top                                        // back to the first record
  1029.    n := 1                                        // establish a slice counter
  1030.    do while .not. eof()                          // loop through the valid records
  1031.       datastore(if(&field<0,0,&field*(1000/maxvalue)),if(pat,pattern,20),if(n == slice,1,0),if(col,color,__DgeColor(setcolor())))
  1032.       color := if(color == 20,1,if(color == 7,color+2,color+1))
  1033.       pattern := if(pattern == 20,1,pattern+1)   // increment the pattern
  1034.       if percent == 0                            // if percentages are not being used for labels
  1035.          labeltxt := labeltxt + &label           // accumulate the label string
  1036.       endif                                      // if percent == 0
  1037.       n ++                                       // increment the pie slice counter (always = n-1)
  1038.       skip                                       // next valid record
  1039.    enddo                                         // do while .not. eof()                          // loop through the valid records
  1040.    piechart(__XdGE(Pos2),__YdGE(Pos1),__XdGE_(radius))  // draw the pie chart
  1041.    do case                                       // evaluate label style
  1042.    case percent > 0                              // percentage labels
  1043.       labelpie(__XdGE_(offset),__XdGE_(radius*if(slice > 0,1.35,1)),0,0,percent+noconnect,__dGEColor(setcolor()),"")
  1044.    case .not. empty(label)                       // text labels
  1045.       labelpie(__XdGE_(offset),__XdGE_(radius*if(slice > 0,1.35,1)),len(&label),0,noconnect,__dGEColor(setcolor()),labeltxt)
  1046.    endcase
  1047.    use                                           // close plot database
  1048.    select(select_)                               // restore area
  1049. RETURN(Void)
  1050.  
  1051. // __XdGE_() ------------------------------------------------------------------
  1052. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1053. //    Description: Convert @SAY Y value to dGE X value
  1054. // Mapped Command: 
  1055. FUNCTION __XdGE_(value)
  1056. RETURN(PointsPerColumn * if(value < 0,0,value))  // return the X length in dGE coordinates
  1057.  
  1058. // __YdGE_() ------------------------------------------------------------------
  1059. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1060. //    Description: Convert @SAY X value to dGE Y value
  1061. // Mapped Command: 
  1062. FUNCTION __YdGE_(value)
  1063. RETURN(PointsPerLine * if(value < 0,0,value))    // return the Y length in dGE coordinates
  1064.  
  1065. // __XdGE() -------------------------------------------------------------------
  1066. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1067. //    Description: Convert @SAY Y coordinate to dGE X coordinate
  1068. // Mapped Command: 
  1069. FUNCTION __XdGE(value)
  1070. RETURN(PointsPerColumn * if(value < 0,0,value))  // return the X location in dGE coordinates
  1071.  
  1072. // __YdGE() -------------------------------------------------------------------
  1073. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1074. //    Description: Convert @SAY X coordinate to dGE Y coordinate
  1075. // Mapped Command: 
  1076. FUNCTION __YdGE(value)
  1077. RETURN(1000-(PointsPerLine * if(value < 0,0,value)))  // return the Y location in dGE coordinates
  1078.  
  1079. // __DgeColor() ---------------------------------------------------------------
  1080. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1081. //    Description: Convert dBase color string to dGE numeric value
  1082. // Mapped Command: 
  1083. FUNCTION __DgeColor(colorstr)
  1084.    local fg, fg_bright
  1085.    if at("/",colorstr) > 0                       // check to make sure we have a color string
  1086.       fg := upper(substr(colorstr,1,at("/",colorstr)-1))  // get the foreground color from the passed string
  1087.    endif                                           
  1088.    fg_bright := if("+" $ fg,8,0)                 // if it's a bright color establish a memvar
  1089.    do case                                       // evaluate the color string
  1090.    case substr(fg,1,1) == "N" .or. fg == " "     // and return the integer value
  1091.       retu(0+fg_bright)
  1092.    case substr(fg,1,1) == "W"                    // if white is present in the string
  1093.       retu(7+fg_bright)
  1094.    otherwise                                     // otherwise
  1095.       retu(fg_bright + if('R' $ fg,4,0) + if('G' $ fg,2,0) + if('B' $ fg,1,0))  // added - PMF
  1096.    endcase
  1097. RETURN(Void)
  1098.  
  1099. // __WordToColor() ------------------------------------------------------------
  1100. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1101. //    Description: Convert color word to dGE numeric equivalent
  1102. // Mapped Command:
  1103. FUNCTION __WordToColor(color)
  1104.    do case                                       // evaluate the color word passed
  1105.    case upper(color) == "BLACK"                  // and return the integer value
  1106.       retu(00)
  1107.    case upper(color) == "BLUE"                   // cyan
  1108.       retu(01)
  1109.    case upper(color) == "GREEN"                  // magenta
  1110.       retu(02)
  1111.    case upper(color) == "CYAN"                   // white
  1112.       retu(03)
  1113.    case upper(color) == "RED"                    // red
  1114.       retu(04)
  1115.    case upper(color) == "MAGENTA"                // magenta
  1116.       retu(05)
  1117.    case upper(color) == "BROWN"                  // brown
  1118.       retu(06)
  1119.    case upper(color) == "WHITE"
  1120.       retu(07)
  1121.    case upper(color) == "GREY" .or. upper(color) == "GRAY"
  1122.       retu(08)
  1123.    case upper(color) == "BRIGHT BLUE"
  1124.       retu(09)
  1125.    case upper(color) == "BRIGHT GREEN"
  1126.       retu(10)
  1127.    case upper(color) == "BRIGHT CYAN"
  1128.       retu(11)
  1129.    case upper(color) == "BRIGHT RED"
  1130.       retu(12)
  1131.    case upper(color) == "BRIGHT MAGENTA"
  1132.       retu(13)
  1133.    case upper(color) == "YELLOW"
  1134.       retu(14)
  1135.    case upper(color) == "BRIGHT WHITE"
  1136.       retu(15)
  1137.    otherwise                                     // if non of the words match, assume white
  1138.       retu(7)
  1139.    endcase
  1140. RETURN(Void)
  1141.  
  1142. // __PalWordToColor() ------------------------------------------------------------
  1143. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1144. //    Description: Convert color word to dGE numeric equivalent for setpal()
  1145. // Mapped Command: 
  1146. FUNCTION __PalWordToColor(color)
  1147.    do case                                       // evaluate the color word passed
  1148.    case upper(color) == "BLACK"                  // and return the integer value
  1149.       retu(00)
  1150.    case upper(color) == "BLUE"                   // cyan
  1151.       retu(01)
  1152.    case upper(color) == "GREEN"                  // magenta
  1153.       retu(02)
  1154.    case upper(color) == "CYAN"                   // white
  1155.       retu(03)
  1156.    case upper(color) == "RED"                    // red
  1157.       retu(04)
  1158.    case upper(color) == "MAGENTA"                // magenta
  1159.       retu(05)
  1160.    case upper(color) == "BROWN"                  // brown
  1161.       retu(06)
  1162.    case upper(color) == "WHITE"
  1163.       retu(07)
  1164.    case upper(color) == "GREY" .or. upper(color) == "GRAY"
  1165.       retu(56)
  1166.    case upper(color) == "BRIGHT BLUE"
  1167.       retu(09)
  1168.    case upper(color) == "BRIGHT GREEN"
  1169.       retu(18)
  1170.    case upper(color) == "BRIGHT CYAN"
  1171.       retu(27)
  1172.    case upper(color) == "BRIGHT RED"
  1173.       retu(36)
  1174.    case upper(color) == "BRIGHT MAGENTA"
  1175.       retu(45)
  1176.    case upper(color) == "YELLOW"
  1177.       retu(54)
  1178.    case upper(color) == "BRIGHT WHITE"
  1179.       retu(63)
  1180.    otherwise                                     // if non of the words match, assume white
  1181.       retu(7)
  1182.    endcase
  1183. RETURN(Void)
  1184.  
  1185. // __ActiveObjects() ----------------------------------------------------------
  1186. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1187. //    Description: Determine the number of active objects in the region array
  1188. // Mapped Command: 
  1189. FUNCTION __ActiveObjects()
  1190.    local n
  1191.    local k := 0                                  // establish an active object counter
  1192.    for n := 1 to MaxHandles                      // loop through the object array
  1193.       k := if(_handles_[n,9] > 0,k++,k)          // if it's an active object in the get array, increment the counter
  1194.    next                                          // for n := 1 to MaxHandles
  1195. RETURN(k)                                        // return the number of objects that are active
  1196.  
  1197. // __DrawBevel() --------------------------------------------------------------
  1198. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1199. //    Description: Display bevel graphics around a box
  1200. // Mapped Command: 
  1201. FUNCTION __DrawBevel(x,y,depth,width,pattern)
  1202.    local currcolor := setcolor()                 // save the current Clipper color
  1203.    set color to BevelFrameColor
  1204.    draw box from x-.15,y-.325 to x+depth+.15,y+width+.325 pattern 20
  1205.    set color to "w/"
  1206.    draw line from x+depth-.15,y+width-.325 to x+depth+.15,y+width+.325
  1207.    set color to LowerRightBevelColor
  1208.    draw line from x-.15,y-.325 to x+.15,y+.325
  1209.    draw line from x-.15,y+width+.325 to x+.15,y+width-.325
  1210.    draw line from x+depth-.15,y+.325 to x+depth+.15,y-.325
  1211.    set color to BevelSurfaceColor
  1212.    draw box from x+.15,y+.325 to x+depth-.15,y+width-.325 pattern pattern
  1213.    set color to UpperLeftBevelColor
  1214.    shade area at x-.05,y+.4
  1215.    shade area at x+.4,y-.1
  1216.    set color to LowerRightBevelColor
  1217.    shade area at x+.2,y+width-.2
  1218.    shade area at x+depth,y+.35
  1219.    setcolor(currcolor)                           // restore the Clipper color
  1220. RETURN(Void)
  1221.  
  1222. // __RunTimeError() -----------------------------------------------------------
  1223. // TecGuide-> {Function Ref::Supporting Functions::UDF} {SOURCE}
  1224. //    Description: Display run time error and quit
  1225. // Mapped Command: 
  1226. FUNCTION __RunTimeError(error,label,procname)
  1227.    procname := if(procname == NIL,"Unknown Proc",procname)
  1228.    settext()
  1229.    clear screen
  1230.    do case
  1231.    case error == NoMouseDriver
  1232.       ? procname + ": No mouse driver present: " + label + "!"
  1233.    endcase
  1234.    quit
  1235. RETURN(Void)
  1236.