1049 lines
33 KiB
Plaintext
1049 lines
33 KiB
Plaintext
function SRP_EDITOR_TEMP_POPUP_SUB_SYSPROG(void)
|
|
|
|
******************************************************************************
|
|
*
|
|
* This program is proprietary and is not to be used by or disclosed
|
|
* to others, nor is it to be copied without written permission from
|
|
* Revelation Technologies, Inc.
|
|
*
|
|
* Name : Popup_Sub
|
|
* Description: This procedure implements the creation event for a Popup, and
|
|
* is responsible for dynamically configuring the display of the
|
|
* Popup to match the Popup's definition.
|
|
* See Also : Popup (the remainder of the Popup functionality)
|
|
* Popup_Equates (structure of the Popup definition)
|
|
*
|
|
* History : (date, initials, notes)
|
|
* 02/02/95 cp Merged from Popup() and Popup_WinEvent()
|
|
* 03/30/95 vg Fixed backcolor
|
|
* 04/04/95 vg Added suppress blank lines and getfirstpage
|
|
* 05/04/95 vg Fixing columns from a row ( aka MV support )
|
|
* 07/14/95 cp Removing "@" properties, replacing with labelled common
|
|
* Adding the DataSet as a data source
|
|
* Replacing Get_ and Set_Property with PS_ versions
|
|
* Consolidating as many Get_ and Set_Properties as possible
|
|
* 01/17/96 cp Sizing the popup window caused it to become visible; put
|
|
* the SIZE property at the end so make crisper appearance.
|
|
* 03/27/96 cp Disabling parent before calling Yield()
|
|
* 03/28/96 cp Fixed C and F types (wrong variable used as file handle)
|
|
* 01/24/97 cp Fixed multi-arg for DataSet type popups (was @vm, now @fm)
|
|
* 03/17/97 cp Fixed truncation and empty title suffixes
|
|
* 06/17/97 cp Disable ALL button until all results retrieved
|
|
* 06/17/97 cp Added support for RGB structure vs. value; modified error
|
|
* handling to store/restore global status (search "Error:");
|
|
* retrieving extended error information for DataSet Popups
|
|
*
|
|
******************************************************************************
|
|
|
|
* external routines
|
|
declare function PS_Get_Property, Get_Status, GetSystemMetrics, Repository
|
|
declare function SendMessage, OpenNote, GetNoteField, EntID
|
|
declare subroutine Utility, Set_Status, RList, Make.List, Send_Event, Yield
|
|
declare subroutine PS_Set_Property, Popup, CloseNote, Post_Event
|
|
declare subroutine End_Dialog, End_Window, Send_Message
|
|
|
|
* insert records
|
|
$insert UIRes_Equates
|
|
$insert Popup_Equates
|
|
$insert ReposErrors
|
|
$insert PS_Equates
|
|
$insert DS_Equates
|
|
$insert XO_Equates
|
|
$insert Logical
|
|
|
|
* control ID's
|
|
equ ET_POPUP$ to ".ET_POPUP"
|
|
equ CB_OK$ to ".CB_OK"
|
|
equ CB_CANCEL$ to ".CB_CANCEL"
|
|
equ CB_CLEAR$ to ".CB_CLEAR"
|
|
equ CB_ALL$ to ".CB_ALL"
|
|
equ CB_FIND$ to ".CB_FIND"
|
|
|
|
* edit-table justifications
|
|
equ DTCS_LEFT$ to 0
|
|
equ DTCS_CENTER$ to 64
|
|
equ DTCS_RIGHT$ to 128
|
|
equ DTCS_HEADLEFT$ to 1024
|
|
equ DTCS_HEADCENTER$ to 256
|
|
equ DTCS_HEADRIGHT$ to 512
|
|
equ DTCS_LOCKED$ to 8192
|
|
|
|
* edit-table messages (assume that WM_USER is 1024)
|
|
equ DTM_GETDTMETRICS$ to 1120
|
|
|
|
* edit-table styles
|
|
equ DTS_HSCROLL$ to 1048576
|
|
equ DTS_VSCROLL$ to 2097152
|
|
equ DTS_ROWSELECT$ to 256
|
|
equ DTS_MULTIROW$ to 512
|
|
equ DTS_VGRID$ to 128
|
|
equ DTS_HGRID$ to 64
|
|
equ DTS_ROWBUTTONS$ to 8192
|
|
equ DTS_ROWNUMBERS$ to 16384
|
|
equ DTS_LARGEDATA$ to 4096
|
|
equ DTS_RESIZE$ to 8
|
|
equ DTS_OWNERDEF$ to 48
|
|
equ DTS_BORDER$ to 8388608
|
|
|
|
* edit-table metrics
|
|
equ DT_ROWHEIGHT$ to 1
|
|
equ DT_ROWWIDTH$ to 2
|
|
equ DT_HEADINGHT$ to 3
|
|
equ DT_LABELWIDTH$ to 4
|
|
|
|
* system metrics
|
|
equ SM_CXVSCROLL$ to 2
|
|
equ SM_CYHSCROLL$ to 3
|
|
|
|
* metrics for the popup window (all numbers should be even to avoid conversion problems to dialog units)
|
|
equ HMARGIN$ to 16 ;* left and right margins
|
|
equ VMARGIN$ to 16 ;* top and bottom margins
|
|
equ HBUTTON$ to 80 ;* button width
|
|
equ VBUTTON$ to 24 ;* button height
|
|
equ HBUTTONSPACE$ to 10 ;* horizontal button spacing (if on botton)
|
|
equ VBUTTONSPACE$ to 6 ;* vertical button spacing (if on right side)
|
|
equ HROWBUTTONEXTRA$ to 10 ;* extra width to add to row buttons (to pad numbers)
|
|
equ HROWBUTTONDFT$ to 14 ;* default button size (if no row numbers)
|
|
|
|
* misc
|
|
equ MAX_LIST_LEN$ to 65000
|
|
equ MAX_PAGE_ROWS$ to 100 ;* maximum number of rows per page (~80 @1600x1200)
|
|
|
|
|
|
*********************************
|
|
* parse the passed popup template
|
|
*********************************
|
|
|
|
* in case anyone calls this from the command-line
|
|
if @window # "POPUP" then return ""
|
|
|
|
* put up hourglass while we set up
|
|
Utility("CURSOR", "H")
|
|
|
|
TypeOverride = Popup_Struct@
|
|
|
|
* establish default POPUP record
|
|
Popup(@window, PopRec, "", PCMDDEFAULT$)
|
|
|
|
* stub in user changes in TypeOverride to PopRec
|
|
for i = 1 to PNUMFIELDS$
|
|
if len(TypeOverride<i>) then
|
|
PopRec<i> = TypeOverride<i>
|
|
end
|
|
next i
|
|
|
|
* extract infromation about the popup into local variables
|
|
type = PopRec<PTYPE$>
|
|
field = PopRec<PFIELD$>
|
|
mode = PopRec<PMODE$>
|
|
format = PopRec<PFORMAT$>
|
|
file = PopRec<PFILE$>
|
|
display = PopRec<PDISPLAY$>
|
|
SelectMode = PopRec<PSELECT$>
|
|
cLocked = PopRec<PLOCK$>
|
|
|
|
* format argument can not be null
|
|
ColCount = count(format, @vm) + (format # "")
|
|
if ColCount else
|
|
Set_Status(TRUE$, POPUP_BADFORMAT$, field)
|
|
goto Error
|
|
end
|
|
|
|
* parse format argument into separate variables
|
|
PopFields = ""
|
|
PopWidths = ""
|
|
PopJusts = "" ;* bit pattern, column and label edit-table justification
|
|
PopJustTypes = "" ;* justification "L", "C", or "R"
|
|
PopOconvs = ""
|
|
PopHeadings = ""
|
|
|
|
* set up constants for calculating column can column header justification values
|
|
equ JUST_CODES$ to "L,l,R,r,C,c" ;* account for upper and lower case
|
|
equ JUST_DFT$ to DTCS_LEFT$
|
|
equ HJUST_DFT$ to DTCS_HEADLEFT$
|
|
just_equivs = DTCS_LEFT$: @fm: DTCS_LEFT$: @fm: DTCS_RIGHT$: @fm: DTCS_RIGHT$: @fm: DTCS_CENTER$: @fm: DTCS_CENTER$
|
|
hjust_equivs = DTCS_HEADLEFT$: @fm: DTCS_HEADLEFT$: @fm: DTCS_HEADRIGHT$: @fm: DTCS_HEADRIGHT$: @fm: DTCS_HEADCENTER$: @fm: DTCS_HEADCENTER$
|
|
|
|
for i = 1 to ColCount
|
|
* calculate the column justification value
|
|
locate format<1,i,3> in JUST_CODES$ using "," setting pos then
|
|
Just = Just_equivs<pos>
|
|
end else
|
|
Just = JUST_DFT$
|
|
end
|
|
|
|
* calculate the column header's justification value
|
|
locate format<1,i,4> in JUST_CODES$ using "," setting pos then
|
|
HJust = HJust_equivs<pos>
|
|
end else
|
|
HJust = HJUST_DFT$
|
|
end
|
|
|
|
* check if the column is "scroll locked"
|
|
if i <= cLocked and i < ColCount then
|
|
LockAttr = DTCS_LOCKED$
|
|
end else
|
|
LockAttr = 0
|
|
end
|
|
|
|
* format information for the popup window (@svm delimited)
|
|
PopJustTypes<1,1,i> = format<1,i,3>
|
|
PopHeadings <1,1,i> = format<1,i,6>
|
|
PopWidths <1,1,i> = format<1,i,2>
|
|
PopJusts <1,1,i> = Just + HJust + LockAttr
|
|
|
|
* store information on this column
|
|
PopFields<1,i> = format<1,i,1>
|
|
PopOconvs<1,i> = format<1,i,5>
|
|
next i
|
|
|
|
* store Popup information in common block
|
|
Popup_Struct@ = PopRec
|
|
Popup_ColCount@ = ColCount
|
|
Popup_Oconvs@ = PopOconvs
|
|
Popup_Fields@ = PopFields
|
|
|
|
begin case
|
|
case type _EQC "F"
|
|
if num(Field) and len(Field) else
|
|
Set_Status(TRUE$, POPUP_BADFIELD$, field)
|
|
goto Error
|
|
end
|
|
Popup_Type@ = Type
|
|
Popup_Field@ = Field
|
|
|
|
case type _EQC "K"
|
|
Popup_Struct@<PTYPE$ > = "C"
|
|
Popup_Struct@<PFIELD$> = 0
|
|
Popup_Type@ = "F"
|
|
Popup_Field@ = ColCount + 1
|
|
|
|
case type _EQC "C"
|
|
if len(Field) else
|
|
Set_Status(TRUE$, POPUP_BADFIELD$, field)
|
|
goto Error
|
|
end
|
|
Popup_Type@ = "F"
|
|
Popup_Field@ = ColCount + 1
|
|
|
|
case Type = "P"
|
|
Popup_Type@ = "F"
|
|
Popup_Field@ = ColCount + 1
|
|
|
|
case OTHERWISE$
|
|
Popup_Type@ = Type
|
|
Popup_Field@ = Field
|
|
end case
|
|
|
|
|
|
**********************
|
|
* build the popup rows
|
|
**********************
|
|
|
|
EditTableList = "" ;* list passed in create param for edit table control
|
|
List = "" ;* list set immediately after edit table created
|
|
RowCount = 0
|
|
bRetrieve = FALSE$
|
|
|
|
convert @lower.case to @upper.case in mode
|
|
Popup_Struct@<PMODE$> = mode
|
|
|
|
* if the popup gets its data from a file then open the file
|
|
locate mode in "T,C,K,R,F" using "," setting Pos then
|
|
open File to fData else
|
|
Set_Status(TRUE$, POPUP_BADFILE$, File)
|
|
goto Error
|
|
end
|
|
open "DICT.": File to fDict else
|
|
open "SYSDICT" to fDict else
|
|
Set_Status(TRUE$, POPUP_BADFILE$, File)
|
|
goto Error
|
|
end
|
|
end
|
|
Popup_hFile@ = fData: @fm: fDict
|
|
end
|
|
|
|
* set up data or data retrieval based on the specified mode
|
|
locate mode in "D,N,L,T,C,K,R,F" using "," setting Pos then
|
|
Error = FALSE$
|
|
on Pos gosub DataSet, Notes, Literal, Table, Table, Table, Row, Field
|
|
if Error then goto Error
|
|
end else
|
|
Set_Status(TRUE$, POPUP_BADMODE$, mode)
|
|
goto Error
|
|
end
|
|
|
|
if bRetrieve then
|
|
* get at least one page of data to determine page size
|
|
RowCount = 0
|
|
List = Popup(MAX_PAGE_ROWS$, RowCount, "", PCMDRETRIEVE$)
|
|
begin case
|
|
case RowCount = 0
|
|
* no rows at all
|
|
gosub popup_empty
|
|
bRetrieve = FALSE$
|
|
case RowCount < MAX_PAGE_ROWS$
|
|
* no more rows to retrieve
|
|
bRetrieve = FALSE$
|
|
end case
|
|
end else
|
|
if RowCount then
|
|
* data output formatting
|
|
for col = 1 to ColCount
|
|
if len(PopOconvs<1,col>) then
|
|
conversion = PopOconvs<1,col>
|
|
for row = 1 to RowCount
|
|
EditTableList<row,col> = oconv(EditTableList<row,col>, conversion)
|
|
next row
|
|
end
|
|
next col
|
|
|
|
* add row number to end of each row if the number of the row is needed
|
|
if Type _EQC "P" then
|
|
col = ColCount + 1
|
|
for row = 1 to RowCount
|
|
EditTableList<row,col> = row
|
|
next row
|
|
end
|
|
|
|
convert @fm:@vm to @svm:@tm in EditTableList
|
|
end else
|
|
* change title to explain no rows
|
|
gosub popup_empty
|
|
end
|
|
end
|
|
|
|
|
|
*************************
|
|
* set up the POPUP window
|
|
*************************
|
|
|
|
Props = PS_Get_Property("SYSTEM": @rm: @window: @rm: @window: @rm: @window: ET_POPUP$: @rm: @window, "SIZE": @rm: "SIZE": @rm: "CLIENTSIZE": @rm: "HANDLE": @rm: "PARENT")
|
|
|
|
* get information on system sizes
|
|
cxVScroll = GetSystemMetrics(SM_CXVSCROLL$) ;* width of Vert Scroll bar
|
|
cyHScroll = GetSystemMetrics(SM_CYHSCROLL$) ;* height of Horiz Scroll bar
|
|
Size = field(Props, @rm, 1, 3)
|
|
convert @rm:@fm to @fm:@vm in Size
|
|
cxScreen = Size<1,3> ;* width of screen
|
|
cyScreen = Size<1,4> ;* height of screen
|
|
cxNonCli = Size<2,3> - Size<3,1>
|
|
cyNonCli = Size<2,4> - Size<3,2>
|
|
|
|
* default edit-table style
|
|
eTblStyle = DTS_LARGEDATA$
|
|
|
|
* get the average character size and other edit-table metrics based on the popup font
|
|
PS_Set_Property(@window: ET_POPUP$, "FONT", PopRec<PFONT$>)
|
|
cxChar = PS_Get_Property(@window: ET_POPUP$, "FONT") <1,1,6> + 3
|
|
hWndET = field(Props, @rm, 4)
|
|
cyRow = SendMessage(hWndET, DTM_GETDTMETRICS$, DT_ROWHEIGHT$, 0)
|
|
cyHead = SendMessage(hWndET, DTM_GETDTMETRICS$, DT_HEADINGHT$, 0)
|
|
|
|
* start with a 0-size edit-table
|
|
cxeTbl = 0
|
|
cyeTbl = 0
|
|
bHScroll = 0
|
|
bVScroll = 0
|
|
|
|
* calculate width for row buttons
|
|
if PopRec<PROWBTN$> then
|
|
if PopRec<PROWNUM$> then
|
|
eTblStyle += DTS_ROWBUTTONS$ + DTS_ROWNUMBERS$
|
|
cxRowBtn = len( RowCount ) * cxChar + HROWBUTTONEXTRA$
|
|
cxRowBtn = int((cxRowBtn + 1) / 2) * 2 ;* round up to even number (since edit-table uses dialog units)
|
|
end else
|
|
eTblStyle += DTS_ROWBUTTONS$
|
|
cxRowBtn = HROWBUTTONDFT$
|
|
end
|
|
end else
|
|
cxRowBtn = 1 ;* bug in edit-table; if the button width is 0, the vscroll won't appear
|
|
end
|
|
cxeTbl += cxRowBtn
|
|
|
|
if PopRec<PWIDTH$> > 0 and PopRec<PWIDTH$> < ColCount then
|
|
cVisCols = PopRec<PWIDTH$>
|
|
end else
|
|
cVisCols = ColCount ;* try to squeeze them all on
|
|
end
|
|
|
|
* calculate width of edit-table
|
|
for Col = 1 to ColCount
|
|
CellLen = PopWidths<1,1,Col>
|
|
HeadLen = len(PopHeadings<1,1,Col>)
|
|
if CellLen >= HeadLen then
|
|
cxCell = CellLen * cxChar
|
|
end else
|
|
cxCell = HeadLen * cxChar
|
|
end
|
|
cxCell = int((cxCell + 1) / 2) * 2 ;* round up to even number (since edit-table uses dialog units)
|
|
PopWidths<1,1,Col> = cxCell
|
|
if Col <= cVisCols then
|
|
cxeTbl += cxCell
|
|
end
|
|
next Col
|
|
|
|
* determine if the edit-table is too big to fit on the screen (needs h-scroll bar)
|
|
gosub CheckForHScroll
|
|
|
|
* calculate height of heading
|
|
if PopRec<PCOLHDR$> then
|
|
eTblStyle += DTS_OWNERDEF$
|
|
cyeTbl += cyHead
|
|
end
|
|
|
|
* calculate height of edit-table (assuming all rows visible)
|
|
bVScroll = (cyNonCli + cyeTbl + RowCount * cyRow + 2 * VMARGIN$ + not(not(PopRec<PBTNSBELOW$>)) * (VMARGIN$ + VBUTTON$) > cyScreen) ;* not(not()) insures TRUE=1 and FALSE=0
|
|
if bVScroll then
|
|
eTblStyle += DTS_VSCROLL$
|
|
* first, check if adding the v-scroll bar makes the edit-table too wide
|
|
* (if HScroll already exists, the edit-table is already as wide as possible)
|
|
if not(bHScroll) then
|
|
cxeTbl += cxVScroll
|
|
gosub CheckForHScroll
|
|
end
|
|
* determine how many rows to put on the screen
|
|
cyButRows = cyNonCli + cyeTbl + 2 * VMARGIN$ + not(not(PopRec<PBTNSBELOW$>)) * (VMARGIN$ + VBUTTON$) ;* everything but the rows
|
|
cVisRows = int((cyScreen - cyButRows) / cyRow)
|
|
if PopRec<PHEIGHT$> > 0 and PopRec<PHEIGHT$> < cVisRows then
|
|
cVisRows = PopRec<PHEIGHT$>
|
|
end else
|
|
cyButRows = cyNonCli + cyeTbl + 2 * VMARGIN$ + not(not(PopRec<PBTNSBELOW$>)) * (VMARGIN$ + VBUTTON$) ;* everything but the rows
|
|
cVisRows = int((cyScreen - cyButRows) / cyRow)
|
|
end
|
|
cyeTbl += cVisRows * cyRow
|
|
end else
|
|
if PopRec<PHEIGHT$> > 0 and PopRec<PHEIGHT$> < RowCount then
|
|
cVisRows = PopRec<PHEIGHT$>
|
|
bVScroll = TRUE$
|
|
eTblStyle += DTS_VSCROLL$
|
|
if bHScroll then
|
|
* see if we can add the vscroll bar to the popup without exceeding screen size
|
|
* (for example, if PopRec<PWIDTH$> forces display of a limited number of columns)
|
|
if cxeTbl + cxVScroll < cxScreen - (cxNonCli + 2 * HMARGIN$ + not(PopRec<PBTNSBELOW$>) * (HMARGIN$ + HBUTTON$)) then
|
|
cxeTbl += cxVScroll
|
|
end
|
|
end else
|
|
cxeTbl += cxVScroll
|
|
gosub CheckForHScroll
|
|
end
|
|
end else
|
|
cVisRows = RowCount
|
|
end
|
|
cyeTbl += cVisRows * cyRow
|
|
end
|
|
|
|
* cyeTbl is in dialog units .. round up to closes dialog unit (2 pixels)
|
|
cyeTbl = int((cyeTbl + 2) / 2) * 2
|
|
|
|
* selection mode
|
|
begin case
|
|
case SelectMode = 1 ;* single selection
|
|
eTblStyle += DTS_ROWSELECT$
|
|
case SelectMode = 2 ;* multi-selection
|
|
eTblStyle += DTS_MULTIROW$
|
|
case SelectMode = 3 ;* ordered multi-selection
|
|
eTblStyle += DTS_MULTIROW$
|
|
end case
|
|
|
|
* other optional edit-table styles
|
|
* note: not(not()) insures TRUE=1 and FALSE=0
|
|
* note: none of these affect the edit-table size
|
|
eTblStyle += DTS_BORDER$ * not(not(PopRec<PBORDER$>)) + DTS_RESIZE$ * not(not(PopRec<PRESIZE$>))
|
|
eTblStyle += DTS_HGRID$ * not(not(PopRec<PHGRID$> )) + DTS_VGRID$ * not(not(PopRec<PVGRID$> ))
|
|
|
|
* destroy the pre-existing edit-table
|
|
* note: this is done for speed (instead of adding individual columns) and
|
|
* to allow non-modifiable styles to be modified (by destroying and re-creating)
|
|
Utility("DESTROY", @window: ET_POPUP$)
|
|
|
|
* determine which buttons are needed
|
|
AllButtons = CB_OK$: @fm: CB_CANCEL$: @fm: CB_CLEAR$: @fm: CB_ALL$: @fm: CB_FIND$
|
|
cAllButtons = 5
|
|
ButtonList = CB_OK$
|
|
if index("123", SelectMode, 1) then
|
|
ButtonList<-1> = CB_CANCEL$
|
|
end
|
|
if SelectMode = 2 or SelectMode = 3 then
|
|
ButtonList<-1> = CB_CLEAR$
|
|
end
|
|
if SelectMode = 2 then
|
|
ButtonList<-1> = CB_ALL$
|
|
end
|
|
if PopRec<PSEARCH$> then
|
|
ButtonList<-1> = CB_FIND$
|
|
end
|
|
cButtons = count(ButtonList, @fm) + 1
|
|
|
|
* determine location and size of button row
|
|
bButtonsBelow = PopRec<PBTNSBELOW$>
|
|
if bButtonsBelow then
|
|
yButton = VMARGIN$ + cyeTbl + VMARGIN$ ;* button row position
|
|
cxButtonRow = HMARGIN$ + HBUTTON$ * cButtons + HBUTTONSPACE$ * (cButtons - 1) + HMARGIN$ ;* width of button row
|
|
cyButtonCol = 0 ;* buttons aren't in a column
|
|
end else
|
|
xButton = HMARGIN$ + cxeTbl + HMARGIN$ ;* button column position
|
|
cxButtonRow = 0 ;* buttons aren't in a row
|
|
cyButtonCol = VMARGIN$ + VBUTTON$ * cButtons + VBUTTONSPACE$ * (cButtons - 1) + VMARGIN$ ;* height of button column
|
|
end
|
|
|
|
* calculate size and position of the popup dialog based on edit-table size
|
|
cxDialog = HMARGIN$ + cxeTbl + HMARGIN$ + not(PopRec<PBTNSBELOW$>) * (HMARGIN$ + HBUTTON$)
|
|
cyDialog = VMARGIN$ + cyeTbl + VMARGIN$ + not(not(PopRec<PBTNSBELOW$>)) * (VMARGIN$ + VBUTTON$)
|
|
|
|
* check if buttons affect the dialog size
|
|
if cxButtonRow > cxDialog then
|
|
cxDialog = cxButtonRow
|
|
end
|
|
if cyButtonCol > cyDialog then
|
|
cyDialog = cyButtonCol
|
|
end
|
|
|
|
* account for the title bar and dialog border
|
|
cxDialog += cxNonCli
|
|
cyDialog += cyNonCli
|
|
|
|
* calculate position for the dialog
|
|
OwnerWindow = field(Props, @rm, 5)
|
|
OwnerSize = PS_Get_Property(OwnerWindow, "SIZE")
|
|
begin case
|
|
case OwnerWindow = "" or OwnerSize = "" or PopRec<PCOL$> = -2 or PopRec<PROW$> = -2 ;* center w.r.t. screen
|
|
xDialog = (cxScreen - cxDialog) / 2
|
|
yDialog = (cyScreen - cyDialog) / 2
|
|
case PopRec<PCOL$> = -1 or PopRec<PROW$> = -1 ;* center w.r.t. OwnerWindow
|
|
xDialog = OwnerSize<1> + (OwnerSize<3> - cxDialog) / 2
|
|
yDialog = OwnerSize<2> + (OwnerSize<4> - cyDialog) / 2
|
|
case 1 ;* position w.r.t. OwnerWindow
|
|
xDialog = OwnerSize<1> + PopRec<PCOL$>
|
|
yDialog = OwnerSize<2> + PopRec<PROW$>
|
|
end case
|
|
|
|
* make sure that the popup is on the screen
|
|
if xDialog < 0 then
|
|
xDialog = 0
|
|
end
|
|
if yDialog < 0 then
|
|
yDialog = 0
|
|
end
|
|
if xDialog + cxDialog > cxScreen then
|
|
xDialog = cxScreen - cxDialog
|
|
end
|
|
if yDialog + cyDialog > cyScreen then
|
|
yDialog = cyScreen - cyDialog
|
|
end
|
|
|
|
* move and size the popup window
|
|
CtrlList = @window
|
|
PropList = "TEXT"
|
|
ValueList = PopRec<PTITLE$>
|
|
|
|
* if the buttons are on the bottom, center them based on the new dialog size
|
|
xFirstButton = (cxDialog - cxButtonRow) / 2
|
|
|
|
* move and size the buttons (deleting unused)
|
|
for i = 1 to cAllButtons
|
|
locate AllButtons<i> in ButtonList using @fm setting pos then
|
|
if bButtonsBelow then
|
|
* button goes on the bottom
|
|
xButton = xFirstButton + (pos - 1) * (HBUTTONSPACE$ + HBUTTON$)
|
|
end else
|
|
* button goes on the right side
|
|
yButton = VMARGIN$ + (pos - 1) * (VBUTTONSPACE$ + VBUTTON$)
|
|
end
|
|
CtrlList := @rm: @window: AllButtons<i>
|
|
PropList := @rm: "SIZE"
|
|
ValueList := @rm: xButton: @fm: yButton: @fm: HBUTTON$: @fm: VBUTTON$
|
|
end else
|
|
Utility("DESTROY", @window: AllButtons<i>)
|
|
end
|
|
next i
|
|
|
|
* invisible columns are used for return values (#1) and for ordered multi-selections (#2)
|
|
if (SelectMode and Type _NEC "R" and Type _NEC "E") or (SelectMode = 3) then
|
|
ExtraCol = 1 + (SelectMode = 3)
|
|
ExtraCh = str(@svm: 132, ExtraCol)
|
|
ExtraWide = str(@svm: 0 , ExtraCol)
|
|
ExtraStyle = str(@svm: 32, ExtraCol)
|
|
end else
|
|
ExtraCol = FALSE$
|
|
ExtraCh = ""
|
|
ExtraWide = ""
|
|
ExtraStyle = ""
|
|
end
|
|
|
|
* determine if color is RGB value or structure
|
|
Color = PopRec<PBKCOLOR$>
|
|
if index(Color, @vm, 1) then
|
|
* @vm delimited structure of red, green, and blue values, each 0..255
|
|
Color = Color<1,1> + Color<1,2> * 256 + Color<1,3> * 65536
|
|
end
|
|
|
|
* create the edit-table
|
|
eTbl = ""
|
|
eTbl<1,PSPOS_NAME$> = @window: ET_POPUP$
|
|
eTbl<1,PSPOS_TYPE$> = PSCTL_EDITTABLE$
|
|
eTbl<1,PSPOS_PARENT$> = @window
|
|
eTbl<1,PSPOS_X$> = HMARGIN$
|
|
eTbl<1,PSPOS_Y$> = VMARGIN$
|
|
eTbl<1,PSPOS_WIDE$> = cxeTbl
|
|
eTbl<1,PSPOS_HIGH$> = cyeTbl
|
|
eTbl<1,PSPOS_ENABLED$> = 1
|
|
eTbl<1,PSPOS_VISIBLE$> = 1
|
|
eTbl<1,PSPOS_SDKSTYLE$> = eTblStyle
|
|
eTbl<1,PSPOS_PSSTYLE$> = 4 ;* initial focus
|
|
eTbl<1,PSPOS_TAB$> = @window: ButtonList<cButtons>
|
|
eTbl<1,PSPOS_BKCOLOR$> = Color
|
|
eTbl<1,PSPOS_LOGFONT$> = PopRec<PFONT$>
|
|
eTbl<1,PSPOS_LIST$> = EditTableList
|
|
eTbl<1,PSPOS_NUMCOLS$> = ColCount + ExtraCol
|
|
eTbl<1,PSPOS_ROWLIMIT$> = RowCount
|
|
eTbl<1,PSPOS_COLSTYLES$> = PopJusts: ExtraStyle
|
|
eTbl<1,PSPOS_COLWIDE$> = cxRowBtn: @svm: PopWidths: ExtraWide
|
|
eTbl<1,PSPOS_EVENTS$> = PSEVENT_CLICK$: @svm: PSEVENT_DBLCLK$
|
|
eTbl<1,PSPOS_LABEL$> = PopHeadings
|
|
eTbl<1,PSPOS_CHARCOUNT$> = str(@svm:132, ColCount) [2,999]: ExtraCh
|
|
Utility("CREATE", eTbl)
|
|
Popup_hWndET@ = PS_Get_Property(@window: ET_POPUP$, "HANDLE")
|
|
|
|
* instead of putting list in create param for the edit table control, it is
|
|
* set now because the create param requires @svm/@tm delim which would destroy
|
|
* any return data that had @svm's or @tm's
|
|
if len(List) then
|
|
CtrlList := @rm: @window: ET_POPUP$
|
|
PropList := @rm: "LIST"
|
|
ValueList := @rm: List
|
|
end
|
|
|
|
if Popup_Struct@<PINITSELECT$> then
|
|
CtrlList := @rm: @window: ET_POPUP$
|
|
PropList := @rm: "SELPOS"
|
|
ValueList := @rm: 1: @fm: Popup_Struct@<PINITSELECT$>
|
|
|
|
if Popup_Struct@<PSELECT$> = 3 then
|
|
cItems = count(Popup_Struct@<PINITSELECT$>, @vm) + (Popup_Struct@<PINITSELECT$> # "")
|
|
for iItem = 1 to cItems
|
|
CtrlList := str(@rm: @window: ET_POPUP$, 2)
|
|
PropList := @rm: "ACCESSPOS": @rm: "ACCESSDATA"
|
|
ValueList := @rm: Popup_ColCount@ + 2: @fm: Popup_Struct@<PINITSELECT$,iItem>: @rm: iItem
|
|
next iItem
|
|
Popup_ClickPos@<4> = cItems + 1
|
|
end
|
|
end
|
|
|
|
* if all rows are not already retrieved, disable "select all" button
|
|
if bRetrieve then
|
|
CtrlList := @rm: @window: CB_ALL$
|
|
PropList := @rm: "ENABLED"
|
|
ValueList := @rm: FALSE$
|
|
end
|
|
|
|
* set window title and make the window visible
|
|
CtrlList := @rm: @window : @rm: OwnerWindow
|
|
PropList := @rm: "SIZE" : @rm: "ENABLED"
|
|
ValueList := @rm: xDialog: @fm: yDialog: @fm: cxDialog: @fm: cyDialog: @rm: FALSE$
|
|
|
|
PS_Set_Property(CtrlList, PropList, ValueList)
|
|
|
|
* change back to arrow cursor
|
|
Utility("CURSOR", "A")
|
|
|
|
* retrieve any pending rows
|
|
if bRetrieve then
|
|
Window = @window
|
|
loop
|
|
List = Popup(cVisRows, RowCount, "", PCMDRETRIEVE$)
|
|
while len(List)
|
|
* append a page's worth of data
|
|
Send_Message(Window: ET_POPUP$, "INSERT", -1, List)
|
|
Yield()
|
|
while PS_Get_Property(Window, "HANDLE")
|
|
repeat
|
|
|
|
if PS_Get_Property(Window, "HANDLE") then
|
|
PS_Set_Property(Window: CB_ALL$, "ENABLED", TRUE$)
|
|
end
|
|
end
|
|
|
|
return 0
|
|
|
|
|
|
** internal routines **
|
|
|
|
|
|
************************
|
|
* is horiz-scroll needed
|
|
************************
|
|
CheckForHScroll:
|
|
if PopRec<PWIDTH$> > 0 and PopRec<PWIDTH$> < ColCount then
|
|
bHScroll = TRUE$
|
|
* add scroll bar style to edit-table
|
|
eTblStyle += DTS_HSCROLL$
|
|
* add scroll bar height to edit-table
|
|
cyeTbl += cyHScroll
|
|
end else
|
|
bHScroll = (cxNonCli + cxeTbl + 2 * HMARGIN$ + not(PopRec<PBTNSBELOW$>) * (HMARGIN$ + HBUTTON$) + bVScroll * cxVScroll > cxScreen)
|
|
if bHScroll then
|
|
eTblStyle += DTS_HSCROLL$
|
|
* ues as much screen as possible (not counting the buttons and the margins) for edit-table
|
|
cxeTbl = cxScreen - (cxNonCli + 2 * HMARGIN$ + not(PopRec<PBTNSBELOW$>) * (HMARGIN$ + HBUTTON$))
|
|
cxeTbl = int((cxeTbl + 1) / 2) * 2 ;* round up to even number (since edit-table uses dialog units)
|
|
* add scroll bar height to edit-table
|
|
cyeTbl += cyHScroll
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
****************
|
|
* error handling
|
|
****************
|
|
Error:
|
|
* store error
|
|
if Get_Status(StatX) then
|
|
Restore = TRUE$
|
|
Set_Status(FALSE$)
|
|
end
|
|
|
|
Send_Event(@window, "CLOSE")
|
|
|
|
* restore error
|
|
if Restore then
|
|
Set_Status(TRUE$, StatX)
|
|
end
|
|
|
|
return 0
|
|
|
|
|
|
****************************
|
|
* add message to popup title
|
|
****************************
|
|
Popup_Truncated:
|
|
PopRec<PTITLE$> = PopRec<PTITLE$>: ResToString(UIRES_TRUNCATED$, UIRES_SYSTEM$)
|
|
return
|
|
|
|
Popup_Empty:
|
|
PopRec<PTITLE$> = PopRec<PTITLE$>: ResToString(UIRES_EMPTY$, UIRES_SYSTEM$)
|
|
return
|
|
|
|
|
|
**************
|
|
* DataSet data
|
|
**************
|
|
DataSet:
|
|
DSName = Popup_Struct@<PFILE$,1>
|
|
hDS = Popup_Struct@<PFILE$,2>
|
|
XOName = Popup_Struct@<PSUBFILE$,1>
|
|
hXO = Popup_Struct@<PSUBFILE$,2>
|
|
Args = Popup_Struct@<PDISPLAY$>
|
|
|
|
* ConInfo <1>=ds <2>=xo; <n,1>=name <n,2>=handle <n,3>=owned (created by Popup)
|
|
Popup_ConInfo@<1,1> = DSName
|
|
Popup_ConInfo@<1,2> = hDS
|
|
Popup_ConInfo@<1,3> = FALSE$
|
|
Popup_ConInfo@<2,1> = XOName
|
|
Popup_ConInfo@<2,2> = hXO
|
|
Popup_ConInfo@<2,3> = FALSE$
|
|
|
|
* if a DataSet was not passed then create it
|
|
if hDS then
|
|
* verify that the DataSet is value
|
|
Flag = DSGetProperty(hDS, DS_VALID$, Valid)
|
|
if not(Valid) then
|
|
Set_Status(TRUE$, "Passed DataSet handle (": hDS: ") is invalid")
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
end else
|
|
* if a Connection was not passed then create it
|
|
if hXO then
|
|
Flag = XOGetProperty(hXO, XO_VALID$, Valid)
|
|
if not(Valid) then
|
|
Set_Status(TRUE$, "Passed Connection Object handle (": hXO: ") is invalid")
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
end else
|
|
* get the Connection name from the subkey of the DataSet
|
|
if len(XOName) else
|
|
XOName = Repository("GETSUBKEY", EntID("", DS_TYPE$, DS_CLASS$, DSName))
|
|
end
|
|
|
|
XOMethod("", XO_GETERROR$)
|
|
hXO = XOInstance(XOName)
|
|
if hXO then
|
|
Popup_ConInfo@<2,2> = hXO
|
|
Popup_ConInfo@<2,3> = TRUE$
|
|
end else
|
|
XOMethod("", XO_GETERROR$, "", "", "", "", Text)
|
|
if len(Text) then
|
|
convert @vm to "|" in Text
|
|
Text = "||": Text
|
|
end
|
|
|
|
if len(XOName) then
|
|
Set_Status(TRUE$, "Unable to connect to ": quote(XOName): ".": Text)
|
|
end else
|
|
Set_Status(TRUE$, "Unable to create connection.": Text)
|
|
end
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
end
|
|
|
|
* create the DataSet
|
|
DSMethod("", DS_GETERROR$)
|
|
hDS = DSInstance(DSName, hXO)
|
|
if hDS then
|
|
Popup_ConInfo@<1,2> = hDS
|
|
Popup_ConInfo@<1,3> = TRUE$
|
|
end else
|
|
DSMethod("", DS_GETERROR$, "", "", "", "", Text)
|
|
if len(Text) then
|
|
convert @vm to "|" in Text
|
|
Text = "||": Text
|
|
end
|
|
Set_Status(TRUE$, "Unable to create DataSet ": quote(DSName): ".": Text)
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
|
|
* set the retrieval arguments
|
|
if len(Args) then
|
|
ArgList = ""
|
|
ArgVals = ""
|
|
if index(Args, @vm, 1) then
|
|
ArgCount = count(Args<1,2>, @svm) + (Args<1,2> # "")
|
|
for iArg = 1 to ArgCount
|
|
ArgList<1,iArg> = Args<1,2,iArg>
|
|
ArgVals<iArg > = Args<1,1,iArg>
|
|
next iArg
|
|
end else
|
|
ArgCount = count(Args<1,1>, @svm) + (Args<1,1> # "")
|
|
for iArg = 1 to ArgCount
|
|
ArgList<1,iArg> = iArg
|
|
ArgVals<iArg > = Args<1,1,iArg>
|
|
next iArg
|
|
end
|
|
Flag = DSSetProperty(hDS, DS_ARG$, ArgVals, ArgList)
|
|
if not(Flag) then
|
|
Set_Status(TRUE$, "Unable to set DataSet arguments")
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
end
|
|
|
|
* convert column names to numbers (for performance reasons)
|
|
Flag = DSGetProperty(hDS, DS_COLID$, Popup_Fields@, Popup_Fields@:"")
|
|
if Flag and Popup_Struct@<PTYPE$> = "C" then
|
|
Flag = DSGetProperty(hDS, DS_COLID$, Temp, Popup_Struct@<PFIELD$>)
|
|
Popup_Struct@<PFIELD$> = Temp
|
|
end
|
|
if not(Flag) then
|
|
Set_Status(TRUE$, "Unable to verify DataSet column ID's")
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
|
|
* execute the DataSet
|
|
Flag = DSMethod(hDS, DS_EXECUTE$)
|
|
if not(Flag) then
|
|
DSMethod(hDS, DS_GETERROR$, "", "", "", "", Text)
|
|
if len(Text) then
|
|
convert @vm to "|" in Text
|
|
Text = "||": Text
|
|
end
|
|
|
|
Set_Status(TRUE$, "Unable to execute DataSet.": Text)
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
end
|
|
|
|
bRetrieve = TRUE$
|
|
return
|
|
|
|
|
|
******************
|
|
* Lotus Notes data
|
|
******************
|
|
Notes:
|
|
* for Lotus Notes, File is as follows:
|
|
* <1,1> database name
|
|
* <1,2> "NOTESFORM" or "NOTESVIEW"
|
|
* <1,3> @svm-delim list of forms/views
|
|
* <1,4> @tm-delim list of fields/columns corresponding to @svm-delim form/view
|
|
* display is either "USE view", a select script for LINEAR search, or the "searchinfo"
|
|
* parameter for the OpenNote function (with @vm's instead of @fm's)
|
|
|
|
begin case
|
|
* searchinfo structure can be passed in display
|
|
case index(Display, @vm, 1)
|
|
convert @vm to @fm in Display
|
|
|
|
* view criteria starts with the keyword "Use" followed by the view name
|
|
case display [1,4] _EQC "USE "
|
|
convert @tm to " " in display
|
|
View = field(trim(Display), " ", 2)
|
|
SubKey = Repository("GETSUBKEY", EntID(@appid<1>, "DBCOMPONENT", "NOTESVIEW", View))
|
|
Display = "INDEXED": @fm: field(SubKey, "#", 2)
|
|
|
|
* standard search criteria
|
|
case OTHERWISE$
|
|
convert @tm to " " in display
|
|
Display = "LINEAR": @fm: Display
|
|
end case
|
|
|
|
* get database name
|
|
Database = Repository("GETSUBKEY", EntID(@appid<1>, "DATASOURCE", "NOTESDB", File<1,1>))
|
|
convert "#" to @fm in Database
|
|
if len(Database) else
|
|
Set_Status(TRUE$, "Database ": quote(File<1,1>): " has not been registered")
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
|
|
* select the note id's to display
|
|
if OpenNote(Database, Display, Popup_OpenDocIDs@) then
|
|
if len(Popup_OpenDocIDs@) then
|
|
bRetrieve = TRUE$
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
**************
|
|
* literal data
|
|
**************
|
|
Literal:
|
|
* data in the "display" variable
|
|
EditTableList = display
|
|
convert @vm:@svm to @fm:@vm in EditTableList
|
|
RowCount = count(EditTableList, @fm) + (EditTableList # "")
|
|
return
|
|
|
|
|
|
*******************
|
|
* data is in a file
|
|
*******************
|
|
Table:
|
|
* build a list of keys
|
|
begin case
|
|
case mode _EQC "T"
|
|
* remove text marks (design-time formatting of criteria)
|
|
convert @tm to " " in display
|
|
* use RList to select records in the file
|
|
RList("SELECT ": file: " ": display, 5, "", "", 0)
|
|
if Get_Status() then
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
Popup_KeyList@ = 0 ;* cursor 0
|
|
|
|
case mode _EQC "C"
|
|
* user has an active cursor (has to be cursor 0 because
|
|
* "readnext key,value" only uses cursor 0)
|
|
if len(Display) and num(Display) then
|
|
Popup_KeyList@ = Display ;* cursor is specified by Display
|
|
end else
|
|
Popup_KeyList@ = 0 ;* assume cursor 0
|
|
end
|
|
|
|
case mode _EQC "K"
|
|
Popup_KeyList@ = display
|
|
convert @vm to @fm in Popup_KeyList@
|
|
end case
|
|
|
|
bRetrieve = TRUE$
|
|
return
|
|
|
|
|
|
******************************
|
|
* Columns from a specified row
|
|
******************************
|
|
Row:
|
|
* the data file has been opened to Popup_hFile@
|
|
* the record key is in display
|
|
fData = Popup_hFile@<1>
|
|
|
|
* read the record
|
|
read rec from fData, display else
|
|
Set_Status(TRUE$, POPUP_BADKEY$, display: @vm: file)
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
convert @tm to "" in rec ;* consistent display with Arev
|
|
|
|
for col = 1 to ColCount
|
|
if num(PopFields<1,col>) and len(PopFields<1,col>) then
|
|
* build the display data
|
|
FieldVal = Rec<Popfields<1,Col>>
|
|
* only count the number of rows (in the popup) for the first column
|
|
if Col = 1 then
|
|
RowCount = count(FieldVal, @vm) + (FieldVal # "")
|
|
end
|
|
for Row = 1 to RowCount
|
|
* add each value of this field to the display record
|
|
EditTableList<row, Col> = rec<PopFields<1,col>, row, 1>
|
|
next Row
|
|
end else
|
|
Set_Status(TRUE$, POPUP_NONNUM_FIELD$, PopFields<1,col>)
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
next col
|
|
return
|
|
|
|
|
|
*****************************
|
|
* Column from a specified row
|
|
*****************************
|
|
Field:
|
|
* the data file has been opened to Popup_hFile@
|
|
* the record key is in "display<1,1>"
|
|
* the column number to get the data from is in "display<1,2>"
|
|
fData = Popup_hFile@<1>
|
|
key = display<1,1>
|
|
col = display<1,2>
|
|
|
|
* verify that the column number is a number and is positive
|
|
if not(num(col)) or (col <= 0) then
|
|
Set_Status(TRUE$, POPUP_BADFIELD$, col)
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
|
|
* read the data to display
|
|
read rec from fData, key else
|
|
Set_Status(TRUE$, POPUP_BADKEY$, key: @vm: file)
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
|
|
* only getting data from one row
|
|
rec = rec<col>
|
|
RowCount = count(rec, @vm) + (rec # "")
|
|
|
|
* verify that the field names in the format argument are all
|
|
* numeric
|
|
if num(field) and len(field) else
|
|
Set_Status(TRUE$, POPUP_NONNUM_FIELD$, field)
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
for col = 1 to ColCount
|
|
if num(PopFields<1,col>) and len(PopFields<1,col>) else
|
|
Set_Status(TRUE$, POPUP_NONNUM_FIELD$, PopFields<1,col>)
|
|
Error = TRUE$
|
|
return
|
|
end
|
|
next col
|
|
|
|
* build the display data
|
|
for row = 1 to RowCount
|
|
for col = 1 to ColCount
|
|
EditTableList<row,col> = rec<1,row,PopFields<1,col>>
|
|
next col
|
|
next row
|
|
return
|
|
|