Побаловался и бросил пока.
Код: Выделить всё
PROGRAM
MAP
END
ePrevMonth EQUATE(-1)
eCurrMonth EQUATE(0)
eNextMonth EQUATE(1)
CalendarQueue QUEUE,TYPE
Col1 STRING(2)
Col2 STRING(2)
Col3 STRING(2)
Col4 STRING(2)
Col5 STRING(2)
Col6 STRING(2)
Col7 STRING(2)
Date1 LONG
Date2 LONG
Date3 LONG
Date4 LONG
Date5 LONG
Date6 LONG
Date7 LONG
END
CalendarClass CLASS
Feq LONG
Date LONG
Calendar &CalendarQueue
Construct PROCEDURE
Destruct PROCEDURE
Init PROCEDURE(LONG Feq, LONG lDate)
BuildCalendar PROCEDURE
GetDayNumber PROCEDURE(LONG lDate),BYTE
TakeEvent PROCEDURE()
END
CalCombo CalendarClass
CalList CalendarClass
Window WINDOW('Date strange'),AT(,,271,112),GRAY,FONT('Tahoma',8,,,CHARSET:CYRILLIC)
PROMPT('Combo... стрелки вправо, влево не работают :-('),AT(14,12),USE(?PROMPT1)
COMBO(@D06.B),AT(14,25,99),USE(?CalendarCombo),COLUMN,DROP(8,126)
PROMPT('List... вывести что то в Entry х.з. как'),AT(14,49),USE(?PROMPT2)
LIST,AT(14,63,99),USE(?CalendarList),COLUMN,DROP(8,126)
END
CODE
OPEN(Window)
CalCombo.Init(?CalendarCombo, TODAY())
CalList.Init(?CalendarList, TODAY())
CalCombo.BuildCalendar
CalList.BuildCalendar
ACCEPT
CalCombo.TakeEvent()
CalList.TakeEvent()
END
CLOSE(Window)
CalendarClass.Construct PROCEDURE
CODE
SELF.Calendar &= NEW(CalendarQueue)
CalendarClass.Destruct PROCEDURE
CODE
FREE(SELF.Calendar)
DISPOSE(SELF.Calendar)
CalendarClass.Init PROCEDURE(LONG Feq, LONG lDate)
CODE
SELF.Date = lDate
SELF.Feq = Feq
SELF.Feq{PROP:From} = SELF.Calendar
SELF.Feq{PROP:Format} = '18CF@S2@18CF@S2@18CF@S2@18CF@S2@18CF@S2@18CF@S2@18CF@S2@'
SELF.Feq{PROP:ScreenText} = FORMAT(lDate, '@'&SELF.Feq{PROP:Text})
SELF.Feq{PROP:LineHeight} = 12
SELF.Feq{PROPLIST:Header,1} = 'Пн'
SELF.Feq{PROPLIST:Header,2} = 'Вт'
SELF.Feq{PROPLIST:Header,3} = 'Ср'
SELF.Feq{PROPLIST:Header,4} = 'Чт'
SELF.Feq{PROPLIST:Header,5} = 'Пт'
SELF.Feq{PROPLIST:Header,6} = 'Сб'
SELF.Feq{PROPLIST:Header,7} = 'Вс'
CalendarClass.BuildCalendar PROCEDURE
lDate LONG
lDay BYTE
lRow BYTE
lCol BYTE
lPrevMonthFromDay BYTE
lCurMonthLastDay BYTE
lFillPrevMonth BYTE
lCurField ANY
lCurFieldDate ANY
lCurDay BYTE
lEnd BYTE
lMonth LONG
lCurrentDate LONG
CODE
lDate = DATE(MONTH(SELF.Date), 1, YEAR(SELF.Date))
lDay = SELF.GetDayNumber(lDate)
IF lDay > 1
lPrevMonthFromDay = DAY(lDate - (lDay - 1))
lFillPrevMonth = TRUE
END
lCurMonthLastDay = DAY(DATE(MONTH(SELF.Date)+1,1,YEAR(SELF.Date))-1)
lMonth = ePrevMonth
LOOP lRow = 1 TO 6
CLEAR(SELF.Calendar)
LOOP lCol = 1 TO 7
lCurField &= WHAT(SELF.Calendar, lCol)
lCurFieldDate &= WHAT(SELF.Calendar, lCol + 7)
IF lFillPrevMonth = TRUE
lCurField = lPrevMonthFromDay
lCurrentDate = DATE(MONTH(SELF.Date)+lMonth, lPrevMonthFromDay ,YEAR(SELF.Date))
lCurFieldDate = lCurrentDate
lPrevMonthFromDay += 1
lDay -=1
IF lDay = 1
lFillPrevMonth = FALSE
lMonth = eCurrMonth
END
ELSE
lCurDay += 1
IF lCurDay > lCurMonthLastDay OR lMonth = eNextMonth
IF SELF.GetDayNumber(DATE(MONTH(SELF.Date) + lMonth, lCurDay-1 ,YEAR(SELF.Date))) = 7
lEnd = TRUE
BREAK
ELSIF lMonth = eCurrMonth
lCurDay = 1
lMonth = eNextMonth
END
END
lCurField = lCurDay
lCurrentDate = DATE(MONTH(SELF.Date) + lMonth, lCurDay ,YEAR(SELF.Date))
lCurFieldDate = lCurrentDate
END
END
IF lEnd = TRUE THEN BREAK END
ADD(SELF.Calendar)
END
CalendarClass.GetDayNumber PROCEDURE(LONG lDate)!,BYTE
lDay BYTE
CODE
lDay = lDate % 7
IF lDay = 0 THEN lDay = 7 END
RETURN lDay
CalendarClass.TakeEvent PROCEDURE()
lCurFieldDate ANY
CODE
CASE FIELD()
OF SELF.Feq
CASE EVENT()
OF EVENT:NewSelection
GET(SELF.Calendar, CHOICE(SELF.Feq))
lCurFieldDate &= WHAT(SELF.Calendar, SELF.Feq{PROP:Column} + 7)
SELF.Feq{PROP:ScreenText} = FORMAT(lCurFieldDate, '@'&SELF.Feq{PROP:Text})
END
END