You've already forked lazarus-ccr
CalLite: Add event OnMonthChange.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5340 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -495,6 +495,14 @@ object Form1: TForm1
|
|||||||
TabOrder = 13
|
TabOrder = 13
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 15
|
||||||
|
Height = 15
|
||||||
|
Top = 818
|
||||||
|
Width = 34
|
||||||
|
Caption = 'Label1'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
object FontDialog: TFontDialog
|
object FontDialog: TFontDialog
|
||||||
MinFontSize = 0
|
MinFontSize = 0
|
||||||
MaxFontSize = 0
|
MaxFontSize = 0
|
||||||
|
@ -37,6 +37,7 @@ type
|
|||||||
FontDialog: TFontDialog;
|
FontDialog: TFontDialog;
|
||||||
GroupBox1: TGroupBox;
|
GroupBox1: TGroupBox;
|
||||||
ImageList1: TImageList;
|
ImageList1: TImageList;
|
||||||
|
Label1: TLabel;
|
||||||
Label10: TLabel;
|
Label10: TLabel;
|
||||||
Label11: TLabel;
|
Label11: TLabel;
|
||||||
Label12: TLabel;
|
Label12: TLabel;
|
||||||
@ -76,7 +77,8 @@ type
|
|||||||
private
|
private
|
||||||
copyCal, demoCal: TCalendarLite;
|
copyCal, demoCal: TCalendarLite;
|
||||||
FNoHolidays: boolean;
|
FNoHolidays: boolean;
|
||||||
procedure RespondToDateChange(Sender: tObject);
|
procedure RespondToDateChange(Sender: TObject);
|
||||||
|
procedure RespondToMonthChange(Sender: TObject);
|
||||||
procedure GetDayText(Sender: TObject; AYear, AMonth, ADay: Word; var AText: String);
|
procedure GetDayText(Sender: TObject; AYear, AMonth, ADay: Word; var AText: String);
|
||||||
procedure GetHintText(Sender: TObject; AYear, AMonth, ADay: Word; var AText: String);
|
procedure GetHintText(Sender: TObject; AYear, AMonth, ADay: Word; var AText: String);
|
||||||
procedure GetHolidays(Sender: TObject; AMonth, AYear: Integer; // wp
|
procedure GetHolidays(Sender: TObject; AMonth, AYear: Integer; // wp
|
||||||
@ -96,6 +98,8 @@ implementation
|
|||||||
|
|
||||||
{$R *.lfm}
|
{$R *.lfm}
|
||||||
|
|
||||||
|
uses
|
||||||
|
DateUtils;
|
||||||
|
|
||||||
function Easter(year:integer) : TDateTime; // wp
|
function Easter(year:integer) : TDateTime; // wp
|
||||||
var
|
var
|
||||||
@ -139,6 +143,7 @@ begin
|
|||||||
demoCal.Height := seHeight.Value;
|
demoCal.Height := seHeight.Value;
|
||||||
demoCal.OnGetHolidays := @GetHolidays;
|
demoCal.OnGetHolidays := @GetHolidays;
|
||||||
demoCal.OnDateChange:= @RespondToDateChange;
|
demoCal.OnDateChange:= @RespondToDateChange;
|
||||||
|
demoCal.OnMonthChange := @RespondToMonthChange;
|
||||||
demoCal.OnHint := @GetHintText;
|
demoCal.OnHint := @GetHintText;
|
||||||
demoCal.ShowHint := true;
|
demoCal.ShowHint := true;
|
||||||
demoCal.Hint := 'Calendar';
|
demoCal.Hint := 'Calendar';
|
||||||
@ -306,7 +311,11 @@ begin
|
|||||||
SelDateListbox.Clear;
|
SelDateListbox.Clear;
|
||||||
for i:=0 to High(s) do
|
for i:=0 to High(s) do
|
||||||
SelDateListbox.Items.Add(DateToStr(s[i]));
|
SelDateListbox.Items.Add(DateToStr(s[i]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.RespondToMonthChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Label1.Caption := 'Month changed to ' + demoCal.GetMonthName(MonthOf(democal.Date));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm1.GetDayText(Sender: TObject; AYear, AMonth, ADay: Word;
|
procedure TForm1.GetDayText(Sender: TObject; AYear, AMonth, ADay: Word;
|
||||||
|
@ -249,6 +249,7 @@ type
|
|||||||
FDisplayTexts: TStringList;
|
FDisplayTexts: TStringList;
|
||||||
FMonthNames: TStringList;
|
FMonthNames: TStringList;
|
||||||
FOnDateChange: TNotifyEvent;
|
FOnDateChange: TNotifyEvent;
|
||||||
|
FOnMonthChange: TNotifyEvent;
|
||||||
FOnGetDayText: TCalGetDayTextEvent;
|
FOnGetDayText: TCalGetDayTextEvent;
|
||||||
FOnDrawCell: TCalDrawCellEvent;
|
FOnDrawCell: TCalDrawCellEvent;
|
||||||
FOnGetHolidays: TGetHolidaysEvent;
|
FOnGetHolidays: TGetHolidaysEvent;
|
||||||
@ -264,9 +265,9 @@ type
|
|||||||
FMultiSelect: Boolean;
|
FMultiSelect: Boolean;
|
||||||
FSelDates: TCalDateList;
|
FSelDates: TCalDateList;
|
||||||
FLanguage: TLanguage; //Ariel Rodriguez 12/09/2013
|
FLanguage: TLanguage; //Ariel Rodriguez 12/09/2013
|
||||||
procedure DateChange;
|
|
||||||
function GetDayNames: String;
|
function GetDayNames: String;
|
||||||
function GetDisplaytexts: String;
|
function GetDisplayText(aTextIndex: TDisplayText): String;
|
||||||
|
function GetDisplayTexts: String;
|
||||||
function GetMonthNames: String;
|
function GetMonthNames: String;
|
||||||
procedure HolidayMenuItemClicked(Sender: TObject);
|
procedure HolidayMenuItemClicked(Sender: TObject);
|
||||||
procedure MonthMenuItemClicked(Sender: TObject);
|
procedure MonthMenuItemClicked(Sender: TObject);
|
||||||
@ -287,11 +288,10 @@ type
|
|||||||
|
|
||||||
protected
|
protected
|
||||||
procedure ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
|
procedure ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
|
||||||
|
procedure DateChange; virtual;
|
||||||
class function GetControlClassDefaultSize: TSize; override;
|
class function GetControlClassDefaultSize: TSize; override;
|
||||||
function GetDayName(ADayOfWeek: TDayOfWeek): String;
|
|
||||||
function GetDisplayText(aTextIndex: TDisplayText): String;
|
|
||||||
function GetMonthName(AMonth: Integer): String;
|
|
||||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||||
|
procedure MonthChange; virtual;
|
||||||
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
||||||
procedure MouseEnter; override;
|
procedure MouseEnter; override;
|
||||||
procedure MouseLeave; override;
|
procedure MouseLeave; override;
|
||||||
@ -308,6 +308,9 @@ type
|
|||||||
constructor Create(anOwner: TComponent); override;
|
constructor Create(anOwner: TComponent); override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
function GetDayName(ADayOfWeek: TDayOfWeek): String;
|
||||||
|
function GetMonthName(AMonth: Integer): String;
|
||||||
|
|
||||||
function IsSelected(ADate: TDate): Boolean;
|
function IsSelected(ADate: TDate): Boolean;
|
||||||
function SelectedDates: TCalDateArray;
|
function SelectedDates: TCalDateArray;
|
||||||
|
|
||||||
@ -378,6 +381,7 @@ type
|
|||||||
property OnGetDayText: TCalGetDayTextEvent read FOnGetDayText write FOnGetDayText;
|
property OnGetDayText: TCalGetDayTextEvent read FOnGetDayText write FOnGetDayText;
|
||||||
property OnGetHolidays: TGetHolidaysEvent read FOnGetHolidays write FOnGetHolidays;
|
property OnGetHolidays: TGetHolidaysEvent read FOnGetHolidays write FOnGetHolidays;
|
||||||
property OnHint: TCalGetDayTextEvent read FOnHint write FOnHint;
|
property OnHint: TCalGetDayTextEvent read FOnHint write FOnHint;
|
||||||
|
property OnMonthChange: TNotifyEvent read FOnMonthChange write FOnMonthChange;
|
||||||
property OnPrepareCanvas: TCalPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
|
property OnPrepareCanvas: TCalPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1308,7 +1312,9 @@ end;
|
|||||||
procedure TCalendarLite.ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
|
procedure TCalendarLite.ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
|
||||||
var
|
var
|
||||||
d, d1, d2: TDate;
|
d, d1, d2: TDate;
|
||||||
|
oldMonth: Integer;
|
||||||
begin
|
begin
|
||||||
|
oldMonth := MonthOf(FDate);
|
||||||
FDate := ADate;
|
FDate := ADate;
|
||||||
|
|
||||||
case ASelMode of
|
case ASelMode of
|
||||||
@ -1351,6 +1357,8 @@ begin
|
|||||||
|
|
||||||
FPrevDate := ADate;
|
FPrevDate := ADate;
|
||||||
DateChange;
|
DateChange;
|
||||||
|
if MonthOf(FDate) <> oldMonth then
|
||||||
|
MonthChange;
|
||||||
with FCalDrawer do begin
|
with FCalDrawer do begin
|
||||||
FCanvas.Brush.Color := Colors.BackgroundColor;
|
FCanvas.Brush.Color := Colors.BackgroundColor;
|
||||||
FCanvas.FillRect(FBoundsRect);
|
FCanvas.FillRect(FBoundsRect);
|
||||||
@ -1449,6 +1457,12 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCalendarLite.MonthChange;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnMonthChange) then
|
||||||
|
FOnMonthChange(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCalendarLite.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
procedure TCalendarLite.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||||
X, Y: Integer);
|
X, Y: Integer);
|
||||||
begin
|
begin
|
||||||
@ -1657,12 +1671,17 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
procedure TCalendarLite.SetDate(AValue: TDateTime);
|
procedure TCalendarLite.SetDate(AValue: TDateTime);
|
||||||
|
var
|
||||||
|
oldMonth: Integer;
|
||||||
begin
|
begin
|
||||||
if FDate = AValue then Exit;
|
if FDate = AValue then Exit;
|
||||||
|
oldMonth := MonthOf(FDate);
|
||||||
FDate := AValue;
|
FDate := AValue;
|
||||||
FPrevDate := AValue;
|
FPrevDate := AValue;
|
||||||
FSelDates.Clear;
|
FSelDates.Clear;
|
||||||
DateChange;
|
DateChange;
|
||||||
|
if MonthOf(FDate) <> oldMonth then
|
||||||
|
MonthChange;
|
||||||
Invalidate;
|
Invalidate;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user