home *** CD-ROM | disk | FTP | other *** search
/ BUG 4 / BUGCD1997_05.BIN / aplic / clip4win / clip4win.exe / C4W30E.HUF / SOURCE / RRWREP.PRG < prev    next >
Text File  |  1995-05-04  |  3KB  |  113 lines
  1. /////////////////////////
  2. //
  3. //    rrwrep.prg - Demo of R & R Report Writer Xbase version 6.0
  4. //
  5. //    Copyright (C) 1995 Skelton Software, Kendal Cottage, Hillam, Leeds LS25 5HP, UK.
  6. //    All Rights Reserved.
  7. //
  8. //    Note: You need rrwapi.prg as well.
  9. //
  10. /////////////////////////
  11.  
  12. #define    WIN_WANT_ALL
  13. #include "windows.ch"
  14. #include "vo.ch"
  15. #define    NO_C4WCLASS
  16. #include "commands.ch"
  17.  
  18. function main()
  19. local    oApp, hWnd
  20.  
  21. CREATE APPLICATION oApp                        ;
  22.     WINDOW hWnd                        ;
  23.     TITLE "Clip-4-Win Using R & R for Windows"        ;
  24.     ON INIT MenuSetup(hWnd)
  25.  
  26. return nil
  27.  
  28.  
  29. static function MenuSetup(hWnd)
  30. MENU in hWnd
  31.     POPUP  "&File"
  32.     MENUITEM  "&Run R && R Reports"  ACTION RRTest(hWnd)
  33.     MENUITEM  SEPARATOR
  34.     MENUITEM  "E&xit"  ACTION PostQuitMessage(0)
  35.     ENDPOPUP
  36. ENDMENU
  37. return nil
  38.  
  39.  
  40. // Many thanks to Rick Spence for donating the original of this code!
  41.  
  42. static function RRTest(hWnd)
  43. LOCAL lResult      AS LOGIC
  44. LOCAL hReport      AS SHORT
  45. LOCAL ptrRepName   AS PTR
  46. LOCAL pszErrorMsg  AS PTR
  47. LOCAL ptrCode      AS PTR
  48. LOCAL ptrReport    AS PTR
  49. LOCAL ptrEcode     AS PTR
  50. LOCAL ptrPageCount AS PTR
  51. LOCAL ptrEMsg      AS PTR
  52.  
  53. LOCAL hRR
  54.  
  55.   hRR := LoadLibrary("RReport.dll")
  56.  
  57.   // R & R seems to need a ptr to a NULL string. Allocate one byte
  58.   // and set it to 0
  59.   ptrRepName := chr(0)
  60.  
  61.   lResult := InitRunTimeInstance()
  62.   hReport := ChooseReport("RRTEST", ;
  63.                           "I:\rrw\rrsample\rrsample.rp5", ;
  64.                           ptrRepName, 1)
  65.  
  66.   IF hReport == 0
  67.     MessageBox( , "Received Error", "R&R Error")
  68.     ptrEMsg  := MemAlloc(200)
  69.     ptrECode := MemAlloc(2)      // INT
  70.     GetErrorInfo(@ptrEMsg, len(ptrEMsg), @ptrECode)
  71.     MessageBox( , ptrEMsg, "R&R GetErrorInfo Msg")
  72.     MessageBox( , left(ptrECode, 1), "R&R GetErrorInfo Code")
  73.   ELSE
  74.     // My window now becomes R & R's parent
  75.     SetWinParentHandle(hReport, hWnd)
  76.   
  77.     // Put up a query box
  78.     SetFilterUsage(hReport, ASC("?"))
  79.   
  80.     // We want to see messages
  81.     SetDisplayStatus(hReport, TRUE)
  82.  
  83.     // Ask user to select destination  
  84.     SetOutputDest(hReport,ASC("?"))
  85.   
  86.     // Allocate memory for ExecRuntime()'s pointers
  87.     ptrECode := MemAlloc(2)      // INT
  88.     ptrPageCount := MemAlloc(4)  // LONG
  89.     ptrEMsg := MemAlloc(200)     // The message
  90.     lResult := ExecRuntime(;
  91.                 hReport,;    //    hReport   AS SHORT
  92.                 TRUE,;            //    bWait     AS LOGIC
  93.                 SW_SHOWNORMAL,;    //    cmdShow   AS SHORT
  94.                 @ptrECode,;    //    ECode     AS PTR
  95.                 @ptrPageCount,;    //    PageCount AS PTR
  96.                 @ptrEMsg,;    //    EMsg      AS PTR
  97.                 200;    //  EMSize    AS SHORT
  98.                 )    // end of call 
  99.  
  100.     EndReport(hReport)
  101.  
  102.     MemFree(ptrECode)
  103.     MemFree(ptrPageCount)
  104.     MemFree(ptrEMsg)
  105.   ENDIF
  106.   EndRuntimeInstance()
  107.  
  108.   SetFocus(hWnd)
  109.  
  110.   FreeLibrary(hRR)
  111.  
  112. RETURN nil
  113.