{                 --------------------------------------------
                  carbonprivate.pp  -  Carbon internal classes
                  --------------------------------------------

 This unit contains the Carbon Calendar view implementation. Pure carbon, no LCL controls

 The code is based on CalendarView code sample.
 http://developer.apple.com/legacy/mac/library/samplecode/CalendarView/index.html

 The calendar view, has been "modernized":
  * using HIShape in GetBoundsEvent
  * removed loop in FindPart
  * changed drawing ratios
  * added day selection (selDay)
 TODO: remove QuickDraw deperacted functions

 The best size is: width = 180. height = 140
 
 Ported by: Dmitry 'skalogryz' Boyarintsev 

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}
unit CarbonCalendarView;

{$mode objfpc}{$H+}

interface

uses
  MacOSAll;

// -----------------------------------------------------------------------------
// CalendarView API
// -----------------------------------------------------------------------------
//
function CalendarViewCreate(inWindow : WindowRef;
	const inBounds : Rect; var outControl: ControlRef): OSStatus;

function CalendarGetDate(Calendar: ControlRef; var Date: CFGregorianDate): Boolean;
function CalendarSetDate(Calendar: ControlRef; const Date: CFGregorianDate): Boolean;

// -----------------------------------------------------------------------------
// CalendarView Set/GetData tags
// -----------------------------------------------------------------------------
//
const
	kControlCalendarTitleRatioTag	  = {$IFDEF FPC_LITTLE_ENDIAN}$74615274{$else}$74526174{$endif}; //tRat float
	kControlCalendarDayNameRatioTag	= {$IFDEF FPC_LITTLE_ENDIAN}$7461526E{$else}$6E526174{$endif}; //nRat float
	kControlCalendarDayRatioTag		  = {$IFDEF FPC_LITTLE_ENDIAN}$74615264{$else}$64526174{$endif}; //dRat float
	kControlCalendarDateTag			    = {$IFDEF FPC_LITTLE_ENDIAN}$65746144{$else}$44617465{$endif}; //Date CFGregorianDate -- on Set, day, hour, etc are ignored
	kControlCalendarDrawProcTag		  = {$IFDEF FPC_LITTLE_ENDIAN}$77617244{$else}$44726177{$endif}; //Draw CalendarDrawUPP
	kControlCalendarLabelProcTag	  = {$IFDEF FPC_LITTLE_ENDIAN}$6C62614C{$else}$4C61626C{$endif}; //Labl CalendarDrawUPP

// -----------------------------------------------------------------------------
// CalendarView Draw/LabelProc callback data and prototypes
// -----------------------------------------------------------------------------
//
type
  CalendarDrawData = packed record
	  context     : CGContextRef;
  	daysInMonth : UInt8;
	  hilitePart  : ControlPartCode;
  	date        : CFGregorianDate;
  end;

type
  CalendarDrawProc = procedure (inPart: ControlPartCode; const inPartRect: HIRect; const inData :CalendarDrawData);
  CalendarDrawProcPtr = ^CalendarDrawProc;

implementation

var
  kCalendarViewClassID    : CFStringRef = nil;
  _kHIViewClassID         : CFStringRef = nil;
  CalendarViewHandlerUPP  : EventHandlerUPP;
  months                  : array[0..11] of CFStringRef;
  dow                     : array[0..6] of CFStringRef;

const
	kCalendarMonthPart          = 100;
	kCalendarPreviousYearPart   = 101;
	kCalendarPreviousMonthPart  = 102;
	kCalendarNextMonthPart      = 103;
	kCalendarNextYearPart       = 104;
	kCalendarSundayNamePart     = 200;
	kCalendarMondayNamePart     = 201;
	kCalendarTuesdayNamePart    = 202;
	kCalendarWednesdayNamePart  = 203;
	kCalendarThursdayNamePart   = 204;
	kCalendarFridayNamePart     = 205;
	kCalendarSaturdayNamePart   = 206;

// -----------------------------------------------------------------------------
//	types
// -----------------------------------------------------------------------------
//
type
  CalendarViewDataPtr = ^CalendarViewData;
  CalendarViewData = record
  	view : HIViewRef;
  	// Geometry
	  titleRowRatio   : single;
  	dayNameRowRatio : single;
	  dayRowRatio     : single;

  	// Date stuff
	  date        : CFGregorianDate;
  	timeZone    : CFTimeZoneRef;
	  firstDay    : UInt8;
  	daysInMonth : UInt8;
    selDay      : UInt8;  // selected day

  	// Proc stuff
	  drawProc    : CalendarDrawProc;
  	labelProc   : CalendarDrawProc;

  end;

// -----------------------------------------------------------------------------
//	utilities
// -----------------------------------------------------------------------------
//

// -----------------------------------------------------------------------------
//	SetUpDateData
// -----------------------------------------------------------------------------
//
procedure SetUpDateData(var inData: CalendarViewData);
var
	tempDate : CFGregorianDate;
	tempTime : CFAbsoluteTime;
  nextMonthMinusADay : CFGregorianUnits;
begin
  with nextMonthMinusADay do begin
		years:=0;
		months:=1;
		days:=-1;
		hours:=0;
		minutes:=0;
		seconds:=0;
  end;
  // What is the first day of this month?
  tempTime := CFGregorianDateGetAbsoluteTime( inData.date, inData.timeZone );
  inData.firstDay := CFAbsoluteTimeGetDayOfWeek( tempTime, inData.timeZone ) mod 7;

  // How many days in this month?
  tempTime := CFAbsoluteTimeAddGregorianUnits( tempTime, inData.timeZone, nextMonthMinusADay );
  tempDate := CFAbsoluteTimeGetGregorianDate( tempTime, inData.timeZone );
  inData.daysInMonth := tempDate.day;
end;

// -----------------------------------------------------------------------------
//	DefaultDrawPart
// -----------------------------------------------------------------------------
//
procedure DefaultDrawPart(inPart: ControlPartCode; const inPartRect: HIRect; const inData: CalendarDrawData );
var
  color: RGBColor;
begin
	case inPart of
		kControlStructureMetaPart:
    begin
  		CGContextSetRGBFillColor( inData.context, 0.95, 0.95, 0.95, 1 );
	  	CGContextFillRect( inData.context, inPartRect );
			//#elif 1
			//	ShadeRect( .8, .95, inPartRect, inData->context );
			//#else
			//{
			//	CGRGB	start = { 1, 0, 0 };
			//	CGRGB	end = { 0, 0, 1 };
		  //	ShadeRectColor( &start, &end, inPartRect, inData->context );
			//}
			//#endif
    end
  else
  	if (inData.hilitePart > 0) and (inData.hilitePart = inPart) then begin
      GetThemeBrushAsColor( kThemeBrushPrimaryHighlightColor, 32, true, color {%H-});
      CGContextSetRGBFillColor( inData.context, color.red / 65536, color.green / 65536, color.blue / 65536, 1 );
      CGContextFillRect(inData.context, inPartRect );
    end;
  end;
end;

// -----------------------------------------------------------------------------
//	DefaultDrawPartLabel
// -----------------------------------------------------------------------------
//
procedure DefaultDrawPartLabel(inPart: ControlPartCode; const inPartRect: HIRect;	const inData: CalendarDrawData);
var
	qdBounds  : Rect;
	s         : CFStringRef;
  dateString: CFMutableStringRef;
begin
	// Set up a quickdraw rectangle for DrawThemeTextBox
	qdBounds.top := Round(inPartRect.origin.y);
	qdBounds.left := Round(inPartRect.origin.x);
	qdBounds.bottom := qdBounds.top + Round(inPartRect.size.height);
	qdBounds.right := qdBounds.left + Round(inPartRect.size.width);

	CGContextSetRGBFillColor( inData.context, 0, 0, 0, 1 );

 case (inPart) of
		kCalendarMonthPart:
    begin
			dateString := CFStringCreateMutableCopy( nil, 16, months[ inData.date.month-1 ] );
			CFStringAppend( dateString, CFSTR(' '));
			CFStringAppendFormat( dateString, nil, CFSTR( '%d' ), inData.date.year );

			DrawThemeTextBox( dateString, kThemeSystemFont,
					kThemeStateActive, false, qdBounds, teJustCenter, inData.context );

			CFRelease( dateString );
		end;

		kCalendarPreviousYearPart:
			DrawThemeTextBox( CFSTR('<'), kThemeEmphasizedSystemFont,
				kThemeStateActive, false, qdBounds, teJustCenter, inData.context );

		kCalendarPreviousMonthPart:
			DrawThemeTextBox( CFSTR( '<' ), kThemeSmallSystemFont,
				kThemeStateActive, false, qdBounds, teJustCenter, inData.context );

		kCalendarNextMonthPart:
			DrawThemeTextBox( CFSTR( '>' ), kThemeSmallSystemFont,
				kThemeStateActive, false, qdBounds, teJustCenter, inData.context );

		kCalendarNextYearPart:
			DrawThemeTextBox( CFSTR( '>' ), kThemeEmphasizedSystemFont,
   			kThemeStateActive, false, qdBounds, teJustCenter, inData.context );

		kCalendarSundayNamePart,
		kCalendarMondayNamePart,
		kCalendarTuesdayNamePart,
		kCalendarWednesdayNamePart,
		kCalendarThursdayNamePart,
		kCalendarFridayNamePart,
		kCalendarSaturdayNamePart:
  		DrawThemeTextBox( dow[ inPart mod kCalendarSundayNamePart ],
        //kThemeSystemFont,
        kThemeEmphasizedSystemFont,
				kThemeStatePressed, false, qdBounds, teJustCenter, inData.context );

	else
		if (inPart > 0) and (inPart <= inData.daysInMonth ) then begin
   		s := CFStringCreateWithFormat( nil, nil, CFSTR( '%d' ), inPart );
      qdBounds.right := qdBounds.right - 4;
			DrawThemeTextBox(s, kThemeSystemFont, kThemeStatePressed, false, qdBounds, teJustRight, inData.context);
			CFRelease( s );
		end;
  end;
end;



// -----------------------------------------------------------------------------
//	CalendarViewConstruct
// -----------------------------------------------------------------------------
//

function CalendarViewConstruct(inEvent : EventRef): OSStatus;
var
	err  : OSStatus;
	data : CalendarViewDataPtr;
begin
	// don't CallNextEventHandler!
  try
   	data :=GetMem( sizeof( CalendarViewData ) );
    if data=nil then begin
      err := memFullErr;
      Exit;
    end;

    FillChar(data^, sizeof(CalendarViewData), 0);
    try
    	// Set up the row height ratios
    	data^.titleRowRatio := 1.0;		// half a row
    	data^.dayNameRowRatio := 1.0;	// half a row
    	data^.dayRowRatio := 1.0;		// full row

  	  // Set up the current timezone
    	data^.timeZone := CFTimeZoneCopySystem();
      if data^.timeZone = nil then begin
        err := memFullErr;
        Exit;
      end;

	    // Set up the current month
    	data^.date := CFAbsoluteTimeGetGregorianDate( CFAbsoluteTimeGetCurrent(), data^.timeZone );
    	data^.date.day := 1;
    	data^.date.hour := 0;
    	data^.date.minute := 0;
    	data^.date.second := 0;
    	SetUpDateData( data^ );

    	// Set up the default drawing callbacks
    	data^.drawProc := @DefaultDrawPart;
    	data^.labelProc := @DefaultDrawPartLabel;

	    // Keep a copy of the created HIViewRef
    	err := GetEventParameter( inEvent, kEventParamHIObjectInstance, typeHIObjectRef,
      			nil, sizeof( HIObjectRef ), nil, @data^.view );
      if err <> noErr then Exit;

      // Set the userData that will be used with all subsequent eventHandler calls
      err := SetEventParameter( inEvent, kEventParamHIObjectInstance, typeVoidPtr,sizeof( CalendarViewDataPtr ), @data );

    finally
      if err <> noErr then FreeMem(data);
    end;
  finally
    Result := err;
  end;
end;


// -----------------------------------------------------------------------------
//	CalendarViewInitialize
// -----------------------------------------------------------------------------
//
function CalendarViewInitialize(inCallRef: EventHandlerCallRef; inEvent : EventRef;
  const inData : CalendarViewData): OSStatus;
var
	bounds    : Rect;
  features  : UInt32;
const
  BounName : PChar = 'Boun';
begin
	features := kControlSupportsDataAccess;

	// Let the base class initialization occur
	Result := CallNextEventHandler( inCallRef, inEvent );
  if Result <> noErr then Exit;

	// Extract the initial view bounds from the event
  //TODO!!!
	Result :=GetEventParameter( inEvent, EventParamNamePtr(BounName)^, typeQDRectangle,	nil, sizeof( Rect ), nil, @bounds );
  if Result <> noErr then Exit;

	// Set up this view's feature bits
	Result := SetEventParameter( inEvent, kEventParamControlFeatures, typeUInt32, sizeof( UInt32 ), @features );
	SetControlBounds( inData.view, bounds );
end;

// -----------------------------------------------------------------------------
//	CalendarViewDestruct
// -----------------------------------------------------------------------------
//
function CalendarViewDestruct({%H-}inEvent : EventRef; var inData : CalendarViewDataPtr): OSStatus;
begin
  //#pragma unused( inEvent )
	// Clean up any allocated data
	CFRelease( inData^.timeZone );
	FreeMem( inData );
  inData := nil;
	Result := noErr;
end;


// -----------------------------------------------------------------------------
//	CalendarViewDraw
// -----------------------------------------------------------------------------
//

function CalendarViewDraw(inEvent: EventRef; const inData: CalendarViewData): OSStatus;
var
	bounds    : HIRect;
	rowHeight : single;
	colWidth  : single;
	cols      : integer;
	rows      : single;
	drawRect  : HIRect;
	part      : ControlPartCode;
	dayCount  : UInt16;
	rowCount  : single;
	drawData  : CalendarDrawData;
begin
  rows := 0;
  dayCount := 0;
  rowCount := 6 * inData.dayRowRatio + inData.dayNameRowRatio + inData.titleRowRatio;
	
	// Get ready to do the CG drawing boogaloo!
	Result := GetEventParameter( inEvent, kEventParamCGContextRef, typeCGContextRef,	
            nil, sizeof( CGContextRef ), nil, @drawData.context );
  if Result <> noErr then Exit;  

	Result := HIViewGetBounds( inData.view, bounds {%H-});

  // highlighting only selected day
	//drawData.hilitePart := GetControlHilite( inData.view );
  drawData.hilitePart := inData.selDay;
	drawData.daysInMonth := inData.daysInMonth;
	drawData.date := inData.date;

	// Figure out how tall a row should be
	rowHeight := bounds.size.height / rowCount;
	colWidth := Round ( bounds.size.width) div 14;	// round here instead of over and over

  inData.drawProc(kControlStructureMetaPart, bounds, drawData);

	drawRect.origin := bounds.origin;
	drawRect.size.height := Round( rowHeight * inData.titleRowRatio);
	drawRect.size.width := colWidth;
  
	inData.drawProc(kCalendarPreviousYearPart, drawRect, drawData);
  inData.labelProc(kCalendarPreviousYearPart, drawRect, drawData);
	drawRect.origin.x := drawRect.origin.x + drawRect.size.width;

	drawRect.size.width := colWidth;
	inData.drawProc( kCalendarPreviousMonthPart, drawRect, drawData);
	inData.labelProc( kCalendarPreviousMonthPart, drawRect, drawData);
	drawRect.origin.x:=drawRect.origin.x+ drawRect.size.width;

	// Draw the month
	drawRect.size.width := 10 * colWidth;
	inData.drawProc( kCalendarMonthPart, drawRect, drawData);
	inData.labelProc( kCalendarMonthPart, drawRect, drawData );
	drawRect.origin.x := drawRect.origin.x + drawRect.size.width;

	drawRect.size.width := colWidth;
	inData.drawProc( kCalendarNextMonthPart, drawRect, drawData);
	inData.labelProc( kCalendarNextMonthPart, drawRect, drawData);
	drawRect.origin.x := drawRect.origin.x + drawRect.size.width;

	drawRect.size.width := colWidth;
	inData.drawProc ( kCalendarNextYearPart, drawRect, drawData);
	inData.labelProc( kCalendarNextYearPart, drawRect, drawData);

	drawRect.origin.y := drawRect.origin.y  + drawRect.size.height;	// on to the next row!
	rows := rows + inData.titleRowRatio;
	drawRect.origin.x := bounds.origin.x;	// reset to leftmost

	// Optionally draw the week day names
	if  inData.dayNameRowRatio <> 0  then begin
		// Draw the weekdays
		drawRect.size.width := 2 * colWidth;
		drawRect.size.height := Int( rowHeight * inData.dayNameRowRatio );
		part := kCalendarSundayNamePart;
    for cols := 0 to 6 do begin
			inData.drawProc (part, drawRect, drawData);
			inData.labelProc(part, drawRect, drawData);
			drawRect.origin.x := drawRect.origin.x+drawRect.size.width;	// on to the next col!
      inc(part);
		end;
		drawRect.origin.y := drawRect.origin.y+drawRect.size.height;	// on to the next row!
		rows := rows + inData.dayNameRowRatio;
	end;

	// Set up to draw the date rows
	drawRect.origin.x := bounds.origin.x;	// reset to leftmost
	drawRect.size.width := 2 * colWidth;
	drawRect.size.height := Round ( rowHeight * inData.dayRowRatio );

	part := 0;
  while rows < rowCount do begin
		for cols := 0 to 6 do begin
			if ( dayCount >= inData.firstDay ) then
				inc(part);
      inc(dayCount);

      if part > inData.daysInMonth
        then inData.drawProc(0, drawRect, drawData)
        else inData.drawProc(part, drawRect, drawData);
      if part > inData.daysInMonth
        then inData.labelProc(0, drawRect, drawData)
        else inData.labelProc(part, drawRect, drawData);
			drawRect.origin.x := drawRect.origin.x + drawRect.size.width;	// on to the next col!
	  end;
		drawRect.origin.x := bounds.origin.x;	// reset to leftmost
		drawRect.origin.y := drawRect.origin.y + drawRect.size.height;	// on to the next row!
    rows := rows + inData.dayRowRatio;
	end;
end;

// -----------------------------------------------------------------------------
//	FindPart
// -----------------------------------------------------------------------------
//
function FindPart(const inBounds: HIRect; const inWhere : HIPoint; const inData : CalendarViewData): ControlPartCode;
var
	part      : ControlPartCode;
	testRect  : HIRect;
	rowHeight : single;
  colWidth  : single;
	rows      : single;
	cols      : integer;
	rowCount  : single;
  dx, dy    : Integer;
begin
  rows := 0;
  rowCount := 6 * inData.dayRowRatio + inData.dayNameRowRatio + inData.titleRowRatio;
	rowHeight := inBounds.size.height / rowCount;
	colWidth := Round(inBounds.size.width / 14 );

	// Part is the month?
	testRect.origin := inBounds.origin;
	testRect.size.height := Round(rowHeight * inData.titleRowRatio );

	testRect.size.width := colWidth;
  if CGRectContainsPoint( testRect, inWhere ) <> 0 then begin
    Result := kCalendarPreviousYearPart;
    Exit;
  end;
	testRect.origin.x :=  testRect.origin.x + testRect.size.width;

	if CGRectContainsPoint( testRect, inWhere ) <> 0 then begin
    Result := kCalendarPreviousMonthPart;
    Exit;
  end;
	testRect.origin.x := testRect.origin.x + testRect.size.width;

	testRect.size.width := 10 * colWidth;
	if CGRectContainsPoint( testRect, inWhere ) <> 0 then begin
    Result := kCalendarMonthPart;
    Exit;
  end;
  testRect.origin.x := testRect.origin.x + testRect.size.width;

	testRect.size.width := colWidth;
	if CGRectContainsPoint( testRect, inWhere ) <> 0 then begin
    Result := kCalendarNextMonthPart;
    Exit;
  end;
	testRect.origin.x := testRect.origin.x + testRect.size.width;

	testRect.size.width := colWidth;
  if CGRectContainsPoint( testRect, inWhere ) <> 0 then begin
    Result := kCalendarNextYearPart;
    Exit;
  end;

	testRect.origin.y := testRect.origin.y + testRect.size.height;
	rows := rows + inData.titleRowRatio;
	testRect.origin.x := inBounds.origin.x;
	
	if ( inData.dayNameRowRatio <> 0 ) then
	begin
		// Part is a weekday?
		testRect.size.height := int( rowHeight * inData.dayNameRowRatio );
		testRect.size.width := inBounds.size.width;

		if CGRectContainsPoint( testRect, inWhere ) <> 0 then 
		begin
			part := kCalendarSundayNamePart;
			testRect.size.width := 2 * colWidth;
			for cols := 0 to 6 do begin
        if CGRectContainsPoint( testRect, inWhere ) <> 0 then begin
          Result := part;
          Exit;
        end;
				testRect.origin.x := testRect.origin.x+testRect.size.width;
				inc(part)
			end;
		end;
		testRect.origin.y := testRect.origin.y + testRect.size.height;
		rows := rows + inData.dayNameRowRatio;
	end;

	testRect.origin.x := inBounds.origin.x;
	testRect.size.height := Round( rowHeight * inData.dayRowRatio );
  testRect.size.width := inBounds.size.width;

  dx := Trunc(inWhere.x / (inBounds.size.width/7));
  dy := Trunc((inWhere.y - testRect.origin.y) / (rowHeight * inData.dayRowRatio));

	// Part is a calendar square?
  part := dy * 7 + dx - inData.firstDay + 1;
  if (part < 0) or (part > inData.daysInMonth) then
    part := kControlNoPart;

	Result := part;
end;



// -----------------------------------------------------------------------------
//	CalendarViewHitTest
// -----------------------------------------------------------------------------
//

function CalendarViewHitTest(inEvent : EventRef; 
  const inData: CalendarViewData): OSStatus;
var
  bounds  :	HIRect;
  where   : HIPoint;
	part    : ControlPartCode;
begin
	Result := GetEventParameter( inEvent, kEventParamMouseLocation, typeHIPoint,
			nil, sizeof( HIPoint ), nil, @where );
  if Result <> noErr then Exit;

	HIViewGetBounds( inData.view, bounds {%H-});

	part := FindPart(bounds, where, inData );

	Result := SetEventParameter( inEvent, kEventParamControlPart, typeControlPartCode,
			sizeof( ControlPartCode ), @part ); 
end;

// -----------------------------------------------------------------------------
//	CalendarViewTrack
// -----------------------------------------------------------------------------
//
function CalendarViewTrack(inEvent : EventRef; var inData: CalendarViewData ): OSStatus;
var
	bounds      : HIRect;
	where       : HIPoint;
	part        : ControlPartCode;
	lastPart    : ControlPartCode;
	startHilite : ControlPartCode;
	qdPt        : Point;
	mouseResult : MouseTrackingResult;
	portPixMap  : PixMapHandle;
  tempTime    : CFAbsoluteTime;
	dateChange  : CFGregorianUnits;
begin
	Result := GetEventParameter( inEvent, kEventParamMouseLocation, typeHIPoint,
			niL, sizeof( HIPoint ), nil, @where );
  if Result <> noErr then Exit;

	Result := HIViewGetBounds( inData.view, bounds {%H-});
	
	startHilite := GetControlHilite( inData.view );
	
	lastPart := FindPart( bounds, where, inData );
	HiliteControl( inData.view, lastPart );
	
	// Need the port's pixMap's bounds to convert the point
	portPixMap := GetPortPixMap( GetWindowPort( GetControlOwner( inData.view ) ) );

	while ( true ) do
  begin
		part := FindPart( bounds, where, inData );
		if ( lastPart <> part ) then
			HiliteControl( inData.view, part );
		lastPart := part;

    //TODO!!!!!!
		Result := TrackMouseLocation( GrafPtr(-1), qdPt{%H-}, mouseResult {%H-});

		// Need to convert from global
		QDGlobalToLocalPoint( GetWindowPort( GetControlOwner( inData.view ) ), qdPt );
		where.x := qdPt.h - portPixMap^^.bounds.left;
		where.y := qdPt.v - portPixMap^^.bounds.top;
		HIViewConvertPoint( where, nil, inData.view );

		// bail out when the mouse is released
		if ( mouseResult = kMouseTrackingMouseReleased ) then Break;
	end;
	
	// If a day wasn't clicked, revert the highlight to the last highlit day
	if (lastPart < 1) and (lastPart > inData.daysInMonth ) then
		HiliteControl( inData.view, startHilite )
  else if (lastPart >= 1) and (lastPart <= inData.daysInMonth ) then begin
    inData.selDay := lastPart;
   	HIViewSetNeedsDisplay( inData.view, true );
  end;


	if ( lastPart >= kCalendarPreviousYearPart) and (lastPart <= kCalendarNextYearPart ) then
  begin
    FillChar(dateChange{%H-}, sizeof(dateChange), 0);

		tempTime := CFGregorianDateGetAbsoluteTime( inData.date, inData.timeZone );

		case lastPart of 
			kCalendarPreviousYearPart:	dateChange.years := -1;
			kCalendarPreviousMonthPart: dateChange.months := -1;
			kCalendarNextMonthPart:    	dateChange.months := 1;
			kCalendarNextYearPart:      dateChange.years := 1;
		end;

		tempTime := CFAbsoluteTimeAddGregorianUnits( tempTime, inData.timeZone, dateChange );
		inData.date := CFAbsoluteTimeGetGregorianDate( tempTime, inData.timeZone );
		
		SetUpDateData( inData );

    if inData.selDay > inData.daysInMonth then
      inData.selDay := inData.daysInMonth;

   	HIViewSetNeedsDisplay( inData.view, true );
  end;

	Result := SetEventParameter( inEvent, kEventParamControlPart, typeControlPartCode,	sizeof( ControlPartCode ), @part ); 
end;

// -----------------------------------------------------------------------------
//	CalendarViewChanged
// -----------------------------------------------------------------------------
//
function CalendarViewChanged({%H-}inEvent :EventRef; const inData: CalendarViewData): OSStatus;
begin
  //#pragma unused( inEvent )
	//Status			err = noErr;
	HIViewSetNeedsDisplay( inData.view, true );
	Result := noErr;
end;


// -----------------------------------------------------------------------------
//	CalendarViewGetData
// -----------------------------------------------------------------------------
//

function CalendarViewGetData(inEvent : EventRef; const inData: CalendarViewData): OSStatus;
var
	part    : ControlPartCode;
	tag     : OSType;
	ptr     : Pointer;
	sz      : Size;
	outSize : Size;
begin
  Result := GetEventParameter( inEvent, kEventParamControlPart, typeControlPartCode,	nil, sizeof( ControlPartCode ), nil, @part );
  if Result <> noErr then Exit;

  Result := GetEventParameter( inEvent, kEventParamControlDataTag, typeEnumeration, nil, sizeof( OSType ), nil, @tag );
  if Result <> noErr then Exit;

  Result := GetEventParameter( inEvent, kEventParamControlDataBuffer, typePtr, nil, sizeof( Ptr ), nil, @ptr );
  if Result <> noErr then Exit;

  Result := GetEventParameter( inEvent, kEventParamControlDataBufferSize, typeLongInteger, nil, sizeof( Size ), nil, @sz );
  if Result <> noErr then Exit;

  case tag of
    kControlCalendarTitleRatioTag:
    begin
      if sz = sizeof( single ) then
	PSingle(ptr)^ := inData.titleRowRatio
      else
	Result := errDataSizeMismatch;
      outSize := sizeof( single);
    end;

    kControlCalendarDayNameRatioTag:
    begin
      if sz = sizeof( single ) then
	PSingle(ptr)^ := inData.dayNameRowRatio
      else
	Result := errDataSizeMismatch;
      outSize := sizeof( single );
    end;

    kControlCalendarDayRatioTag:
    begin
      if ( sz = sizeof( single ) ) then
	PSingle(ptr)^ := inData.dayRowRatio
      else
	Result := errDataSizeMismatch;
      outSize := sizeof( single );
    end;

    kControlCalendarDateTag:
    begin
      if sz = sizeof( CFGregorianDate ) then
      begin
	CFGregorianDatePtr(ptr)^ := inData.date;
        if (inData.selDay>0) and (inData.selDay<=inData.daysInMonth) then
          CFGregorianDatePtr(ptr)^.day := inData.selDay;
      end
      else
        Result := errDataSizeMismatch;
      outSize := sizeof( CFGregorianDate );
    end;

    kControlCalendarDrawProcTag:
    begin
      if sz =sizeof( CalendarDrawProc ) then
        CalendarDrawProc(Ptr^):=inData.drawProc
      else
	Result := errDataSizeMismatch;
      outSize := sizeof( CalendarDrawProc );
    end;

    kControlCalendarLabelProcTag:
    begin
      if sz = sizeof( CalendarDrawProc ) then
        CalendarDrawProc(Ptr^):=inData.labelProc
      else
        Result := errDataSizeMismatch;
      outSize := sizeof( CalendarDrawProc );
    end;

  else
    Result := errDataNotSupported;
    outSize := 0;
  end;

  if ( Result = noErr ) then
    Result := SetEventParameter( inEvent, kEventParamControlDataBufferSize, typeLongInteger, sizeof( sz ), @outSize );
end;

// -----------------------------------------------------------------------------
//	CalendarViewSetData
// -----------------------------------------------------------------------------
//

function CalendarViewSetData(inEvent: EventRef;	var inData : CalendarViewData): OSStatus;
var
	part  : ControlPartCode;
	tag   : OSType;
	ptr   : Pointer;
	sz    : Size;
begin
	Result := GetEventParameter( inEvent, kEventParamControlPart, typeControlPartCode,	nil, sizeof( ControlPartCode ), nil, @part );
	if Result <> noErr then Exit;

	Result := GetEventParameter( inEvent, kEventParamControlDataTag, typeEnumeration,	nil, sizeof( OSType ), nil, @tag );
	if Result <> noErr then Exit;

	Result := GetEventParameter( inEvent, kEventParamControlDataBuffer, typePtr, nil, sizeof( Ptr ), nil, @ptr );
	if Result <> noErr then Exit;

	Result := GetEventParameter( inEvent, kEventParamControlDataBufferSize, typeLongInteger, nil, sizeof( sz ), nil, @sz );
	if Result <> noErr then Exit;

	case tag of
		kControlCalendarTitleRatioTag:
			if sz = sizeof( single ) then
        inData.titleRowRatio := PSingle(ptr)^
			else
				Result := errDataSizeMismatch;

		kControlCalendarDayNameRatioTag:
			if sz = sizeof( single ) then
				inData.dayNameRowRatio := PSingle(ptr)^
			else
			  Result := errDataSizeMismatch;

		kControlCalendarDayRatioTag:
			if  sz = sizeof( single ) then
				inData.dayRowRatio := PSingle(ptr )^
			else
				Result := errDataSizeMismatch;

		kControlCalendarDateTag:
			if sz = sizeof(CFGregorianDate ) then
      begin
				inData.date.year :=  CFGregorianDatePtr(ptr)^.year;
				inData.date.month := CFGregorianDatePtr(ptr)^.month;
        inData.selDay := CFGregorianDatePtr(ptr)^.day;
				SetUpDateData( inData );
				HIViewSetNeedsDisplay( inData.view, true );
			end
      else
				Result := errDataSizeMismatch;

		kControlCalendarDrawProcTag:
			if sz = sizeof( CalendarDrawProc) then
				inData.drawProc := CalendarDrawProc(ptr^)
			else
				Result := errDataSizeMismatch;

		kControlCalendarLabelProcTag:
			if sz = sizeof( CalendarDrawProc) then
				inData.labelProc := CalendarDrawProc(ptr^)
			else
				Result := errDataSizeMismatch;
	else
	  Result := errDataNotSupported;
	end;

  if (Result = noErr) and (inData.view<>nil) then
    HIViewSetNeedsDisplay(inData.view, true);
end;


// -----------------------------------------------------------------------------
//	CalendarViewGetRegion
// -----------------------------------------------------------------------------
//

function CalendarViewGetRegion(inEvent: EventRef; const inData : CalendarViewData): OSStatus;
var
	part     : ControlPartCode;
  outShape : HIShapeRef;
  bounds   : HIRect;
begin
	Result := GetEventParameter( inEvent, kEventParamControlPart, typeControlPartCode, nil, sizeof( ControlPartCode ), nil, @part );
	if Result <> noErr then Exit;

  HIViewGetBounds(inData.view, bounds{%H-});
  outShape:=HIShapeCreateWithRect(bounds);
  Result := SetEventParameter(inEvent, kEventParamShape, typeHIShapeRef, sizeof(HIShapeRef), @outShape);
  CFRelease(outShape);
end;

// -----------------------------------------------------------------------------
//	CalendarViewHandler
// -----------------------------------------------------------------------------
//	This is the bottleneck for incoming events

function CalendarViewHandler(	inCallRef : EventHandlerCallRef;
  inEvent : EventRef; inUserData : Pointer): OSStatus; mwpascal;
var
	err : OSStatus;
	eventClass : UInt32;
	eventKind  : UInt32;
	data       : CalendarViewDataPtr;
begin
	err := eventNotHandledErr;
  eventClass := GetEventClass( inEvent );
	eventKind := GetEventKind( inEvent );
	data := CalendarViewDataPtr(inUserData);


	case ( eventClass ) of
		kEventClassHIObject:
			case eventKind of
				kEventHIObjectConstruct: 	err := CalendarViewConstruct( inEvent );
				kEventHIObjectInitialize: err := CalendarViewInitialize( inCallRef, inEvent, data^ );
				kEventHIObjectDestruct:  	err := CalendarViewDestruct( inEvent, data ); // don't CallNextEventHandler!
			end;
		kEventClassControl:
			case eventKind of
				kEventControlInitialize:	err := noErr;
				kEventControlDraw:        err := CalendarViewDraw( inEvent, data^ );
				kEventControlHitTest:	    err := CalendarViewHitTest( inEvent, data^ );
				kEventControlTrack:  			err := CalendarViewTrack( inEvent, data^ );
				kEventControlValueFieldChanged,
				kEventControlHiliteChanged:	err := CalendarViewChanged( inEvent, data^ );
				kEventControlGetData:     	err := CalendarViewGetData( inEvent, data^ );
				kEventControlSetData:			  err := CalendarViewSetData( inEvent, data^ );
				kEventControlGetPartRegion: err := CalendarViewGetRegion( inEvent, data^ );
		 end;
	end;
	Result := err;
end;


// -----------------------------------------------------------------------------
//	CalendarViewRegister
// -----------------------------------------------------------------------------
//

var
  sCalendarViewClassRef : HIObjectClassRef = nil;

function CalendarViewRegister: OSStatus;
var
	err : OSStatus;
const
  eventList : array [0..11] of EventTypeSpec = (
    ( eventClass: kEventClassHIObject; eventKind: kEventHIObjectConstruct ),
    ( eventClass: kEventClassHIObject; eventKind: kEventHIObjectInitialize ),
		( eventClass: kEventClassHIObject; eventKind: kEventHIObjectDestruct ),
		( eventClass:	kEventClassControl;  eventKind: kEventControlInitialize ),
		( eventClass:	kEventClassControl;  eventKind: kEventControlDraw ),
		( eventClass:	kEventClassControl;  eventKind: kEventControlHitTest ),
		( eventClass:	kEventClassControl;  eventKind: kEventControlTrack ),
		( eventClass:	kEventClassControl;  eventKind: kEventControlValueFieldChanged ),
		( eventClass:	kEventClassControl;  eventKind: kEventControlHiliteChanged ),
		( eventClass:	kEventClassControl;  eventKind: kEventControlGetData ),
		( eventClass:	kEventClassControl;  eventKind: kEventControlSetData ),
		( eventClass:	kEventClassControl;  eventKind: kEventControlGetPartRegion )
  );
begin
  err := noErr;
	if not Assigned(sCalendarViewClassRef) then begin
		err := HIObjectRegisterSubclass(
			kCalendarViewClassID,		// class ID
			_kHIViewClassID,				// base class ID
			0,						          // option bits
			CalendarViewHandlerUPP,		// construct proc
			length( eventList ),
			@eventList,
			nil,						// construct data,
			@sCalendarViewClassRef );
	end;
	Result:=err;
end;

// -----------------------------------------------------------------------------
//	CalendarViewCreate
// -----------------------------------------------------------------------------
//

function CalendarViewCreate(inWindow : WindowRef; const inBounds : Rect; var outControl: ControlRef): OSStatus;
var
  root  : ControlRef;
  event : EventRef;
const
  BounName : PChar = 'Boun';
begin
  // Make sure this type of view is registered
  Result := CalendarViewRegister;
  if Result <> noErr then Exit;

  // Make the initialization event
  Result := CreateEvent(nil, kEventClassHIObject, kEventHIObjectInitialize, GetCurrentEventTime(), 0, event {%H-});
  if Result <> noErr then Exit;
  try
    // Set the bounds into the event
    Result := SetEventParameter( event, EventParamNamePtr(BounName)^, typeQDRectangle,	sizeof( Rect ), @inBounds );
    if Result <> noErr then Exit;

    Result := HIObjectCreate( kCalendarViewClassID, event, HIObjectRef(outControl) );
    if Result <> noErr then Exit;

    // Get the content root
    Result := GetRootControl( inWindow, root {%H-});
    if Result <> noErr then Exit;

    // - added -
    //HIViewFindByID(root, kHIViewWindowContentID, root);

    // And stick this view into it
    Result := HIViewAddSubview( root, outControl );
  finally
    ReleaseEvent(event);
  end;
end;

procedure InitGlobals;
begin
  kCalendarViewClassID := CFSTR('com.apple.CalendarView');
  _kHIViewClassID := CFSTR('com.apple.hiview');

  CalendarViewHandlerUPP := NewEventHandlerUPP(@CalendarViewHandler);
	months[0]  := CFSTR('January');
	months[1]  := CFSTR('February');
	months[2]  := CFSTR('March');
	months[3]  := CFSTR('April');
	months[4]  := CFSTR('May');
	months[5]  := CFSTR('June');
	months[6]  := CFSTR('July');
	months[7]  := CFSTR('August');
	months[8]  := CFSTR('September');
	months[9]  := CFSTR('October');
	months[10] := CFSTR('November');
	months[11] := CFSTR('December');

  dow[0] := CFSTR('Su');
  dow[1] := CFSTR('Mo');
  dow[2] := CFSTR('Tu');
  dow[3] := CFSTR('We');
  dow[4] := CFSTR('Th');
  dow[5] := CFSTR('Fr');
  dow[6] := CFSTR('Sa');
end;

procedure ReleaseGlobals;
begin
  DisposeEventHandlerUPP(CalendarViewHandlerUPP);
end;

function isValidCalendarControl(Calendar: ControlRef): Boolean;
begin
  Result := Assigned(Calendar) and HIObjectIsOfClass(HIObjectRef(Calendar), kCalendarViewClassID);
end;

function CalendarGetDate(Calendar: ControlRef; var Date: CFGregorianDate): Boolean;
begin
  Result := isValidCalendarControl(Calendar);
  if not Result then Exit;
  Result := GetControlData(Calendar, kControlEntireControl,
    kControlCalendarDateTag, sizeof(Date), @Date, nil) = noErr;
end;

function CalendarSetDate(Calendar: ControlRef; const Date: CFGregorianDate): Boolean;
begin
  Result := isValidCalendarControl(Calendar);
  if not Result then Exit;
  Result := SetControlData(Calendar, kControlEntireControl, kControlCalendarDateTag, sizeof(Date), @Date) = noErr;
end;


initialization
  InitGlobals;

finalization
  ReleaseGlobals;

end.

