home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DOS/V Power Report 1996 August
/
VPR9608A.BIN
/
del20try
/
install
/
data.z
/
CALSAMP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-05-08
|
5KB
|
210 lines
unit CalSamp;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids;
type
TSampleCalendar = class(TCustomGrid)
private
FDate: TDateTime;
FMonthOffset: Integer;
FOnChange: TNotifyEvent;
function GetDateElement(Index: Integer): Integer;
procedure SetCalendarDate(Value: TDateTime);
procedure SetDateElement(Index: Integer; Value: Integer);
protected
procedure Change; dynamic;
procedure Click; override;
function DayNum(ACol, ARow: Integer): Integer;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
function SelectCell(ACol, ARow: Longint): Boolean; override;
procedure UpdateCalendar; virtual;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
public
constructor Create(AOwner: TComponent); override;
function DaysThisMonth: Integer;
function IsLeapYear: Boolean;
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;
published
property Align;
property BorderStyle;
property Color;
property Ctl3D;
property Font;
property GridLineWidth;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
end;
procedure Register;
implementation
uses StdCtrls;
constructor TSampleCalendar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ColCount := 7;
RowCount := 7;
FixedCols := 0;
FixedRows := 1;
ScrollBars := ssNone;
Options := Options - [goRangeSelect] + [goDrawFocusSelected];
FDate := Date;
UpdateCalendar;
end;
procedure TSampleCalendar.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TSampleCalendar.Click;
var
TempDay: Integer;
begin
inherited Click;
TempDay := DayNum(Col, Row);
if TempDay <> -1 then Day := TempDay;
end;
function TSampleCalendar.DayNum(ACol, ARow: Integer): Integer;
begin
Result := FMonthOffset + ACol + (ARow - 1) * 7;
if (Result < 1) or (Result > DaysThisMonth) then Result := -1;
end;
function TSampleCalendar.DaysThisMonth: Integer;
const
DaysPerMonth: array[1..12] of Integer =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
if FDate = 0 then Result := 0
else
begin
Result := DaysPerMonth[Month];
if (Month = 2) and IsLeapYear then Inc(Result);
end;
end;
procedure TSampleCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState);
var
TheText: string;
TempDay: Integer;
begin
if ARow = 0 then
TheText := ShortDayNames[ACol + 1]
else
begin
TheText := '';
TempDay := DayNum(ACol, ARow);
if TempDay <> -1 then TheText := IntToStr(TempDay);
end;
with ARect, Canvas do
TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
end;
function TSampleCalendar.GetDateElement(Index: Integer): Integer;
var
AYear, AMonth, ADay: Word;
begin
DecodeDate(FDate, AYear, AMonth, ADay);
case Index of
1: Result := AYear;
2: Result := AMonth;
3: Result := ADay;
else Result := -1;
end;
end;
function TSampleCalendar.IsLeapYear: Boolean;
begin
Result := (Year mod 4 = 0)
and ((Year mod 100 <> 0)
or (Year mod 400 = 0));
end;
function TSampleCalendar.SelectCell(ACol, ARow: Longint): Boolean;
begin
if DayNum(ACol, ARow) = -1 then Result := False
else Result := inherited SelectCell(ACol, ARow);
end;
procedure TSampleCalendar.SetCalendarDate(Value: TDateTime);
begin
FDate := Value;
UpdateCalendar;
Change;
end;
procedure TSampleCalendar.SetDateElement(Index: Integer; Value: Integer);
var
AYear, AMonth, ADay: Word;
begin
if Value > 0 then
begin
DecodeDate(FDate, AYear, AMonth, ADay);
case Index of
1: AYear := Value;
2: AMonth := Value;
3: ADay := Value;
else Exit;
end;
FDate := EncodeDate(AYear, AMonth, ADay);
UpdateCalendar;
Change;
end;
end;
procedure TSampleCalendar.UpdateCalendar;
var
AYear, AMonth, ADay: Word;
FirstDate: TDateTime;
begin
if FDate <> 0 then
begin
DecodeDate(FDate, AYear, AMonth, ADay);
FirstDate := EncodeDate(AYear, AMonth, 1);
FMonthOffset := 2 - DayOfWeek(FirstDate);
Row := (ADay - FMonthOffset) div 7 + 1;
Col := (ADay - FMonthOffset) mod 7;
end;
Refresh;
end;
procedure TSampleCalendar.WMSize(var Message: TWMSize);
var
GridLines: Integer;
begin
GridLines := 6 * GridLineWidth;
DefaultColWidth := (Message.Width - GridLines) div 7;
DefaultRowHeight := (Message.Height - GridLines) div 7;
end;
procedure Register;
begin
RegisterComponents('Samples', [TSampleCalendar]);
end;
end.