chncalendar.pas

含阴历的中国式日历

    InflateRect(R, -1, -1);
    Brush.Color := clBtnFace;
    FrameRect(R);

    Brush.Color := clBtnShadow;
    Pen.Color := clBtnShadow;
    MoveTo(r.Left, r.Top);
    LineTo(r.Right - 1, r.Top);
    MoveTo(r.Left, r.Top);
    LineTo(r.Left, r.Bottom - 1);
  end;
end;

procedure TChnCalendar.Paint;
var
  TextTop: integer;
begin
  YearEdit.Color := color;
  MonthEdit.Color := color;
  DayEdit.Color := Color;

  Canvas.Pen.Color := FrameColor;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(ClientRect);
  if Ctl3D then
  begin
    DrawClt3D(Canvas, ClientRect);
    Canvas.Pen.Color := FrameColor;
    Canvas.Brush.Color := Color;
  end
  else
  begin
    Canvas.Rectangle(ClientRect);
  end;


  canvas.Font.Color := Font.Color;
  TextTop := (Height - canvas.TextHeight('A')) div 2;
  Canvas.TextOut(33, TextTop, '-');
  Canvas.TextOut(60, TextTop, '-');
  canvas.Font.Color := FCnDateColor;
  Canvas.TextOut(84, TextTop, CnDate);
  canvas.Font.Color := Font.Color;


  DrawButton(0);
  inherited;
end;

procedure TChnCalendar.SetBackPicture(const Value: TbitMap);
begin
  FBackPicture.Assign(Value);

end;

procedure TChnCalendar.setButtonColor(const Value: TColor);
begin
  if FButtonColor <> Value then
  begin
    FButtonColor := Value;
    Invalidate;
  end;
end;

procedure TChnCalendar.setCnDateColor(const Value: TColor);
begin
  if FCnDateColor <> Value then
  begin
    FCnDateColor := Value;
    Invalidate;
  end;
end;

procedure TChnCalendar.SetDateTime(const Value: TDateTime);
begin
  if Value <> FDateTime then
  begin
    FDateTime := Value;
    YearEdit.Text := FormatDateTime('YYYY', FDateTime);
    MonthEdit.Text := FormatDateTime('m', FDateTime);
    DayEdit.Text := FormatDateTime('dd', FDateTime);
    CnDate := CnanimalOfYear(DateTime) + CnMonthOfDate(DateTime) + CnDayOfDate(DateTime);
    Invalidate;
  end;
end;

procedure TChnCalendar.SetFrameColor(const Value: TColor);
begin
  FFrameColor := Value;
  Invalidate;
end;

function FormExists(FORM_NAME: string): BOOLEAN;
begin
  if Application.FindComponent(FORM_NAME) = nil then
    RESULT := FALSE
  else
    RESULT := TRUE;
end;

function DayOfMonth(Year, Month: Integer): integer; overload;
begin
  try
    Result := MonthDays[IsLeapYear(Year), Month];
  except
    Result := 0;
  end;
end;

function DayOfMonth(Dates: TDateTime): integer; overload;
var
  Year, Month, Day, Hour: Word;

begin
  DecodeDate(Dates, Year, Month, day);
  Result := MonthDays[IsLeapYear(Year), Month];
end;

function DaysOfMonth(Dates: TDateTime): Integer;
begin
  Result := DayOfMonth(YearOf(Dates), MonthOf(Dates));
end;


function SetDateTime(NYear, NMonth, NDay: Word): TDate;
var
  MyDay: Word;
begin
  MyDay := DayOfMonth(NYear, NMonth);
  if MyDay < NDay then
    NDay := MyDay;
  Result := EncodeDate(NYear, NMonth, NDay);

end;


procedure AdjustDropDownForm(AControl: TControl; HostControl: TControl);
var
  WorkArea: TRect;
  HostP, PDelpta: TPoint;
begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0);
  HostP := HostControl.ClientToScreen(Point(0, 0));
  PDelpta := AControl.ClientToScreen(Point(0, 0));

  AControl.Left := HostP.x;
  AControl.Top := HostP.y + HostControl.Height + 1;

  if (AControl.Width > WorkArea.Right - WorkArea.Left) then
    AControl.Width := WorkArea.Right - WorkArea.Left;

  if (AControl.Left + AControl.Width > WorkArea.Right) then
    AControl.Left := WorkArea.Right - AControl.Width;
  if (AControl.Left < WorkArea.Left) then
    AControl.Left := WorkArea.Left;


  if (AControl.Top + AControl.Height > WorkArea.Bottom) then
  begin
    if (HostP.y - WorkArea.Top > WorkArea.Bottom - HostP.y - HostControl.Height) then
      AControl.Top := HostP.y - AControl.Height;
  end;

  if (AControl.Top < WorkArea.Top) then
  begin
    AControl.Height := AControl.Height - (WorkArea.Top - AControl.Top);
    AControl.Top := WorkArea.Top;
  end;

  if (AControl.Top + AControl.Height > WorkArea.Bottom) then
  begin
    AControl.Height := WorkArea.Bottom - AControl.Top;
  end;

end;


procedure TChnCalendar.WMLButtonDown(var Message: TWMLButtonDown);
var
  xy: TPoint;
  P: TPoint;
  bmp: TbitMap;
begin
  xy := Point(Message.Pos.x, Message.Pos.y);
  //GetCursorPos(xy);
  //xy := ScreenToClient(xy);
  //xy:=ClientToScreen(xy);
  if PtInRect(ButtonRect, xy) then
  begin
    if not IsWindowVisible(FRM_Date.Handle) then
    begin
      if MouseStyle <> 1 then
      begin
        MouseStyle := 1;
        DrawButton(1);
      end;

      FRM_Date.YearEdit := YearEdit;
      FRM_Date.MonthEdit := MonthEdit;
      FRM_Date.DayEdit := DayEdit;
      MHostControl := Self;

      with FRM_Date do
      begin
        YearEdit.Text := IntToStr(StrTOIntDef(YearEdit.Text, YearOf(Date)));
        MonthEdit.Text := IntToStr(StrTOIntDef(MonthEdit.Text, MonthOf(Date)));
        DayEdit.Text := IntToStr(StrTOIntDef(DayEdit.Text, DayOfMonth(Date)));
        if (StrToInt(YearEdit.Text) > 2050) or (StrToInt(YearEdit.Text) < 1901) then
         YearEdit.Text := IntToStr(YearOf(Date));
        if (StrToInt(MonthEdit.Text) > 12) or (StrToInt(MonthEdit.Text) < 1) then
         MonthEdit.Text := IntToStr(MonthOf(Date));
        if StrToInt(DayEdit.Text) > DayOfMonth(StrToInt(YearEdit.Text), StrToInt(MonthEdit.Text)) then
         DayEdit.Text := IntToStr(DayOfMonth(StrToInt(YearEdit.Text), StrToInt(MonthEdit.Text)));
        NDate := EncodeDate(StrToInt(YearEdit.text), StrToInt(MonthEdit.text), StrToInt(DayEdit.text));
      end;
      AdjustDropDownForm(FRM_Date, Self);
      FRM_Date.Show;
    end;
  end;
end;

procedure TChnCalendar.WMLButtonUp(var Message: TWMLButtonUp);
var
  xy: TPoint;
begin
  xy := Point(Message.Pos.x, Message.Pos.y);
  if PtInRect(ButtonRect, xy) then
  begin
    MouseStyle := 0;
    DrawButton(0);
  end;
end;

procedure TChnCalendar.WMSize(var Msg: TWMSize);
begin
  YearEdit.Top := (Height - YearEdit.Height) div 2;
  MonthEdit.Top := YearEdit.Top;
  DayEdit.Top := YearEdit.Top;
end;

procedure TChnCalendar.CMCtl3DChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;

end;

procedure TChnCalendar.CMMouseLeave(var Message: TMessage);
begin
  if MouseStyle = 1 then
  begin
    MouseStyle := 0;
    DrawButton(0);
  end;

end;

procedure TChnCalendar.__EditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  X,M : Integer;
begin
  if TEdit(Sender)=YearEdit then
  begin
    if key=38 then
      YearEdit.Text:=IntToStr(StrToIntDef(YearEdit.Text,0)+1);
    if key=40 then
    begin
      X:=StrToIntDef(YearEdit.Text,0)-1;
      if X<=0 then X:= 1899;
      YearEdit.Text:=IntToStr(X);
    end;
    if key=39 then
      MonthEdit.SetFocus;
    if key=37 then
      DayEdit.SetFocus;
  end;

  if TEdit(Sender)=MonthEdit then
  begin
    if key=38 then
    begin
      X:=StrToIntDef(MonthEdit.Text,0)+1;
      if X>=13 then X:=12;
      MonthEdit.Text:=IntToStr(X);
    end else
    if key=40 then
    begin
      X:=StrToIntDef(MonthEdit.Text,0)-1;
      if X<=0 then X:= 1;
      MonthEdit.Text:=IntToStr(X);
    end else
    if key=39 then
      DayEdit.SetFocus
    else
    if key=37 then
      YearEdit.SetFocus;
  end;

  if TEdit(Sender)=DayEdit then
  begin
    if key=39 then
      YearEdit.SetFocus
    else
    if key=37 then
      MonthEdit.SetFocus
    else
    begin
      X:=-999999;
      M:=StrToInt(MonthEdit.Text);
      if key=38 then
        X:=StrToIntDef(DayEdit.Text,0)+1;
      if key=40 then
        X:=StrToIntDef(DayEdit.Text,0)-1;
      if X=-999999 then Exit;

      if X<1 then X:=1;

      Case M of
        1,3,5,7,8,10,11:
          if X>31 then X:=32;
        2:
          if X>28 then X:=28;
        4,6,9,12 :
          if X>28 then X:=28;
      end;
      DayEdit.Text:=IntToStr(X);
    end;
  end;

  if (key=38) or (key=40) then
  begin
    TEdit(Sender).SelStart:=Length(TEdit(Sender).Text)+1;
    Key:=0;
  end;
end;

procedure TChnCalendar.__EditOnChange(Sender: TObject);
var
  X,M : Integer;
begin
  X:=StrToIntDef(TEdit(Sender).Text,0);
  if TEdit(Sender)=YearEdit then
  begin
    if X<=0 then  TEdit(Sender).Text:='1899';
  end;

  if TEdit(Sender)=MonthEdit then
  begin
    if X<=0 then TEdit(Sender).Text:='1';
    if X>12 then TEdit(Sender).Text:='12';
  end;

  if TEdit(Sender)=DayEdit then
  begin
    M:=StrToInt(MonthEdit.Text);

    if X<1 then X:=1;
    Case M of
      1,3,5,7,8,10,11:
        if X>31 then X:=32;
      2:
        if X>28 then X:=28;
      4,6,9,12 :
        if X>30 then X:=30;
    end;
    DayEdit.Text:=IntToStr(X);
  end; 
end;

procedure TChnCalendar.WMLBUTTONDBLCLK(var Message: TWMLButtonUp);
begin

end;

end.