home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / DATABASE / C4WCARET.ZIP / CARET.PRG < prev    next >
Text File  |  1993-04-01  |  12KB  |  310 lines
  1.  
  2.  
  3. // The following code is used to provide an interface to
  4. // CA-RET from within a Clip4Win application.  Please
  5. // be warned that the code is still in its infancy and
  6. // is subject to further change/modification as my
  7. // experience with CA-RET grows.  You are welcome to
  8. // use it in any way you see fit AT YOUR OWN RISK!
  9.  
  10. // If you find something wrong or have any suggestions for
  11. // ways to improve any of this please let me know!!!!
  12.  
  13. // Sorry for the absence of comments in the code.  If I can't
  14. // understand what my code is doing then I re-write it so it
  15. // is obvious to me - if dumb old me can understand it then anyone
  16. // should!
  17. ******************************************************************
  18.  
  19. // StartCaret() - Used to start the CA-RET runtime module.  Needed
  20. // in case the user has closed the application with the last preview.
  21. // Calls Message() function which displays a sunken bar at the bottom
  22. // of the screen with a message to the user.  If there is a problem
  23. // starting the runtime module we just QUIT since we could not do
  24. // any reports without it!
  25.  
  26. STATIC LASTMSG := ""  // Used to hold the current message displayed
  27. STATIC GLOBALS := {}  // Used to hold the global mem handles for execute cmds
  28.  
  29. STATIC FUNCTION StartCaret(hClientWnd)
  30.        LOCAL cOldMsg := SaveMsg()
  31.  
  32.        Message(hClientWnd,"Loading CARES Report Engine...")
  33.        IF WinExec("CARETRUN") < 32
  34.           ErrorMsg("UNABLE TO START CARETRUN!",'E')
  35.           QUIT
  36.        ENDIF
  37.        Message(hClientWnd,cOldMsg)
  38. RETURN(NIL)
  39.  
  40. // This is my generic report printer/previewer.  It is called with
  41. // the name of the report file USERLIST.RET, DISCLIST.RET, etc.
  42. // You will need to adjust the placement of the dialogbox to suit
  43. // your application. To automatically print a series of reports
  44. // you pass the report file names as an array.  For a single report
  45. // the user automatically gets prompted to either send the report
  46. // to the screen (preview), or to the printer. Please note that
  47. // from within the CA-RET runtime module the user can print a
  48. // report after previewing it.  For a series of reports the user
  49. // does NOT have a choice - all reports are automatically sent
  50. // to the printer.  You might want to consider calling the Printer
  51. // setup dialog box first so the user can set any printer options.
  52. // I have not included it at this point since I find it rather
  53. // annoying to have the damn thing pop up every time I want to
  54. // print something in a Windows app! I do have it on the File
  55. // Menu of my app so it is always an option for the user.
  56.  
  57. // If you use this code then you will need to change the Set.Title()
  58. // command to use the title YOU want displayed in the CA-RET runtime
  59. // window!!
  60.  
  61. FUNCTION PrintIt(cReport)
  62.        LOCAL hClientWnd
  63.        LOCAL hServerWnd
  64.        LOCAL nMsg
  65.        LOCAL nCtr
  66.        LOCAL aDlg
  67.        LOCAL nSel
  68.        LOCAL lPreview := .F.
  69.  
  70.        IF VALTYPE(cReport) != 'A'
  71.           aDlg := CreateDialog("Print To?",DS_MODALFRAME+WS_POPUP+WS_CAPTION,70,63,142,31)
  72.           aDlg := AppendDialog(aDlg,"scr",DLG_BUTTON,BS_PUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_TABSTOP    , 17, 12, 31, 14,"Screen" )
  73.           aDlg := AppendDialog(aDlg,"prn",DLG_BUTTON,BS_DEFPUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_TABSTOP , 55, 12, 31, 14,"Printer")
  74.           aDlg := AppendDialog(aDlg,"can",DLG_BUTTON,BS_PUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_TABSTOP    , 93, 12, 31, 14,"Cancel" )
  75.           nSel := ModalDialog(aDlg,_GetInstance(),hOldWnd)
  76.           IF nSel == 0 .OR. nSel == 3
  77.              RETURN(NIL)
  78.           ENDIF
  79.           IF nSel == 1
  80.              lPreview := .T.
  81.           ENDIF
  82.        ENDIF
  83.        hClientWnd := _LasthWnd()
  84.        hServerWnd := DDEStart(hClientWnd,"CARETRUN","SYSTEM")
  85.        IF hServerWnd == NIL
  86.           StartCaret(hClientWnd)
  87.           hServerWnd := DDEStart(hClientWnd,"CARETRUN","System")
  88.        ENDIF
  89.        DDEAdvise(hServerWnd,hClientWnd,CF_TEXT,"CARETEVENTS")
  90.        DDEExecute(hServerWnd,hClientWnd,'Set.Title(CARES Report Engine)',.F.)
  91.        DDEExecute(hServerWnd,hClientWnd,"App.Maximize",.F.)
  92.        IF VALTYPE(cReport) != 'A'
  93.           DDEExecute(hServerWnd,hClientWnd,'File.Open('+cReport+')',.T.,"Report.Opened")
  94.           IF !lPreview
  95.              DDEExecute(hServerWnd,hClientWnd,"File.Print(0,0)",.T.,"Report.Complete")
  96.              DDEExecute(hServerWnd,hClientWnd,"File.Exit",.T.,"CARET.Close")
  97.           ELSE
  98.              DDEExecute(hWnd,hClientWnd,"File.Preview",.T.,"CARET.Close")
  99.           ENDIF
  100.        ELSE
  101.           FOR nCtr := 1 TO LEN(cReport)
  102.               DDEEXecute(hServerWnd,hClientWnd,"File.Open("+cReport[nCtr]+')',.T.,'Report.Opened')
  103.               DDEEXecute(hServerWnd,hClientWnd,"File.Print(0,0)",.T.,'Report.Complete')
  104.               DDEEXecute(hServerWnd,hClientWnd,"File.Close",.T.,'View.Close')
  105.           NEXT
  106.           DDEExecute(hServerWnd,hClientWnd,"File.Exit",.T.,"CARET.Close")
  107.        ENDIF
  108.        DDEStop(hServerWnd,hClientWnd)
  109.        FreeGlobals()
  110.        SelectWindow(hClientWnd)
  111.        SetFocus(hClientWnd)
  112. RETURN(NIL)
  113.  
  114. // This function does all the grunt work.  It issues the DDE
  115. // EXECUTE commands and if a reply is required waits for the reply.
  116. // Please note that you also need to modify the DDEGetData()
  117. // function found in the DDE.PRG distributed with Clip4Win.
  118. // DDEGetData() has been modified to accept two params, one
  119. // the handle of the DDE server and the second the handle of
  120. // the client window.
  121. // Calling conventions:
  122. //
  123. //   hServerWnd - handle/channel of DDE server.  Obtained
  124. //                from DDEStart() command.
  125. //   hClientWnd - handle of client window.
  126. //   cItem      - Execute command item.
  127. //   lData      - .T. if a reply is required, .F. if not
  128. //   cMsg       - Required response from DDL server
  129. //
  130. // The CARET.Close response from CA-RET is NOT documented by them,
  131. // had to find out by watching the traffic back and forth.  It is
  132. // issued when the user selects Exit from the File menu or closes
  133. // the window.
  134.  
  135. // For a true "generic" DDEExecute() you would NOT do any message
  136. // handling, just send the command and handle what happens elsewhere
  137. // Everything between the PostMessage() call and return would
  138. // be deleted.  You need to keep in mind that YOU MUST free the
  139. // global memory allocated by the GlobalAlloc() call!  If you
  140. // go this route then you can modify RETURN(NIL) to RETURN(hExecute)
  141. // and free it after you have processed the results of the command.
  142.  
  143. // HandleEvent() is a modified version of the one contained in
  144. // the sample code distributed with Clip4Win.  You MUST have
  145. // Clip4Win to use this code.  I have NOT included it since I
  146. // do not want to accidently distribute anything that the author/
  147. // distributor does not want out there.  You can leave it out
  148. // and restrict the user to not being able to do anything funny
  149. // while the command is being processed by the DDE server.
  150.  
  151. // GlobalAlloc(), GlobalData(), and GlobalFree() are UNDOCUMENTED
  152. // functions at this point.  The author has confirmed that they
  153. // work as used and is considering including them in the documentation
  154. // of the next release of Clip4Win.  Please note that the EXECUTE
  155. // command strings MUST be NUL terminated!  This gave me a lot
  156. // of grief until John Skelton (the author) was kind enough to
  157. // take a look at the code and pointed this out!
  158.  
  159. FUNCTION DDEExecute(hServerWnd, hClientWnd,  cItem, lData, cMsg)
  160.        LOCAL  hExecute := GlobalAlloc(2+GMEM_DDESHARE,LEN(cItem)+1,)
  161.        LOCAL  nMsg, nEvent, cData
  162.  
  163.        GlobalData(hExecute,cItem+CHR(0))
  164.        PostMessage(hServerWnd,;
  165.                    WM_DDE_EXECUTE,;
  166.                    hClientWnd,;
  167.                    MAKELPARAM(0, hExecute))
  168.        IF lData
  169.           DO WHILE .T.
  170.              DO WHILE (nEvent := ChkEvent()) != EVENT_OTHER
  171.                 HandleEvent(nEvent)
  172.              ENDDO
  173.              nMsg := _LastMsg()
  174.              IF nMsg = WM_DDE_DATA
  175.                 cData := DDEGetData(hServerWnd,hClientWnd)
  176.                 IF UPPER(cData) = UPPER(cMsg)
  177.                    EXIT
  178.                 ENDIF
  179.              ENDIF
  180.              IF nMsg = WM_DDE_TERMINATE .OR. cData == "CARET.Close"
  181.                 DDEStop(hServerWnd,hClientWnd)
  182.                 EXIT
  183.              ENDIF
  184.           ENDDO
  185.        ENDIF
  186.        AADD(GLOBALS,hExecute)
  187. RETURN(NIL)
  188.  
  189. // Free up the global memory used by DDE execute commands
  190. // Crude, but it appears to  work ok!
  191.  
  192. FUNCTION FreeGlobals
  193.          LOCAL nCtr
  194.  
  195.          FOR nCtr := 1 TO LEN(GLOBALS)
  196.              GlobalFree(GLOBALS[nCtr])
  197.          NEXT
  198.          GLOBALS := {}
  199. RETURN(NIL)
  200.  
  201. // Since in my application all this code is in one module along
  202. // with my other shared stuff, I use these two functions to
  203. // save and restore the current message displayed at the bottom
  204. // of a window.  These are crude at this point.  At some point
  205. // I intend to expand them so that I can keep track of all the
  206. // messages in all my open windows.
  207.  
  208. FUNCTION SaveMsg
  209. RETURN(LASTMSG)
  210.  
  211. FUNCTION RestMsg(cMsg)
  212.          LASTMSG := cMsg
  213. RETURN(NIL)
  214.  
  215. // This is my generic function to display error messages, warnings
  216. // and prompts to my users. 'E' type messages only allow the user
  217. // to select Ok.  'W' type messages allows the user to contine or
  218. // cancel.  Any OTHER cType param will result in the user getting
  219. // a prompt to do something Please!
  220.  
  221. FUNCTION ErrorMsg(cMarr,cType)
  222.          LOCAL nResponse
  223.  
  224.          DO CASE
  225.             CASE cType = 'W'
  226.                  Ebeep()
  227.                  nResponse := MessageBox(GetFocus(),cMarr,"Caution!",;
  228.                               MB_OKCANCEL+MB_ICONEXCLAMATION)
  229.             CASE cType = 'E'
  230.                  MessageBeep(MB_ICONHAND)
  231.                  nResponse := MessageBox(GetFocus(),cMarr,"Problem!",;
  232.                               MB_OK+MB_ICONHAND)
  233.             OTHERWISE
  234.                  MessageBeep(MB_OK)
  235.                  nResponse := MessageBox(GetFocus(),cMarr,"Please!",;
  236.                               MB_OKCANCEL+MB_ICONASTERISK)
  237.          ENDCASE
  238. RETURN(nResponse)
  239.  
  240. // Make error messages have a distict sound to the user
  241.  
  242. STATIC FUNCTION EBeep
  243.  
  244.        TONE(880,1)
  245.        TONE(440,1)
  246.        TONE(220,1)
  247.        TONE(110,1)
  248. RETURN(NIL)
  249.  
  250. // Message() and MsgBar() - Used to display a sunken message/status
  251. // bar at the bottom of a window.  Message() calls MsgBar().  You
  252. // can easily modify this so that you can call them individually
  253. // if you like.
  254.  
  255. FUNCTION Message(hWnd,cText)
  256.        LOCAL nLeft, nTop, nRight, nBottom, aCRect, hDC
  257.        LOCAL nOldBkClor
  258.  
  259.        aCRect  := GetClientRect(hWnd)
  260.        nLeft   := 0
  261.        nTop    := aCRect[4]-26
  262.        nRight  := aCRect[3]
  263.        nBottom := nTop+28
  264.  
  265.        hDC     := GetDC(hWnd)
  266.        nOldBkClor := SetBkColor(hDC,RGB(192,192,192))
  267.        MsgBar(hWnd)
  268.        DrawText(hDC,cText,;
  269.                    {nLeft+10,nTop+5,nRight-11,nBottom-5},DT_CENTER)
  270.        SetBkColor(hDC,nOldBkClor)
  271.        ReleaseDC(hWnd,hDC)
  272.        LASTMSG := cText
  273. RETURN(NIL)
  274.  
  275. FUNCTION MsgBar(hWnd)
  276.        LOCAL nLeft, nTop, nRight, nBottom, aCRect
  277.        LOCAL hDC, hColor, hBlackPen, hGreyPen, hWhitePen
  278.  
  279.        hDc     := GetDC(hWnd)
  280.        aCRect  := GetClientRect(hWnd)
  281.        nLeft   := 0
  282.        nTop    := aCRect[4]-26
  283.        nRight  := aCRect[3]
  284.        nBottom := nTop+26
  285.  
  286.        hBlackPen := CreatePen(PS_SOLID,1,RGB(0,0,0))
  287.        hGreyPen  := CreatePen(PS_SOLID,1,RGB(128,128,128))
  288.        hWhitePen := CreatePen(PS_SOLID,1,RGB(255,255,255))
  289.  
  290.        SelectObject(hDC,hBlackPen)
  291.        Rectangle(hDC,nLeft,nTop,nRight,nBottom)
  292.        hColor := CreateSolidBrush(RGB(192,192,192))
  293.        FillRect(hDC,nLeft,nTop+1,nRight,nBottom,hColor)
  294.  
  295.        SelectObject(hDC,hGreyPen)
  296.        MoveTo(hDC,nLeft+10,nBottom-4)
  297.        LineTo(hDC,nLeft+10,nTop+4)
  298.        LineTo(hDC,nRight-10,nTop+4)
  299.  
  300.        SelectObject(hDC,hWhitePen)
  301.        LineTo(hDC,nRight-10,nBottom-4)
  302.        LineTo(hDC,nLeft+10,nBottom-4)
  303.  
  304.        ReleaseDC(hWnd,hDC)
  305.        DeleteObject(hColor)
  306.        DeleteObject(hBlackPen)
  307.        DeleteObject(hGreyPen)
  308.        DeleteObject(hWhitePen)
  309. RETURN(NIL)
  310.