added LSL2 stored procedures
This commit is contained in:
Infineon\StieberD
244
LSL2/STPROC/NDW_DATEPICKER_EVENTS.txt
Normal file
244
LSL2/STPROC/NDW_DATEPICKER_EVENTS.txt
Normal file
@ -0,0 +1,244 @@
|
||||
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
|
||||
Reference in New Issue
Block a user