diff --git a/components/callite/demo2/testCalLite.lpi b/components/callite/demo2/testCalLite.lpi
index f0851d414..186e2781c 100644
--- a/components/callite/demo2/testCalLite.lpi
+++ b/components/callite/demo2/testCalLite.lpi
@@ -73,11 +73,6 @@
-
-
-
-
-
diff --git a/components/callite/demo2/umaintestcallite.pp b/components/callite/demo2/umaintestcallite.pp
index dbf7320e7..40b57126d 100644
--- a/components/callite/demo2/umaintestcallite.pp
+++ b/components/callite/demo2/umaintestcallite.pp
@@ -70,6 +70,7 @@ type
copyCal, demoCal: TCalendarLite;
FNoHolidays: boolean;
procedure RespondToDateChange(Sender: tObject);
+ procedure GetHint(Sender: TObject; AYear, AMonth, ADay: Word; out AHintText: String);
procedure GetHolidays(Sender: TObject; AMonth, AYear: Integer; // wp
var Holidays: THolidays);
procedure PrepareCanvas(Sender: TObject; AYear, AMonth, ADay: Word;
@@ -120,7 +121,8 @@ end;
procedure TForm1.FormCreate(Sender: TObject);
-var opt: TCalOption;
+var
+ opt: TCalOption;
begin
demoCal:= TCalendarLite.Create(Self);
demoCal.Parent:= Self;
@@ -130,6 +132,9 @@ begin
demoCal.Height := seHeight.Value;
demoCal.OnGetHolidays := @GetHolidays;
demoCal.OnDateChange:= @RespondToDateChange;
+ demoCal.OnHint := @GetHint;
+ demoCal.ShowHint := true;
+ demoCal.Hint := 'Calendar';
if CbPrepareCanvas.Checked then
demoCal.OnPrepareCanvas := @PrepareCanvas else
demoCal.OnPrepareCanvas := nil;
@@ -267,7 +272,24 @@ begin
copyCal.Date:= TCalendarLite(Sender).Date;
end;
-// wp
+procedure TForm1.GetHint(Sender: TObject; AYear, AMonth, ADay: Word;
+ out AHintText: String);
+var
+ dt, e: TDate;
+begin
+ case AMonth of
+ 1: if ADay = 1 then AHintText := 'New Year';
+ 12: if ADay = 25 then AHintText := 'Christmas';
+ else
+ e := Easter(AYear);
+ dt := EncodeDate(AYear, AMonth, ADay);
+ if (dt = e) then
+ AHintText := 'Easter'
+ else if (dt = e + 49) then
+ AHintText := 'Whit Sunday';
+ end;
+end;
+
procedure TForm1.GetHolidays(Sender: TObject; AMonth, AYear: Integer;
var Holidays: THolidays);
var
diff --git a/components/callite/source/calendarlite.pas b/components/callite/source/calendarlite.pas
index 53fb3e628..28d5abeb6 100644
--- a/components/callite/source/calendarlite.pas
+++ b/components/callite/source/calendarlite.pas
@@ -110,6 +110,9 @@ type
AState: TCalCellStates; ARect: TRect; ACanvas: TCanvas;
var AContinueDrawing: Boolean) of object;
+ TCalHintEvent = procedure (Sender: TObject; AYear, AMonth, ADay: Word;
+ out AHintText: String) of object;
+
TCalOption = (coBoldDayNames, coBoldHolidays, coBoldToday, coBoldTopRow,
coBoldWeekend, coDayLine, coShowBorder, coShowHolidays,
coShowTodayFrame, coShowTodayName, coShowTodayRow,
@@ -118,7 +121,6 @@ type
TLanguage = (lgEnglish, lgFrench, lgGerman, lgHebrew, lgSpanish); //Ariel Rodriguez 12/09/2013
-
{ TCalDrawer }
TCalDrawer = class
@@ -144,6 +146,7 @@ type
function GetCellAt(aPoint: TPoint): TSize;
function GetCellAtColRow(aCol, aRow: integer): TRect;
function GetColRowPosition(aCol, aRow: integer): TSize;
+ function GetDateOfCell(ACell: TSize): TDate;
function GetLeftColIndex: Integer;
procedure GetMonthYearRects(var AMonthRect, AYearRect: TRect);
function GetRightColIndex: Integer;
@@ -200,11 +203,14 @@ type
FOnDateChange: TNotifyEvent;
FOnDrawCell: TCalDrawCellEvent;
FOnGetHolidays: TGetHolidaysEvent;
+ FOnHint: TCalHintEvent;
FOnPrepareCanvas: TCalPrepareCanvasEvent;
FOptions: TCalOptions;
FPopupMenu: TPopupMenu;
FStartingDayOfWeek: TDayOfWeek;
FWeekendDays: TDaysOfWeek;
+ FPrevMouseDate: TDate;
+ FSavedHint: String;
FLanguage: TLanguage; //Ariel Rodriguez 12/09/2013
procedure DateChange;
function GetDayNames: String;
@@ -233,8 +239,16 @@ type
function GetMonthName(AMonth: Integer): String;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
+ procedure MouseEnter; override;
+ procedure MouseLeave; override;
+ procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
+
procedure Paint; override;
+ { Hints }
+ procedure ShowHintWindow(APoint: TPoint; ADate: TDate);
+ procedure HideHintWindow;
+
public
constructor Create(anOwner: TComponent); override;
destructor Destroy; override;
@@ -303,6 +317,7 @@ type
property OnDateChange: TNotifyEvent read FOnDateChange write FOnDateChange;
property OnDrawCell: TCalDrawCellEvent read FOnDrawCell write FOnDrawCell;
property OnGetHolidays: TGetHolidaysEvent read FOnGetHolidays write FOnGetHolidays;
+ property OnHint: TCalHintEvent read FOnHint write FOnHint;
property OnPrepareCanvas: TCalPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
end;
@@ -877,6 +892,18 @@ begin
Result.cx:= FColPositions[aCol];
end;
+function TCalDrawer.GetDateOfCell(ACell: TSize): TDate;
+var
+ diff: Integer;
+begin
+ if (ACell.cy > 1) and (ACell.cy < 8) then
+ begin
+ diff := ACell.cx + LastCol * (ACell.cy - 2);
+ Result := FStartDate + diff - 1;
+ end else
+ Result := 0;
+end;
+
function TCalDrawer.GetLeftColIndex: Integer;
begin
if FOwner.BiDiMode = bdLeftToRight then
@@ -1061,6 +1088,7 @@ begin
FOptions := [coShowTodayFrame, coBoldHolidays, coShowWeekend, coShowHolidays,
coShowTodayRow];
FLanguage := lgEnglish; //Ariel Rodriguez 12/09/2013
+ FPrevMouseDate := 0;
end;
destructor TCalendarLite.Destroy;
@@ -1166,6 +1194,39 @@ begin
end;
end;
+procedure TCalendarLite.MouseEnter;
+begin
+ FSavedHint := Hint;
+end;
+
+procedure TCalendarLite.MouseLeave;
+begin
+ HideHintWindow;
+ FPrevMouseDate := 0;
+end;
+
+procedure TCalendarLite.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+ c: TSize;
+ dt: TDate;
+begin
+ inherited MouseMove(Shift, X, Y);
+
+ if ShowHint and Assigned(FCalDrawer) then
+ begin
+ c := FCalDrawer.GetCellAt(Point(X,Y));
+ dt := FCalDrawer.GetDateOfCell(c);
+ if (dt > 0) and (dt <> FPrevMouseDate) then begin
+ HideHintWindow;
+ ShowHintWindow(Point(X, Y), dt);
+ end else
+ if (dt = 0) then
+ HideHintWindow;
+ FPrevMouseDate := dt;
+ end;
+end;
+
+
procedure TCalendarLite.MonthMenuItemClicked(Sender: TObject);
begin
FCalDrawer.GotoMonth(TMenuItem(Sender).Tag);
@@ -1406,6 +1467,41 @@ begin
FCalDrawer.GotoYear(TMenuItem(Sender).Tag);
end;
+{ Hints }
+
+procedure TCalendarLite.ShowHintWindow(APoint: TPoint; ADate: TDate);
+const
+ MAX_HINT_WIDTH = 300;
+var
+ txt: String;
+ y, m, d: Word;
+ R: TRect;
+begin
+ if Assigned(FOnHint) then begin
+ DecodeDate(ADate, y, m, d);
+ FOnHint(Self, y, m, d, txt);
+ if Hint <> '' then begin
+ if txt = '' then txt := Hint else txt := Hint + LineEnding + txt;
+ end;
+ end else
+ txt := Hint;
+
+ if txt = '' then
+ exit;
+
+ APoint := ClientToScreen(APoint);
+ Hint := txt;
+ Application.Hint := txt;
+ Application.ActivateHint(APoint);
+end;
+
+procedure TCalendarLite.HideHintWindow;
+begin
+ Hint := FSavedHint;
+ Application.CancelHint;
+end;
+
+
//Ariel Rodriguez 12/09/2013
procedure Register;
begin