Monster Media 1993 #2

home *** CD-ROM | disk | FTP | other *** search

/ Monster Media 1993 #2 / Image.iso / database / tools401.zip / DS4_UTIL.SC

Wrap

Text File | 1993-05-25 | 179KB | 4,022 lines

; **************************************************************************** ; TITLE: DS4_UTIL.sc (DS4UTL.EXE - Self-extracting file) ; DEVTEAM: Dan Paolini - Micah Bleecher - Pat Paolini - David Kelton ; COPYRIGHT: (c) 1991, 1992, 1993 - DataStar International ; DESCRIPTION: Over 50 Paradox 4 Generic Utilities from DataStar. ; ; This is a sample of the over 200 routines in Paladin 4.0, ; which will be shipping in May, 1993, from dp Solutions. ; Paladin 4 contains an extensive library of routines for ; Paradox 4, and an extensive library of routines for Paradox ; 3.5 and 4.0 Compatible mode, which simulate appearance and ; behavior of 4.0 Standard mode. It also includes a Help ; system generator for Paradox 4, and the original Paladin 1.01, ; which was a menu and help system generator for Paradox 3. ; All source code is included! The product may be obtained ; from: ; dp Solutions ; 3111 Route 38 #11 ; Mount Laurel, NJ 08054 USA ; 609.265.9500 ; ; "PALADIN" is a 1992 Paradox Informant Readers' Choice Award ; Winner, includes all source code, and lists for $99. ; ; Please note that these procedures are all FREEWARE. You may ; use them freely in your own applications, providing you make ; acknowledgement of their source in your script comments. You ; are under no obligation to purchase Paladin. These routines ; are provided without warranty. Use and enjoy! ; ; Dan Paolini - dp Solutions - DataStar International ; ; ============================================================================ ; TITLE: dbAlert.l (c) 1991 - 1993 DataStar International ; RETURNS: True, for dBox Event Handler ; DESCRIPTION: Dialog Event Handler proc for IDLE event Alerts ; ---------------------------------------------------------------------------- PROC dbAlert.l() ; Idle Alert called from Event Handler Private n1, n2 ; Transient loop counter ;Global alert.n ; Alert Value from dBox (0 - 5) ; onceflag.l ; For non-continuous Alert (1, 2) IF NOT IsAssigned(onceflag.l) THEN onceflag.l = true ENDIF SWITCH CASE alert.n = 1 AND onceflag.l : Beep Sleep 50 Beep Sleep 50 Beep onceflag.l = false ; Turns off subsequent Alerts CASE alert.n = 2 AND onceflag.l : Sound 770 150 Sound 440 150 Sound 770 150 Sound 440 150 Sound 770 150 onceflag.l = false ; Turns off subsequent Alerts CASE alert.n = 3 : Beep Sleep 50 Beep Sleep 1000 CASE alert.n = 4 : Sound 300 50 Sleep 100 Sound 300 50 Sleep 100 Sound 150 50 Sleep 100 Sound 150 50 Sleep 100 Sleep 200 CASE alert.n = 5 : Sound 770 150 Sound 440 150 CASE alert.n = 86 and onceflag.l : FOR n1 From 4 To 0 Step -1 FOR n2 From 11 To 0 Step -1 Sound Int(Pow(2,n1+n2/12)*110) 5 ENDFOR ENDFOR Sound 10 3000 onceflag.l = false ; Turns off subsequent Alerts ENDSWITCH Return true ENDPROC ; ============================================================================ ; TITLE: dbButtonPress.v (c) 1991 - 1993 DataStar International ; RETURNS: Whatever value is passed as parameter ; DESCRIPTION: Adds 300 millisecond delay to PushButton press ; ---------------------------------------------------------------------------- PROC dbButtonPress.v( ; Adds 300 ms delay to button press retval.v) ; Value to assign to Pushbutton variable Sleep 300 Return retval.v ENDPROC ; ============================================================================ ; TITLE: dbEventHandler.l (c) 1991 - 1993 DataStar International ; RETURNS: Logical true/false id dBox accepted ; DESCRIPTION: Generic Dialog Box Event Handler ; ---------------------------------------------------------------------------- PROC dbEventHandler.l( ; Alert Siren in Idle Dialog Box type.a, ; EVENT, or TRIGGER Name tag.a, ; Control element tag or null event.v, ; DynArray of GetEvent, or control value element.a) ; Checkbox label or null Private h, ; Transient window handle y, ; Transient window attributes dynarray retval.l, ; Value to return dboxcolors.y, ; Custom Dialog Box Color Palette proctag.a ; Trigger name, or event type ;Global alert.n ; Alert Value from dBox (0 - 5) ; onceflag.l ; For non-continuous Alert (1, 2) ; dboxpalette.a ; Palette name for custom colors ; starticks.n ; Starting Ticks, if assigned, enables timeout ; frametag.a ; Can be used by calling proc to paint frame retval.l = true SWITCH CASE type.a = "OPEN" : IF IsAssigned(dboxprocs.y["OPEN"]) THEN ExecProc dboxprocs.y["OPEN"] retval.l = retval ELSE Window Handle Dialog To h DynArray y[] y["OriginRow"] = toprow.n y["OriginCol"] = leftcol.n IF IsAssigned(dboxpalette.a) AND NOT IsBlank(dboxpalette.a) THEN dbPaletteSet.u(dboxpalette.a) Window SetColors h From dboxcolors.y RepaintDialog ENDIF Window SetAttributes h From y ENDIF CASE type.a = "IDLE" : IF IsAssigned(dboxprocs.y["IDLE"]) THEN ExecProc dboxprocs.y["IDLE"] retval.l = retval ELSE IF IsAssigned(starticks.n) AND Ticks() > starticks.n + 600000 THEN CancelDialog ENDIF ENDIF OTHERWISE : proctag.a = IIF(type.a = "EVENT",event.v["Type"],type.a) IF IsAssigned(dboxprocs.y[proctag.a]) THEN ExecProc dboxprocs.y[proctag.a] retval.l = retval ENDIF ENDSWITCH frametag.a = tag.a RepaintDialog Return retval.l ENDPROC ; ============================================================================ ; TITLE: dbPaletteSet.u (c) 1991 - 1993 DataStar International ; RETURNS: No value (sets local global dynarray: dboxcolors.y) ; DESCRIPTION: Creates a dynarray of dialog box colors based upon palette.a ; ---------------------------------------------------------------------------- PROC dbPaletteSet.u( ; Creates Palette for Dialog Boxes palette.a) ;Global dboxcolors.y DynArray dboxcolors.y[] SWITCH CASE Upper(palette.a) = "BLUE" : dboxcolors.y["1"] = 27 ; Active dialog box frame and title dboxcolors.y["2"] = 26 ; Selected dialog box frame when dragging dboxcolors.y["3"] = 48 ; Scroll bar dboxcolors.y["4"] = 63 ; Scroll bar controls dboxcolors.y["5"] = 31 ; Default background text dboxcolors.y["6"] = 23 ; Label when linked control is inactive dboxcolors.y["7"] = 31 ; Label when linked control is active dboxcolors.y["8"] = 30 ; Label hot key dboxcolors.y["9"] = 48 ; Text for normal push button label dboxcolors.y["10"] = 59 ; Text for default push button label dboxcolors.y["11"] = 63 ; Text for selected push button label dboxcolors.y["13"] = 62 ; Hot key for push button label dboxcolors.y["14"] = 16 ; Button shadow dboxcolors.y["16"] = 27 ; Normal radio button / check box dboxcolors.y["16"] = 31 ; Highlighted radio button / check box dboxcolors.y["17"] = 30 ; Hot key for radio button / check box dboxcolors.y["18"] = 63 ; Normal typein box text dboxcolors.y["19"] = 47 ; Selected typein box text dboxcolors.y["20"] = 49 ; Typein box arrows dboxcolors.y["25"] = 48 ; Normal pick list item text dboxcolors.y["26"] = 47 ; Selected text when pick list is active dboxcolors.y["27"] = 63 ; Selected text when pick list is inactive dboxcolors.y["28"] = 49 ; Column dividers framehigh.n = 25 ; Frame highlight (sunny side) framelow.n = 16 ; Frame lowlight (shadow side) CASE Upper(palette.a) = "RED" : dboxcolors.y["1"] = 79 ; Active dialog box frame and title dboxcolors.y["2"] = 75 ; Selected dialog box frame when dragging dboxcolors.y["3"] = 112 ; Scroll bar dboxcolors.y["4"] = 127 ; Scroll bar controls dboxcolors.y["5"] = 71 ; Default background text dboxcolors.y["6"] = 65 ; Label when linked control is inactive dboxcolors.y["7"] = 79 ; Label when linked control is active dboxcolors.y["8"] = 78 ; Label hot key dboxcolors.y["9"] = 112 ; Text for normal push button label dboxcolors.y["10"] = 116 ; Text for default push button label dboxcolors.y["11"] = 127 ; Text for selected push button label dboxcolors.y["13"] = 126 ; Hot key for push button label dboxcolors.y["14"] = 64 ; Button shadow dboxcolors.y["16"] = 71 ; Normal radio button / check box dboxcolors.y["16"] = 79 ; Highlighted radio button / check box dboxcolors.y["17"] = 78 ; Hot key for radio button / check box dboxcolors.y["18"] = 31 ; Normal typein box text dboxcolors.y["19"] = 47 ; Selected typein box text dboxcolors.y["20"] = 27 ; Typein box arrows dboxcolors.y["25"] = 112 ; Normal pick list item text dboxcolors.y["26"] = 31 ; Selected text when pick list is active dboxcolors.y["27"] = 127 ; Selected text when pick list is inactive dboxcolors.y["28"] = 116 ; Column dividers framehigh.n = 76 ; Frame highlight (sunny side) framelow.n = 64 ; Frame lowlight (shadow side) CASE Upper(palette.a) = "CYAN" : dboxcolors.y["1"] = 63 ; Active dialog box frame and title dboxcolors.y["2"] = 59 ; Selected dialog box frame when dragging dboxcolors.y["3"] = 23 ; Scroll bar dboxcolors.y["4"] = 31 ; Scroll bar controls dboxcolors.y["5"] = 49 ; Default background text dboxcolors.y["6"] = 48 ; Label when linked control is inactive dboxcolors.y["7"] = 63 ; Label when linked control is active dboxcolors.y["8"] = 62 ; Label hot key dboxcolors.y["9"] = 27 ; Text for normal push button label dboxcolors.y["10"] = 29 ; Text for default push button label dboxcolors.y["11"] = 31 ; Text for selected push button label dboxcolors.y["13"] = 30 ; Hot key for push button label dboxcolors.y["14"] = 48 ; Button shadow dboxcolors.y["16"] = 49 ; Normal radio button / check box dboxcolors.y["16"] = 63 ; Highlighted radio button / check box dboxcolors.y["17"] = 62 ; Hot key for radio button / check box dboxcolors.y["18"] = 31 ; Normal typein box text dboxcolors.y["19"] = 47 ; Selected typein box text dboxcolors.y["20"] = 27 ; Typein box arrows dboxcolors.y["25"] = 112 ; Normal pick list item text dboxcolors.y["26"] = 31 ; Selected text when pick list is active dboxcolors.y["27"] = 127 ; Selected text when pick list is inactive dboxcolors.y["28"] = 115 ; Column dividers framehigh.n = 59 ; Frame highlight (sunny side) framelow.n = 48 ; Frame lowlight (shadow side) CASE Upper(palette.a) = "GREEN" : dboxcolors.y["1"] = 47 ; Active dialog box frame and title dboxcolors.y["2"] = 43 ; Selected dialog box frame when dragging dboxcolors.y["3"] = 96 ; Scroll bar dboxcolors.y["4"] = 111 ; Scroll bar controls dboxcolors.y["5"] = 32 ; Default background text dboxcolors.y["6"] = 42 ; Label when linked control is inactive dboxcolors.y["7"] = 47 ; Label when linked control is active dboxcolors.y["8"] = 46 ; Label hot key dboxcolors.y["9"] = 27 ; Text for normal push button label dboxcolors.y["10"] = 29 ; Text for default push button label dboxcolors.y["11"] = 31 ; Text for selected push button label dboxcolors.y["13"] = 30 ; Hot key for push button label dboxcolors.y["14"] = 32 ; Button shadow dboxcolors.y["16"] = 33 ; Normal radio button / check box dboxcolors.y["16"] = 47 ; Highlighted radio button / check box dboxcolors.y["17"] = 46 ; Hot key for radio button / check box dboxcolors.y["18"] = 112 ; Normal typein box text dboxcolors.y["19"] = 31 ; Selected typein box text dboxcolors.y["20"] = 114 ; Typein box arrows dboxcolors.y["25"] = 112 ; Normal pick list item text dboxcolors.y["26"] = 31 ; Selected text when pick list is active dboxcolors.y["27"] = 127 ; Selected text when pick list is inactive dboxcolors.y["28"] = 114 ; Column dividers framehigh.n = 42 ; Frame highlight (sunny side) framelow.n = 32 ; Frame lowlight (shadow side) CASE Upper(palette.a) = "BROWN" : dboxcolors.y["1"] = 111 ; Active dialog box frame and title dboxcolors.y["2"] = 107 ; Selected dialog box frame when dragging dboxcolors.y["3"] = 112 ; Scroll bar dboxcolors.y["4"] = 127 ; Scroll bar controls dboxcolors.y["5"] = 96 ; Default background text dboxcolors.y["6"] = 97 ; Label when linked control is inactive dboxcolors.y["7"] = 111 ; Label when linked control is active dboxcolors.y["8"] = 110 ; Label hot key dboxcolors.y["9"] = 27 ; Text for normal push button label dboxcolors.y["10"] = 29 ; Text for default push button label dboxcolors.y["11"] = 31 ; Text for selected push button label dboxcolors.y["13"] = 30 ; Hot key for push button label dboxcolors.y["14"] = 96 ; Button shadow dboxcolors.y["16"] = 97 ; Normal radio button / check box dboxcolors.y["16"] = 111 ; Highlighted radio button / check box dboxcolors.y["17"] = 110 ; Hot key for radio button / check box dboxcolors.y["18"] = 112 ; Normal typein box text dboxcolors.y["19"] = 47 ; Selected typein box text dboxcolors.y["20"] = 118 ; Typein box arrows dboxcolors.y["25"] = 112 ; Normal pick list item text dboxcolors.y["26"] = 47 ; Selected text when pick list is active dboxcolors.y["27"] = 127 ; Selected text when pick list is inactive dboxcolors.y["28"] = 118 ; Column dividers framehigh.n = 110 ; Frame highlight (sunny side) framelow.n = 96 ; Frame lowlight (shadow side) CASE Upper(palette.a) = "MAGENTA" : dboxcolors.y["1"] = 95 ; Active dialog box frame and title dboxcolors.y["2"] = 91 ; Selected dialog box frame when dragging dboxcolors.y["3"] = 23 ; Scroll bar dboxcolors.y["4"] = 31 ; Scroll bar controls dboxcolors.y["5"] = 80 ; Default background text dboxcolors.y["6"] = 81 ; Label when linked control is inactive dboxcolors.y["7"] = 95 ; Label when linked control is active dboxcolors.y["8"] = 94 ; Label hot key dboxcolors.y["9"] = 27 ; Text for normal push button label dboxcolors.y["10"] = 29 ; Text for default push button label dboxcolors.y["11"] = 31 ; Text for selected push button label dboxcolors.y["13"] = 30 ; Hot key for push button label dboxcolors.y["14"] = 80 ; Button shadow dboxcolors.y["16"] = 81 ; Normal radio button / check box dboxcolors.y["16"] = 95 ; Highlighted radio button / check box dboxcolors.y["17"] = 94 ; Hot key for radio button / check box dboxcolors.y["18"] = 112 ; Normal typein box text dboxcolors.y["19"] = 31 ; Selected typein box text dboxcolors.y["20"] = 113 ; Typein box arrows dboxcolors.y["25"] = 112 ; Normal pick list item text dboxcolors.y["26"] = 31 ; Selected text when pick list is active dboxcolors.y["27"] = 127 ; Selected text when pick list is inactive dboxcolors.y["28"] = 117 ; Column dividers framehigh.n = 93 ; Frame highlight (sunny side) framelow.n = 80 ; Frame lowlight (shadow side) CASE Upper(palette.a) = "GRAY" : dboxcolors.y["1"] = 127 ; Active dialog box frame and title dboxcolors.y["2"] = 123 ; Selected dialog box frame when dragging dboxcolors.y["3"] = 19 ; Scroll bar dboxcolors.y["4"] = 27 ; Scroll bar controls dboxcolors.y["5"] = 112 ; Default background text dboxcolors.y["6"] = 113 ; Label when linked control is inactive dboxcolors.y["7"] = 127 ; Label when linked control is active dboxcolors.y["8"] = 126 ; Label hot key dboxcolors.y["9"] = 32 ; Text for normal push button label dboxcolors.y["10"] = 43 ; Text for default push button label dboxcolors.y["11"] = 47 ; Text for selected push button label dboxcolors.y["13"] = 46 ; Hot key for push button label dboxcolors.y["14"] = 112 ; Button shadow dboxcolors.y["16"] = 112 ; Normal radio button / check box dboxcolors.y["16"] = 127 ; Highlighted radio button / check box dboxcolors.y["17"] = 126 ; Hot key for radio button / check box dboxcolors.y["18"] = 31 ; Normal typein box text dboxcolors.y["19"] = 47 ; Selected typein box text dboxcolors.y["20"] = 26 ; Typein box arrows dboxcolors.y["25"] = 48 ; Normal pick list item text dboxcolors.y["26"] = 47 ; Selected text when pick list is active dboxcolors.y["27"] = 63 ; Selected text when pick list is inactive dboxcolors.y["28"] = 55 ; Column dividers framehigh.n = 127 ; Frame highlight (sunny side) framelow.n = 112 ; Frame lowlight (shadow side) ENDSWITCH Return ENDPROC ;============================================================================= ; TITLE: hsEngine.u (c) 1992, 1993 DataStar International ; RETURNS: No value ; DESCRIPTION: Main help engine procedure. Expects global dynarray called ; g.help.y to contain tags pointing to procedure created by ; the help compiler the load the necessary text strings into ; the proper arrays. ;----------------------------------------------------------------------------- PROC hsEngine.u( ; Engine for Context Help Dialog System context.a, ; Help procedure DynArray tag g.help.y) ; Help Procedure DynArray Private help.n, ; pick array index colorshelp.y, ; color attributes of dialog box prompts.y, ; prompts on dialog box helptag.a, ; current element seealso.r, ; array of linked topics seealsotitles.r, ; array of linked topic titles title.a, ; current title dbox.w, ; DB window handle pushbutton.l, ; button variable helptext.r, ; array of help text retval.v ; return variable DynArray colorshelp.y[] colorshelp.y[1032] = 116 colorshelp.y[1034] = 15 colorshelp.y[1035] = 15 colorshelp.y[1056] = 112 colorshelp.y[1057] = 112 colorshelp.y[1058] = 112 SetColors From colorshelp.y IF IsAssigned(g.help.y[context.a]) THEN ExecProc g.help.y[context.a] ; This procedure should assign the memovar for help, as well as ; the ShowPullDown Menu ELSE ; Default Help Text and Menu IF IsAssigned(g.help.y["DEFAULT"]) THEN EXECPROC g.help.y["DEFAULT"] ELSE Array helptext.r[31] helptext.r[1] = "" helptext.r[2] = "" helptext.r[3] = " ─── Help on Using the DataStar Help System ──┐" helptext.r[4] = " │" helptext.r[5] = " │" helptext.r[6] = " Help ▄ Brings Up This Screen. │" helptext.r[7] = " ▀▀▀▀▀▀▀▀▀ │" helptext.r[8] = " ┌────────────────────────────────────────────┘" helptext.r[9] = " │" helptext.r[10] = " │" helptext.r[11] = " │ Index ▄ Displays Index of Help Topics." helptext.r[12] = " │ ▀▀▀▀▀▀▀▀▀" helptext.r[13] = " └─────────────────────────────────────────────┐" helptext.r[14] = " │" helptext.r[15] = " │" helptext.r[16] = " SeeAlso ▄ Displays List of Linked Topics │" helptext.r[17] = " ▀▀▀▀▀▀▀▀▀▀ if any Exist. │" helptext.r[18] = " │" helptext.r[19] = " ┌─────────────────────────────────────────────┘" helptext.r[20] = " │" helptext.r[21] = " │" helptext.r[22] = " │ Print ▄ Sends Current Help Screen To" helptext.r[23] = " │ ▀▀▀▀▀▀▀▀▀▀ the Printer." helptext.r[24] = " │" helptext.r[25] = " └─────────────────────────────────────────────┐" helptext.r[26] = " │" helptext.r[27] = " Exit ▄ Exit the Help System Back to │" helptext.r[28] = " ▀▀▀▀▀▀▀▀▀▀ the Application. │" helptext.r[29] = " │" helptext.r[30] = " │" helptext.r[31] = " ──────────────────────────────────────────────┘" Array seealso.r[1] Array seealsotitles.r[1] ENDIF ENDIF DynArray prompts.y[] prompts.y["TEXT"] = "Use Mouse, Cursor Keys or <PgUp>/<PgDn> to Scroll Help Text" prompts.y["HELP"] = "How to Use the Help System" prompts.y["INDEX"] = "Index of Available Help Screens" prompts.y["ALSO"] = "Menu of Related Help Topics" prompts.y["PRINT"] = "Print this Help Screen" prompts.y["BACK"] = "Return to Previous Help Screen" prompts.y["EXIT"] = "Return to what you were doing before Help" retval.v = "" pushbutton.l = false helptag.a = "TEXT" title.a = IIF(IsAssigned(g.helpindex.y[context.a]), g.helpindex.y[context.a], "Application Help System") SHOWDIALOG title.a PROC "hsEngineEP.l" Trigger "ARRIVE","OPEN" ;MJB 1/27/93 @ 2, 3 Height 20 Width 74 PaintCanvas Fill Format("w70,ac",prompts.y[helptag.a]) Attribute 113 17,1,17,70 Frame Single From 0,1 To 14,70 PaintCanvas Border Attribute 127 0,1,14,70 PaintCanvas Attribute 112 0,1,0,69 PaintCanvas Attribute 112 0,1,14,1 PickArray @ 1,2 Height 13 Width 67 helptext.r Tag "TEXT" To help.n PushButton @ 15, 5 Width 8 "~H~elp" Value hsEngineHelp.l() Tag "HELP" To pushbutton.l PushButton @ 15, 17 Width 9 "~I~ndex" Value hsEngineIndex.l(g.helpindex.y) Tag "INDEX" To pushbutton.l PushButton @ 15, 30 Width 12 "~S~ee Also" Value hsEngineSeeAlso.l(seealso.r,seealsotitles.r) Tag "ALSO" To pushbutton.l PushButton @ 15, 46 Width 9 "~P~rint" Value hsEnginePrint.l(helptext.r) Tag "PRINT" To pushbutton.l PushButton @ 15, 59 Width 8 "~E~xit" Cancel Value False Tag "EXIT" To pushbutton.l ENDDIALOG SetColors From g.appcolors.y msWorkingClear.u() Return ENDPROC ;=========================================================================== ; TITLE: hsEngineEP.l ; AUTHOR: (c) 1992 - DataStar International ; RETURNS: Nothing ; DESCRIPTION: Event proc for help engine dialog boxes ;--------------------------------------------------------------------------- PROC hsEngineEP.l( ; Help Engine Event Handler type.a, ; event type or trigger tag.a, ; name of current TAG event.v, ; event bag element.a) ; element for check boxes IF type.a = "OPEN" THEN WINDOW HANDLE DIALOG TO dbox.w ENDIF helptag.a = tag.a RepaintDialog Return true ENDPROC ;=========================================================================== ; TITLE: hsEngineHelp.l (c) 1992, 1993 DataStar International ; RETURNS: Logical true/false if ; DESCRIPTION: ;--------------------------------------------------------------------------- PROC hsEngineHelp.l() ; Help for the Help Engine Private helptext.r, ; array of help text pushbutton.l, ; pushbutton variable help.n, ; pickarray index helptag.a ; current element IF IsAssigned(g.help.y["HELP"]) THEN EXECPROC g.help.y["HELP"] ELSE Array helptext.r[31] helptext.r[1] = "" ;default help text helptext.r[2] = "" helptext.r[3] = " ─── Help on Using the DataStar Help System ──┐" helptext.r[4] = " │" helptext.r[5] = " │" helptext.r[6] = " Help ▄ Brings Up This Screen. │" helptext.r[7] = " ▀▀▀▀▀▀▀▀▀ │" helptext.r[8] = " ┌────────────────────────────────────────────┘" helptext.r[9] = " │" helptext.r[10] = " │" helptext.r[11] = " │ Index ▄ Displays Index of Help Topics." helptext.r[12] = " │ ▀▀▀▀▀▀▀▀▀" helptext.r[13] = " └─────────────────────────────────────────────┐" helptext.r[14] = " │" helptext.r[15] = " │" helptext.r[16] = " SeeAlso ▄ Displays List of Linked Topics │" helptext.r[17] = " ▀▀▀▀▀▀▀▀▀▀ if any Exist. │" helptext.r[18] = " │" helptext.r[19] = " ┌─────────────────────────────────────────────┘" helptext.r[20] = " │" helptext.r[21] = " │" helptext.r[22] = " │ Print ▄ Sends Current Help Screen To" helptext.r[23] = " │ ▀▀▀▀▀▀▀▀▀▀ the Printer." helptext.r[24] = " │" helptext.r[25] = " └─────────────────────────────────────────────┐" helptext.r[26] = " │" helptext.r[27] = " Exit ▄ Exit the Help System Back to │" helptext.r[28] = " ▀▀▀▀▀▀▀▀▀▀ the Application. │" helptext.r[29] = " │" helptext.r[30] = " │" helptext.r[31] = " ──────────────────────────────────────────────┘" Array seealso.r[1] ENDIF helptag.a = "TEXT" SHOWDIALOG "Help on Using Help" PROC "hsEngineEP.l" Trigger "ARRIVE" @ 2, 3 Height 20 Width 74 PaintCanvas Fill Format("w70,ac",prompts.y[helptag.a]) Attribute 113 17,1,17,70 Frame Single From 0,1 To 14,70 PaintCanvas Border Attribute 127 0,1,14,70 PaintCanvas Attribute 112 0,1,0,69 PaintCanvas Attribute 112 0,1,14,1 PickArray @ 1,2 Height 13 Width 67 helptext.r Tag "TEXT" To help.n PushButton @ 15, 24 Width 24 "~P~revious Help Screen" OK Value True Tag "BACK" To pushbutton.l ENDDIALOG Return true ENDPROC ;=========================================================================== ; TITLE: hsEngineIndex.l (c) 1993 - DataStar International ; RETURNS: Logical true ; DESCRIPTION: Help System index. Select with index button on the help DB. ;--------------------------------------------------------------------------- PROC hsEngineIndex.l( ; Help System Index Engine helpindex.y) ; index dynarray Private pushbutton.l, ; button variable y ; window attributes dynarray IF DynarraySize(helpindex.y) = 0 THEN msWorking.u("Sorry, No Help Index is Available in this System",111,2,2) ELSE pushbutton.l = false dynarray y[] SetColors From g.appcolors.y SHOWDIALOG "Select Help Topic" @ 3,17 Height 15 Width 49 ;46 MJB 1/27/93 PickDynArray @ 1,1 Height 9 Width 43 helpindex.y Tag "PICKINDEX" To context.a PushButton @ 11,8 Width 10 "~S~elect" OK Default Value True Tag "INDEXBUTTON" To pushbutton.l PushButton @ 11,26 Width 10 "~C~ancel" Cancel Value False Tag "INDEXBUTTON" To pushbutton.l ENDDIALOG SetColors From colorshelp.y IF pushbutton.l THEN ExecProc g.help.y[context.a] y["Title"] = IIF(IsAssigned(g.helpindex.y[context.a]), g.helpindex.y[context.a], "Application Help System") WINDOW SetAttributes dbox.w FROM y help.n = 1 RefreshDialog SelectControl "TEXT" ENDIF ENDIF Return true ENDPROC ;=========================================================================== ; TITLE: hsEngineSeeAlso.l (c) 1992, 1993 DataStar International ; RETURNS: Logical true/false ; DESCRIPTION: ;--------------------------------------------------------------------------- PROC hsEngineSeeAlso.l( ; Help System See-Also Engine seealso.r, ; Array of module names seealsotitles.r) ; Array of help screen titles Private seealso.v, ; return variable from ioPickArray helptag.a, ; current element retval.l, ; return variable help.n, ; pick array index helptext.r, ; help text array pushbutton.l ; button variable retval.l = true WHILE true IF IsAssigned(seealso.r[1]) THEN SetColors From g.appcolors.y seealso.v = ioPickArrayDialog.v(seealsotitles.r, 43, "Select See Also Help Topic", "Help Topics",3,17,"") SetColors From colorshelp.y IF seealso.v <> "" THEN IF IsAssigned(seealso.r[seealso.v]) THEN EXECPROC "hsHelp" + seealso.r[seealso.v] + ".u" ELSE retval.l = false QUITLOOP ENDIF ELSE QUITLOOP ENDIF ELSE retval.l = false QUITLOOP ENDIF helptag.a = "TEXT" SHOWDIALOG seealsotitles.r[seealso.v] PROC "hsEngineEP.l" Trigger "ARRIVE" @ 2, 3 Height 20 Width 74 PaintCanvas Fill Format("w70,ac",prompts.y[helptag.a]) Attribute 113 17,1,17,70 Frame Single From 0,1 To 14,70 PaintCanvas Border Attribute 127 0,1,14,70 PaintCanvas Attribute 112 0,1,0,69 PaintCanvas Attribute 112 0,1,14,1 PickArray @ 1,2 Height 13 Width 67 helptext.r Tag "TEXT" To help.n PushButton @ 15, 24 Width 24 "~P~revious Help Screen" OK Value True Tag "BACK" To pushbutton.l ENDDIALOG QUITLOOP ENDWHILE IF NOT retval.l THEN msWorking.u("No Links Available for this Topic - Choose <Index>",31, 3, 2) ENDIF Return retval.l ENDPROC ;=========================================================================== ; TITLE: hsEnginePrint.l (c) 1992, 1993 DataStar International ; RETURNS: Logical true/false if ; DESCRIPTION: ;--------------------------------------------------------------------------- PROC hsEnginePrint.l( ; Help System Screen Print helptext.r) ; generic editor handler Private n1, n2, ; counter variables a, ; temp file name file.m, ; memo text stream line.n ; line number counter IF ioPrinterStatus.l() THEN ; test printer msWorking.u("One Moment - Printing Help Screen",31,0,0) n1 = ArraySize(helptext.r) a = PrivDir() + StrVal(Ticks()) file.m = "\n" + Format("w80,ac","Help Screen: " + g.helpindex.y[context.a]) file.m = file.m + "\n" + Spaces(10) + Fill("-",60) + "\n\n" line.n = 3 FOR n2 From 1 To n1 line.n = line.n + 1 file.m = file.m + Spaces(10) + helptext.r[n2] + "\n" IF line.n >= 55 AND line.n <> n1 THEN file.m = file.m + "\012\n\n" line.n = 2 ENDIF ENDFOR file.m = file.m + "\012" FileWrite a FROM file.m OPEN Printer Run NOREFRESH "Copy " + a + " LPT1 > NUL" EDITOR OPEN a DO_IT! CLOSE Printer msWorkingClear.u() ENDIF Return true ENDPROC ; =========================================================================== ; TITLE: hsHelpFind.u ; GENERATED: 4/13/93 - 05:31:38 ; DESCRIPTION: Help Screen: Help on Finding or Locating Data ; --------------------------------------------------------------------------- PROC hsHelpFind.u() ; Help on Locating Data ;Global helptext.r, ; array of Help Text ; seealso.r ; array of See Also Links ; seealsotitles.r ; array of See Also Titles IF NOT IsAssigned(g.helpindex.y) THEN Dynarray g.helpindex.y[] ENDIF g.helpindex.y["FIND"] = "Help on Finding or Locating Data" Array helptext.r[44] Array seealso.r[4] Array seealsotitles.r[4] helptext.r[1] = " There are several ways to search for data." helptext.r[2] = " ────────────────────────────────────────────────────────────────" helptext.r[3] = " While in a table:" helptext.r[4] = "" helptext.r[5] = " 1) [Home] moves to the first record in the table," helptext.r[6] = " [End] moves to the last one." helptext.r[7] = "" helptext.r[8] = " 2) [Ctrl Z] Zooms to the first occurrence of a value for" helptext.r[9] = " the field that you are in." helptext.r[10] = "" helptext.r[11] = " You will be asked to type in a search value." helptext.r[12] = " a) Enter the EXACT value for a case sensitive search." helptext.r[13] = " Example: New York Would not find NEW YORK or new york" helptext.r[14] = "" helptext.r[15] = " b) Use wildcards for a case insensitive search." helptext.r[16] = " @ Any one character." helptext.r[17] = " .. Any string of characters." helptext.r[18] = "" helptext.r[19] = " Examples: ..new.. In a city field would find the first" helptext.r[20] = " field that has the word \"new\" in it." helptext.r[21] = " @.. Finds first field that is not blank." helptext.r[22] = "" helptext.r[23] = " * Note: leave Zoom blank to find the first blank value." helptext.r[24] = "" helptext.r[25] = " 3) [Alt Z] finds the next occurrence of the last Zoom value" helptext.r[26] = " specified." helptext.r[27] = " ────────────────────────────────────────────────────────────────" helptext.r[28] = " Select from the {Image} menu:" helptext.r[29] = "" helptext.r[30] = " Zoom... Same as pressing [Ctrl Z] to Zoom to the first" helptext.r[31] = " occurrence of a value for the current field." helptext.r[32] = "" helptext.r[33] = " ZoomNext Same as pressing [Alt Z] to go to the next" helptext.r[34] = " occurrence of the last value Zoomed in" helptext.r[35] = " this field." helptext.r[36] = "" helptext.r[37] = " Record #... Enter a specific record number to move to." helptext.r[38] = "" helptext.r[39] = " +# records... Specify the number of records to move forward" helptext.r[40] = " in the table." helptext.r[41] = "" helptext.r[42] = " -# records... Specify the number of records to move backward" helptext.r[43] = " in the table." helptext.r[44] = " ════════════════════════════════════════════════════════════════" seealso.r[1] = "HELP" seealsotitles.r[1] = "Help on Using Help" seealso.r[2] = "KEYS" seealsotitles.r[2] = "Help Using The Keyboard" seealso.r[3] = "MENUS" seealsotitles.r[3] = "Help Using Application Menus" seealso.r[4] = "MOUSE" seealsotitles.r[4] = "Help for Using Your Mouse" Return ENDPROC ; =========================================================================== ; TITLE: hsHelpHelp.u ; GENERATED: 4/13/93 - 05:31:47 ; DESCRIPTION: Help Screen: Help on Using Help ; --------------------------------------------------------------------------- PROC hsHelpHelp.u() ; Help on using Help ;Global helptext.r, ; array of Help Text ; seealso.r ; array of See Also Links ; seealsotitles.r ; array of See Also Titles IF NOT IsAssigned(g.helpindex.y) THEN Dynarray g.helpindex.y[] ENDIF g.helpindex.y["HELP"] = "Help on Using Help" Array helptext.r[31] Array seealso.r[4] Array seealsotitles.r[4] helptext.r[1] = "" helptext.r[2] = "" helptext.r[3] = " ─── Help on Using the DataStar Help System ──┐" helptext.r[4] = " │" helptext.r[5] = " │" helptext.r[6] = " Help ▄ Brings Up This Screen. │" helptext.r[7] = " ▀▀▀▀▀▀▀▀▀ │" helptext.r[8] = " ┌────────────────────────────────────────────┘" helptext.r[9] = " │" helptext.r[10] = " │" helptext.r[11] = " │ Index ▄ Displays Index of Help Topics." helptext.r[12] = " │ ▀▀▀▀▀▀▀▀▀" helptext.r[13] = " └─────────────────────────────────────────────┐" helptext.r[14] = " │" helptext.r[15] = " │" helptext.r[16] = " SeeAlso ▄ Displays List of Linked Topics │" helptext.r[17] = " ▀▀▀▀▀▀▀▀▀▀ if any Exist. │" helptext.r[18] = " │" helptext.r[19] = " ┌─────────────────────────────────────────────┘" helptext.r[20] = " │" helptext.r[21] = " │" helptext.r[22] = " │ Print ▄ Sends Current Help Screen To" helptext.r[23] = " │ ▀▀▀▀▀▀▀▀▀▀ the Printer." helptext.r[24] = " │" helptext.r[25] = " └─────────────────────────────────────────────┐" helptext.r[26] = " │" helptext.r[27] = " Exit ▄ Exit the Help System Back to │" helptext.r[28] = " ▀▀▀▀▀▀▀▀▀▀ the Application. │" helptext.r[29] = " │" helptext.r[30] = " │" helptext.r[31] = " ──────────────────────────────────────────────┘" seealso.r[1] = "FIND" seealsotitles.r[1] = "Help on Finding or Locating Data" seealso.r[2] = "KEYS" seealsotitles.r[2] = "Help Using The Keyboard" seealso.r[3] = "MENUS" seealsotitles.r[3] = "Help Using Application Menus" seealso.r[4] = "MOUSE" seealsotitles.r[4] = "Help for Using Your Mouse" Return ENDPROC ; =========================================================================== ; TITLE: hsHelpKeys.u ; GENERATED: 4/13/93 - 05:32:05 ; DESCRIPTION: Help Screen: Help Using The Keyboard ; --------------------------------------------------------------------------- PROC hsHelpKeys.u() ; Help on using Keyboard ;Global helptext.r, ; array of Help Text ; seealso.r ; array of See Also Links ; seealsotitles.r ; array of See Also Titles IF NOT IsAssigned(g.helpindex.y) THEN Dynarray g.helpindex.y[] ENDIF g.helpindex.y["KEYS"] = "Help Using The Keyboard" Array helptext.r[96] Array seealso.r[4] Array seealsotitles.r[4] helptext.r[1] = " ════════════════════════════════════════════════════════════════" helptext.r[2] = " Cursor keys:" helptext.r[3] = "" helptext.r[4] = " [Up] Next field up" helptext.r[5] = " [Down] Next field down" helptext.r[6] = " [Home] First record" helptext.r[7] = " [Ctrl Home] First field of form or table" helptext.r[8] = " [End] Last record" helptext.r[9] = " [Ctrl End] Last field of form or table" helptext.r[10] = " [Left] Previous field left" helptext.r[11] = " [Ctrl Left] Previous screen left" helptext.r[12] = " [Right] Next field right" helptext.r[13] = " [Ctrl Right] Next screen right" helptext.r[14] = " [PgUp] Next screen up" helptext.r[15] = " [Ctrl PgUp] Previous record, same field" helptext.r[16] = " [PgDn] Next screen down" helptext.r[17] = " [Ctrl PgDn] Next record, same field" helptext.r[18] = " ────────────────────────────────────────────────────────────────" helptext.r[19] = " Special keys:" helptext.r[20] = "" helptext.r[21] = " [Esc] Exit table or menu" helptext.r[22] = " [F10] Activate menu" helptext.r[23] = " [Alt F10] Activate popup menu" helptext.r[24] = " [Alt Space] Select system menu choice (≡)" helptext.r[25] = " [F1] Field help if available" helptext.r[26] = " [F3] UpImage" helptext.r[27] = " [F4] DownImage" helptext.r[28] = " [F7] FormToggle" helptext.r[29] = " [Backspace] Delete character left of cursor" helptext.r[30] = " [Ctrl Backspace] Delete field" helptext.r[31] = " [Ctrl D] Ditto (copy field from previous record)" helptext.r[32] = " [Ctrl Z] Zoom to first occurrence of value" helptext.r[33] = " [Alt Z] ZoomNext" helptext.r[34] = " [Alt S] Set table sort order based on current field" helptext.r[35] = " [Shift F5] Maximize/Restore current window" helptext.r[36] = " [Ctrl F5] Move/Resize current window" helptext.r[37] = " [Ctrl F3] Go to previous window" helptext.r[38] = " [Ctrl F4] Go to next window" helptext.r[39] = " [Ctrl F8] Close current window" helptext.r[40] = " [Ctrl U] Undo last change to field or record" helptext.r[41] = " ────────────────────────────────────────────────────────────────" helptext.r[42] = " To allow cursor movement within a field (FieldView)," helptext.r[43] = " press [Ctrl F] or [Alt F5]." helptext.r[44] = " Cursor keys while in FieldView in a Regular field:" helptext.r[45] = "" helptext.r[46] = " [Left] One character left" helptext.r[47] = " [Ctrl Left] One word left" helptext.r[48] = " [Right] One character right" helptext.r[49] = " [Ctrl Right] One word right" helptext.r[50] = " [Home] First character in field" helptext.r[51] = " [End] Last character in field" helptext.r[52] = " [Del] Delete character at cursor" helptext.r[53] = " [Ins] Toggle insert mode on/off" helptext.r[54] = " ────────────────────────────────────────────────────────────────" helptext.r[55] = " Cursor keys while in a Memo or Editor window:" helptext.r[56] = "" helptext.r[57] = " [Left] One character left" helptext.r[58] = " [Ctrl Left] One word left" helptext.r[59] = " [Shift Left] Select one character left" helptext.r[60] = " [Ctrl Shift Left] Select one word left" helptext.r[61] = " [Right] One character right" helptext.r[62] = " [Ctrl Right] One word right" helptext.r[63] = " [Shift Right] Select one character right" helptext.r[64] = " [Ctrl Shift Right] Select one word right" helptext.r[65] = " [Home] First character of line" helptext.r[66] = " [Shift Home] Select from cursor to start of line" helptext.r[67] = " [End] Last character of line" helptext.r[68] = " [Shift End] Select from cursor to end of line" helptext.r[69] = " [Up] Up one line" helptext.r[70] = " [Shift Up] Select one line up" helptext.r[71] = " [Down] Down one line" helptext.r[72] = " [Shift Down] Select one line down" helptext.r[73] = " [PgUp] Up one screen" helptext.r[74] = " [Ctrl PgUp] First character of memo" helptext.r[75] = " [Shift PgUp] Select from cursor up one screen" helptext.r[76] = " [Ctrl Shift PgUp] Select from cursor to first character of memo" helptext.r[77] = " [PgDn] Down one screen" helptext.r[78] = " [Ctrl PgDn] Last character of memo" helptext.r[79] = " [Shift PgDn] Select from cursor down one screen" helptext.r[80] = " [Ctrl Shift PgDn] Select from cursor to last character of memo" helptext.r[81] = " [Del] Delete selected text or character at cursor" helptext.r[82] = " [Ins] Toggle insert mode on/off" helptext.r[83] = " ────────────────────────────────────────────────────────────────" helptext.r[84] = " Text editing keys while in a Memo or Editor window:" helptext.r[85] = "" helptext.r[86] = " [Ctrl Del] Cut selected text to Clipboard" helptext.r[87] = " [Ctrl Ins] Copy selected text to Clipboard" helptext.r[88] = " [Shift Ins] Paste Clipboard contents at cursor position" helptext.r[89] = " [Alt D] Delete from cursor position to end of word" helptext.r[90] = " [Ctrl Y] Delete entire cursor line" helptext.r[91] = " [Ctrl Z] Find a value" helptext.r[92] = " [Alt Z] Find next value" helptext.r[93] = " [Ctrl A] Replace a value with another value" helptext.r[94] = " [Alt A] Replace next value with replacement value" helptext.r[95] = " [Alt W] Show cursor position" helptext.r[96] = " ════════════════════════════════════════════════════════════════" seealso.r[1] = "FIND" seealsotitles.r[1] = "Help on Finding or Locating Data" seealso.r[2] = "HELP" seealsotitles.r[2] = "Help on Using Help" seealso.r[3] = "MENUS" seealsotitles.r[3] = "Help Using Application Menus" seealso.r[4] = "MOUSE" seealsotitles.r[4] = "Help for Using Your Mouse" Return ENDPROC ; =========================================================================== ; TITLE: hsHelpMenus.u ; GENERATED: 4/13/93 - 05:32:21 ; DESCRIPTION: Help Screen: Help Using Application Menus ; --------------------------------------------------------------------------- PROC hsHelpMenus.u() ; Help on using Menus ;Global helptext.r, ; array of Help Text ; seealso.r ; array of See Also Links ; seealsotitles.r ; array of See Also Titles IF NOT IsAssigned(g.helpindex.y) THEN Dynarray g.helpindex.y[] ENDIF g.helpindex.y["MENUS"] = "Help Using Application Menus" Array helptext.r[30] Array seealso.r[4] Array seealsotitles.r[4] helptext.r[1] = " ════════════════════════════════════════════════════════════════" helptext.r[2] = " A menu presents you with a list of options." helptext.r[3] = "" helptext.r[4] = " To activate the menu, press [F10]." helptext.r[5] = " To activate the special popup menu, press [Alt F10] or click" helptext.r[6] = " the right mouse button." helptext.r[7] = "" helptext.r[8] = " Choices which are not currently available are grayed out." helptext.r[9] = " Each menu choice has a descriptive line attached to it." helptext.r[10] = " ────────────────────────────────────────────────────────────────" helptext.r[11] = " There are three ways to select a menu choice:" helptext.r[12] = "" helptext.r[13] = " 1) Press the first letter of the menu selection." helptext.r[14] = "" helptext.r[15] = " 2) Use the cursor keys to highlight the menu choice," helptext.r[16] = " then press [Enter]." helptext.r[17] = " (When a menu choice is highlighted, it displays a" helptext.r[18] = " descriptive help line at the bottom of the screen.)" helptext.r[19] = "" helptext.r[20] = " 3) Mouse click on the menu selection." helptext.r[21] = "" helptext.r[22] = " To escape from the menu, returning to whatever you were doing" helptext.r[23] = " before you asked for it, press [Esc] or mouse click outside of" helptext.r[24] = " the menu area." helptext.r[25] = " ────────────────────────────────────────────────────────────────" helptext.r[26] = " Special keys for menus:" helptext.r[27] = "" helptext.r[28] = " [Home] Move to the first menu selection" helptext.r[29] = " [End] Move to the last menu selection" helptext.r[30] = " ════════════════════════════════════════════════════════════════" seealso.r[1] = "FIND" seealsotitles.r[1] = "Help on Finding or Locating Data" seealso.r[2] = "HELP" seealsotitles.r[2] = "Help on Using Help" seealso.r[3] = "KEYS" seealsotitles.r[3] = "Help Using The Keyboard" seealso.r[4] = "MOUSE" seealsotitles.r[4] = "Help for Using Your Mouse" Return ENDPROC ; =========================================================================== ; TITLE: hsHelpMouse.u ; GENERATED: 4/13/93 - 05:32:36 ; DESCRIPTION: Help Screen: Help for Using Your Mouse ; --------------------------------------------------------------------------- PROC hsHelpMouse.u() ; Help on using Mouse ;Global helptext.r, ; array of Help Text ; seealso.r ; array of See Also Links ; seealsotitles.r ; array of See Also Titles IF NOT IsAssigned(g.helpindex.y) THEN Dynarray g.helpindex.y[] ENDIF g.helpindex.y["MOUSE"] = "Help for Using Your Mouse" Array helptext.r[70] Array seealso.r[4] Array seealsotitles.r[4] helptext.r[1] = " ════════════════════════════════════════════════════════════════" helptext.r[2] = " All application functions can be accessed with the mouse." helptext.r[3] = " ────────────────────────────────────────────────────────────────" helptext.r[4] = " Mouse Actions:" helptext.r[5] = "" helptext.r[6] = " Click Press and release a mouse button quickly." helptext.r[7] = " Double-Click Rapidly press and release a mouse button" helptext.r[8] = " twice without moving the mouse." helptext.r[9] = " Drag Press a mouse button and hold it down" helptext.r[10] = " while moving the mouse." helptext.r[11] = " ────────────────────────────────────────────────────────────────" helptext.r[12] = " To activate the special popup menu of actions for the table or" helptext.r[13] = " window you are currently on, click the right mouse button." helptext.r[14] = "" helptext.r[15] = " To move to a field or select from a menu, click on the field" helptext.r[16] = " or choice you want." helptext.r[17] = "" helptext.r[18] = " To enter FieldView, double-click on the field (same as pressing" helptext.r[19] = " [Alt F5] or [Ctrl F])." helptext.r[20] = " ────────────────────────────────────────────────────────────────" helptext.r[21] = " Window Controls:" helptext.r[22] = "" helptext.r[23] = " Click anywhere on a window to make it current. The current" helptext.r[24] = " window has a highlighted double-line border. Inactive windows" helptext.r[25] = " have a single-line border and are not highlighted." helptext.r[26] = " Drag on the top line to move a window." helptext.r[27] = "" helptext.r[28] = " ┌───────────────────────── Close window (same as [Ctrl F8])." helptext.r[29] = " │" helptext.r[30] = " │ ┌──────────────── Restore window to previous size" helptext.r[31] = " ╔[■]══════[]╗ and position, if Maximized, or" helptext.r[32] = " ║── │ ── │ ─ ▒ ┌──── Maximize (same as [Shift F5])." helptext.r[33] = " ║── │ ── │ ─ ▒ ╔[■]══[]╗ Also double-click on top line." helptext.r[34] = " ║── │ ── │ ─ ▒ ║── │ ── ▒" helptext.r[35] = " ╚══════▒▒▒▒▒─┘ ╚══▒▒▒▒▒─┘── Drag to Resize window" helptext.r[36] = " (same as [Ctrl F5])." helptext.r[37] = " ────────────────────────────────────────────────────────────────" helptext.r[38] = " SpeedBar Buttons:" helptext.r[39] = "" helptext.r[40] = " ┌ Drag on the handle to reposition the SpeedBar." helptext.r[41] = " │" helptext.r[42] = " │ ┌─── Move to the previous record (same as [Up] in" helptext.r[43] = " │ │ TableView or [CtrlPgUp] in FormView)." helptext.r[44] = " │ │" helptext.r[45] = " │ │ ┌ Move to the next record (same as [Down] in" helptext.r[46] = " │ │ │ TableView or [CtrlPgDn] in FormView)." helptext.r[47] = " │ │ │" helptext.r[48] = " │ ┌───────┼──┼──────── Move to the first record" helptext.r[49] = " │ │ │ │ (same as [Home])." helptext.r[50] = " │ │ │ │" helptext.r[51] = " │ │ │ │ ┌ Move to the last record" helptext.r[52] = " │ │ │ │ │ (same as [End])." helptext.r[53] = " ╠═(|)()(─)(─)()(|)(F1)── Same as pressing [F1]." helptext.r[54] = " │ └ Move to the next group of records for" helptext.r[55] = " │ master tables in TableView and" helptext.r[56] = " │ multi-record detail tables in FormView" helptext.r[57] = " │ (same as [PgDn]). Move ahead by the" helptext.r[58] = " │ specified number of records for" helptext.r[59] = " │ master tables in FormView." helptext.r[60] = " │" helptext.r[61] = " └─────────── Move to the previous group of records" helptext.r[62] = " for master tables in TableView and" helptext.r[63] = " multi-record detail tables in FormView" helptext.r[64] = " (same as [PgUp]). Move back by the" helptext.r[65] = " specified number of records for master" helptext.r[66] = " tables in FormView." helptext.r[67] = "" helptext.r[68] = " Right-click on the SpeedBar to set the button style," helptext.r[69] = " orientation and number of records to move for () and ()." helptext.r[70] = " ════════════════════════════════════════════════════════════════" seealso.r[1] = "FIND" seealsotitles.r[1] = "Help on Finding or Locating Data" seealso.r[2] = "HELP" seealsotitles.r[2] = "Help on Using Help" seealso.r[3] = "KEYS" seealsotitles.r[3] = "Help Using The Keyboard" seealso.r[4] = "MENUS" seealsotitles.r[4] = "Help Using Application Menus" Return ENDPROC ; ============================================================================ ; TITLE: inAllFieldsChecked.l() (c) 1991 - 1993 DataStar International ; RETURNS: Logical true/false if all fields are checked ; DESCRIPTION: Checks all query fields to determine if all have a positive ; check mark (check, checkplus or groupby) ; ---------------------------------------------------------------------------- PROC inAllFieldsChecked.l( : Used by quPAL.u - Checks Checked Fields fieldorder.r, ; Sequential order of fields checkstatus.y, ; Check mark status of the field columns.n) ; Number of columns in the image Private firstcheck.a, ; Status of the first field retval.l, ; Return variable n ; Transient loop counter firstcheck.a = checkstatus.y[fieldorder.r[2]] retval.l = false IF NOT IsBlank(firstcheck.a) THEN retval.l = true FOR n From 2 To columns.n IF firstcheck.a <> checkstatus.y[fieldorder.r[n]] THEN retval.l = false QUITLOOP ENDIF ENDFOR ENDIF Return retval.l ENDPROC ; ============================================================================ ; TITLE: inAttributeConvert.n (c) 1991 - 1993 DataStar International ; RETURNS: Color attribute ; DESCRIPTION: Returns either the intense foreground of a background color if ; highlight.l = true, else black on background color. ; ---------------------------------------------------------------------------- PROC inAttributeConvert.n( ; Converts color into highlight or lowlight color.n, ; Background color highlight.l) ; True=highlight, false=lowlight Return (Int(color.n/16)*16) + IIF(highlight.l,Int(color.n/16)+8,0) ENDPROC ; ============================================================================ ; TITLE: inBackSlashDouble.a (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Doubles backslashes in a String ; ---------------------------------------------------------------------------- PROC inBackSlashDouble.a( ; Doubles backslashes in a string path.a) ; Path to double Private a1, a2, a3 ; Transient string variables a1 = path.a a2 = "" WHILE Match(a1,"..\\..",a3,a1) a2 = a2 + a3 +"\\\\" ENDWHILE Return IIF(a1 = path.a, path.a, a2 + a1) ENDPROC ; ============================================================================ ; TITLE: inBackSlashQuotes.a (c) 1991 - 1993 DataStar International ; RETURNS: String with backslash preceding all embedded quotes ; DESCRIPTION: Adds escape characters (backslashes) to quoted strings ; ---------------------------------------------------------------------------- PROC inBackSlashQuotes.a( ; Adds backslashes preceding quotes string.a) ; String to process Private len.n, ; Origional length of string n ; Loop counter IF Search("\"",string.a) > 0 THEN len.n = Len(string.a) FOR n From len.n To 1 Step -1 ; Step backwords to account for IF SubStr(string.a,n,1) = "\"" THEN ; increasing length of string string.a = SubStr(string.a,1,n-1) + "\\" + SubStr(string.a,n,Len(string.a)) ENDIF ENDFOR ENDIF Return string.a ENDPROC ; ============================================================================ ; TITLE: inErrorHandler.n (c) 1991 - 1993 DataStar International ; RETURNS: Error Continuation Code ; DESCRIPTION: Main Error Handling Procedure - calls inErrorLog.u ; The initial switch deals with specific errors, and attempts ; to continue the application. You should do this only when ; you are sure it won't end up breaking something else (e.g. ; If you continue from a query error, and later code expects ; that the query will have performed successfully, you are ; just postponing the inevitable. That is one reason to use a ; Query Execute procedure, so that you can interrupt the ; process in the event of an error. ; ---------------------------------------------------------------------------- PROC inErrorHandler.n() ; Main Error Handler Private errorproc, ; Keeps errorproc from being recursive error.y, ; DynArray from ErrorInfo message.a, ; Formatted message to user script.a, ; Concatonated re-named Savevars.sc errorwin.a, ; Paradox Window() a, ; Counter for FOREACH command windows.r, ; Array of Windows from WINDOW LIST n1, n2 ; Transient Loop Counters ;Global g.sysinfo.y ; System info dynarray ; g.debug.l ; Development DEBUG flag ; g.y ; Dynarray of Passwords ; g.startmemleft.n ; Memory at Startup ; error.l ; Error flag passed back to routine errorwin.a = Window() ; Capture the Paradox Window IF NImages() > 0 AND ImageType() <> "Query" THEN SetBatch Off ; Just in case ENDIF ErrorInfo to error.y ; Capture the error info bag retval.n = 2 ; Initialize returned value SWITCH CASE error.y["Proc"] = "WSDITTO.U" : msContinue!.u("","You cannot ditto " + StrVal(record.r[Field()]) + " - " + errorwin.a,79,"RED",1) retval.n = 1 ; Ignore Ditto CASE error.y["Proc"] = "WSFIELDVIEW.U" AND error.y["Code"] = 23 : msContinue!.u("","The Field Value does not satisfy current validity " + "checks. Current field value is: " + StrVal([]),30,"BLUE",1) error.l = True ; Set error flag retval.n = 1 ; Step over the []=[] assignment CASE error.y["Proc"] = "WSPICKFORM.L" : error.l = True ; Set error flag msContinue!.u("",error.y["Message"],79,"RED",1) retval.n = 1 CASE error.y["Proc"] = "WSCOPYFROMARRAY.U" : SWITCH CASE (error.y["Code"] = 60 AND Match (error.y["Message"],"..linked fields in ..") OR Match (error.y["Message"],"..master record is blank..")) OR (error.y["Code"] = 23 AND Match(error.y["Message"],"..value must be provided..")): retval.n = 1 CASE error.y["Code"] = 23 AND MATCH(error.y["Message"],"..not one of the possible value.."): wsCopyFromArrayRecover.u(arrayname.a) ENDSWITCH CASE error.y["Code"] = 23 AND ImageType() = "Query" AND error.y["Proc"] = "QUEXECUTE.L" : a = [] CtrlBackSpace ; Eliminate offending expression msContinue!.u("","","The invalid query criterion: " + a + " was deleted from the " + Field() + " field," + " so that the Query could continue.",31,"BLUE",1) retval.n = 1 ; Skip over error command CASE error.y["Code"] = 34 AND Search("procedure",error.y["Message"]) <> 0 : SWITCH CASE Search("!",error.y["Message"]) <> 0 : error.l = true retval.n = 1 CASE Search("help",error.y["Message"]) <> 0 : helpchoice.a = "HELP" helpmenu.a = "DEFAULT" retval.n = 0 ENDSWITCH CASE error.y["Code"] = 27 ; Using quExecute.l proc AND ImageType() = "Query" AND error.y["Proc"] = "QUEXECUTE.L" : error.l = true ; Set Query Error flag retval.n = 1 ; Skip over error command CASE error.y["Code"] = 27 ; Not using quExecute.l proc AND ImageType() = "Query" : msContinue!.u("","Query Error - " +Window(),79,"RED",3) retval.n = 1 ; Skip over error command CASE error.y["Code"] = 27 : msContinue!.u("","Sorry, the Query could NOT be Completed",79,"RED",3) retval.n = 1 ; Skip over error command CASE error.y["Code"] = 43 OR error.y["Message"] = "Printer not ready" : ioPrinterStatus.l() IF retval THEN retval.n = 0 ELSE retval.n = 1 ENDIF CASE error.y["Proc"] = "INSTARTUP.L" AND error.y["Code"] = 11 : ; PrivDir conflict retval.n = 1 CASE error.y["Proc"] = "INERRORRESET.U" AND error.y["Code"] = 30 : ; ErrorReset retval.n = 1 ENDSWITCH IF retval.n = 2 THEN ; Error still not resolved Echo OFF password.a = "" ; Deassign any password variables IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo to g.sysinfo.y ; Capture System Info ENDIF IF g.sysinfo.y["UIMode"] = "COMPATIBLE" THEN Canvas ON ; Just in case ENDIF IF IsAssigned(g.y) THEN ; Deassign any password variables FOREACH a In g.y UnPassword g.y[a] g.y[a] = "********" ENDFOREACH ENDIF IF IsAssigned(g.a) THEN UnPassword g.a g.a = "********" ENDIF IF IsAssigned(t.a) THEN UnPassword t.a t.a = "********" ENDIF IF IsAssigned(chars.a) THEN chars.a = "********" ENDIF IF NOT Match(error.y["Message"],"..run Error..",a,message.a) THEN IF NOT Match(error.y["Message"],"..Syntax Error..",a,message.a) THEN message.a = error.y["Message"] ENDIF ENDIF msWorking.u(message.a,79,0,0) IF NOT IsAssigned(g.debug.l) OR NOT g.debug.l THEN msContinue!.u("","Error in Procedure: " + error.y["Proc"] + " - " + message.a,79,"RED",4) IF DirExists("ERR") = 0 THEN ; Create an ERR directory if none Run NOREFRESH "MD ERR" ; Store error logs in separate Dir ENDIF ; Log the error info script.a = "ERR\\"+StrVal(Ticks()) ; Easy Unique Name inErrorLog.u(error.y,g.sysinfo.y) ; Log the error to disk and printer msWorking.u("Saving Current Variable Assignments to Disk",110,0,0) SaveVars ALL ; Rename Savevars.sc for posterity IF Sysmode() <> "Main" Then RUN NOREFRESH "REN "+PrivDir()+"savevars.sc "+Directory()+"\\"+script.a ELSE {Tools} {Rename} {Script} Select "Savevars" Select script.a IF MenuChoice() = "Cancel" THEN ; VERY unlikely {Replace} ENDIF ENDIF ELSE msContinue!.u("","Error in Procedure: " + error.y["Proc"],79, "RED",1) ENDIF msWorkingClear.u() ; Removes message window IF NOT IsAssigned(g.debug.l) OR NOT g.debug.l THEN msContinue!.u("","Log Complete - Please Contact Technical Support", 31,"BLUE",1) Reset {Tools} {More} {Protect} {Clearpasswords} SetColors DEFAULT EXIT ELSE ; Allow access to DEBUG prompt msConfirm!.l("","IF <Debug>, Use <Ctrl><T> to Trace Back to Error",79, "RED",3,"~D~ebug","~C~ancel",true) IF retval THEN msConfirm!.l("","Maintain Context, or Display SAVEVARS?",63, "CYAN",1,"~C~ontext","~S~avevars",true) IF NOT retval THEN CancelDialog Window List To windows.r n1 = ArraySize(windows.r) FOR n2 From 1 To n1 IF IsWindow(windows.r[n2]) THEN Window Select windows.r[n2] Window Close ENDIF ENDFOR SaveVars All Editor Open PrivDir() + "Savevars.sc" ENDIF Debug ; Must <Ctrl><T> back to error retval.n = 0 ELSE Reset {Tools} {More} {Protect} {Clearpasswords} SetColors DEFAULT QUIT "You have Canceled the Application from the Error Prompt..." ENDIF ENDIF ELSE PROC epErrorReset.n() ; Reset the ErrorCode Private errorproc Return 1 ENDPROC errorproc = "epErrorReset.n" ; Specialized errorproc retval = 1 + "A" ; Create errorcode 30 errorproc = "" ; Deassign errorproc Release Procs epErrorReset.n ; Release procedure ENDIF Return retval.n ; 0, 1 or 2 ENDPROC ; ============================================================================ ; TITLE: inErrorLog.u (c) 1991 - 1993 DataStar International ; RETURNS: No value ; DESCRIPTION: Error Logging Procedure - called by inErrorHandler.n ; Creates a Memo Variable and writes it to disk from the ; contents of error.y (ErrorInfo, SysInfo & selected info). ; ---------------------------------------------------------------------------- PROC inErrorLog.u( ; Logs Error to file and printer error.y, ; ErrorInfo DynArray g.sysinfo.y) ; SysInfo DynArray Private a, ; Tag of error.y in FOREACH loop error.m ; Memo variable holding errorlog ;Global g.debug.l ; Development DEBUG flag msWorking.u("An Error has occurred, please wait while it is logged",79,3,0) error.y["Date of Error"] = Today() error.y["Working Directory"] = Directory() error.y["Working Drivespace"] = DriveSpace(SubStr(Directory(),1,1)) error.y["Current MemLeft"] = MemLeft() error.y["Private Directory"] = PrivDir() error.y["Private Drivespace"] = DriveSpace(SubStr(PrivDir(),1,1)) error.y["Printer Status"] = Format("LO",PrinterStatus()) error.y["RunTime"] = Format("LY",IsRunTime()) error.y["Current SysMode"] = SysMode() error.y["Time of Error"] = Time() error.y["Paradox version"] = Version() error.y["Paradox Build"] = g.sysinfo.y["Build"] error.y["Current Extended Memory"] = g.sysinfo.y["Extended"] error.y["Current Expanded Memory"] = g.sysinfo.y["Expanded"] error.y["Mouse Available"] = g.sysinfo.y["Mouse"] error.y["Screen Height"] = StrVal(g.sysinfo.y["ScreenHeight"]) + " Rows" error.y["Screen Width"] = StrVal(g.sysinfo.y["ScreenWidth"]) + " Columns" error.y["UI Mode"] = g.sysinfo.y["UIMode"] IF NImages() <> 0 THEN ; occurred on image on workspace error.y["Number of Images"] = NImages() error.y["Current Table"] = Table() error.y["Current Image Type"] = ImageType() error.y["Current Field"] = Field() IF ImageType() = "Display" THEN error.y["Current Field Value"] = IIF(NImageRecords() <> 0,[],"No Records Present") ELSE error.y["Current Field Value"] = [] ENDIF error.y["Shared Table"] = IsShared(Table()) IF error.y["Current Image Type"] = "Query" THEN IF CheckMarkStatus() <> "" THEN ; store checkmark if appropriate error.y["Current Field Value"] = CheckMarkStatus()+" "+[] ENDIF error.y["Formview"] = "N/A" error.y["Record Number"] = "N/A" ELSE error.y["Formview"] = Format("LN",IsFormView()) error.y["Record Number"] = RecNo() ENDIF error.y["Number of Records"] = NRecords(TABLE()) ELSE ; not in an image error.y["Number of Images"] = "N/A" error.y["Current Table"] = "N/A" error.y["Current Image Type"] = "N/A" error.y["Current Field"] = "N/A" error.y["Current Field Value"] = "N/A" error.y["Shared Table"] = "N/A" error.y["Number of Records"] = "N/A" error.y["Formview"] = "N/A" error.y["Record Number"] = "N/A" ENDIF IF IsAssigned(g.sysinfo.y["Starting MemLeft"]) THEN error.y["Starting MemLeft"] = g.sysinfo.y["Starting MemLeft"] ELSE error.y["Starting MemLeft"] = "UA" ENDIF IF error.y["User"] = "" THEN error.y["User"] = "N/A" ENDIF error.m = Fill("-",80) + "\n" + Format("w80,ac","*** Error while in Procedure " + error.y["Proc"] + " ***") + "\n" + Spaces(8) + "Error: #" + StrVal(error.y["Code"]) + " - " + error.y["Message"] + "\n" + Spaces(8) + Fill("-",64) + "\n" FOREACH a In error.y error.m = error.m + Format("w31,ar",a) + ": " + StrVal(error.y[a]) + "\n" ENDFOREACH ; Write memo variable to diskfile msWorking.u("Writing Error Log to Disk",31,0,0) FileWrite APPEND "ERR\\Errorlog.sc" From error.m IF NOT IsAssigned(g.debug.l) OR NOT g.debug.l THEN IF PrinterStatus() THEN ; prints log if printer is available msWorking.u("Writing Error Log to Printer",111,0,0) Open PRINTER FileWrite PrivDir()+"Errorlog" FROM error.m RUN NoRefresh "Copy "+PrivDir()+"Errorlog LPT1 > NUL" Editor New PrivDir()+"Errorlog" {Cancel} {Yes} Close PRINTER ENDIF ENDIF Return ENDPROC ; ============================================================================ ; TITLE: ioAcceptDialog.v (c) 1991 - 1993 DataStar International ; RETURNS: Value Entered, or false if Cancelled ; DESCRIPTION: Generic routine for accepting data from user, with or without ; a Picture or Default value, Hidden or unhidden. ; ---------------------------------------------------------------------------- PROC ioAcceptDialog.v( ; One value DialogBox Accept top.n, ; Top Row for Box (999 = Centered) left.n, ; Left Column (999 = Centered) title.a, ; Title for dBox prompt.a, ; Data Input Prompt type.a, ; Type of Data Input picture.a, ; Additional validity string default.v, ; Any Default for the Accept Value? hidden.l, ; Hidden, or not? colors.y) ; DynArray of Colors Private width.n, ; Width of Dialog Box length.n, ; Length of Input right.n, ; Right edge of Box input.v, ; Value entered by user oldcolors.y, ; Previous Color Set accept.v, ; Variable to capture Accept spot.n, ; Where to begin Prompt pbutton.a ; Pushbutton variable ;Global g.sysinfo.y IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo To g.sysinfo.y ; Determine Screen Size ENDIF IF NOT IsAssigned(g.appcolors.y) THEN GetColors To g.appcolors.y ENDIF IF g.sysinfo.y["UIMode"] = "COMPATIBLE" THEN accept.v = ioCanvasAccept.v(top.n, left.n, 79, prompt.a, type.a, IIF(IsBlank(picture.a),"", "Picture \""+picture.a+"\"")) ELSE IF Len(prompt.a) > 50 THEN ; Must keep to a reasonable length accept.v = false Message "ERROR - Prompt is too Long!!!" Beep Beep Beep Sleep 5000 ELSE IF Type(colors.y) = "DY" THEN ; Must be a DynArray, or else ignore SetColors From colors.y ENDIF SWITCH ; Determine length of Accept Datatype CASE type.a = "D" : ; Set Default value to passed value length.n = 11 ; or a blank value if none passed accept.v = IIF(IsBlank(default.v),BlankDate(),default.v) CASE type.a = "N" OR type.a = "$" : length.n = 20 accept.v = IIF(IsBlank(default.v),BlankNum(),default.v) CASE type.a = "S" : length.n = 8 accept.v = IIF(IsBlank(default.v),BlankNum(),default.v) OTHERWISE : length.n = NumVal(SubStr(type.a,2,3)) + 3 accept.v = default.v ENDSWITCH ; Are we beyond 80 column screen width? IF length.n + Len(prompt.a) > 69 THEN length.n = 69 - Len(prompt.a) spot.n = 1 ENDIF width.n = Min(74,Max(32,Max(Len(title.a)+10,length.n+Len(prompt.a)+5))) IF NOT IsAssigned(spot.n) THEN ; Calculate starting spot if needed spot.n = Int((width.n - 3 - length.n - Len(prompt.a))/2) ENDIF IF IsBlank(picture.a) THEN ; Set "global" Picture if none passed IF type.a = "D" THEN ; Dates are tricky! picture.a = "{"+StrVal(Month(Today()))+",#[#]}"+"/"+ "{"+StrVal(Day(Today()))+",#[#]}"+"/"+ "{"+SubStr(StrVal(Year(Today())),3,2)+",#[#[#[#]]]}" ELSE picture.a = "*@" ENDIF ENDIF top.n = IIF(top.n = 999, Int((g.sysinfo.y["ScreenHeight"]-8)/2), top.n) top.n = IIF(top.n < 0 OR top.n > g.sysinfo.y["ScreenHeight"]-8, 8, top.n) left.n = IIF(left.n = 999 OR left.n < 0 OR left.n > g.sysinfo.y["ScreenWidth"]-width.n-3, Int((g.sysinfo.y["ScreenWidth"]-width.n)/2), left.n) IF hidden.l THEN accept.v = ioAcceptDialogHidden.v(top.n, left.n, title.a, prompt.a, type.a, picture.a, width.n, spot.n, "CANCEL") ELSE accept.v = ioAcceptDialogValue.v(top.n, left.n, title.a, prompt.a, type.a, picture.a, width.n, spot.n, "CANCEL") ENDIF ENDIF SetColors From g.appcolors.y ENDIF Return accept.v ; Return entered value or FALSE ENDPROC ; ============================================================================ ; TITLE: ioAcceptDialogHidden.v (c) 1991 - 1993 DataStar International ; RETURNS: Value Entered, or false if Cancelled ; DESCRIPTION: Dialog Box definition to accept a Hidden Value ; ---------------------------------------------------------------------------- PROC ioAcceptDialogHidden.v( ; Accepts value, using HIDDEN parameter top.n, ; Top Row for Box left.n, ; Left Column title.a, ; Title for dBox prompt.a, ; Data Input Prompt type.a, ; Type of Data Input picture.a, ; Additional validity string width.a, ; Width of dialog box spot.n, ; Where to begin prompt pbutton.a) ; Pushbutton variable Private accept.v ; Variable to capture Accept SHOWDIALOG title.a ; Begin DialogBox definition @ top.n,left.n Height 7 Width width.n @ 1,spot.n ?? prompt.a+":" Accept @ 1,spot.n+Len(prompt.a)+1 Width length.n type.a Picture picture.a Required Hidden Tag "ACCEPT" To accept.v PushButton @3,3 Width 10 "~O~K" Ok Default Value "OK" Tag "OK" To pbutton.a PushButton @3,width.n-15 Width 10 "~C~ancel" Cancel Value "CANCEL" Tag "CANCEL" To pbutton.a EndDialog ; Now evaluate results IF NOT retval OR pbutton.a = "CANCEL" THEN accept.v = false ENDIF Return accept.v ; Return entered value or FALSE ENDPROC ; ============================================================================ ; TITLE: ioAcceptDialogValue.v (c) 1991 - 1993 DataStar International ; RETURNS: Value Entered, or false if Cancelled ; DESCRIPTION: Generic routine for accepting data from user, with or without ; a Picture or Default value. Use ioAcceptHidden.v for hidden. ; ---------------------------------------------------------------------------- PROC ioAcceptDialogValue.v( ; Accepts value from user top.n, ; Top Row for Box left.n, ; Left Column title.a, ; Title for dBox prompt.a, ; Data Input Prompt type.a, ; Type of Data Input picture.a, ; Additional validity string width.a, ; Width of dialog box spot.n, ; Where to begin prompt pbutton.a) ; Pushbutton variable Private accept.v ; Variable to capture Accept SHOWDIALOG title.a ; Begin DialogBox definition @ top.n,left.n Height 7 Width width.n @ 1,spot.n ?? prompt.a+":" Accept @ 1,spot.n+Len(prompt.a)+1 Width length.n type.a Picture picture.a ;Required Tag "ACCEPT" To accept.v PushButton @3,3 Width 10 "~O~K" Ok Default Value "OK" Tag "OK" To pbutton.a PushButton @3,width.n-15 Width 10 "~C~ancel" Cancel Value "CANCEL" Tag "CANCEL" To pbutton.a EndDialog ; Now evaluate results IF NOT retval OR pbutton.a = "CANCEL" THEN accept.v = false ENDIF Return accept.v ; Return entered value or FALSE ENDPROC ;============================================================================= ; TITLE: ioPickArrayDialog.v (c) 1991 - 1993 DataStar International ; RETURNS: Value selected, or "" ; DESCRIPTION: ;----------------------------------------------------------------------------- PROC ioPickArrayDialog.v( ; Generic PickArray dBox listarray.r, ; Array to use for Picklist pickwidth.n, ; Width for Picklist title.a, ; Title for dBox label.a, ; Label to place above Picklist toprow.n, ; Top row (999 = centered vertically) leftcolumn.n, ; Left Column (999 = centered horizontally) dboxpalette.a) ; Dynamic Array of colors, or "" Private dboxheight.n, dboxwidth.n, pushbutton.l IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo To g.sysinfo.y ENDIF dboxwidth.n = Max(pickwidth.n + 4,30) dboxheight.n = Max(10,Min(DynArraySize(listarray.y) + 7, g.sysinfo.y["ScreenHeight"] - 3)) retval.v = "" pushbutton.l = false SHOWDIALOG title.a PROC "dbEventHandler.l" Trigger "ARRIVE" @ toprow.n, leftcolumn.n Height dboxheight.n Width dboxwidth.n ; @ 1,Int((dboxwidth.n-Len(label.a)-2)/2) label.a "PICKLIST" PickArray @ 2,Int((dboxwidth.n-pickwidth.n-2)/2) Height dboxheight.n - 7 Width pickwidth.n listarray.r Tag "PICKLIST" To retval.v PushButton @ dboxheight.n - 4, 2 Width 10 "~S~elect" OK Default Value True Tag "BUTTON" To pushbutton.l PushButton @ dboxheight.n - 4, dboxwidth.n - 14 Width 10 "~C~ancel" Cancel Value False Tag "BUTTON" To pushbutton.l ENDDIALOG Return retval.v ENDPROC ; ============================================================================ ; TITLE: ioPrinterStatus.l (c) 1991 - 1993 DataStar International ; RETURNS: logical true or false if printer available ; DESCRIPTION: Generic printer status, called from ErrorProc ; ---------------------------------------------------------------------------- PROC ioPrinterStatus.l() ; Generic printer status Private retval.l ; Value to return retval.l = true msWorking.u("Checking Printer Status",96,0,0) WHILE NOT PrinterStatus() msWorkingClear.u() retval.l = msConfirm!.l("","N",79,"RED",3,"~R~eady","~C~ancel",true) IF NOT retval.l THEN QUITLOOP ENDIF msWorking.u("Checking Printer Status",96,0,0) ENDWHILE IF NOT retval.l THEN msContinue!.u("","The Report has been Canceled - Attempting to " + "Continue with Application",79,"BLUE",1) ENDIF msWorkingClear.u() Return retval.l ENDPROC ; ============================================================================ ; TITLE: ioReportToFile.u (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Prints a Report to a designated File Name ; ---------------------------------------------------------------------------- PROC ioReportToFile.u( ; Generic report to file table.a, ; Table to Report on report.a, ; Report to Output file.a) ; Name of File to Output to Private pica.a, ; These set embedded printer control elite.a, ; variables to blank condensed.a, compressed.a, picalandscape.a, elitelandscape.a, condensedlandscape.a, boldon.a, boldoff.a, reset.a msWorking.u("Preparing Report - Please Wait",111,0,0) ; Sets blank Setup string {Report} {Change} Select table.a Select report.a Enter {Setting} {Setup} {Custom} Enter ; Enter chooses default Port Select "" Select "" ; Second SELECT removes Reset {Output} {File} Select file.a ; Outputs to File IF MenuChoice() = "Cancel" THEN {Replace} ENDIF {Cancel} {Yes} msWorkingClear.u() Return ENDPROC ; ============================================================================ ; TITLE: ioSelectOutput.u (c) 1991 - 1993 DataStar International ; CREATED: 07-01-92 03:50:00am ; DESCRIPTION: Generic Output Loop ; ---------------------------------------------------------------------------- PROC ioSelectOutput.u( ; Generic Report Output Loop title.a, ; Report Title table.a, ; Table to report on report.a, ; Report number default.a, ; default printer port for Local printername.a, ; printer name setup.a, ; Report Setup String setupfield.a, ; Printer Setup String Field in printable.a printable.a, ; Full path to Printers table, or "" custom.a, ; Custom Printer Select routine or "" pause.l) ; Pause before Printing? Private menu.a, ; destination for report file.a, ; name for saved report file n, ; Menu selection number file.l, ; Is Report already in file? netport.a, ; selected network port destination.a, ; Report destination pushbutton.l, screenfile.a, printers.r, framehigh.n, framelow.n, titlelength.n, titleleft.n, frametag.a, destination.n ;Global g.user.r, ; pica.a, ; elite.a, ; condensed.a, ; compressed.a, ; picalandscape.a, ; elitelandscape.a, ; condensedlandscape.a, ; boldon.a, ; boldoff.a, ; reset.a, msWorking.u("W",111,0,0) IF NOT IsBlank(printable.a) THEN ioSelectOutputPrinter.u(printable.a) ENDIF file.l = false screenfile.a = PrivDir() + StrVal(Ticks())+".sc" file.a = PrivDir() + "Filesave.rpt" destination.n = 1 pushbutton.l = false framehigh.n = inAttributeConvert.n(g.appcolors.y["1036"],true) framelow.n = inAttributeConvert.n(g.appcolors.y["1036"],false) frametag.a = "OUTPUT" titlelength.n = Min(54,Len(title.a)+2) titleleft.n = 29 - Int(titlelength.n/2) msWorkingClear.u() SHOWDIALOG "Select Report Destination for" PROC "dbEventHandler.l" Trigger "UPDATE", "ARRIVE", "DEPART" @ 5,10 Height 12 Width 60 Frame Single From 3,1 To 5,56 PaintCanvas Border Attribute IIF(frametag.a="DESTINATION",framehigh.n,framelow.n) 3,1,5,56 PaintCanvas Border Attribute IIF(frametag.a="DESTINATION",framelow.n,framehigh.n) 3,1,3,55 PaintCanvas Border Attribute IIF(frametag.a="DESTINATION",framelow.n,framehigh.n) 3,1,5, 1 Frame Single From 6,7 To 9,50 PaintCanvas Border Attribute IIF(frametag.a="OK" OR frametag.a = "CANCEL", framehigh.n,framelow.n) 6,7,9,50 PaintCanvas Border Attribute IIF(frametag.a="OK" OR frametag.a = "CANCEL", framelow.n,framehigh.n) 6,7,6,49 PaintCanvas Border Attribute IIF(frametag.a="OK" OR frametag.a = "CANCEL", framelow.n,framehigh.n) 6,7,9, 7 @ 1,titleleft.n ?? Format("w"+StrVal(titlelength.n)+",ac",title.a) PaintCanvas Attribute 95 1,titleleft.n,1,titleleft.n+titlelength.n-1 @ 2,titleleft.n+1 ?? Fill("▀",titlelength.n) PaintCanvas Attribute 120 2,titleleft.n+1,2,titleleft.n+titlelength.n @ 1,titleleft.n+titlelength.n ?? "▄" PaintCanvas Attribute 120 1,titleleft.n+titlelength.n, 1,titleleft.n+titlelength.n RadioButtons @ 4,2 Height 1 Width 54 "Screen", "Printer", "Alternate", "DiskFile" Tag "DESTINATION" To destination.n PushButton @ 7,11 Width 12 "~O~utput" Default Value ioSelectOutputProcess.l() Tag "OK" To pushbutton.l PushButton @ 7,35 Width 12 "~C~ontinue" Cancel Value dbButtonPress.v(false) Tag "CANCEL" To pushbutton.l ENDDIALOG msWorking.u("W",111,0,0) {Report} {SetPrinter} {Regular} {Report} {SetPrinter} {Override} {EndOfPage} {FormFeed} IF file.l THEN Run NOREFRESH "Del " + screenfile.a + " > NUL" ENDIF IF NOT IsBlank(printable.a) THEN tbView.u(printable.a,true) ClearImage UnLock printable.a PFL ENDIF msWorkingClear.u() Return ENDPROC ; ============================================================================ ; TITLE: ioSelectOutputPrinter.u (c) 1991 - 1993 DataStar International ; CREATED: 07-01-92 03:50:00am ; DESCRIPTION: Generic Output Dialog Box Proc ; ---------------------------------------------------------------------------- PROC ioSelectOutputPrinter.u( ; Reads Printers from printer table printable.a) Private count.n, w count.n = 0 Lock printable.a PFL WHILE NOT retval AND count.n < 5 count.n = count.n + 1 Sleep 1000 Lock printable.a PFL ENDWHILE IF count.n = 5 THEN printable.a = "" ELSE View printable.a Window Handle Image ImageNo() To w MoveTo [Printer Name] Array printers.r[NImageRecords()] SCAN printers.r[RecNo()] = [] IF [] = printername.a Then Moveto Field SetupField.a setup.a=[] Moveto [Printer Name] ENDIF ENDSCAN ENDIF wsWindowPark.u(w) Return ENDPROC ; ============================================================================ ; TITLE: ioSelectOutputProcess.l (c) 1991 - 1993 DataStar International ; CREATED: 07-01-92 03:50:00am ; DESCRIPTION: Generic Output Dialog Box Proc ; ---------------------------------------------------------------------------- PROC ioSelectOutputProcess.l() ; Generic Report Output Loop Private print.l, v, altprinter.n, pushbutton.l ;Global printable.a ; g.user.r, ; pica.a, ; elite.a, ; condensed.a, ; compressed.a, ; picalandscape.a, ; elitelandscape.a, ; condensedlandscape.a, ; boldon.a, ; boldoff.a, ; reset.a, ; setup.a, ; custom.a, ; printers.r ; printername.a print.l = false SWITCH CASE destination.n = 1 : msWorking.u("Sending Report to Screen - Press <Esc> when Finished Viewing", 31, 1, 0) IF NOT file.l THEN ioReportToFile.u(table.a,report.a,screenfile.a) ENDIF Run NoRefresh "Readme " + screenfile.a file.l = true CASE destination.n = 2 : IF NOT IsBlank(printable.a) THEN tbView.u(printable.a,true) MoveTo [Printer Name] Locate printername.a IF retval THEN pica.a = [Pica] elite.a = [Elite] condensed.a = [Condensed] compressed.a = [Compressed] picalandscape.a = [Pica Landscape] elitelandscape.a = [Elite Landscape] condensedlandscape.a = [Condensed Landscape] boldon.a = [Bold ON] boldoff.a = [Bold OFF] reset.a = [Reset] MoveTo FIELD setupfield.a setup.a = [] ENDIF ENDIF print.l = true CASE destination.n = 3 : SWITCH CASE NOT IsBlank(custom.a) : ExecProc custom.a ; Must assign variables, true/false v = retval IF NOT Type(v) = "L" OR NOT v THEN print.l = true ENDIF CASE NOT IsBlank(printable.a) : altprinter.n = 1 pushbutton.l = false SHOWDIALOG "Select Alternate Printer" @9,17 Height 11 Width 46 PickArray @1,1 Height 5 Width 42 Columns 1 printers.r Tag "ALTPRINTER" To altprinter.n PushButton @7,7 Width 10 "~S~elect" Ok Default Value dbButtonPress.v(true) Tag "OK" To pushbutton.l PushButton @7,27 Width 10 "~C~ancel" Cancel Value dbButtonPress.v(false) Tag "CANCEL" To pushbutton.l ENDDIALOG IF retval THEN tbView.u(printable.a,true) MoveTo [Printer Name] Locate printers.r[altprinter.n] IF retval THEN pica.a = [Pica] elite.a = [Elite] condensed.a = [Condensed] compressed.a = [Compressed] picalandscape.a = [Pica Landscape] elitelandscape.a = [Elite Landscape] condensedlandscape.a = [Condensed Landscape] boldon.a = [Bold ON] boldoff.a = [Bold OFF] reset.a = [Reset] MoveTo FIELD setupfield.a setup.a = [] print.l = true ELSE msContinue!.u("","SelectedPrinter is NOT Available", 79,"RED",2) ENDIF ENDIF OTHERWISE : msContinue!.u("","No Alternate Printers are Available",31,"BLUE",1) ENDSWITCH CASE destination.n = 4 : ; SaveFile() printfile.l = true file.v = ioAcceptDialog.v(12,18,"Enter File Name for Your Private Directory", "File Name","A12","",file.a,false,"") IF file.v <> false THEN file.a = file.v IF IsFile(PrivDir()+file.a) THEN ; Whoops! msConfirm!.l("","That Filename Exists - Overwrite?",31, "BLUE",2, "~N~O - Try again", "~Y~ES - Overwrite",false) IF NOT retval THEN printfile.l = false ENDIF ENDIF IF printfile.l THEN IF NOT file.l THEN msWorking.u("One Moment - Preparing Report",49,0,0) ioReportToFile.u(table.a,report.a,screenfile.a) file.l = true ENDIF msWorking.u("Saving Report as "+PrivDir()+file.a,49,0,0) Run NOREFRESH "Copy " + screenfile.a + " " + PrivDir()+file.a ENDIF ENDIF ENDSWITCH IF print.l THEN IF pause.l THEN msContinue!.u("","Make sure Printer is Ready with the proper paper",79,"RED",2) ENDIF ioPrinterStatus.l() ; Check printer status IF retval THEN {Report} {SetPrinter} {Override} {Setup} Select setup.a Report table.a report.a ENDIF ENDIF msWorkingClear.u() Return true ENDPROC ; ============================================================================ ; TITLE: mnVerticalDialog.n (c) 1991 - 1993 DataStar International ; RETURNS: Number of menu item selected, or zero if canceled ; DESCRIPTION: Displays a vertical menu in a dialog box ; ---------------------------------------------------------------------------- PROC mnVerticalDialog.n( ; Displays a vertical menu in dialog box menuitems.r, ; Array of menu items menuprompts.r, ; Array of menu prompts menutitle.a, ; Title for menu user.a, ; User name to display on menu menucolors.y, ; Optional alternate window colors eventhandler.a) ; Optional alternate event handler Private n, ; Transient loop counter row.n, ; Top row for dialog box column.n, ; Left column for dialog box menutag.n, ; Menu item selected width.n, ; Width of menu item picklist frameleft.n, ; Left column for menu item frame framebottom.n, ; Bottom row for menu item frame frameright.n, ; Right column for menu item frame searchstring.a, ; String of 1st characters of each item items.n, ; Number of items in menu textcolor.n, ; Window text color height.n ; Menu dialog box height ;Global g.sysinfo.y ; Stores SysInfo elements IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo To g.sysinfo.y ; Capture SysInfor for screen size ENDIF IF IsBlank(eventhandler.a) THEN ; Substitute default event handler eventhandler.a = "mnVerticalDialogEH.l" ENDIF items.n = ArraySize(menuitems.r) ; How many items? width.n = 0 searchstring.a = "" ; String of item hotkeys FOR n From 1 To items.n ; Calculate max width and hotkeys width.n = Max(width.n,Len(menuitems.r[n])+2) searchstring.a = searchstring.a + SubStr(menuitems.r[n],1,1) ENDFOR width.n = Min(54,width.n) ; Maximum width is 54 frameleft.n = Int((56 - width.n)/2) ; Calculate menu item frame framebottom.n = 2 + Min(items.n,10) ; coordinates frameright.n = frameleft.n + width.n + 3 height.n = 9 + framebottom.n ; Calculate dialog box dimensions row.n = Int((g.sysinfo.y["ScreenHeight"]- height.n - 1)/2) column.n = Int((g.sysinfo.y["ScreenWidth"]-58)/2) menutag.n = 0 ; Initialize menu choice variable ; Determine text color textcolor.n = IIF(Type(menucolors.y) = "DY" AND IsAssigned(menucolors.y["5"]), menucolors.y["5"], SysColor(1036)) SHOWDIALOG "" PROC eventhandler.a ALL @ -200, -200 Height height.n Width 62 ; Menu items frame Frame Single From 1,frameleft.n To framebottom.n,frameright.n PaintCanvas Border Attribute inAttributeConvert.n(textcolor.n,false) 1,frameleft.n,framebottom.n,frameright.n PaintCanvas Border Attribute inAttributeConvert.n(textcolor.n,true) framebottom.n,frameleft.n+1,framebottom.n,frameright.n PaintCanvas Border Attribute inAttributeConvert.n(textcolor.n,true) 1,frameright.n,framebottom.n,frameright.n ; Menu prompt frame Frame Single From framebottom.n+1,1 To framebottom.n+3,58 PaintCanvas Border Attribute inAttributeConvert.n(textcolor.n,true) framebottom.n+1,1,framebottom.n+3,58 PaintCanvas Border Attribute inAttributeConvert.n(textcolor.n,false) framebottom.n+3,2,framebottom.n+3,58 PaintCanvas Border Attribute inAttributeConvert.n(textcolor.n,false) framebottom.n+1,58,framebottom.n+3,58 ; Date/user/time frame Frame Single From framebottom.n+4,12 To framebottom.n+6,47 PaintCanvas Border Attribute inAttributeConvert.n(textcolor.n,true) framebottom.n+4,12,framebottom.n+6,47 PaintCanvas Border Attribute inAttributeConvert.n(textcolor.n,false) framebottom.n+6,13,framebottom.n+6,47 PaintCanvas Border Attribute inAttributeConvert.n(textcolor.n,false) framebottom.n+4,47,framebottom.n+6,47 ; Menu title placement PaintCanvas Fill Format("w58,ac",menutitle.a) Attribute (Int(textcolor.n/16) * 16) + 15 0,1,0,58 ; Date/user/time placement PaintCanvas Fill Format("w8,d1",Today()) + Format("w16,ac",user.a) + Time() Attribute (Int(textcolor.n/16) * 16) + 15 framebottom.n+5,14,framebottom.n+5,45 ; Menu prompt placement PaintCanvas Fill Format("W54,ac",menuprompts.r[menutag.n]) Attribute textcolor.n framebottom.n+2,3,framebottom.n+2,54 ; Menu item placement PickArray @ 2,frameleft.n+2 Height framebottom.n-2 Width width.n Columns 1 menuitems.r Tag "MENULIST" To menutag.n ; help/exit buttons placement PushButton @ framebottom.n+5,2 Width 8 "~H~elp" Value "HELP" Tag "HELP" To button.a PushButton @ framebottom.n+5,50 Width 8 "~E~xit" Cancel Value "EXIT" Tag "EXIT" To button.a ENDDIALOG Return menutag.n ; Number of item selected, or zero ENDPROC ; ============================================================================ ; TITLE: mnVerticalDialogEH.l (c) 1991 - 1993 DataStar International ; RETURNS: Logical true/false if event is accepted ; DESCRIPTION: Default event handler for vertical menu dialog box ; ---------------------------------------------------------------------------- PROC mnVerticalDialogEH.l( ; Event handler for dbox vertical menu type.a, ; EVENT or trigger name tag.a, ; Current control tag event.v, ; Dynarray of EVENT; UPDATE value; next ; control from DEPART; or null string checkbox.a) ; Checkbox label; or null string Private oldtag.n, ; Current menutag.n retval.l, ; Value to return h, y ; Transient window and dynarray variables ;Global menutag.n, ; Current item from mnVerticalDialog.n ; searchstring.n ; First character of each menu item ; row.n ; Menu origin row ; column.n ; Menu origin column ; height.n ; Height of menu dialog box ; items.n ; Number of menu items retval.l = false IF type.a = "EVENT" THEN ; Not a trigger SWITCH CASE event.v["TYPE"] = "KEY" : IF tag.a = "MENULIST" THEN SWITCH CASE event.v["KEYCODE"] = 13 : AcceptDialog CASE event.v["KEYCODE"] = -72 : menutag.n = menutag.n - 1 IF menutag.n < 1 THEN menutag.n = items.n ENDIF CASE event.v["KEYCODE"] = -80 : menutag.n = menutag.n + 1 IF menutag.n > items.n THEN menutag.n = 1 ENDIF CASE event.v["KEYCODE"] = -71 : menutag.n = 1 CASE event.v["KEYCODE"] = -79 : menutag.n = items.n CASE event.v["KEYCODE"] > 31 AND event.v["KEYCODE"] < 127 : oldtag.n = menutag.n menutag.n = Search(Chr(event.v["KeyCode"]),searchstring.a) IF menutag.n = 0 THEN menutag.n = oldtag.n ELSE AcceptDialog ENDIF CASE event.v["KEYCODE"] = 9 OR event.v["KEYCODE"] = -15 OR event.v["KEYCODE"] = 27 OR event.v["KEYCODE"] = -35 OR event.v["KEYCODE"] = -18 : retval.l = true OTHERWISE : Beep ENDSWITCH IF NOT retval.l THEN ResyncControl "MENULIST" ENDIF ELSE retval.l = true ENDIF OTHERWISE : retval.l = true ENDSWITCH RepaintDialog ELSE SWITCH CASE type.a = "OPEN" : Window Handle Dialog To h IF Type(menucolors.y) = "DY" THEN Window SetColors h From menucolors.y ENDIF RepaintDialog Window GetColors h To menucolors.y DynArray y[] y["HASFRAME"] = false y["OriginCol"] = column.n y["OriginRow"] = row.n Window SetAttributes h From y CASE type.a = "UPDATE" AND tag.a = "HELP" : mnVerticalDialogHelp.u(row.n,column.n,row.n+height.n-5) CASE type.a = "UPDATE" AND tag.a = "EXIT" : CancelDialog CASE type.a = "UPDATE" AND tag.a = "MENULIST" : AcceptDialog ENDSWITCH retval.l = true ENDIF Return retval.l ENDPROC ; ============================================================================ ; TITLE: mnVerticalDialogHelp.u (c) 1991 - 1993 DataStar International ; RETURNS: No value ; DESCRIPTION: Default help dialog box for vertical menu dialog box ; ---------------------------------------------------------------------------- PROC mnVerticalDialogHelp.u( ; Default help for vertical menu dialog box toprow.n, ; Origin row for menu dialog box leftcolumn.n, ; Origin column of menu dialog box helprow.n) ; origin row for help dialog box Private button.l ; Value of continue pushbutton SHOWDIALOG "" @ Min(helprow.n,g.sysinfo.y["ScreenHeight"]-7), leftcolumn.n + 10 Height 5 Width 40 PaintCanvas Fill Format("w36,ac","Use the Cursor \018 Keys to Scroll") + Format("w36,ac","<Tab> to Buttons - <Enter> to Select") Attribute SysColor(1036) 1, 1, 2, 36 PushButton @ -1,13 Width 12 "~C~ontinue" OK Default Value true Tag "OK" To button.l ENDDIALOG Return ENDPROC ; ============================================================================ ; TITLE: msAlertDialog.l (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Dialog PROC for IDLE events in Messages ; ---------------------------------------------------------------------------- PROC msAlertDialog.l( ; DBox EventHandler for non-icon messages type.a, ; EVENT or TRIGGER tag.a, ; Control element tag or null event.v, ; DynArray of GetEvent, or control value element.a) ; Checkbox label or null Private h, y ;Global alert.n ; Alert Value from dBox (0 - 5) ;Global onceflag.l ; For non-continuous Alert (1, 2) IF NOT IsAssigned(onceflag.l) THEN onceflag.l = true ENDIF SWITCH CASE alert.n = 1 AND onceflag.l : Beep Sleep 50 Beep Sleep 50 Beep onceflag.l = false ; Turns off subsequent Alerts CASE alert.n = 2 AND onceflag.l : Sound 770 150 Sound 440 150 Sound 770 150 Sound 440 150 Sound 770 150 onceflag.l = false ; Turns off subsequent Alerts CASE alert.n = 3 : Beep Sleep 50 Beep Sleep 300 CASE alert.n = 4 : Sound 300 50 Sleep 100 Sound 300 50 Sleep 100 Sound 150 50 Sleep 100 Sound 150 50 Sleep 100 Sleep 200 CASE alert.n = 5 : Sound 770 150 Sound 440 150 CASE alert.n = 86 and onceflag.l : FOR n1 From 4 To 0 Step -1 FOR n2 From 11 To 0 Step -1 Sound Int(Pow(2,n1+n2/12)*110) 5 ENDFOR ENDFOR Sound 10 3000 onceflag.l = false ; Turns off subsequent Alerts ENDSWITCH Return true ENDPROC ; ============================================================================ ; TITLE: msConfirm!.l (c) 1991 - 1993 DataStar International ; RETURNS: Logical true/false if User Confirmed/Canceled ; DESCRIPTION: Generic Continue-or-Cancel Message routine ; Alert 0 = No sound ; Alert 1 = Three beeps ; Alert 2 = Siren, short (high-low-high-low-high) ; Alert 3 = Two beeps, continuous ; Alert 4 = Two high beeps, two low beeps, continuous ; Alert 5 = Siren, continuous ; ---------------------------------------------------------------------------- PROC msConfirm!.l( ; Confirmation DialogBox title.a, ; Title for Dialog Box, or "" for Default message.a, ; Message to display (< 70 chars) msgcolor.n, ; Color for message (not DialogBox!) dboxpalette.a, ; Palette name for custom dBox window colors alert.n, ; Sound level of Alert (0 - 4) oklabel.a, ; Label of CONTINUE Pushbutton cxlabel.a, ; Label of CANCEL Pushbutton confirm.l) ; Should Confirm be default? Private width.n, ; Width of Dialog Box a1, a2, ; Match variables n1, n2, ; Button length comparisons buttonlength.n, ; Width of Pushbuttons button.l, ; Value of selected Pushbutton onceflag.l, ; True = Non-continuous Alert icon.a, framehigh.n, framelow.n ;Global g.appcolors.y ; Global Application Colors ; g.sysinfo.y ; Global System Information SetCanvas DEFAULT IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo to g.sysinfo.y ENDIF IF Len(message.a) = 1 THEN icon.a = msIcon.a(message.a) message.a = msShortcuts.a(message.a) ELSE IF alert.n > 3 THEN icon.a = msIcon.a("!") ELSE icon.a = msIcon.a("?") ENDIF ENDIF framehigh.n = inAttributeConvert.n(SysColor(1036),true) framelow.n = inAttributeConvert.n(SysColor(1036),false) onceflag.l = alert.n < 3 OR alert.n > 50 button.l = false message.a = msWrap.a(message.a) title.a = IIF(title.a = "", "Press <Tab> to Highlight - <Enter> to Select", title.a) DynArray dboxprocs.y[] dboxprocs.y["IDLE"] = "dbAlert.l" toprow.n = 7 leftcol.n = Int((g.sysinfo.y["ScreenWidth"]-60)/2) a1 = "" a2 = oklabel.a WHILE Match(a1+a2,"..~..",a1,a2) ENDWHILE n1 = Len(a1+a2) a1 = "" a2 = cxlabel.a WHILE Match(a1+a2,"..~..",a1,a2) ENDWHILE n2 = Len(a1+a2) buttonlength.n = Max(n1,n2)+4 SHOWDIALOG title.a Proc "dbEventHandler.l" IDLE TRIGGER "Open" @ -200,-200 Height 11 Width 60 Frame From 0,1 To 6,11 PaintCanvas Border Attribute framelow.n 0,1,6,11 PaintCanvas Border Attribute framehigh.n 0,1,0,10 PaintCanvas Border Attribute framehigh.n 0,1,6,1 PaintCanvas Fill icon.a Attribute msgcolor.n 1,2,5,10 Frame From 0,13 To 6,56 PaintCanvas Border Attribute framehigh.n 0,13,6,56 PaintCanvas Border Attribute framelow.n 0,13,0,55 PaintCanvas Border Attribute framelow.n 0,13,6,13 PaintCanvas Fill message.a Attribute msgcolor.n 1,15,5,54 PushButton @ 7,10 Width buttonlength.n IIF(confirm.l,oklabel.a,cxlabel.a) OK Value dbButtonPress.v(confirm.l) Tag "BUTTON" To button.l PushButton @ 7,48 - buttonlength.n Width buttonlength.n IIF(confirm.l,cxlabel.a,oklabel.a) OK Value dbButtonPress.v(NOT confirm.l) Tag "BUTTON" To button.l ENDDIALOG msWorkingClear.u() Return button.l ENDPROC ; ============================================================================ ; TITLE: msContinue!.u (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Generic Message and wait for a <Continue> keypress ; Alert 0 = No sound ; Alert 1 = Three beeps ; Alert 2 = Siren, short (high-low-high-low-high) ; Alert 3 = Two beeps, continuous ; Alert 4 = Two high beeps, two low beeps, continuous ; Alert 5 = Siren, continuous ; ---------------------------------------------------------------------------- PROC msContinue!.u( ; Generic Continue DialogBox title.a, ; Title for dBox, "" for Default message.a, ; Message to display msgcolor.n, ; Color for Message (not DialogBox!) dboxpalette.a, ; Dynarray of custom colors alert.n) ; Sound level of Alert (0 - 5) Private icon.a, button.l, ; Value of selected Pushbutton onceflag.l, ; True = non-continuous alert framehigh.n, framelow.n ;Global g.appcolors.y ; Global Application Colors ; g.sysinfo.y ; Global System Information SetCanvas DEFAULT IF Len(message.a) = 1 THEN icon.a = msIcon.a(message.a) message.a = msShortcuts.a(message.a) ELSE IF alert.n > 3 THEN icon.a = msIcon.a("!") ELSE icon.a = msIcon.a("I") ENDIF ENDIF IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo to g.sysinfo.y ENDIF DynArray dboxprocs.y[] dboxprocs.y["IDLE"] = "dbAlert.l" framehigh.n = inAttributeConvert.n(SysColor(1036),true) framelow.n = inAttributeConvert.n(SysColor(1036),false) onceflag.l = alert.n < 3 OR alert.n > 50 message.a = msWrap.a(message.a) button.l = true toprow.n = 7 leftcol.n = Int((g.sysinfo.y["ScreenWidth"]-60)/2) title.a = IIF(title.a = "", "Press <Enter> to Continue", title.a) SHOWDIALOG title.a Proc "dbEventHandler.l" Idle Trigger "OPEN" ; Wait for Key Alert @ -200,-200 Height 11 Width 60 Frame From 0,1 To 6,11 PaintCanvas Border Attribute framelow.n 0,1,6,11 PaintCanvas Border Attribute framehigh.n 0,1,0,10 PaintCanvas Border Attribute framehigh.n 0,1,6,1 PaintCanvas Fill icon.a Attribute msgcolor.n 1,2,5,10 Frame From 0,13 To 6,56 PaintCanvas Border Attribute framehigh.n 0,13,6,56 PaintCanvas Border Attribute framelow.n 0,13,0,55 PaintCanvas Border Attribute framelow.n 0,13,6,13 PaintCanvas Fill message.a Attribute msgcolor.n 1,15,5,54 PushButton @ 7,23 Width 12 "~C~ontinue" OK Default Value dbButtonPress.v(true) Tag "OK" To button.l ENDDIALOG msWorkingClear.u() Return ENDPROC ; ============================================================================ ; TITLE: msIcon.a (c) 1991 - 1993 DataStar International ; RETURNS: String containing message box icon ; DESCRIPTION: Assigns Icon based upon icon code ; ---------------------------------------------------------------------------- PROC msIcon.a( ; Create icon for message dBoxes icon.a) icon.a = Upper(icon.a) SWITCH CASE Search(icon.a,"IWM") <> 0 : icon.a = " ▀ " + " ██ " + " █ " + " █ " + " ███ " CASE Search(icon.a,"DKA?") <> 0 : icon.a = " █▀▀▀▀█ " + " █ " + " █▀▀ " + " █ " + " ▄ " CASE Search(icon.a,"!U") <> 0 : icon.a = " ▐█▌ " + " ███ " + " ▐█▌ " + " █ " + " ▄ " CASE Search(icon.a,"PN") <> 0 : icon.a = " █████ " + " █████ " + " █████ " + "┌─┬─┬─┬─┐" + "▀███████▀" CASE Search(icon.a,"CR") <> 0 : icon.a = " ▄ ▄ " + " ▀▄ ▄▀ " + " ▄▀▄ " + " ▄▀ ▀▄ " + " " OTHERWISE : icon.a = " █ " + " ▄█▀█▄ " + "▀▀█▄▀▄█▀▀" + " ▀█▀ " + " ▀ " ENDSWITCH Return icon.a ENDPROC ; ============================================================================ ; TITLE: msPauser.u (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Pauses for specified time, but continues with keypress ; ---------------------------------------------------------------------------- PROC msPauser.u( ; Generic Wait for Event, with timeout seconds.n) ; Maximum number of seconds to wait Private count.n, ; Loop counter y ; Event Dynarray WHILE CharWaiting() ; Clear keyboard buffer retval = GetChar() ENDWHILE Message "Please MouseClick or Press Any Key to Continue..." count.n = 0 WHILE count.n < (40 * seconds.n) GetEvent ALL To y IF (y["Type"] = "MOUSE" AND y["Action"] = "DOWN") OR y["Type"] = "KEY" OR y["Type"] = "MESSAGE" THEN QUITLOOP ENDIF Sleep 20 count.n = count.n + 1 ENDWHILE Message "" Return ENDPROC ; ============================================================================ ; TITLE: msProgressBar.u() (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Displays progress bar on screen indicating to user ; processing messages and percent complete. ; ---------------------------------------------------------------------------- PROC msProgressBar.u( ; Creates Progress Bar thermometer toprow.n, ; Top row for Window leftcol.n, ; Left column for Window title.a, ; Title for bar message.a, ; Message, below title wincolor.n, ; Color of Window, includes Title barcolor.n, ; Color of Bar msgcolor.n, ; Color of Message percentdone.n) ; 0 = SetUpWindow and MoveIntoPosition Private y, ; Throwaway Window DynArray oldcanvas.h, ; Current Canvas oldwindow.h ; Current Window ;Global g.sysinfo.y ; SysInfo ; g.handles.y ; Window Handles oldwindow.h = GetWindow() oldcanvas.h = GetCanvas() IF percentdone.n = -1 THEN Window Select g.handles.y["PROGRESS"] SetCanvas g.handles.y["PROGRESS"] WinClose ELSE IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo To g.sysinfo.y ENDIF Dynarray y[] y["hasframe"] = false y["Style"] = wincolor.n y["height"] = 8 y["width"] = 64 IF NOT IsAssigned(g.handles.y) Then DynArray g.handles.y[] ENDIF IF NOT IsAssigned(g.handles.y["PROGRESS"]) OR NOT IsWindow(g.handles.y["PROGRESS"]) THEN Window Create Floating @ -200, -200 Attributes y To g.handles.y["PROGRESS"] ENDIF Window Select g.handles.y["PROGRESS"] SetCanvas g.handles.y["PROGRESS"] Canvas Off IF toprow.n = 999 THEN toprow.n = 7 ENDIF IF leftcol.n = 999 THEN leftcol.n = Int((g.sysinfo.y["ScreenWidth"]-64)/2) ENDIF IF percentdone.n = 0 THEN ; 0 = 1st time through Setup Window Move g.handles.y["PROGRESS"] To toprow.n,leftcol.n @ 0,0 ??"┌──────────────────────────────────────────────────────────────┐" @ 1,0 ??"│ │" @ 2,0 ??"│ │" @ 3,0 ??"│ │" @ 4,0 ??"│ ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ │" @ 5,0 ??"│ 0 25 50 75 100 │" @ 6,0 ??"│ Percent Complete │" @ 7,0 ??"└──────────────────────────────────────────────────────────────┘" @ 1,2 ?? Format("ac,w60",Title.a) PaintCanvas Attribute wincolor.n 0,0,6,63 PaintCanvas Attribute barcolor.n 4,6,4,57 PaintCanvas Border Attribute 112 0,0,7,63 PaintCanvas Attribute 127 0,0,7,0 PaintCanvas Attribute 127 7,0,7,62 ENDIF Style Attribute msgcolor.n @ 2,2 ?? Format("ac,w60",message.a) Style Attribute barcolor.n @ 4,7 ?? Fill("\219",Min(Int(percentdone.n/2),50)) Style Canvas On ENDIF IF IsWindow(oldcanvas.h) THEN SetCanvas oldcanvas.h ELSE SetCanvas Default ENDIF IF IsWindow(oldwindow.h) THEN Window Select oldwindow.h ENDIF Return ENDPROC ; ============================================================================ ; TITLE: msScreenBlanker.u (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Snaking worm screen blanker ; ---------------------------------------------------------------------------- PROC msScreenBlanker.u() ; Screen blanking routine Private row.r, ; Row location array column.r, ; Column location array n1, n2, ; Loop counters fill.a, ; Message fill string worm.r, ; Worm segment array direction.n, ; Current direction olddirection.n, ; Last direction y, ; Getevent dynarray oldcanvas.h, ; Previous Canvas oldwindow.h, ; Previous Window height.n, width.n ;Global g.sysinfo.y ; SysInfo ; g.handles.y ; Window Handles oldwindow.h = GetWindow() oldcanvas.h = GetCanvas() IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo To g.sysinfo.y ENDIF height.n = g.sysinfo.y["ScreenHeight"] width.n = g.sysinfo.y["ScreenWidth"] DynArray w.y[] w.y["HasFrame"] = false w.y["HasShadow"] = false w.y["Style"] = 15 w.y["Height"] = g.sysinfo.y["ScreenHeight"] w.y["Width"] = g.sysinfo.y["ScreenWidth"] Window Create Floating @ 0,0 Attributes w.y to blank.h Array worm.r[4] ; Set up worm using ASCII worm.r[1] = "\10\10" worm.r[2] = "▓▓" worm.r[3] = "▒▒" worm.r[4] = "░░" Array row.r[4] ; Initialize starting rows row.r[1] = 12 row.r[2] = 12 row.r[3] = 12 row.r[4] = 12 Array column.r[4] ; Initialize starting columns column.r[1] = 40 column.r[2] = 42 column.r[3] = 44 column.r[4] = 46 Style ATTRIBUTE 9 fill.a = " P R E S S A N Y K E Y T O R E T U R N " olddirection.n = 0 ; Initialize WHILE NOT IsAssigned(g.debug.l) OR NOT g.debug.l direction.n = Int(Rand()*8) ; Randomize next direction IF Mod(direction.n,4) = Mod(olddirection.n,4) THEN ; Prevent same direct or reverse IF direction.n = 7 THEN direction.n = 0 ELSE direction.n = direction.n + 1 ENDIF ENDIF FOR n2 From 1 To 3 Canvas OFF PaintCanvas Fill " " ATTRIBUTE 0 0,0,24,79 ; Black screen SWITCH ; Randomize and display message CASE Mod(direction.n,4) = 0 : PaintCanvas FILL Format("w80,ac",fill.a) ATTRIBUTE 79 0,0,0,79 CASE Mod(direction.n,4) = 1 : PaintCanvas FILL fill.a+" " ATTRIBUTE 95 0,0,24,1 CASE Mod(direction.n,4) = 2 : PaintCanvas FILL Format("w80,ac",fill.a) ATTRIBUTE 31 24,0,24,79 CASE Mod(direction.n,4) = 3 : PaintCanvas FILL " "+fill.a ATTRIBUTE 47 0,78,24,79 ENDSWITCH FOR n1 From 4 To 1 Step -1 ; Countdown loop places worm @ row.r[n1], column.r[n1] ?? worm.r[n1] ENDFOR Canvas ON ; Increment worm segment locations row.r[4] = row.r[3] row.r[3] = row.r[2] row.r[2] = row.r[1] column.r[4] = column.r[3] column.r[3] = column.r[2] column.r[2] = column.r[1] SWITCH ; Check for Out-of-bounds movement CASE direction.n = 0 : ; and then assign head position SWITCH CASE row.r[1] > 1 : row.r[1] = row.r[1] - 1 CASE column.r[1] = width.n - 4 : column.r[1] = width.n - 6 OTHERWISE : column.r[1] = column.r[1] + 2 ENDSWITCH CASE direction.n = 1 : SWITCH CASE row.r[1] < 2 AND column.r[1] > width.n - 5 : row.r[1] = 2 column.r[1] = width.n - 6 CASE row.r[1] < 2 : column.r[1] = column.r[1] + 2 CASE column.r[1] > width.n - 5 : row.r[1] = row.r[1] - 1 OTHERWISE : row.r[1] = row.r[1] - 1 column.r[1] = column.r[1] + 2 ENDSWITCH CASE direction.n = 2 : SWITCH CASE column.r[1] < width.n - 5 : column.r[1] = column.r[1] + 2 CASE row.r[1] < 2 : row.r[1] = 2 OTHERWISE : row.r[1] = row.r[1] - 1 ENDSWITCH CASE direction.n = 3 : SWITCH CASE row.r[1] > height.n - 3 AND column.r[1] > width.n - 5 : row.r[1] = height.n - 3 column.r[1] = height.n - 6 CASE row.r[1] > height.n - 3 : column.r[1] = column.r[1] + 2 CASE column.r[1] > width.n - 5 : row.r[1] = row.r[1] + 1 OTHERWISE : row.r[1] = row.r[1] + 1 column.r[1] = column.r[1] + 2 ENDSWITCH CASE direction.n = 4 : SWITCH CASE row.r[1] < height.n - 2 : row.r[1] = row.r[1] + 1 CASE column.r[1] > width.n - 5 : column.r[1] = width.n - 6 OTHERWISE : column.r[1] = column.r[1] + 2 ENDSWITCH CASE direction.n = 5 : SWITCH CASE row.r[1] > height.n - 3 AND column.r[1] < 3 : row.r[1] = height.n - 3 column.r[1] = 4 CASE row.r[1] > height.n - 3 : column.r[1] = column.r[1] - 2 CASE column.r[1] < 3 : row.r[1] = row.r[1] + 1 OTHERWISE : row.r[1] = row.r[1] + 1 column.r[1] = column.r[1] - 2 ENDSWITCH CASE direction.n = 6 : SWITCH CASE column.r[1] > 3 : column.r[1] = column.r[1] - 2 CASE row.r[1] < 2 : row.r[1] = 2 OTHERWISE : row.r[1] = row.r[1] - 1 ENDSWITCH CASE direction.n = 7 : SWITCH CASE row.r[1] < 2 AND column.r[1] < 3 : row.r[1] = 2 column.r[1] = 4 CASE row.r[1] < 2 : column.r[1] = column.r[1] - 2 CASE column.r[1] < 3 : row.r[1] = row.r[1] - 1 OTHERWISE : row.r[1] = row.r[1] - 1 column.r[1] = column.r[1] - 2 ENDSWITCH ENDSWITCH Sleep 500 ; Pause 1/2 second (adjustable) ENDFOR olddirection.n = direction.n ; Store previous direction GetEvent ALL To y IF (y["Type"] = "MOUSE" AND y["Action"] = "DOWN") OR y["Type"] = "KEY" THEN QUITLOOP ENDIF ENDWHILE IF IsWindow(oldcanvas.h) THEN SetCanvas oldcanvas.h ELSE SetCanvas Default ENDIF IF IsWindow(oldwindow.h) THEN Window Select oldwindow.h ENDIF Return ENDPROC ; ============================================================================ ; TITLE: msScreenTimeOut.l (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Warning - the end is near! Message ; ---------------------------------------------------------------------------- PROC msScreenTimeOut.l( ; Generic Inactivity Warning time.a) ; Current time Private y, ; Getevent dynarray oldcanvas.n, ; Previous Canvas oldwindow.n ; Previous Window oldcanvas.n = GetCanvas() oldwindow.n = GetWindow() SetCanvas DEFAULT Style ATTRIBUTE SysColor(3) @ 0,0 ?? Format("w80,ac","Inactivity Warning!!! " + "Logout will occur in less than One Minute!") Style ATTRIBUTE status.n retval.l = false WHILE true IF time.a = SubStr(Time(),1,5) THEN Beep Sleep 50 Beep Sleep 50 Beep Sleep 350 ?? " P r e s s a K e y ! " ELSE QUITLOOP ENDIF GetEvent ALL To y IF (y["Type"] = "MOUSE" AND y["Action"] = "DOWN") OR y["Type"] = "KEY" OR y["Type"] = "MESSAGE" THEN retval.l = true QUITLOOP ENDIF ENDWHILE Return retval.l ENDPROC ; ============================================================================ ; TITLE: msShortcuts.a (c) 1991 - 1993 DataStar International ; RETURNS: Expanded Message Value ; DESCRIPTION: Shortcuts for Generic Information Messages ; ---------------------------------------------------------------------------- PROC msShortcuts.a( ; Shortcuts for Messages message.a) ; Message Code SWITCH ; shortcuts CASE message.a = "C" : message.a = "Operation Canceled - Returning" CASE message.a = "M" : message.a = "One Moment - Returning to MENU" CASE message.a = "P" : message.a = "P R I N T I N G - This will take a few moments" CASE message.a = "Q" : message.a = "Q U E R Y I N G - This will take a few moments" CASE message.a = "R" : message.a = "Report NOT Printed - Returning" CASE message.a = "W" : message.a = "W O R K I N G - One Moment" CASE message.a = "K" : message.a = "Key Violation! Do You Want to Overwrite the Existing Record?" CASE message.a = "A" : message.a = "A R E Y O U S U R E ?" CASE message.a = "U" : message.a = "Unable to Lock Necessary Tables, Please Try Later" CASE message.a = "N" : message.a = "The Printer is NOT Responding! Please fix Printer, or Cancel Report" CASE message.a = "D" : message.a = "Do You Want to DELETE This Record?" OTHERWISE : message.a = "DataStar International" ENDSWITCH Return message.a ENDPROC ; ============================================================================ ; TITLE: msSignBoard.u (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Generic Message and wait for a <Continue> keypress ; ---------------------------------------------------------------------------- PROC msSignBoard.u( ; Generic Continue DialogBox title.a, ; Title for dBox, "" for Default message.a, ; Message to display msgcolor.n, ; Color for Message (not DialogBox!) dboxpalette.a) ; Dynarray of custom colors Private icon.a, button.l, ; Value of selected Pushbutton onceflag.l, ; True = non-continuous alert framehigh.n, framelow.n, display.a, counter.n ;Global g.appcolors.y ; Global Application Colors ; g.sysinfo.y ; Global System Information SetCanvas DEFAULT IF Len(message.a) = 1 THEN icon.a = msIcon.a(message.a) message.a = msShortcuts.a(message.a) ELSE IF alert.n > 3 THEN icon.a = msIcon.a("!") ELSE icon.a = msIcon.a("I") ENDIF ENDIF IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo to g.sysinfo.y ENDIF DynArray dboxprocs.y[] dboxprocs.y["IDLE"] = "msSignBoardIdle.l" framehigh.n = 76 ; inAttributeConvert.n(SysColor(1036),true) framelow.n = 64 ; inAttributeConvert.n(SysColor(1036),false) button.l = true toprow.n = 7 leftcol.n = Int((g.sysinfo.y["ScreenWidth"]-60)/2) title.a = IIF(title.a = "", "Press <Enter> to Continue", title.a) message.a = Spaces(54) + message.a display.a = Spaces(54) SHOWDIALOG title.a Proc "dbEventHandler.l" Idle Trigger "OPEN" ; Wait for Key Alert @ -200,-200 Height 7 Width 60 Frame From 0,1 To 2,56 PaintCanvas Border Attribute framelow.n 0,1,2,56 PaintCanvas Border Attribute framehigh.n 0,1,0,55 PaintCanvas Border Attribute framehigh.n 0,1,2,1 PaintCanvas Fill display.a Attribute msgcolor.n 1,2,1,55 PushButton @ 3,23 Width 12 "~C~ontinue" OK Default Value dbButtonPress.v(true) Tag "OK" To button.l ENDDIALOG msWorkingClear.u() Return ENDPROC ; ============================================================================ ; TITLE: msSignBoardIdle.l (c) 1991 - 1993 DataStar International ; RETURNS: No Value ; DESCRIPTION: Generic Message and wait for a <Continue> keypress ; ---------------------------------------------------------------------------- PROC msSignBoardIdle.l() ; SignBoard IDLE routine ;Global message.a ; Original message ; display.a ; Portion to display ; counter.n ; Tracking counter for message display.a = SubStr(message.a,1,54) message.a = SubStr(message.a,2,255) + SubStr(message.a,1,1) IF NOT IsAssigned(counter.n) THEN counter.n = 0 ENDIF IF counter.n = 8 THEN counter.n = 1 Sound 440 100 ELSE counter.n = counter.n + 1 Sound 9 2 Sleep 100 ENDIF Return true ENDPROC ; ============================================================================ ; TITLE: msTeleType.u (c) 1991 - 1993 DataStar International ; RETURNS: No value ; DESCRIPTION: Writes string to screen at passed coordinates. Clicks with ; each letter written. Speed controlled by speed.n variable. ; ---------------------------------------------------------------------------- PROC msTeleType.u( ; Scrolls text onto canvas row.n, ; Relative Row position column.n, ; Relative Column position string.a, ; Message to write to Canvas speed.n) ; Speed to write (0=fastest, 10=slowest) Private n ; Transient Loop Counter FOR n from 1 To Len(String.a) @ row.n,column.n + n - 1 ?? SubStr(string.a,n,1) Sound 9 2 Sleep Max(1,Min(speed.n,10))*10 ENDFOR Return ENDPROC ; ============================================================================ ; TITLE: msTickerTape.u (c) 1991 - 1993 DataStar International ; RETURNS: No value ; DESCRIPTION: Writes string to screen backwards at passed coordinates. ; Clicks with each letter. Speed controlled by speed.n variable. ; ---------------------------------------------------------------------------- PROC msTickerTape.u( ; Scrolls text onto canvas row.n, ; Relative Row position column.n, ; Relative Column position string.a, ; Message to write to Canvas speed.n) ; Speed to write (0=fastest, 10=slowest) Private n, ; Transient Loop Counter length.n ; Length of string length.n = Len(string.a) FOR n from 1 To length.n @ row.n,column.n + length.n - n ?? SubStr(string.a,1,n) Sound 9 2 Sleep Max(1,Min(speed.n,10))*10 ENDFOR Return ENDPROC ; ============================================================================ ; TITLE: msWorking.u (c) 1991 - 1993 DataStar International ; RETURNS: No value ; DESCRIPTION: Generic Information Message Window, Cleared as follows: ; 0 Seconds - must be manually cleared ; 1 - 5 Seconds - self-clears ; -1 Seconds - pauses while event = IDLE, then clears ; ---------------------------------------------------------------------------- PROC msWorking.u( ; Generic information message window message.a, ; Message to display (<ScreenWidth color.n, ; Color for message window beep.n, ; Number of beeps sleep.n) ; # of Seconds to pause (-1 to 5) Private y, n, width.n, oldcanvas.h, oldwindow.h, offset.n ;Global g.message.h ; g.sysinfo.y IF Len(message.a) = 1 THEN message.a = msShortcuts.a(message.a) ENDIF message.a = message.a + "..." IF NOT IsAssigned(g.sysinfo.y) THEN SysInfo To g.sysinfo.y ; Determine Screen Size ENDIF msWorkingClear.u() DynArray y[] y["CanClose"] = False y["CanMaximize"] = False y["CanMove"] = False y["CanResize"] = False y["HasFrame"] = False ; If Framed, window is *5* rows!!! y["Style"] = color.n width.n = Max(50,Min(Len(message.a)+4,g.sysinfo.y["ScreenWidth"]-4)) offset.n = Max(5,Int((width.n-Len(message.a)+1)/2)+3) oldcanvas.h = GetCanvas() oldwindow.h = GetWindow() Window Create Floating @ -200,-200 Height 1 Width width.n Attributes y To g.message.h Style Attribute color.n PaintCanvas Fill Format("w"+StrVal(width.n)+",ac",message.a) Attribute color.n 0,0,0,width.n-1 PaintCanvas Attribute color.n + 128 0,width.n - offset.n,0,width.n-offset.n+2 Window Move g.message.h To 1, Int((g.sysinfo.y["ScreenWidth"]-width.n)/2) FOR n from 1 to Min(5,beep.n) Beep Sleep 100 ; Beep for desired # of Beeps ENDFOR SWITCH CASE sleep.n > 0 : Sleep Min(sleep.n,5) * 1000 ; Sleep for desired # of seconds Window Select g.message.h Window Close CASE sleep.n < 0 : Message "Mouseclick or Press Any Key to Continue..." WHILE true GetEvent ALL To y IF (y["Type"] = "MOUSE" AND y["Action"] = "DOWN") OR y["Type"] = "KEY" THEN QUITLOOP ENDIF ENDWHILE Window Select g.message.h Window Close ENDSWITCH IF IsWindow(oldcanvas.h) THEN SetCanvas oldcanvas.h ELSE SetCanvas Default ENDIF IF IsWindow(oldwindow.h) THEN Window Select oldwindow.h ENDIF Return ENDPROC ; ============================================================================ ; TITLE: msWorkingClear.u (c) 1991 - 1993 DataStar International ; RETURNS: No value ; DESCRIPTION: Generic Information Message Window Clearer ; ---------------------------------------------------------------------------- PROC msWorkingClear.u() ; Clears msWorking message Private oldwindow.h, oldcanvas.h ;Global g.message.h oldwindow.h = GetWindow() oldcanvas.h = GetCanvas() IF IsAssigned(g.message.h) AND IsWindow(g.message.h) THEN Window Select g.message.h Window Close ENDIF IF IsWindow(oldcanvas.h) THEN SetCanvas oldcanvas.h ELSE SetCanvas Default ENDIF IF IsWindow(oldwindow.h) THEN Window Select oldwindow.h ENDIF Return ENDPROC ; ============================================================================ ; TITLE: msWrap.a (c) 1991 - 1993 DataStar International ; RETURNS: Formatted 200 char message ; DESCRIPTION: Formats message for dBox message routines ; ---------------------------------------------------------------------------- PROC msWrap.a( ; Formats message for dBox message.a) ; Message to format Private n1, n2, n3 IF Len(message.a) < 41 THEN message.a = Spaces(80) + Format("w40,ac",message.a) + Spaces(80) ELSE IF Len(message.a) < 121 THEN message.a = Spaces(40) + message.a ENDIF FOR n1 From 40 To 160 Step 40 n2 = n1 + 1 WHILE SubStr(message.a, n2, 1) <> " " n2 = n2 - 1 ENDWHILE n3 = n2 + 1 WHILE SubStr(message.a, n3, 1) = " " n3 = n3 + 1 ENDWHILE message.a = Format("w"+StrVal(n1),SubStr(message.a,1,n2-1)) + Format("w"+StrVal(200-n1),SubStr(message.a,n3,200)) ENDFOR ENDIF Return message.a ENDPROC ; ============================================================================ ; TITLE: quExecute.l (c) 1991 - 1993 DataStar International ; RETURNS: Logical true/false IF Query successful ; DESCRIPTION: Generic Query processor ; ---------------------------------------------------------------------------- PROC quExecute.l( ; Generic Query Processor clear.l) ; Should resultant table be cleared? Private error.l, ; Error routine flag proc.a, ; Name of current procedure retval.l ; Value to return proc.a = "quExecute.l" error.l = false Do_It! ; Main Errorproc checks IF Query Completes IF error.l OR Window() <> "" THEN msContinue!.u("","Query Error - " + Window(),79,"RED",4) retval.l = false IF IsAssigned(g.debug.l) AND g.debug.l THEN DEBUG ENDIF ELSE IF clear.l THEN ClearImage ENDIF WHILE NImages() > 0 MoveTo 1 IF ImageType() = "Query" THEN ClearImage ELSE QUITLOOP ENDIF ENDWHILE retval.l = true ENDIF Return retval.l ENDPROC ; ============================================================================ ; TITLE: quPAL.u() (c) 1991 - 1993 DataStar International ; RETURNS: No value ; DESCRIPTION: Dialog box user interface to present utility options ; and control execution. Requires the following procedures: ; dbAlert.l Alert procedure for dialog boxes ; dbButtonPress.v Pauses depressed dbox button ; dbEventHandler.l Generic dbox event handler ; msContinue!.u Generic message dialog box ; inAllFieldsChecked.l Determines if every field is checked ; inBackSlashDouble.a Doubles backslashes in a string ; inBackslashQuotes.a Adds backslashes to quotes ; ioAcceptDialog.v Accepts procedure name ; ioAcceptDialogValue.v Generic Accept sub-routine ; ---------------------------------------------------------------------------- PROC quPAL.u() ; Turns Query Image into PAL code Private pushbutton.l, ; Button variable justification.n, ; Output justification type outputfile.a, ; Output file name proceduralize.n, ; Proceduralize flag frametag.a, ; Current tag for framing framehigh.n, ; Highlight color for framing framelow.n, ; lowlight color for framing dboxpalette.a ; Color palette for dialog box framehigh.n = 127 framelow.n = 112 pushbutton.l = false outputfile.a = "INSTANT" justification.n = 1 proceduralize.n = 1 dboxpalette.a = "GRAY" IF NImages() > 0 THEN SHOWDIALOG "Paladin Query Converter" Proc "dbEventHandler.n" Trigger "ARRIVE" @4,14 Height 15 Width 53 Frame Single From 2,1 To 4,49 PaintCanvas Attribute IIF(frametag.a = "FILE",framehigh.n,framelow.n) 2,1,4,49 PaintCanvas Attribute IIF(frametag.a = "FILE",framelow.n,framehigh.n) 2,49,4,49 PaintCanvas Attribute IIF(frametag.a = "FILE",framelow.n,framehigh.n) 4,2,4,49 Frame Single From 5,1 To 8,49 PaintCanvas Attribute IIF(Search("JUST",frametag.a) = 1, framehigh.n,framelow.n) 5,1,8,49 PaintCanvas Attribute IIF(Search("JUST",frametag.a) = 1, framelow.n,framehigh.n) 5,49,8,49 PaintCanvas Attribute IIF(Search("JUST",frametag.a) = 1, framelow.n,framehigh.n) 8,2,8,49 Frame Single From 9,1 To 12,49 PaintCanvas Attribute IIF(Search("PUSH",frametag.a) = 1, framehigh.n,framelow.n) 9,1,12,49 PaintCanvas Attribute IIF(Search("PUSH",frametag.a) = 1, framelow.n,framehigh.n) 9,49,12,49 PaintCanvas Attribute IIF(Search("PUSH",frametag.a) = 1, framelow.n,framehigh.n) 12,2,12,49 PaintCanvas Fill "Output File Name:" Attribute 112 3,3,3,19 PaintCanvas Fill "Justification:" Attribute 112 6,3,6,16 PaintCanvas Fill "Proceduralize:" Attribute 112 7,3,7,16 PaintCanvas Fill " Paladin Query-To-PAL Converter " Attribute 94 0,9,0,40 PaintCanvas Fill Fill("▀",32) Attribute 112 1,10,1,41 PaintCanvas Fill "▄" Attribute 112 0,41,0,41 Accept @3,20 Width 28 "A8" Picture "*!" Tag "FILE" To outputfile.a RadioButtons @6,17 Height 1 Width 32 "Flush", "Right", "Left" Tag "JUST1" To justification.n RadioButtons @7,17 Height 1 Width 18 "No", "Yes" Tag "JUST2" To proceduralize.n PushButton @10,8 Width 15 "~D~o_It!" Default Value quPALCreate.l(outputfile.a) Tag "PUSH1" To pushbutton.l PushButton @10,28 Width 15 "~C~ancel" Cancel Value dbButtonPress.v(false) Tag "PUSH2" To pushbutton.l ENDDIALOG ELSE msContinue!.u("","Sorry, there are no images present",31,"BLUE",1) ENDIF Return ENDPROC ; ============================================================================ ; TITLE: quPALCreate.u() (c) 1991 - 1993 DataStar International ; RETURNS: No value ; DESCRIPTION: Converts interactive query images to PAL code ; ---------------------------------------------------------------------------- PROC quPALCreate.l( ; Converts Query images to PAL code outputfile.a) ; Name of output file Private columns.n, ; Number of columns in query image firstimage.a, ; Query image 1 blankrow.l, ; True if entire row is blank row.n, ; Image row numbers fieldvalues.y, ; Contents of fields checkstatus.y, ; Check mark status of fields fieldorder.r, ; Sequential order of fields allchecks.l, ; True if checkmark status same in all fields maxlength.n, ; Maximum length of field for output format retval.l, ; Return variable outputproc.a, ; Output procedure name n, n1, n2 ; Transient loop counters WHILE true retval.l = false IF NImages() = 0 THEN ; Check for no images msContinue!.u("","Sorry, there are no images present",31,"BLUE",1) QUITLOOP ENDIF IF Search(".",outputfile.a) > 0 THEN ; Check for file extensions msContinue!.u("","Sorry, the Filename cannot have an extension",31,"BLUE",1) SelectControl "FILE" QUITLOOP ENDIF MoveTo 1 ; If any query images, they start IF ImageType() <> "Query" THEN ; at Image #1 msContinue!.u("","Sorry, there are no Query images present",31,"BLUE",1) QUITLOOP ENDIF outputfile.a = outputfile.a + ".SC" IF IsFile(outputfile.a) THEN ; Check for file name Beep Sleep 50 Beep Sleep 50 Beep SHOWPOPUP Upper(outputfile.a) + " Already Exists" CENTERED "~A~ppend" : "Append Current File Name" : "APPEND", "~O~verwrite" : "Overwrite Current File Name" : "OVER", "~R~ename" : "Rename Current File Name" : "RENAME" ENDMENU TO menuchoice.a IF NOT retval then QUITLOOP ENDIF SWITCH CASE menuchoice.a = "OVERWRITE" : Editor New outputfile.a {Cancel} {Yes} CASE menuchoice.a = "RENAME" : SelectControl "FILE" QUITLOOP ENDSWITCH ENDIF IF proceduralize.n = 2 THEN ;proceduralize output outputproc.a = ioAcceptDialog.v(3, 15, "Query Procedure Name", "Enter Proc Name", "A40", "", "", false, "") IF outputproc.a = false THEN QUITLOOP ENDIF ENDIF Print File outputfile.a "\n", "; quPAL: Begin Query \n", "; Generated: " + Format("d2",Today()) + " - " + Time() + "\n", "; Description:\n\n" IF proceduralize.n = 2 THEN ;proceduralize output Print File outputfile.a "PROC " + outputproc.a + "\n\n", "Private retval.v\n\n\n" ENDIF MoveTo 1 FOR n2 FROM 1 TO Nimages() IF ImageType() = "Query" THEN ; Process query images only firstimage.a = Table() columns.n = Nfields(Table())+1 blankrow.l = true row.n = 1 Print File outputfile.a "\n {Ask} SELECT \"" + inBackSlashDouble.a(Table()) + "\"\n" Home WHILE true CtrlHome DynArray fieldvalues.y[] DynArray checkstatus.y[] Array fieldorder.r[columns.n] maxlength.n = 0 FOR n From 1 To columns.n Message "Reading - Row: "+StrVal(row.n)+", Column: "+Strval(n) fieldvalues.y[Field()] = [] checkstatus.y[Field()] = CheckMarkStatus() fieldorder.r[n] = Field() IF NOT IsBlank([] + CheckMarkStatus()) THEN maxlength.n = Max(Len(Field()),maxlength.n) blankrow.l = false ENDIF Right ENDFOR IF blankrow.l THEN QUITLOOP ELSE IF row.n > 1 THEN Print File outputfile.a " DOWN\n" ENDIF ENDIF allchecks.l = inAllFieldsChecked.l(fieldorder.r, checkstatus.y, columns.n) IF allchecks.l THEN Print File outputfile.a " CTRLHOME " + Upper(checkstatus.y[fieldorder.r[2]]) +"\n" ENDIF IF NOT IsBlank(fieldvalues.y[fieldorder.r[1]]) THEN Print File outputfile.a " \"" + inBackslashQuotes.a(Upper(fieldvalues.y[fieldorder.r[1]]))+"\"\n" ENDIF FOR n1 FROM 2 To columns.n Message "Writing Row: " + StrVal(row.n) + ", Column: " + Strval(n) IF NOT allchecks.l AND NOT IsBlank(checkstatus.y[fieldorder.r[n1]]) THEN SWITCH CASE justification.n = 1 : ; Full justification Print File outputfile.a " MoveTo" + Spaces((maxlength.n)-(len(fieldorder.r[n1]))+1) + "[" + fieldorder.r[n1] + "] " + Upper(checkstatus.y[fieldorder.r[n1]]) + "\n" CASE justification.n = 2 : ;Right justification Print File outputfile.a Spaces((maxlength.n)-(len(fieldorder.r[n1]))+3) + "MoveTo [" + fieldorder.r[n1] + "] " + Upper(checkstatus.y[fieldorder.r[n1]]) + "\n" CASE justification.n = 3 : ;left justification Print File outputfile.a "MoveTo [" + fieldorder.r[n1] + "] " + Upper(checkstatus.y[fieldorder.r[n1]]) + "\n" ENDSWITCH ENDIF IF NOT IsBlank(fieldvalues.y[fieldorder.r[n1]]) THEN SWITCH CASE justification.n = 1 : ; Full justification Print File outputfile.a Spaces((maxlength.n+7)-(len(fieldorder.r[n1]))+2) + "[" + fieldorder.r[n1] + "] = \"" + inBackslashQuotes.a(fieldvalues.y[fieldorder.r[n1]]) + "\"\n" CASE justification.n = 2 : ; Right justification Print File outputfile.a Spaces((maxlength.n+7)-(len(fieldorder.r[n1]))+3) + "[" + fieldorder.r[n1] + "] = \"" + inBackslashQuotes.a(fieldvalues.y[fieldorder.r[n1]]) + "\"\n" CASE justification.n = 3 : ; Left justification Print File outputfile.a "[" + fieldorder.r[n1] + "] = \"" + inBackslashQuotes.a(fieldvalues.y[fieldorder.r[n1]]) + "\"\n" ENDSWITCH ENDIF ENDFOR row.n = row.n + 1 blankrow.l = true ENDWHILE Home CtrlHome ENDIF DownImage ENDFOR CtrlHome Print File outputfile.a "\n", "; Do_It! \n", "; quExecute.l(True)\n", "; IF NOT retval THEN\n", "; DEBUG\n", "; ENDIF\n", ";\n", ";== End Query ==\n" IF proceduralize.n = 2 THEN ;proceduralize output Print File outputfile.a "\n", "ENDPROC\n", ";??\"\\004\"\n", ";WRITELIB libname.a ", IIF(Search("(",outputproc.a) = 0, outputproc.a + "\n", SubStr(outputproc.a,1,(Search("(",outputproc.a)-1)) + "\n") ENDIF SelectControl "PUSH2" Message "Conversion Complete" retval.l = true QUITLOOP ENDWHILE Return retval.l ENDPROC ; =========================================================================== ; TITLE: utSpeedButtonsEnable.u ; RETURNS: No value ; DESCRIPTION: Places SpeedButtons at desired location; creates Window if it ; does not exist. ; --------------------------------------------------------------------------- PROC utSpeedButtonsEnable.u( ; Restores or establishes SpeedButtons row.n, ; Row to establish SpeedButtons window column.n, ; Column to establish SpeedButtons window colors.v) ; DynArray of custom colors, or "" ;Global g.handles.y ; Stores application window handles IF NOT IsAssigned(g.handles.y) THEN DynArray g.handles.y[] ENDIF IF NOT IsAssigned(g.handles.y["SpeedButtons"]) OR NOT IsWindow(g.handles.y["SpeedButtons"]) THEN utSpeedButtonsSetup.u(colors.v) ; Establish a new window ENDIF Window MOVE g.handles.y["SpeedButtons"] To row.n, column.n ; Bring it to desired location Return ENDPROC ; =========================================================================== ; TITLE: utSpeedButtonsSetup.u ; RETURNS: No Value ; DESCRIPTION: Sets up mouse SpeedButtons ; --------------------------------------------------------------------------- PROC utSpeedButtonsSetup.u( ; Generic Mouse SpeedButtons Setup colors.v) ; DynArray of Colors, or "" Private current.w, ; Current Window Handle canvas.w, ; Current Canvas Window Handle speedbuttons.y, ; SpeedButtons window dynarray iconcolor.n, ; Color of SpeedButton icons barcolor.n, ; Color of SpeedButton divider bars n, ; Loop incrementer y ; Transient window attributes dynarray ;Global g.handles.y ; Global window handle dynarray IF NOT IsAssigned(g.handles.y) THEN DynArray g.handles.y[] ; Create window-tracking dynarray ENDIF iconcolor.n = IIF(IsBlank(colors.v),SysColor(1003),colors.v["1003"]) barcolor.n = IIF(IsBlank(colors.v),SysColor(1001),colors.v["1001"]) Window HANDLE CURRENT To current.w ; Save current window handle canvas.w = GetCanvas() ; Save current window handle DynArray speedbuttons.y[] ; Create a dynamic array for specs speedbuttons.y["CanClose"] = False speedbuttons.y["CanMaximize"] = False speedbuttons.y["CanMove"] = False speedbuttons.y["CanResize"] = False speedbuttons.y["Echo"] = False speedbuttons.y["HasShadow"] = False speedbuttons.y["HasFrame"] = False ; IF Framed, window is *5* rows!!! speedbuttons.y["Style"] = iconcolor.n Window CREATE FLOATING @ -200,-200 HEIGHT 1 WIDTH 37 ATTRIBUTES speedbuttons.y To g.handles.y["SpeedButtons"] SetCanvas g.handles.y["SpeedButtons"] ; Set Canvas to SpeedButtons Window @ 0,0 ?? "│ \30 │ \174 │ \27 │Pg\24│ ? │Pg\25│ \26 │ \175 │ \31 │" FOR n From 0 To 9 ; Color divider bars PaintCanvas ATTRIBUTE barcolor.n 0,0+(n*4),0,0+(n*4) ENDFOR IF IsWindow(canvas.w) THEN ; Restore focus SetCanvas canvas.w ELSE SetCanvas Default ENDIF IF IsWindow(current.w) THEN Window SELECT current.w ; Restore original Window ENDIF Return ENDPROC ; =========================================================================== ; TITLE: utSpeedButtonsPressed.u ; RETURNS: No value ; DESCRIPTION: Determines which button was selected, colors it to appear ; depressed, and calls the SpeedBar dispatch procedure ; --------------------------------------------------------------------------- PROC utSpeedButtonsPressed.u( ; Handles Mouse Events on Buttons window event.y, ; Wait Proc Event DynArray pushcolor.n) ; Color for "depressed" button (11 is good) Private canvas.w, ; Current canvas current.w, ; Current window button.n, ; Which button was "pressed" y ; DynArray of Window attributes IF NImages() = 0 OR IsEmpty(Table()) THEN msWorking.u("Table is Empty",79,3,2) ELSE ; You may need code here to block activity if editing/adding a record, ; if you do not control how this proc is called from within your wait ; handler. canvas.w = GetCanvas() ; Current canvas focus LocalizeEvent event.y ; Set Row/Column position SetCanvas g.handles.y["SpeedButtons"] ; relative to current window ; Determines current Style attrib Window GetAttributes g.handles.y["SpeedButtons"] To y IF Mod(event.y["Col"],4) <> 0 THEN ; 0 = Clicked on a divider bar button.n = Int(event.y["Col"]/4)+1 ; Buttons are evenly spaced PaintCanvas Attribute pushcolor.n 0,(button.n*4)-3,0,(button.n*4)-1 utSpeedButtonsDispatch.u(button.n,pushcolor.n) Sleep 300 ; Pause for "depressed" effect PaintCanvas Attribute y["Style"] 0,(button.n*4)-3,0,(button.n*4)-1 ELSE Beep ENDIF IF IsWindow(canvas.w) THEN ; Restore focus SetCanvas canvas.w ELSE SetCanvas Default ENDIF ENDIF Return ENDPROC ; =========================================================================== ; TITLE: utSpeedButtonsDispatch.u ; RETURNS: No value ; DESCRIPTION: Dispatches actions based upon which button was pressed ; --------------------------------------------------------------------------- PROC utSpeedButtonsDispatch.u( ; Calls action appropriate to button button.n,color.n) ; Button number Private y ; Transient GetEvent DynArray ;Global g.scrollrate.n ; Scroll rate in milliseconds IF NOT IsAssigned(g.scrollrate.n) THEN ; Initialize scroll variable g.scrollrate.n = 300 ENDIF SWITCH CASE button.n = 1 : ; Home Home Message "Beginning of Table..." CASE button.n = 2 : ; Reverse Scroll IF NOT AtFirst() THEN WHILE NOT AtFirst() Skip -1 Echo NORMAL Echo OFF Message "Reverse Scroll, Record ",RecNo()," - MouseClick or Press Any Key to Stop..." Sleep g.scrollrate.n GetEvent ALL To y IF (y["Type"] = "MOUSE" AND y["Action"] = "UP") OR y["Type"] = "KEY" THEN QUITLOOP ENDIF ENDWHILE Message "You are on Record " + StrVal(RecNo()) + "..." ELSE Beep Message "You are at the First Record in this Image..." ENDIF CASE button.n = 3 : ; Skip -1 IF NOT AtFirst() THEN Skip -1 Message "Record " +Strval([#])+ "..." ELSE Beep Message "You are at the First Record in this Image..." ENDIF CASE button.n = 4 : ; PgUp IF IsFormView() THEN IF AtFirst() AND PageNo() = 1 THEN Beep IF NPages() = 1 THEN Message "You are at the First Record in this Image..." ELSE Message "You are at the First Record's First Page in this Image..." ENDIF ELSE PgUp IF NPages() = 1 THEN Message "Record " +StrVal([#])+ "..." ELSE Message "Page " +StrVal(PageNo())+ " of Record "+Strval([#])+ "..." ENDIF ENDIF ELSE PgUp Message "Record " +StrVal([#])+ "..." ENDIF CASE button.n = 5 : ; Help utSpeedButtonsHelp.u() CASE button.n = 6 : ; PgDn IF IsFormView() THEN IF AtLast() AND PageNo() = NPages() THEN Beep IF NPages() = 1 THEN Message "You are at the Last Record in this Image..." ELSE Message "You are at the Last Record's Last Page in this Image..." ENDIF ELSE PgDn IF NPages() = 1 THEN Message "Record " +StrVal([#])+ "..." ELSE Message "Page " +StrVal(PageNo())+ " of Record "+Strval([#])+ "..." ENDIF ENDIF ELSE PgDn Message "Record " +StrVal([#])+ "..." ENDIF CASE button.n = 7 : ; Skip 1 IF NOT AtLast() THEN Skip 1 Message "Record " +Strval([#])+ "..." ELSE Beep ENDIF CASE button.n = 8 : ; Forward Scroll IF NOT AtLast() THEN WHILE NOT AtLast() Skip 1 Echo NORMAL Echo OFF Message "Forward Scroll, Record ",RecNo()," - MouseClick or Press Any Key to Stop..." Sleep g.scrollrate.n GetEvent ALL To y IF (y["Type"] = "MOUSE" AND y["Action"] = "UP") OR y["Type"] = "KEY" THEN QUITLOOP ENDIF ENDWHILE Message "You are on Record " + StrVal(RecNo()) + "..." ELSE Beep Message "You are at the Last Record in this Image..." ENDIF CASE button.n = 9 : ; End End Message "End of Table..." OTHERWISE : Beep ; Clicked a divider bar ENDSWITCH Return ENDPROC ; =========================================================================== ; TITLE: utSpeedButtonsHelp.u ; RETURNS: No value ; DESCRIPTION: Popup Dialog with descriptions of SpeedButton icons, and ; embedded Dialog Box to set scroll rate in milliseconds ; --------------------------------------------------------------------------- PROC utSpeedButtonsHelp.u() ; Description of SpeedButton icons Private button.l ; Pushbutton variable SHOWDIALOG "Help on Using Speed Buttons" Proc "utSpeedButtonsHelpDB.l" Trigger "UPDATE" @ 1,0 Height 18 Width 37 @ 1,1 ?? "┌───────────────────────────────┐" @ 2,1 ?? "│ │" @ 3,1 ?? "│ \030 Home: 1st record in table │" @ 4,1 ?? "│ \174 Reverse continuous scroll │" @ 5,1 ?? "│ \027 Back/Up one record │" @ 6,1 ?? "│ Pg\024 Page up │" @ 7,1 ?? "│ Pg\025 Page down │" @ 8,1 ?? "│ \026 Next/Down one record │" @ 9,1 ?? "│ \175 Forward continuous scroll │" @10,1 ?? "│ \031 End: Last record in table │" @11,1 ?? "│ │" @12,1 ?? "└───────────────────────────────┘" PaintCanvas Attribute 48 1,1,12,33 PaintCanvas Attribute 59 1,33,12,33 PaintCanvas Attribute 59 12,2,12,33 PaintCanvas Attribute 59 3,3,10,5 PushButton @ 14,3 Width 14 "~C~ontinue" OK Default Value true Tag "OK" To button.l PushButton @ 14,19 Width 14 "~S~crollRate" Value false Tag "RATE" To button.l ENDDIALOG Return ENDPROC ; =========================================================================== ; TITLE: utSpeedButtonsHelpDB.l ; RETURNS: No value ; DESCRIPTION: Embedded Dialog Box to set scroll rate for Scrolling icons ; --------------------------------------------------------------------------- PROC utSpeedButtonsHelpDB.l( ; Set scroll rate for SpeedButtons type.a, ; EVENT or TRIGGER tag.a, ; Control element tag or null event.v, ; DynArray of GetEvent, or control value element.a) ; Checkbox label or null Private button.l IF type.a = "UPDATE" AND tag.a = "RATE" THEN SHOWDIALOG "In Tenth Seconds" @ 17,15 Height 6 Width 26 PaintCanvas Fill "1 5 9 13 17 20" Attribute SysColor(1003) 1,2,1,21 Slider @ 0,1 Horizontal Length 22 Min 100 Max 2000 ArrowStep 100 PageStep 500 Tag "SLIDER" To g.scrollrate.n PushButton @ 2,7 Width 10 "~S~elect" OK Default Value true Tag "OK" To button.l ENDDIALOG ENDIF Return true ENDPROC ; ******************************************************************* ; THE FOLLOWING IS AN EXAMPLE OF HOW TO SEE THE MOUSE TOOLS IN ACTION ; ******************************************************************* ;View SomeTableHere ; SUBSTITUTE A NON-EMPTY TABLE NAME ;utSpeedButtonsEnable.u(0,0,"") ;Message "Press <Esc> to Cancel Demonstration..." ;WHILE true ; Echo Normal Echo Off ; GetEvent Mouse "UP" Key 27 To test.y ; IF test.y["Type"] = "KEY" THEN ; QUITLOOP ; ENDIF ; utSpeedButtonsPressed.u(test.y,11) ;ENDWHILE