Subject: 请问哪里有cncalendar控件,日历控件 [Print This Page]

---

Author: greenpeople    Time: 2007-10-31 14:25     Subject: 请问哪里有cncalendar控件,日历控件

请问哪里有cncalendar控件,日历控件

---

Author: Passion    Time: 2007-10-31 15:04

cncalendar是函数库，不是界面控件。
在CVS的cnpack模块中。

---

Author: croslq    Time: 2007-12-13 15:07

//继承自TCustomGrid并带有CheckBox的日历
{
   修改的日历组件
   加入了CheckBox的功能
   主要是用于我写的一个电视广告合同串联编排的管理软件
   QQ:250198418
   Email:lqcros@126.com

}
unit SampleCalendar;

interface

uses
  SysUtils, Classes, Controls, Grids, Windows, Messages, StdCtrls, Graphics, Forms;

type
  TSampleCalendar = class(TCustomGrid)
  private
    { Private declarations }
    FSelArray: Array of boolean;   //记录每一个单元格的Checked状态;
    FSelectColor: TColor;          //选择单元格颜色
    FDate: TDateTime;
    FMonthOffset: integer;
    FOnChange: TNotifyEvent;

    procedure SetCalendarDate(Value: TDateTime);
    function  GetDateElement(Index: integer): integer;                       //   note   the   Index   parameter
    procedure SetDateElement(Index: integer; Value: integer);
    function  GetChecked(Index: integer): boolean;
    procedure SetChecked(Index: integer; Value: boolean);
    procedure SetSelectColor(Value: TColor);
  protected
    { Protected declarations }
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState);override;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure UpdateCalendar;
    function  DayNum(ACol: integer; ARow: integer): integer;
    procedure NextMonth;
    procedure PrevMonth;
    procedure NextYear;
    procedure PrevYear;
    procedure Change;
    function SelectCell(ACol, ARow: Longint): Boolean; override;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
//    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
//      X, Y: Integer); override;

  public
    { Public declarations }

    constructor Create(AOwner: TComponent); override;

//    procedure Click;
    property  CalendarDate: TDateTime read FDate write SetCalendarDate;
    property  Day:   integer index 3 read GetDateElement write SetDateElement;
    property  Month: integer index 2 read GetDateElement write SetDateElement;
    property  Year:  integer index 1 read GetDateElement write SetDateElement;
    property  Checked[Index: integer]: boolean read GetChecked write SetChecked;   //设置或提取单元格状态
  published
    { Published declarations }
    property  SelectColor: TColor read FSelectColor write SetSelectColor default clBtnFace;
    property  Align;                                         //   publish   properties
    property  BorderStyle;
    property  Color;
    property  FixedColor;
    property  Font;
    property  GridLineWidth;
    property  ParentColor;
    property  ParentFont;
    property  Options;

    property  OnClick;                                       //   publish   events
    property  OnDblClick;
    property  OnDragDrop;
    property  OnDragOver;
    property  OnEndDrag;
    property  OnKeyDown;
    property  OnKeyPress;
    property  OnKeyUp;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

var
  ShortDayNames1: array[1..7] of string;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TSampleCalendar]);
end;

constructor TSampleCalendar.Create(AOwner: TComponent);

begin
    inherited;
//  初始化日历组件的外观
    ColCount   :=   7;
    RowCount   :=   7;
    RowHeights[0] := 35;
    FixedCols  :=   0;
    FixedRows  :=   1;
    BorderStyle := bsNone;
    Color      := clBtnFace;
    FixedColor := $00ACACAC;
    SelectColor := $00ACACAC;
    ScrollBars := ssNone;
    Options := [goVertLine,goHorzLine,goDrawFocusSelected];

    FDate      :=  Now;

    SetLength(FSelArray, 31);

    ShortDayNames1[1] := '日';
    ShortDayNames1[2] := '一';
    ShortDayNames1[3] := '二';
    ShortDayNames1[4] := '三';
    ShortDayNames1[5] := '四';
    ShortDayNames1[6] := '五';
    ShortDayNames1[7] := '六';

    UpdateCalendar();

end;

procedure TSampleCalendar.SetCalendarDate(Value: TDateTime);
var
    i: integer;
begin
    FDate   :=   Value;                                             //   Set   the   new   date   value

    for i := 0 to 31 do
    FSelArray := false;

    //Refresh();                                                 //   Update   the   onscreen   image
    UpdateCalendar();                                       //   this   previously   called   Refresh
    Change();                                                       //   this   is   the   only   new   statement   
end;

function  TSampleCalendar.GetDateElement(Index: integer): Integer;                       //   note   the   Index   parameter
var
    AYear,   AMonth,   ADay: word;
begin
    DecodeDate(FDate, AYear,   AMonth,   ADay);                         //   break   encoded   date   into   elements
    case Index of
        1:   result   :=   AYear;
        2:   result   :=   AMonth;
        3:   result   :=   ADay;
    else
        result := -1;
    end;
end;

procedure TSampleCalendar.SetDateElement(Index: integer; Value: integer);
var
    AYear, AMonth, ADay: word;
begin
    if (Value   >   0) then                                                                    //   all   elements   must   be   positive
    begin
        DecodeDate(FDate, AYear, AMonth, ADay);       //   get   current   date   elements
        case Index of
            1: AYear  := Value;
            2: AMonth := Value;
            3: ADay   := Value;
        else
            exit;
        end;
    end;
    FDate   :=   EncodeDate(AYear,   AMonth,   ADay);                   //   encode   the   modified   date
    //Refresh();                                                                         //   update   the   visible   calendar
    UpdateCalendar();                                                               //   this   previously   called   Refresh
    Change();                                                                               //   this   is   new
end;

procedure TSampleCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState);
var
    TheText: string;
    TempDay: integer;
    Checked: boolean;
    CheckRect: TRect;
const
    CheckBox : array[Boolean] of Integer = (DFCS_BUTTONCHECK,
    DFCS_BUTTONCHECK or DFCS_CHECKED);
begin
    if gdSelected in AState then
    begin
        Canvas.Brush.Color := SelectColor;
        Canvas.FillRect(ARect);
    end
    else
    begin
        if (ARow >= FixedRows) and (ACol >= FixedCols) then
        Canvas.Brush.Color := Color
        else
        Canvas.Brush.Color := FixedColor;   //
        Canvas.FillRect(ARect);
    end;

    if (ARow = 0) then
        TheText := ShortDayNames1[ACol + 1]
    else
    begin
        TheText := '';
        TempDay := DayNum(ACol, ARow);                                       //   DayNum   is   defined   later
        if (TempDay <> -1) then
        begin
            if TempDay <= 9 then
            TheText := ' ' + IntToStr(TempDay)   //日期右对齐,美观
            else
            TheText := IntToStr(TempDay);
        end;
    end;

    CheckRect.Top    := ARect.Top  + (ARect.Bottom - ARect.Top - 17) div 2;
    CheckRect.Bottom := CheckRect.Top  + 16;
    CheckRect.Left   := ARect.Left + (ARect.Right - ARect.Left - Canvas.TextWidth('11') - 16) div 2;
    CheckRect.Right  := CheckRect.Left + 16;

    if (ARow >= FixedRows) and (ACol >= FixedCols) then
    begin
        if TheText <> '' then
        begin
            Checked := FSelArray[StrToInt(TheText)];
            Canvas.FillRect(CheckRect);
            DrawFrameControl(Canvas.Handle, CheckRect, DFC_BUTTON, CheckBox[Checked]);
        end;
    end;

    if (ARow >= FixedRows) and (ACol >= FixedCols) then
    begin
        CheckRect.Left := CheckRect.Left + 18;
        CheckRect.Top  := ARect.Top + (ARect.Bottom - ARect.Top - Canvas.TextHeight(TheText)) div 2;
        CheckRect.Bottom := Arect.Bottom;
        CheckRect.Right := Arect.Right -3;

        DrawText(Canvas.Handle, pchar(TheText), Length(TheText), CheckRect, DT_LEFT);
    end
    else
    begin
        CheckRect := ARect;
        CheckRect.Top := ARect.Top + (ARect.Bottom - ARect.Top - Canvas.TextHeight(TheText)) div 2;
        DrawText(Canvas.Handle, pchar(TheText), Length(TheText), CheckRect, DT_CENTER);
    end;

end;

procedure TSampleCalendar.WMSize(var Msg: TWMSize);
var
    GridLines: integer;
begin
    GridLines        := 6 * GridLineWidth;                                     //   calculated   combined   size   of   all   lines
    DefaultColWidth  := (Msg.Width  - GridLines) div 7;         //   set   new   default   cell   width
    DefaultRowHeight := (Msg.Height - GridLines) div 7;     //   and   cell   height
    inherited;
end;

procedure TSampleCalendar.UpdateCalendar;
var
    AYear, AMonth, ADay: word;
    FirstDate: TDateTime;
begin
    if (FDate <> 0) then                                                     //   only   calculate   offset   if   date   is   valid
    begin
        DecodeDate(FDate, AYear,   AMonth,   ADay);     //   get   elements   of   date
        FirstDate    := EncodeDate(AYear,   AMonth,   1);       //   date   of   the   first
        FMonthOffset := 2 - DayOfWeek(FirstDate);     //   generate   the   offset   into   the   grid
        Row := (ADay - FMonthOffset) div 7 + 1;
        Col := (ADay - FMonthOffset) mod 7;
    end;
    Refresh();                                                                         //   always   repaint   the   control
end;

function TSampleCalendar.DayNum(ACol: integer; ARow: integer): integer;
begin
    Result := FMonthOffset + ACol + (ARow - 1) * 7;               //   calculate   day   for   this   cell

    if ((result < 1) or (result > MonthDays[IsLeapYear(Year)][Month])) then
    result := -1;       //   return   -1   if   invalid
end;

procedure TSampleCalendar.NextMonth;
var
    AYear, AMonth, ADay: word;
    i: integer;
begin
    DecodeDate(IncMonth(CalendarDate, 1), AYear, AMonth, ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.PrevMonth;
var
    AYear, AMonth, ADay: word;
    i: integer;
begin
    DecodeDate(IncMonth(CalendarDate, -1), AYear,   AMonth,   ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.NextYear;
var
    AYear, AMonth, ADay: word;
    i: integer;
begin
    DecodeDate(IncMonth(CalendarDate, 12), AYear,   AMonth,   ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.PrevYear;
var
    AYear, AMonth, ADay: word;
    i: integer;   
begin
    DecodeDate(IncMonth(CalendarDate,   -12),   AYear,   AMonth,   ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self)
end;

function TSampleCalendar.SelectCell(ACol, ARow: Longint): Boolean;
begin
  if (DayNum(ACol,ARow) = -1)  then
  Result := false
  else
  Result := true;
//    Result := inherited(ACol, ARow);
end;
{
procedure TSampleCalendar.Click;
var
    TempDay: integer;
begin
    TempDay := DayNum(Col, Row);                         // get   the   day   number   for   the   clicked   cell
    if (TempDay <>  -1) then  Day := TempDay;            // change   day   if   valid
end;
}
procedure TSampleCalendar.KeyDown(var Key: Word; Shift: TShiftState);
var
    TempDay: integer;
begin
  inherited KeyDown(Key, Shift);
  if Key = VK_SPACE then
  begin
    TempDay := DayNum(Col, Row);
    if TempDay <> -1 then
    begin
        FSelArray[TempDay] := Not FSelArray[TempDay];
        Day := TempDay;
    end;
  end;
  Refresh();
end;

procedure TSampleCalendar.MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
var
    TempDay: integer;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    TempDay := DayNum(Col, Row);
    if TempDay <> -1 then
    begin
        FSelArray[TempDay] := Not FSelArray[TempDay];
        Day := TempDay;
    end;
  end;
  Refresh();
end;
{

procedure TSampleCalendar.MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
  try
    case FGridState of
      gsSelecting:
        begin
          Click;
        end;
    end;
    inherited MouseUp(Button, Shift, X, Y);
  finally
    FGridState := gsNormal;
  end;
end;
}

function TSampleCalendar.GetChecked(Index: integer): boolean;
begin
    Result := false;
    if (Index >= 1) and (Index <=31) then
    Result := FSelArray[Index];
end;

procedure TSampleCalendar.SetChecked(Index: integer; Value: boolean);
begin
    if (Index >= 1) and (Index <=31) then
    if FSelArray[Index] <> Value then
    begin
        FSelArray[Index] := Value;
    end;
end;

procedure TSampleCalendar.SetSelectColor(Value: TColor);
begin
  if FSelectColor <> Value then
  begin
    FSelectColor := Value;
    Refresh();
  end;
end;

end.



2007-8-18 22:05:46   
修改笔记  发表评语???     

2007-8-20 10:05:27    加入了，Enabled 功能{
   修改的日历组件
   加入了CheckBox的功能
   主要是用于我写的一个电视广告合同串联编排的管理软件
   QQ:250198418
   Email:lqcros@126.com

}
unit SampleCalendar;

interface

uses
  SysUtils, Classes, Controls, Grids, Windows, Messages, StdCtrls, Graphics, Forms;

type
  TSampleCalendar = class(TCustomGrid)
  private
    { Private declarations }
    FSelArray: Array of boolean;   //记录每一个单元格的Checked状态;
    FSelectColor: TColor;          //选择单元格颜色
    FDate: TDateTime;
    FMonthOffset: integer;
    FOnChange: TNotifyEvent;

    procedure SetCalendarDate(Value: TDateTime);
    function  GetDateElement(Index: integer): integer;                       //   note   the   Index   parameter
    procedure SetDateElement(Index: integer; Value: integer);
    function  GetChecked(Index: integer): boolean;
    procedure SetChecked(Index: integer; Value: boolean);
    procedure SetSelectColor(Value: TColor);
    procedure CMEnabledChanged( var Msg: TMessage ); message cm_EnabledChanged;

  protected
    { Protected declarations }
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState);override;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure UpdateCalendar;
    function  DayNum(ACol: integer; ARow: integer): integer;
    procedure NextMonth;
    procedure PrevMonth;
    procedure NextYear;
    procedure PrevYear;
    procedure Change;
    function SelectCell(ACol, ARow: Longint): Boolean; override;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
//    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
//      X, Y: Integer); override;

  public
    { Public declarations }

    constructor Create(AOwner: TComponent); override;

//    procedure Click;
    property  CalendarDate: TDateTime read FDate write SetCalendarDate;
    property  Day:   integer index 3 read GetDateElement write SetDateElement;
    property  Month: integer index 2 read GetDateElement write SetDateElement;
    property  Year:  integer index 1 read GetDateElement write SetDateElement;
    property  Checked[Index: integer]: boolean read GetChecked write SetChecked;   //设置或提取单元格状态
  published
    { Published declarations }
    property  SelectColor: TColor read FSelectColor write SetSelectColor default clBtnFace;
    property  Align;                                         //   publish   properties
    property  BorderStyle;
    property  Color;
    property  FixedColor;
    property  Font;
    property  GridLineWidth;
    property  ParentColor;
    property  ParentFont;
    property  Options;
    property  Enabled;

    property  OnClick;                                       //   publish   events
    property  OnDblClick;
    property  OnDragDrop;
    property  OnDragOver;
    property  OnEndDrag;
    property  OnKeyDown;
    property  OnKeyPress;
    property  OnKeyUp;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

var
  ShortDayNames1: array[1..7] of string;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TSampleCalendar]);
end;

constructor TSampleCalendar.Create(AOwner: TComponent);

begin
    inherited;
//  初始化日历组件的外观
    ColCount   :=   7;
    RowCount   :=   7;
    RowHeights[0] := 35;
    FixedCols  :=   0;
    FixedRows  :=   1;
    BorderStyle := bsNone;
    Color      := clBtnFace;
    FixedColor := $00ACACAC;
    SelectColor := $00ACACAC;
    ScrollBars := ssNone;
    Enabled    := true;
    Options := [goVertLine,goHorzLine,goDrawFocusSelected];

    FDate      :=  Now;

    SetLength(FSelArray, 31);

    ShortDayNames1[1] := '日';
    ShortDayNames1[2] := '一';
    ShortDayNames1[3] := '二';
    ShortDayNames1[4] := '三';
    ShortDayNames1[5] := '四';
    ShortDayNames1[6] := '五';
    ShortDayNames1[7] := '六';

    UpdateCalendar();

end;

procedure TSampleCalendar.SetCalendarDate(Value: TDateTime);
var
    i: integer;
begin
    FDate   :=   Value;                                             //   Set   the   new   date   value

    for i := 0 to 31 do
    FSelArray := false;

    //Refresh();                                                 //   Update   the   onscreen   image
    UpdateCalendar();                                       //   this   previously   called   Refresh
    Change();                                                       //   this   is   the   only   new   statement   
end;

function  TSampleCalendar.GetDateElement(Index: integer): Integer;                       //   note   the   Index   parameter
var
    AYear,   AMonth,   ADay: word;
begin
    DecodeDate(FDate, AYear,   AMonth,   ADay);                         //   break   encoded   date   into   elements
    case Index of
        1:   result   :=   AYear;
        2:   result   :=   AMonth;
        3:   result   :=   ADay;
    else
        result := -1;
    end;
end;

procedure TSampleCalendar.SetDateElement(Index: integer; Value: integer);
var
    AYear, AMonth, ADay: word;
begin
    if (Value   >   0) then                                                                    //   all   elements   must   be   positive
    begin
        DecodeDate(FDate, AYear, AMonth, ADay);       //   get   current   date   elements
        case Index of
            1: AYear  := Value;
            2: AMonth := Value;
            3: ADay   := Value;
        else
            exit;
        end;
    end;
    FDate   :=   EncodeDate(AYear,   AMonth,   ADay);                   //   encode   the   modified   date
    //Refresh();                                                                         //   update   the   visible   calendar
    UpdateCalendar();                                                               //   this   previously   called   Refresh
    Change();                                                                               //   this   is   new
end;

procedure TSampleCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState);
var
    TheText: string;
    TempDay: integer;
    Checked: boolean;
    CheckRect: TRect;
const
    CheckBox : array[Boolean] of Integer = (DFCS_BUTTONCHECK,
    DFCS_BUTTONCHECK or DFCS_CHECKED);
begin
    if gdSelected in AState then
    begin
        Canvas.Brush.Color := SelectColor;
        Canvas.FillRect(ARect);
    end
    else
    begin
        if (ARow >= FixedRows) and (ACol >= FixedCols) then
        Canvas.Brush.Color := Color
        else
        Canvas.Brush.Color := FixedColor;   //
        Canvas.FillRect(ARect);
    end;

    if (ARow = 0) then
        TheText := ShortDayNames1[ACol + 1]
    else
    begin
        TheText := '';
        TempDay := DayNum(ACol, ARow);                                       //   DayNum   is   defined   later
        if (TempDay <> -1) then
        begin
            if TempDay <= 9 then
            TheText := ' ' + IntToStr(TempDay)   //日期右对齐,美观
            else
            TheText := IntToStr(TempDay);
        end;
    end;

    CheckRect.Top    := ARect.Top  + (ARect.Bottom - ARect.Top - 17) div 2;
    CheckRect.Bottom := CheckRect.Top  + 16;
    CheckRect.Left   := ARect.Left + (ARect.Right - ARect.Left - Canvas.TextWidth('11') - 16) div 2;
    CheckRect.Right  := CheckRect.Left + 16;

    if (ARow >= FixedRows) and (ACol >= FixedCols) then
    begin
        if TheText <> '' then
        begin
            Checked := FSelArray[StrToInt(TheText)];
            Canvas.FillRect(CheckRect);
            if Enabled then
            DrawFrameControl(Canvas.Handle, CheckRect, DFC_BUTTON, CheckBox[Checked])
            else
            DrawFrameControl(Canvas.Handle, CheckRect, DFC_BUTTON, CheckBox[Checked] or DFCS_INACTIVE);
        end;
    end;

    if (ARow >= FixedRows) and (ACol >= FixedCols) then
    begin
        CheckRect.Left := CheckRect.Left + 18;
        CheckRect.Top  := ARect.Top + (ARect.Bottom - ARect.Top - Canvas.TextHeight(TheText)) div 2;
        CheckRect.Bottom := Arect.Bottom;
        CheckRect.Right := Arect.Right -3;

        DrawText(Canvas.Handle, pchar(TheText), Length(TheText), CheckRect, DT_LEFT);
    end
    else
    begin
        CheckRect := ARect;
        CheckRect.Top := ARect.Top + (ARect.Bottom - ARect.Top - Canvas.TextHeight(TheText)) div 2;
        DrawText(Canvas.Handle, pchar(TheText), Length(TheText), CheckRect, DT_CENTER);
    end;

end;

procedure TSampleCalendar.WMSize(var Msg: TWMSize);
var
    GridLines: integer;
begin
    GridLines        := 6 * GridLineWidth;                                     //   calculated   combined   size   of   all   lines
    DefaultColWidth  := (Msg.Width  - GridLines) div 7;         //   set   new   default   cell   width
    DefaultRowHeight := (Msg.Height - GridLines) div 7;     //   and   cell   height
    inherited;
end;

procedure TSampleCalendar.UpdateCalendar;
var
    AYear, AMonth, ADay: word;
    FirstDate: TDateTime;
begin
    if (FDate <> 0) then                                                     //   only   calculate   offset   if   date   is   valid
    begin
        DecodeDate(FDate, AYear,   AMonth,   ADay);     //   get   elements   of   date
        FirstDate    := EncodeDate(AYear,   AMonth,   1);       //   date   of   the   first
        FMonthOffset := 2 - DayOfWeek(FirstDate);     //   generate   the   offset   into   the   grid
        Row := (ADay - FMonthOffset) div 7 + 1;
        Col := (ADay - FMonthOffset) mod 7;
    end;
    Refresh();                                                                         //   always   repaint   the   control
end;

function TSampleCalendar.DayNum(ACol: integer; ARow: integer): integer;
begin
    Result := FMonthOffset + ACol + (ARow - 1) * 7;               //   calculate   day   for   this   cell

    if ((result < 1) or (result > MonthDays[IsLeapYear(Year)][Month])) then
    result := -1;       //   return   -1   if   invalid
end;

procedure TSampleCalendar.NextMonth;
var
    AYear, AMonth, ADay: word;
    i: integer;
begin
    DecodeDate(IncMonth(CalendarDate, 1), AYear, AMonth, ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.PrevMonth;
var
    AYear, AMonth, ADay: word;
    i: integer;
begin
    DecodeDate(IncMonth(CalendarDate, -1), AYear,   AMonth,   ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.NextYear;
var
    AYear, AMonth, ADay: word;
    i: integer;
begin
    DecodeDate(IncMonth(CalendarDate, 12), AYear,   AMonth,   ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.PrevYear;
var
    AYear, AMonth, ADay: word;
    i: integer;   
begin
    DecodeDate(IncMonth(CalendarDate,   -12),   AYear,   AMonth,   ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self)
end;

function TSampleCalendar.SelectCell(ACol, ARow: Longint): Boolean;
begin
  if Enabled then
  if (DayNum(ACol,ARow) = -1)  then
  Result := false
  else
  Result := true;
//    Result := inherited(ACol, ARow);
end;
{
procedure TSampleCalendar.Click;
var
    TempDay: integer;
begin
    TempDay := DayNum(Col, Row);                         // get   the   day   number   for   the   clicked   cell
    if (TempDay <>  -1) then  Day := TempDay;            // change   day   if   valid
end;
}
procedure TSampleCalendar.KeyDown(var Key: Word; Shift: TShiftState);
var
    TempDay: integer;
begin
  inherited KeyDown(Key, Shift);
  if Key = VK_SPACE then
  begin
    TempDay := DayNum(Col, Row);
    if TempDay <> -1 then
    begin
        if Enabled then
        begin
            FSelArray[TempDay] := Not FSelArray[TempDay];
            Day := TempDay;
        end;
    end;
  end;
  Refresh();
end;

procedure TSampleCalendar.MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
var
    TempDay: integer;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    TempDay := DayNum(Col, Row);
    if TempDay <> -1 then
    begin
        if Enabled then
        begin
            FSelArray[TempDay] := Not FSelArray[TempDay];
            Day := TempDay;
        end;
    end;
  end;
  Refresh();
end;
{

procedure TSampleCalendar.MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
  try
    case FGridState of
      gsSelecting:
        begin
          Click;
        end;
    end;
    inherited MouseUp(Button, Shift, X, Y);
  finally
    FGridState := gsNormal;
  end;
end;
}

function TSampleCalendar.GetChecked(Index: integer): boolean;
begin
    Result := false;
    if (Index >= 1) and (Index <=31) then
    Result := FSelArray[Index];
end;

procedure TSampleCalendar.SetChecked(Index: integer; Value: boolean);
begin
    if (Index >= 1) and (Index <=31) then
    if FSelArray[Index] <> Value then
    begin
        FSelArray[Index] := Value;
    end;
end;

procedure TSampleCalendar.SetSelectColor(Value: TColor);
begin
  if FSelectColor <> Value then
  begin
    FSelectColor := Value;
    Refresh();
  end;
end;

procedure TSampleCalendar.CMEnabledChanged( var Msg: TMessage);
begin
  inherited;
  Refresh;
end;

end.  


2007-8-20 10:49:39    CheckBox 在右边 {
   修改的日历组件
   加入了CheckBox的功能
   主要是用于我写的一个电视广告合同串联编排的管理软件
   QQ:250198418
   Email:lqcros@126.com

}
unit SampleCalendar;

interface

uses
  SysUtils, Classes, Controls, Grids, Windows, Messages, StdCtrls, Graphics, Forms;

type
  TSampleCalendar = class(TCustomGrid)
  private
    { Private declarations }
    FSelArray: Array of boolean;   //记录每一个单元格的Checked状态;
    FSelectColor: TColor;          //选择单元格颜色
    FDate: TDateTime;
    FMonthOffset: integer;
    FOnChange: TNotifyEvent;

    procedure SetCalendarDate(Value: TDateTime);
    function  GetDateElement(Index: integer): integer;                       //   note   the   Index   parameter
    procedure SetDateElement(Index: integer; Value: integer);
    function  GetChecked(Index: integer): boolean;
    procedure SetChecked(Index: integer; Value: boolean);
    procedure SetSelectColor(Value: TColor);
    procedure CMEnabledChanged( var Msg: TMessage ); message cm_EnabledChanged;

  protected
    { Protected declarations }
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState);override;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure UpdateCalendar;
    function  DayNum(ACol: integer; ARow: integer): integer;
    procedure NextMonth;
    procedure PrevMonth;
    procedure NextYear;
    procedure PrevYear;
    procedure Change;
    function SelectCell(ACol, ARow: Longint): Boolean; override;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
//    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
//      X, Y: Integer); override;

  public
    { Public declarations }

    constructor Create(AOwner: TComponent); override;

//    procedure Click;
    property  CalendarDate: TDateTime read FDate write SetCalendarDate;
    property  Day:   integer index 3 read GetDateElement write SetDateElement;
    property  Month: integer index 2 read GetDateElement write SetDateElement;
    property  Year:  integer index 1 read GetDateElement write SetDateElement;
    property  Checked[Index: integer]: boolean read GetChecked write SetChecked;   //设置或提取单元格状态
  published
    { Published declarations }
    property  SelectColor: TColor read FSelectColor write SetSelectColor default clBtnFace;
    property  Align;                                         //   publish   properties
    property  BorderStyle;
    property  Color;
    property  FixedColor;
    property  Font;
    property  GridLineWidth;
    property  ParentColor;
    property  ParentFont;
    property  Options;
    property  Enabled;

    property  OnClick;                                       //   publish   events
    property  OnDblClick;
    property  OnDragDrop;
    property  OnDragOver;
    property  OnEndDrag;
    property  OnKeyDown;
    property  OnKeyPress;
    property  OnKeyUp;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

var
  ShortDayNames1: array[1..7] of string;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TSampleCalendar]);
end;

constructor TSampleCalendar.Create(AOwner: TComponent);

begin
    inherited;
//  初始化日历组件的外观
    ColCount   :=   7;
    RowCount   :=   7;
    RowHeights[0] := 35;
    FixedCols  :=   0;
    FixedRows  :=   1;
    BorderStyle := bsNone;
    Color      := clBtnFace;
    FixedColor := $00ACACAC;
    SelectColor := $00ACACAC;
    ScrollBars := ssNone;
    Enabled    := true;
    Options := [goVertLine,goHorzLine,goDrawFocusSelected];

    FDate      :=  Now;

    SetLength(FSelArray, 31);

    ShortDayNames1[1] := '日';
    ShortDayNames1[2] := '一';
    ShortDayNames1[3] := '二';
    ShortDayNames1[4] := '三';
    ShortDayNames1[5] := '四';
    ShortDayNames1[6] := '五';
    ShortDayNames1[7] := '六';

    UpdateCalendar();

end;

procedure TSampleCalendar.SetCalendarDate(Value: TDateTime);
var
    i: integer;
begin
    FDate   :=   Value;                                             //   Set   the   new   date   value

    for i := 0 to 31 do
    FSelArray := false;

    //Refresh();                                                 //   Update   the   onscreen   image
    UpdateCalendar();                                       //   this   previously   called   Refresh
    Change();                                                       //   this   is   the   only   new   statement   
end;

function  TSampleCalendar.GetDateElement(Index: integer): Integer;                       //   note   the   Index   parameter
var
    AYear,   AMonth,   ADay: word;
begin
    DecodeDate(FDate, AYear,   AMonth,   ADay);                         //   break   encoded   date   into   elements
    case Index of
        1:   result   :=   AYear;
        2:   result   :=   AMonth;
        3:   result   :=   ADay;
    else
        result := -1;
    end;
end;

procedure TSampleCalendar.SetDateElement(Index: integer; Value: integer);
var
    AYear, AMonth, ADay: word;
begin
    if (Value   >   0) then                                                                    //   all   elements   must   be   positive
    begin
        DecodeDate(FDate, AYear, AMonth, ADay);       //   get   current   date   elements
        case Index of
            1: AYear  := Value;
            2: AMonth := Value;
            3: ADay   := Value;
        else
            exit;
        end;
    end;
    FDate   :=   EncodeDate(AYear,   AMonth,   ADay);                   //   encode   the   modified   date
    //Refresh();                                                                         //   update   the   visible   calendar
    UpdateCalendar();                                                               //   this   previously   called   Refresh
    Change();                                                                               //   this   is   new
end;

procedure TSampleCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState);
var
    TheText: string;
    TempDay: integer;
    Checked: boolean;
    CheckRect: TRect;
const
    CheckBox : array[Boolean] of Integer = (DFCS_BUTTONCHECK,
    DFCS_BUTTONCHECK or DFCS_CHECKED);
begin
    if gdSelected in AState then
    begin
        Canvas.Brush.Color := SelectColor;
        Canvas.FillRect(ARect);
    end
    else
    begin
        if (ARow >= FixedRows) and (ACol >= FixedCols) then
        Canvas.Brush.Color := Color
        else
        Canvas.Brush.Color := FixedColor;   //
        Canvas.FillRect(ARect);
    end;

    if (ARow = 0) then
        TheText := ShortDayNames1[ACol + 1]
    else
    begin
        TheText := '';
        TempDay := DayNum(ACol, ARow);                                       //   DayNum   is   defined   later
        if (TempDay <> -1) then
        begin
            if TempDay <= 9 then
            TheText := ' ' + IntToStr(TempDay)   //日期右对齐,美观
            else
            TheText := IntToStr(TempDay);
        end;
    end;

    if (ARow >= FixedRows) and (ACol >= FixedCols) then
    begin
        CheckRect.Left := ARect.Left + (ARect.Right - ARect.Left - Canvas.TextWidth('11') - 18) div 2;
        CheckRect.Top  := ARect.Top + (ARect.Bottom - ARect.Top - Canvas.TextHeight(TheText)) div 2;
        CheckRect.Bottom := Arect.Bottom;
        CheckRect.Right := ARect.Right;

        DrawText(Canvas.Handle, pchar(TheText), Length(TheText), CheckRect, DT_LEFT);
    end
    else
    begin
        CheckRect := ARect;
        CheckRect.Top := ARect.Top + (ARect.Bottom - ARect.Top - Canvas.TextHeight(TheText)) div 2;
        DrawText(Canvas.Handle, pchar(TheText), Length(TheText), CheckRect, DT_CENTER);
    end;
        

    CheckRect.Top    := ARect.Top  + (ARect.Bottom - ARect.Top - 16) div 2;
    CheckRect.Bottom := CheckRect.Top  + 15;
    CheckRect.Left   := CheckRect.Left + Canvas.TextWidth('11') + 2;
    CheckRect.Right  := CheckRect.Left + 14;;

    if (ARow >= FixedRows) and (ACol >= FixedCols) then
    begin
        if TheText <> '' then
        begin
            Checked := FSelArray[StrToInt(TheText)];
            Canvas.FillRect(CheckRect);
            if Enabled then
            DrawFrameControl(Canvas.Handle, CheckRect, DFC_BUTTON, CheckBox[Checked])
            else
            DrawFrameControl(Canvas.Handle, CheckRect, DFC_BUTTON, CheckBox[Checked] or DFCS_INACTIVE);
        end;
    end;



end;

procedure TSampleCalendar.WMSize(var Msg: TWMSize);
var
    GridLines: integer;
begin
    GridLines        := 6 * GridLineWidth;                                     //   calculated   combined   size   of   all   lines
    DefaultColWidth  := (Msg.Width  - GridLines) div 7;         //   set   new   default   cell   width
    DefaultRowHeight := (Msg.Height - GridLines) div 7;     //   and   cell   height
    inherited;
end;

procedure TSampleCalendar.UpdateCalendar;
var
    AYear, AMonth, ADay: word;
    FirstDate: TDateTime;
begin
    if (FDate <> 0) then                                                     //   only   calculate   offset   if   date   is   valid
    begin
        DecodeDate(FDate, AYear,   AMonth,   ADay);     //   get   elements   of   date
        FirstDate    := EncodeDate(AYear,   AMonth,   1);       //   date   of   the   first
        FMonthOffset := 2 - DayOfWeek(FirstDate);     //   generate   the   offset   into   the   grid
        Row := (ADay - FMonthOffset) div 7 + 1;
        Col := (ADay - FMonthOffset) mod 7;
    end;
    Refresh();                                                                         //   always   repaint   the   control
end;

function TSampleCalendar.DayNum(ACol: integer; ARow: integer): integer;
begin
    Result := FMonthOffset + ACol + (ARow - 1) * 7;               //   calculate   day   for   this   cell

    if ((result < 1) or (result > MonthDays[IsLeapYear(Year)][Month])) then
    result := -1;       //   return   -1   if   invalid
end;

procedure TSampleCalendar.NextMonth;
var
    AYear, AMonth, ADay: word;
    i: integer;
begin
    DecodeDate(IncMonth(CalendarDate, 1), AYear, AMonth, ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.PrevMonth;
var
    AYear, AMonth, ADay: word;
    i: integer;
begin
    DecodeDate(IncMonth(CalendarDate, -1), AYear,   AMonth,   ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.NextYear;
var
    AYear, AMonth, ADay: word;
    i: integer;
begin
    DecodeDate(IncMonth(CalendarDate, 12), AYear,   AMonth,   ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.PrevYear;
var
    AYear, AMonth, ADay: word;
    i: integer;   
begin
    DecodeDate(IncMonth(CalendarDate,   -12),   AYear,   AMonth,   ADay);
    Year  := AYear;
    Month := AMonth;
    Day   := ADay;
    for i := 0 to 31 do
    FSelArray := false;
    Refresh();
end;

procedure TSampleCalendar.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self)
end;

function TSampleCalendar.SelectCell(ACol, ARow: Longint): Boolean;
begin
  if Enabled then
  if (DayNum(ACol,ARow) = -1)  then
  Result := false
  else
  Result := true;
//    Result := inherited(ACol, ARow);
end;
{
procedure TSampleCalendar.Click;
var
    TempDay: integer;
begin
    TempDay := DayNum(Col, Row);                         // get   the   day   number   for   the   clicked   cell
    if (TempDay <>  -1) then  Day := TempDay;            // change   day   if   valid
end;
}
procedure TSampleCalendar.KeyDown(var Key: Word; Shift: TShiftState);
var
    TempDay: integer;
begin
  inherited KeyDown(Key, Shift);
  if Key = VK_SPACE then
  begin
    TempDay := DayNum(Col, Row);
    if TempDay <> -1 then
    begin
        if Enabled then
        begin
            FSelArray[TempDay] := Not FSelArray[TempDay];
            Day := TempDay;
        end;
    end;
  end;
  Refresh();
end;

procedure TSampleCalendar.MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
var
    TempDay: integer;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    TempDay := DayNum(Col, Row);
    if TempDay <> -1 then
    begin
        if Enabled then
        begin
            FSelArray[TempDay] := Not FSelArray[TempDay];
            Day := TempDay;
        end;
    end;
  end;
  Refresh();
end;
{

procedure TSampleCalendar.MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
  try
    case FGridState of
      gsSelecting:
        begin
          Click;
        end;
    end;
    inherited MouseUp(Button, Shift, X, Y);
  finally
    FGridState := gsNormal;
  end;
end;
}

function TSampleCalendar.GetChecked(Index: integer): boolean;
begin
    Result := false;
    if (Index >= 1) and (Index <=31) then
    Result := FSelArray[Index];
end;

procedure TSampleCalendar.SetChecked(Index: integer; Value: boolean);
begin
    if (Index >= 1) and (Index <=31) then
    if FSelArray[Index] <> Value then
    begin
        FSelArray[Index] := Value;
    end;
end;

procedure TSampleCalendar.SetSelectColor(Value: TColor);
begin
  if FSelectColor <> Value then
  begin
    FSelectColor := Value;
    Refresh();
  end;
end;

procedure TSampleCalendar.CMEnabledChanged( var Msg: TMessage);
begin
  inherited;
  Refresh;
end;

end.

[ 本帖最后由 croslq 于 2007-12-13 15:09 编辑 ]

Image Attachment: Calendar.jpg (2007-12-13 15:09, 11.61 K) / Download count 433
http://bbs.cnpack.org/attachment.php?aid=366

---

Author: Passion    Time: 2007-12-17 11:57

Checked[Index: integer]:
这个Index的直观意义是什么？不太明了吧？

---

Author: kendling    Time: 2007-12-19 13:49

Index应该是指日期吧？

---

Author: croslq    Time: 2007-12-19 21:41

index 就是 1-31 日
如果哪个月只有29天,就用 只用29天的

[ 本帖最后由 croslq 于 2007-12-19 21:43 编辑 ]

---

Welcome to CnPack Forum (http://bbs.cnpack.org/)

Powered by Discuz! 5.0.0