Category : Paradox DBMS
Archive   : GOLD13.ZIP
Filename : GOLDUTL2.SC

Libname.a = "Gold1"
@ 10,0 ?? "Playing Script GOLDUTL2 "
; ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
; º º
; º Written By Harry Goldman º
; º DataBase Designs, Inc. º
; º (v) (708) 634-9355 (f) 708-634-9357 , Compuserve 75300,1733 º
; º Copyright 1992 º
; º All Rights Resevered º
; º º
; º This program can be modifeid and enhanced freely as º
; º long as the copyright and original program credits are maintained. º
; º If you enhance or modify this program, feel free to let me know, º
; º you will be credited in the next release. Resale of this program º
; º is prohibited without the written permission of the author º
; º º
; ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹
; ºSpecial Thanks to Alan Zenreich, Dan Paolini and Phil Goulson for their º
; ºideas and support. º
; ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
; ---------------------------------------------------------------------------
; Generic messaging proc, modified version originally
; written by Dan Paolini, DP Solutions
; ---------------------------------------------------------------------------
Proc Message.u(color.n, ; Color Attribute for Message
msg.a, ; Message
beep.n, ; How many times to Beep
sleep.n, ; Seconds to Sleep ( < 0 means pause)
clear.l) ; Whether to Clear after sleep
Private n ; Transient Loop counter
Canvas OFF ; Let us paint behind scenes
Switch
Case Upper(Msg.a) = "W" : Msg.a = "Working, Please Wait "
Case Upper(Msg.a) = "P" : Msg.a = "Printing, Please Wait ..."
Case Upper(Msg.a) = "Q" : Msg.a = "Querying, This Will Take A Minute "
Case Upper(Msg.a) = "J" : Msg.a = "Just A Minute"
Endswitch
Style ATTRIBUTE color.n
@ 0,0 ?? Format("w80,ac",msg.a); Centers message, colors entire line
@ 1,0
IF sleep.n < 0 THEN ; < 0 means Pause for a Keypress
?? Format("w80,ac","Press Any Key to Continue...")
ELSE
?? Fill("\205",80) ; IBM Graphics horizontal line
ENDIF
Style ; Resets Style
Canvas ON ; Admire our work

IF beep.n > 0 AND beep.n < 5 THEN
FOR n From 1 To beep.n ; Beep number of beeps
Beep Sleep 100 ; Small sleep is helpful
ENDFOR
ENDIF

WHILE CharWaiting() ; Clears any typed-ahead keys
retval = GetChar()
ENDWHILE

SWITCH
CASE sleep.n > 5 : Sleep 5000 ; We don't have all day
CASE sleep.n < 0 :
While Not CharWaiting()
Beep Beep
Sleep 500
Endwhile
retval = GetChar() ; Pause for KeyPress
CASE sleep.n = 0 : ; Don't do anything
OTHERWISE : Sleep (sleep.n * 1000)
ENDSWITCH

IF clear.l THEN ; Should we clear the message?
Paintcanvas Fill " " Attribute 111 0,0,1,79
ENDIF
Return
ENDPROC
WriteLib libname.a Message.u
Release PROCS Message.u
?? "."
; ---------------------------------------------------------------------------
; Prompt The User If They Wish To Print The Output File
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
Proc PrtFile.u(Row.n,Col.n,RptFile.a)
private Row.n,
Col.n,
RptFile.a,
Resp.n

Procname.a = "PrtFile.u"

Menu.u(Row.n,Col.n,20,3,True) ; Display a a menu
Resp.n = Retval ; Save the responce

If Resp.n = 1 Then ; User want to print
Message.u(RegMtr.n,"P",0,0,False) ; Message the user
Cursor Off ; Turn off the cursor
CheckPrinter.l() ; Check the printer
If Retval Then ; Printer is OK
Run NoRefresh "Copy "+RptFile.a+" Prn > nul" ; Print the file
Endif ;
Cursor Normal ; Restore the cursor
Endif ;
Endproc

Writelib LIBNAME.a PrtFile.u
Release Procs PrtFile.u
?? "."
;---------------------------------------------------------------------
; Check The Printer, Annoy The Operator if the printer is not online
; Slightly modified version of routine from Alan Zenreich
;---------------------------------------------------------------------
Proc checkprinter.l ()
; RETURNS a True if printer is ready
; False if printer is offline and user chooses Quit

Private choice.a
Message.u(RegMtr.n,"Checking Printer",0,0,False)

While Not PrinterStatus() ; if printer is not ready
Style Reverse
Message.u(RevMtr.n,
"Printer is not ready, press any key for options..",0,-1,True)

ShowMenu
"Continue" :
"Turn On Printer, Then Make This Choice To Continue Printing",
"Quit" : "Do Not Print"
To choice.a
Switch
Case choice.a <> "Continue":
Return False
OtherWise: ; try again
Message.u(RegMtr.n,"Checking Printer",0,0,False)
EndSwitch
EndWhile
PaintCanvas Fill(" ") Attribute 111 0,0, 1,79
Return True
EndProc
WriteLib libname.a checkprinter.l
Release Procs checkprinter.l
?? "."
; ---------------------------------------------------------------------------
; Check If an Output File Exists, If It Does, Prompt The User.
; If the user responds with "D" or "d" then delete the output
; file. Otherwise the system will append output to the previous
; output file.
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
Proc CkFile.u(Flname.a)
private Flname.a

Procname.a = "CkFile.u"

Canvas Off
If Isfile(Flname.a) Then
@ 19,0 Clear EOS
Setmargin 10
? "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
? "º A Print File Already Exists. Press [D] To Delete º"
? "º Any Other Key To Continue º"
? "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
SetMargin Off
PaintCanvas Attribute 111 19,0,24,79
PaintCanvas Attribute 118 20,10, 23,66
PaintCanvas Border Attribute 79 20,10, 23,66
Canvas On
Resp.n = GetChar() ; D will delete, any
Canvas Off ; other key to append
If Resp.n = Asc("D") Or Resp.n = Asc("d") Then ;
Run Norefresh "Del " + Flname.a
Endif
Endif

PaintCanvas Fill " " Attribute 111 20,0,24,79 ; Clear the screen
Canvas On ; Turn on the canvas
Endproc
Writelib LIBNAME.a CkFile.u
Release Procs CkFile.u
?? "."
;------------------------------------------------------------------
; Create a list of all table names. Loop through the list and remove
; any Paradox temporary tables from the list.
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
;-------------------------------------------------------------------
Proc GetTblNames.u(Type.a)

{Tools} {Info} {Inventory} ; Get a list of all tables
If Type.a = "Tables" Then ; based on the type of
Select Type.a Select DDir.a ; search requested
Else ; (RDA, non RDA)
{Files} Select DDir.a + Type.a ;
Endif ;

If Isempty("List") Then ; No tables found
Return ; quit
Endif ;

EditKey ; Remove PDOX objects
Scan For Search(Upper([Name]),
"ANSWER,CHANGED,INSERTED,DELETED,LIST,PROBLEMS,STRUCT,FAMILY,") > 0
Del Up
Endscan
Do_It! ; Save the changes
Clearall ; Clear the workspace
Endproc
Writelib Libname.a GetTblNames.u
Release Procs GetTblNames.u
?? "."
; ---------------------------------------------------------------------------
; Menu.sc is a menuing system using overlaying menus
; Steps involved :
;
; 1) Paint the entire screen a background color
; 2) determine the location of the upper left hand corner
; 3) Determine the width of the menu
; 4) determine the depth of the menu
; 5) Paint the menu
; 6) Paint the screen for shadows
;
; Parameters used :
;
; Col.n - Starting column
; Row.n - Starting Row
; Width.n - Width of the menu - default to 20
; Level.n - Menu level
; Control.l - True = Allow user access to the menu
; - False = Return to calling Proc
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
; Menuing 'engine'
; ---------------------------------------------------------------------------
Proc Menu.u(Row.n, ; Starting Row
Col.n, ; Starting column
Width.n, ; Width of the menu - default to 20
Level.n, ; Menu level
Control.l) ; Menu Access

private RowCont.n ; Counter

Procname.a = "Menu.u" ; Verify the parameters

If Row.n < 1 Or Row.n > 23 Then Row.n = 5 Endif ; passed to the routine
If Col.n < 1 Or Col.n > 79 Then Col.n = 10 Endif
If Width.n < 3 Or Width.n > 70 Then Width.n = 20 Endif
If Col.n + Width.n > 75 Then Col.n=75-Width.n Endif
If Level.n < 1 Or Level.n > 20 Then Level.n = 1 Endif
Cursor Off
Canvas Off ; Turn the screen off

@ Row.n, Col.n ?? Chr(201) + Fill(Chr(205),Width.n+2) + Chr(187) ; Top Line

Buffer.n = Int((Width.n - Len(MenuItems.r[Level.n*10])+2) / 2)

MenuItem.a = Spaces(Buffer.n) + MenuItems.r[Level.n*10] + Spaces(Buffer.n)

@ Row.n + 1, Col.n ?? Chr(186) + MenuItem.a + Chr(186)
@ Row.n + 2, Col.n ?? Chr(204) + Fill(Chr(205),Width.n+2) + Chr(185)

RowCount.n = 3 ; Initialize

; As long as the array element is assigned loop through the following
; code and put a line on the screen

While True
If Isassigned(Menuitems.r[(Level.n*10)+RowCount.n-2]) Then
MenuItem.a = Menuitems.r[(Level.n*10)+RowCount.n-2]
@ Row.n + RowCount.n, Col.n ?? Chr(186)+" " +
MenuItem.a + Fill(" ",Width.n-Len(MenuItem.a)) + Chr(186)
RowCount.n = RowCount.n + 1
If Row.n + RowCount.n > 22 Then ; Did we hit the end of the
Quitloop ; screen ? If so quit
Endif
Else
Quitloop
Endif
Endwhile

; Place the closing line on the screen

@ Row.n+RowCount.n, Col.n ?? Chr(200) + Fill(Chr(205),Width.n+2) + Chr(188)

PaintCanvas Attribute Level.n*16 Row.n,Col.n, ; Level sensitive menu
Row.n+RowCount.n, Col.n+Width.n+3 ; background
PaintCanvas Attribute Level.n*16+15 Row.n+1,Col.n+1, ; Level sensitive menu
Row.n+RowCount.n-1, Col.n+Width.n+2 ; foreground
PaintCanvas Attribute 8 ; Create the shadow
Row.n+1, Col.n+Width.n+4,
Row.n+RowCount.n+1, Col.n+Width.n+4
PaintCanvas Attribute 8
Row.n+RowCount.n+1, Col.n+1,
Row.n+Rowcount.n+1, Col.n+Width.n+4
If Control.l Then
Canvas On ; Turn the screen on
MenuCtl.u(3,3) ; Call the controller
Return Retval ; Return a value to
Else ; the calling routine
Cursor Normal
Return True
Endif

Endproc
Writelib Libname.a Menu.u
Release Procs Menu.u
?? "."
; ---------------------------------------------------------------------------
; Controller proc to control bounce bar menu
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
Proc MenuCtl.u(CursorPos.n,TopLine.n)
private Line.n, ; Current menu line
Line1.n, ; Next menu line
Charpress.n ; User pressed key

Procname.a = "MenuCtl.u"

If Not Isassigned(Roll.l) Then
Roll.l = True
Endif
If Not Isassigned(Level.n) Then
Level.n = 1
Endif
Line.n = CursorPos.n
Line1.n = 4 ; Initialize

; Stay in this loop until the user either presses [Esc] or [Enter]

While True
If Level.n = 7 Then
PaintCanvas Attribute 15 Row.n+Line.n, Col.n+1, ; Highlight the
Row.n+Line.n, Col.n+Width.n ; current line
Else
PaintCanvas Attribute 112 Row.n+Line.n, Col.n+1, ; Highlight the
Row.n+Line.n, Col.n+Width.n ; current line
Endif
Canvas On
Charpress.n = Getchar() ; Wait for keystroke
PaintCanvas Attribute Level.n*16+15 Row.n+Line.n ,Col.n+1, ; Repaint
Row.n+Line.n, Col.n+Width.n ; current line
Switch
Case Charpress.n = 27 : Return 0 ; Esc
Case Charpress.n = 13 : Return Line.n-(Topline.n-1) ; Enter
Case Charpress.n = -71 : Line1.n = TopLine.n ; Home
Case Charpress.n = -79 : Line1.n = RowCount.n-1 ; End
Case Charpress.n = -60 : Return Charpress.n ; [F2]
Case Charpress.n = -72 : Line1.n = Line.n-1 ; Up
Case Charpress.n = -80 : Line1.n = Line.n+1 ; Down
Case Charpress.n = -73 : Return -3 ; PgUp
Case Charpress.n = -81 : Return -4 ; PgDn
Otherwise : Beep
Loop
Endswitch

Switch
Case Line1.n < TopLine.n : ; Roll to end
If Roll.l Then
Line1.n = RowCount.n-1
Else
Return -1
Endif
Case Line1.n > RowCount.n-1 : ; Roll to top
If Roll.l Then
Line1.n = TopLine.n
Else
Return -2
Endif
EndSwitch
Line.n = Line1.n ; reset pointer
Endwhile
Endproc
Writelib Libname.a MenuCtl.u
Release Procs MenuCtl.u
?? "."
; ---------------------------------------------------------------------------
; Check If The User Has Access To A Table
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
Proc CheckTbl.l(Tbl.a,Echo.l)
private Tbl.a,
Form.n, Echo.l

Procname.a = "CheckTbl.l"

PW.l = False
Form.n = Form()

Lock Tbl.a PFL
If Not Retval Then
Message.u(BlkMtr.n,"Cannot Place Prevent Full Lock On Table "+
Tbl.a,2,2,True)
Return False
Endif

If IsEncrypted(Tbl.a) Then
Beep Sleep 100 Beep Sleep 100 Beep
While True
Canvas Off
If Echo.l Then
Echo Normal
Echo Off
Endif
@ 0,0 ?? Fill(" ",160)
Cursor Box
@ 10,20 ?? "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
@ 11,20 ?? "º º"
@ 12,20 ?? "º Is Password Protected º"
@ 13,20 ?? "º Please Enter The Password Or º"
@ 14,20 ?? "º Press [Esc] To Skip This Table º"
@ 15,20 ?? "º º"
@ 16,20 ?? "º Password : º"
@ 17,20 ?? "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"

@ 11,21 ?? Format("W40,AC","Table : " + Tbl.a)

Paintcanvas Attribute 112 10,20,17,62
PaintCanvas Border Attribute 79 10,20,17,62

Style Attribute 63
@ 16, 34 ??
Canvas On
Accept "A15" To PW.a
If Not Retval Then
Message.u(BlkMtr.n,
"Table "+Tbl.a+" Is Pasword Protected, Cannot Access"
,2,1,True)
Return False
Endif

Password PW.a
View Tbl.a

Cursor Off
If Directory() + Table() = Tbl.a Then
PW.l = True
ClearImage
PickForm Form.n
Quitloop
Else
Message.u(RevMtr.n,"Invalid Password",2,1,True)
EndIf
EndWhile
EndIf
Return True
Endproc
Writelib Libname.a CheckTbl.l
Release Procs CheckTbl.l
?? "."
; ---------------------------------------------------------------------------
; Get The Directory To Use
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
Proc GetDir.u(Row.n,Col.n,DirControl.l)
private Row.n, ; Row to place display on
Col.n, ; Comumn to place display on
TempDir.a, ; Temporary Directory
Dircontrol.l

Procname.a = "GetDir.u"

While True ; Loop to place a directory
While Dircontrol.l
Canvas Off
@ Row.n, 0 Clear EOS
PaintCanvas Fill " " Attribute 96 Row.n, 0, 24, 79
SetMargin Col.n
@ Row.n, Col.n

?? "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
? "º Please Enter The Working Directory To Search º"
? "º º"
? "º Or Press [Esc] To Quit º"
? "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"

SetMargin Off
PaintCanvas Attribute 9 Row.n, Col.n, Row.n+4,Col.n+49
PaintCanvas Attribute 118 Row.n, Col.n, Row.n+4, Col.n+48
PaintCanvas Attribute 96 Row.n, Col.n+50, Row.n+4, 79
PaintCanvas Border Attribute 79 Row.n, Col.n, Row.n+4, Col.n+48
PaintCanvas Attribute 9 Row.n+5, Col.n+1, Row.n+5, Col.n+49
Canvas On ; Turn The canvas back on
Cursor Normal ; Make sure the cursor is set

@ Row.n + 2, Col.n+10 ?? ; Prompt the user for the
Style Reverse ; directory to use. Default
Accept "A32" ; to the current directory
Default DefDir.a
To WDir.a
Style

If Not Retval Or Isblank(WDir.a) Then ; If the user pressed [Esc]
Return False ; do not continue
Endif

DefDir.a = Wdir.a

If WDir.a = "" Or DirExists(WDir.a) = 0 Then ; Valid directory ??
Message.u(BlkMtr.n,"Invalid Directory",2,-1,True) ; No - Message and
loop ; Loop to the top
Endif

Message.u(RegMtr.n,"Checking For Subdirectories",0,0,False)

Cursor Off ; Turn Off the cursor
If SubStr(Wdir.a,Len(Wdir.a),1) <> "\\" Then ; If needed, place a "\"
Wdir.a = Wdir.a + "\\" ; at the end of the directory
Endif ; name

Run Norefresh "Dir "+Wdir.a+"*. > GoldList" ; Use DIR to get a list
; then import the list in PDOX
Menu {Tools} {ExportImport} {Import} {Ascii} {Text} {GoldList.} {List}

If MenuChoice() = "Cancel" Then ; If a LIST file already exists
{Replace} ; replace it
Endif

TempDir.a = WDir.a ; Set the TEMP name

While Match(TempDir.a,"..\\..",CurDir.a,TempDir.a) ; Strip out all but the
EndWhile ; current directory from the
; directory name
If Isblank(CurDir.a) Or SubStr(CurDir.a,2,1) = ":" Then
CurDir.a = CurDir.a + "\\"
Endif

Array Dirs.r[Nrecords("List")] ; Create an array for directory
Dirlist.n = 2 ; names
Dirs.r[1] = CurDir.a ; first on the list is the
; current directory
Scan For Search("",Upper([Text])) > 0 ; Pull out directory names only
Dir.a = SubStr([Text],1,8) ; make sure that we do not save
If Search(".",Dir.a) < 1 Then ; the parent or current
While Match(Dir.a,".. ",Dir.a) ; directory by searching for
Endwhile ; "." This will also strip out
Dirs.r[DirList.n] = Format("CC",Lower(Dir.a)) ; directories with extensions
DirList.n = DirList.n + 1 ; and trailing blanks from the
Endif ; directory name
EndScan
Clearall

Canvas Off
PaintCanvas Fill " " Attribute 111 Row.n, 0, Row.n + 5, 79
PaintCanvas Fill " " Attribute 111 0, 0, 1, 79

@ 21,0 ?? Format("W80,AC","Select The Data Directory To Use")
@ 22,0 ?? Format("W80,AC","Or Press [F2] For All Directories")
PaintCanvas Attribute 111 21,0,24,79
Quitloop
EndWhile
While True
DirControl.l = True
GetDir.l = False
ShowDir.u() ; Show the directory list

; Showdir will return either a data directory that the user chose,
; a -60 ([F2]) ifthe user wants to use all directories, or no value if
; the user did not select a data directory and wants to quit

Switch
Case Not Retval : Return False
Case not IsAssigned(DDir.a) Or
IsBlank(DDir.a) :
Case DDir.a = -60 : ; User pressed [F2]
@ 21,0 Clear EOS
?? Format("W80,AC","Using All Subdirectories For "+WDir.a)
Quitloop
Otherwise : Quitloop
Endswitch

Canvas Off
PaintCanvas Fill " " Attribute 111 5,0,24,79
Menu.u(8,20,35,1,False)

If Level.n = 2 Then
Menu.u(11,25,25,2,False)
Endif

GetDir.l = True
Quitloop
Endwhile
If Not GetDir.l Then
QuitLoop
Endif
Endwhile

SetDir WDir.a ; User selected a directory
IF Ddir.a = -60 Then
LoopDir.l = True
DDir.a = Dirs.r[1]
If Substr(DDir.a,1,1) <> "\\" And Substr(DDir.a,2,1) <> ":" Then
DDir.a = "\\" + DDir.a
Endif
Else
LoopDir.l = False
Endif
If Substr(DDir.a,Len(DDir.a),1) <> "\\" Then
DDir.a = DDir.a + "\\"
Endif
Return true
Endproc
Writelib Libname.a GetDir.u
Release Procs GetDir.u
?? "."
; ---------------------------------------------------------------------------
; Show all subdirectories found in the working directory. Allow
; the user to select from a menu of choices, andreturn that directory
; to the calling routine as the new DATA Directory.
; Returns : DDir.a ifthe user selects a single directory
; -60 ifthe user wants to use all directories
; This routine was written for GOLD Utilities by Phil Goulson
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
Proc ShowDir.u()
private Counter.n,
col1.n,
mdepth.n,
Row.n, col.n,
fillborder.a

Procname.a = "ShowDir.u"

canvas off

Width.n = 14
CPos.n = 4
Start.n = 1
level.n = 3

Mdepth.n = Min(Start.n+10,DirList.n-1)

Col.n = abs((80-width.n)/2) ;compute start column for menu
Col1.n = Col.n + 1

row.n = 24 - 4 - mdepth.n - 4 ;compute start row for menu

fillborder.a = "É"+Fill("Í",Width.n)+"»"+"ººººÇ¶"+
fill("º",mdepth.n*2) + "È"+Fill("Í",Width.n)+"¼"

paintcanvas border fill fillborder.a
row.n, col.n, row.n +mdepth.n+4, col.n + width.n + 1

@ Row.n + 1, Col1.n ?? " SubDirectory "
@ Row.n + 2, Col1.n ?? " List "
@ Row.n + 3, Col1.n ?? Fill("Ä",Width.n)

While True
Canvas Off
paintcanvas fill " " row.n+4, col.n+1, row.n +mdepth.n+3, col.n + width.n
Setmargin Col1.n
@Row.n+3 ,0
For RowCount.n From Start.n To start.n + mdepth.n -1
? Dirs.r[RowCount.n]
EndFor

Setmargin Off
RowCount.n = RowCount.n + 4 - Start.n
PaintCanvas Attribute Level.n*16+15 Row.n, Col.n, ; paint menu
Row.n+ mdepth.n + 4, Col.n+Width.n+1 ; current line

If DirList.n > 11 Then
Roll.l = False
Else
Roll.l = True
Endif
MenuCtl.u(CPos.n,4)
Switch
Case Retval = -1 : Start.n = Max(Start.n-1,1) ;roll Up
CPos.n = 4
Case Retval = -2 : Start.n = Min(Start.n+1,DirList.n-11) ;roll Down
CPos.n = 14
Case Retval = -3 : Start.n = Max(Start.n-10,1) ;PgUp
CPos.n = 4
Case Retval = -4 : Start.n = Min(Start.n+10,DirList.n-11) ;PgDn
CPos.n = 4
Case Retval = 0 : Ddir.a = "" ;Esc
quitloop
Case Retval = 1 : DDir.a = WDir.a ;Enter on 1st
quitloop ;option
Case Retval = -60: DDir.a = -60 ;F2
quitloop
Otherwise : DDir.a = WDir.a + Dirs.r[Retval+Start.n-1] ;Enter
quitloop
EndSwitch
EndWhile
return true
EndProc
Writelib Libname.a ShowDir.u
Release Procs ShowDir.u
?? "."
; ---------------------------------------------------------------------------
; Configuration Routine For GOLD Utilities
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
Proc Cfg.u()
private Key.a,
DelChoice.a

Procname.a = "Cfg.u"

If Nimages() < 1 Or
Upper(Table()) <> "GOLDCFG" Then
View "GoldCfg"
Endif

CoEditKey
PickForm "1"
[Path] = Directory()

Canvas On

While True
Wait Record
Prompt Format("W80,AC","Please Complete All Information"),
Format("W80,AC","Press [Del] To Reset, [F2] To Save")
Until "F1", "F2",
"Del",
"Ins",
-24, 15, 18,
"PgUp", "PgDn",
"Right", "Enter", "Down",
"Left", "Up",
"Tab", "ReverseTab"

Key.a = retval

Switch
Case Key.a = "Del" :
ShowMenu
"Reset" : "Clear the current information",
"OOPPS" : "Do not clear the current information"
To DelChoice.a

If DelChoice.a = "Reset" Then
Del
Endif
Case Key.a = "F1" : Moveto [Abbrev]
PgDn
LookupHelp.u()
Case Key.a = "F2" : Quitloop
Case Key.a = "Ins" : Beep
Case Key.a = "PgUp" : Beep
Case Key.a = "PgDn" : Beep
Case Key.a = -24 : Beep
Case Key.a = 15 : Beep
Case Key.a = 18 : Beep
Otherwise :
If Field() = "Abbrev" And
Search(Key.a,"RightTabEnterDown") <> 0 Then
Beep
Loop
Endif
Keypress Key.a
Endswitch
Endwhile
[Date] = Today()
[Time] = ""
Do_It!
Canvas Off
Return True
Endproc
Writelib Libname.a Cfg.u
Release Procs Cfg.u
?? "."
; ---------------------------------------------------------------------------
; Display a header on the screen for menus
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
Proc Goldheader.u()

Procname.a = "Goldheader.u"
Cursor Off ; Turn the cusror off
Canvas Off ; Turn the canvas off
Clear ; Clear the canvas
Clearall ; Clear the workspace

@ 2,0 ?? Format("W80,AC","Welcome To The Gold Utilities")
@ 3,0 ?? Format("W80,AC","A Table Documenting Utility. Select A")
@ 4,0 ?? Format("W80,AC","Menu Choice Or [Esc] To Quit")

PaintCanvas Attribute 111 0,0,24,79 ; Entire screen
Endproc
Writelib Libname.a Goldheader.u
Release Procs Goldheader.u
?? "."
; ---------------------------------------------------------------------------
; Print a page header for record size reports
; Copyright 1991 @ Harry Goldman, DataBase Deigns, Inc.
; Permission is hereby granted by the author to re-distribute all
; or part of this script, provided that this statement,
; including the above copyright notice is included.
; ---------------------------------------------------------------------------
Proc PrintHeader.u(PgSize.n)

Procname.a = "PrintHeader.u"

If PgSize.n > 0 Then
If LineCount.n > PgSize.n Then
Print File RecFile.a "\f"
LineCount.n = 10
Else
Return
Endif
Endif

Print File RecFile.a "\n\n\n\n\n\n"
If Not IsBlank(RemoteTbl.a) Then
Print File RecFile.a Fill(" ",10)+"Table Name = " + Upper(RemoteTbl.a) +
" REMOTE TABLE "
Else
Print File RecFile.a Fill(" ",10) + "Table Name = " + Upper(Tbl.a)
Endif
Print File Recfile.a "\n\n\n"
Endproc
Writelib Libname.a PrintHeader.u
Release Procs PrintHeader.u
?? "."