home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
database
/
apd40ulb.zip
/
APD40ULB.SC
< prev
next >
Wrap
Text File
|
1993-06-17
|
111KB
|
3,640 lines
;****************************************************
;
; A PARADOX 4.O UTILITY LIBRARY (APD40ULB.SC)
;
; THIS FREEWARE HAS BEEN PREPARED BY:
;
; MICHAEL MAKLER
; 10221 SLATER AVE
; #103-315
; FOUNTAIN VALLEY, CA 92708
; (714) 571-8510
;
; IF YOU FIND IT USEFUL A DONATION OF $29.95 WOULD BE
; APPRECIATED.
;
; FEEL FREE TO USE AND DISTRIBUTE THIS CODE OR ANY PORTIONS OF IT
; WITH YOUR APPLICATION. IF YOU USE IT PLEASE RETAIN MY COPYRIGHT
; IF YOU PLACE IT ON BBS OR DISTRIBUTE IT PLEASE DELIVER
; THE FULL PACKAGE.
;
; EVERY EFFORT HAS BEEN MADE TO TEST AND VALIDATE THIS SYSTEM
; HOWEVER NO GUARANTEES OR WARRANTIES FOR FITNESS OF USE ARE
; EXPRESSED OR IMPLIED.
;
; IF YOU FIND ANY BUGS OR ADD FEATURES PLEASE LET ME KNOW.
; IF YOU HAVE ANY SUGGESTIONS OR CRITICISMS PLEASE LET ME KNOW.
;
; THANK YOU,
; MIKE MAKLER
;
; FILES.DOC CONTAINS A LISTING OF ALL FILES REQUIRED
; IF ANY ARE MISSING PLEASE CONTACT ME AT PHONE OR
; ADDRESS ABOVE.
;
; COPYRIGHT (C) 1993 MICHAEL MAKLER
;
;****************************************************
;********************************************************************
; FILE: APD40ULB.SC
;
; NOTES: THESE ARE THE PROCEDURE FILES FOR THE
; PARADOX 4.0 UTILITY LIBRARY
;
;*******************************************************************
;****************************************************************
; Name: DEMO.A
; Notes: DEMONSTRATE THE PARDOX 4.0 UTILITY LIBRARY
; THIS DEMO RUNS MY PRINTER UTILITIES WHICH IT TURNS OUT
; USES A LARGE MAJORITY OF THE UTILITY LIBRARY
;
; Copyright (c) 1993 Mike MAKLER
;
;****************************************************************
PROC DEMO.A ()
CLEAR
InitGlobalVar.v () ; INITIALIZE LOCAL VARIABLES
; THESE MAY NEED TO CHANGE OR BE ADDED TO
; FOR YOUR SPECIFIC APPLICATION
REPORT_GL = "PRINTER DEFINITION REPORT" ;NAME OF ACTIVE REPORT
Printit_UT(PRINTTAB_GL, 1) ;CALL THE PRINT ROUTINE MAIN MENU
;FOR THE PRINTER TABLE REPORT SCRIPT
ENDPROC ;**** DEMO ***
WriteLib Libname.a DEMO.A
Release Procs DEMO.A
;****************************************************************
; Name: BeepIt_UT
; Notes: Beeps alot
;
; Inputs:
; Seconds - is Number of seconds in Milliseconds to pause
; between beeps
; Count - Is number of times to beep;
;
; Outputs: N/A
;
; Local Variables: I loop index
;
; Global Variables: N/A
;
; Routines Called : N/A
;
; Code Segment: Beepit (2000,5) ; This will beep 5 times with a 2 second
; ;Pause between beeps
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike MAKLER
;
;*****************************************************************************
Proc BeepIt_UT (Seconds, Count)
;*************************
;* locals
;**************************
Private I ;Loop index
; seconds is number of miliseconds
; count is number of times to beep
For I From 1 To Count Step 1
Beep
Sleep Seconds
EndFor
EndProc ;**** BeepIt_UT ****
WriteLib Libname.a BeepIt_UT
Release Procs BeepIt_UT
;****************************************************************
; Name: Check_Drive_Ready_UT
;
; Notes: This module merely gives the user an oppurtunity
; To Insert a disk. The Calling Module should
; Check the Drive status before and after calling
; This module. The calling module should also call
; Loc_err to put up an apprioate message before calling
; This Module.
;
;
; Inputs: DriveName - Name of Disk Drive to Check
;
; Outputs: N/A
;
; Local Variables: Count ; number of times to loop currently 5
;
; Global Variables: N/A
;
; Routines Called : N/A
;
; Code Segment:
; IF Not DriveStatus (DriveName)
; Then Loc_err ("Drive Is Not Ready",
; "Called By Format")
; Check_Drive_Ready_UT (DriveName)
; ;give user chance
; ;to insert Disk
; Endif
;
; If Not DriveStatus (DriveName)
; ; Has user Inserted Disk
; ; Note that if Drive is
; ; ready then an
; ; extra call to DriveStatus
; ; is made <No Big Deal>
; then Loc_err ("Drive not Ready",
; "Opertion Aboterted" )
; Else Drivespace (DriveName)
; Endif
;
; Error Conditions : N/A
;
; Other : Algorithm
; Start Check_Drive_Ready_UT ()
; Count = 0
; While Count is less then 5 and Drive not ready
; If Drive ready
; Then Quitloop
; Else PlaceMsg ("Printer Not Ready")
; Endif
; Increment Count
; Pause 1.5 seconds
; Loop
; EndWhile
; End Check_Drive_Ready_UT ***
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc Check_Drive_Ready_UT (DriveName.S)
;*********************************
; Locals
;*********************************
Private ButtonValue.S
Showdialog "Disk Drive " + DriveName.S + " Not Ready"
@8, 5
height 13
width 70
@2,8 ?? "Disk Drive " + DriveName.S + " Not Ready"
Pushbutton @8,9 width 10
"~O~K"
OK
Default
value "Yes"
Tag "YES"
To ButtonValue.s
EndDialog
Return
EndProc ;*** Check_Drive_Ready_UT ***
WriteLib Libname.a Check_Drive_Ready_UT
Release Procs Check_Drive_Ready_UT
;****************************************************************
; Name: Check_Print_ready_UT
;
; Notes: This module merely gives the user an oppurtunity
; To Turn On The Printer. The Calling Module should
; Check the Printer status before and after calling
; This module. The calling module should also call
; Loc_err to put up an apprioate message before calling
; This Module.
;
;
; Inputs: N/A
;
; Outputs: N/A
;
; Local Variables: Count ; number of times to loop currently 5
;
; Global Variables: N/A
;
; Routines Called : N/A
;
; Code Segment:
; IF Not PrinterStatus ()
; Then Loc_err ("Printer Is Not Ready",
; "Called By Print Report")
; Check_Print_Ready_UT () ;give user chance
; ;to turn on printer
; Endif
;
; If Not PrinterStatus () ; Has user turned on printer
; ; Note that if printer is
; ; already online then an
; ; extra call to print status
; ; is made <No Big Deal>
; then Loc_err ("Printer was not Ready",
; "Report Can't Be Printed" )
; Else Print_The_Report ()
; Endif
;
; Error Conditions : N/A
;
; Other : Algorithm
; Start Check_Print_ready_UT ()
; Count = 0
; While Count is less then 5 and printer not ready
; If Printer ready
; Then Quitloop
; Else PlaceMsg ("Printer Not Ready")
; Endif
; Increment Count
; Pause 1.5 seconds
; Loop
; EndWhile
; End Check_Print_ready_UT ***
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc Check_Print_Ready_UT ()
;*********************************
; Locals
;*********************************
;Private Count
Showdialog "Printer Not Ready"
@8, 5
height 13
width 70
@2,8 ?? "Printer is Not Ready"
Pushbutton @8,9 width 10
"~O~K"
OK
Default
value "Yes"
Tag "YES"
To ButtonValue.s
EndDialog
Return
EndProc ;*** Check_Print_Ready_UT ***
WriteLib Libname.a Check_print_Ready_UT
Release Procs Check_print_Ready_UT
;****************************************************************
; Name: clearwindow.v
;
; Notes: This Routine WILL clear a window from the screen
;
; Outputs: N/A
;
; Copyright (c) 1993 Mike Makler
;****************************************************************************
PROC clearwindow.v (WinHand.H)
Private isvalue.l
isvalue.l = Isassigned (WinHand.H)
if Isvalue.l
then if Iswindow (winhand.h)
then window select winhand.h
window move winhand.h to -200,-200
endif
endif
echo off
ENDPROC ;**** clearwindow.v ****
WRITELIB LibName.a clearwindow.v
RELEASE PROCS clearwindow.v
PROC CLOSEWINDOW.N (WIN.H)
IF ISASSIGNED (WIN.H)
THEN IF ISWINDOW (WIN.H)
THEN WINDOW SELECT WIN.H
WINDOW CLOSE
ENDIF
ENDIF
RETURN
ENDPROC ;**** clOSEwindow.N ****
WRITELIB LibName.a clOSEwindow.N
RELEASE PROCS clOSEwindow.N
;****************************************************************
; Name: EditRec_UT
; Notes: allows user to edit a record (table_in) using
; form (formNum)
;
; Input: Table_in - Name of table to edit
; FORMNUM - form to use for editing
;
; Outputs: Retval (Paradox Global Variable)
;
; Local Variables:
; L - CancelEdit Yes/No Prompt Variable
; Msg1 - User Message
; Msg2 - User Message
;
; Global Variables: RetVal - Paradox WaitKey Variable
;
; Routines Called : NotCode_UT
; YesNo_Ut
;
; Code Segment: View Table_In
; Moveto Field Xfield
; Locate Xstring
; If Retval
; Then EditTable_UT (Table_in,formNum)
; ;Depending on Aplication you may want to test
; ; Retval after returning from EditTable_UT
; Else ; error Logic
; Endif
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitatiions : This routine will not allow Dos, Dosbig, Zoom or ZoomNext
; Keys to be Entered.
; You Must Supply your own Help_Me (PRocName) Routine.
; If you want Help. I have Supplied one that does nothing.
; You Can use EditTableNoHelp_Ut if help is not Needed.
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc EditRec_UT (Table_in.s, FormNum.s,Field.s,Value.a)
;*************************
;* locals
;**************************
Private L,
Msg1,
Msg2,
Formv.l,
Empty.L,
TABVIEW.H,
FORMVIEW.H
Msg1 = "Editing Record --- Enter [F2] - Save, [Esc] - Cancel, [F1] - Help"
View Table_in.s
TABVIEW.H = GETWINDOW()
Moveto Field field.s
Locate Value.a
if retval
then EditKey
CURSOR NORMAL
Formv.l = IsFormView ()
Empty.L = IsEmpty (Table_IN.s)
If Not Formv.l and Not Empty.l
Then PickForm FormNum.s
FORMVIEW.H = GETWINDOW()
EndIf
While True
Wait Record
Prompt Msg1
Message "Begin Editing Record."
Until "F1","F2", "Esc","DOS","DOSBIG","ZOOM","ZOOMNEXT","F7"
Switch
Case RetVal = "F1":
;help_me("EditTable_UT")
If helpmode() = "LookupHelp"
then Keypress "F1"
else Message "LookUp Help Not Available for This Field"
Endif
Loop
Case RetVal = "F2":
Do_it!
QuitLoop
Case Retval = "F7" : Formv.l = IsFormView ()
Empty.L = IsEmpty (Table_IN.s)
If Not Formv.l
Then If Not Empty.L
then PickForm FormNum.S
endif
Else KeyPress "F7"
Endif
Case RetVal = "DOS" or RetVal = "DOSBIG" : Beep
Loop
Case RetVal ="ZOOM" or Retval = "ZOOMNEXT" : Beep
Loop
Case RetVal = "Esc":
L=YesNo_UT("YES Leave The Edit Session ALL CHANGES WILL BE LOST",
"No Return to THE EDIT SESSION To Save Changes","no")
If Upper(L) = Upper("Yes")
Then CancelEdit
RetVal = "Esc"
QuitLoop
Else
Loop
EndIf
OtherWise: NotCode_UT ()
Loop
EndSwitch
EndWhile
else ;record not found error
M1.s = "Record not found for table : " + Table_in.s
m2.s = "Field : " + field.s
m3.s = "Value : " + strval (Value.a)
Loc_err_Pause_UT (M1.s, M2.s, M3.s)
endif
CLOSEWINDOW.N (TABVIEW.H)
CLOSEWINDOW.N (FORMVIEW.H)
;CURSOR OFF
EndProc ;*** Editrec_UT ***
WriteLib Libname.a Editrec_UT
Release Procs Editrec_UT
;****************************************************************
; Name: EditTable_UT
; Notes: allows user to edit a table (table_in) using
; form (formNum)
;
; Input: Table_in - Name of table to edit
; FORMNUM - form to use for editing
;
; Outputs: Retval (Paradox Global Variable)
;
; Local Variables:
; L - CancelEdit Yes/No Prompt Variable
; Msg1 - User Message
; Msg2 - User Message
;
; Global Variables: RetVal - Paradox WaitKey Variable
;
; Routines Called : NotCode_UT
; YesNo_Ut
;
; Code Segment: View Table_In
; Moveto Field Xfield
; Locate Xstring
; If Retval
; Then EditTable_UT (Table_in,formNum)
; ;Depending on Aplication you may want to test
; ; Retval after returning from EditTable_UT
; Else ; error Logic
; Endif
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitatiions : This routine will not allow Dos, Dosbig, Zoom or ZoomNext
; Keys to be Entered.
; You Must Supply your own Help_Me (PRocName) Routine.
; If you want Help. I have Supplied one that does nothing.
; You Can use EditTableNoHelp_Ut if help is not Needed.
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc EditTable_UT (Table_in, FormNum)
;*************************
;* locals
;**************************
Private L,
Msg1,
Msg2,
Formv.l,
Empty.L
Msg1 = "Editing TABLE --- Enter [F2] - Save, [Esc] - Cancel, [F1] - Help"
View Table_in
TABVIEW.H = GETWINDOW()
EditKey
CURSOR NORMAL
Formv.l = IsFormView ()
Empty.L = IsEmpty (Table_IN)
If Not Formv.l and Not Empty.l
Then PickForm FormNum
FORMVIEW.H = GETWINDOW()
EndIf
While True
Wait Table
Prompt Msg1
Message "Begin Editing TABLE."
Until "F1","F2", "Esc","DOS","DOSBIG","ZOOM","ZOOMNEXT","F7"
Switch
Case RetVal = "F1":
;help_me("EditTable_UT")
If helpmode() = "LookupHelp"
then Keypress "F1"
else Message "LookUp Help Not Available for This Field"
Endif
Loop
Case RetVal = "F2":
Do_it!
QuitLoop
Case Retval = "F7" : Formv.l = IsFormView ()
Empty.L = IsEmpty (Table_IN)
If Not Formv.l
Then If Not Empty.L
then PickForm FormNum
endif
Else KeyPress "F7"
Endif
Case RetVal = "DOS" or RetVal = "DOSBIG" : Beep
Loop
Case RetVal ="ZOOM" or Retval = "ZOOMNEXT" : Beep
Loop
Case RetVal = "Esc":
L=YesNo_UT("YES Leave The Edit Session ALL CHANGES WILL BE LOST",
"No Return to THE EDIT SESSION To Save Changes","no")
If Upper(L) = Upper("Yes")
Then CancelEdit
RetVal = "Esc"
QuitLoop
Else
Loop
EndIf
OtherWise: NotCode_UT ()
Loop
EndSwitch
EndWhile
CLOSEWINDOW.N (TABVIEW.H)
CLOSEWINDOW.N (FORMVIEW.H)
EndProc ;*** EditTable_UT ***
WriteLib Libname.a EditTable_UT
Release Procs EditTable_UT
;****************************************************************
; Name: GetDate_PromptString_UT
;
; Notes: Prompt User To enter Date.
;
; Inputs: Date.d - Default Value Of Date
; StartLine.s - Line to prompt From
; ClearFlag.l - If True Then Clear Screen Before Prompting
; PromptString.s - String To show User (Ie "Please Enter Submission Date - ")
;
; OutPuts:VarOut.d - User Entered Data
;
; Code Segment: Date = GetDate_promptString_UT (D1,10,true,"Please enter Date: ")
;
;
; Local Variables: MonitorType - Monitor Type (COLOR, B&W, MONO)
; VarOut - User Selected Date
;
; Global Variables: N/A
;
; Routines Called : GetMonitorType_UT
;
; Code Segment: Date = GetDate_promptString_UT (D1,10,true,
; "Please enter Date: ")
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;
;*****************************************************************************
Proc GetDate_PromptString_UT (date.d,StartLine.s,ClearFlag.l,PromptString.s)
;*************************
;* locals
;**************************
Private MonitorType.s,
Varout.d,
len.n,
Entry.n,
ButtonValue.s
MonitorType.s = GetMonitorType_UT ()
len.n = len (promptstring.s)
entry.n = len.n + 2 + 2
Varout.d = date.d
ButtonValue.S = "NO"
Showdialog "DATE SELECTION"
@Startline.s, 5
height 10
width 60
@2,2 ?? Promptstring.s
Accept @2, entry.n
width 10 "D"
tag "date"
to varout.d
Pushbutton @5,9 width 10
"~O~K"
OK
Default
value "Yes"
Tag "YES"
To ButtonValue.s
Pushbutton @5,29 width 10
"~C~ancel"
CANCEL
value "No"
Tag "No"
To ButtonValue.s
EndDialog
If ButtonValue.S = "NO"
Then Varout.d = Date.d
RETVAL = FALSE
ELSE RETVAL = TRUE
Endif
Return Varout.d
EndProc ;*** GetDate_PromptString_UT ***
WriteLib LIBNAME.A GetDate_PromptString_UT
Release Procs GetDate_PromptString_UT
;****************************************************************
; Name: GetDirName_Ut
;
; Notes: This routine will Prompt the user to enter a Path Name
;
;
; Inputs:
; N1 - Default Directory Name
; StartLine - Line to start User Prompt On
; ClearFlag - If True then Clear screen before displaying user Prompt
; Msg - Message to display to user
; Pic - Paradox Variable Type
; Edtfield - Paradox input Format
;
;
; Outputs: DirName - Directory Name
;
; Local Variables:
; Arg1 - Directory Name input to accept1arg_ut
; c - Value Returned From accept1arg_ut
; DirFlag - True if Directory Exists
; Message1 - User Message Text
; Message2 - User Message Text
; Prompt1 - Prompt value input to accept1arg_ut
; SaveDir - Save Value of current Directory
; Title - title for accept1arg_ut Prompt Screen
;
; Global Variables: N/A
;
; Routines Called : Accept1Arg_UT
; GetStringEdtField_UT
; Loc_Err_UT
;
; Code Segment:
; NewDir = GetDirName_Ut
; ("C:\\INV\\DB\\",12, True,
; "Enter Name of New Directory - ",
; "A45","!*!")
; If NewDir = "NONE"
; Then ;Invalid Directory Name Eror Logic
; Endif
;
; Error Conditions : Directory Does Not Exist
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;
;*****************************************************************************
Proc GetDirName_Ut(N1,StartLine, ClearFlag, Msg,Pic,Edtfield)
;*************************
;* locals
;**************************
Private Arg1,
C,
DirFlag,
DirName,
Message1,
Message2,
Prompt1,
SaveDir,
Title
SaveDir = Directory ()
If N1 = ""
Then
N1 = SaveDir
Endif
While True
DirName = GetStringEDTField_ut (n1,StartLine,ClearFlag,msg,pic,EDTFIELD)
N1 = DirName
Arg1 = DirName
Prompt1 = "Directory Name"
Title = "Data Dictionary Directory Name Acceptance Menu"
C = Accept1arg_ut (arg1,Prompt1,title)
C = Upper(C)
If C = "YES"
Then DirFlag = DirExists(DirName)
If Dirflag = 1
then QuitLoop
Else Message1 = "No Dir Found"
Message2 = "Better Luck Next Time"
Loc_err_UT (Message1, Message2)
DirName = "NONE"
Quitloop ; *** Not DirFlag ***
Endif ;**** DirFlag *****
else loop ; *** C <> Yes ***
EndIf ; *** C = Yes ***
EndWhile
Return DirName
EndProc ;**** GetDirName_Ut ****
WriteLib LIBNAME.A GetDirName_Ut
Release Procs GetDirName_Ut
;****************************************************************
; Name: GetMask_UT
;
; Notes: This routine will get a Dos Style File Mask
; (I.E. *.*, C:\Lib\????.Lib ....)
;
; Inputs: DefMak - Default Mask types
;
; Outputs: Varout - Output Mask Type
;
; Local Variables: Msg - user Prompt String
;
; Global Variables: N/A
;
; Routines Called : GetStringzedtField_UT
;
; Code Segment: FileListMask = GetMask_UT ("*.*")
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;
;*****************************************************************************
Proc GetMask_UT(DefMask)
;*************************
;* locals
;**************************
Private Msg,
Varout
MSG = "Enter a File Mask (i.e. C:\*.Lib) - "
Varout = GetStringEDTField_UT(DefMask,12,True,msg,"A30","!*!")
Return Varout
EndProc ;*** GetMask_UT
WriteLib LIBNAME.A GetMask_UT
Release Procs GetMask_UT
;****************************************************************
; Name: GetMonitorType_UT
;
; Notes: This Will return the Monitor Type as an Upper Case String
;
; Inputs: N/A
;
; Outputs: MonitorType - Contains Monitor Type String
; ("MONO", "B&W", "COLOR")
;
; Local Variables: N/A
;
; Global Variables: N/A
;
; Routines Called : N/A
;
; Code Segment: MonitorType = GetMonitorType_UT ()
;
; Error Conditions :
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;
;*****************************************************************************
Proc GetMonitorType_UT ()
MonitorType = Monitor() ; Monitor Type for screen displays
Monitortype = Upper (Monitortype)
Return MonitorType
EndProc ;**** GetMonitorType_UT ****
WriteLib Libname.a GetMonitorType_UT
Release Procs GetMonitorType_UT
Proc Getpromptyesno_UT (m1.s, m2.s,m3.s)
ButtonValue.s=""
MonitorType.s = GetMonitorType_UT ()
Showdialog "Go To Dos Prompt"
@8, 5
height 14
width 60
@2,8 ?? m1.s
@3,8 ?? m2.s
@4,8 ?? m3.s
Pushbutton @8,9 width 10
"~O~K"
OK
Default
value "Yes"
Tag "YES"
To ButtonValue.s
Pushbutton @8,29 width 10
"~C~ancel"
CANCEL
value "No"
Tag "No"
To ButtonValue.s
EndDialog
If ButtonValue.s = "Yes"
Then buttonvalue.s = "YES"
else buttonvalue.s = "NO"
EndIf
Return buttonvalue.s
EndProc ;**** Getpromptyesno_UT ***
WriteLib LIBNAME.A Getpromptyesno_UT
Release Procs Getpromptyesno_UT
;****************************************************************
; Name: GetStringEDTField_UT
;
; Note: Prompt User To input a string
;
; Inputs: N1 - Default Value
; StartLine - Line to prompt From
; ClearFlag - If True Then Clear Screen Before Prompting
; Msg - String To show User (Ie "Please Enter Value For Process Yields - ")
; Pic - Format data is sored in (I.E. "A6", "D")
; EdtField - Format Of User Input ("###.#[#]")
;
; OutPuts:VarOut - User Entered Data
;
; Local Variables: MonitorType - Contains Monitor Type String
; ("MONO", "B&W", "COLOR")
;
; Global Variables: Retval - Paradox defined Global Variable
;
; Routines Called : GetMonitorType_UT
;
; Code Segment: Inv_Tab = GetStringEDTField_UT(InvDefTab,12,True,
; "Please Enter Inventory Table Name - ",
; "A53","!*!")
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;
;*****************************************************************************
Proc GetStringEDTField_UT(n1.v,StartLine.n,ClearFlag.l,msg.s,pic.s,EDTFIELD.s)
;*************************
;* locals
;**************************
Private Monitortype.s,
Varout.v
MonitorType.s = GetMonitorType_UT ()
If startline.n >9
then startline.n = 9
Endif
Varout.v = n1.v
ButtonValue.s ="No"
Showdialog "USER SELECTION BOX"
@Startline.n, 5
height 12
width 60
@2,2 ?? Msg.s
Accept @3, 2
width 70 pic.s
Picture EDTFIELD.s
;Required
tag "Typein"
to varout.V
Pushbutton @7,9 width 10
"~O~K"
OK
Default
value "Yes"
Tag "YES"
To ButtonValue.s
Pushbutton @7,29 width 10
"~C~ancel"
CANCEL
value "No"
Tag "No"
To ButtonValue.s
EndDialog
If ButtonValue.s = "No"
Then Varout.v = n1.v
RETVAL = FALSE
ELSE RETVAL = TRUE
EndIf
Return Varout.v
EndProc ;*** GetStringEDTField_UT ***
WriteLib LIBNAME.A GetStringEDTField_UT
Release Procs GetStringEDTField_UT
;****************************************************************
; Name: GetStringHideField_UT
;
; Note: Prompt User To input a string
;
; Inputs: N1 - Default Value
; StartLine - Line to prompt From
; ClearFlag - If True Then Clear Screen Before Prompting
; Msg - String To show User (Ie "Please Enter Value For Process Yields - ")
; Pic - Format data is sored in (I.E. "A6", "D")
; EdtField - Format Of User Input ("###.#[#]")
;
; OutPuts:VarOut - User Entered Data
;
; Local Variables: MonitorType - Contains Monitor Type String
; ("MONO", "B&W", "COLOR")
;
; Global Variables: Retval - Paradox defined Global Variable
;
; Routines Called : GetMonitorType_UT
;
; Code Segment: Inv_Tab = GetStringEDTField_UT(InvDefTab,12,True,
; "Please Enter Inventory Table Name - ",
; "A53","!*!")
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;
;*****************************************************************************
Proc GetStringHideField_UT(n1.v,StartLine.n,ClearFlag.l,msg.s,pic.s,EDTFIELD.s)
;*************************
;* locals
;**************************
Private Monitortype.s,
Varout.v,
ButtonValue.s
MonitorType.s = GetMonitorType_UT ()
If Startline.n > 9
Then Startline.N = 9
Endif
Varout.v = n1.v
ButtonValue.s = "No"
Showdialog "USER SELECTION BOX"
@Startline.n, 5
height 12
width 60
@2,2 ?? msg.s
Accept @3, 2
width 20 pic.s
Picture EDTFIELD.s
;Required
Hidden
tag "Typein"
to varout.V
Pushbutton @7,9 width 10
"~O~K"
OK
Default
value "Yes"
Tag "YES"
To ButtonValue.s
Pushbutton @7,29 width 10
"~C~ancel"
CANCEL
value "No"
Tag "No"
To ButtonValue.s
EndDialog
If ButtonValue.s = "No"
Then Varout.v = n1.v
RETVAL = FALSE
ELSE RETVAL = TRUE
EndIf
Return Varout.v
EndProc ;*** GetStringHideField_UT ***
WriteLib LIBNAME.A GetStringHideField_UT
Release Procs GetStringHideField_UT
;****************************************************************
; Name: Getusername_UT
;
; Note: Prompt User To enter a user name
;
; Inputs: N1.v - Default Value
; Line.n - Line to prompt From
; Clear.l - If True Then Clear Screen Before Prompting
; Pic.s - Format data is sored in (I.E. "A6", "D")
; Edt.s - Format Of User Input ("###.#[#]")
;
; OutPuts:VarOut - User Entered Data
;
; Local Variables: MonitorType - Contains Monitor Type String
; ("MONO", "B&W", "COLOR")
;
; Global Variables: Retval - Paradox defined Global Variable
;
; Routines Called : GetMonitorType_UT
;
; Code Segment: Inv_Tab = Getusername_UT(InvDefTab,12,True,
; "Please Enter Inventory Table Name - ",
; "A53","!*!")
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;
;*****************************************************************************
Proc Getusername_UT(n1.v,Line.n,Clear.l,pic.s,EDT.s)
Private un1.s,
un2.s,
msg.s,
m1.s,
m2.s,
m3.s
PlaceMsg_Bottom_ut (PromptTitle_GL,PTMsg1_GL, PTMsg2_GL, pcolor_gl, 22)
n1.v = ""
msg.s = "Enter User Name : "
UN1.s = GetStringHideField_UT(n1.v,line.n,clear.l,msg.s,pic.s,EDT.s)
if UN1.S = n1.v
Then Un2.s = "ZNUN"
Else msg.s = "Confirm User Name : "
UN2.s = GetStringHideField_UT(n1.v,line.n,clear.l,msg.s,pic.s,EDT.s)
endif
If un1.s = un2.s and un1.s <> ""
then UserName_GL = un2.s
SetUserName UserName_GL
else M1.S = "Confirmation Failed"
M2.S = "USER NAME NOT SET"
M3.s = ""
Loc_err_Pause_UT (M1.s, M2.s, M3.s)
username_gl = "No User"
endif
@19,0
clear EOS
return
EndProc ;*** Getusername_UT ***
WriteLib LIBNAME.A Getusername_UT
Release Procs Getusername_UT
;***************************************************************
; Name: GoToDOS_UT
;
; Notes: This will exit to DOS
;
; Inputs: N/A
;
; Outputs: N/A
;
; Local Variables: M1 - User Prompt String
; M2 - User Prompt String
; M3 - User Prompt String
;
; Global Variables: N/A
;
; Routines Called : PlaceMsgPause_ut
;
; Code Segment: Switch
; :
; :
; Case MenSel = "DOS" : GoToDOS_UT()
; :
; :
; EndSWitch
;
; Error Conditions :
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 MiKE MAKLER
;
;*****************************************************************************
Proc GoToDOS_UT()
;*************************
;* locals
;**************************
Private M1.s,
M2.s,
M3.s,
ButtonValue.s
M1.s = "You Are About To Exit To DOS"
M2.s = "Do Not Load any TSR's and Do Not Modify any Paradox Files"
M3.s = "Type [Exit] to return to Aplication"
ButtonValue.s=""
MonitorType.s = GetMonitorType_UT ()
Showdialog "Go To Dos Prompt"
@8, 5
height 14
width 60
@2,8 ?? m1.s
@3,8 ?? m2.s
@4,8 ?? m3.s
Pushbutton @8,9 width 10
"~O~K"
OK
Default
value "Yes"
Tag "YES"
To ButtonValue.s
Pushbutton @8,29 width 10
"~C~ancel"
CANCEL
value "No"
Tag "No"
To ButtonValue.s
EndDialog
If ButtonValue.s = "Yes"
Then Dos
EndIf
Return
EndProc ;**** GoToDOS_UT ****
WriteLib LIBNAME.A GoToDOS_UT
Release Procs GoToDOS_UT
;****************************************************************
; Name: GoToDOSBig_UT
;
; Notes: This will exit to DOS with Maximum available Memory
; (i.e. It will swap as much of the Paradox stuff to disk as
; Possible)
;
; Inputs: N/A
;
; Outputs: N/A
;
; Local Variables: M1 - User Prompt String
; M2 - User Prompt String
; M3 - User Prompt String
;
; Global Variables: N/A
;
; Routines Called : PlaceMsgPause_ut
;
; Code Segment: Switch
; :
; :
; Case MenSel = "DOS" : GoToDOSBig_UT()
; :
; :
; EndSWitch
;
; Error Conditions :
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc GoToDOSBIG_UT()
;*************************
;* locals
;**************************
Private M1.s,
M2.s,
M3.s,
ButtonValue.s,
Monitortype.s
M1.s = "You Are About To Exit To DOS"
M2.s = "Do Not Load any TSR's and Do Not Modify any Paradox Files"
M3.s = "Type [Exit] to return to Aplication"
ButtonValue.S = "No"
MonitorType.s = GetMonitorType_UT ()
Showdialog "Go To Dos Prompt"
@5, 3
height 14
width 70
@2,2 ?? m1.s
@3,2 ?? m2.s
@4,2 ?? m3.s
Pushbutton @8,9 width 10
"~O~K"
OK
Default
value "Accept"
Tag "YES"
To ButtonValue.s
Pushbutton @8,29 width 10
"~C~ancel"
CANCEL
value "No"
Tag "No"
To ButtonValue.s
EndDialog
If ButtonValue.s = "Accept"
Then DosBIG
EndIf
Return
EndProc ;**** GoToDOSBIG_UT ****
WriteLib LIBNAME.A GoToDOSBIG_UT
Release Procs GoToDOSBIG_UT
;****************************************************************
; Name: InitColors.S
; Notes: Sets up values of global Variables
; (most are really Parameters)
;****************************************************************
Proc InitColors.s ()
; Private None
;*********************************************
; Set Up Default Colors
;*********************************************
Sc_Gl = 112 ; User Messages Color
Linechar_gl = chr (205) ; Line Drawing Characters
LineColor_Gl = 31 ;White on Blue ;
DataEntryColor_GL = 112 ;Black on Grey ;
ErrorColor_Gl = 79 ;White on Red ; User Error Message Color
ReportInfoColor_GL = 112 ;Black On Grey ;
pcolor_gl = 29 ;sYSCOLOR(4)
ENDPROC ;**** InitColors.s ****
WRITELIB LibName.a InitColors.s
RELEASE PROCS InitColors.s
;****************************************************************
; Name: InitGlobalVar.v
; Notes: Sets up values of global Variables
; (most are really Parameters)
;****************************************************************
Proc InitGlobalVar.v ()
PrintMode_GL = "Reset" ; SET THE PRINTER MODE
PrinTTab_GL = "Printset" ; NAME OF PRINTER TABLE
PrintPort_GL = "LPT1" ; NAME OF PRINTER PORT
PortTab_GL = "PortTab" ; NAME OF PRINTER PORT TABLE
PRINTER_GL = "HPLJet" ; NAME OF PRINTER
REPORT_GL = "" ;NAME OF ACTIVE REPORT
PlaceMsg_gl = BLANKNUM() ; WINDOW HANDLE
MenuTree_gl.S = "" ; KEEP TRACK OF MENU SELECTED
Journalflag_GL = TRUE ; IF TRUE WRITE MENU SELECTED TO FILE
JOURNAL_GL = "JOURNAL.SC" ; NAME OF FILE TO TRACK MENU SELECTIONS
InitPromptMsg.S () ; INITIALIZE PROMPT MESSAGES
InitColors.s () ; INITIALIZE COLORS TO USE
EndProc ;*** InitGlobalVar.v ***
Writelib libname.a InitGlobalVar.v
Release Procs InitGlobalVar.v
;****************************************************************
; Name: InitPrinter
;
; Notes: This Routine will Initialze the Printer
;
; Inputs: Mode.s - This is :
; Pica - print 10 cpi
; Elite - Print 12 cpi
; Compressed - Print 17 cpi
; Compoff - Turn off 17 Cpi or 12 cpi revert to 10 cpi
; Reset - Printer power on defaults)
; User - User String - Set In Global UserprintString_Gl
;
;
; Outputs: N/a
;
; Other : These setup strings are for Epson MX/FX/RX and IBM graphics
; printers and other printers that mimic these. If this is not
; the case then change these strings or use the user option and
; set UserprintString_GL to the string you want.
;
; Copyright (c) 1993 Mike Makler
;****************************************************************************
PROC InitPrinter(Mode.S)
PRIVATE MODE.S,
MSG1,
MSG2,
MSG3,
PRINTSET.S,
RESET.S
PrinTTab_GL = "Printset"
PortTab_GL = "PortTab"
View PrintTab_GL
Moveto [PrinterName]
Locate Printer_GL
Reset.S = ""
PrintSet.S = ""
If Retval
then MoveTo Field Mode.S
PrintSet.S = []
Reset.S = [Reset]
If Printer_GL = "*Custom-1" or Printer_GL = "*Custom-2"
then Msg1 = "For Custom Printer Setup"
Msg2 = " Please Call MIKE MAKLER"
Msg3 = "(714) 571-8510"
PlaceMsgPause_UT (Msg1, Msg2, Msg3)
Reset.S = ""
PrintSet.S = ""
Endif
If Printer_GL = "HPQuiet"
then Menu {Report} {SetPrinter} {Override} {Setup} Select "\\027%@"
Endif
Else Msg1 = "No Printer Specified"
Msg3 = "Select Printer and Retry"
Msg2 = ""
PlaceMsgPause_UT (Msg1, Msg2, Msg3)
clearimage
return
Endif
;********* Set Printer to Formfeed **********************
Menu {Report} {SetPrinter} {Override} {EndOfPage} {FormFeed}
;******** Reset Printer Power on Defaults *************
If Reset.s <> ""
THEN Menu {Report} {SetPrinter} {Override} {Setup} Select Reset.S
Endif
;************ Set Print Size **********************************
If PrintSet.S <>""
Then Menu {Report} {SetPrinter} {Override} {Setup} Select PrintSet.S
Endif
clearimage
Return
ENDPROC ;**** InitPrinter ****
WRITELIB LibName.a InitPrinter
RELEASE PROCS InitPrinter
;****************************************************************
; Name: InitPromptMsg.S
;
; Notes: This Routine Is used to Set up Default Prompt Messages
;
; Inputs: N/a
;
; Outputs: N/A
;
;
; Copyright (c) 1993 Mike Makler
;****************************************************************************
Proc InitPromptMsg.S ()
Private FILLT,
LENT
PMenu1_GL = "Use Arrow Keys to Highlight choice and <ENTER> to select."
PMenu2_GL = "<F1>=MenuHelp, <ESC>=Previous Menu, <ENTER>=Perform Action"
PromptTitle_GL = "Data Input Operation"
Lent = Len(PromptTitle_Gl)
Ia.L = Isassigned (LENRS_GL)
If Not Ia.L
Then LENRS_GL = 0
Endif
Fillt = 80 - (Lent+Lenrs_GL)
PromptTitle_GL = PromptTitle_Gl
PTMsg1_GL = "<BKSP> -Delete Character By Character, <CTRL-BKSP> - Clear Current Setting"
PTMsg2_GL = "<ENTER> - To Accept Current Setting, <ESC> - To go Back"
ENDPROC ;**** InitPromptMsg.S ****
WRITELIB LibName.a InitPromptMsg.S
RELEASE PROCS InitPromptMsg.S
;****************************************************************
; Name : Loc_err_UT
;
; Notes : Displays a 2 line error message
;
; Inputs: MSG1 - line 1 of error message
; MSG2 - line 2 of error message
;
; Outputs: N/A
;
; Local Variables: MonitorType - Contains Monitor Type String
; ("MONO", "B&W", "COLOR")
; ScreenBlink - Screen Blink Attribute
; ScreenColor - Screen color attribute
; Secs - Milliseconds Passed to Beepit_ut
; Times - Number of times to loop passed to Beepit_ut
;
; Global Variables: N/A
;
; Routines Called : Beepit_UT
; GetMonitorType_UT
;
; Code Segment: Loc_err_UT ("Error Error Error", "Fix It ")
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc Loc_err_UT (Msg1, Msg2)
;*************************
;* locals
;**************************
Private Monitortype,
ScreenBlink,
ScreenColor,
Secs,
Times
MonitorType = GetMonitorType_UT ()
ScreenColor = ErrorColor_GL
ScreenBlink = ScreenColor + 128
OldCanvas_GL = GetCanvas()
Window Create
Floating
@9,0
Height 7
Width 80
to loc_err_ut.win
Window Echo loc_err_ut.win False
@3,10
?? "Error ....."
@4,10
?? Msg1
@5,10
?? Msg2
Window Echo loc_err_ut.win True
Secs = 1000
Times = 2
Beepit_UT (Secs,Times)
Window close
EndProc ;**** Loc_Err_UT ****
WriteLib LIBNAME.A Loc_err_UT
Release Procs Loc_err_UT
;****************************************************************
; Name : Loc_err_Pause_UT
;
; Notes : Displays a 3 line error message and pauses until user
; enters a Key
;
; Inputs: MSG1 - line 1 of error message
; MSG2 - line 2 of error message
; MSG3 - line 3 of error message
;
; Outputs: N/A
;
; Local Variables: Char1 - User enter Character
; MonitorType - Contains Monitor Type String
; ("MONO", "B&W", "COLOR")
; ScreenBlink - Screen Blink Attribute
; ScreenColor - Screen color attribute
; Secs - Milliseconds Passed to Beepit_ut
; Times - Number of times to loop passed to Beepit_ut
;
; Global Variables: N/A
;
; Routines Called : Beepit_UT
; GetMonitorType_UT
;
; Code Segment: Loc_err_Pause_UT ("Error Error Error", "Fix It Please",
; "Pretty please")
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc Loc_err_Pause_UT (M1.s, M2.s, M3.s)
;*************************
;* locals
;**************************
Private Char1,
Monitortype,
ScreenBlink,
ScreenColor,
Secs,
Times
MonitorType = GetMonitorType_UT ()
ScreenColor = ERRORCOLOR_GL
ScreenBlink = ScreenColor + 128
MonitorType.s = GetMonitorType_UT ()
Showdialog "User Error"
@5, 0
height 10
width 75
@2,8 ?? "Warning ....."
@4,8 ?? m1.s
@5,8 ?? m2.s
@6,8 ?? m3.s
Pushbutton @8,9 width 10
"~O~K"
OK
Default
value "Yes"
Tag "YES"
To ButtonValue.s
EndDialog
Return
EndProc ;**** Loc_Err_Pause_UT ****
WriteLib LIBNAME.A Loc_err_Pause_UT
Release Procs Loc_err_Pause_UT
;****************************************************************
; Name: NotCode_UT
;
; Notes: This Module will Produce a Message -
; "This Option Has Not Been Coded Yet"
;
; Inputs: N/A
;
; Outputs: N/A
;
; Local Variables: N/A
;
; Global Variables: N/A
;
; Routines Called : N/A
;
; Code Segment: N/A
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc NotCode_UT ()
Clear
Beep sleep 100 Beep
Message "This Option Has Not Been Coded Yet"
Sleep 1000
Beep sleep 200 Beep
Sleep 1000
Clear
EndProc ;***** NotCode_UT *****
WriteLib LIBNAME.A NotCode_UT
Release Procs NotCode_UT
;****************************************************************
; Name: PlaceMsg_Bottom_ut
; Notes: Places a user Message on the Screen without clearing screen
; Inputs: MSG1 - line 1 of message
; MSG2 - line 2 of message
; Screencolor - foreground and background color of boxed
; error message
; for a red backround on a white forground pass 89
; 64+15 (64 = red backround, 15 = white forground)
; See appendix A of Paradox User Guide
; for Complete list of colors
; Startline - Line to start message on
;****************************************************************
Proc PlaceMsg_Bottom_ut (Btitle,Message1, Message2, ScreenColor, StartLine)
;*************************
;* locals
;**************************
Private Endline
isval.L = Isassigned (Placeline.Win)
If Isval.L
then iswin.l = IsWindow (placeline.win)
else iswin.l = False
EndIf
if iswin.l
then window select placeline.win
window close
endif
Endline = StartLine + 2
setcanvas default
canvas off
@ STARTLINE,0
Clear Eos
MonitorType = GetMonitorType_UT ()
If Monitortype = "COLOR"
Then PaintCanvas Attribute ScreenColor
StartLine,0 ,EndLine,79
Style Attribute ScreenColor
Else PaintCanvas Border fill chr(254)
Intense
StartLine,0 ,EndLine,79
Style Intense
Endif ;**** Monitortype = "COLOR" ****
LineChar.c = LineChar_gl;
Drawline.s = fill(linechar.c,80)
Style attribute LineColor_gl
@StartLine-1,00
?? DrawLine.s
style attribute screencolor
@Startline,00
?? Btitle
@StartLine+1,00
?? Message1
@Endline, 00
?? Message2
canvas on
EndProc ;*** PlaceMsg_Bottom_ut ***
WriteLib Libname.a PlaceMsg_Bottom_ut
Release Procs PlaceMsg_Bottom_ut
;****************************************************************
; Name: PlaceMsg_UT
;
; Notes: Places a user Message on the Screen
;
; Inputs: Message1 - line 1 of message
; Message2 - line 2 of message
; Screencolor - foreground and background color of boxed
; error message
; for a red backround on a white forground pass 89
; 64+15 (64 = red backround, 15 = white forground)
;
; See appendix A of Paradox User Guide
; for Complete list of colors
;
; Outputs: N/A
;
; Local Variables: MonitorType - Contains Monitor Type String
; ("MONO", "B&W", "COLOR")
;
; Global Variables: N/A
;
; Routines Called : GetMonitorType_UT
;
; Code Segment: PlaceMsg_UT("Loadiding Table", "Please Wait", 48)
;
; Error Conditions :
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc PlaceMsg_UT(Message1.s, Message2.s, ScreenColor.s)
Private Monitortype.s,
placemsg.da,
placemsg.win
dynarray placemsg.da[]
isval.L = Isassigned (placemsg.win)
If Isval.L
then iswin.l = IsWindow (placemsg.win)
else iswin.l = False
EndIf
echo normal
if not iswin.l
then placemsg.da ["CanClose"] = false
placemsg.da ["canmaximize"] = false
placemsg.da ["canmove"] = true
placemsg.da ["canresize"] = false
placemsg.da ["canvas"] = true
placemsg.da ["echo"] = false
placemsg.da ["Floating"] = false
placemsg.da ["hasframe"] = true
placemsg.da ["Maximized"] = False
placemsg.da ["TITLE"] = "User Prompt Message"
placemsg.da ["hasshadow"] = true
placemsg.da ["height"] = 11
placemsg.da ["margin"] = "off"
placemsg.da ["origincol"] = 0
placemsg.da ["originrow"] = 7
placemsg.da ["Width"] = 80
placemsg.da ["style"] = ScreenColor.S
window create
attributes placemsg.da
to placemsg.win
placemsg_gl = placemsg.win
endif
window select placemsg_gl
setcanvas placemsg_gl
window move placemsg_gl to 7,0
MonitorType.s = GetMonitorType_UT ()
If Monitortype.s = "COLOR"
Then Style Attribute ScreenColor.s
Else Style Intense
Endif ;**** Monitortype = "COLOR" ****
Window Echo placemsg_gl false
@3,10
?? Message1.s
@5,10
?? Message2.s
Window Echo placemsg_gl true
echo off
EndProc ;*** PlaceMsg_UT ***
WriteLib Libname.a PlaceMsg_UT
Release Procs PlaceMsg_UT
;****************************************************************
; Name: PlaceMsg_noClear_ut
; Notes: Places a user Message on the Screen without clearing screen
; Inputs: MSG1 - line 1 of message
; MSG2 - line 2 of message
; Screencolor - foreground and background color of boxed
; error message
; for a red backround on a white forground pass 89
; 64+15 (64 = red backround, 15 = white forground)
; See appendix A of Paradox User Guide
; for Complete list of colors
; Startline - Line to start message on
;****************************************************************
Proc PlaceMsg_NoClear_ut (Message1.s, Message2.s, ScreenColor.s, StartLine.n)
;*************************
;* locals
;**************************
Private NextLine.n
setcanvas default
Nextline.n = StartLine.n + 2
canvas off
@ sTARTLINE.n-1,0
Clear Eos
MonitorType.s = GetMonitorType_UT ()
If Monitortype.s = "COLOR"
Then PaintCanvas Attribute ScreenColor.s
StartLine.n-1,0 ,NextLine.n+1,79
Style Attribute ScreenColor.S
Else PaintCanvas Border fill chr(254)
Intense
StartLine.n-1,0 ,NextLine.n+1,79
Style Intense
Endif ;**** Monitortype = "COLOR" ****
@Startline.n,10
?? Message1.s
@NextLine.n,10
?? Message2.s
canvas on
EndProc ;*** PlaceMsg_noclear_ut ***
WriteLib Libname.a PlaceMsg_NoClear_ut
Release Procs PlaceMsg_NoClear_ut
;****************************************************************
; Name: PlaceMsgPause_UT
;
; Notes: Places a user Message on the Screen and Pauses until user
; Strikes a key
;
; Inputs: Msg1 - line 1 of message
; Msg2 - line 2 of message
; Msg3 - Line 3 of message
; Screencolor - foreground and background color of boxed
; error message
; for a red backround on a white forground pass 89
; 64+15 (64 = red backround, 15 = white forground)
;
; See appendix A of Paradox User Guide
; for Complete list of colors
;
; Outputs: N/A
;
; Local Variables: MonitorType - Contains Monitor Type String
; ("MONO", "B&W", "COLOR")
;
; Global Variables: N/A
;
; Routines Called : GetMonitorType_UT
;
; Code Segment: PlaceMsgPause_UT("Editing Table", "message more",
; "message Even More", 48)
;
; Error Conditions :
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc PlaceMsgPause_UT (M1.s, M2.s, M3.s)
;*************************
;* locals
;**************************
Private Char1.c,
Monitortype.s,
ScreenBlink.n,
ScreenColor.s
;Secs.n,
;Times.n
MonitorType.s = GetMonitorType_UT ()
ScreenColor.s = ERRORCOLOR_GL
ScreenBlink.n = ScreenColor.s + 128
MonitorType.s = GetMonitorType_UT ()
Showdialog "User Message"
@5, 0
height 12
width 75
@2,8 ?? "Take Note ....."
@4,8 ?? m1.s
@5,8 ?? m2.s
@6,8 ?? m3.s
Pushbutton @8,9 width 10
"~O~K"
OK
Default
value "Say Yes"
Tag "YES"
To ButtonValue.s
EndDialog
EndProc ;**** PlaceMsgPause_UT ****
WriteLib Libname.a PlaceMsgPause_UT
Release Procs PlaceMsgPause_UT
;****************************************************************
; Name: PrinterConfig_UT
;
; Notes: This routine displays information about the currently
; active printer configuratio
;
; Inputs: n/a
;
; Outputs: N/A
;
; Global Variables: Report_GL - Discription of currently active report
; Printer_GL - Name of currently active printer
; PrintPort_GL - Name of currently active printer port
;
; Routines Called : none
;
; Code Segment: PrinterConfigUT()
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc PrinterConfig_UT ()
Private M0.s, ; message text
M1.S, ; message text
M2.S, ; message text
M3.S, ; message text
M4.S, ; message text
M5.s, ; message text
buutonvalue.s ;user dialogue box keypress
m0.s = "Report - " + Report_GL
M1.S = "The Currently Active Printer is - " + Printer_GL
M2.s = "The Currently Active Printer Port is - " + PrintPort_GL
M3.S = "TO CHANGE THESE VALUES CHOOSE:"
M4.S = "Select Printer or Select Printer Port"
m5.s = "From the Printer Selection Menu"
Showdialog "Display Printer Configuration"
@3, 3
height 16
width 70
@2,2 ?? m0.s
@3,2 ?? m1.s
@4,2 ?? m2.s
@6,2 ?? m3.s
@7,2 ?? m4.s
@8,2 ?? m5.s
Pushbutton @11,9 width 10
"OK"
OK
Default
value "Accept"
Tag "YES"
To ButtonValue.s
EndDialog
Return
EndProc ;*** PrinterConfig_UT ***
WriteLib LibNAME.A PrinterConfig_UT
Release Procs PrinterConfig_UT
;****************************************************************
; Name: PrinterDefine_UT
;
; Notes: this routine is used to define a new printer,
; edit an existing printer,
; view all printers,
; delete a printer
;
; Inputs: n/a
;
; Outputs: N/A
;
; Global Variables: placemsg_gl ; window message handle
;
; Routines Called : Printer_defnewprt_ut ()
; Printer_ViewPrt_ut ()
; Printer_EditPrt_ut ()
; Printer_DELPrt_ut ()
; PRINTERCONFIG_UT ()
; clearwindow.v ()
; showtree.s (MTree.S)
;
; Code Segment: PrinterDefine_UT()
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc PrinterDefine_UT()
Private mtree.s, ; menu tree calling sequance
PDest.S ; menu selected variable
While True
ShowPopUP "Printer UTILITIES" Centered
"~N~ew" : "Define New Printer" : "New",
"~V~iew" : "View printer configurations" : "View",
"~E~dit" : "Edit Printer Configurations" : "Edit",
"~D~elete" : "Delete a Printer" : "Delete",
SEPARATOR,
"D~I~splay" : "Display active printer" : "Display",
SEPARATOR,
"~L~eave" : "Exit Printer Utilities Menu" : "Leave"
Submenu
"~N~o" : "Stay in Printer Destination Menu" : "NO",
"~Y~es" : "Leave Printer Destination Menu" : "YES"
EndSubMenu
EndMenu
to Pdest.s
MTree.S = MenuTree_gl.S + "/" + Pdest.S
Pdest.s = Upper (pdest.s)
Switch
Case Pdest.s = "NEW" : showtree.s (MTree.S)
Printer_defnewprt_ut ()
SHOWPULLDOWN ENDMENU
ALTSPACE {DESKTOP} {EMPTY}
Case Pdest.s = "VIEW" : showtree.s (MTree.S)
Printer_ViewPrt_ut ()
ALTSPACE {DESKTOP} {EMPTY}
Case Pdest.s = "EDIT" : showtree.s (MTree.S)
Printer_EditPrt_ut ()
SHOWPULLDOWN ENDMENU
ALTSPACE {DESKTOP} {EMPTY}
CASE PDEST.S = "DELETE" : showtree.s (MTree.S)
Printer_DELPrt_ut ()
ALTSPACE {DESKTOP} {EMPTY}
case Pdest.s = "DISPLAY" : showtree.s (MTree.S)
PRINTERCONFIG_UT ()
Case Pdest.s = "YES" : showtree.s (MTree.S)
clearwindow.v (PlaceMsg_Gl)
QuitLoop
Case Pdest.s = "NO" : showtree.s (MTree.S)
clearwindow.v (PlaceMsg_Gl)
loop
OtherWIse : clearwindow.v (PlaceMsg_Gl)
QUITLOOP
EndSwitch
clearwindow.v (PlaceMsg_gl)
EndWhile
Return
EndProc ;*** PrinterDEFINE_UT ***
WriteLib LibNAME.A PrinterDEFINE_UT
Release Procs PrinterDEFINE_UT
;****************************************************************
; Name: Printer_defnewprt_ut
;
; Notes: define a new printer
;
; Inputs: n/a
;
; Outputs: N/A
;
; Global Variables: PrinTTab_GL ;name of printer definition table
;
; Routines Called : GetStringEDTField_UT("",6,TRUE,msg.s,"A20","!*@")
; EditRec_UT (PrinTTab_GL, "1","printername",pname.s)
;
; Code Segment: Printer_defnewprt_ut ()
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc Printer_defnewprt_ut()
private Msg.s, ; disaplay message
pname.s, ; name of printer
pnum.n ; number of printer
MSG.S = "ENTER THE NAME OF THE PRINTER TO DEFINE : "
PNAME.s = GetStringEDTField_UT("",6,TRUE,msg.s,"A20","!*@")
VIEW PrinTTab_GL
MOVETO [PRINTERNAME]
LOCATE PNAME.s
IF NOT RETVAL
THEN PNUM.N = CMAX (PRINTTAB_GL,"PRINTNUM") + 1
EDITKEY
INS
[PRINTNUM] = PNUM.N
[PRINTERNAME] = PNAME.s
DO_IT!
ELSE ;ERROR MESSAGE OR JUST LET EM EDIT IT ANYHOW
ENDIF
EditRec_UT (PrinTTab_GL, "1","printername",pname.s)
Return
EndProc ;*** Printer_defnewprt_ut ***
WriteLib LibNAME.A Printer_defnewprt_ut
Release Procs Printer_defnewprt_ut
;****************************************************************
; Name: Printer_delprt_ut
;
; Notes: delete a printer from the printer table
;
; Inputs: n/a
;
; Outputs: N/A
;
; Global Variables:
;
; Routines Called : Loc_err_Pause_ut (M1.s,M2.s,m3.s)
; GetStringEDTField_UT("",6,TRUE,msg.s,"A20","!*@")
; Getpromptyesno_UT (m1.s, m2.s,m3.s)
;
; Code Segment: Printer_delprt_ut ()
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc Printer_delprt_ut()
private pname.s, ; printer name
msg.s, ; display message
m1.s, ; display message
m2.s, ; display messagr
m3.s, ; display message
yes.no.confirm, ; yes/no user prompt
yes.no ; ditto
MSG.S = "ENTER THE NAME OF THE PRINTER TO DEFINE : "
PNAME.s = GetStringEDTField_UT("",6,TRUE,msg.s,"A20","!*@")
VIEW PrinTTab_GL
MOVETO [PRINTERNAME]
LOCATE PNAME.s
IF RETVAL
THEN m1.s = "Printer - " + Pname.s + " will be deleted"
m2.s = "Yes/no Delete Printer - " + Pname.S
m3.s = "...."
YES.NO = Getpromptyesno_UT (m1.s, m2.s,m3.s)
If yes.no = "YES"
then m3.s = "CONFIRM DELETION OF PRINTER - " + PNAME.S
yes.no.confirm = Getpromptyesno_UT (m1.s, m2.s,m3.s)
else yes.no.confirm = "NO"
endif
ELSE m1.s = "Printer - " + Pname.s + " not defined"
m2.s = "Printer not deleted"
m3.s = "...."
Loc_err_Pause_ut (M1.s,M2.s,m3.s)
ENDIF
editkey
moveto [printername]
locate pname.s
del
do_it!
Return
EndProc ;*** Printer_delprt_ut ***
WriteLib LibNAME.A Printer_delprt_ut
Release Procs Printer_delprt_ut
;****************************************************************
; Name: Printer_EditPrt_ut
;
; Notes: edit printer definition table
;
; Inputs:
;
; Outputs: N/A
;
; Global Variables: menutree.win ; window message handle
; printtab_gl ; name of printer definition table
;
; Routines Called : clearwindow.v (menutree.win)
; editTable_UT (Printtab_gl, 1)
; Windowmove.v (menutree.win,21,2)
;
; Code Segment: Printer_editPrt_ut ()
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc Printer_EditPrt_ut()
clearwindow.v (menutree.win)
editTable_UT (Printtab_gl, 1)
Windowmove.v (menutree.win,21,2)
Return
EndProc ;*** Printer_EditPrt_ut
WriteLib LibNAME.A Printer_EditPrt_ut
Release Procs Printer_EditPrt_ut
;***********************************
; Name: Printer_ViewPrt_ut
;
; Notes: View Printer Definition Table
;
; Inputs: na/
;
; Outputs: N/A
;
; Global Variables: menutree.win ; window message handle
; printtab_gl ; name of printer definition table
;
; Routines Called : clearwindow.v (menutree.win)
; ViewTable_UT (Printtab_gl, "1", "Printer Definition Table")
; Windowmove.v (menutree.win,21,2)
;
;
; Code Segment: Printer_ViewPrt_ut ()
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc Printer_ViewPrt_ut()
clearwindow.v (menutree.win)
ViewTable_UT (Printtab_gl, "1", "Printer Definition Table")
Windowmove.v (menutree.win,21,2)
Return
EndProc ;*** Printer_ViewPrt_ut
WriteLib LibNAME.A Printer_ViewPrt_ut
Release Procs Printer_ViewPrt_ut
;****************************************************************
; Name: Printit_UT
;
; Notes: If printer is ready Prints report for table (totable,
; using report form . If printer is not ready
; sounds alarm to user and gives time to get printer
; ready.
;
; Inputs: FromTable - Name of table to copy report specification from
; FromRpt - Number of Report specification to copy from
;
; Outputs: N/A
;
; Global Variables: screen_gl ; true if report displayed to screen
;
; Routines Called : PrinttoPrinter_UT (Fromtable.s,fromrpt.s)
; PrintToFile_UT (FromTable.S, FromRpt.S)
; Printtoscreen_ut (fromtable.s, fromrpt.s)
; SelPrintPopMen(8,8)
; SelPortPopMen(8,8)
; PrinterDefine_UT ()
; PRINTERCONFIG_UT ()
; clearwindow.v (PlaceMsg_gl)
; PlaceMsg_UT("Preparing Report ", "Processing...", Sc_gl)
; showtree.s (MTree.S)
;
; Code Segment: Printit_UT(FromTable, FromRpt)
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc Printit_UT(FromTable.s, FromRpt.s)
private pdest.s,
MTree.S
Screen_GL = False
While True
clearwindow.v (PlaceMsg_gl)
ALTSPACE {DESKTOP} {EMPTY}
CLEAR
ShowPopUP "Printer Destination Selection Menu" Centered
"~P~rinter" : "Send Report to Printer" : "Printer",
"~S~creen" : "Display Report on Screen" : "Screen",
"~F~ile" : "Send Report to File" : "File",
SEPARATOR,
"S~E~LECT Printer" : "Select Printer" : "Select Printer",
"SELE~C~T Printer Port" : "Select Printer Port" : "Select Printer Port",
"Define Printer" : "Define New Printer" : "Define Printer",
"D~I~splay Configuration" : "Display Report Configuration": "Display Configuration",
SEPARATOR,
"~L~eave" : "Exit Printer Destination Menu" : "Leave"
Submenu
"~Y~es" : "Leave Printer Destination Menu" : "YES",
"~N~o" : "Stay in Printer Destination Menu" : "NO"
EndSubMenu
EndMenu
to Pdest.s
MTree.S = MenuTree_gl.S + "/" + Pdest.S
Pdest.s = Upper (pdest.s)
PlaceMsg_UT("Preparing Report ", "Processing...", Sc_gl)
Switch
Case Pdest.s = "SCREEN" : showtree.s (MTree.S)
Printtoscreen_ut (fromtable.s, fromrpt.s)
Screen_GL = True
Case Pdest.s = "PRINTER" : showtree.s (MTree.S)
PrinttoPrinter_UT (Fromtable.s,fromrpt.s)
Case Pdest.s = "FILE" : showtree.s (MTree.S)
PrintToFile_UT (FromTable.S, FromRpt.S)
CASE PDEST.S = "SELECT PRINTER" : showtree.s (MTree.S)
SelPrintPopMen(8,8)
CASE PDEST.S = "SELECT PRINTER PORT" : showtree.s (MTree.S)
SelPortPopMen(8,8)
case Pdest.s = "DEFINE PRINTER" : showtree.s (MTree.S)
PrinterDefine_UT ()
case Pdest.s = "DISPLAY CONFIGURATION": showtree.s (MTree.S)
PRINTERCONFIG_UT ()
Case Pdest.s = "YES" : showtree.s (MTree.S)
clearwindow.v (PlaceMsg_Gl)
QuitLoop
Case Pdest.s = "NO" : showtree.s (MTree.S)
clearwindow.v (PlaceMsg_Gl)
loop
OtherWIse : clearwindow.v (PlaceMsg_Gl)
QUITLOOP
EndSwitch
EndWhile
Return
EndProc ;*** Printit_UT ***
WriteLib Libname.a Printit_UT
Release Procs Printit_UT
;****************************************************************
; Name: PrintReport_UT
; ToTable is usually the result of a query and is only
; the portion of to Fromtable we are interested in.
;
; Notes: If printer is ready Prints report for table (totable,
; using report form (toRpt). If printer is not ready
; sounds alarm to user and gives time to get printer
; ready.
;
; Inputs: FromTable - Name of table to copy report specification from
; ToTable - Name of table to copy to
; FromRpt - Number of Report specification to copy from
; ToRpt - Report number to copy to
;
; Outputs: N/A
;
;
; Global Variables: N/A
;
; Routines Called : Printit_UT(ToTable.s, ToRpt.s)
;
; Code Segment: PrintReport_UT(FromTable, ToTable, FromRpt, ToRpt)
;
; Error Conditions : None
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc PrintReport_UT(FromTable.s, ToTable.s, FromRpt.s, ToRpt.s)
CopyReport FromTable.s FromRpt.s ToTable.s ToRpt.s
Printit_UT(ToTable.s, ToRpt.s)
Return
EndProc ;*** PrintReport_UT ***
WriteLib Libname.a PrintReport_UT
Release Procs PrintReport_UT
;****************************************************************
; Name: PrintToFile_UT
;
; Notes: Places A report specification in a file
;
; Inputs: ToTable - Name of table to whose report geets routed to file
; ToRpt - Report number to route to file
;
; Outputs: PrintFile
;
; Local Variables: PrintFileExt - Print File with ".Rpt" extension
; concatenated
; YesNo - OverWrite Yes/No Prompt Variable
;
; Global Variables: N/A
;
; Routines Called : PlaceMsg_Bottom_ut (PromptTitle_GL,PTMsg1_GL, PTMsg2_GL, pcolor_gl, 22)
;
; Code Segment: PrintToFile_UT(ToTable, ToRpt)
; GetStringEDTField_UT(n1.v,15,False,"Enter FILE NAME for report ", "A8","!*!")
; DriveStatus(DriveName.S)
; Loc_err_UT ( "Drive Not Ready", "Process Aborted...")
; clearwindow.v (PlaceMsg_Gl)
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc PrintToFile_UT(ToTable.s, ToRpt.s)
;*********************************
; Locals
;*********************************
Private drive.l,
Drivename.S,
N,
PrintFile,
PrintFileExt,
YesNo,
print.l ,
isfile.l
While True
PlaceMsg_Bottom_ut (PromptTitle_GL,PTMsg1_GL, PTMsg2_GL, pcolor_gl, 22)
n1.v =""
PrintFile = GetStringEDTField_UT(n1.v,15,False,"Enter FILE NAME for report ", "A8","!*!")
PrintFileExt = PrintFile + ".RPT"
PrintFile = PrintFile
if printfile=n1.v
then print.l = false
QuitLoop
else print.l = true
Endif
Isfile.L = IsFile (PrintfileExt)
If IsFile.L
Then YesNo = GetStringedtfield_UT ("",17,False, "File Already Exists OverWrite it (Y/N) : ", "A1","!")
If YesNo = "Y"
Then Run "Del " + PrintFileEXT
QuitLoop
Else @ 17,0
Clear Eol
Loop
EndIf ;***** Yesno = yes ****
Else QuitLoop
EndIf ;*** IsFile (PrintFileExt) ***
EndWhile
If print.l
then N = search (printfileext,":")
If N > 0
then drivename.S = substr (printfileext,n-1,1)
Drive.L = DriveStatus(DriveName.S)
else drive.l = true
Endif
If Drive.L
Then Menu
{Report}
{Output}
Select Totable.s
Select ToRpt.s
{File}
TypeIn PrintFile
Else Loc_err_UT ( "Drive Not Ready", "Process Aborted...")
Endif
Endif
clearwindow.v (PlaceMsg_Gl)
Return
EndProc ;*** PrintToFile_UT
WriteLib LibName.A PrintToFile_UT
Release Procs PrintToFile_UT
;****************************************************************
; Name: PrintToPrinter_UT
;
; Notes: Prints A report
;
; Inputs: ToTable - Name of table to whose report geets routed to file
; ToRpt - Report number to route to file
;
; Outputs:
;
; Global Variables: N/A
;
; Routines Called : Check_Print_Ready_UT ()
;
;
; Code Segment: PrintToPrinter_UT(ToTable, ToRpt)
; SetPrinter.A("Reset")
; Loc_err_UT ("Printer Is Not Ready","Printer Is Not Ready")
; clearwindow.v (PlaceMsg_Gl)
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc PrintToPrinter_UT(ToTable.s, ToRpt.s)
Private Pstat.L
Pstat.l = PrinterStatus ()
IF Not PStat.l
Then Loc_err_UT ("Printer Is Not Ready",
"Printer Is Not Ready")
Check_Print_Ready_UT ()
Endif
Pstat.l = PrinterStatus ()
If Pstat.l
Then SetPrinter.A(PrintMode_GL)
Report ToTable.s ToRpt.s
SetPrinter.A("Reset")
Endif
clearwindow.v (PlaceMsg_Gl)
EndProc ;*** PrintToPrinter_UT ****
WriteLib LibName.A PrintToPrinter_UT
Release Procs PrintToPrinter_UT
;****************************************************************
; Name: PrintToScreen_UT
;
; Notes: Places A report specification on the screen
;
; Inputs: ToTable - Name of table to whose report geets routed to file
; ToRpt - Report number to route to file
;
; Outputs:
;
; Global Variables: placemsg_gl
;
; Routines Called : clearwindow.v (PlaceMsg_Gl)
;
; Code Segment: PrintToScreen_UT(ToTable, ToRpt)
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc PrintToScreen_UT(ToTable.s, ToRpt.s)
clearwindow.v (PlaceMsg_Gl)
Clearpulldown
Menu
{Report}
{Output}
Select totable.s
Select toRpt.s
{screen}
SHOWPULLDOWN ENDMENU
clearwindow.v (PlaceMsg_Gl)
EndProc ;*** PrintToScreen_UT ****
WriteLib LibName.A PrintToScreen_UT
Release Procs PrintToScreen_UT
;****************************************************************
; Name: RunBatch_UT
;
; Notes: Prompts User to enter a Name of A batch File to Run
;
; Inputs: N/A
;
; Outputs: N/A
;
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1991 Michael Makler
;
;*****************************************************************************
Proc RunBatch_UT ()
Private Bat.S,
Msg.S,
Search.N,
Ifile.L,
m1.s,
m2.s,
m3.s,
Msg.s,
yesno.s,
buttonvalue.s,
X
M1.s = "You Are About To Run A DOS Batch File"
M2.s = "Do Not Load any TSR's and Do Not Modify any Paradox Files"
M3.s = "Enter Full Path Name of DOS Batch File"
bat.s=""
ButtonValue.S = "Say No"
MonitorType.s = GetMonitorType_UT ()
Showdialog "Run a BATCH File"
@3, 3
height 14
width 70
@2,2 ?? m1.s
@3,2 ?? m2.s
@4,2 ?? m3.s
Accept @6,2
width 70
"A60"
tag "batchfile"
to bat.s
Pushbutton @8,9 width 10
"OK"
OK
Default
value "Accept"
Tag "YES"
To ButtonValue.s
Pushbutton @8,29 width 10
"Cancel"
CANCEL
value "Say No"
Tag "No"
To ButtonValue.s
EndDialog
Search.N = Search (".Bat",Bat.S)
If Search.N = 0
then Bat.S = Bat.s + ".BAT"
Endif
If ButtonValue.S = "Accept"
then Ifile.L = IsFile (Bat.S)
If Ifile.L
then Run Big Sleep 5000 Bat.S
WHILE CHARWAITING ()
X = GETCHAR ()
ENDWHILE
Else M1.S = "Batch File Not Found"
M2.S = "Try Using Full Path Name"
M3.S = "(I.E. C:\\Batch\\Backup)"
Loc_err_Pause_ut (M1.s,M2.s,m3.s)
Endif
Endif
Return
EndProc ;*** RunBatch_UT ***
WriteLib LibNAME.A RunBatch_UT
Release Procs RunBatch_UT
;****************************************************************
; Name: runbatchparm_UT
;
; Notes: Prompts User to enter a Name of A batch File to Run
;
; Inputs: N/A
;
; Outputs: N/A
;
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1991 Michael Makler
;
;*****************************************************************************
Proc runbatchparm_UT (bat.s)
Private Msg.S,
Search.N,
Ifile.L,
m1.s,
m2.s,
m3.s,
Msg.s,
yesno.s,
buttonvalue.s,
batrun.n,
X
M1.s = "You Are About To Run A DOS Batch File: "
M3.s = "Do Not Load any TSR's and Do Not Modify any Paradox Files"
M2.s = bat.s
Batrun.n = 0
ButtonValue.S = "Say No"
MonitorType.s = GetMonitorType_UT ()
Showdialog "Run a BATCH File"
@3, 3
height 14
width 70
@2,2 ?? m1.s
@3,2 ?? m2.s
@4,2 ?? m3.s
Pushbutton @8,9 width 10
"OK"
OK
Default
value "Accept"
Tag "YES"
To ButtonValue.s
Pushbutton @8,29 width 10
"Cancel"
CANCEL
value "Say No"
Tag "No"
To ButtonValue.s
EndDialog
Search.N = Search (".Bat",Bat.S)
If Search.N = 0
then Bat.S = Bat.s + ".BAT"
Endif
If ButtonValue.S = "Accept"
then Ifile.L = IsFile (Bat.S)
If Ifile.L
then Run Big Sleep 5000 Bat.S
batrun.n = 1
WHILE CHARWAITING ()
X = GETCHAR ()
ENDWHILE
Else M1.S = "Batch File Not Found"
M2.S = "Try Using Full Path Name"
M3.S = "(I.E. C:\\Batch\\Backup)"
Loc_err_Pause_ut (M1.s,M2.s,m3.s)
Endif
Endif
Return batrun.n
EndProc ;*** runbatchparm_UT ***
WriteLib LibNAME.A runbatchparm_UT
Release Procs runbatchparm_UT
;****************************************************************
; Name: SelPortPopMen
;
; Notes: This Routine allows the User to select a default Printer
;
; Inputs: N/A
;
; Outputs: Printer_Gl
;
; Other : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;****************************************************************************
Proc SelPortPopMen(Rw,CL)
;*************************
;* locals
;**************************
Private C,
DEFITEM.PP,
HELPID,
IA.L,
PROMPT1,
PROMPT2,
PTITLE,
R,
REC.N,
TABDESC.S,
TITLE,
VNUM
; Global ;Item, ;Array of items of menu
;Width ;Width of widest item
Rec.N = Nrecords ( PortTab_GL )
If Rec.n < 2
then PlaceMsgPause_UT ("Only one Port Defined","","")
Return
endif
Ia.l = IsAssigned (PortItem_GL)
If Ia.l
then Defitem.PP = PortItem_GL
Else Defitem.PP = 1
Endif
While True
VNum = 10
Title = "Printer Port Selection"
Prompt1 =""
Prompt2 =""
SetPopup2(PortTab_gl,"PortName")
ClearImage
Ptitle = "Printer Port Selection Menu"
PlaceMsg_Bottom_ut (Ptitle,PMenu1_GL, PMenu2_GL, pcolor_gl, 22)
TabDesc.s = Popup2(Rw,Cl,VNum,DefItem.PP,Title,Prompt1,Prompt2)
cLEARiMAGE
Switch
Case TabDesc.S = "RemF3" : DefItem.PP = 1
Loop
Case TabDesc.s = "Help" : R=16 ;[F1]
C=0
Size=6
HelpId = "PORT01"
Pophelp(R,C,helptab_gl,Size,Helpid)
@R-2,C
Clear eos
Case TabDesc.s = "Esc" : Quitloop
OtherWise : View PortTab_GL
Moveto Field "PortName"
Locate TabDESc.S
If Retval
Then PRINTPORT_Gl = TabDesc.S
PortItem_GL = RecNo()
DefItem.PP = POrtItem_GL
SetPrinter PRINTPort_GL
message "Printer Port Set to: " + TabDesc.S
else
message "Error Printer Port Not Set"
Endif
ClearaLL
Clear
Quitloop
EndSwitch
EndWhile
@rw,cl
Clear eos
Return
EndProc ;*** SelPortPopMen ***
WriteLib LibNAME.A SelPortPopMen ;***
Release Procs SelPortPopMen ;***
;****************************************************************
; Name: SelPrintPopMen
;
; Notes: This Routine allows the User to select a default Printer
;
; Inputs: N/A
;
; Outputs: Printer_Gl
;
; Other : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;****************************************************************************
Proc SelPrintPopMen(Rw,CL)
;*************************
;* locals
;**************************
Private C,
DEFITEM.P,
HELPID,
IA.L,
PROMPT1,
PROMPT2,
PTITLE,
R,
REC.N,
TABDESC.S,
TITLE,
VNUM
; Global ;Item, ;Array of items of menu
;Width ;Width of widest item
Rec.N = Nrecords ( PrintTab_GL )
If Rec.n < 2
then PlaceMsgPause_UT ("Only one Printer Defined","","")
Return
endif
Ia.l = IsAssigned (PrintItem_GL)
If Ia.l
then Defitem.P = PrintItem_GL
Else Defitem.P = 1
Endif
While True
VNum = 10
Title = "Report Printer Selection"
Prompt1 =""
Prompt2 =""
SetPopup2(PrintTab_gl,"PrinterName")
ClearImage
Ptitle = "Report Printer Selection Menu"
PlaceMsg_Bottom_ut (Ptitle,PMenu1_GL, PMenu2_GL, pcolor_gl, 22)
TabDesc.s = Popup2(Rw,Cl,VNum,DefItem.P,Title,Prompt1,Prompt2)
cLEARiMAGE
Switch
Case TabDesc.S = "RemF3" : DefItem.P = 1
Loop
Case TabDesc.s = "Help" : R=16 ;[F1]
C=0
Size=6
HelpId = "PRNT01"
Pophelp(R,C,helptab_gl,Size,Helpid)
@R-2,C
Clear eos
Case TabDesc.s = "Esc" : Quitloop
OtherWise : View PrintTab_GL
Moveto Field "PrinterName"
Locate TabDESc.S
If Retval
Then Printer_Gl = TabDesc.S
PrintItem_GL = RecNo()
DefItem.P = PrintItem_GL
SetPrinter.A("PICA")
message "Printer Set to: " + TabDesc.S
Else Message "Error Printer Not Set"
Endif
ClearaLL
;@9,0
Clear
quitloop
EndSwitch
EndWhile
@rw,cl
Clear eos
Return
EndProc ;*** SelPrintPopMen ***
WriteLib LIBNAME.A SelPrintPopMen ;***
Release Procs SelPrintPopMen ;***
;****************************************************************
; Name: SetPrinter.A
;
; Notes: This Routine will Initialze the Printer
;
; Inputs: Mode.s - This is :
; Pica - print 10 cpi
; Elite - Print 12 cpi
; Compressed - Print 17 cpi
; Compoff - Turn off 17 Cpi or 12 cpi revert to 10 cpi
; Reset - Printer power on defaults)
; User - User String - Set In Global UserprintString_Gl
;
; PORT.S - This is:
; LPT1 - Printer Port 1
; LPT2 - Printer Port 2
;
; Outputs: N/a
;
; Other : These setup strings are for Epson MX/FX/RX and IBM graphics
; printers and other printers that mimic these. If this is not
; the case then change these strings or use the user option and
; set UserprintString_GL to the string you want.
;
; Copyright (c) 1993 Mike Makler
;****************************************************************************
PROC SetPrinter.A (Mode.S)
PRIVATE Msg1,
msg2,
msg3
View PrintTab_GL
Moveto [PrinterName]
Locate Printer_GL
PrintSet.S = ""
If Retval
then MoveTo Field Mode.S
PrintSet.S = []
If Printer_GL = "*Custom-1" or Printer_GL = "*Custom-2"
then Msg1 = "For Custom Printer Setup"
Msg2 = " Call Mike Makler "
Msg3 = "(714) 571-8510"
PlaceMsgPause_UT (Msg1, Msg2, Msg3)
PrintSet.S = ""
Endif
If Printer_GL = "HPQuiet"
then Menu {Report} {SetPrinter} {Override} {Setup} Select "\\027%@"
Endif
Else Msg1 = "No Printer Specified"
Msg3 = "Select Printer and Retry"
Msg2 = ""
PlaceMsgPause_UT (Msg1, Msg2, Msg3)
clearimage
return
Endif
;************ Set Print Mode **********************************
If PrintSet.S <>""
Then Menu {Report} {SetPrinter} {Override} {Setup} Select PrintSet.S
Endif
clearimage
Return
ENDPROC ;**** SetPrinter.A ****
WRITELIB LibName.a SetPrinter.A
RELEASE PROCS SetPrinter.A
Proc ShowTree.S (MenuTree.S)
private menutree.da,
Memleft.m,
date.d,
time.a,
version.n,
runtime.a
DynArray Menutree.DA []
isval.l = Isassigned (menutree.win)
if isval.l
then iswin.l = IsWinDow (MenuTree.win)
else iswin.l = false
endif
if not iswin.l
then Menutree.DA ["CanClose"] = false
Menutree.DA ["canmaximize"] = false
Menutree.DA ["canmove"] = FALSE
Menutree.DA ["canresize"] = false
;Menutree.DA ["canvas"] = true
;Menutree.DA ["echo"] = false
Menutree.DA ["Floating"] = TRUE
Menutree.DA ["hasframe"] = FALSE
menutree.da ["Maximized"] = False
; menutree.da ["TITLE"] = "LAST Menu Tree Selected"
Menutree.DA ["hasshadow"] = false
Menutree.DA ["height"] = 1
Menutree.DA ["margin"] = "off"
Menutree.DA ["origincol"] = 2
Menutree.DA ["originrow"] = 21
Menutree.DA ["Width"] = 80
;menutree.da ["style"] = 30
window create
attributes menutree.da
to menutree.win
SETCANVAS MENUTREE.WIN
WINDOW ECHO MENUTREE.WIN TRUE
@0,0 ?? "LAST MENU SELECTED - " + Menutree.s
Else window select menutree.win
setcanvas menutree.win
WINDOW ECHO MENUTREE.WIN TRUE
clear
@0,0 ?? "LAST MENU SELECTED - " + Menutree.s
endif
if Journalflag_GL
then
If Isassigned (Write_gl)
Then memleft.m = MEMLEFT()
version.n = VERSION()
runtime.a = FORMAT("LY",ISRUNTIME())
PRINT FILE JOURNAL_GL ; In the current directory (appends if one exists).
"\n\n" , ; "\n" is linefeed "\f" is formfeed.
" Memory left: ", memleft.m, "\n",
" Action: ", menutree.s, "\n"
Else write_gl=true
memleft.m = MEMLEFT()
date.D = TODAY()
time.a = TIME()
version.n = VERSION()
runtime.a = FORMAT("LY",ISRUNTIME())
PRINT FILE JOURNAL_GL ; In the current directory (appends if one exists).
"\n\n" , ; "\n" is linefeed "\f" is formfeed.
"===========================================================\n",
" Date: ", date.D, "\n",
" Time: ", time.a, "\n",
" Version: ", version.n, "\n",
" Runtime: ", runtime.a, "\n",
" Memory left: ", memleft.m, "\n",
" Action: ", menutree.s, "\n"
Endif
Endif
Return
EndProc
WRITELIB LibName.a ShowTree.S
RELEASE PROCS ShowTree.S
;****************************************************************
; Name: viewrec_UT
; Notes: allows user to VIEW a record (table_in) using
; form (formNum)
;
; Input: Table_in - Name of table to edit
; FORMNUM - form to use for editing
;
; Outputs: Retval (Paradox Global Variable)
;
; Local Variables:
; L - CancelEdit Yes/No Prompt Variable
; Msg1 - User Message
; Msg2 - User Message
;
; Global Variables: RetVal - Paradox WaitKey Variable
;
; Routines Called : NotCode_UT
; YesNo_Ut
;
;
; Error Conditions : N/A
;
; Other : N/A
;
; Limitatiions : This routine will not allow Dos, Dosbig, Zoom or ZoomNext
; Keys to be Entered.
; You Must Supply your own Help_Me (PRocName) Routine.
; If you want Help. I have Supplied one that does nothing.
; You Can use EditTableNoHelp_Ut if help is not Needed.
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc viewrec_UT (Table_in.s, FormNum.s,Field.s,Value.a)
;*************************
;* locals
;**************************
Private L,
Msg1,
Msg2,
Formv.l,
Empty.L
Msg1 = "Viewing Record --- Enter [F2] - Save, [Esc] - Cancel, [F1] - Help"
View Table_in.s
Moveto Field field.s
Locate Value.a
if retval
then ;EditKey
;CURSOR NORMAL
Formv.l = IsFormView ()
Empty.L = IsEmpty (Table_IN.s)
If Not Formv.l and Not Empty.l
Then PickForm FormNum.s
EndIf
While True
Wait Record
Prompt Msg1
Message "Begin viewing Record."
Until "F1","F2", "Esc","DOS","DOSBIG","ZOOM","ZOOMNEXT","F7"
Switch
Case RetVal = "F1":
;help_me("EditTable_UT")
If helpmode() = "LookupHelp"
then Keypress "F1"
else Message "LookUp Help Not Available for This Field"
Endif
Loop
Case RetVal = "F2":
Do_it!
QuitLoop
Case Retval = "F7" : Formv.l = IsFormView ()
Empty.L = IsEmpty (Table_IN.s)
If Not Formv.l
Then If Not Empty.L
then PickForm FormNum
endif
Else KeyPress "F7"
Endif
Case RetVal = "DOS" or RetVal = "DOSBIG" : Beep
Loop
Case RetVal ="ZOOM" or Retval = "ZOOMNEXT" : Beep
Loop
Case RetVal = "Esc": quitloop
OtherWise: NotCode_UT ()
Loop
EndSwitch
EndWhile
else ;record not found error
M1.s = "Record not found for table : " + Table_in.s
m2.s = "Field : " + field.s
m3.s = "Value : " + strval (Value.a)
Loc_err_Pause_UT (M1.s, M2.s, M3.s)
endif
ClearImage ;*** Table ***
CURSOR OFF
EndProc ;*** viewrec_UT ***
WriteLib Libname.a viewrec_UT
Release Procs viewrec_UT
;****************************************************************
; Name: ViewTable_UT
;
; Notes: allows user to View a table (table_in) using
; form (formNum)
;
; Inputs:Table_in - Name of Table to View
; FormNum - Name of Form to use To View Table With
; TabName - Informative Text that gives Table Name or Purpose or....
;
; Outputs: N/A
;
; Local Variables: Msg1 - User Prompt Text
; Msg2 - User Prompt Text
;
; Global Variables: N/A
;
; Routines Called : Loc_err_UT
;
; Code Segment: ViewTable_UT (EmpId, "3", "Employee Id Table")
;
; Error Conditions : Cannot Toggle Formview table is empty
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 Mike Makler
;
;*****************************************************************************
Proc ViewTable_UT (Table_in, FormNum, TabName)
;*************************
;* locals
;**************************
Private Msg1,
Msg2,
Eflag.L
If TabName = " "
Then TabName = Table_in
EndIf
Eflag.L = IsEmpty (Table_in)
If Eflag.L
Then loc_err_ut ("No Records Found For - " + Tabname, " ")
Return
Endif
Msg1 = "Viewing TABLE --- " + TabName
Msg2 = "Enter [F7] To Toggle Form , [ESC] or [F2] When Done"
View Table_in
If Not IsFormView ()
Then
If FormNum = " "
Then FormKey
formnum = Form ()
Else PickForm FormNum
EndIf
EndIf
WINMAX
While True
Wait Table
Prompt Msg1, Msg2
Message "Begin Viewing TABLE " + TabName
Until "F2", "Esc" , "F7","DOS","DOSBIG","ZOOM","ZOOMNEXT"
Switch
Case RetVal = "F2" Or RetVal = "Esc" : QuitLoop
Case RetVal = "F7" : If IsFormView()
Then FormKey
Else If Not Isempty (Table_in)
Then PickForm FormNum
Else Loc_err_UT ("We Cannot Enter Form Mode",
"Table" + Table_IN + "Does Not Contain Records")
Endif
EndIf
Loop
Case RetVal = "DOS" or RetVal = "DOSBIG" : Beep
Loop
Case RetVal ="ZOOM" or Retval = "ZOOMNEXT" : Beep
Loop
OtherWise : Beep
loop
EndSwitch
EndWhile
ClearImage ;*** Table ***
EndProc ;*** ViewTable_UT*
WriteLib Libname.a ViewTable_UT
Release Procs ViewTable_UT
;****************************************************************
; Name: windowmove.v
;
; Notes: This Routine WILL move a window.
;
; Outputs: N/A
;
; Copyright (c) 1993 Mike Makler
;****************************************************************************
PROC Windowmove.v (WinHand.H,rw.n,cl.n)
Private isvalue.l
isvalue.l = Isassigned (WinHand.H)
if Isvalue.l
then if Iswindow (winhand.h)
then window select winhand.h
window move winhand.h to RW.N,CL.N
endif
endif
ENDPROC ;**** windowmove.v ****
WRITELIB LibName.a windowmove.v
RELEASE PROCS windowmove.v
;****************************************************************
; Name: YesNo_UT
;
; Notes: Displays a yes/no Menu and Returns user selection to
; Calling Routine.
;
; Inputs: YesMsg - Yes Message String
; noMsg - no Message String
; Def - Default Selection (Yes, Or No)
;
; Output Selection - user Selection (YES, NO)
;
; Local Variables: N/A
;
; Global Variables: N/A
;
; Routines Called : N/A
;
; Code Segment: While True
; Switch
; :
; :
; Case MenSel = Leave :L= YesNo_UT ("Yes leave DOS Menu",
; "No Return to The DOS Menu","YES")
; If Upper(L) = "YES"
; Then QuitLoop
; Else Loop
; EndIf
; :
; :
; Otherwise : ;********
; EndSwitch
; EndWhile
; Error Conditions : N/A
;
; Other : N/A
;
; Limitations : N/A
;
; Copyright (c) 1993 MIKE MAKLER
;
;*****************************************************************************
Proc YesNo_UT (YesMsg, NoMSG, Def)
;*************************
;* locals
;**************************
Private Selection,
ButtonValue.s,
Startline.n
;setcanvas default
StartLine.N = 9
ButtonValue.s ="No"
Showdialog "Cancel Edit Session"
@Startline.n, 5
height 9
width 60
@3,2 ?? "Leave Current Edit Session"
@4,2 ?? "Yes - Changes will be lost"
@5,2 ?? "No - Continue Editing Save Changes"
Pushbutton @7,9 width 10
"~O~K"
OK
Default
value "Yes"
Tag "YES"
To ButtonValue.s
Pushbutton @7,29 width 10
"~C~ancel"
CANCEL
value "No"
Tag "No"
To ButtonValue.s
EndDialog
Return ButtonValue.s
EndProc ;***** YesNo_UT *******
WriteLib LibNAME.A YesNo_UT
Release Procs YesNo_UT
;****************************
;****************************
; Borlands PopUp Menu Code
;****************************
;****************************
; Copyright (c) 1988, 1989 Borland International. All Rights Reserved.
;
; General permission to re-distribute all or part of this script is granted,
; provided that this statement, including the above copyright notice, is not
; removed. You may add your own copyright notice to secure copyright
; protection for new matter that you add to this script, but Borland
; International will not support, nor assume any legal responsibility for,
; material added or changes made to this script.
;
; Revs.: DCY 12/15/88
; ****************************************************************************
; SetPopup2 initializes variables required by Popup2 from data stored in a
; table. It requires a table name and a field name from which to read menu
; item information. Basically, it views and scans the given table, defining
; menu items as elements within an array. It also determines the widest
; element of the array (not necessarily the width_gl of the field), assigning it
; to another variable also required by Popup2.
;
Proc SetPopup2(PopTbl,Fld)
; Private;PopTbl, ;Source table for items of menu
;Fld, ;Source field for items of menu
; Global ;Item, ;Array of items of menu
;width_gl ;Width of widest item
Array Item[NRecords(PopTbl)] ;Dimension Item array. One item per record
View PopTbl ; in PopTbl.
MoveTo Field Fld
width_gl = 0
If Search("A",FieldType()) = 0 ;If field is non-alphanumeric, convert it
Then Scan ; to a string value before assigning it
Item[[#]] = Strval([])
width_gl = Max(Len(Item[[#]]),width_gl) ;Update max. width
Endscan
Else Scan
Item[[#]] = []
width_gl = Max(Len([]),Width_gl)
Endscan
Endif
Endproc
WriteLib LIBNAME.A SetPopup2
Release Procs Setpopup2
Proc Popup2(R,C,VNum,DefItem,Title,Prompt1,Prompt2)
Private;R, ;Row position of upper-left corner of menu box
;C, ;Column position of upper-left corner menu box
;VNum, ;Number of items to be displayed in one menu image
;DefItem, ;Item (number) to show
;Title, ;Title of popup box
;Prompt1, ;First prompt line
;Prompt2, ;Second prompt line
NItems, ;Number of items in menu list
Char, ;Keycode of last key pressed
MenuPos, ;Current (row image) position within menu
CIndex, ;Current choice index into Item
X, ;Counter variable
PrmptColr, ;Color attribute for prompt
BrdrColr, ;Color attribute for box border
ListColr, ;Color attribute for menu item list
SlctColr, ;Color attribute for current menu selection
Promptit
; Global ;Item, ;Array of items of menu
;width_gl ;Width of widest item
H.s = Vnum + 6
ok.s = ""
ltitle.n = len (title) +6
width_gl = max (width_gl, ltitle.n)
ShowDialog title
@R-2, C-2
Height H.s
width width_gl + 10
Pickarray @1,2
height Vnum width width_gl +2
Item
Tag "PickArray.A"
to Menu.S
Pushbutton @vnum+3,10 width 10
"~O~K"
OK
DEFAULT
Value "Accept"
Tag "Yes"
to ok.s
Pushbutton @vnum+3,21 width 10
"~C~ANCEL"
CANCEL
Value "Cancel"
Tag "Cancel"
to ok.s
Enddialog
If Ok.s = "Accept"
then MenuPick.S = Item [menu.s]
else MenuPick.S = "Esc"
endif
Return Menupick.S
Endproc ;*** Popup2 *
WriteLib LIBNAME.A Popup2
Release Procs Popup2