wwmonthcalendar.pas

InfoPower_Studio 2007 v5.0.1.3 banben

end;

// Set the EndDate for a MonthCalendar with MultiSelect
procedure TwwMonthCalendar.SetEndDate(Value: TDate);
begin
    Value := Trunc(Value);
    if Value = 0.0 then
    begin
      Invalidate;
    end
    else begin
      try
        if (FMaxDate <> 0.0) and (Value > FMaxDate) then begin
          FEndDate := FMaxDate;
          raise EDateTimeError.CreateFmt(SDateTimeMax, [DateToStr(FMaxDate)]);
        end;
        if (FMinDate <> 0.0) and (Value < FMinDate) then begin
          FEndDate := FMinDate;
          raise EDateTimeError.CreateFmt(SDateTimeMin, [DateToStr(FMinDate)]);
        end;
        FEndDate := Value;
        if (FStartDate <> 0) and (FStartDate <> Value) then
           SetSelRange(FStartDate,FEndDate);
      except
        raise;
      end;
    end;
end;

// Set the StartDate for a MonthCalendar with MultiSelect
procedure TwwMonthCalendar.SetStartDate(Value: TDate);
begin
    Value := Trunc(Value);
    if Value = 0.0 then
    begin
      Invalidate;
    end
    else begin
      try
        if (FMaxDate <> 0.0) and (Value > FMaxDate) then
        begin
          FStartDate := MaxDate;
          raise EDateTimeError.CreateFmt(SDateTimeMax, [DateToStr(FMaxDate)]);
        end;
        if (FMinDate <> 0.0) and (Value < FMinDate) then
        begin
          FStartDate := MinDate;
          raise EDateTimeError.CreateFmt(SDateTimeMin, [DateToStr(FMinDate)]);
        end;
        FStartDate := Value;
        if (FEndDate <> 0) and (FEndDate <> Value) then
           SetSelRange(FStartDate,FEndDate);
      except
        raise;
      end;
    end;
end;

function TwwMonthCalendar.SetMonthCalDateTime(Value:TDateTime):Boolean;
var  ST: TSystemTime;
begin
  DateTimeToSystemTime(Value, ST);
  ST.wDayOfWeek := DayOfWeek(Value);

  if not (mdoMultiSelect in Options) then
     result :=MonthCal_SetCurSel(handle, ST)
  else
     result :=SetSelRange(Value,Value);
end;

procedure TwwMonthCalendar.SetDateTime(Value: TDateTime);
begin
  // Make sure that the monthcalendar is set to a valid date based on min/max settings.
  if (MaxDate <> 0.0) and (Trunc(Value)>MaxDate) then Value := MaxDate
  else if (MinDate <> 0.0) and (Trunc(Value)<MinDate) then Value := MinDate
  else if (MinDate = 0.0) and (Trunc(Value)<MinDate) then Value := EncodeDate(1899,12,31);

  // 7/20/98 - Make sure that when multiselect is on that StartDate and EndDates are updated
  //           when the DateTime Changes.
  if (mdoMultiSelect in Options) then begin
     FStartDate := Value;
     FEndDate := Value;
  end;

  if SetMonthCalDateTime(Value) then FDateTime := Value;
end;

procedure TwwMonthCalendar.SetMaxDate(Value: TDate);
begin            {9/10/98 - Check for clearing of max date when mindate <> 0}
  if (Value <> 0.0) and (FMinDate <> 0.0) and (Value < FMinDate) then
    raise EDateTimeError.CreateFmt(SDateTimeMin, [DateToStr(FMinDate)]);
  if FMaxDate <> Value then
  begin
    SetRange(FMinDate, Value);
    FMaxDate := Value;
  end;
end;

procedure TwwMonthCalendar.SetPopupYearOptions(Value: TwwPopupYearOptions);
begin
   if FPopupYearOptions<>Value then
      FPopupYearOptions.Assign(Value); { RSW }

//  if (FPopupYearOptions <> Value) then
//  begin
//    FPopupYearOptions := Value;
//  end;
end;

procedure TwwMonthCalendar.SetMaxSelectCount(Value: Integer);
begin
  if FMaxSelectCount <> Value then
  begin
    FMaxSelectCount := Value;
    MonthCal_SetMaxSelCount(Handle,Value);
  end;
end;

procedure TwwMonthCalendar.SetMinDate(Value: TDate);
begin
  if (FMaxDate <> 0) and (Value > FMaxDate) then
    raise EDateTimeError.CreateFmt(SDateTimeMin, [DateToStr(FMaxDate)]);
  if FMinDate <> Value then
  begin
    SetRange(Value, FMaxDate);
    FMinDate := Value;
  end;
end;

procedure TwwMonthCalendar.SetRange(MinVal, MaxVal: TDateTime);
var
  STA: packed array[1..2] of TSystemTime;
  Flags: DWORD;
begin
  Flags := 0;
  if Double(MinVal) <> 0.0 then
  begin
    Flags := Flags or GDTR_MIN;
    DateTimeToSystemTime(MinVal, STA[1]);
    STA[1].wDayOfWeek := DayOfWeek(MinVal);
  end;
  if Double(MaxVal) <> 0.0 then
  begin
    Flags := Flags or GDTR_MAX;
    DateTimeToSystemTime(MaxVal, STA[2]);
    STA[2].wDayOfWeek := DayOfWeek(MaxVal);
  end;
  if (Flags <> 0) then Monthcal_SetRange(Handle, Flags, @STA[1]);
end;

procedure TwwMonthCalendar.SetBorder(Value: TBorderStyle);
begin
  if FBorder <> Value then
  begin
    FBorder := Value;
    RecreateWnd;
  end;
end;

procedure TwwMonthCalendar.SetHeight(Value: Integer);
var flag:boolean;
    Rect:TRect;
begin
  if (Height <> Value) then
  begin
    Flag := MonthCal_GetMinReqRect(WindowHandle,Rect);
    if flag then begin
       if (Value >= (Rect.Bottom)) then
           inherited Height := Value
       else inherited Height := Rect.Bottom;
    end
    else inherited Height := Value;

    if not (csDesigning in ComponentState) then RecreateWnd;
  end;
end;

procedure TwwMonthCalendar.SetWidth(Value: Integer);
var flag:boolean;
    Rect:TRect;
begin
  if (Width <> Value) then
  begin
    Flag := MonthCal_GetMinReqRect(WindowHandle,Rect);
    if flag then begin
       if (Value >= (Rect.Right)) then
           inherited Width := Value
       else inherited Width := Rect.Right;
    end
    else inherited Width := Value;

    if not (csDesigning in ComponentState) then RecreateWnd;
  end;
end;

procedure TwwMonthCalendar.SetTime(Value: TTime);
begin
  if Frac(FDateTime) <> Frac(Value) then
  begin
    Value := Trunc(FDateTime) + Frac(Value);
    if Value = 0.0 then
    begin
      Invalidate;
    end
    else
      SetDateTime(Value);
  end;
end;

procedure TwwMonthCalendar.KeyDown(var Key: Word; Shift: TShiftState);
var pst: TSystemTime;
    tempDate: TDateTime;
    STA: packed array[1..2] of TSystemTime;
begin
  inherited KeyDown(Key, Shift);
  if key in [vk_right, vk_left, vk_down, vk_up, vk_next, vk_prior] then
  begin
    if mdoMultiSelect in Options then
    begin
       MonthCal_GetSelRange(handle,@STA);
       if (Trunc(SystemTimeToDateTime(STA[1])) =
           Trunc(SystemTimeToDateTime(STA[2]))) then
         pst := STA[1]
       else if (Key=VK_NEXT) or (Key=VK_Prior) then begin
         Key:=0;
         exit;
       end;
    end
    else MonthCal_GetCurSel(handle, pst);

    case key of
     vk_right:begin  {Handle Keyboard ShiftSelect}
                 if (mdoMultiSelect in Options) then begin
                    if ssshift in Shift then
                       if (Date < Trunc(SystemTimeToDateTime(STA[2]))) then
                          SetSelRange(Date,Trunc(SystemTimeToDateTime(STA[2])+1))
                       else
                          SetSelRange(Trunc(SystemTimeToDateTime(STA[1])+1),Date)
                    else if (Date <> MaxDate) then Date:=Date+1; {10/13/2000 - Check for Out of Range}
                 end
                 else if (Date <> MaxDate) then Date:= Date + 1; {10/13/2000 - Check for Out of Range}
              end;
     vk_left: begin
                 if (mdoMultiSelect in Options) then begin
                    if ssshift in Shift then
                       if (Date < Trunc(SystemTimeToDateTime(STA[2]))) then
                          SetSelRange(Date,Trunc(SystemTimeToDateTime(STA[2])-1))
                        else
                          SetSelRange(Trunc(SystemTimeToDateTime(STA[1])-1),Date)
                    else if (Date <> MinDate) then Date:= Date - 1; {10/13/2000 - Check for Out of Range}
                 end
                 else if (Date <> MinDate) then Date:= Date - 1;  {10/13/2000 - Check for Out of Range}
               end;
     vk_down: begin
                 if (mdoMultiSelect in Options) then begin
                    if ssshift in Shift then
                       if (Date < Trunc(SystemTimeToDateTime(STA[2]))) then
                          SetSelRange(Date,Trunc(SystemTimeToDateTime(STA[2])+7))
                        else
                          SetSelRange(Trunc(SystemTimeToDateTime(STA[1])+7),Date)
                    else if (MaxDate=0) or (Date+7 <= MaxDate) then Date:= Date +7; {10/13/2000 - Check for Out of Range}
                 end
                 else if (MaxDate=0) or (Date +7 <= MaxDate) then Date:= Date +7; {10/13/2000 - Check for Out of Range}
              end;
     vk_up:   begin
                 if (mdoMultiSelect in Options) then begin
                    if ssshift in Shift then
                       if (Date < Trunc(SystemTimeToDateTime(STA[2]))) then
                          SetSelRange(Date,Trunc(SystemTimeToDateTime(STA[2])-7))
                        else
                          SetSelRange(Trunc(SystemTimeToDateTime(STA[1])-7),Date)
                    else if (Date-7 >= MinDate) then Date:= Date -7; {10/13/2000 - Check for Out of Range}
                 end
                 else if (Date-7 >= MinDate) then Date:= Date -7; {10/13/2000 - Check for Out of Range}
              end;
     vk_next: begin
         if pst.wMonth<12 then
            { 9/1/98 - Do not raise EncodeDate exception}
            tempDate:= EncodeDate(pst.wyear, pst.wMonth+1,
                min(pst.wday,DaysThisMonth(pst.wMonth+1,pst.wyear)))
            //               pst.wDay)
         else
            tempDate:= EncodeDate(pst.wyear+1, 1, pst.wDay);
         if (MaxDate=0) or (tempDate < MaxDate) then {10/13/2000 - Check for Out of Range}
            Date:= tempDate
         else Date := MaxDate;
       end;
     vk_prior: begin
         if pst.wMonth>1 then
            tempDate:= EncodeDate(pst.wyear, pst.wMonth-1,
                       min(pst.wday,DaysThisMonth(pst.wMonth-1,pst.wyear))) { 10/29/98 }
         else
            tempDate:= EncodeDate(pst.wyear-1, 12, pst.wDay);
         if tempDate > MinDate then {10/13/2000 - Check for Out of Range}
            Date:= tempDate
         else Date := MinDate;
       end;
    end;

    Change; { 8/24/98 }

    key:= 0;
  end;
end;

procedure TwwMonthCalendar.CNKeyDown(var Message: TWMKeyDown);
var shiftState: TShiftState;
begin
  if not (csDesigning in ComponentState) then
  begin
    with Message do
    begin
       shiftState:= KeyDataToShiftState(KeyData);

       if (charcode in [vk_right, vk_left, vk_down, vk_up, vk_next, vk_prior]) and
          not (ssCtrl in shiftState) then
       begin
          exit;
       end;

       // allows monthcalendar in inspector to support Ctrl - Arrow keys
       // for navigation
       if (charcode in [vk_down, vk_up, vk_right, vk_left]) and (ssCtrl in shiftState) and
          IsInGrid(self) then
       begin
          exit;
       end

    end
  end;

  inherited;
end;

procedure TwwMonthCalendar.Loaded;
begin
   inherited;
   RecreateWnd;         //Necessary to make sure OnCalcBoldDay is fired.
end;

procedure TwwMonthCalendar.GetFocus;
begin
   if visible then SetFocus;
end;

{procedure TwwMonthCalendar.WMLButtonDown(var Message: TWMLButtonDown);
begin
   GetFocus;
   inherited;
end;}

procedure TwwMonthCalendar.CMShowingChanged(var Message: TMessage);
begin
  inherited;
  FAfterYearPopup := False;
  FAfterMonthPopup := False;
end;