Category : Paradox DBMS
Archive   : POPEYE.ZIP
Filename : POPEYE.SC

CreateLib "j:\\pdoxdata\\vreports\\vrpopups"

;*******************************************************************************
; Procedure: AcceptEx_Fixed(), updated November 8, 1990
; Size: Approximately 4,900 bytes
; Developer: Eric S. Taylor, May 21, 1990
; Version: 3.0 (because of 3.5's downward compatibility, it is assumed
; that this procedure will work with it
; Implementation: Canvas Only
; Performance: A little sluggish searching for a first-letter match; a
; little sluggish appearing on the screen, but disappears
; immediately; subsequent calls clock in faster due to
; file buffering (or network caching).
; Description: AcceptEx_Fixed() is an EXtended ACCEPT statement based on
; a FIXED set of choices in a popup window. This procedure is
; two-fold in nature: a) when the popup window isn't displayed,
; the user still doesn't have to type in the choices. He can
; scroll through them using the right and left arrow keys
; and the various choices will appear in the field. He can
; also press the first letter of the choice(s) if he know it
; (them); b) when the popup window is displayed, the choices
; will appear in the field as the user scrolls through them
; in the window. First letter searches are performed, backwards
; and forwards, even if there are duplicate letters. The window
; remembers the last item highlighted upon subsequent calls to it.
; Tables: AcceptEx_Fixed() expects a single-field table with the field
; name being "Choices." Up to 23 choices can be handled
; (the entire screen, with room for a top and bottom border).
; Special Notes: Since Paradox doesn't have any buffering commands for the
; Canvas, you have to overcome the redisplaying of underlying
; screen content by calling a screen template. One of the
; parameters of AcceptEx_Fixed() accepts a template function name,
; including its parameters, inside double quotes. This
; template will automatically be called whenever appropriate.
; Also, a Help procedure is supported. Using the EXECUTE
; statement, AcceptEx_Fixed() builds the Help procedure in
; the following mannger: EXECUTE "Help" + STRVAL(ROW()) + "()".
; The help procedure called is sensitive to the current row
; of the cursor. If the cursor is on row 10, for example,
; pressing [F1] will try to call Help10(). This can be
; changed to suit your needs. You could even add another
; parameter to the list to accommodate an alternative help
; routine.
; AcceptEx_Fixed() uses the question mark (63) to call the
; popup window. This can be changed.
; The procedure GetFxPop() is called to actually display the
; window.
; Whether you'll use a template or a help function or not, you
; must specify the name of a function, even it just contains
; a return statement.
;*******************************************************************************

Proc AcceptEx_Fixed(PUTABLE,PUDEFLT,PUATT,PUCWIDTH,AROW,ACOL,LCOL,LW,ATXTCLR,IPFIELD,DATATEMP)
Private x,r

;PUTABLE - Table upon which popup window is based
;PUDEFLT - The default value passed from somewhere in your application
; as the first choice to be highlighted. Pass a "" if you
; wish the initial choice to be the first one
;PUATT - Combined foreground and background attribute of highlight bar
;PUCWIDTH - Width of the popup window
;AROW - AROW and ACOL specify the location of the first character
;ACOL of the field where the choices must appear
;LCOL - The column of the beginning of the field description (the
; same row as AROW is assumed)
;LW - The width of the field description
;ATXTCLR (Not used currently)
;IPFIELD - Variable to which to assign the selection made
;DATATEMP - Screen template for simulating buffering techniques
;r - Stores next row for highlight bar

;** Test for monitor type and set highlight bar to reverse video if monochrome **
If Monitor() <> "Color"

Then

PUATT = 112

Endif

;** NOTES **
;When you display a field on the screen, it is typically accompanied by a field
;description: 1. Beginning Job Number <<<<<<
;The split highlight bar implementation allows you to highlight both the
;description and the field itself. You can adjust this to either or none, if you like
;This should explain the LCOL and LW variables

;** Display split highlight bar **
PaintCanvas Attribute PUATT
AROW,LCOL,AROW,LCOL + LW - 1

PaintCanvas Attribute PUATT
AROW,ACOL,AROW,ACOL + PUCWIDTH - 1

;** Bring fixed selection table on to workspace **
View PUTABLE
Right

;** If default value is a null string, move to top of table **
Moveto [Choices]
Locate Pattern PUDEFLT

If Retval = false

Then

MoveTo Record 1

Endif

;** Display default information **
Style Attribute PUATT
@AROW,ACOL ?? PUDEFLT

;** Initialize status **
@AROW,ACOL

;** Main loop **
While true

;IT WOULD BE ADVISABLE TO INCLUDE CODE FOR A PROMPT HERE
;** Display Prompt **
; Your code here

Cursor Normal
@AROW,ACOL
Canvas On

x = GetChar()

Switch

Case x = 27:
;** User pressed Escape **

Return x

Case x = 13 Or x = -80:
;** User processed selection with either Enter or Down. The
; use of the left and right arrows to scroll through choices
; when the window isn't displayed is deliberate. It is assumed
; that the up and down arrows will be used to move through fields. **

Execute IPFIELD + "= FieldStr()"

;** NOTES **
;The field change analysis can be disabled by commenting out the following line.
;If you use it, however, your program must support the FLDCHANG variable elsewhere

;Test current field value with current selection to see if changed
Execute "If " + IPFIELD + "<> FieldStr() Then FLDCHANG = 1 Endif"

;Do NOT replace 13 with x - the Down key is mapped to the Enter key
Return 13

Case (x >= 42 And x <= 122) And x <> 63:
;** Attempt to match based on first letter **

;Make sure we're in the right field
CtrlEnd
Zoom Select Chr(x) + ".."

Case x = -75 Or x = -77:
;** Left, Right **

KeyPress x
KeyPress x

Case x = -71 Or x = -79 Or x = -81 Or x = -73:
;** Home, End, Page Down, Page Up **

KeyPress x

Case x = -59:
;** User called Help **

;** NOTES **
;To accommodate an alternate help routine:
; Replace the first two lines with your own code

Execute "Help" + StrVal(AROW) + "()"
Execute "Release Procs Help" + StrVal(AROW)
Execute DATATEMP

;** NOTES **
;You can replace the keycode 63 (?) with any keycode

Case x = 63:
;User pressed the question mark to call popup window

;Get the window
GetFxPop()
Release Procs GetFxPop

;If the Enter key was passed back from the window...then pass it
;back again to the procedure that called AcceptEx_Fixed()
If Retval = 13

Then Return x

Endif

Case x = -72:
;** Up **

;Assign the current choice to the current field, then leave the field
Execute IPFIELD + "= FieldStr()"
;Pass the keycode back to the procedure that called AcceptEx_Fixed()
Return x

EndSwitch

;** Update canvas with underlying information **
Canvas Off
Style Attribute PUATT
@AROW,ACOL ?? Spaces(PUCWIDTH)
@AROW,ACOL ?? [Choices]

EndWhile

EndProc
WriteLib "j:\\pdoxdata\\vreports\\vrpopups" AcceptEx_Fixed
Release Procs AcceptEx_Fixed

;*******************************************************************************
; Procedure: GetFxPop(), update November 9, 1990
; Size: Approximately 5,680 bytes
; Developer: Eric S. Taylor, May 21, 1990
; Version: 3.0 (because of 3.5's downward compatibility, it is assumed
; that this procedure will work with it)
; Implementation: Canvas Only
; Performance: Same as AcceptEx_Fixed(); for memory conservation, the
; window routine is separated from the field routine.
; Description: This is the popup window counterpart to AcceptEx_Fixed();
; Remember, AcceptEx_Fixed() has two parts: a) the field
; display, and b) the field and window display.
; Special Notes: Same as AcceptEx_Fixed()
; Tables: Same as AcceptEx_Fixed()
;*******************************************************************************

Proc GetFxPop()

;IT WOULD BE ADVISABLE TO PUT A PLEASE WAIT TYPE OF MESSAGE HERE
;** Please Wait sign **
; Your code here

;** Outer screen-drawing loop **
While true

;** Save current position
r = RecNo()

;** Draw window **
PopBordD(AROW + 2,ACOL - 1,AROW + NRecords(PUTABLE) + 3,ACOL + PUCWIDTH,PUATT,14,0)
Release Procs PopBordD

;IT WOULD BE ADVISABLE TO INSERT CODE FOR A PROMPT HERE
;** Print incidental help **
; Your code here

;** Print choices in window **
Scan

@AROW + 2 + RecNo(),ACOL ?? [Choices]

EndScan

;** Return to saved position and highlight that choice **
MoveTo Record r
r = AROW + 2 + RecNo()

;** NOTES **
;To accommodate variable color:
; Change the 110 to a variable, and then add a formal parameter to the list.

PaintCanvas Attribute 110
r,ACOL,r,ACOL + PUCWIDTH - 1
@r,ACOL

;** Popup loop (Change the definition of movement keys) **
While true

;** Update Window **
Canvas Off
Style Attribute PUATT
@AROW,ACOL ?? Spaces(PUCWIDTH)
@AROW,ACOL ?? [Choices]
@AROW + 2 + RecNo(),ACOL

Canvas On

x = GetChar()

Switch

Case x = 27:
;** User pressed Escape **

;** Call data template, but first update field so template has the right value **
Execute IPFIELD + "= [Choices]"
Execute DATATEMP
Cursor Normal

QuitLoop

Case x = 13:
;** User processed selection **

Execute IPFIELD + "= FieldStr()"
Execute DATATEMP

;** NOTES **
;GetFxPop() supports field change analysis. Your program must support the FLDCHANG
;variable elsewhere. You can disable this feature by deleting this line of code

Execute "If " + IPFIELD + "<> FieldStr() Then FLDCHANG = 1 Endif"
ClearAll
Return x

Case x = -72 Or x = -80 Or x = -71 Or x = -79:
;** All standard movement keys **

KeyPress x

;** NOTES **
;The PageUp and PageDown keys are not supported by Paradox tables, so they must
;be re-mapped
Case x = -73:
;** Page Up (Map to Home) **

KeyPress -71

Case x = -81:
;** Page Down (Map to End) **

KeyPress -79

Case x >= 42 And x <= 122:
;** Match by first letter **

MoveTo [Choices]
Zoom Select Chr(x) + ".."

Case x = -59:
;** User called Help **

;** NOTES **
;To accommodate alternate help:
; Replace the following two lines of code with your own.

Execute "Help" + StrVal(AROW) + "()"
Execute "Release Procs Help" + StrVal(AROW)
Execute DATATEMP

;Failing to set x = 1 will cause the popup window to disappear upon return
;from the help screen

x = 1
QuitLoop

EndSwitch

Canvas Off

;** Unhighlight previous choice **
PaintCanvas Attribute 14
Row(),ACOL,Row(),ACOL + PUCWIDTH - 1

;** Highlight current choice **
PaintCanvas Attribute 110
AROW + 2 + RecNo(),ACOL,AROW + 2 + RecNo(),ACOL + PUCWIDTH - 1

EndWhile

;Help must have been processed
If x = 1

Then Loop

Endif

@AROW,ACOL
;Return an ESCAPE status to AcceptEx_Fixed()
Return 27

EndWhile

EndProc
WriteLib "j:\\pdoxdata\\vreports\\vrpopups" GetFxPop
Release Procs GetFxPop


;*******************************************************************************
; Procedure: PopBordD(), updated November 8, 1990
; Size: Approximately 2,180 bytes
; Developer: Eric S. Taylor, July 17, 1990
; Version: 3.0 (because of 3.5's downward compatibility, it is assumed
; that this procedure will work with it)
; Implementation: Canvas or Workspace (with Echo Normal)
; Performance: Excellent
; Description: PopBordD() displays a Double Line Border according to
; coordinates and color attribute information. It was originally
; written to work with popup windows, but can be implemented
; for any window-drawing requirements.
;*******************************************************************************

Proc PopBordD(orowtl,ocoltl,orowbr,ocolbr,promptclr,bordfore,bordback)

;orowtl - Outer row, top left corner
;ocoltl - Outer column, top left corner
;orowbr - Outer row, bottom right corner
;ocolbr - Outer column, bottom right corner

;promptclr - (Not used currently)
;bordfore - Foreground color attribute
;bordback - Background color attribute

Canvas Off
Cursor Off

PaintCanvas Fill Chr(32) Attribute 0
orowtl,ocoltl,orowbr,ocolbr

Style Attribute bordfore+bordback

@orowtl,ocoltl+1 ?? Fill("M",ocolbr-ocoltl)
@orowbr,ocoltl+1 ?? Fill("M",ocolbr-ocoltl)

For I From orowtl+1 To orowbr-1

@I,ocoltl ?? ":"
@I,ocolbr ?? ":"

Endfor

@orowtl,ocoltl ?? "I" @orowtl,ocolbr ?? ";" @orowbr,ocoltl ?? "H" @orowbr,ocolbr ?? "<"

Canvas On

EndProc
WriteLib "j:\\pdoxdata\\vreports\\vrpopups" PopBordD
Release Procs PopBordD

;*******************************************************************************
; Procedure: PopBordS(), updated November 8, 1990
; (Carries the same implementation as PopBordD(), except PopBordS() draws a
; Single Line Border)
;*******************************************************************************

Proc PopBordS(orowtl,ocoltl,orowbr,ocolbr,promptclr,bordfore,bordback)

Canvas Off
Cursor Off

PaintCanvas Attribute 0
orowtl,ocoltl,orowbr,ocolbr

Style Attribute bordfore+bordback

@orowtl,ocoltl+1 ?? Fill("D",ocolbr-ocoltl)
@orowbr,ocoltl+1 ?? Fill("D",ocolbr-ocoltl)

For I From orowtl+1 To orowbr-1

@I,ocoltl ?? "3"
@I,ocolbr ?? "3"

Endfor

@orowtl,ocoltl ?? "Z" @orowtl,ocolbr ?? "?" @orowbr,ocoltl ?? "@" @orowbr,ocolbr ?? "Y"

Canvas On

EndProc
WriteLib "j:\\pdoxdata\\vreports\\vrpopups" PopBordS
Release Procs PopBordS

;*******************************************************************************
; Procedure: PopUp_Window, updated November 8, 1990
; Size: Approximately 9,300 bytes
; Developer: Eric Taylor, July 15, 1990
; Version: Paradox 3.0 (because of 3.5's downward compatibility, it is
; assumed that this procedure will work with 3.5).
; Implementation: Canvas or Workspace; data retrieval is table-based;
; No calls to the Engine are made.
; Performance: Optimized, black box procedure; still can't overcome
; PAL's lacking for a SCROLL command; scrolling is simulated
; by quickly erasing the window and redrawing its data; this
; method CAN cause the keyboard to buffer out.
; Description: PopUp_Window() is a generic popup window routine that can
; be quickly modified in subtle ways to accomodate only one
; field, or many fields; to accomodate multiple assignments to
; different variables for a multi-field fill-in effect; and to
; accommodate variable color control.
; Tables: The table upon which the popup window is based is passed as
; a formal parameter to the procedure; the fields to display
; aren't considered until the printing loop later on in the
; procedure.
;*******************************************************************************

Proc PopUp_Window(PUTABLE,TLROW,TLCOL,PUF1W,PUF2W,MAXITEMS,ASSIGNTO)

;PUTABLE - Table upon which popup window is based
;TLROW - The row of the top left corner
;TLCOL - The column of the top left corner
;PUF1W - The width of field one (not field 1 in the sense of table position)
;PUF2W - The width of field two (not field 2 in the sense of table position)
;MAXITEMS - Maximum number of data items to be displayed in window
;counter - Keeps track of records printed in window
;offset - Beginning record (offset from record one)
;redraw - Flag that determines whether or not to reprint records
;r - Highlight bar row
;n - Number of records in popup table
;ASSIGNTO - The variable to which to assign selection

;** NOTES **
;To accommodate a different number of fields:
; Decrease or increase the number of PUFnW variables in the formal parameter list,
; where n is just a nominal field number and has no significance.

;To accommodate multiple field data assignments:
; Increase the number of ASSIGNTO variables in the formal parameter list.
; One could use a simple ASSIGNTO2, ASSIGNTO3, ASSIGNTO4, etc. naming convention.
; The PopUp_Window() procedure is an open procedure for this reason.

;IT IS ADVISABLE TO INCLUDE A PLEASE WAIT TYPE OF MESSAGE HERE
;** Please Wait sign **
; Your code goes here

;** NOTES **
;Be sure to add any variables that you create or add, to the Release Vars
;statement.

;** Destructor **
Proc Popup_TwoFields_DDD()

Release Vars PUTABLE,TLROW,TLCOL,PUF1W,PUF2W,MAXITEMS,counter,offset,redraw,r,n,ASSIGNTO,pclr,x

EndProc

;** NOTES **
;PopBordD(...) gets its information from the formal parameters passed through
;PopUp_Window(...). If you add PUFnW variables (or delete), remember to
;change the formal parameter TLCOL+PUF1W etc... The number 3 represents the
;total of the aggregate of spaces between items, + 1. For example, if you had
;four fields requiring 1 physical space between each of them, you would
;multiply 2 * 3 + 1, or 7, to arrive at the number to replace the number 3
;with below. (Remember, 3 + 2 = 5, which leaves only 1 physical space between
;an item.) The formula above reads: The number of physical spaces + 1 times
;the number of fields - 1, + 1 to make sure that the rightmost border of the
;window is right next to the last possible character of the last field.

;** Get window on screen **
PopBordD(TLROW,TLCOL,TLROW+MAXITEMS+1,TLCOL+PUF1W+PUF2W+3,110,14,0)
Release Procs PopBordD

;** Set initial status **
View PUTABLE
counter = 0
offset = 0
redraw = 1
r = TLROW + 1
n = NRecords(PUTABLE)

;** NOTES **
;To accommodate variable color:
; Turn 110 into a variable and add a color variable to the formal parameter
; list. Colors could also be encapsulated into a "color table" and read from
; the color table.

;** Determine prompt color **
If Monitor() = "Color"

Then pclr = 110
Else pclr = 112

Endif

;IT IS ADVISABLE THAT A PROMPT BE PLACED ON THE SCREEN HERE
;** Print incidental help **
; Your code goes here

While true

;** Find out if necessary to reprint **
If redraw = 1

Then

;** Reset record counter **
counter = 0
Canvas Off

;** NOTES **
;This is the brain of the procedure: getting the information to the screen.
;If you notice, [Field-1] and [Field-2] could be changed in favor of any
;field names in any order. If you wanted to add a [Field-3] and a [Field-4],
;the code would be:

; @TLROW + counter+1,TLCOL + PUF1W + PUF2W + 4 ?? [Field-3]
; @TLROW + counter+1,TLCOL + PUF1W + PUF2W + PUF3W + 6 ?? [Field-4]

;Since we have to keep getting an aggregate offset from the first column of
;the window, we have to keep adding PUFnW to the print routine. The numbers
;4 and 6 represent the aggregate of spaces between the fields. A field
;spacing of 2 (4, 6, etc...) will leave 1 physical space between the items.
;You can leave as many spaces as you like by just changing the aggregates.
;Remember, however, the window will NOT resize automatically. You have to
;pass new widths, etc., to the PopBordD() procedure.

;Be careful with numeric fields. Remember, you are hand-coding field widths,
;and this routine doesn't know how wide a numeric field should be. Be sure
;to allow an appropriate amount of space between surrounding fields so as
;not to overwrite numeric data.

;Note: [Field-1], [Field-2], etc., are not indicative of how to describe
;a field. You could have any field name. This naming convention was used
;here because the data was typically imported from an existing accounting
;system's files, saved as SDF. Paradox uses this naming convention automatically
;when importing data into a table.

;** Printing loop **
Scan

MoveTo Record 1 + offset + counter
;Erase the line first
@TLROW + counter+1,TLCOL + 1 ?? Spaces(PUF1W+PUF2W+2)
@TLROW + counter+1,TLCOL + 1 ?? [Field-1]
@TLROW + counter+1,TLCOL + PUF1W + 2 ?? [Field-2]

;** Increment record counter **
counter = counter + 1

;** Have we printed the maximum allowable records in window? **
If counter = MAXITEMS Or counter = n

Then

QuitLoop

Endif

EndScan

Canvas On

redraw = 0

EndIf

;** NOTES **
;To accommodate a greater or a lesser number of fields:
; Follow previous notes to adjust PUFnW variables here. And remember to
; adjust the aggregate spaces number from 2 to whatever (4, 6, etc...).

;** Unhighlight previous selection **
PaintCanvas Attribute 14
Row(),TLCOL + 1,Row(),TLCOL + PUF1W + PUF2W + 2

;** Highlight new selection **
PaintCanvas Attribute pclr
r,TLCOL + 1,r,TLCOL + PUF1W + PUF2W + 2

;** Update cursor **
@r,TLCOL + 1

x = getchar()

;** NOTES **
;To accommodate multiple field data return:
; For each of the Case statements, where appropriate, just add an Execute
; line for each of your ASSIGNTOn formal parameters. Refer to the 2nd line
; of the Case x = 13 statement.

Switch

Case x = 13: ;Enter key

MoveTo Record RecNo() - ((TLROW + MAXITEMS) - r)
Execute ASSIGNTO + "= [Field-1]"
Popup_TwoFields_DDD()
Release Procs Popup_TwoFields_DDD
Return

Case x = 27: ;Escape key

Popup_TwoFields_DDD()
Release Procs Popup_TwoFields_DDD
Return

Case x = -80 And AtLast() And (Row() = TLROW + MAXITEMS Or Row() = TLROW + n):
;If user pressed Down and we're at the last record and the highlight
;bar is at the bottom of the window or the highlight bar is covering
;the last item in the table (this is to cover the situation where
;the number of records in the table is less than the maximum displayable
;items.

Beep
Loop

Case x = -80 And (Row() = TLROW + MAXITEMS Or Row() = TLROW + n):
;If user pressed Down and the highlight bar is at the bottom of
;the window.

offset = offset + 1
redraw = 1

Case x = -80:
;If the user pressed Down and we have no need to scroll.

r = r + 1
Loop

Case x = -72 And (RecNo() = MAXITEMS Or (RecNo() = n And n <= MAXITEMS)) And Row() = TLROW + 1:
;If the user pressed Up and we're at the first record. The
;implementation here is a little tricky because the Scan loop that
;displays the items leaves the position in the table at the last
;item displayed. So being at the first record doesn't mean that
;the position in the table reflects the same. This was done to
;cut down on table position management.

Beep
Loop

Case x = -72 And Row() = TLROW + 1:
;If the user pressed Up and we need to scroll.

offset = offset - 1
redraw = 1

Case x = -72:
;If the user pressed Up and we do not need to scroll.

r = r - 1
Loop

Case x = -71:
;If the user pressed Home

r = TLROW + 1
offset = 0
redraw = 1

Case x = -79:
;If the user pressed End

r = Min(TLROW + MAXITEMS, TLROW + n)
offset = Max(n - MAXITEMS, 0)
redraw = 1

Case x = -73:
;If the user pressed PageUp

If RecNo() <= MAXITEMS * 2 Or RecNo() = n

Then

offset = 0

Else

offset = offset - MAXITEMS

Endif

redraw = 1
r = TLROW + 1

Case x = -81:
;If the user pressed PageDown

If RecNo() >= n - MAXITEMS

Then

offset = Max(n - MAXITEMS, 0)

Else

offset = offset + MAXITEMS

Endif

redraw = 1
r = Min(TLROW + MAXITEMS, TLROW + n)

EndSwitch

EndWhile
EndProc
WriteLib "j:\\pdoxdata\\vreports\\vrpopups" Popup_Window
Release Procs Popup_Window

;*******************************************************************************
; Procedure: Popup_Multi(), updated November 8, 1990
; Size: Approximately 11,600 bytes
; Developer: Eric S. Taylor, July 17, 1990
; Version: 3.0 (because of 3.5's downward compatibility, it is assumed
; that this procedure will work with it).
; Implementation: Canvas or Workspace; data retrieval is table-based;
; No calls to the Engine are made.
; Performance: Optimized, black box procedure; still can't overcome
; Paradox's lacking for a SCROLL command; scrolling is
; simulated by quickly erasing the screen and redrawing the
; data; this method CAN cause the keyboard to buffer out.
; Description: PopUp_Multi() is a multi-selection popup window designed to
; emulate space selection. This procedure can be modified
; in subtle ways, in the same way that PopUp_Window() can be.
; The only difference between this procedure and PopUp_Window()
; is the code necessary to mark a selection; there is no
; need for multiple ASSIGNTO statements, however, since they are
; not used in the same context as PopUp_Window().
; Tables: The same rules apply to tables in PopUp_Multi() as in
; PopUp_Window(), except for two important differences:
; a) every table to be accessed through PopUp_Multi() must
; contain an extra field for marking the selections, and
; b) because of this, PopUp_Multi() cannot be used on a
; network unless the table is first copied to the user's
; private directory temporarily, under a different name.
; There are a number of ways to handle the network situation.
; Special Notes: It would be prudent to write a little procedure to
; Restructure any table "on the fly" with the extra field
; for marking selections, and then call this procedure just
; before calling PopUp_Multi().
; This procedure prints "x Items Excluded" at a place on the
; screen and using an attribute that you designate, where x
; is the number of items excluded. You can disable this feature
; by commenting out the few lines of code that handles it.
;*******************************************************************************


Proc PopUp_Multi(PUTABLE,TLROW,TLCOL,PUF1W,PUF2W,MAXITEMS,RPTROW,RPTCOL,RPTCLR,ASSIGNTO)

;PUTABLE - Table upon which popup window is based
;TLROW - The row of the top left corner
;TLCOL - The column of the top left corner
;PUF1W - The width of field one
;PUF2W - The width of field two
;MAXITEMS - Maximum number of data items to be displayed in window
;counter - Keeps track of records printed in window
;offset - Beginning record (offset from record one)
;redraw - Flag that determines whether or not to reprint records
;r - Highlight bar row
;n - Number of records in popup table
;RPTROW - Row where number of items excluded is reported
;RPTCOL - Column " " " "
;RPTCLR - Color attributes of reported exclusions statement
;ASSIGNTO - Variable to which to assign number of items excluded


;IT WOULD BE ADVISABLE TO INLCUDE A PLEASE WAIT TYPE OF MESSAGE HERE
;** Please Wait **
; Your code goes here

;** Get window on screen **
PopBordD(TLROW,TLCOL,TLROW+MAXITEMS+1,TLCOL+PUF1W+PUF2W+5,110,14,0)
Release Procs PopBordD

;** Set initial status **
View PUTABLE
CoEditKey

;** NOTES **
;[Field-3] can be the name of any field

;** Initialize checkmark field with "_" **
MoveTo [Field-3]
Scan

[Field-3] = "_"

EndScan

counter = 0
offset = 0
redraw = 1
r = TLROW + 1
n = NRecords(PUTABLE)
NITEMSEX = 0

;** Determine prompt color **
If Monitor() = "Color"

Then pclr = 110
Else pclr = 112

Endif

While true

;** Report number of items excluded **
t = Row()

Style Attribute RPTCLR
@RPTROW,RPTCOL ?? StrVal(NITEMSEX) + " Items Excluded "

;** NOTES **
;To accommodate variable colors:
; Replace 14 with a variable and add a formal parameter to the procedure
; to accommodate color.

Style Attribute 14

@t,TLCOL + 1

;** Find out if necessary to reprint **
If redraw = 1

Then

;** Reset record counter **
counter = 0
Canvas Off

;** Printing loop **
Scan

MoveTo Record 1 + offset + counter
;Erase the line first
@TLROW + counter+1,TLCOL + 1 ?? Spaces(PUF1W+PUF2W+4)
;Display the checkmark field
@TLROW + counter+1,TLCOL + 1 ?? [Field-3]
;Begin displaying the fields
@TLROW + counter+1,TLCOL + 3 ?? [Field-1]
@TLROW + counter+1,TLCOL + PUF1W + 5 ?? [Field-2]

;** Increment record counter **
counter = counter + 1

;** Have we printed the maximum allowable records in window? **
If counter = MAXITEMS Or counter = n

Then

QuitLoop

Endif

EndScan

redraw = 0

EndIf

;** Unhighlight previous selection **
PaintCanvas Attribute 14
Row(),TLCOL + 1,Row(),TLCOL + PUF1W + PUF2W + 4

;** Highlight new selection **
PaintCanvas Attribute pclr
r,TLCOL + 1,r,TLCOL + PUF1W + PUF2W + 4

;** Update cursor **
@r,TLCOL + 1

;** Turn the lights on **
Canvas On

x = getchar()

Switch

Case x = -83:
;** User wants to reset by pressing the DEL key **

;IF WOULD BE ADVISABLE TO INCLUDE A PLEASE WAIT TYPE OF MESSAGE HERE
;** Please Wait **
; Your code goes here

Scan

[Field-3] = "_"

EndScan

offset = 0
r = TLROW + 1
Redraw = 1
NITEMSEX = 0

Case x = 32:
;** User wants to mark using the SPACE bar **

;** Save current position **
t = RecNo()

;** Offset back into window
MoveTo Record (t - ((TLROW + MAXITEMS) - r))

;** Determine whether to mark or unmark **
If [Field-3] = "*"

Then

[Field-3] = "_"
NITEMSEX = NITEMSEX - 1

Else

[Field-3] = "*"
NITEMSEX = NITEMSEX + 1

Endif

;** Rather than redraw, just print the results immediately **
@r,TLCOL + 1 ?? [Field-3]

;** Move back to original position and release scratch variable **
Moveto Record t
Release Vars t

Loop

Case x = 27:
;If user pressed ESC

Do_It!
ClearImage
Return x

Case x = -80 And AtLast() And (Row() = TLROW + MAXITEMS Or Row() = TLROW + n):
;User pressed Down...

Beep
Loop

Case x = -80 And (Row() = TLROW + MAXITEMS Or Row() = TLROW + n):
;User pressed Down...

offset = offset + 1
redraw = 1

Case x = -80:
;User pressed Down...

r = r + 1
Loop

Case x = -72 And (RecNo() = MAXITEMS Or (RecNo() = n And n <= MAXITEMS)) And Row() = TLROW + 1:
;User pressed Up...

Beep
Loop

Case x = -72 And Row() = TLROW + 1:
;User pressed Up...

offset = offset - 1
redraw = 1

Case x = -72:
;User pressed Up...

r = r - 1
Loop

Case x = -71:
;User pressed Home...

r = TLROW + 1
offset = 0
redraw = 1

Case x = -79:
;User pressed End...

r = Min(TLROW + MAXITEMS, TLROW + n)
offset = Max(n - MAXITEMS, 0)
redraw = 1

Case x = -73:
;User pressed PageUp...

If RecNo() <= MAXITEMS * 2 Or r = n

Then

offset = 0

Else

offset = offset - MAXITEMS

Endif

redraw = 1
r = TLROW + 1

Case x = -81:
;User pressed PageDown...

If RecNo() >= n - MAXITEMS

Then

offset = Max(n - MAXITEMS, 0)

Else

offset = offset + MAXITEMS

Endif

redraw = 1
r = Min(TLROW + MAXITEMS, TLROW + n)

Case x = 13:
;** User pressed enter **

;** NOTES **
;Comment out this line of code to disable the "Items Excluded" feature, and
;then remove the ASSIGNTO parameter from the procedure's list.

Execute ASSIGNTO + "= StrVal(NITEMSEX)" + " Items Excluded"
Return x

EndSwitch

EndWhile
EndProc
WriteLib "j:\\pdoxdata\\vreports\\vrpopups" Popup_Multi
Release Procs Popup_Multi

InfoLib "j:\\pdoxdata\\vreports\\vrpopups"