forum.clarionlife.net

Код: Выделить всё

  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
  

Код: Выделить всё

Event:SelectDate Equate( .... ) ! По вкусу 
.... 
OF Field() = ?Combobox 
... 
OF Event:SelectDate 
    ... ! Здесь вызываем календарь 
Of EVENT:DroppingDown
     ! Меняем обработчик 
     Post( Event: SelectDate ?Combobox) 
     ! Встаём на первую запись 
     ?ComboBox{Prop:Selected} = 1 
    ! И игнорируем DroppingDown 
     Cycle