pre cutover push
This commit is contained in:
Infineon\StieberD
378
SYSPROG/STPROC/POPUP_MONTH.txt
Normal file
378
SYSPROG/STPROC/POPUP_MONTH.txt
Normal file
@ -0,0 +1,378 @@
|
||||
function Popup_Month(Options, Instruction, Param)
|
||||
|
||||
******************************************************************************
|
||||
*
|
||||
* Product : OpenInsight Works!
|
||||
* Release : 3.4
|
||||
*
|
||||
* Procedure : Popup_Month
|
||||
* Description: Displays a month calendar to facilitate date entry via
|
||||
* keyboard and/or mouse.
|
||||
*
|
||||
* Usage : Popup_Month can be called as a Stored Procedure using a
|
||||
* QuickEvent. For example, call Popup_Month on the OPTIONS
|
||||
* event of each control used for date entry.
|
||||
*
|
||||
* See Also : Popup_Month
|
||||
*
|
||||
* History
|
||||
* 02/09/97 cp Original programmer.
|
||||
* 05/05/97 cp Completing for Works!
|
||||
* 12/17/01 mtr changes for 32-bit
|
||||
******************************************************************************
|
||||
|
||||
declare function Get_Property, Send_Message, Dialog_Box, SendMessage
|
||||
declare subroutine Set_Property, Send_Message, End_Dialog, Popup_Month
|
||||
declare subroutine SendMessage, GetWindowRect
|
||||
|
||||
$insert Logical
|
||||
$insert Colors
|
||||
$insert PS_Equates
|
||||
|
||||
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 DTM_READCELLRECT$ to 1079
|
||||
equ DTM_GETCELLLEFTBOTTOM$ TO 1160
|
||||
equ DTA_CURRENT$ to 1
|
||||
|
||||
|
||||
if assigned(Default ) else Default = ""
|
||||
if assigned(Instruction) else Instruction = ""
|
||||
if assigned(Param ) else Param = ""
|
||||
* mtr
|
||||
if assigned(Options ) else Options = ""
|
||||
|
||||
Ret = ""
|
||||
if len(Instruction) and num(Instruction) then
|
||||
on Instruction gosub Create, Month_Changed, Year_Changed, Day_DblClk, Day_GotFocus, Day_PosChanged, OK_Click, Cancel_Click
|
||||
end else
|
||||
gosub StartWindow
|
||||
end
|
||||
return Ret
|
||||
|
||||
************************
|
||||
* display month calendar
|
||||
************************
|
||||
StartWindow:
|
||||
* determine the control to do the lookup for
|
||||
Ctrl = Get_Property(@window, "FOCUS")
|
||||
|
||||
Ctrls = @window: @rm: Ctrl: @rm: Ctrl: @rm: Ctrl
|
||||
Props = "MDIFRAME,TYPE,HANDLE,SELPOS"
|
||||
gosub GetProps
|
||||
Frame = field(Vals, @rm, 1)
|
||||
Type = field(Vals, @rm, 2)
|
||||
Handle = field(Vals, @rm, 3)
|
||||
SelPos = field(Vals, @rm, 4)
|
||||
|
||||
Parent = @window
|
||||
if len(Frame) then
|
||||
Parent = Frame
|
||||
end
|
||||
|
||||
Table = (Type = "EDITTABLE")
|
||||
if Table else
|
||||
SelPos = ""
|
||||
end
|
||||
|
||||
Default = Get_Property(Ctrl, "INVALUE", SelPos)
|
||||
|
||||
if len(Default) else
|
||||
Default = date()
|
||||
end
|
||||
|
||||
Rect = str(\00\, 16)
|
||||
* MTR 12-17-01 Changes for 32-bit
|
||||
if Table then
|
||||
* get x,y of edit table
|
||||
GetWindowRect(Handle, Rect)
|
||||
xDlg = seq(Rect [1,1]) + (seq(Rect [2,1]) * 256)
|
||||
yDlg = seq(Rect [5,1]) + (seq(Rect [6,1]) * 256)
|
||||
|
||||
* add x,y+h of cell
|
||||
LeftBottom = SendMessage(Handle, DTM_GETCELLLEFTBOTTOM$, DTA_CURRENT$, 0)
|
||||
xDlg += mod(LeftBottom, 65536)
|
||||
yDlg += int(LeftBottom / 65536)
|
||||
end else
|
||||
* get x,y+h of control
|
||||
GetWindowRect(Handle, Rect)
|
||||
xDlg = seq(Rect [1,1]) + (seq(Rect [2,1]) * 256)
|
||||
yDlg = seq(Rect [13,1]) + (seq(Rect [14,1]) * 256)
|
||||
end
|
||||
|
||||
Ans = Dialog_Box("POPUP_MONTH", Parent, Default: @fm: Ctrl: @fm: xDlg: @fm: yDlg: @fm: Options)
|
||||
if len(Ans) then
|
||||
Set_Property(Ctrl, "INVALUE", Ans, SelPos)
|
||||
end
|
||||
return
|
||||
|
||||
*******************************
|
||||
* create event for month dialog
|
||||
*******************************
|
||||
Create:
|
||||
Default = Param<1>
|
||||
Ctrl = Param<2>
|
||||
xDlg = Param<3>
|
||||
yDlg = Param<4>
|
||||
FirstYear = Param<5>
|
||||
LastYear = Param<6>
|
||||
|
||||
if len(Default) else
|
||||
Default = date()
|
||||
end
|
||||
|
||||
if len(FirstYear) else
|
||||
FirstYear = FIRST_YEAR$
|
||||
end
|
||||
if len(LastYear) else
|
||||
LastYear = LAST_YEAR$
|
||||
end
|
||||
|
||||
Day = fmt(Default, "DJS")
|
||||
CurYear = Day [1,4]
|
||||
CurMonth = Day [6,2]
|
||||
CurDay = Day [9,2]
|
||||
|
||||
* build list of month names
|
||||
List = ""
|
||||
for i = 1 to 12
|
||||
List<i> = i: "/1"
|
||||
next i
|
||||
List = iconv(List, "DH")
|
||||
List = oconv(List, "DHL")
|
||||
for i = 1 to 12
|
||||
List<i> = List<i> [1," "]
|
||||
next i
|
||||
|
||||
Ctrls = "@.LB_MONTH,@.LB_MONTH"
|
||||
Props = "LIST,SELPOS"
|
||||
Vals = List: @rm: CurMonth
|
||||
|
||||
List = ""
|
||||
for i = FirstYear to LastYear
|
||||
List<-1> = i
|
||||
next i
|
||||
|
||||
*if CurYear >= FIRST_YEAR$ and CurYear <= LAST_YEAR$ then
|
||||
* Pos = CurYear - FIRST_YEAR$ + 1
|
||||
if CurYear >= FirstYear and CurYear <= LastYear then
|
||||
Pos = CurYear - FirstYear + 1
|
||||
end else
|
||||
Pos = 1
|
||||
end
|
||||
|
||||
Ctrls := ",@.LB_YEAR,@.LB_YEAR"
|
||||
Props := ",LIST,SELPOS"
|
||||
Vals := @rm: List: @rm: Pos
|
||||
|
||||
Ctrls := ",@.ET_DAY,@.LB_MONTH,SYSTEM"
|
||||
Props := ",NEXT,PREVIOUS,FOCUS"
|
||||
Vals := @rm: @window: ".LB_MONTH": @rm: @window: ".ET_DAY": @rm: @window: ".ET_DAY"
|
||||
gosub SetProps
|
||||
|
||||
* signal that month changed
|
||||
Popup_Month("", 2, CurDay)
|
||||
|
||||
* hide extra column (which must exist to allow cell selection)
|
||||
Style = Send_Message(@window: ".ET_DAY", "COLSTYLE", 8, "")
|
||||
Send_Message(@window: ".ET_DAY", "COLSTYLE", 8, bitor(Style, 32))
|
||||
|
||||
* position dialog, verify on-screen
|
||||
Ctrls = "SYSTEM,@"
|
||||
Props = "SIZE,SIZE"
|
||||
gosub GetProps
|
||||
Screen = field(Vals, @rm, 1)
|
||||
Size = field(Vals, @rm, 2)
|
||||
ORIG_SIZE = SIZE
|
||||
|
||||
if len(xDlg) and num(xDlg) and len(yDlg) and num(yDlg) then
|
||||
Size<1> = xDlg
|
||||
Size<2> = yDlg
|
||||
end
|
||||
|
||||
if Size<1> + Size<3> > Screen<1> then
|
||||
Size<1> = Screen<1> - Size<3>
|
||||
end
|
||||
if Size<2> + Size<4> > Screen<2> then
|
||||
Size<2> = Screen<2> - Size<4>
|
||||
end
|
||||
|
||||
Set_Property(@window, "SIZE", Size)
|
||||
return
|
||||
|
||||
*******************************
|
||||
* display the days in the month
|
||||
*******************************
|
||||
Month_Changed:
|
||||
Year_Changed:
|
||||
Ctrls = "@.LB_MONTH,@.LB_MONTH,@.LB_YEAR,@.LB_YEAR,@.ET_DAY,@.ET_DAY"
|
||||
Props = "SELPOS,@PREV,TEXT,@PREV,TEXT,SELPOS"
|
||||
gosub GetProps
|
||||
|
||||
Month = field(Vals, @rm, 1)
|
||||
PrevMonth = field(Vals, @rm, 2)
|
||||
Year = field(Vals, @rm, 3)
|
||||
PrevYear = field(Vals, @rm, 4)
|
||||
DftDay = field(Vals, @rm, 5)
|
||||
Row = field(Vals, @rm, 6) <2>
|
||||
|
||||
if len(Month) and len(Year) and (Month # PrevMonth or Year # PrevYear) then
|
||||
* get list of days (S,M,T,W,T,F) from the edit table column labels
|
||||
List = Get_Property(@window: ".ET_DAY", "ORIG_STRUCT")<1,PSPOS_LABEL$>
|
||||
convert @svm to @vm in List
|
||||
|
||||
* what day is the first on?
|
||||
First = iconv(Year: "-": Month: "-01", "DJS")
|
||||
Col = mod(First, 7) + 1
|
||||
|
||||
* how many days in the month?
|
||||
cDays = field(DAY_COUNT$, ",", Month)
|
||||
if Month = 2 then
|
||||
if mod(Year, 4) = 0 and (mod(Year, 100) or mod(Year, 400) = 0) then
|
||||
cDays += 1
|
||||
end
|
||||
end
|
||||
|
||||
if num(Param) and len(Param) then
|
||||
DftDay = Param
|
||||
end else
|
||||
if Row > 1 and num(DftDay) and len(DftDay) else
|
||||
DftDay = 1
|
||||
end
|
||||
end
|
||||
if DftDay < 1 or DftDay > cDays then
|
||||
DftDay = 1
|
||||
end
|
||||
|
||||
* fill in the days
|
||||
List := @fm: str(@vm, Col - 1)
|
||||
cRows = 2
|
||||
for iDay = 1 to cDays
|
||||
if Col > 7 then
|
||||
List := @fm
|
||||
Col = 1
|
||||
cRows += 1
|
||||
end
|
||||
List := iDay: @vm
|
||||
|
||||
* is this the day to default to?
|
||||
if iDay = DftDay then
|
||||
DftRow = cRows
|
||||
DftCol = Col
|
||||
end
|
||||
|
||||
Col += 1
|
||||
next iDay
|
||||
|
||||
if cRows < 7 then
|
||||
List := @fm
|
||||
end
|
||||
|
||||
Ctrls = "@.ET_DAY,@.ET_DAY"
|
||||
Props = "LIST,SELPOS"
|
||||
Vals = List: @rm: DftCol: @fm: DftRow
|
||||
gosub SetProps
|
||||
|
||||
* set day-of-week headers to blue
|
||||
Send_Message(@window: ".ET_DAY", "COLOR_BY_POS", 0, 1, @fm: BLUE$)
|
||||
end
|
||||
return
|
||||
|
||||
***********************
|
||||
* edit table poschanged
|
||||
***********************
|
||||
Day_GotFocus:
|
||||
Day_PosChanged:
|
||||
Ctrls = "@.ET_DAY,@.ET_DAY,@.ET_DAY,@.ET_DAY,@.ET_DAY"
|
||||
Props = "TEXT,SELPOS,@PREV,NEXT,PREVIOUS"
|
||||
gosub GetProps
|
||||
|
||||
Day = field(Vals, @rm, 1)
|
||||
Pos = field(Vals, @rm, 2)
|
||||
PrevPos = field(Vals, @rm, 3)
|
||||
NextCtrl = field(Vals, @rm, 4)
|
||||
PrevCtrl = field(Vals, @rm, 5)
|
||||
|
||||
isDate = (Pos<2> > 1 and num(Day) and len(Day))
|
||||
|
||||
if isDate then
|
||||
if len(PrevPos) then
|
||||
* reset previously selected day
|
||||
Send_Message(@window: ".ET_DAY", "COLOR_BY_POS", PrevPos<1>, PrevPos<2>, WHITE$: @fm: BLACK$)
|
||||
end
|
||||
|
||||
* select current day
|
||||
Send_Message(@window: ".ET_DAY", "COLOR_BY_POS", Pos<1>, Pos<2>, BLACK$: @fm: WHITE$)
|
||||
|
||||
Ctrls = "@.ET_DAY"
|
||||
Props = "@PREV"
|
||||
Vals = Pos
|
||||
end else
|
||||
Ctrls = "@.ET_DAY"
|
||||
Props = "SELPOS"
|
||||
Vals = PrevPos
|
||||
|
||||
* handle tabbing
|
||||
if Pos<2> <= 2 then
|
||||
Focus = PrevCtrl
|
||||
end else
|
||||
Focus = NextCtrl
|
||||
end
|
||||
|
||||
Ctrls := ",SYSTEM"
|
||||
Props := ",FOCUS"
|
||||
Vals := @rm: Focus
|
||||
end
|
||||
|
||||
Ctrls := ",@.CB_OK"
|
||||
Props := ",ENABLED"
|
||||
Vals := @rm: isDate
|
||||
gosub SetProps
|
||||
return
|
||||
|
||||
*********************
|
||||
* date chosen by user
|
||||
*********************
|
||||
Day_DblClk:
|
||||
OK_Click:
|
||||
Ctrls = "@.LB_MONTH,@.LB_YEAR,@.ET_DAY,@.ET_DAY"
|
||||
Props = "SELPOS,TEXT,TEXT,SELPOS"
|
||||
gosub GetProps
|
||||
|
||||
Month = field(Vals, @rm, 1)
|
||||
Year = field(Vals, @rm, 2)
|
||||
Day = field(Vals, @rm, 3)
|
||||
Row = field(Vals, @rm, 4)<2>
|
||||
|
||||
if Row > 1 and num(Day) and len(Day) then
|
||||
Date = iconv(Year: "-": Month: "-": Day, "DJS")
|
||||
End_Dialog(@window, Date)
|
||||
end
|
||||
return
|
||||
|
||||
*****************************
|
||||
* user cancels date selection
|
||||
*****************************
|
||||
Cancel_Click:
|
||||
End_Dialog(@window, "")
|
||||
return
|
||||
|
||||
|
||||
***************** internal subroutines ******************
|
||||
|
||||
GetProps:
|
||||
swap "@" with @window in Ctrls
|
||||
convert "," to @rm in Ctrls
|
||||
convert "," to @rm in Props
|
||||
Vals = Get_Property(Ctrls, Props)
|
||||
return
|
||||
|
||||
SetProps:
|
||||
swap "@" with @window in Ctrls
|
||||
convert "," to @rm in Ctrls
|
||||
convert "," to @rm in Props
|
||||
Set_Property(Ctrls, Props, Vals)
|
||||
return
|
||||
|
||||
Reference in New Issue
Block a user