home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR19
/
C4WCARET.ZIP
/
CARET.PRG
< prev
next >
Wrap
Text File
|
1993-04-01
|
12KB
|
310 lines
// The following code is used to provide an interface to
// CA-RET from within a Clip4Win application. Please
// be warned that the code is still in its infancy and
// is subject to further change/modification as my
// experience with CA-RET grows. You are welcome to
// use it in any way you see fit AT YOUR OWN RISK!
// If you find something wrong or have any suggestions for
// ways to improve any of this please let me know!!!!
// Sorry for the absence of comments in the code. If I can't
// understand what my code is doing then I re-write it so it
// is obvious to me - if dumb old me can understand it then anyone
// should!
******************************************************************
// StartCaret() - Used to start the CA-RET runtime module. Needed
// in case the user has closed the application with the last preview.
// Calls Message() function which displays a sunken bar at the bottom
// of the screen with a message to the user. If there is a problem
// starting the runtime module we just QUIT since we could not do
// any reports without it!
STATIC LASTMSG := "" // Used to hold the current message displayed
STATIC GLOBALS := {} // Used to hold the global mem handles for execute cmds
STATIC FUNCTION StartCaret(hClientWnd)
LOCAL cOldMsg := SaveMsg()
Message(hClientWnd,"Loading CARES Report Engine...")
IF WinExec("CARETRUN") < 32
ErrorMsg("UNABLE TO START CARETRUN!",'E')
QUIT
ENDIF
Message(hClientWnd,cOldMsg)
RETURN(NIL)
// This is my generic report printer/previewer. It is called with
// the name of the report file USERLIST.RET, DISCLIST.RET, etc.
// You will need to adjust the placement of the dialogbox to suit
// your application. To automatically print a series of reports
// you pass the report file names as an array. For a single report
// the user automatically gets prompted to either send the report
// to the screen (preview), or to the printer. Please note that
// from within the CA-RET runtime module the user can print a
// report after previewing it. For a series of reports the user
// does NOT have a choice - all reports are automatically sent
// to the printer. You might want to consider calling the Printer
// setup dialog box first so the user can set any printer options.
// I have not included it at this point since I find it rather
// annoying to have the damn thing pop up every time I want to
// print something in a Windows app! I do have it on the File
// Menu of my app so it is always an option for the user.
// If you use this code then you will need to change the Set.Title()
// command to use the title YOU want displayed in the CA-RET runtime
// window!!
FUNCTION PrintIt(cReport)
LOCAL hClientWnd
LOCAL hServerWnd
LOCAL nMsg
LOCAL nCtr
LOCAL aDlg
LOCAL nSel
LOCAL lPreview := .F.
IF VALTYPE(cReport) != 'A'
aDlg := CreateDialog("Print To?",DS_MODALFRAME+WS_POPUP+WS_CAPTION,70,63,142,31)
aDlg := AppendDialog(aDlg,"scr",DLG_BUTTON,BS_PUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_TABSTOP , 17, 12, 31, 14,"Screen" )
aDlg := AppendDialog(aDlg,"prn",DLG_BUTTON,BS_DEFPUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_TABSTOP , 55, 12, 31, 14,"Printer")
aDlg := AppendDialog(aDlg,"can",DLG_BUTTON,BS_PUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_TABSTOP , 93, 12, 31, 14,"Cancel" )
nSel := ModalDialog(aDlg,_GetInstance(),hOldWnd)
IF nSel == 0 .OR. nSel == 3
RETURN(NIL)
ENDIF
IF nSel == 1
lPreview := .T.
ENDIF
ENDIF
hClientWnd := _LasthWnd()
hServerWnd := DDEStart(hClientWnd,"CARETRUN","SYSTEM")
IF hServerWnd == NIL
StartCaret(hClientWnd)
hServerWnd := DDEStart(hClientWnd,"CARETRUN","System")
ENDIF
DDEAdvise(hServerWnd,hClientWnd,CF_TEXT,"CARETEVENTS")
DDEExecute(hServerWnd,hClientWnd,'Set.Title(CARES Report Engine)',.F.)
DDEExecute(hServerWnd,hClientWnd,"App.Maximize",.F.)
IF VALTYPE(cReport) != 'A'
DDEExecute(hServerWnd,hClientWnd,'File.Open('+cReport+')',.T.,"Report.Opened")
IF !lPreview
DDEExecute(hServerWnd,hClientWnd,"File.Print(0,0)",.T.,"Report.Complete")
DDEExecute(hServerWnd,hClientWnd,"File.Exit",.T.,"CARET.Close")
ELSE
DDEExecute(hWnd,hClientWnd,"File.Preview",.T.,"CARET.Close")
ENDIF
ELSE
FOR nCtr := 1 TO LEN(cReport)
DDEEXecute(hServerWnd,hClientWnd,"File.Open("+cReport[nCtr]+')',.T.,'Report.Opened')
DDEEXecute(hServerWnd,hClientWnd,"File.Print(0,0)",.T.,'Report.Complete')
DDEEXecute(hServerWnd,hClientWnd,"File.Close",.T.,'View.Close')
NEXT
DDEExecute(hServerWnd,hClientWnd,"File.Exit",.T.,"CARET.Close")
ENDIF
DDEStop(hServerWnd,hClientWnd)
FreeGlobals()
SelectWindow(hClientWnd)
SetFocus(hClientWnd)
RETURN(NIL)
// This function does all the grunt work. It issues the DDE
// EXECUTE commands and if a reply is required waits for the reply.
// Please note that you also need to modify the DDEGetData()
// function found in the DDE.PRG distributed with Clip4Win.
// DDEGetData() has been modified to accept two params, one
// the handle of the DDE server and the second the handle of
// the client window.
// Calling conventions:
//
// hServerWnd - handle/channel of DDE server. Obtained
// from DDEStart() command.
// hClientWnd - handle of client window.
// cItem - Execute command item.
// lData - .T. if a reply is required, .F. if not
// cMsg - Required response from DDL server
//
// The CARET.Close response from CA-RET is NOT documented by them,
// had to find out by watching the traffic back and forth. It is
// issued when the user selects Exit from the File menu or closes
// the window.
// For a true "generic" DDEExecute() you would NOT do any message
// handling, just send the command and handle what happens elsewhere
// Everything between the PostMessage() call and return would
// be deleted. You need to keep in mind that YOU MUST free the
// global memory allocated by the GlobalAlloc() call! If you
// go this route then you can modify RETURN(NIL) to RETURN(hExecute)
// and free it after you have processed the results of the command.
// HandleEvent() is a modified version of the one contained in
// the sample code distributed with Clip4Win. You MUST have
// Clip4Win to use this code. I have NOT included it since I
// do not want to accidently distribute anything that the author/
// distributor does not want out there. You can leave it out
// and restrict the user to not being able to do anything funny
// while the command is being processed by the DDE server.
// GlobalAlloc(), GlobalData(), and GlobalFree() are UNDOCUMENTED
// functions at this point. The author has confirmed that they
// work as used and is considering including them in the documentation
// of the next release of Clip4Win. Please note that the EXECUTE
// command strings MUST be NUL terminated! This gave me a lot
// of grief until John Skelton (the author) was kind enough to
// take a look at the code and pointed this out!
FUNCTION DDEExecute(hServerWnd, hClientWnd, cItem, lData, cMsg)
LOCAL hExecute := GlobalAlloc(2+GMEM_DDESHARE,LEN(cItem)+1,)
LOCAL nMsg, nEvent, cData
GlobalData(hExecute,cItem+CHR(0))
PostMessage(hServerWnd,;
WM_DDE_EXECUTE,;
hClientWnd,;
MAKELPARAM(0, hExecute))
IF lData
DO WHILE .T.
DO WHILE (nEvent := ChkEvent()) != EVENT_OTHER
HandleEvent(nEvent)
ENDDO
nMsg := _LastMsg()
IF nMsg = WM_DDE_DATA
cData := DDEGetData(hServerWnd,hClientWnd)
IF UPPER(cData) = UPPER(cMsg)
EXIT
ENDIF
ENDIF
IF nMsg = WM_DDE_TERMINATE .OR. cData == "CARET.Close"
DDEStop(hServerWnd,hClientWnd)
EXIT
ENDIF
ENDDO
ENDIF
AADD(GLOBALS,hExecute)
RETURN(NIL)
// Free up the global memory used by DDE execute commands
// Crude, but it appears to work ok!
FUNCTION FreeGlobals
LOCAL nCtr
FOR nCtr := 1 TO LEN(GLOBALS)
GlobalFree(GLOBALS[nCtr])
NEXT
GLOBALS := {}
RETURN(NIL)
// Since in my application all this code is in one module along
// with my other shared stuff, I use these two functions to
// save and restore the current message displayed at the bottom
// of a window. These are crude at this point. At some point
// I intend to expand them so that I can keep track of all the
// messages in all my open windows.
FUNCTION SaveMsg
RETURN(LASTMSG)
FUNCTION RestMsg(cMsg)
LASTMSG := cMsg
RETURN(NIL)
// This is my generic function to display error messages, warnings
// and prompts to my users. 'E' type messages only allow the user
// to select Ok. 'W' type messages allows the user to contine or
// cancel. Any OTHER cType param will result in the user getting
// a prompt to do something Please!
FUNCTION ErrorMsg(cMarr,cType)
LOCAL nResponse
DO CASE
CASE cType = 'W'
Ebeep()
nResponse := MessageBox(GetFocus(),cMarr,"Caution!",;
MB_OKCANCEL+MB_ICONEXCLAMATION)
CASE cType = 'E'
MessageBeep(MB_ICONHAND)
nResponse := MessageBox(GetFocus(),cMarr,"Problem!",;
MB_OK+MB_ICONHAND)
OTHERWISE
MessageBeep(MB_OK)
nResponse := MessageBox(GetFocus(),cMarr,"Please!",;
MB_OKCANCEL+MB_ICONASTERISK)
ENDCASE
RETURN(nResponse)
// Make error messages have a distict sound to the user
STATIC FUNCTION EBeep
TONE(880,1)
TONE(440,1)
TONE(220,1)
TONE(110,1)
RETURN(NIL)
// Message() and MsgBar() - Used to display a sunken message/status
// bar at the bottom of a window. Message() calls MsgBar(). You
// can easily modify this so that you can call them individually
// if you like.
FUNCTION Message(hWnd,cText)
LOCAL nLeft, nTop, nRight, nBottom, aCRect, hDC
LOCAL nOldBkClor
aCRect := GetClientRect(hWnd)
nLeft := 0
nTop := aCRect[4]-26
nRight := aCRect[3]
nBottom := nTop+28
hDC := GetDC(hWnd)
nOldBkClor := SetBkColor(hDC,RGB(192,192,192))
MsgBar(hWnd)
DrawText(hDC,cText,;
{nLeft+10,nTop+5,nRight-11,nBottom-5},DT_CENTER)
SetBkColor(hDC,nOldBkClor)
ReleaseDC(hWnd,hDC)
LASTMSG := cText
RETURN(NIL)
FUNCTION MsgBar(hWnd)
LOCAL nLeft, nTop, nRight, nBottom, aCRect
LOCAL hDC, hColor, hBlackPen, hGreyPen, hWhitePen
hDc := GetDC(hWnd)
aCRect := GetClientRect(hWnd)
nLeft := 0
nTop := aCRect[4]-26
nRight := aCRect[3]
nBottom := nTop+26
hBlackPen := CreatePen(PS_SOLID,1,RGB(0,0,0))
hGreyPen := CreatePen(PS_SOLID,1,RGB(128,128,128))
hWhitePen := CreatePen(PS_SOLID,1,RGB(255,255,255))
SelectObject(hDC,hBlackPen)
Rectangle(hDC,nLeft,nTop,nRight,nBottom)
hColor := CreateSolidBrush(RGB(192,192,192))
FillRect(hDC,nLeft,nTop+1,nRight,nBottom,hColor)
SelectObject(hDC,hGreyPen)
MoveTo(hDC,nLeft+10,nBottom-4)
LineTo(hDC,nLeft+10,nTop+4)
LineTo(hDC,nRight-10,nTop+4)
SelectObject(hDC,hWhitePen)
LineTo(hDC,nRight-10,nBottom-4)
LineTo(hDC,nLeft+10,nBottom-4)
ReleaseDC(hWnd,hDC)
DeleteObject(hColor)
DeleteObject(hBlackPen)
DeleteObject(hGreyPen)
DeleteObject(hWhitePen)
RETURN(NIL)