379 lines
9.4 KiB
Plaintext
379 lines
9.4 KiB
Plaintext
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
|
|
|