Function NDW_DATEPICKER_EVENTS(CtrlEntId, Event, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10, Param11, Param12, Param13, Param14, Param15) /*********************************************************************************************************************** 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 SRP Computer Solutions, Inc. Name : NDW_DatePicker_Events Description : Event commuter module for the NDW_DatePicker window. Notes : This is typically called by setting up a QuickEvent to execute a procedure and the procedure will be this function. The Parameters field would then contain the necessary parameters to for proper event routing in this routine. The syntax for these parameters are: 'event name','@SELF',['@PARAM1','@PARAMx'] 'event name' is the actual event that is being called (e.g. 'CREATE'). It should be surrounded by single quotes. '@SELF' will tell NDW_DatePicker_Events what the fully qualified name of the current control is. '@PARAMx' is to pass any additional parameters that the current event may have. '@SELF' and '@PARAMx' also need to be surrounded by single quotes. Parameters : Event [in] -- The event that is being executed in the window. CtrlEntId [in] -- The control that is calling the event. Param1-13 [in] -- Additional parameters that the event is passing through. History : (Date, Initials, Notes) 12/06/07 rch Original programmer. 05/27/10 rch Ported to FRAMEWORKS from DM. 08/25/10 rch Fix horizontal positioning when control is too far right for calendar to fit. 10/14/10 rch Replace GetWindowRect with calls to SRP_Get_Window_Rect. 11/10/10 rch Default new Font property to Tahoma, 8pt size. 03/04/13 dmb Add support for this window to be called as a modeless dialog. - [SRPFW-9] 10/05/13 dmb Retrofit form and commuter to use the default FrameWorks system font. - [SRPFW-17] 10/05/13 dmb Improve the logic that determines the position of the form when it is going to appear on a second monitor. Previously the logic would always force it to appear on the first monitor. - [SRPFW-18] ***********************************************************************************************************************/ $Insert APP_INSERTS $Insert EVENT_SETUP Declare function SendMessage, Send_Message, SRP_Get_Window_Rect *Declare subroutine GetWindowRect Equ DTM_READCELLRECT$ to 1079 Equ DTM_GETCELLLEFTBOTTOM$ to 1160 Equ DTA_CURRENT$ to 1 // Update the arguments so that the OpenInsight OLE event will treate the ActiveX event as a native event handler. If Event EQ 'OLE' then Transfer Event to OIEvent Transfer Param1 to Event Transfer Param2 to Param1 Transfer Param3 to Param2 Transfer Param4 to Param3 Transfer Param5 to Param4 Transfer Param6 to Param5 Transfer Param7 to Param6 Transfer Param8 to Param7 end Begin Case Case Control EQ Window Begin Case Case Event EQ "CREATE" ; GoSub CREATE Case Event EQ "INACTIVATED" ; GoSub INACTIVATED End Case Case Event EQ "CLICK" Begin Case Case Control EQ "PUB_OK" ; GoSub CLICK.PUB_OK End Case Case Control EQ "OLE_DATEPICKER" Begin Case Case Event EQ "OnDblClick" ; GoSub OnDblClick.OLE_DATEPICKER End Case End Case If Assigned(EventFlow) else EventFlow = EVENT_CONTINUE$ Return EventFlow CREATE: CreateParam = Param1 // If CreateParam has a value then this is the control that needs to get the return result. It also means this // window was launched as a modeless dialog box rather than modal. This will determine how this window should be // closed. * Set_Property(@Window, '@PARENTCONTROL', CreateParam) GoSub Set_OLE_Controls GoSub Determine_Position SRP_Show_Window(@Window, '', '', '', True$, '', True$, True$, Size, False$) return INACTIVATED: Post_Event(@Window, 'CLOSE') return CLICK.PUB_OK: GoSub Return_Date return OnDblClick.OLE_DATEPICKER: GoSub Return_Date return ******************************************** * Internal procedures follow ******************************************** Determine_Position: // Determine the Parent window MdiActive = Get_Property(Parent, "MDIACTIVE") If Len(MdiActive) then Parent = MdiActive end // Determine the control to do the lookup for CtrlId = Get_Property(Parent, "FOCUS") // Get some property values Ctrls = Parent :@RM: @Window :@RM: CtrlId :@RM: CtrlId :@RM: CtrlId :@RM: CtrlId :@RM: "SYSTEM" Props = "MDIFRAME" :@RM: "SIZE" :@RM: "TYPE" :@RM: "HANDLE" :@RM: "SELPOS" :@RM: "ORIG_TEXT" :@RM: "SIZE" Vals = Get_Property(Ctrls, Props) Frame = Field(Vals, @RM, 1) Size = Field(Vals, @RM, 2) Type = Field(Vals, @RM, 3) CtlHdl = Field(Vals, @RM, 4) SelPos = Field(Vals, @RM, 5) ProgID = Field(Vals, @RM, 6) ; // To check for OLE EditTables Screen = Field(Vals, @RM, 7) // If no frame, use window size to determine if calendar should show below or above control If Frame then WinSize = SRP_Get_Window_Rect(Frame) end else WinSize = SRP_Get_Window_Rect(Parent) end Table = (Type EQ "EDITTABLE") OR (ProgID _EQC "SRP.EditTable.1") If Table else SelPos = "" end If ProgID _EQC "SRP.EditTable.1" then // OLE EditTables need to use the CellText property ColNo = SelPos<1> RowNo = SelPos<2> Convert @FM to ";" in SelPos DfltDate = Iconv(Get_Property(CtrlId, "OLE.CellText[":SelPos:"]"), "D") end else DfltDate = Get_Property(CtrlId, "INVALUE", SelPos) end // Set initial selection to date passed in and make it visible If DfltDate then Set_Property(@Window:".OLE_DATEPICKER", "OLE.Selection", DfltDate) Send_Message(@Window:".OLE_DATEPICKER", "OLE.EnsureVisible", DfltDate) end Rect = Str(\00\, 16) CtlSize = SRP_Get_Window_Rect(CtrlId) xPos = CtlSize<1> yPos = CtlSize<2> If Table then // add x, y and y+h of cell If ProgID _EQC "SRP.EditTable.1" then CellSize = Send_Message(CtrlId, "OLE.GetCellRect", ColNo:@FM:RowNo) *xPos += CellSize<1> xPos += CellSize<1> + 1 ; // This makes alignment better yPos += CellSize<2> cyPos = yPos + CellSize<4> end else LeftBottom = SendMessage(CtlHdl, DTM_GETCELLLEFTBOTTOM$, DTA_CURRENT$, 0) xPos += mod(LeftBottom, 65536) cyPos = yPos + int(LeftBottom / 65536) // Get y position with different SendMessage call SendMessage(CtlHdl, DTM_READCELLRECT$, DTA_CURRENT$, GetPointer(Rect)) yPos += seq(Rect [5,1]) + (seq(Rect [6,1]) * 256) end end else // get y+h of control cyPos = CtlSize<2> + CtlSize<4> end // get y+h of frame or parent window MaxCy = WinSize<2> + WinSize<4> // Set x and y of calendar window Size<1> = xPos If Size<1> + Size<3> GT Screen<1> AND (Screen<1> GT Size<1>) then // Shift calendar to left to fit on screen Size<1> = Screen<1> - Size<3> end If cyPos+Size<4> GT MaxCy then // Position above control so calendar shows fully Size<2> = yPos - Size<4> end else Size<2> = cyPos end return Return_Date: ParentControl = Get_Property(@Window, '@PARENTCONTROL') SelDate = Get_Property(@Window : '.OLE_DATEPICKER', 'OLE.Selection') If Len(ParentControl) then Send_Event(ParentControl, 'UPDATE', SelDate) Post_Event(@Window, 'CLOSE') end else End_Dialog(@Window, SelDate) end // Since we are ending the window now, there is no need to allow the event chain to continue. // If we do, then we will get the "labeled common variable has been freed and is no longer valid" error. EventFlow = EVENT_CONTINUE_NO_SYSTEM$ return Set_OLE_Controls: Ctrl = @Window : '.OLE_DATEPICKER' SizeWindow = Get_Property(@Window, 'SIZE') SizePicker = -1 : @FM : -1 : @FM : SizeWindow<3> : @FM : SizeWindow<4> Set_Property(Ctrl, 'SIZE', SizePicker) Set_Property(Ctrl, 'OLE.Theme', 'Windows7Blue') Set_Property(Ctrl, 'OLE.Font', SystemFont$) Set_Property(Ctrl, 'OLE.Selection', CreateParam) // Use asynchronous event handling (because in Dialog Box) Send_Message(@Window:".OLE_DATEPICKER", "QUALIFY_EVENT", "ALL_OLES", 1) return