Error al instalar un Componente "Year Plan"

[feliz-58]

Código Delphi [-]
procedure TYearPlanner.SetEndEllipsis(Val: Boolean);
begin
  if fEndEllipsis <> Val then
  begin
    fEndEllipsis := Val;
    Invalidate;
  end;
end;
{$ENDIF}

procedure TYearPlanner.SetFlatCells(Val: Boolean);
begin
  if fFlatCells <> Val then
  begin
    fFlatCells := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetGridLines(Val: Boolean);
begin
  if fGridLines <> Val then
  begin
    fGridLines := Val;
    Invalidate;
  end;
end;

{ Thanks to Max Evans for this routine }
procedure TYearPlanner.SetGridPen(Val: TPen);
begin
  if fGridPen <> Val then
  begin
    fGridPen.Assign(Val);
    Invalidate;
  end;
end;

procedure TYearPlanner.SetHeadingColor(Val: TColor);
begin
  if fHeadingColor <> Val then
  begin
    fHeadingColor := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetHintColor(Val: TColor);
begin
  if fHintColor <> Val then
  begin
    fHintColor := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetHintDelay(Val: Integer);
begin
  if fHintDelay <> Val then
  begin
    fHintDelay := Val;
    if fHintDelay < 0 then fHintDelay := 0;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetHintFont(Val: TFont);
begin
  if fHintFont <> Val then
  begin
    fHintFont.Assign(Val);
    Invalidate;
  end;
end;

procedure TYearPlanner.SetLongHint(Val: Boolean);
begin
  if fLongHint <> Val then
  begin
    fLongHint := Val;
    Invalidate;
  end;
end;

{ Thanks to Max Evans for this routine }
{$IFDEF WIN32}
procedure TYearPlanner.SetMonthButtons(Val: Boolean);
begin
  if fMonthButtons <> Val then
  begin
    fMonthButtons := Val;
    Invalidate;
  end;
end;
{$ENDIF}

procedure TYearPlanner.SetMonthColor(Val: TColor);
begin
  if fMonthColor <> Val then
  begin
    fMonthColor := Val;
    Invalidate;
  end;
end;

{ Thanks to Max Evans for this routine }
procedure TYearPlanner.SetMonthFont(Val: TFont);
begin
  if fMonthFont <> Val then
  begin
    fMonthFont.Assign(Val);
    Invalidate;
  end;
end;

procedure TYearPlanner.SetNoDayColor(Val: TColor);
begin
  if fNoDayColor <> Val then
  begin
    fNoDayColor := Val;
    Invalidate;
  end;
end;

{ Thanks to Robert Gesswein contributing this procedure }
procedure TYearPlanner.SetNoDayPriority(Val: Boolean);
begin
  if fNoDayPriority <> Val then
  begin
    fNoDayPriority := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetSelectionColor(Val: TColor);
begin
  if fSelectionColor <> Val then
  begin
    fSelectionColor := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetSelectionFont(Val: TFont);
begin
  if fSelectionFont <> Val then
  begin
    fSelectionFont.Assign(Val);
    Invalidate;
  end;
end;

procedure TYearPlanner.SetSelectionStyle(Val: TypSelSty);
begin
  if fSelectionStyle <> Val then
  begin
    fSelectionStyle := Val;
    Invalidate;
  end;
end;

{$IFDEF WIN32}
procedure TYearPlanner.SetSeperator(Val: Boolean);
begin
  if fSeperator <> Val then
  begin
    fSeperator := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetSoftBorder(Val: Boolean);
begin
  if fSoftBorder <> Val then
  begin
    fSoftBorder := Val;
    Invalidate;
  end;
end;
{$ENDIF}

procedure TYearPlanner.SetShowDefaultHint(Val: Boolean);
begin
  if fShowDefaultHint <> Val then
  begin
    fShowDefaultHint := Val;
    Invalidate;
  end;
end;

{ Thanks to Max Evans for this routine }
procedure TYearPlanner.SetShowToday(Val: Boolean);
begin
  if fShowToday <> Val then
  begin
    fShowToday := Val;
    Invalidate;
  end;
end;

{ Thanks to Robert Gesswein for contributing this procedure }
procedure TYearPlanner.SetStartDayOfWeek(Val: TypDOW);
begin
  if fStartDayOfWeek <> Val then
  begin
    fStartDayOfWeek := Val;
    SetupHeadings;
    CalculateCalendar;
    CalculateData;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetStretchImages(Val: Boolean);
begin
  if fStretchImages <> Val then
  begin
    fStretchImages := Val;
    Invalidate;
  end;
end;

{ Thanks to Max Evans for this routine }
procedure TYearPlanner.SetTodayCircleColour(Val: TColor);
begin
  if fTodayCircleColour <> Val then
  begin
    fTodayCircleColour := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetTodayCircleFilled(Val: Boolean);
begin
  if fTodayCircleFilled <> Val then
  begin
    fTodayCircleFilled := Val;
    Invalidate;
  end;
end;

{ Thanks to Max Evans for this routine }
procedure TYearPlanner.SetTodayTextColour(Val: TColor);
begin
  if fTodayTextColour <> Val then
  begin
    fTodayTextColour := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetUseFreeSpace(Val: Boolean);
begin
  if fUseFreeSpace <> Val then
  begin
    fUseFreeSpace := Val;
    CalculateSizes;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetWeekendColor(Val: TColor);
begin
  if fWeekendColor <> Val then
  begin
    fWeekendColor := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetWeekendHeadingColor(Val: TColor);
begin
  if fWeekendHeadingColor <> Val then
  begin
    fWeekendHeadingColor := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.SetYear(Val: Word);
begin
  if fYear <> Val then
  begin
    { Handle the OnYearChange event, if there is one }
    if Assigned(fOnYearChange) then fOnYearChange(Self);
    { Change the year }
    fYear := Val;
    { Setup the calender }
    CalculateCalendar;
    CalculateData;
    { Clear the selection }
    ClearSelection;
    { Handle the OnYearChanged event, if there is one }
    if Assigned(fOnYearChanged) then fOnYearChanged(Self);
    { Update the control }
    Invalidate;
  end;
end;

{ Thanks to Max Evans for this routine }

[feliz-58]

Código Delphi [-]
procedure TYearPlanner.SetYearColor(Val: TColor);
begin
  if fYearColor <> Val then
  begin
    fYearColor:= Val;
    Invalidate;
  end;
end;

{ Thanks to Max Evans for this routine }
procedure TYearPlanner.SetYearFont(Val: TFont);
begin
  if fYearFont <> Val then
  begin
    fYearFont.Assign(Val);
    Invalidate;
  end;
end;

procedure TYearPlanner.SetYearNavigators(Val: Boolean);
begin
  if fYearNavigators <> Val then
  begin
    fYearNavigators := Val;
    Invalidate;
  end;
end;

procedure TYearPlanner.ShowAbout(Val: TYearPlanAbout);
begin
  if fAbout <> Val then
  begin
    if Val = abNone then fAbout := Val else
    begin
      fAbout := abNone;
      MessageDlg(StrPas(CopyRightStr), mtInformation, [mbOk], 0);
    end;
    Invalidate;
  end;
end;

procedure TYearPlanner.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

{ Thanks to Kaj Ekman, Max Evans, Paul Fisher, Rob Schoenaker and Roberto
  Chieregato for improving this routine }
procedure TYearPlanner.Paint;
var
  I,J: Byte;
  T,tH,tW,X,Y: Integer;
  fBorderRect, fCellRect, fSepRect, GridCellRect: TRect;
  fTodayDay, fTodayMonth, fTodayYear: Word;
  GridCol, OldColor: TColor;
  CurrWidth, CurrHeight : Integer;
  CellText: string;
  CellTextLen: Integer;
  TheCanvas: TCanvas;
  DrawDC: HDC;
  SizeRec: tSize;
  {$IFDEF WIN32}
  nXStart, nYStart, tXStart, tYStart: Integer;
  BitmapRect, TempDRect, TempSRect: TRect;
  ImageH, ImageIndex, ImageW: Integer;
  ImageBmp: TPicture;
  {$ELSE}
  bmpNavigator: TBitmap;
  {$ENDIF}

{ This function determines if a cell is selected - Thanks to Roberto Chieregato
  for improving it }
function CellSelected: Boolean;
var
  crDate: TDateTime;
begin
  { By default we assume that the cell is not selected }
  Result := False;
  { We cannot select cells if selections are not allowed }
  if not fAllowSelections then Exit;
  { Is the cell selected ? }
  if SelectionStyle = ypNormal then
  begin
    { With normal selections we check the date range }
    crDate := EncodeDate(Year,J,StrToInt(Cells[I,J]));
    if (crDate >= fStartDate) and (crDate <= fEndDate) then Result := True;
  end
  else
    { With rectangular selections we check the selection coordinates }
    if (I >= StDay) and (I <= EnDay) and (J >= StMonth) and (J <= EnMonth)
      then Result := True;
end;

{ This function determines the font to use for a day cell }
function CellFont: TFont;
var
  Dy,Mn: Byte;
begin
  Result := fDayFont;
  if Cells[I,J] = '' then Exit;
  { It's a calender day, so check for a custom font }
  Dy := StrToInt(Cells[I,J]);
  Mn := J;
  if CellData[Mn,Dy].CustomFont then
  begin
    Result := CellData[Mn,Dy].CellFont;
    Exit;
  end;
  { Check for a selection font }
  if CellSelected then Result := fSelectionFont;
end;

{ This procedure works out the color of a cell - Thanks to Christian Hackbart,
  Max Evans, Paolo Prandini and Robert Gesswein for improving it }
function GridColor: TColor;
var
  Dy,Mn: Byte;
begin
  if I = 0 then
  begin
    if J = 0 then Result:= fYearColor else
      Result := fMonthColor;
    Exit;
  end;
  if (J > 0) and (J < 13) then
    if (Cells[I,J] <> '') then
    begin
      { It's a calender day, so check for a color }
      Dy := StrToInt(Cells[I,J]);
      Mn := J;
      CellData[Mn,Dy].Selected := CellSelected;
      if CellData[Mn,Dy].Selected then
      begin
        { It's a selected cell }
        Result := fSelectionColor;
        Exit;
      end;
      if CellData[Mn,Dy].CustomColor then
      begin
        { Use the custom color }
        Result := CellData[Mn,Dy].CellColor;
        CellData[Mn,Dy].Selected := False;
        Exit;
      end;
    end;
  if J = 13 then Result := fNoDayColor else
  begin
    if (((I+Ord(fStartDayOfWeek) in [0,6,7,13,14,20,21,27,28,34,35,41,42]) or (J = 0))
      and ((not fNoDayPriority) or (Cells[I,J] <> ''))) then
    begin
      { Weekend day or heading }
      Result := fWeekendColor;
      if J = 0 then
        if (I+Ord(fStartDayOfWeek) in [6,7,13,14,20,21,27,28,34,35,41,42]) then
          Result := fWeekendHeadingColor else
            Result := fHeadingColor;
    end
    else
    begin
      { Normal day }
      if Cells[I,J] = '' then Result := fNoDayColor
        else Result := fDayColor;
    end;
  end;
end;

{ Thanks to Roberto Chieregato for this new routine }
{$IFDEF WIN32}
function GridImage: Integer;
var
  Dy,Mn: Byte;
begin
  Result := -1;
  if (Images <> nil) and (J > 0) and (J < 13) and (I > 0) then
    if (Cells[I,J] <> '') then
    begin
      Dy := StrToInt(Cells[I,J]);
      Mn := J;
      Result := CellData[Mn,Dy].CellImage;
    end;
end;
{$ENDIF}

{ Thanks to Max Evans, Paolo Prandini and Rob Schoenaker for helping with
  this routine }
procedure DrawGridLines;
var
  L: Integer;
  LineHeight: Integer;
begin
  with TheCanvas do
  begin
    { Draw the grid }
    Pen.Assign(fGridPen);
    DrawDC := TheCanvas.Handle;
    X := Widths[0] - 1;
    Y := Heights[0] - 1;
    LineHeight := Heights[1] shl 2 + Heights[1] shl 3 + 1;
    for L := 1 to 38 do
    begin
      {$IFDEF WIN32}
      Windows.MoveToEx(DrawDC, X, Y, nil);
      Windows.LineTo(DrawDC, X, Y + LineHeight);
      {$ELSE}
      WinProcs.MoveToEx(DrawDC, X, Y, nil);
      WinProcs.LineTo(DrawDC, X, Y + LineHeight);
      {$ENDIF}
      if L < 38 then
        Inc(X, Widths[L]);
    end;
    for L := 1 to 13 do
    begin
      {$IFDEF WIN32}
      Windows.MoveToEx(DrawDC, Widths[0], Y, nil);
      Windows.LineTo(DrawDC, X, Y);
      {$ELSE}
      WinProcs.MoveToEx(DrawDC, Widths[0], Y, nil);
      WinProcs.LineTo(DrawDC, X, Y);
      {$ENDIF}
      if L < 13 then Inc(Y, Heights[L]);
    end;
  end;
end;

begin
  { Setup the offscreen bitmap }
  CalculateSizes;
  if (fUseBitmap) and not (csDesigning in ComponentState) then
  begin
    fControl.Width := Width;
    fControl.Height := Height;
    TheCanvas := fControl.Canvas;
  end
  else
    TheCanvas := Canvas;
  { Get today's date }
  DecodeDate(Date, fTodayYear, fTodayMonth, fTodayDay);
  with TheCanvas do
  begin
    { Draw the calender cells and text }
    Brush.Style := bsSolid;
    Font := Self.Font;
    DrawDC := TheCanvas.Handle;
    SetBKMode(DrawDC, TRANSPARENT);
    X := 0;
    for I := 0 to 37 do
    begin
      J := 0;
      Y := 0;
      CurrWidth := Widths[i];
      OldColor := GridColor;
      repeat
        T := Y;
        repeat
          Inc(Y,Heights[J]);
          Inc(J);
          GridCol := GridColor;
        until (GridCol <> OldColor) or (J = 13);
        GridCellRect := Rect(X, T, X + CurrWidth, Y);
        Brush.Color := OldColor;
        OldColor := GridCol;
        {$IFDEF WIN32}
        Windows.FillRect(DrawDC, GridCellRect, Brush.Handle);
        {$ELSE}
        WinProcs.FillRect(DrawDC, GridCellRect, Brush.Handle);
        {$ENDIF}
      until
        J = 13;
      Y := 0;
      for J := 0 to 12 do
      begin
        CurrHeight := Heights[J];
        GridCellRect := Rect(X,Y + 1,X + CurrWidth - 1,Y + CurrHeight - 1);
        if (I = 0) or (J = 0) then
        {$IFDEF WIN32}
        fSepRect:= GridCellRect;
        InFlateRect(fSepRect,-10,0);
        if fSeperator then DrawEdge(DrawDC, fSepRect, EDGE_RAISED, BF_BOTTOM);
        { Draw the month buttons and flat cells }
        if (fMonthButtons) and (I = 0) and (J > 0) then
          DrawEdge(DrawDC, GridCellRect, EDGE_RAISED, BF_RECT OR BF_SOFT)
        else
          if not fFlatCells then
            DrawEdge(DrawDC, GridCellRect, BDR_RAISEDINNER, BF_RECT);
        {$ELSE}
        if not fFlatCells then
          Frame3D(TheCanvas,GridCellRect,clBtnHighlight,clBtnShadow,1);
        {$ENDIF}
        {$IFDEF WIN32}
        { Draw the cell images }
        ImageIndex := GridImage;
        If ImageIndex > -1 then
        begin
          ImageBmp := TPicture.Create;
          { Do we want to draw a stretched image ? }
          if fStretchImages then
          begin
            { Stretch the image to fill the cell }
            BitmapRect := Rect(X, Y, X + CurrWidth, Y + CurrHeight);
            Images.GetBitmap(ImageIndex, ImageBmp.Bitmap);
            TheCanvas.StretchDraw(BitmapRect, ImageBmp.Bitmap);
          end
          else
          begin
            { Center the image in the cell }
            Images.GetBitmap(ImageIndex, ImageBmp.Bitmap);
            ImageW := ImageBmp.Bitmap.Width;
            ImageH := ImageBmp.Bitmap.Height;
            { Crop the image so that it is not drawn over other cells }
            if ImageBmp.Width > CurrWidth then
            begin
              { Crop the image width }
              tXStart := (ImageW - CurrWidth) div 2;
              TempSRect := Rect(tXStart, 0, tXStart + CurrWidth, ImageH);
              TempDRect := Rect(0, 0, CurrWidth, ImageH);
              with ImageBmp.Bitmap do Canvas.CopyRect(TempDRect,Canvas,TempSRect);
              ImageBmp.Bitmap.Width := CurrWidth;
              ImageW := ImageBmp.Bitmap.Width;
            end;
            if ImageBmp.Height > CurrHeight then
            begin
              { Crop the image height }
              tYStart := (ImageH - CurrHeight) div 2;
              TempSRect := Rect(0, tYStart, CurrWidth, tYStart + CurrHeight);
              TempDRect := Rect(0, 0, ImageW, CurrHeight);
              with ImageBmp.Bitmap do Canvas.CopyRect(TempDRect,Canvas,TempSRect);
              ImageBmp.Bitmap.Height := CurrHeight;
              ImageH := ImageBmp.Bitmap.Height;
            end;
            { Work out the top left coordinates of the image }
            nXStart := (X + (CurrWidth div 2)) - (ImageW div 2);
            nYStart := (Y + (CurrHeight div 2)) - (ImageH div 2);
            { Draw the image }
            TheCanvas.Draw(nXStart, nYStart, ImageBmp.Bitmap);
          end;
          ImageBmp.Free;
        end
        else
        begin
          {$ENDIF}
          CellText := Cells[I,J];
          CellTextLen := Length(CellText);
          { Select the font to use }
          if CellTextLen <> 0 then
          begin
            if I = 0 then
            begin
              { Month Cell }
              Font := fMonthFont;
              DrawDC := TheCanvas.Handle;
              SetBKMode(DrawDC, TRANSPARENT);
            end;
            if J = 0 then
            begin
              { Day Cell }
              Font := fDayFont;
              DrawDC := TheCanvas.Handle;
              SetBKMode(DrawDC, TRANSPARENT);
            end;
            if (J = 0) and (I = 0) then
            begin
              { Year Cell }
              Font := fYearFont;
              DrawDC := TheCanvas.Handle;
              SetBKMode(DrawDC, TRANSPARENT);
              if fYearNavigators then
              begin
                { Draw the year navigation buttons }
                CalculateNavigators;
                {$IFDEF WIN32}
                if fMonthButtons then
                begin
                  DrawFrameControl(DrawDC, fYearNavLeft, DFC_SCROLL, DFCS_SCROLLLEFT);
                  DrawFrameControl(DrawDC, fYearNavRight, DFC_SCROLL, DFCS_SCROLLRIGHT);
                end
                else
                begin
                  DrawFrameControl(DrawDC, fYearNavLeft, DFC_SCROLL, DFCS_SCROLLLEFT or DFCS_FLAT);
                  DrawFrameControl(DrawDC, fYearNavRight, DFC_SCROLL, DFCS_SCROLLRIGHT or DFCS_FLAT);
                end;
                {$ELSE}
                bmpNavigator := TBitmap.Create;
                try
                  bmpNavigator.Handle := LoadBitmap(0,pchar(obm_LfArrow));
                  BitBlt(DrawDC,fYearNavLeft.Left,fYearNavLeft.Top,fYearNavLeft.Right - fYearNavLeft.Left,
                    fYearNavLeft.Bottom - fYearNavLeft.Top, bmpNavigator.Canvas.Handle,0,0,SrcCopy);
                  bmpNavigator.ReleaseHandle;
                  bmpNavigator.Handle := LoadBitmap(0,pchar(obm_RGArrow));
                  BitBlt(DrawDC,fYearNavRight.Left,fYearNavRight.Top,fYearNavRight.Right - fYearNavRight.Left,
                    fYearNavRight.Bottom - fYearNavRight.Top, bmpNavigator.Canvas.Handle,0,0,SrcCopy)
                finally
                  bmpNavigator.Free;
                end;
                {$ENDIF}
              end;
            end;
            if (J > 0) and (I > 0) then
            begin
              { Normal Cells }
              Font := CellFont;
              DrawDC := TheCanvas.Handle;
              SetBKMode(DrawDC, TRANSPARENT);
            end;
            { Draw the text in the center of the cell }
            {$IFNDEF WIN32}
            GetTextExtentPoint(DrawDC, @CellText[1], CellTextLen, SizeRec);
            {$ELSE}
            GetTextExtentPoint32(DrawDC, PChar(CellText), CellTextLen, SizeRec);
            {$ENDIF}
            tW := (CurrWidth - SizeRec.cx) shr 1;
            tH := (CurrHeight - SizeRec.cy) shr 1;
            {$IFDEF WIN32}
            if fEndEllipsis then
            begin
              fCellRect := Rect(X + tW,Y + tH, (X + tW) + CurrWidth,(Y + tH) + CurrHeight);
              DrawText(DrawDC,PChar(@CellText[1]),-1,fCellRect,DT_VCENTER OR DT_CENTER OR DT_END_ELLIPSIS);
            end
            else
              Windows.TextOut(DrawDC, X + tW, Y + tH, PChar(CellText), CellTextLen);
            {$ELSE}
              WinProcs.TextOut(DrawDC, X + tW, Y + tH, @CellText[1], CellTextLen);
            {$ENDIF}
            if (fShowToday) and (Cells[I, J] = IntToStr(fTodayDay)) and
              (J = fTodayMonth) and (fYear = fTodayYear) then
            begin
              if fTodayCircleFilled then
                CircleToday(TheCanvas, GridCellRect, IntToStr(fTodayDay), fTodayCircleColour)
              else
                CircleToday(TheCanvas, GridCellRect, IntToStr(fTodayDay), GridColor);
            end;
          end;
        {$IFDEF WIN32}
        end;
        {$ENDIF}
        Inc(Y,CurrHeight);
      end;
      Inc(X,CurrWidth);
    end;
    if fGridlines then DrawGridLines;
    {$IFDEF WIN32}
    if fSoftBorder then
    begin
      SetBKMode(DrawDC, OPAQUE);
      fBorderRect:= Rect(0,0,Width,Height);
      DrawEdge(DrawDC,fBorderRect,EDGE_ETCHED,BF_RECT);
    end;
    {$ENDIF}
  end;
  { Now copy the bitmap to the screen }
  if fUseBitmap then
    BitBlt(Canvas.Handle, 0, 0, Width, Height, DrawDC, 0, 0, SRCCOPY);
  { If we are printing, copy the canvas and stretch it to the page }
  if hPrinting then
    StretchBlt(Printer.Canvas.Handle, PrinterLeftMargin, PrinterTopMargin,
      PrinterPageWidth, PrinterPageHeight, Canvas.Handle, 0, 0,
      Width, Height, SRCCOPY);
end;

[feliz-58]

Código Delphi [-]
{ Thanks to Max Evans for improving this routine }
constructor TYearPlanner.Create(AOwner: TComponent);
var
  Dy,Mn,Yr: Word;
begin
  { Setup the control }
  Inherited Create(AOwner);
  HintWin := THintWindow.Create(Self);
  fStringList := TStringList.Create;
  fPrintOptions := TPrintOptions.Create(nil);
  CopyRightPtr := @CopyRightStr;
  Width := 615;
  Height := 300;
  Color := clGray;
  DecodeDate(Date, Yr, Mn, Dy);
  fAbout := abNone;
  fAllowSelections := True;
  fDayColor := clWhite;
  {$IFDEF WIN32}
  fEndEllipsis := False;
  {$ENDIF}
  fFlatCells := True;
  fGridLines := True;
  fHeadingColor := clGray;
  fHintColor := clYellow;
  fHintDelay := 0;
  fLongHint := True;
  fMonthColor := clGray;
  {$IFDEF WIN32}
  fMonthButtons := False;
  {$ENDIF}
  fNoDayColor := clSilver;
  fNoDayPriority := False;
  fSelectionColor := clBlue;
  fSelectionStyle := ypNormal;
  {$IFDEF WIN32}
  fSeperator := True;
  fSoftBorder := False;
  {$ENDIF}
  fShowDefaultHint := True;
  fStartDayOfWeek := ypMonday;
  fStretchImages := False;
  fTodayCircleColour := clMaroon;
  fTodayCircleFilled := False;
  fTodayTextColour:= clWhite;
  fUseBitmap := True;
  fUseFreeSpace := True;
  fWeekendColor := clGray;
  fWeekendHeadingColor := clSilver;
  fYear := Yr;
  fYearColor:= clGray;
  {$IFDEF WIN32}
  fYearNavigators := True;
  {$ENDIF}
  fStartDate := Now;
  fEndDate := Now;
  hUpdating := False;
  hWaiting := False;
  hWaitingToDestroy := False;
  CurrentDate.Day := 0;
  CurrentDate.Month := 0;
  OldX := -1;
  OldY := -1;
  hPrinting := False;
  hSelecting := ypNotSelecting;
  { Create the off screen bitmap }
  fControl := TBitmap.Create;
  { Create the fonts }
  fDayFont := TFont.Create;
  fHintFont := TFont.Create;
  fMonthFont := TFont.Create;
  fSelectionFont := TFont.Create;
  fYearFont := TFont.Create;
  fGridPen := TPen.Create;
  fGridPen.OnChange:= OnGridPenChange;
  { Setup the calender }
  SetupHeadings;
  CalculateCalendar;
  CalculateData;
  CalculateSizes;
end;

{ Thanks to Max Evans for improving this routine }
destructor TYearPlanner.Destroy;
begin
  { Kill the control }
  fPrintOptions.Free;
  fStringList.Free;
  { Inform the hint window that the control is destroying }
  hWaitingToDestroy := True;
  { If a hint is being displayed, we release the hint window }
  if hUpdating then HintWin.ReleaseHandle;
  { Free the hint window }
  HintWin.Free;
  { Free used bitmap }
  fControl.Free;
  { Free the fonts }
  fGridPen.OnChange:= nil;
  fGridPen.Free;
  fYearFont.Free;
  fSelectionFont.Free;
  fMonthFont.Free;
  fHintFont.Free;
  fDayFont.Free;
  { Here the control is destroyed.  If a hint was being displayed, the hint
    procedure will safely exit by picking up the csDestroying flag in the
    ComponentState property }
  Inherited Destroy;
end;

procedure TYearPlanner.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  { If a selection has been made, and a double click procedure has been set,
    execute it }
  if (hSelecting = ypSelected) and (Assigned(fOnYearDblClick)) then
    fOnYearDblClick(StDay,EnDay,EnMonth,StMonth,fStartDate,fEndDate);
end;

{ Thanks to Martin Roberts, Max Evans, Paul Fisher and Wolf Garber for
  helping with this routine }
procedure TYearPlanner.WMLButtonDown(var Message: TWMLButtonDown);
var
  Pt,Temp: TPoint;
  tX,tY: Integer;
  fOnClick: TNotifyEvent;
begin
  Inherited;
  if fYearNavigators then
  begin
    { Check the navigation buttons }
    GetCursorPos(Pt);
    Pt := ScreenToClient(Pt);
    if PtInRect(fYearNavLeft,Pt) then
    begin
      { User clicked the previous year button }
      Year := Year - 1;
      Invalidate;
      Exit;
    end;
    if PtInRect(fYearNavRight,Pt) then
    begin
      { User clicked the next year button }
      Year := Year + 1;
      Invalidate;
      Exit;
    end;
  end;
  { Check to see if the mouse is over a cell }
  Temp := ClientToScreen(Point(Message.XPos,Message.YPos));
  if not (FindDragTarget(Temp, True) = Self) then Exit;
  XYToCell(Message.XPos,Message.YPos,tX,tY);
  { If we are selecting in date range style, we must select a cell with a date }
  if ((tx = 0) or (ty = 0) or (cells[tx,ty] = '')) and (fSelectionStyle = ypNormal) then
  begin
    ClearSelection;
    Exit;
  end;
  { If the user has assigned an OnClick event, we cannot use selections }
  fOnClick := OnClick;
  if not Assigned(fOnClick) then hSelecting := ypSelecting;
  { Set the initial and start coordinates }
  InDay := tX;
  InMonth := tY;
  StDay := InDay;
  StMonth := InMonth;
  EnDay := InDay;
  EnMonth := InMonth;
  { Set the date range, if we are using date range selection style }
  if fSelectionStyle = ypNormal then
  begin
    fStartDate := EncodeDate(fYear, ty, StrToInt(Cells[tx,ty]));
    fEndDate := fStartDate;
  end;
  { Update the control }
  Invalidate;
end;

{ Thanks to Paul Fisher, Goldschmidt Jean-Jacques and Istvan Mesaros for
  helping with this routine }
procedure TYearPlanner.WMLButtonUp(var Message: TWMLButtonUp);
var
  CountX,CountY: Integer;
begin
  { We cannot allow the user to select a range of cells which do not
    contain dates }
  hSelecting := ypNotSelecting;
  for CountX := StDay to EnDay do
    for CountY := StMonth to EnMonth do
      if Cells[CountX,CountY] <> '' then
        hSelecting := ypSelected;
  { Process the selection coordinates }
  ProcessSelection;
  { Update the start and end date variables }
  StartDate := fStartDate;
  EndDate := fEndDate;
  { Handle an OnSelectionEnd event if one exists }
  if Assigned(fOnSelectionEnd) then fOnSelectionEnd(Self);
  Inherited;
end;

{ Thanks to Paul Fisher for helping with this routine }
procedure TYearPlanner.WMRButtonDown(var Message: TWMRButtonDown);
begin
  Inherited;
  { If a selection has been made, and a right click procedure has been set,
    execute it }
  if (hSelecting = ypSelected) and (Assigned(fOnYearRightClick)) then
    fOnYearRightClick(StDay,EnDay,EnMonth,StMonth,fStartDate, fEndDate);
end;

procedure TYearPlanner.WMMouseMove(var Message: TWMMouseMove);
var
  Temp: TPoint;
  HintText, TmpHint, TmpText: String;
  HintRect: TRect;
  HDelay : {$IFDEF WIN32}Cardinal{$ELSE}LongInt{$ENDIF};
  HintH, HintLines, HintSH, HintW: Integer;
  Dy,Mn: Byte;
  swapTmp:integer;
begin
  { If the control is destroying we cannot continue }
  if hWaitingToDestroy then Exit;
  Inherited;
  { Check to see if the mouse is over a cell }
  Temp := ClientToScreen(Point(Message.XPos,Message.YPos));
  if not (FindDragTarget(Temp, True) = Self) then Exit;
  XYToCell(Message.XPos,Message.YPos,cX,cY);
  { We do not use hints when selecting cells }
  if hSelecting = ypSelecting then
  begin
    { Update the selection coordinates }
    StDay := InDay;
    StMonth := InMonth;
    EnDay := cX;
    EnMonth := cY;
    { Do we need to change the selection coordinates ? }
    if fSelectionStyle = ypNormal then
    begin
      if (StMonth > EnMonth) or ((StMonth = EnMonth) and (StDay > EnDay)) then
      begin
        { With normal selections we reverse the date range }
        swapTmp := StDay;
        StDay := EnDay;
        EnDay := swapTmp;
        swapTmp := StMonth;
        StMonth := EnMonth;
        EnMonth := swapTmp;
      end;
    end
    else
    begin
      { With rectangular selections, we simply switch the coordinates }
      if StDay > EnDay then
      begin
        swapTmp := StDay;
        StDay := EnDay;
        EnDay := swapTmp;
      end;
      if StMonth > EnMonth then
      begin
        swapTmp := StMonth;
        StMonth := EnMonth;
        EnMonth := swapTmp;
      end;
    end;
    { Process the selection coordinates }
    ProcessSelection;
    { Repaint the control }
    Invalidate;
    Exit;
  end;
  { Is this cell a calender day? }
  if ((OldX = cX) and (OldY = cY)) or (cX = 0) or (cY = 0) or
    (Cells[cX,cY] = '') then Exit;
  { Update the current date }
  CurrentDate.Day := StrToInt(Cells[cX,cY]);
  CurrentDate.Month := cY;
  { Now check to see if we can use hints }
  if not (Application.ShowHint and (ShowHint or ParentShowHint)) then Exit;
  { Do we show this hint? }
  if (CellData[cY,CurrentDate.Day].CellHint = '') and (not fShowDefaultHint) then Exit;
  { If a hint is being displayed, we mark a hint status flag to say that
    another hint is waiting }
  if hUpdating then
  begin
    hWaiting := True;
    Exit;
  end;
  { Now we setup the hint }
  OldX := cX;
  OldY := cY;
  Dy := CurrentDate.Day;
  Mn := CurrentDate.Month;
  HintText := CellData[Mn,Dy].CellHint;
  if HintText = '' then
  begin
    { Now we determine whether we display a long or short date }
    if fLongHint then
      HintText := FormatDateTime(LongDateFormat, EncodeDate(Year, Mn, Dy))
    else
      HintText := FormatDateTime(ShortDateFormat, EncodeDate(Year, Mn, Dy));
  end;
  HintDate := CellData[Mn,Dy].CellDate;
  { Set the hint status flags }
  hUpdating := True;
  hWaiting := False;
  { Set the hint width }
  TmpHint := HintText;
  if TmpHint[length(TmpHint)] <> #13 then
    TmpHint := TmpHint + #13;
  HintLines := 0;
  HintW := 0;
  repeat
    Inc(HintLines);
    TmpText := Copy(TmpHint,1,Pos(#13,TmpHint)-1);
    if HintWin.Canvas.TextWidth(TmpText) + 5 > HintW then
      HintW := HintWin.Canvas.TextWidth(TmpText) + 5;
    Delete(TmpHint,1,Pos(#13,TmpHint));
  until Pos(#13,TmpHint) = 0;
  { Set the hint height }
  HintH := (HintWin.Canvas.TextHeight('0') * HintLines) + 3;
  HintSH := HintWin.Canvas.TextHeight('0') + 3;
  { Set the delay length }
  if fHintDelay = 0 then HDelay := Application.HintPause else
    HDelay := fHintDelay;
  { Display the hint }
  HintRect := Rect(Temp.X, Temp.Y + HintSH, Temp.X + HintW, Temp.Y + HintH + HintSH);
  HintWin.Color := fHintColor;
  HintWin.Canvas.Font.Assign(fHintFont);
  HintWin.ActivateHint(HintRect, HintText);
  { Display the hint window for some time }
  FirstTickCount := GetTickCount;
  repeat
    { If another hint is waiting, get rid of this hint }
    Application.ProcessMessages;
    { If the control has been destroyed, this code will safely exit the
      procedure without causing an access violation }
    if csDestroying in ComponentState then Exit;
    { If the parent control has been hidden or the application has terminated
      the hint shouldn't be shown }
    if (not Parent.Showing) or (Application.Terminated) then Break;
    { Otherwise, we deal with the hint in the normal way }
    if (hSelecting = ypSelecting) or (hWaiting) or (hWaitingToDestroy) then Break;
  until (GetTickCount - FirstTickCount > HDelay);
  { Destroy the hint window }
  HintWin.ReleaseHandle;
  hUpdating := False;
end;

{ Thanks to Max Evans for this routine }
procedure TYearPlanner.WMSize(var Message:TWMSize);
begin
  CalculateNavigators;
end;

{ Thanks to Robert Gesswein for helping with this procedure }
procedure TYearPlanner.SetColorAtDate(dt: TDateTime; cellColor: TColor; UpdateControl: Boolean);
var
  mm,dd,yy: word;
begin
  DecodeDate(dt, yy, mm, dd);
  CellData[mm, dd].CellColor := cellColor;
  CellData[mm, dd].CustomColor := True;
  if UpdateControl then Invalidate;
end;

procedure TYearPlanner.SetFontAtDate(dt: TDateTime; cellFont: TFont; UpdateControl: Boolean);
var
  mm,dd,yy: word;
begin
  DecodeDate(dt, yy, mm, dd);
  CellData[mm, dd].CellFont := cellFont;
  CellData[mm, dd].CustomFont := True;
  if UpdateControl then Invalidate;
end;

procedure TYearPlanner.SetHintAtDate(dt: TDateTime; cellHint: String; UpdateControl: Boolean);
var
  mm,dd,yy: word;
begin
  DecodeDate(dt, yy, mm, dd);
  CellData[mm, dd].CellHint := cellHint;
  if UpdateControl then Invalidate;
end;

{$IFDEF WIN32}
procedure TYearPlanner.SetImageAtDate(dt: TDateTime; cellImage: Integer; UpdateControl: Boolean);
var
  mm,dd,yy: word;
begin
  DecodeDate(dt, yy, mm, dd);
  CellData[mm, dd].CellImage := cellImage;
  if UpdateControl then Invalidate;
end;
{$ENDIF}

function TYearPlanner.GetCellData(dt: TDateTime): TCellData;
var
  mm,dd,yy: word;
begin
  DecodeDate(dt, yy, mm, dd);
  Result := CellData[mm, dd];
end;

{ Thanks to Paul Bailey, Paul Fisher and Wolf Garber for this routine }
procedure TYearPlanner.Print;
var
  TempCap: array[0..255] of char;
  pHeight, pWidth: Integer;
  DrawFlags: Longint;
  TheRect: TRect;
  Ratio: Extended;
begin
  hPrinting := True;
  { Work out the page size and margins }
  with fPrintOptions do
  begin
    Printer.Orientation := fPrinterOrientation;
    { The page width and height exclude the margins }
    pWidth := Printer.PageWidth - fPrinterLeftMargin - fPrinterRightMargin;
    pHeight := Printer.PageHeight - fPrinterTopMargin - fPrinterBottomMargin;
    { Resize the page size based on the reduction ratio }
    PrinterPageWidth := round(pWidth * (fPrintReductionSize / 100));
    PrinterPageHeight := round(pHeight * (fPrintReductionSize / 100));
    {Preserve Aspect Ratio}
    if PreserveAspect then
    begin
      Ratio := Height/Width;
      PrinterPageHeight := round(Ratio * PrinterPageWidth);
      if PrinterPageHeight > pHeight then
      begin
        PrinterPageWidth:= round(PrinterPageWidth*(pHeight/PrinterPageHeight));
        PrinterPageHeight:= round(pHeight);
      end;
    end;
    { Set the margins }
    PrinterLeftMargin := fPrinterLeftMargin;
    PrinterTopMargin := fPrinterTopMargin;
    PrinterRightMargin := fPrinterRightMargin;
    PrinterBottomMargin := fPrinterBottomMargin;
  end;
  try
    Printer.BeginDoc;
    { Paint the YearPlanner }
    self.Paint;
    { Draw the headers and footers }
    with fPrintOptions, Printer.Canvas do
    begin
      { Draw the header }
      if PrintHeader.Caption <> '' then
      begin
        { Setup the header }
        StrPCopy(TempCap, PrintHeader.Caption);
        Font := PrintHeader.Font;
        TheRect := Rect(PrinterLeftMargin, 0, PrinterLeftMargin + pWidth,
          PrinterTopMargin);
        { The text is vetically centered in the top margin }
        DrawFlags := DT_VCENTER or DT_SINGLELINE;
        { Do the alignment }
        case PrintHeader.Alignment of
          taLeftJustify: DrawFlags := DrawFlags or DT_LEFT;
          taCenter: DrawFlags := DrawFlags or DT_CENTER;
          taRightJustify: DrawFlags := DrawFlags or DT_RIGHT;
        end;
        { Draw the text }
        DrawText(Handle, TempCap, StrLen(TempCap), TheRect, DrawFlags);
      end;
      { Draw the footer }
      if PrintFooter.Caption <> '' then
      begin
        { Setup the footer }
        StrPCopy(TempCap, PrintFooter.Caption);
        Font := PrintFooter.Font;
        TheRect := Rect(PrinterLeftMargin, PrinterTopMargin + pHeight,
          PrinterLeftMargin + pWidth, PrinterTopMargin + pHeight + PrinterBottomMargin);
        { The text is vetically centered in the bottom margin }
        DrawFlags := DT_VCENTER or DT_SINGLELINE;
        { Do the alignment }
        case PrintFooter.Alignment of
          taLeftJustify: DrawFlags := DrawFlags or DT_LEFT;
          taCenter: DrawFlags := DrawFlags or DT_CENTER;
          taRightJustify: DrawFlags := DrawFlags or DT_RIGHT;
        end;
        { Draw the text }
        DrawText(Handle, TempCap, StrLen(TempCap), TheRect, DrawFlags);
      end;
    end;
  finally
    Printer.EndDoc;
    hPrinting := False;
  end;
end;

{ Thanks to Goldschmidt Jean-Jacques for this routine }
function TYearPlanner.GetStartDate: TDateTime;
begin
  GetStartDate := fStartDate;
end;

{ Thanks to Goldschmidt Jean-Jacques for this routine }
function TYearPlanner.GetEndDate: TDateTime;
begin
  GetEndDate := fEndDate;
end;

{ Thanks to Goldschmidt Jean-Jacques for this routine }
function TYearPlanner.IsSelected(date: TDateTime): Boolean;
var
  mm,dd,yy: word;
begin
  DecodeDate(date, yy, mm, dd);
  IsSelected := CellData[mm, dd].Selected;
end;

{ Clear the selection }
procedure TYearPlanner.ClearSelection;
begin
  StDay := 0;
  StMonth := 0;
  EnDay := 0;
  EnMonth := 0;
  fStartDate := Now;
  fEndDate := Now;
  Invalidate;
end;

{ Manually select a single cell }
procedure TYearPlanner.SelectCells(sDate, eDate: TDateTime);
var
  eD, eM, eY, sD, sM, sY: word;
  CountX: Integer;
  tmpDate:  TDateTime;
begin
  { We may need to reverse the cell dates }
  if sDate > eDate then
  begin
    tmpDate := sDate;
    sDate := eDate;
    eDate := tmpDate;
  end;
  { Get the start and end cell dates }
  DecodeDate(sDate, sY, sM, sD);
  DecodeDate(eDate, eY, eM, eD);
  { Find the start date cell }
  for CountX := 1 to 37 do
    if StrToIntDef(Cells[CountX, sM],0) = sD then
    begin
      { Select the cell }
      StDay := CountX;
      StMonth := sM;
      fStartDate := sDate;
    end;
  { Find the end date cell }
  for CountX := 1 to 37 do
    if StrToIntDef(Cells[CountX, eM],0) = eD then
    begin
      { Select the cell }
      EnDay := CountX;
      EnMonth := eM;
      fEndDate := eDate;
    end;
  { Repaint the control }
  Invalidate;
  Exit;
end;

{ Selects a given week }
procedure TYearPlanner.SelectWeek(aWeek: Integer);
var
  eDate, sDate: TDateTime;
begin
  { Set the dates }
  sDate := FindFirstWeek(Year) + ((aWeek - 1) * 7);
  eDate := sDate + 6;
  { Select the cells }
  SelectCells(sDate, eDate);
end;

{ Thanks to Trev for this routine }
procedure TYearPlanner.ClearCells;
var
  mm, dd: Integer;
begin
  for mm := 1 to 12 do
    for dd := 1 to 31 do
      with CellData[mm, dd] do
      begin
        CellColor := $00000000;
        CellFont := fDayFont;
        CellHint := '';
        CustomColor := False;
        CustomFont := False;
        {$IFDEF WIN32}
        CellImage := -1;
        {$ENDIF}
        Tag := -1;
      end;
  Invalidate;
end;

{ Gives you the week number of a specified date. }
function TYearPlanner.WeekNumber(aDate: TDateTime): Integer;
var
  sDay, sMonth, sYear: Word;
begin
  { Extract the current year }
  DecodeDate(aDate, sYear, sMonth, sDay);
  { We now have the start date of the first week, so find out the difference }
  Result := Trunc((StrToInt(FloatToStr(aDate - FindFirstWeek(sYear))) / 7) + 1);
end;

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

end.

[feliz-58]

hay esta todo

[ecfisa]

Hola feliz-58.

El error que mencionas en el primer mensaje no existe en ese código, seguramente esté en el que realiza la llamada al mismo.

Saludos