CalLite: Add Hint support for individual days.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5333 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/callite/demo2/testCalLite.lpi

@@ -73,11 +73,6 @@
         <DebugInfoType Value="dsDwarf2Set"/>
         <UseExternalDbgSyms Value="True"/>
       </Debugging>
-      <Options>
-        <Win32>
-          <GraphicApplication Value="True"/>
-        </Win32>
-      </Options>
     </Linking>
   </CompilerOptions>
   <Debugging>

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

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