Brian S wrote:

> I like the idea of using this control (_kControlClockDateProc) to 
> collect a date from a user. It has all the edits built-in and it is 
> simple to retrieve and set the date in the control. However, only 
> years on or after 1904 and prior to/including  2039 are selectable.


Here's a starter... It has a few limitations which I'm sure are 
overcomeable (!)

Everyone: please feel free to improve/correct the code.

N.B. Watch out for missing underscores and other nasties.


'----------
'~'A
'                       Runtime : Rntm Appearance.Incl
'                           CPU : Carbon
'                    CALL Req'd : Off
'~'B

/*

ClockDateControl_2041

Here's an attempt at persuading the editable variety of the ClockDate 
control
to accept dates outside the range 1 Jan, 1904 - 6 Feb, 2040.


LIMITATIONS:

1. Because I've used _kEventControlClick, the window containing the 
control needs _kWindowStandardHandlerAttribute.
2. Unfortunately, this version uses one too many globals (gMouseDelay).
3. Could do with a carbon timer in place of on timer event (maybe this 
would eliminate the global).
4. ...


Bernie Wylde   7 December 2004

*/

include "Tlbx HIView.Incl"
'~'<
_Window1Wnd = 1
_theDate = 1

begin enum 9
_kControlClockHourDayPart
_kControlClockMinuteMonthPart
_kControlClockSecondYearPart
_
_kControlClockUpArrowPart// made up constant name - bw
_kControlClockDownArrowPart// made up constant name - bw
end enum

begin enum 1
_jan
_feb
_mar
_apr
_may
_jun
_jul
_aug
_sep
_oct
_nov
_dec
end enum

begin globals
dim as short gMouseDelay
end globals

'~'1

local fn HIRectToRect(hiRect as ^HIRect)
dim as Rect r

r.left   = hiRect.origin.x
r.top    = hiRect.origin.y
r.right  = r.left + hiRect.size.width
r.bottom = r.top + hiRect.size.height
end fn = r

local fn IsValidDay(longDate as ^LongDateRec)
dim as Boolean bool

bool = _zTrue
if ((longDate.day < 1) or (longDate.day > 31)) then bool = _false : 
exit fn
select longDate.month
case _feb
if (longDate.day > 29) then bool = _false : exit case
long if (longDate.day == 29)
long if ((longDate.year mod 100 == 0) and (longDate.year mod 400))
bool = _false
xelse
if (longDate.year mod 4) then bool = _false
end if
end if
case _apr, _jun, _sep, _nov
if (longDate.day > 30) then bool = _false
end select
end fn = bool

local fn DateKey(btnNum as long, num as short)
dim as Str15            y
dim as LongDateRec    @ longDate
dim as HIViewPartCode @ partCode
dim as long           @ actual
dim as OSStatus         ignore
dim as Boolean          bool

bool = _false
def GetButtonData(btnNum, _kControlEditTextPart, 
_kControlClockLongDateTag, SizeOf(LongDateRec), @longDate, actual)
ignore = fn HIViewGetFocusPart(button&(btnNum), partCode)
select partCode
case _kControlClockHourDayPart
select longDate.day
'~'<
case 1
longDate.day = 10 + num
bool = _zTrue
'~'<
case 2
longDate.day = 20 + num
bool = fn IsValidDay(longDate)
'~'<
case 3
longDate.day = 30 + num
bool = fn IsValidDay(longDate)
end select

long if (bool == _false)
if num then longDate.day = num
end if
'~'<
case _kControlClockMinuteMonthPart
long if ((longDate.month == 1) and ((num >= 0) and (num <= 2)))
longDate.month = 10 + num
xelse
if (num) then longDate.month = num
end if

select longDate.month
case _feb
if (fn IsValidDay(longDate) == _false) then longDate.day = 29
if (fn IsValidDay(longDate) == _false) then longDate.day = 28
case _apr, _jun, _sep, _nov
if (fn IsValidDay(longDate) == _false) then longDate.day = 30
end select
'~'<
case _kControlClockSecondYearPart
y = mid$(str$(longDate.year), 2)
if (longDate.year < 1000) then y = "0" + y
if (longDate.year < 100) then y = "0" + y
if (longDate.year < 10) then y = "0" + y
y = mid$(y, 2) + mid$(str$(num), 2)
longDate.year = val(y)

long if (longDate.month == _feb)
if (fn IsValidDay(longDate) == _false) then longDate.day = 28
end if
end select
'~'<
def SetButtonData(btnNum, _kControlEditTextPart, 
_kControlClockLongDateTag, SizeOf(LongDateRec), @longDate)
end fn

local fn DateArrows(btnNum as long, dir as short)
dim as LongDateRec    @ longDate
dim as HIViewPartCode @ partCode
dim as long           @ actual
dim as OSStatus         ignore

def GetButtonData(btnNum, _kControlEditTextPart, 
_kControlClockLongDateTag, SizeOf(LongDateRec), @longDate, actual)
ignore = fn HIViewGetFocusPart(button&(btnNum), partCode)
select partCode
'~'<
case _kControlClockHourDayPart
longdate.day += dir
long if (fn IsValidDay(longDate) == _false)
long if (dir > 0)
longDate.day = 1
xelse
select longDate.month
case _feb
longDate.day = 29
if (fn IsValidDay(longDate) == _false) then longDate.day = 28
case _apr, _jun, _sep, _nov
longDate.day = 30
case else
longDate.day = 31
end select
end if
end if
'~'<
case _kControlClockMinuteMonthPart
longDate.month += dir
if (longDate.month > 12) then longDate.month = 1
if (longDate.month < 1) then longDate.month = 12

select longDate.month
case _feb
if (fn IsValidDay(longDate) == _false) then longDate.day = 29
if (fn IsValidDay(longDate) == _false) then longDate.day = 28

case _apr, _jun, _sep, _nov
if (fn IsValidDay(longDate) == _false) then longDate.day = 30
end select
'~'<
case _kControlClockSecondYearPart
longDate.year += dir
long if (longDate.month == _feb)
if (fn IsValidDay(longDate) == _false) then longDate.day = 28
end if
end select
'~'<
def SetButtonData(btnNum, _kControlEditTextPart, 
_kControlClockLongDateTag, SizeOf(LongDateRec), @longDate)
end fn

'~'1

local mode
local fn AddEventToHandle(eventClass as UInt32, eventKind as UInt32, h 
as Handle)
dim as EventTypeSpec evnt

evnt.eventClass = eventClass
evnt.eventKind  = eventKind
end fn = fn PtrAndHand(evnt, h, SizeOf(EventTypeSpec))

local fn InstallWindowEvents(w as WindowRef)
dim as Handle   eventH
dim as OSStatus ignore
begin globals
dim as Ptr sWindowEventHandlerUPP
end globals

long if (sWindowEventHandlerUPP == 0)
sWindowEventHandlerUPP = fn NewEventHandlerUPP([proc 
"WindowEventHandler" + _FBprocToProcPtrOffset])
end if
eventH = fn NewHandle(0)
long if (eventH)
'~'<
fn AddEventToHandle(_kEventClassMouse, _kMouseTrackingMouseUp,   eventH)
fn AddEventToHandle(_kEventClassMouse, _kMouseTrackingMouseDown, eventH)
'~'<
ignore = fn InstallEventHandler(fn GetWindowEventTarget(w), 
sWindowEventHandlerUPP, ¬
                                 fn 
GetHandleSize(eventH)\\(SizeOf(EventTypeSpec)), #[eventH], #0, #0)
DisposeHandle(eventH)
end if
end fn

local fn InstallControlEvents(c as ControlRef)
dim as Handle   eventH
dim as OSStatus ignore
begin globals
dim as Ptr sControlEventHandlerUPP
end globals

long if (sControlEventHandlerUPP == 0)
sControlEventHandlerUPP = fn NewEventHandlerUPP([proc 
"ControlEventHandler" + _FBprocToProcPtrOffset])
end if
eventH = fn NewHandle(0)
long if eventH
'~'<
fn AddEventToHandle(_kEventClassControl,  _kEventControlClick, eventH)
fn AddEventToHandle(_kEventClassControl,  _kEventControlHit,   eventH)
fn AddEventToHandle(_kEventClassKeyboard, _kEventRawKeyDown,   eventH)
fn AddEventToHandle(_kEventClassKeyboard, _kEventRawKeyRepeat, eventH)
'~'<
ignore = fn InstallEventHandler(fn GetControlEventTarget(c), 
sControlEventHandlerUPP, ¬
                                 fn 
GetHandleSize(eventH)\\(SizeOf(EventTypeSpec)), #[eventH], #0, #0)
DisposeHandle(eventH)
end if
end fn

long if 0
"ControlEventHandler"
enterproc fn ControlEventHandler(handler as EventHandlerCallRef, evnt 
as EventRef, userData as Ptr) = OSStatus
dim as LongDateRec    @ longDate
dim as Rect             r
dim as HIRect         @ hiRect
dim as HIPoint        @ hiPoint
dim as point          @ pt
dim as HIViewPartCode @ partCode
dim as ControlRef     @ c, focusCtrl
dim as UInt32           eventClass, eventKind
dim as long             result
dim as long           @ actual
dim as short            dir
dim as char           @ ch
dim as OSStatus         ignore

result = _EventNotHandledErr
eventClass = fn GetEventClass(evnt)
eventKind  = fn GetEventKind(evnt)
ignore = fn GetEventParameter(evnt, _kEventParamDirectObject, 
_TypeControlRef, #0, SizeOf(ControlRef), #0, @c)
select eventClass
'~'<
case _kEventClassControl
select eventKind
case _kEventControlClick
fn HIViewGetBounds(c, hiRect)
r = fn HIRectToRect(hiRect)
ignore = fn GetEventParameter(evnt, _kEventParamMouseLocation, 
_typeHIPoint, #0, SizeOf(HIPoint), #0, hiPoint)
pt.h = hiPoint.x
pt.v = hiPoint.y
GlobalToLocal(pt)

c = fn FindControlUnderMouse(pt, window(_wndRef), partCode)
HiliteControl(c, partCode)
select partCode
case _kControlClockHourDayPart, _kControlClockMinuteMonthPart, 
_kControlClockSecondYearPart
ignore = fn SetKeyboardFocus(window(_wndRef), c, partCode)

case _kControlClockUpArrowPart, _kControlClockDownArrowPart
if partCode == _kControlClockUpArrowPart then dir = 1 else dir = -1
gMouseDelay  = 5
fn DateArrows(usr Handle2Btn(c), dir)
result = _noErr
end select
'~'<
case _kEventControlHit
result = _noErr
end select
'~'<
case _kEventClassKeyboard
select eventKind
case _kEventRawKeyDown, _kEventRawKeyRepeat
ignore = fn GetEventParameter(evnt, _kEventParamKeyMacCharCodes, 
_typeChar, #0, SizeOf(char), #0, ch)
fn GetKeyboardFocus(window(_wndRef), focusCtrl)
select
case (ch >= _"0") and (ch <= _"9")
fn DateKey(usr Handle2Btn(focusCtrl), ch - 48)
result = _noErr
case (ch == _fbUpArrowKey)
fn DateArrows(usr Handle2Btn(focusCtrl), 1)
result = _noErr
case (ch == _fbDownArrowKey)
fn DateArrows(usr Handle2Btn(focusCtrl), -1)
result = _noErr
end select
end select
'~'<
end select
exitproc = result
end If

long if 0
"WindowEventHandler"
enterproc fn WindowEventHandler(handler as EventHandlerCallRef, evnt as 
EventRef, userData as Ptr) = OSStatus
dim as HIPoint         @ hiPoint
dim as Point           @ pt
dim as ControlRef      @ c
dim as UInt32            eventClass, eventKind
dim as ControlPartCode @ partCode
dim as long              result
dim as OSStatus          ignore

result = _EventNotHandledErr
eventClass = fn GetEventClass(evnt)
eventKind  = fn GetEventKind(evnt)
select eventClass
'~'<
case _kEventClassMouse
ignore = fn GetEventParameter(evnt, _kEventParamMouseLocation, 
_typeHIPoint, #0, SizeOf(HIPoint), #0, hiPoint)
pt.h = hiPoint.x
pt.v = hiPoint.y
GlobalToLocal(pt)
c = fn FindControlUnderMouse(pt, window(_wndRef), partCode)
select eventKind
case _kMouseTrackingMouseUp   : if (c) then HiliteControl(c, 0)
case _kMouseTrackingMouseDown : if (c == 0) then fn ClearAnyFocus
end select
'~'<
end select
exitproc = result
end If

'~'1

local fn BuildWindow1Wnd
dim as Rect r

SetRect(r, 0, 0, 350, 150)
appearance window -_Window1Wnd, "Pick a date... any date", @r, 
_kDocumentWindowClass, _kWindowStandardHandlerAttribute
def SetWindowBackground(_kThemeActiveDialogBackgroundBrush, _zTrue)
fn InstallWindowEvents(window(_wndRef))
'~'<
SetRect(r, 123, 65, 226, 88)
appearance button _theDate, _activeBtn, _kControlClockNoFlags,,,, @r, 
_kControlClockDateProc
fn InstallControlEvents(button&(_theDate))
'~'<
appearance window _Window1Wnd
end fn

local fn DoTimer
dim ev               as ^EventRecord
dim as Point           @ pt
dim as ControlPartCode @ partCode
dim as ControlRef        c
dim as short             dir

long if fn StillDown
ev = event
pt = ev.where
GlobalToLocal(pt)
c = fn FindControlUnderMouse(pt, window(_wndRef), partCode)
long if c
select partCode
case _kControlClockUpArrowPart   : dir = 1
case _kControlClockDownArrowPart : dir = -1
end select
gMouseDelay--
if (gMouseDelay < 0) then fn DateArrows(usr Handle2Btn(c), dir)
end if
end if
end fn

fn BuildWindow1Wnd

on timer(-6) fn DoTimer

do
HandleEvents
until gFBQuit











// Extra line spaces courtesy the FB4 Editor


'----------