procedure Register;
implementation
const
CopyRightStr: PChar = 'TYearPlanner Component v2.71 (22/05/2002)'+#13+#13+
'By Jonathan Hosking'+#13+#13+'Compiled in '+
{$IFDEF VER80} 'Delphi 1.0' {$ENDIF}
{$IFDEF VER90} 'Delphi 2.0' {$ENDIF}
{$IFDEF VER100} 'Delphi 3.0' {$ENDIF}
{$IFDEF VER120} 'Delphi 4.0' {$ENDIF}
{$IFDEF VER130} 'Delphi 5.0' {$ENDIF}
{$IFDEF VER140} 'Delphi 6.0' {$ENDIF}
{$IFDEF VER93} 'C++Builder 1.0' {$ENDIF}
{$IFDEF VER110} 'C++Builder 3.0' {$ENDIF}
{$IFDEF VER125} 'C++Builder 4.0' {$ENDIF};
MonthDays: array[1..12] of Integer = (31,28,31,30,31,30,31,31,30,31,30,31);
var
CopyRightPtr: Pointer;
constructor TPrintOptions.Create(UpdateEvent : TNotifyEvent);
begin
inherited Create;
fPreserveAspect:= True;
fPrinterOrientation := poLandscape;
fPrintReductionSize := 100;
fPrinterLeftMargin := 0;
fPrinterTopMargin := 0;
fPrinterRightMargin := 0;
fPrinterBottomMargin := 0;
fPrintHeader := TPrintTitle.Create(nil);
fPrintFooter := TPrintTitle.Create(nil);
end;
destructor TPrintOptions.Destroy;
begin
fPrintFooter.Free;
fPrintHeader.Free;
inherited Destroy;
end;
procedure TPrintTitle.SetAlignment(Val: TAlignment);
begin
if fAlignment <> Val then
begin
fAlignment := Val;
UpdateControl;
end;
end;
procedure TPrintTitle.SetCaption(Val: String);
begin
if fCaption <> Val then
begin
fCaption := Val;
UpdateControl;
end;
end;
procedure TPrintTitle.SetFont(Val: TFont);
begin
if fFont <> Val then
begin
fFont.Assign(Val);
UpdateControl;
end;
end;
constructor TPrintTitle.Create(UpdateEvent: TNotifyEvent);
begin
inherited Create;
fFont := TFont.Create;
fCaption := '';
fAlignment := taLeftJustify;
end;
destructor TPrintTitle.Destroy;
begin
fFont.Free;
inherited Destroy;
end;
procedure TPrintTitle.UpdateControl;
begin
if Assigned(fOnChange) then fOnChange(Self);
end;
function TYearPlanner.FindFirstWeek(aYear: Word): TDateTime;
var
sDay, tDay: Integer;
sDate: TDateTime;
dateOk: Boolean;
begin
dateOk := False;
sDay := 1;
while not dateOk do
begin
sDate := EncodeDate(aYear, 1, sDay);
tDay := (DayOfWeek(sDate) + 5) mod 7;
if tDay = ord(fStartDayOfWeek) then dateOk := True;
inc(sDay);
end;
Result := sDate;
end;
function TYearPlanner.IsLeapYear(Year: Word): Boolean;
begin
Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;
procedure TYearPlanner.XYToCell(X,Y: Integer;var CellX,CellY: Integer);
begin
if X < Widths[0] then CellX := 0 else
begin
CellX := ((X - Widths[0]) div Widths[1]) + 1;
if CellX > 37 then CellX := 37;
end;
if Y < Heights[0] then CellY := 0 else
begin
CellY := ((Y - Heights[0]) div Heights[1]) + 1;
if CellY > 12 then CellY := 12;
end;
end;
procedure TYearPlanner.ProcessSelection;
var
sD, eD, sM, eM: Integer;
begin
sD := StDay;
sM := StMonth;
eD := EnDay;
eM := EnMonth;
if StDay = 0 then Inc(sD);
if StMonth = 0 then Inc(sM);
if (StDay > 7) then
while Cells[sD,sM] = '' do Dec(sD)
else
while Cells[sD,sM] = '' do Inc(sD);
fStartDate := EncodeDate(fYear, sM, StrToInt(Cells[sD,sM]));
if EnDay = 0 then Inc(eD);
if EnMonth = 0 then Inc(eM);
if (EnDay > 7) then
while Cells[eD,eM] = '' do Dec(eD)
else
while Cells[eD,eM] = '' do Inc(eD);
fEndDate := EncodeDate(fYear, eM, StrToInt(Cells[eD,eM]));
end;
procedure TYearPlanner.LoadFromFile(var fFile: File);
var
fLength, numRead, X, Y: Integer;
begin
for X := 1 to 12 do
for Y := 1 to 31 do
with CellData[X, Y] do
begin
BlockRead(fFile, fLength, SizeOf(fLength), numRead);
if fLength > 0 then
begin
{$IFDEF WIN32}
SetLength(CellHint, fLength);
{$ENDIF}
BlockRead(fFile, CellHint[1], fLength, numRead);
end;
BlockRead(fFile, CellColor, SizeOf(CellColor), numRead);
BlockRead(fFile, CellFont, SizeOf(CellFont), numRead);
BlockRead(fFile, CustomColor, SizeOf(CustomColor), numRead);
BlockRead(fFile, CustomFont, SizeOf(CustomFont), numRead);
BlockRead(fFile, CellDate, SizeOf(CellDate), numRead);
BlockRead(fFile, Selected, SizeOf(Selected), numRead);
{$IFDEF WIN32}
BlockRead(fFile, CellImage, SizeOf(CellImage), numRead);
{$ENDIF}
BlockRead(fFile, Tag, SizeOf(Tag), numRead);
end;
end;
procedure TYearPlanner.LoadFromStream(var fStream:{$IFDEF USEBLOB}TBlobStream{$ELSE}TStream{$ENDIF});
var
fLength, X, Y: Integer;
begin
for X := 1 to 12 do
for Y := 1 to 31 do
with fStream, CellData[X, Y] do
begin
ReadBuffer(fLength, SizeOf(fLength));
if fLength > 0 then
begin
{$IFDEF WIN32}
SetLength(CellHint, fLength);
{$ENDIF}
ReadBuffer(CellHint[1], fLength);
end;
ReadBuffer(CellColor, SizeOf(CellColor));
ReadBuffer(CellFont, SizeOf(CellFont));
ReadBuffer(CustomColor, SizeOf(CustomColor));
ReadBuffer(CustomFont, SizeOf(CustomFont));
ReadBuffer(CellDate, SizeOf(CellDate));
ReadBuffer(Selected, SizeOf(Selected));
{$IFDEF WIN32}
ReadBuffer(CellImage, SizeOf(CellImage));
{$ENDIF}
ReadBuffer(Tag, SizeOf(Tag));
end;
end;
procedure TYearPlanner.SaveToFile(var fFile: File);
var
fLength, numWritten, X, Y: Integer;
begin
for X := 1 to 12 do
for Y := 1 to 31 do
with CellData[X, Y] do
begin
fLength := Length(CellHint);
BlockWrite(fFile, fLength, SizeOf(fLength), numWritten);
if fLength > 0 then
BlockWrite(fFile, CellHint[1], fLength, numWritten);
BlockWrite(fFile, CellColor, SizeOf(CellColor), numWritten);
BlockWrite(fFile, CellFont, SizeOf(CellFont), numWritten);
BlockWrite(fFile, CustomColor, SizeOf(CustomColor), numWritten);
BlockWrite(fFile, CustomFont, SizeOf(CustomFont), numWritten);
BlockWrite(fFile, CellDate, SizeOf(CellDate), numWritten);
BlockWrite(fFile, Selected, SizeOf(Selected), numWritten);
{$IFDEF WIN32}
BlockWrite(fFile, CellImage, SizeOf(CellImage));
{$ENDIF}
BlockWrite(fFile, Tag, SizeOf(Tag), numWritten);
end;
end;
procedure TYearPlanner.SaveToStream(var fStream:{$IFDEF USEBLOB}TBlobStream{$ELSE}TStream{$ENDIF});
var
fLength, X, Y: Integer;
begin
for X := 1 to 12 do
for Y := 1 to 31 do
with fStream, CellData[X, Y] do
begin
fLength := Length(CellHint);
WriteBuffer(fLength, SizeOf(fLength));
if fLength > 0 then
WriteBuffer(CellHint[1], fLength);
WriteBuffer(CellColor, SizeOf(CellColor));
WriteBuffer(CellFont, SizeOf(CellFont));
WriteBuffer(CustomColor, SizeOf(CustomColor));
WriteBuffer(CustomFont, SizeOf(CustomFont));
WriteBuffer(CellDate, SizeOf(CellDate));
WriteBuffer(Selected, SizeOf(Selected));
{$IFDEF WIN32}
WriteBuffer(CellImage, SizeOf(CellImage));
{$ENDIF}
WriteBuffer(Tag, SizeOf(Tag));
end;
end;
procedure TYearPlanner.CalculateCalendar;
var
I,J: Byte;
DaysInMonth,StartDay: Integer;
begin
Cells[0, 0] := IntToStr(Self.Year);
for I := 1 to 37 do
for J := 1 to 12 do
Cells[I,J] := '';
for I := 1 to 12 do
begin
StartDay := DayOfWeek(EncodeDate(Year,I,1));
StartDay := (StartDay+7-Ord(fStartDayOfWeek)-2) mod 7;
DaysInMonth := MonthDays[i] + byte(IsLeapYear(Year) and (I = 2));
for J := 1 to DaysInMonth do Cells[J + StartDay,I] := IntToStr(J);
end;
end;
procedure TYearPlanner.CalculateData;
var
I,J: Byte;
DaysInMonth: Integer;
begin
for I := 1 to 12 do
begin
DaysInMonth := MonthDays[i] + byte(IsLeapYear(Year) and (I = 2));
for J := 1 to DaysInMonth do
begin
with CellData[I,J] do
begin
CellColor := $00000000;
CellFont := fDayFont;
CustomColor := False;
CustomFont := False;
CellDate := EncodeDate(Year,I,J);
CellHint := '';
{$IFDEF WIN32}
CellImage := -1;
{$ENDIF}
Tag := -1;
Selected := False;
end;
end;
end;
end;
procedure TYearPlanner.CalculateNavigators;
var
sWidth,sHeight,y: Integer;
begin
sWidth := GetSystemMetrics(SM_CXHSCROLL);
sHeight := GetSystemMetrics(SM_CYHSCROLL);
y := (Heights[0] - sHeight) div 2;
fYearNavLeft := Rect(0 + 1,y,1 + sWidth,y + sHeight);
fYearNavRight := Rect(Widths[0] - (sWidth + 1),y,Widths[0] - 1,y + sHeight);
end;
procedure TYearPlanner.CalculateSizes;
var
I: Byte;
begin
if fUseFreeSpace then
begin
Heights[0] := Height - ((Height div 13) * 12);
Widths[0] := Width - ((Width div 41) * 37);
end
else
begin
Heights[0] := (Height div 13);
Widths[0] := (Width div 41) * 4;
end;
for I := 1 to 37 do Widths[i] := (Width div 41);
for I := 1 to 12 do Heights[i] := (Height div 13);
CalculateNavigators;
end;
procedure TYearPlanner.CircleToday(Canvas: TCanvas; CircleRect: TRect; const TodayText: String; InnerColor: TColor);
begin
Canvas.Pen.Color := TodayCircleColour;
Canvas.Pen.Width := 2;
Canvas.Brush.Color := InnerColor;
with CircleRect do
Canvas.Ellipse(Left, Top, Right, Bottom);
Canvas.Font.Color := TodayTextColour;
{$IFDEF WIN32}
DrawText(Canvas.Handle, PChar(TodayText), -1, CircleRect, DT_VCENTER OR DT_CENTER OR DT_SINGLELINE);
{$ELSE}
DrawText(Canvas.Handle, @TodayText[1], -1, CircleRect, DT_VCENTER OR DT_CENTER OR DT_SINGLELINE);
{$ENDIF}
end;
procedure TYearPlanner.OnGridPenChange(Sender:TObject);
begin
Invalidate;
end;
procedure TYearPlanner.SetupHeadings;
var
I,J: Byte;
begin
for I := 1 to 37 do
begin
J := (((I - 1) + (Ord(fStartDayOfWeek))) mod 7) + 2;
if J = 8 then J := 1;
Cells[I,0] := ShortDayNames[J][1];
end;
for I := 1 to 12 do Cells[0,I] := LongMonthNames[i];
end;
procedure TYearPlanner.SetAllowSelections(Val: Boolean);
begin
if fAllowSelections <> Val then
begin
fAllowSelections := Val;
Invalidate;
end;
end;
procedure TYearPlanner.SetDayColor(Val: TColor);
begin
if fDayColor <> Val then
begin
fDayColor := Val;
Invalidate;
end;
end;
procedure TYearPlanner.SetDayFont(Val: TFont);
begin
if fDayFont <> Val then
begin
fDayFont.Assign(Val);
Invalidate;
end;
end;
{$IFDEF WIN32}
04-11-2013
Error al instalar un Componente "Year Plan"
Temas Similares
![Avatar de Neftali [Germán.Estévez]](image.php?u=3561&dateline=1185205509)
Modo Híbrido
