2007-12-13 15:07
croslq
//继承自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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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[i] := 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.[/i][/i][/i][/i][/i][/i][/i][/i][/i][/i][/i][/i][/i][/i][/i]
[[i] 本帖最后由 croslq 于 2007-12-13 15:09 编辑 [/i]]