wwmonthcalendar.pas

胜天进销存源码,国产优秀的进销存

  end;
  inherited;
end;

procedure TwwMonthCalendar.SetFirstDayOfWeek(Value: TwwCalDayOfWeek);
var
  DOWFlag: Integer;
  A: array[0..1] of char;
begin
    if Value = wwdowLocaleDefault then
    begin
      GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IFIRSTDAYOFWEEK, A, SizeOf(A));
      DOWFlag := Ord(A[0]) - Ord('0');
    end
    else
      DOWFlag := Ord(Value);
    if Handle <> 0 then
      MonthCal_SetFirstDayOfWeek(WindowHandle, DOWFlag);
  FFirstDayOfWeek := Value;
end;

procedure TwwMonthCalendar.SetOptions(val: TwwMonthOptions);
begin
   FOptions:= val;
   RecreateWnd;
end;

procedure TwwMonthCalendar.CreateParams(var Params: TCreateParams);
const   MCS_NOTRAILINGDATES = $0040;
        MCS_SHORTDAYSOFWEEK = $0080;
        MCS_NOSELCHANGEONNAV = $0100;
begin
  inherited CreateParams(Params);
  CreateSubClass(Params, MONTHCAL_CLASS);

  with Params do
  begin
    if mdoDayState in Options then Style:= Style or MCS_DAYSTATE;
    if mdoMultiSelect in Options then Style:= Style or MCS_MULTISELECT;
    if mdoWeekNumbers in Options then Style:= Style or MCS_WEEKNUMBERS;
    if (IsVistaComCtrlVersion) then
    begin
      if mdoNoTrailingDates in Options then Style:= Style or MCS_NOTRAILINGDATES;
      if mdoShortDaysOfWeek in Options then Style:= Style or MCS_SHORTDAYSOFWEEK;
      if mdoNoSelChangeOnNav in Options then Style:= Style or MCS_NOSELCHANGEONNAV;
    end;
    if mdoNoTodayCircle in Options then Style:= Style or $0008;
    if (mdoNoToday in Options) and UpdatedComCtlVersion then { 8/25/98 }
       Style:= Style or $0010;
    if FBorder=bsSingle then Style := Style or WS_Border;
    WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW) or
      CS_DBLCLKS;
  end;
end;

procedure TwwMonthCalendar.CreateWnd;
begin
  inherited CreateWnd;
  SetRange(FMinDate, FMaxDate);
  if mdoMultiSelect in Options then begin
     MonthCal_SetMaxSelCount(Handle,FMaxSelectCount);
     // 7/20/1998 - Only set Start and End Dates when if they are nonzero.
     //             Otherwise let the DateTime update the range.
     if (Trunc(FStartDate)<>0) and (Trunc(FEndDate)<>0)then
        SetSelRange(FStartDate, FEndDate)
     else SetDateTime(FDateTime);
  end
  else SetDateTime(FDateTime);
  FCalColors.SetAllColors;
  SetFirstDayOfWeek(FFirstDayOfWeek);
  AdjustHeight;
end;

procedure TwwMonthCalendar.CMColorChanged(var Message: TMessage);
begin
  inherited;
  if HandleAllocated then {1/9/98 - Make sure Handle is allocated before calling InvalidateRect}
     InvalidateRect(Handle, nil, True);
end;

procedure TwwMonthCalendar.CMFontChanged(var Message: TMessage);
begin
  inherited;
  AdjustHeight;
  if HandleAllocated then {1/9/98 - Make sure Handle is allocated before calling InvalidateRect}
     InvalidateRect(Handle, nil, True);
end;

(*{$ifdef wwdelphi4up}
type TMDSArray = array[0..MaxMonthForDayState-1] of TMonthDayState;
     PMDSArray = ^TMDSArray;

procedure TwwMonthCalendar.RefreshBoldDays;
var STA: packed array[1..2] of TSystemTime;
    MDSP: PMDSArray;
    MonthCount,i:Integer;
    curMonth,curDay,curYear:Integer;
    curDate:TDateTime;
    accept:Boolean;
    function BoldDay(ds:TMonthDayState;iDay:Integer):TMonthDayState;
    begin
      if (iDay > 0) and (iDay < 32) then
         ds := ds or (1 shl (iDay-1));
      result := ds;
    end;
begin
  MonthCount := MonthCal_GetMonthRange(Handle, GMR_DAYSTATE, @sta[1]);
  GetMem(MDSP, MonthCount * SizeOf(TMonthDayState));
  try
    for i:=0 to MonthCount-1 do begin
       //Can only display up to 14 monthdaystates so exit if larger than 14.
       if i >= MaxMonthForDayState then exit;

       //Get curmonth and curyear for this day state.
       curMonth := (sta[1].wMonth+i) mod 12;
       if curMonth =0 then curMonth := 12;
       curYear := sta[1].wYear+(((i+sta[1].wMonth)-1) div 12);

       MDSP[i] := TMONTHDAYSTATE(0); //Initialize to 0's
       //Loop through and update monthdaystates...
       for curDay:=1 to DaysThisMonth(curMonth,curYear) do begin
           accept := False;
           if Assigned(FOnCalcBoldDay) then begin
              curDate := EncodeDate(curYear,curMonth,curDay);
              FOnCalcBoldDay(self,curDate,curMonth,curDay,curYear,accept);
           end;
           if accept then MDSP[i]:=BOLDDAY(MDSP[i],curDay);
       end;
    end;
    Win32Check(BOOL(SendMessage(Handle, MCM_SETDAYSTATE, MonthCount, Longint(MDSP))));
  finally
    FreeMem(MDSP);
  end;
end;
{$endif}*)

var DayStateArray: packed array[0..MaxMonthForDayState-1] of TMonthDayState;

procedure TwwMonthCalendar.CNNotify(var Message: TWMNotify);
var tempstart,tempend:TDateTime;
    imax,i:integer;
    st:TSystemTime;
    curMonth,curDay,curYear:Integer;
    accept:Boolean;
    curDate:TDate;

  function IsBlankSysTime(ST: TSystemTime): Boolean;
  begin
    with ST do
      Result := (wYear = 0) and (wMonth = 0) and (wDayOfWeek = 0) and
        (wDay = 0) and (wHour = 0) and (wMinute = 0) and (wSecond = 0) and
        (wMilliseconds = 0);
  end;
  function BoldDay(ds:TMonthDayState;iDay:Integer):TMonthDayState;
  begin
     if (iDay > 0) and (iDay < 32) then
        ds := ds or (1 shl (iDay-1));
     result := ds;
  end;
begin
  with Message, Message.NMHdr^ do
  begin
    Result := 0;
    case code of
      MCM_HitTest:
      begin
      end;
      MCN_GETDAYSTATE:  {Allow user to change bold day settings in OnCalcBoldDay}
        begin
            if (csLoading in componentstate) then exit;
            imax := PNMDayState(NMHdr)^.cDayState;  {Number of MonthDayStates for monthcalendar}
            for i:=0 to iMax-1 do                   {i is the current MonthDayState}
              begin
                if i >= MaxMonthForDayState then exit;
                st:=PNMDayState(NMHdr)^.stStart;    {Starting Date for First Month Day State}

                curMonth := (st.wMonth+i) mod 12;
                if curMonth =0 then curMonth := 12;
                curYear := st.wYear+(((i+st.wMonth)-1) div 12);

                { 3/04/2002 - PYW - Add better support for 12/31/9999.}
                if curYear < 10000 then begin
                  DayStateArray[i] := TMONTHDAYSTATE(0);
                  for curDay:=1 to DaysThisMonth(curMonth,curYear) do begin
                     accept := False;
                     if Assigned(FOnCalcBoldDay) then begin
                        curDate := EncodeDate(curYear,curMonth,curDay);
                        FOnCalcBoldDay(Self,curDate,curMonth,curDay,curYear,accept);
                     end;
                     if accept then begin
                        DayStateArray[i]:=BOLDDAY(DayStateArray[i],curDay);
                     end;
                  end;
                end;
              end;
          PNMDayState(NMHdr)^.prgDayState := @DayStateArray;
        end;
      MCN_SELCHANGE:
        begin
          Tempstart:=Startdate;     {Save Start and End Dates}
          Tempend:=EndDate;

          if Trunc(SystemTimeToDateTime(PNMSelChange(NMHdr)^.stSelStart)) >= Trunc(MinDate) then
             FStartDate:= Trunc(SystemTimeToDateTime(PNMSelChange(NMHdr)^.stSelStart))  // 5/18/2000 - PYW - Remove Multiselect when just clicking without dragging
          else StartDate := MinDate;

          if (mdoMultiSelect in Options) then  {Update EndDate if MultiSelect}
          begin
             if (Trunc(SystemTimeToDateTime(PNMSelChange(NMHdr)^.stSelEnd)) >= Trunc(MinDate)) then
                FEndDate := Trunc(SystemTimeToDateTime(PNMSelChange(NMHdr)^.stSelEnd))  // 5/18/2000 - PYW - Remove Multiselect when just clicking without dragging
             else EndDate := MinDate;
             if (Trunc(tempstart) <> Trunc(StartDate)) or
                (Trunc(tempend) <> Trunc(EndDate)) then
                FSelChanged := True;      {MultiSelection has Changed}
          end
          else EndDate:=StartDate;

          if (Trunc(StartDate)=Trunc(EndDate))then
          begin
             // 2/15/98 - PYW - Don't call change when no changes to date have occurred.
             if Trunc(StartDate)<>Trunc(Date) then
             begin
                FDateTime:= StartDate; // 5/21/07 - Don't call SetDate and that prevents button next from being repeated
//                SetDate(StartDate);
                Change;
             end;
          end;

                   //Don't Call OnChange event while dragging and multiselecting
//          if (mdoMultiSelect in Options) then begin
//             exit; // MouseUp handles OnChange event when Multiselect complete.
//          end
//          else begin
//             Change;
//          end;
        end;
    else
      inherited;
    end;
  end;
end;

procedure TwwMonthCalendar.AdjustHeight;
var
  DC: HDC;
  SaveFont: HFont;
  SysMetrics, Metrics: TTextMetric;
  Rect:TRect;
  Flag:Boolean;
begin
  Flag := MonthCal_GetMinReqRect(WindowHandle,Rect);

  DC := GetDC(0);
  try
    GetTextMetrics(DC, SysMetrics);
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
  finally
    ReleaseDC(0, DC);
  end;

  if Flag then begin
     if Rect.Bottom > Height then
        Height := Rect.bottom;
     if Rect.Right > Width then
        Width := Rect.right;
  end;
 // What does this code do?
 // else Height := Metrics.tmHeight + (GetSystemMetrics(SM_CYBORDER) * 8);
 //
end;

function TwwMonthCalendar.GetStartDate: TDate;
begin
  Result := FStartDate;
end;

function TwwMonthCalendar.GetEndDate: TDate;
begin
  Result := FEndDate;
end;

function TwwMonthCalendar.GetDate: TDate;
begin
  Result := TDate(FDateTime);
end;

function TwwMonthCalendar.GetTime: TTime;
begin
  Result := TTime(FDateTime);
end;

function TwwMonthCalendar.GetHeight: Integer;
begin
  Result := inherited Height;
end;

function TwwMonthCalendar.GetWidth: Integer;
begin
  Result := inherited Width;
end;

//function TwwMonthCalendar.GetMaxSelectCount;
//begin
//   Result := MonthCal_GetMaxSelCount(Handle);
//end;

procedure TwwMonthCalendar.SetCalColors(Value: TwwDateTimeColors);
begin
  if FCalColors <> Value then FCalColors.Assign(Value);
end;

procedure TwwMonthCalendar.SetDate(Value: TDate);
begin
  if Trunc(FDateTime) <> Trunc(Value) then
  begin
    Value := Trunc(Value) + Frac(FDateTime);
    if Value = 0.0 then
    begin
      Invalidate;
    end
    else begin
      try                    {Compare dates only, ignore time portion}
        if (FMaxDate <> 0.0) and (Trunc(Value) > FMaxDate) then
          raise EDateTimeError.CreateFmt(SDateTimeMax, [DateToStr(FMaxDate)]);
        if (FMinDate <> 0.0) and (Trunc(Value) < FMinDate) then
          raise EDateTimeError.CreateFmt(SDateTimeMin, [DateToStr(FMinDate)]);
        SetDateTime(Value);
      except
        SetDateTime(FDateTime);
        raise;
      end;
    end;
  end;
end;

// Sets the Selected Date in the DateTime Picker when MultiSelect
function TwwMonthCalendar.SetSelRange(AStart,AEnd:TDate):boolean;
var STA: packed array[1..2] of TSystemTime;
begin
   result := False;
   if not (mdoMultiSelect in Options) then exit;
   DateTimeToSystemTime(AStart, STA[1]);
   DateTimeToSystemTime(AEnd, STA[2]);
   STA[1].wDayOfWeek := DayOfWeek(AStart);
   STA[2].wDayOfWeek := DayOfWeek(AEnd);
   result := MonthCal_SetSelRange(handle,@STA[1]);

   //1/9/98 - pw - Update Multiselection Start and End Dates
   if Trunc(AStart) < Trunc(AEnd) then
   begin
      FStartDate := AStart;
      FEndDate := AEnd;
   end
   else begin
      FStartDate := AEnd;
      FEndDate := AStart;
   end;