open-insight/SYSPROG/STPROC/RTI_POPUP_DATETIME.txt
2024-03-25 15:17:34 -07:00

1118 lines
34 KiB
Plaintext

compile function rti_Popup_DateTime( object, method, param1, param2, param3, param4, param5, param6, param7, param8 )
/*
** Copyright (C) 2012-2022 Revelation Software Inc. All Rights Reserved **
Author : Mr C
Date : 12th Jan 2022
Purpose : Commuter module for the RTI_POPUP_DATETIME form
Comments
========
This source is included as an example of dialog box programming.
Do not make modifications to this as it may be overwritten in a
future update - take a copy in your own application instead and
make modifications there.
Amended Date Reason
======= ==== ======
Mr C 19 Jul 23 Fixed DTS mode return value
Fixed DT layout (hide SECONDS controls)
Improved "S" detection when parsing time conv patterns
*/
#pragma precomp event_precomp
declare function get_Property, set_Property, retStack, rti_ErrorText
declare function ps_Get_Property, rti_Res2Str, msg, exec_Method, dialog_Box
declare function ps_TypeInfo, msWin_GetDateFormat, rti_Convert
$insert rti_Popup_DateTime_Equates
$insert ps_EditTable_Equates
$insert ps_Monitor_Equates
$insert msWin_Locale_Equates
$insert msWin_SystemTime_Equates
$insert msWin_SysColor_Equates
$insert rti_Struct_Equates
$insert rti_StrConv_Equates
$insert rti_Resources_Equates
$insert rti_SSP_Equates
$insert msg_Equates
$insert logical
$insert colors
equ FIRST_YEAR$ to 1980
equ LAST_YEAR$ to 2050
equ DAY_COUNT$ to "31,28,31,30,31,30,31,31,30,31,30,31"
equ SECS_PER_DAY$ to 86400
equ HOURS_PER_DAY$ to 24
equ SECS_PER_HOUR$ to 3600
equ SECS_PER_MINUTE$ to 60
if assigned( object ) else object = ""
if assigned( method ) else method = ""
if assigned( param1 ) else param1 = ""
if assigned( param2 ) else param2 = ""
if assigned( param3 ) else param3 = ""
if assigned( param4 ) else param4 = ""
if assigned( param5 ) else param5 = ""
if assigned( param6 ) else param6 = ""
if assigned( param7 ) else param7 = ""
if assigned( param8 ) else param8 = ""
errorText = ""
abort = FALSE$
retVal = ""
if bLen( method ) then
locate method in "CHANGED,CLOSE,CREATE,DBLCLK,POSCHANGED,WRITE" using "," setting pos then
on pos goSub onChanged,onClose,onCreate,onDblClk,onPosChanged,onWrite
end else
// ERR002: Invalid method "%1% passed to the %2% procedure
errorText = rti_Res2Str( RESID$, "ERR002", method : @fm : retStack()<1> )
abort = TRUE$
end
end else
// Assume this is one of those lazy calls that tries to work out
// where it is and then handle everything from there...
goSub onInit
end
if abort then
if bLen( errorText ) then
goSub errorMsg
if ( method = "CREATE" ) then
@@window->close( "" )
end
end
end
return retVal
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
// onInit subroutine
//
// This method is used to try and work out what the developer was intending
// when they couldn't be bothered to pass any params to the function - we
// basically look at the control with focus, and if it's something we can
// work with (i.e. it has a D,DT or MT iconv/conv then we'll do our best)
//
// Once we get something we're happy with we'll update it ourselves.
//
// ----------------------------------------------------------------------------
onInit:
// Note ... @window is not reliable here because this not an
// RTI_POPUP_DATETIME event
atFocus = $system->focus
if bLen( atFocus ) else return
bAMV = ps_TypeInfo( "ISAMVTYPE", atFocus )
conv = @atFocus->conv
colIdx = ""
rowIdx = ""
iVal = ""
begin case
case ( bAMV )
caretPos = @atFocus->caretPosX
colIdx = caretPos<1>
rowIdx = caretPos<2>
if ( colIdx and rowIdx ) then
conv = conv<0,0,colIdx>
iVal = @atFocus->inValue{colIdx,rowIdx}
end else
// wut?
atFocus = ""
end
case OTHERWISE$
iVal = @atFocus->inValue
end case
if bLen( atFocus ) then
createParam = ""
createMode = PDT_MODE_DEFAULT$
begin case
case ( conv[1,2] == "DT" )
if index( conv[-1,"B^"], "S", 1 ) then
createMode = PDT_MODE_DTS$
end else
createMode = PDT_MODE_DT$
end
case ( conv[1,2] == "MT" )
if index( conv, "S", 1 ) then
createMode = PDT_MODE_MTS$
end else
createMode = PDT_MODE_MT$
end
case ( conv[1,1] == "D" )
createMode = PDT_MODE_D$
case OTHERWISE$
null
end case
createParam<PDT_CP_POS_MODE$> = createMode
begin case
case ( createMode[1,2] == PDT_MODE_DT$ ) ; // DTS,DT
initDate = iVal[1,"."]
// Simply using the fractional part can lose us precision here,
// so we'll run it through the MT processor to get something more
// accurate
oVal = oconv( iVal, conv )
// Now find the date/time delimiter from the conv spec so we
// can extract the time...
sepDelim = " "
tmp = conv[-1,"B^"]
if bLen( tmp ) then
if num( tmp[1,1] ) then
if ( ( tmp[2,1] != "H" ) and ( tmp[2,1] != "S" ) ) then
sepDelim = tmp[2,1]
tmp[1,2] = ""
end else
tmp[1,1] = ""
end
end
end
mtConv = "MT" : tmp
oVal = oVal[-1,"B" : sepDelim]
initTime = iconv( oVal, mtConv )
if initDate else initDate = date()
if initTime else initTime = time()
case ( createMode[1,2] == PDT_MODE_MT$ ); // MTS,MT
initDate = 0
initTime = iVal
if initTime else
initTime = time()
end
case ( createMode == PDT_MODE_D$ )
initDate = iVal
initTime = 0
if initDate else
initDate = date()
end
end case
createParam<PDT_CP_POS_INITDATE$> = initDate
createParam<PDT_CP_POS_INITTIME$> = initTime
createParam<PDT_CP_POS_OWNERID$> = atFocus
createParam<PDT_CP_POS_OWNERALIGN$> = PDT_ALIGN_DEFAULT$
parentWin = @atFocus->parentForm
retVal = dialog_Box( "RTI_POPUP_DATETIME", parentWin, createParam )
if bLen( retVal ) then
if ( colIdx and rowIdx ) then
@atFocus->inValue{colIdx,rowIdx} = retVal
end else
@atFocus->inValue = retVal
end
end
end
return
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
// onChanged subroutine
//
// Main CHANGED event dispatch handler
//
// ----------------------------------------------------------------------------
// [i] param1 : NewData - this is the text that has changed.
// ----------------------------------------------------------------------------
onChanged:
transfer param1 to newData
atCtrl = field( object, ".", 2, 999 )
begin case
case ( atCtrl == "CBO_MONTH" )
goSub cboMonth_OnChanged
case ( atCtrl == "CBO_YEAR" )
goSub cboYear_OnChanged
end case
transfer newData to param1
return
///////////////////////////////////////////////////////////////////////////////
// onClose subroutine
//
// CLOSE event handler
//
// ----------------------------------------------------------------------------
// [i] param1 : Cancel Flag
// [i] param2 : Close Flags
// ----------------------------------------------------------------------------
onClose:
cancelFlag = param1
closeFlags = param2
return
///////////////////////////////////////////////////////////////////////////////
// onCreate subroutine
//
// CREATE event handler
//
// ----------------------------------------------------------------------------
// [i] param1 : CreateParam - see RTI_POPUP_DATETIME_EQUATES
// ----------------------------------------------------------------------------
onCreate:
transfer param1 to createParam
// Cache the createParam for later use
@@window->PDT_UDP_CREATEPARAM$ = createParam
// Set the "highlight colors" for EDT_DAYS - note that the FOCUSRECT color
// is already set in the FormDes
tmp = $system->visualStyleColor{SYSCOLOR_HIGHLIGHTTEXT$}
.edt_Day->PDT_UDP_SELFORECOLOR$ = tmp
tmp = $system->visualStyleColor{SYSCOLOR_HIGHLIGHT$}
.edt_Day->PDT_UDP_SELBACKCOLORCOLOR$ = tmp
createMode = createParam<PDT_CP_POS_MODE$>
// Size the window according to the mode.
goSub onCreate_LayoutControls
// Load the controls with the init data
goSub onCreate_LoadInitData
// Put it in place...
goSub onCreate_PositionDialog
// Final shuffle. Because of scaling issues sometimes the rows in EDT_DAYS
// won't fill the control properly, so what we need to do here is calculate
// how high the edit table is and resize it's height accordingly.
//
// When we do this we might need to move the time controls and resize the
// form's client height as well.
goSub onCreate_AdjustEdtDaysHeight
transfer createParam to param1
@@window->show( "" )
if ( createMode[1,2] == "MT" ) then
$system->focus = @window : ".EDL_HOUR"
end else
$system->focus = @window : ".EDT_DAY"
end
return
///////////////////////////////////////////////////////////////////////////////
// onCreate_LayoutControls subroutine
//
// Set the size of the dialog based in the mode:
//
// "D" - Hide the time controls
// "MT","MTS" - Hide the date controls
// "DT","DTS" - Leave as designed.
//
// If we are not showing the seconds ("DT" or "MT" ) then we hide the seconds
// controls. If it's an MT format then we also narrow the dialog to
// compensate.
//
// ----------------------------------------------------------------------------
// [i] createMode : Specifies the mode the dialog operates in
// ----------------------------------------------------------------------------
onCreate_LayoutControls:
begin case
case ( createMode == "D" )
// Hide the TIME controls and resize the dialog to cover them
objxArray = "@.EDL_HOUR"
objxArray := @rm : "@.UPD_HOUR"
objxArray := @rm : "@.EDL_MINUTES"
objxArray := @rm : "@.UPD_MINUTES"
objxArray := @rm : "@.EDL_SECONDS"
objxArray := @rm : "@.UPD_SECONDS"
swap "@" with @window in objxArray
call set_Property( objxArray, "VISIBLE", FALSE$ )
// Reduce the height of the dialog to the bottom of the EDT_DAY
// edit table plus a small margin
@@window->clientHeight = ( .edt_day->bottom + PDT_BORDERMARGIN$ )
case ( createMode[1,2] == "MT" )
// Hide the date controls
objxArray = "@.CBO_MONTH"
objxArray := @rm : "@.CBO_YEAR"
objxArray := @rm : "@.EDT_DAY"
swap "@" with @window in objxArray
call set_Property( objxArray, "VISIBLE", FALSE$ )
// Now move the time controls - we could have put them on a panel
// and just moved that but where's the fun then eh?
// Work out the offset height
yOffset = .cbo_month->top - .lbl_hour->top
ctrlNames = "HOUR,MINUTES,SECONDS" ; convert "," to @fm in ctrlNames
ctrlTypes = ".LBL_,.EDL_,.UPD_" ; convert "," to @fm in ctrlTypes
for x = 1 to 3
ctrlName = ctrlNames<x>
for y = 1 to 3
ctrlType = ctrlTypes<y>
ctrlID = @window : ctrlType : ctrlName
@ctrlID->offset( 0, yOffset )
next
next
// Reduce the height of the dialog to the bottom of the BTN_CANCEL
// button plus a small margin
@@window->clientHeight = ( ( .btn_Cancel->bottom ) + PDT_BORDERMARGIN$ )
if ( createMode[-1,1] != "S" ) then
// Hide the seconds controls
for y = 1 to 3
ctrlType = ctrlTypes<y>
ctrlID = @window : ctrlType : "SECONDS"
@ctrlID->visible = FALSE$
next
// And make the dialog narrower - we shouldn't need to move the
// buttons ourselves because they are right-aligned.
btnW = .btn_OK->width
minR = .upd_minutes->right
@@window->clientWidth = ( minR + btnW + ( 2 * PDT_BORDERMARGIN$ ) + PDT_BORDERMARGIN$ )
end
case OTHERWISE$
if ( createMode[-1,1] != "S" ) then
// Hide the seconds controls
ctrlTypes = ".LBL_,.EDL_,.UPD_" ; convert "," to @fm in ctrlTypes
for y = 1 to 3
ctrlType = ctrlTypes<y>
ctrlID = @window : ctrlType : "SECONDS"
@ctrlID->visible = FALSE$
next
end
end case
locate createMode in "D,DT,DTS" using "," setting pos then
// We need to load in the user locale's abbreviated day names - we start
// from a known sunday and loop through each day ...
st = ""
st<SYSTEMTIME_POS_WYEAR$> = 2022
st<SYSTEMTIME_POS_WMONTH$> = 1
st<SYSTEMTIME_POS_WDAYOFWEEK$> = 0 ; // Sunday
st<SYSTEMTIME_POS_WDAY$> = 9
st<SYSTEMTIME_POS_WHOUR$> = 0
st<SYSTEMTIME_POS_WMINUTE$> = 0
st<SYSTEMTIME_POS_WSECOND$> = 0
st<SYSTEMTIME_POS_WMILLSECONDS$> = 0
lpFormat = str_Unicode( "ddd" : \00\ ) ; // Short day name format
lpDateStr = str_Unicode( str( \00\, 10 ) )
for x = 0 to 6
st_ = var_To_Struct( st, SYSTEMTIME$ )
if msWin_GetDateFormat( LOCALE_USER_DEFAULT$, |
0, |
getPointer( st_ ), |
getPointer( lpFormat ), |
getPointer( lpDateStr ), |
10 ) then
tmp = unicode_Str( lpDateStr )[1,\00\]
colIdx = ( x + 1 )
.edt_Days.columns{colIdx}->headerText = tmp
end else
// wut?
null
end
st<SYSTEMTIME_POS_WDAYOFWEEK$> = st<SYSTEMTIME_POS_WDAYOFWEEK$> + 1
st<SYSTEMTIME_POS_WDAY$> = st<SYSTEMTIME_POS_WDAY$> + 1
next
end
return
///////////////////////////////////////////////////////////////////////////////
// onCreate_LoadInitData subroutine
//
// Set the size of the dialog based in the mode:
//
// "D" - Hide the time controls
// "MT" - Hide the date controls
// "DT" - Leave as designed.
//
// ----------------------------------------------------------------------------
// [i] createMode : Specifies the mode the dialog operates in
// [i] createParam : See RTI_POPUP_DATETIME_EQUATES
// ----------------------------------------------------------------------------
onCreate_LoadInitData:
initDate = createParam<PDT_CP_POS_INITDATE$>
initTime = createParam<PDT_CP_POS_INITTIME$>
if bLen( initDate ) else initDate = date()
if bLen( initTime ) else initTime = time()
locate createMode in "D,DT,DTS" using "," setting pos then
// Load the date controls - first preload the combos and then set
// the date...
firstYear = createParam<PDT_CP_POS_FIRSTYEAR$>
lastYear = createParam<PDT_CP_POS_LASTYEAR$>
if bLen( firstYear ) else firstYear = FIRST_YEAR$
if bLen( lastYear ) else lastYear = LAST_YEAR$
if ( lastYear < firstYear ) then
lastYear = firstYear
end else
if ( firstYear > lastYear ) then
firstYear = lastYear
end
end
tmp = fmt( initDate, "DJS" )
initYear = tmp[1,4]
initMonth = tmp[6,2]
initDay = tmp[9,2]
if ( initYear < firstYear ) then
firstYear = initYear
end else
if ( initYear > lastYear ) then
lastYear = initYear
end
end
tmp = ""
for x = 1 to 12
tmp<x> = x : "/1"
next
tmp = oconv( iconv( tmp, "DH" ), "DHL" )
for x = 1 to 12
tmp<x> = tmp<x>[1," "]
next
.cbo_month->list = tmp
.cbo_month->selPos = initMonth
tmp = ""
for x = firstYear to lastYear
tmp := x : @fm
next
tmp[-1,1] = ""
.cbo_Year->list = tmp
.cbo_Year->text = initYear
@@window->PDT_UDP_CURRDAY$ = initDay
goSub loadDaysForMonthYear
end
locate createMode in "MTS,MT,DTS,DT" using "," setting pos then
// Load the time controls
.edl_hour->text = int( initTime / SECS_PER_HOUR$ )
tmp = mod( initTime, SECS_PER_HOUR$ )
.edl_minutes->text = int( tmp / SECS_PER_MINUTE$ )
if ( createMode[-1,1] == "S" ) then
.edl_seconds->text = mod( tmp, SECS_PER_MINUTE$ )
end
end
return
///////////////////////////////////////////////////////////////////////////////
// onCreate_PositionDialog subroutine
//
// Position the dialog below it's owner using the specified horizontal
// alignment.
//
// 1) If there is not enough room to display below it owner then place it
// above
//
// 2) Ensure it stays within the bounds of it's owner's monitor
//
// ----------------------------------------------------------------------------
// [i] createParam : See RTI_POPUP_DATETIME_EQUATES
// ----------------------------------------------------------------------------
onCreate_PositionDialog:
ownerID = createParam<PDT_CP_POS_OWNERID$>
if bLen( ownerID ) else
// wut?
@@window->center( TRUE$ )
return
end
ownerSize = rti_Convert( createParam<PDT_CP_POS_OWNERSCREENSIZE$>, @vm, @fm )
colIdx = ""
rowIdx = ""
begin case
case ( @ownerID->type == "EDITTABLE" )
caretPos = @ownerID->caretPosX
colIdx = caretPos<1>
rowIdx = caretPos<2>
if bLen( ownerSize ) else
if ( colIdx and rowIdx ) then
ownerSize = @ownerID.cells{colIdx,rowIdx}->screenSize
end
end
case ps_TypeInfo( "ISAMVTYPE", ownerID )
caretPos = @ownerID->defPosProp
colIdx = caretPos<1>
rowIdx = caretPos<2>
case OTHERWISE$
if bLen( ownerSize ) else
ownerSize = @ownerID->screenSize
end
end case
if ( colIdx and rowIdx ) then
@@window->PDT_UDP_CARETPOS$ = colIdx : @fm : rowIdx
end
if bLen( ownerSize ) else
// wut?
@@window->center( TRUE$ )
return
end
ownerMon = @ownerID->monitor
winSize = @@window->size
monRect = rti_Convert( ownerMon<PS_MON_POS_WORKAREARECT$>, @vm, @fm )
ownerB = ( ownerSize<2> + ownerSize<4> )
if ( ( monRect<4> - ownerB ) < winSize<4> ) then
// Display above - I assume that if we can't display below then we'll
// be fine above and on the monitor, because no-one has a monitor that
// small, right?
winSize<2> = ( ownerSize<2> - winSize<4> )
end else
// Display below, and if we're outside the work rectangle then push us up
// until we're all on.
winSize<2> = ( ownerSize<2> + ownerSize<4> + 1 )
winB = ( winSize<2> + winSize<4> )
if ( winB > monRect<4> ) then
winSize<2> = ( monRect<4> - winSize<4> )
end
end
// Now h-Align...
if ( createParam<PDT_CP_POS_OWNERALIGN$> == PDT_ALIGN_R$ ) then
// Right align then check...
winSize<1> = ( ownerSize<1> + ownerSize<3> ) - winSize<3>
winR = ( winSize<1> + winSize<3> )
if ( winR > monRect<3> ) then
// Dialog is off the right side of the monitor so push it left
winSize<1> = monRect<3> - winSize<1>
end else
if ( winSize<1> < monRect<1> ) then
// We're off the left side (!) so push it right...
winSize<1> = monRect<1>
end
end
end else
winSize<1> = ownerSize<1>
if ( winSize<1> < monRect<1> ) then
// Dialog is off the left size of the monitor so push it back
winSize<1> = monRect<1>
end else
winR = ( winSize<1> + winSize<3> )
if ( winR > monRect<3> ) then
// Dialog is off the right side of the monitor, so push it
// back
winSize<1> = ( monRect<3> - winSize<3> )
end
end
end
winSize<5> = -1 ; // Keep invisible
@@window->size = winSize
return
///////////////////////////////////////////////////////////////////////////////
// onCreate_AdjustEdtDaysHeight subroutine
//
// ----------------------------------------------------------------------------
onCreate_AdjustEdtDaysHeight:
edtOrigH = .edt_Days->height
colHdrH = .edt_Days->colHeaderHeight
rowH = .edt_Days->rowHeight
.edt_Days->clientHeight = ( colHdrH + ( rowH * 6 ) )
edtH = .edt_Days->height
diffH = ( edtH - edtOrigH )
if ( diffH ) then
ctrlNames = "HOUR,MINUTES,SECONDS" ; convert "," to @fm in ctrlNames
ctrlTypes = ".LBL_,.EDL_,.UPD_" ; convert "," to @fm in ctrlTypes
for x = 1 to 3
ctrlName = ctrlNames<x>
for y = 1 to 3
ctrlType = ctrlTypes<y>
ctrlID = @window : ctrlType : ctrlName
@ctrlID->offset( 0, diffH )
next
next
@@window->clientHeight = ( @@window->clientHeight + diffH )
end
return
///////////////////////////////////////////////////////////////////////////////
// onDblClk subroutine
//
// Main DBLCLK event dispatch handler
//
// ----------------------------------------------------------------------------
// [i] param1 : ctrlKey - TRUE$ if the Ctrl key is down
// [i] param2 : shiftKey - TRUE$ if the Shift key is down
// [i] param3 : mouseButton - TRUE$ if the right mouseButton is down
// ---------------------------------------------------------------------------
onDblClk:
transfer param1 to ctrlKey
transfer param2 to shiftKey
transfer param3 to mouseButton
atCtrl = field( object, ".", 2, 999 )
begin case
case ( atCtrl == "EDT_DAY" )
goSub edtDay_OnDblClk
end case
transfer ctrlKey to param1
transfer shiftKey to param2
transfer mouseButton to param3
return
///////////////////////////////////////////////////////////////////////////////
// onPosChanged subroutine
//
// Main POSCHANGED event handler dispatch handler.
//
// ----------------------------------------------------------------------------
// [i] nextColumn : Column index of the current cell
// [i] nextRow : Row Index in the current cell
// ----------------------------------------------------------------------------
onPosChanged:
transfer param1 to nextColumn
transfer param1 to nextRow
atCtrl = field( object, ".", 2, 999 )
begin case
case ( atCtrl == "EDT_DAY" )
goSub edtDay_OnPosChanged
end case
transfer nextRow to param2
transfer nextColumn to param1
return
///////////////////////////////////////////////////////////////////////////////
// onWrite subroutine
//
// WRITE event handler. Return the date/time in internal format to the dialog
// owner
//
// ----------------------------------------------------------------------------
onWrite:
if ( @@window->PDT_UDP_EXECWRITE$ ) then
return
end
@@window->PDT_UDP_EXECWRITE$ = TRUE$
goSub getDateTimeValue ; // returns dtVal
@@window->closeDialog( dtVal )
return
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
// cboMonth_OnChanged subroutine
//
// CHANGED event handler for the CBO_MONTH control. When the month changes
// then update the day numbers in EDT_DAY
//
// ----------------------------------------------------------------------------
// [i] NewData : New month
// ----------------------------------------------------------------------------
cboMonth_OnChanged:
goSub loadDaysForMonthYear
return
///////////////////////////////////////////////////////////////////////////////
// cboYear_OnChanged subroutine
//
// CHANGED event handler for the CBO_YEAR control. When the year changes
// then update the day numbers in EDT_DAY
//
// ----------------------------------------------------------------------------
// [i] NewData : New year
// ----------------------------------------------------------------------------
cboYear_OnChanged:
goSub loadDaysForMonthYear
return
///////////////////////////////////////////////////////////////////////////////
// edtDay_OnDblClk subroutine
//
// DBLCLK event handler for the EDT_DAY control.
//
// If the user double-clicks on a day number then return the data to the user
//
// ----------------------------------------------------------------------------
// [i] ctrlKey - TRUE$ if the Ctrl key is down
// [i] shiftKey - TRUE$ if the Shift key is down
// [i] mouseButton - TRUE$ if the right mouseButton is down
// ---------------------------------------------------------------------------
edtDay_OnDblClk:
caretPos = @object->caretPosX
colIdx = caretPos<1>
rowIdx = caretPos<2>
dayNo = @object.cells{colIdx,rowIdx}->text
if dayNo then
@@window->writeRow( "" )
end
return
///////////////////////////////////////////////////////////////////////////////
// edtDay_OnPosChanged subroutine
//
// POSCHANGED event handler
//
// ----------------------------------------------------------------------------
// [i] param1 : nextColumn
// [i] param2 : nextRow
// ----------------------------------------------------------------------------
edtDay_OnPosChanged:
caretPos = @object->caretPosX
colIdx = caretPos<1>
rowIdx = caretPos<2>
dayNo = @object.cells{colIdx,rowIdx}->text
if bLen( dayNo ) else
// Moved onto a non-date cell so no coloring update...
return
end
@object->redraw = FALSE$
@@window->PDT_UDP_CURRDAY$ = dayNo
colorPos = @object->PDT_UDP_COLORPOS$
if bLen( colorPos ) then
if ( colorPos != caretPos ) then
cs = ""
cs<PS_EDT_CS_POS_FORECOLOR$> = CLR_USEDEFAULT$
cs<PS_EDT_CS_POS_BACKCOLORFROM$> = CLR_TRANSPARENT$
cs<PS_EDT_CS_POS_BACKCOLORTO$> = CLR_TRANSPARENT$
cs<PS_EDT_CS_POS_BOLD$> = FALSE$
@object.cells->cellStyle( colorPos<1>, colorPos<2>, PS_EDT_CS_NORMAL$, FALSE$, cs )
end
end
cs = ""
cs<PS_EDT_CS_POS_FORECOLOR$> = .edt_Day->PDT_UDP_SELFORECOLOR$
cs<PS_EDT_CS_POS_BACKCOLORFROM$> = .edt_Day->PDT_UDP_SELBACKCOLORCOLOR$
cs<PS_EDT_CS_POS_BACKCOLORTO$> = cs<PS_EDT_CS_POS_BACKCOLORFROM$>
cs<PS_EDT_CS_POS_BOLD$> = TRUE$
@object.cells->cellStyle( colIdx, rowIdx, PS_EDT_CS_NORMAL$, FALSE$, cs )
@object->PDT_UDP_COLORPOS$ = caretPos
@object->redraw = TRUE$
return
///////////////////////////////////////////////////////////////////////////////
// getDateTimeValue subroutine
//
// Extracts the data from the controls and constructs the date, time or
// datetime value that should be returned to the caller based on the create
// mode
//
// ----------------------------------------------------------------------------
// [o] dtVal : Returned date/time value
// ----------------------------------------------------------------------------
getDateTimeValue:
createParam = @@window->PDT_UDP_CREATEPARAM$
createMode = createParam<PDT_CP_POS_MODE$>
iDate = 0
iTime = 0
dtVal = ""
locate createMode in "D,DT,DTS" using "," setting pos then
dayNo = @@window->PDT_UDP_CURRDAY$
monthNo = .cbo_Month->selPos
year = .cbo_Year->text
iDate = iconv( dayNo : "/" : monthNo : "/" : year, "D4/E" )
end
locate createMode in "MTS,MT,DT,DTS" using "," setting pos then
hour = .edl_Hour->text
mins = .edl_Minutes->text
secs = .edl_Seconds->text
iTime = ( hour * SECS_PER_HOUR$ ) + ( mins * SECS_PER_MINUTE$ ) + secs
end
begin case
case ( createMode == "D" )
dtVal = iDate
case ( createMode[1,2] == "MT" )
dtVal = iTime
case OTHERWISE$
dtVal = iDate + ( iTime / SECS_PER_DAY$ )
end case
return
///////////////////////////////////////////////////////////////////////////////
// loadDaysForMonthYear
//
// This subroutine loads in the day numbers into EDT_DAY based on the Month
// and Year in their respective combos.
//
// ----------------------------------------------------------------------------
loadDaysForMonthYear:
currYear = .cbo_Year->text
currMonth = .cbo_Month->selPos
prevYear = @@window->PDT_UDP_PREVYEAR$
prevMonth = @@window->PDT_UDP_PREVMONTH$
if ( currYear == prevYear ) then
if ( currMonth == prevMonth ) then
return
end
end
.edt_Day->redraw = FALSE$
.edt_Day->PDT_UDP_COLORPOS$ = ""
currDay = @@window->PDT_UDP_CURRDAY$
if ( currDay ) else currDay = 1
firstDay = iconv( currYear : "-" : currMonth : "-01", "DJS" )
colIdx = mod( firstDay, 7 ) + 1
rowIdx = 1
currCol = ""
currRow = ""
dayCount = field( DAY_COUNT$, ",", currMonth )
if ( currMonth == 2 ) then
if ( mod( currYear, 4 ) == 0 ) and ( mod( currYear, 100 ) or mod( currYear, 400 ) == 0 ) then
// Leap Year
dayCount += 1
end
end
dayCells = ""; dayCells<6,7> = "" ; // fill the array..
for dayNo = 1 to dayCount
if ( colIdx > 7 ) then
colIdx = 1
rowIdx += 1
end
dayCells<rowIdx,colIdx> = dayNo
if ( dayNo == currDay ) then
currCol = colIdx
currRow = rowIdx
end
colIdx += 1
next
.edt_Day->list = dayCells
if ( currCol ) then
.edt_Day->caretPosX = currCol : @fm : currRow
end
// Now set any non-day cells to skipped, and the HOT color to the same as
// the back color so that hot tracking looks like it's not on.
cs = ""
cs<PS_EDT_CS_POS_FORECOLOR$> = CLR_USEDEFAULT$
cs<PS_EDT_CS_POS_BACKCOLORFROM$> = ( $system->visualStyleColor{SYSCOLOR_WINDOW$} + 1 )
cs<PS_EDT_CS_POS_BACKCOLORTO$> = cs<PS_EDT_CS_POS_BACKCOLORFROM$>
for rowIdx = 1 to 6
for colIdx = 1 to 7
dayNo = .edt_Day.cells{colIdx,rowIdx}->text
if bLen( dayNo ) else
.edt_Day.cells{colIdx,rowIdx}->skipOver = TRUE$
.edt_Day.cells->cellStyle( colIdx, rowIdx, PS_EDT_CS_NORMAL$, FALSE$, cs )
end
next
next
.edt_Day->redraw = TRUE$
return
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
// errorMsg subroutine
//
// Displays a simple error message
//
// ----------------------------------------------------------------------------
// [i] errorText : Text to display in the message
// [i] errorCaption : Caption for the message
// ----------------------------------------------------------------------------
errorMsg:
if assigned( errorCaption ) else errorCaption = ""
if bLen( errorCaption ) else
errorCaption = @@window->text
end
msgArray = ""
msgArray<MTEXT$> = errorText
msgArray<MICON$> = "!"
msgArray<MCOL$> = -2
msgArray<MROW$> = -2
msgArray<MJUST$> = "C"
msgArray<MCAPTION$> = errorCaption
call msg( @window, msgArray )
return
///////////////////////////////////////////////////////////////////////////////
// setSPError subroutine
//
// Translates an SSP status error array into a "text version" from REVERROR.DAT
//
// ----------------------------------------------------------------------------
// [i,o] errorText : SSP status error to convert. Returns the "text" version
// [o] abort : Always set to TRUE$
// ----------------------------------------------------------------------------
setSPError:
errorText = rti_ErrorText( "SP", errorText )
abort = TRUE$
return
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
$insert copyright
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////