wwmonthcalendar.pas

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

      end;
      curx:= curx+1;
      cury:=cury+1;

      if FYearPopupMenu = nil then
      begin
         FYearPopupMenu := TCalendarPopupMenu.Create(self);
         {$ifdef wwDelphi5Up}
         FYearPopupMenu.AutoHotKeys:= maManual;
         {$endif}
      end;

      NumPopupYears := FPopupYearOptions.YearsPerColumn * FPopupYearOptions.NumberColumns;

      while FYearPopupMenu.Items.count <> 0 do
         FYearPopupMenu.Items[0].Free;

      DecodeDate(Date,yr,m,dy);
      yearoffset :=0;
      if FPopupYearOptions.ShowEditYear {and (FPopupYearOptions.NumberColumns=1) }then begin      //!!! Add to wwintl....
         FYearPopupMenu.Items.Add(NewItem(wwInternational.MonthCalendar.PopupYearLabel,0,False,True,nil,0,''));
         FYearPopupMenu.Items[0].onClick := wwPopupMenuClick;
         FYearPopupMenu.Items.Add(NewItem('-',0,False,True,nil,0,''));
         yearoffset :=2;
      end;
      for i:= FPopupYearOptions.StartYear to FPopupYearOptions.StartYear+NumPopupYears-1 do
      begin
         FYearPopupMenu.Items.Add(NewItem(inttostr(i),0,False,True,nil,0,''));
         //Assign PopupMenu Item's OnClick event.
         FYearPopupMenu.Items[i-FPopupYearOptions.StartYear+yearoffset].onClick := wwPopupMenuClick;
         //Check Current Year
         FYearPopupMenu.Items[i-FPopupYearOptions.StartYear+yearoffset].Checked := (i = info.st.wyear);
         //Disable invalid years based on min and max dates.
         if (Trunc(MaxDate) <> 0) and
            (Trunc(MaxDate) < Trunc(EncodeDate(i,m,min(dy,DaysThisMonth(m,i))))) then
            FYearPopupMenu.Items[i-FPopupYearOptions.StartYear+yearoffset].Enabled := False;

         if Trunc(MinDate) > Trunc(EncodeDate(i,m,min(dy,DaysThisMonth(m,i)))) then
            FYearPopupMenu.Items[i-FPopupYearOptions.StartYear+yearoffset].Enabled := False;

         //Add bar breaks after certain number of years for each column.
         if ((((i-FPopupYearOptions.StartYear) mod FPopupYearOptions.YearsPerColumn) = 0) and
            (i <> FPopupYearOptions.StartYear)) or
            ((i= FPopupYearOptions.StartYear) and (FPopupYearOptions.ShowEditYear) and
             (FPopupYearOptions.YearsPerColumn<>1)) then
            FYearPopupMenu.Items[i-FPopupYearOptions.StartYear+yearoffset].break := mbbarbreak;
      end;

{      if FPopupYearOptions.ShowEditYear and (FPopupYearOptions.NumberColumns>1) then begin      //!!! Add to wwintl....
         FYearPopupMenu.Items.Add(NewItem(wwInternational.MonthCalendar.PopupYearLabel,0,False,True,nil,0,''));
         FYearPopupMenu.Items[FYearPopupMenu.Items.Count-1].onClick := wwPopupMenuClick;
         FYearPopupMenu.Items[FYearPopupMenu.Items.Count-1].break := mbbarbreak;
      end;}
      if (FPopupYearOptions.ShowEditYear) and (FPopupYearOptions.YearsPerColumn<>1) then
      begin
         curx := curx-GetParentForm(self).Canvas.TextWidth(wwInternational.MonthCalendar.PopupYearLabel);
         curx := curx - (screen.pixelsperinch * 45) div 96;  //Calculate Correct Popup Menu Width For Label
      end;

      APoint := ClientToScreen(Point(curx, cury+1));
      FPopupSystemTime := info.st;
      FAfterYearPopup := False;
      FYearPopupMenu.Popup(APoint.x, APoint.y);
      FAfterYearPopup := True;
   end
   //If TitleMonth was clicked on then Get Positions and then popup the Month Menu.
   else if info.uHit = MCHT_TITLEMONTH then begin
      FAfterYearPopup := False;
      if (FMonthPopupShowing or FAfterMonthPopup)and (FPrevPopupMonth = info.st.wMonth) then begin
        FAfterMonthPopup := False;
        FAfterYearPopup := False;
        exit;
      end;
      FPrevPopupMonth := info.st.wMonth;
      while Info.uhit = MCHT_TITLEMONTH do begin
         cury := cury+1;
         info.pt := Point(curx,cury);
         MonthCal_HitTest(Handle,Info);
      end;
      cury:=cury-1;
      info.pt := Point(curx,cury);
      MonthCal_HitTest(Handle,Info);
      while Info.uhit = MCHT_TITLEMONTH do begin
         curx := curx+1;
         info.pt := Point(curx,cury);
         MonthCal_HitTest(Handle,Info);
      end;
      curx:= curx-1;
      cury:=cury+1;

      DecodeDate(Date,yr,m,dy);

      for i:= 1 to 12 do begin
          FMonthPopupMenu.Items[i-1].Checked := (i = info.st.wmonth);
         //Disable invalid years based on min and max dates.
          FMonthPopupMenu.Items[i-1].Enabled := True;
          if (Trunc(MaxDate) <> 0) and
             (Trunc(MaxDate) < Trunc(EncodeDate(info.st.wYear,i,min(dy,DaysThisMonth(i,info.st.wYear))))) then
             FMonthPopupMenu.Items[i-1].Enabled := False;

          if Trunc(MinDate) > Trunc(EncodeDate(info.st.wYear,i,min(dy,DaysThisMonth(i,info.st.wYear)))) then
             FMonthPopupMenu.Items[i-1].Enabled := False;
      end;

      APoint := ClientToScreen(Point(curx, cury+1));
      FPopupSystemTime := info.st;
      FAfterMonthPopup := False;
      FMonthPopupMenu.Popup(APoint.x, APoint.y);
      FAfterMonthPopup := True;
   end
   else begin
      FAfterMonthPopup := False;
      FAfterYearPopup := False;
   end;
end;

procedure TwwMonthCalendar.wwPopupMenuClick(Sender: TObject);
var d,m,y:Word;
    md,mm,my:Word;
    mind,minm,miny:Word;
    minvalidyear,maxvalidyear:word;
    STA: packed array[1..2] of TSystemTime;
    inputyear:String;
    defaultyear: string;
    function LessThanDate(y1,m1,d1,y2,m2,d2:word):boolean;
    begin
       result :=False;
       if y1<y2 then result := True
       else if (y1=y2) then begin
         if m1<m2 then result :=True
         else if m1=m2 then
            if d1 < d2 then result :=True;
       end
    end;
begin
   FAfterMonthPopup := False;
   FAfterYearPopup := False;

// Get Starting and Ending months and number of months.
   MonthCal_GetMonthRange(WindowHandle,GMR_VISIBLE,@STA[1]);

   DecodeDate(Date,y,m,d);
   DecodeDate(MaxDate,my,mm,md);
   DecodeDate(MinDate,miny,minm,mind);

   if Trunc(MinDate)<>0 then begin
      if (LessThanDate(miny,m,d,miny,minm,mind)) then minvalidyear := miny+1
      else minvalidyear := miny;
   end
   else minvalidyear := 0;

   if (Trunc(MaxDate)<>0) then begin
      if (LessThanDate(my,mm,md,my,m,d)) then maxvalidyear := my-1
      else maxvalidyear := my;
   end
   else maxvalidyear := 0;

   // Accept only valid dates.  ????  PW
   if ((Sender as TMenuItem).Caption = wwInternational.MonthCalendar.PopupYearLabel) then
   begin
      defaultyear:= inttostr(FPopupSystemTime.wYear);
      if (StrToIntDef(defaultyear,-1)=-1) or ((MaxDate<>0)and (maxvalidyear=0)) or
         ((MinDate<>0)and(minvalidyear=0)) then begin
         defaultyear := defaultyear;
      end
      else if ((MaxDate <> 0) and LessThanDate(my,mm,md,StrToInt(DefaultYear),m,d)) then begin
         defaultyear:=inttostr(maxvalidyear);
      end
      else if (LessThanDate(StrToInt(DefaultYear),m,d,miny,minm,mind)) then begin
         defaultyear:=inttostr(minvalidyear);
      end;
//      inputyear := inputbox('Enter Valid Year','Enter New Year:',defaultyear);
      if (MinValidYear=0) then begin
         if MaxValidYear<>0 then
            inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt+' (<='+IntToStr(MaxValidYear)+')',
               'Enter New Year:',defaultyear)
         else
            inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt,' ',defaultyear)
      end
      else if (MaxValidYear=0) then begin
         if MinValidYear<>0 then
            inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt+' (>='+IntToStr(MinValidYear)+')',
               'Enter New Year:',defaultyear)
         else
            inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt,' ',defaultyear)
      end
      else
         inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt+' ('+IntToStr(MinValidYear)+'-'+IntToStr(MaxValidYear)+')',
               '',defaultyear);

      while (strToIntDef(inputyear,-1) = -1) or
         ((MaxDate <> 0) and (LessThanDate(my,mm,md,StrToInt(InputYear),m,d))) or
         (LessThanDate(StrToInt(InputYear),m,d,miny,minm,mind)) do
      begin
         if (StrToIntDef(inputyear,-1)=-1) or ((MaxDate<>0)and (maxvalidyear=0)) or
             ((MinDate<>0)and(minvalidyear=0)) then begin
            defaultyear := defaultyear;
         end
         else if ((MaxDate <> 0) and LessThanDate(my,mm,md,StrToInt(InputYear),m,d)) then begin
            defaultyear:=inttostr(maxvalidyear);
         end
         else if (LessThanDate(StrToInt(InputYear),m,d,miny,minm,mind)) then begin
            defaultyear:=inttostr(minvalidyear);
         end;
//         inputyear := inputbox('Edit Valid Year'+' ('+IntToStr(MinValidYear)+'-'+IntToStr(MaxValidYear)+')',
//               'Enter New Year:',defaultyear)
      if (MinValidYear=0) then begin
         if MaxValidYear<>0 then
            inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt+' (<='+IntToStr(MaxValidYear)+')',
               'Enter New Year:',defaultyear)
         else
            inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt,' ',defaultyear)
      end
      else if (MaxValidYear=0) then begin
         if MinValidYear<>0 then
            inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt+' (>='+IntToStr(MinValidYear)+')',
               'Enter New Year:',defaultyear)
         else
            inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt,' ',defaultyear)
      end
      else
         inputyear := inputbox(wwInternational.MonthCalendar.EnterYearPrompt+' ('+IntToStr(MinValidYear)+'-'+IntToStr(MaxValidYear)+')',
               'Enter New Year:',defaultyear);

      end;
   end
   else inputyear := (Sender as TMenuItem).Caption;

   //Valid Year so compute new date for calendar.
   if (FPopupSystemTime.wYear < StrToInt(inputyear)) then begin
      //Handle scrolling issues.
      SetMonthCalDateTime(EncodeDate(StrToInt(inputyear),sta[2].wmonth,1));
      Date := EncodeDate(StrToInt(inputyear),m,min(d,DaysThisMonth(m,StrToInt(inputyear))));
      Change;
   end
   else if (FPopupSystemTime.wYear > StrToInt(inputyear)) then begin
      SetMonthCalDateTime(EncodeDate(StrToInt(inputyear),sta[1].wmonth,1));
      Date := EncodeDate(StrToInt(inputyear),m,min(d,DaysThisMonth(m,StrToInt(inputyear))));
      Change;
   end;
end;

procedure TwwMonthCalendar.wwMonthPopupMenuClick(Sender: TObject);
var d,m,y:Word;
    i:Integer;
    endmonth,endyear,startmonth,startyear:Integer;
    STA: packed array[1..2] of TSystemTime;
begin
   FAfterMonthPopup := False;
   FAfterYearPopup := False;

   DecodeDate(Date,y,m,d);
// Get Starting and Ending months and number of months.
   MonthCal_GetMonthRange(WindowHandle,GMR_VISIBLE,@STA[1]);
   for i:= 1 to 12 do begin
     if (LongMonthNames[i]=(Sender as TMenuItem).Caption) then
        break;
   end;

   if (FPopupSystemTime.wMonth < i) then begin
      EndMonth := sta[2].wMonth+i-FPopupSystemTime.wMonth;
      if EndMonth > 12 then begin
         Endyear:= sta[2].wYear+1;
         EndMonth := EndMonth-12;
      end
      else EndYear:=sta[2].wYear;

      SetMonthCalDateTime(EncodeDate(EndYear,EndMonth,1));
      Date := EncodeDate(FPopupSystemTime.wYear,i,min(d,DaysThisMonth(i,FPopupSystemTime.wYear)));
      Change;
   end
   else if (FPopupSystemTime.wMonth > i) then begin
      StartMonth := sta[1].wMonth-(FPopupSystemTime.wMonth-i);
      if StartMonth < 1 then begin
         Startyear:= FPopupSystemTime.wYear-1;
         StartMonth := 12+StartMonth;
      end
      else StartYear:=FPopupSystemTime.wYear;

      SetMonthCalDateTime(EncodeDate(StartYear,StartMonth,1));
      Date := EncodeDate(FPopupSystemTime.wYear,i,min(d,DaysThisMonth(i,FPopupSystemTime.wYear)));
      Change;
   end;
end;

procedure TwwMonthCalendar.WndProc(var Message: TMessage);
var info:TMCHitTestInfo;
begin
  if (not (csdesigning in componentstate)) and visible then { RSW - add test for visible }
  case Message.Msg of
    WM_LBUTTONDBLCLK,
    WM_LBUTTONDOWN:
    begin
       FYearPopupShowing := ((FYearPopupMenu<>Nil) and (TCalendarPopupMenu(FYearPopupMenu).IsPoppedUp));
       FMonthPopupShowing := ((FMonthPopupMenu<>Nil) and (TCalendarPopupMenu(FMonthPopupMenu).IsPoppedUp));
       // The following code is used to hide ugly display of month calendar control
       // when one clicks on the year property.
       FillChar(info, SizeOf(TMCHitTestInfo), 0); { RSW }
       info.cbSize := sizeof(TMCHitTestInfo);
       info.pt := Point(TWMMouse(Message).xpos,TWMMouse(Message).ypos);

       MonthCal_HitTest(Handle,info);
       if (info.uHit = MCHT_TITLEYEAR) or (info.uHit = MCHT_TITLEMONTH) then begin
          MouseDown(mbleft,KeysToShiftState(TWMMouse(Message).Keys),TWMMouse(Message).xpos,TWMMouse(Message).ypos);
          Message.Result := 1;
          exit;
       end
       // 5/31/07 - Following code is not necessary and it causes auto-repeat of button to fail.
       {
       else if (not IsVistaComCtrlVersion) and ((info.uHit = MCHT_TITLEBTNNEXT) or (info.uHit = MCHT_TITLEBTNPREV)) then
       begin
          MouseDown(mbleft,KeysToShiftState(TWMMouse(Message).Keys),TWMMouse(Message).xpos,TWMMouse(Message).ypos);
          Message.Result := 1;
          exit;
       end
       }
       else begin
          // 3/22/2000 - PYW - Add better support for 12/31/9999.
          if info.st.wYear < 10000 then begin
            if (info.st.wDay<>0) and (info.st.wDay < 32) then begin
               if ((MaxDate<> 0.0) and
                  (Trunc(MaxDate)<Trunc(EncodeDate(info.st.wyear,info.st.wmonth,min(info.st.wday,DaysThisMonth(info.st.wmonth,info.st.wYear)))))) or
                  (Trunc(MinDate)>Trunc(EncodeDate(info.st.wyear,info.st.wmonth,min(info.st.wday,DaysThisMonth(info.st.wmonth,info.st.wYear))))) then
               begin
                  MouseDown(mbleft,KeysToShiftState(TWMMouse(Message).Keys),TWMMouse(Message).xpos,TWMMouse(Message).ypos);
                  Message.Result:=1;
                  exit;
               end;
            end;
          end
          else begin
             Message.Result:=1;
             exit;
          end;
       end;
    end;
    WM_LBUTTONUP,WM_MOUSEMOVE:
    begin
       FillChar(info, SizeOf(TMCHitTestInfo), 0); { RSW }
       info.cbSize := sizeof(TMCHitTestInfo);
       info.pt := Point(TWMMouse(Message).xpos,TWMMouse(Message).ypos);

       MonthCal_HitTest(Handle,info);
       if info.st.wYear < 10000 then // 3/22/2000 - PYW - Add better support for 12/31/9999.
       if (info.st.wDay<>0) and (info.st.wDay < 32) then begin
          if ((MaxDate<> 0.0) and
             (Trunc(MaxDate)<Trunc(EncodeDate(info.st.wyear,info.st.wmonth,min(info.st.wday,DaysThisMonth(info.st.wmonth,info.st.wYear)))))) or
             (Trunc(MinDate)>Trunc(EncodeDate(info.st.wyear,info.st.wmonth,min(info.st.wday,DaysThisMonth(info.st.wmonth,info.st.wYear))))) then
          begin
             if Message.Msg = WM_LButtonUP then
                MouseUp(mbleft,KeysToShiftState(TWMMouse(Message).Keys),TWMMouse(Message).xpos,TWMMouse(Message).ypos)
             else if Message.Msg = WM_LButtonUP then
                MouseMove(KeysToShiftState(TWMMouse(Message).Keys),TWMMouse(Message).xpos,TWMMouse(Message).ypos);

             Message.Result:=1;
             exit;
          end;
       end
    end;