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 = 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 = initDate createParam = initTime createParam = atFocus createParam = 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 // 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 for y = 1 to 3 ctrlType = ctrlTypes 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 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 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 = 2022 st = 1 st = 0 ; // Sunday st = 9 st = 0 st = 0 st = 0 st = 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 = st + 1 st = st + 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 initTime = createParam 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 lastYear = createParam 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 : "/1" next tmp = oconv( iconv( tmp, "DH" ), "DHL" ) for x = 1 to 12 tmp = tmp[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 if bLen( ownerID ) else // wut? @@window->center( TRUE$ ) return end ownerSize = rti_Convert( createParam, @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, @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_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 for y = 1 to 3 ctrlType = ctrlTypes 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 = CLR_USEDEFAULT$ cs = CLR_TRANSPARENT$ cs = CLR_TRANSPARENT$ cs = FALSE$ @object.cells->cellStyle( colorPos<1>, colorPos<2>, PS_EDT_CS_NORMAL$, FALSE$, cs ) end end cs = "" cs = .edt_Day->PDT_UDP_SELFORECOLOR$ cs = .edt_Day->PDT_UDP_SELBACKCOLORCOLOR$ cs = cs cs = 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 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 = 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 = CLR_USEDEFAULT$ cs = ( $system->visualStyleColor{SYSCOLOR_WINDOW$} + 1 ) cs = cs 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 = errorText msgArray = "!" msgArray = -2 msgArray = -2 msgArray = "C" msgArray = 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 /////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////