You've already forked lazarus-ccr
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
This commit is contained in:
wp_xxyyzz
@ -73,11 +73,6 @@
|
||||
<DebugInfoType Value="dsDwarf2Set"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user