You've already forked lazarus-ccr
CalLite: Add MultiSelect support (ctrl: add single date, shift: add date range, alt: add week)
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5339 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -1,7 +1,7 @@
|
|||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<CONFIG>
|
<CONFIG>
|
||||||
<ProjectOptions>
|
<ProjectOptions>
|
||||||
<Version Value="9"/>
|
<Version Value="10"/>
|
||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<General>
|
<General>
|
||||||
<SessionStorage Value="InProjectDir"/>
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
@ -441,7 +441,7 @@ object Form1: TForm1
|
|||||||
object BtnFont: TButton
|
object BtnFont: TButton
|
||||||
Left = 560
|
Left = 560
|
||||||
Height = 25
|
Height = 25
|
||||||
Top = 272
|
Top = 8
|
||||||
Width = 75
|
Width = 75
|
||||||
Caption = 'Font...'
|
Caption = 'Font...'
|
||||||
OnClick = BtnFontClick
|
OnClick = BtnFontClick
|
||||||
@ -476,16 +476,34 @@ object Form1: TForm1
|
|||||||
State = cbChecked
|
State = cbChecked
|
||||||
TabOrder = 11
|
TabOrder = 11
|
||||||
end
|
end
|
||||||
|
object CbMultiSelect: TCheckBox
|
||||||
|
Left = 560
|
||||||
|
Height = 19
|
||||||
|
Top = 264
|
||||||
|
Width = 81
|
||||||
|
Caption = 'Multi select'
|
||||||
|
OnChange = CbMultiSelectChange
|
||||||
|
TabOrder = 12
|
||||||
|
end
|
||||||
|
object SelDateListbox: TListBox
|
||||||
|
Left = 560
|
||||||
|
Height = 104
|
||||||
|
Top = 288
|
||||||
|
Width = 168
|
||||||
|
Columns = 2
|
||||||
|
ItemHeight = 0
|
||||||
|
TabOrder = 13
|
||||||
|
end
|
||||||
end
|
end
|
||||||
object FontDialog: TFontDialog
|
object FontDialog: TFontDialog
|
||||||
MinFontSize = 0
|
MinFontSize = 0
|
||||||
MaxFontSize = 0
|
MaxFontSize = 0
|
||||||
left = 664
|
left = 408
|
||||||
top = 272
|
top = 416
|
||||||
end
|
end
|
||||||
object ImageList1: TImageList
|
object ImageList1: TImageList
|
||||||
left = 564
|
left = 336
|
||||||
top = 334
|
top = 432
|
||||||
Bitmap = {
|
Bitmap = {
|
||||||
4C69010000001000000010000000FFFFFF00FFFFFF00FFFFFF0000BBC74800C7
|
4C69010000001000000010000000FFFFFF00FFFFFF00FFFFFF0000BBC74800C7
|
||||||
D3C7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000BBC74800C7
|
D3C7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000BBC74800C7
|
||||||
|
@ -33,6 +33,7 @@ type
|
|||||||
CbDrawCell: TCheckBox;
|
CbDrawCell: TCheckBox;
|
||||||
CbAddHolidayNameToCell: TCheckBox;
|
CbAddHolidayNameToCell: TCheckBox;
|
||||||
CbShowHints: TCheckBox;
|
CbShowHints: TCheckBox;
|
||||||
|
CbMultiSelect: TCheckBox;
|
||||||
FontDialog: TFontDialog;
|
FontDialog: TFontDialog;
|
||||||
GroupBox1: TGroupBox;
|
GroupBox1: TGroupBox;
|
||||||
ImageList1: TImageList;
|
ImageList1: TImageList;
|
||||||
@ -49,6 +50,7 @@ type
|
|||||||
Label7: TLabel;
|
Label7: TLabel;
|
||||||
Label8: TLabel;
|
Label8: TLabel;
|
||||||
Label9: TLabel;
|
Label9: TLabel;
|
||||||
|
SelDateListbox: TListBox;
|
||||||
LTitle: TLabel;
|
LTitle: TLabel;
|
||||||
LWidth: TLabel;
|
LWidth: TLabel;
|
||||||
lHeight: TLabel;
|
lHeight: TLabel;
|
||||||
@ -60,6 +62,7 @@ type
|
|||||||
procedure BtnFontClick(Sender: TObject);
|
procedure BtnFontClick(Sender: TObject);
|
||||||
procedure CbAddHolidayNameToCellChange(Sender: TObject);
|
procedure CbAddHolidayNameToCellChange(Sender: TObject);
|
||||||
procedure CbDrawCellChange(Sender: TObject);
|
procedure CbDrawCellChange(Sender: TObject);
|
||||||
|
procedure CbMultiSelectChange(Sender: TObject);
|
||||||
procedure CbPrepareCanvasChange(Sender: TObject);
|
procedure CbPrepareCanvasChange(Sender: TObject);
|
||||||
procedure CbShowHintsChange(Sender: TObject);
|
procedure CbShowHintsChange(Sender: TObject);
|
||||||
procedure ColorButtonChanged(Sender: TObject);
|
procedure ColorButtonChanged(Sender: TObject);
|
||||||
@ -274,6 +277,11 @@ begin
|
|||||||
demoCal.Invalidate;
|
demoCal.Invalidate;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.CbMultiSelectChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
demoCal.MultiSelect := CbMultiSelect.Checked;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TForm1.CbPrepareCanvasChange(Sender: TObject);
|
procedure TForm1.CbPrepareCanvasChange(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
if CbPrepareCanvas.Checked then
|
if CbPrepareCanvas.Checked then
|
||||||
@ -288,8 +296,17 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm1.RespondToDateChange(Sender: tObject);
|
procedure TForm1.RespondToDateChange(Sender: tObject);
|
||||||
|
var
|
||||||
|
s: TCalDateArray;
|
||||||
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
copyCal.Date:= TCalendarLite(Sender).Date;
|
copyCal.Date:= TCalendarLite(Sender).Date;
|
||||||
|
|
||||||
|
s := demoCal.SelectedDates;
|
||||||
|
SelDateListbox.Clear;
|
||||||
|
for i:=0 to High(s) do
|
||||||
|
SelDateListbox.Items.Add(DateToStr(s[i]));
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm1.GetDayText(Sender: TObject; AYear, AMonth, ADay: Word;
|
procedure TForm1.GetDayText(Sender: TObject; AYear, AMonth, ADay: Word;
|
||||||
|
@ -140,8 +140,35 @@ type
|
|||||||
coShowWeekend, coUseTopRowColors);
|
coShowWeekend, coUseTopRowColors);
|
||||||
TCalOptions = set of TCalOption;
|
TCalOptions = set of TCalOption;
|
||||||
|
|
||||||
|
TCalDateArray = array of TDate;
|
||||||
|
|
||||||
|
TCalSelMode = (smFirstSingle, smNextSingle, smFirstRange, smNextRange, smFirstWeek, smNextWeek);
|
||||||
|
|
||||||
TLanguage = (lgEnglish, lgFrench, lgGerman, lgHebrew, lgSpanish); //Ariel Rodriguez 12/09/2013
|
TLanguage = (lgEnglish, lgFrench, lgGerman, lgHebrew, lgSpanish); //Ariel Rodriguez 12/09/2013
|
||||||
|
|
||||||
|
{ TCalDateList }
|
||||||
|
|
||||||
|
TCalDateList = class
|
||||||
|
private
|
||||||
|
FList: TFPList;
|
||||||
|
function GetCount: Integer;
|
||||||
|
function GetDate(AIndex: Integer): TDate;
|
||||||
|
procedure SetDate(AIndex: Integer; AValue: TDate);
|
||||||
|
protected
|
||||||
|
procedure Sort;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure AddDate(ADate: TDate);
|
||||||
|
function AsArray: TCalDateArray;
|
||||||
|
procedure Clear;
|
||||||
|
procedure DeleteDate(ADate: TDate);
|
||||||
|
function IndexOfDate(ADate: TDate): Integer;
|
||||||
|
procedure Insert(AIndex: Integer; ADate: TDate);
|
||||||
|
property Count: Integer read GetCount;
|
||||||
|
property Values[AIndex: Integer]: TDate read GetDate write SetDate; default;
|
||||||
|
end;
|
||||||
|
|
||||||
{ TCalDrawer }
|
{ TCalDrawer }
|
||||||
|
|
||||||
TCalDrawer = class
|
TCalDrawer = class
|
||||||
@ -158,7 +185,7 @@ type
|
|||||||
FThisYear: word;
|
FThisYear: word;
|
||||||
FTStyle: TTextStyle;
|
FTStyle: TTextStyle;
|
||||||
procedure CalcSettings;
|
procedure CalcSettings;
|
||||||
procedure ChangeDateTo(ACell: TSize);
|
// procedure ChangeDateTo(ACell: TSize; AddToSel: Boolean = false);
|
||||||
procedure DrawArrow(ARect: TRect; AHead: TArrowhead; ADirec: TArrowDirection);
|
procedure DrawArrow(ARect: TRect; AHead: TArrowhead; ADirec: TArrowDirection);
|
||||||
procedure DrawDayCells;
|
procedure DrawDayCells;
|
||||||
procedure DrawDayLabels;
|
procedure DrawDayLabels;
|
||||||
@ -175,8 +202,8 @@ type
|
|||||||
procedure GotoMonth(AMonth: word);
|
procedure GotoMonth(AMonth: word);
|
||||||
procedure GotoToday;
|
procedure GotoToday;
|
||||||
procedure GotoYear(AYear: word);
|
procedure GotoYear(AYear: word);
|
||||||
procedure LeftClick;
|
procedure LeftClick(Shift: TShiftState);
|
||||||
procedure RightClick;
|
procedure RightClick(Shift: TShiftState);
|
||||||
public
|
public
|
||||||
constructor Create(ACanvas: TCanvas);
|
constructor Create(ACanvas: TCanvas);
|
||||||
procedure Draw;
|
procedure Draw;
|
||||||
@ -232,7 +259,10 @@ type
|
|||||||
FStartingDayOfWeek: TDayOfWeek;
|
FStartingDayOfWeek: TDayOfWeek;
|
||||||
FWeekendDays: TDaysOfWeek;
|
FWeekendDays: TDaysOfWeek;
|
||||||
FPrevMouseDate: TDate;
|
FPrevMouseDate: TDate;
|
||||||
|
FPrevDate: TDate;
|
||||||
FSavedHint: String;
|
FSavedHint: String;
|
||||||
|
FMultiSelect: Boolean;
|
||||||
|
FSelDates: TCalDateList;
|
||||||
FLanguage: TLanguage; //Ariel Rodriguez 12/09/2013
|
FLanguage: TLanguage; //Ariel Rodriguez 12/09/2013
|
||||||
procedure DateChange;
|
procedure DateChange;
|
||||||
function GetDayNames: String;
|
function GetDayNames: String;
|
||||||
@ -248,6 +278,7 @@ type
|
|||||||
procedure SetDefaultDisplayTexts;
|
procedure SetDefaultDisplayTexts;
|
||||||
procedure SetDisplayTexts(AValue: String);
|
procedure SetDisplayTexts(AValue: String);
|
||||||
procedure SetMonthNames(const AValue: String);
|
procedure SetMonthNames(const AValue: String);
|
||||||
|
procedure SetMultiSelect(AValue: Boolean);
|
||||||
procedure SetOptions(AValue: TCalOptions);
|
procedure SetOptions(AValue: TCalOptions);
|
||||||
procedure SetStartingDayOfWeek(AValue: TDayOfWeek);
|
procedure SetStartingDayOfWeek(AValue: TDayOfWeek);
|
||||||
procedure SetWeekendDays(AValue: TDaysOfWeek);
|
procedure SetWeekendDays(AValue: TDaysOfWeek);
|
||||||
@ -255,6 +286,7 @@ type
|
|||||||
procedure SetLanguage(AValue: TLanguage); //Ariel Rodriguez 12/09/2013
|
procedure SetLanguage(AValue: TLanguage); //Ariel Rodriguez 12/09/2013
|
||||||
|
|
||||||
protected
|
protected
|
||||||
|
procedure ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
|
||||||
class function GetControlClassDefaultSize: TSize; override;
|
class function GetControlClassDefaultSize: TSize; override;
|
||||||
function GetDayName(ADayOfWeek: TDayOfWeek): String;
|
function GetDayName(ADayOfWeek: TDayOfWeek): String;
|
||||||
function GetDisplayText(aTextIndex: TDisplayText): String;
|
function GetDisplayText(aTextIndex: TDisplayText): String;
|
||||||
@ -264,6 +296,7 @@ type
|
|||||||
procedure MouseEnter; override;
|
procedure MouseEnter; override;
|
||||||
procedure MouseLeave; override;
|
procedure MouseLeave; override;
|
||||||
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
|
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
|
||||||
|
function SelMode(Shift: TShiftState): TCalSelMode;
|
||||||
|
|
||||||
procedure Paint; override;
|
procedure Paint; override;
|
||||||
|
|
||||||
@ -275,6 +308,9 @@ type
|
|||||||
constructor Create(anOwner: TComponent); override;
|
constructor Create(anOwner: TComponent); override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
function IsSelected(ADate: TDate): Boolean;
|
||||||
|
function SelectedDates: TCalDateArray;
|
||||||
|
|
||||||
published
|
published
|
||||||
property Align;
|
property Align;
|
||||||
property Anchors;
|
property Anchors;
|
||||||
@ -326,6 +362,7 @@ type
|
|||||||
property DayNames: String read GetDayNames write SetDayNames;
|
property DayNames: String read GetDayNames write SetDayNames;
|
||||||
property DisplayTexts: String read GetDisplaytexts write SetDisplayTexts;
|
property DisplayTexts: String read GetDisplaytexts write SetDisplayTexts;
|
||||||
property MonthNames: String read GetMonthnames write SetMonthNames;
|
property MonthNames: String read GetMonthnames write SetMonthNames;
|
||||||
|
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect;
|
||||||
property Options: TCalOptions read FOptions write SetOptions
|
property Options: TCalOptions read FOptions write SetOptions
|
||||||
default [coShowTodayFrame, coBoldHolidays, coShowWeekend, coShowHolidays, coShowTodayRow];
|
default [coShowTodayFrame, coBoldHolidays, coShowWeekend, coShowHolidays, coShowTodayRow];
|
||||||
property StartingDayOfWeek: TDayOfWeek read FStartingDayOfWeek
|
property StartingDayOfWeek: TDayOfWeek read FStartingDayOfWeek
|
||||||
@ -377,6 +414,143 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TCalSortedDateList }
|
||||||
|
|
||||||
|
type
|
||||||
|
TDateItem = TDate;
|
||||||
|
PDateItem = ^TDateItem;
|
||||||
|
|
||||||
|
function CompareDates(P1, P2: Pointer): Integer;
|
||||||
|
begin
|
||||||
|
Result := CompareDate(PDateItem(P1)^, PDateItem(P2)^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TCalDateList.Create;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FList := TFPList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TCalDateList.Destroy;
|
||||||
|
begin
|
||||||
|
Clear;
|
||||||
|
FList.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCalDateList.AddDate(ADate: TDate);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
P: PDateItem;
|
||||||
|
begin
|
||||||
|
i := IndexOfDate(ADate);
|
||||||
|
if i > -1 then begin
|
||||||
|
P := PDateItem(FList.Items[i]);
|
||||||
|
Dispose(P);
|
||||||
|
FList.Delete(i);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Assume that the list is sorted
|
||||||
|
for i:= FList.Count-1 downto 0 do begin
|
||||||
|
P := PDateItem(FList.Items[i]);
|
||||||
|
// Add new date
|
||||||
|
if P^ < ADate then begin
|
||||||
|
Insert(i+1, ADate); // meaning: "insert BEFORE index i"
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Insert(0, ADate);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCalDateList.AsArray: TCalDateArray;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
SetLength(Result, Count);
|
||||||
|
for i:=0 to High(Result) do
|
||||||
|
Result[i] := Values[i];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCalDateList.Clear;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
P: PDateItem;
|
||||||
|
begin
|
||||||
|
for i := FList.Count-1 downto 0 do begin
|
||||||
|
P := PDateItem(FList.Items[i]);
|
||||||
|
Dispose(P);
|
||||||
|
FList.Delete(i);
|
||||||
|
end;
|
||||||
|
FList.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCalDateList.DeleteDate(ADate: TDate);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
P: PDateItem;
|
||||||
|
begin
|
||||||
|
i := IndexOfDate(ADate);
|
||||||
|
if i > -1 then begin
|
||||||
|
P := PDateItem(FList.Items[i]);
|
||||||
|
Dispose(P);
|
||||||
|
FList.Delete(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCalDateList.GetCount: Integer;
|
||||||
|
begin
|
||||||
|
Result := FList.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCalDateList.GetDate(AIndex: Integer): TDate;
|
||||||
|
var
|
||||||
|
P: PDateItem;
|
||||||
|
begin
|
||||||
|
P := PDateItem(FList.Items[AIndex]);
|
||||||
|
Result := P^;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCalDateList.IndexOfDate(ADate: TDate): Integer;
|
||||||
|
// to do: Since the list is always ordered use a binary search here
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
for i:=0 to FList.Count-1 do
|
||||||
|
if SameDate(GetDate(i), ADate) then begin
|
||||||
|
Result := i;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Result := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCalDateList.Insert(AIndex: Integer; ADate: TDate);
|
||||||
|
var
|
||||||
|
P: PDateItem;
|
||||||
|
begin
|
||||||
|
New(P);
|
||||||
|
P^ := ADate;
|
||||||
|
if AIndex >= FList.Count then
|
||||||
|
FList.Add(P)
|
||||||
|
else
|
||||||
|
FList.Insert(AIndex, P);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCalDateList.SetDate(AIndex: Integer; AValue: TDate);
|
||||||
|
var
|
||||||
|
P: PDateItem;
|
||||||
|
begin
|
||||||
|
P := PDateItem(FList.Items[AIndex]);
|
||||||
|
P^ := AValue;
|
||||||
|
Sort;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCalDateList.Sort;
|
||||||
|
begin
|
||||||
|
FList.Sort(@CompareDates);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TCalDrawer }
|
{ TCalDrawer }
|
||||||
|
|
||||||
constructor TCalDrawer.Create(ACanvas: TCanvas);
|
constructor TCalDrawer.Create(ACanvas: TCanvas);
|
||||||
@ -447,12 +621,12 @@ begin
|
|||||||
if (LastRow = TodayRow) then
|
if (LastRow = TodayRow) then
|
||||||
FRowPositions[TodayRow] := FRowPositions[LastDateRow] + borderv + ch + rem;
|
FRowPositions[TodayRow] := FRowPositions[LastDateRow] + borderv + ch + rem;
|
||||||
end;
|
end;
|
||||||
|
{
|
||||||
procedure TCalDrawer.ChangeDateTo(ACell: TSize);
|
procedure TCalDrawer.ChangeDateTo(ACell: TSize; AddToSel: Boolean = false);
|
||||||
var
|
var
|
||||||
diff: integer;
|
diff: integer;
|
||||||
newDate: TDateTime;
|
newDate: TDateTime;
|
||||||
d, m, y: word;
|
//d, m, y: word;
|
||||||
begin
|
begin
|
||||||
diff := ACell.cx + LastCol * (ACell.cy - 2);
|
diff := ACell.cx + LastCol * (ACell.cy - 2);
|
||||||
newDate := FStartDate + diff - 1;
|
newDate := FStartDate + diff - 1;
|
||||||
@ -461,8 +635,8 @@ begin
|
|||||||
FCanvas.Brush.Color := FOwner.Colors.BackgroundColor;
|
FCanvas.Brush.Color := FOwner.Colors.BackgroundColor;
|
||||||
FCanvas.FillRect(FBoundsRect);
|
FCanvas.FillRect(FBoundsRect);
|
||||||
Draw;
|
Draw;
|
||||||
DecodeDate(newDate, y, m, d);
|
//DecodeDate(newDate, y, m, d);
|
||||||
end;
|
end; }
|
||||||
|
|
||||||
procedure TCalDrawer.Draw;
|
procedure TCalDrawer.Draw;
|
||||||
begin
|
begin
|
||||||
@ -617,7 +791,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
{ Set default background color }
|
{ Set default background color }
|
||||||
if (dt = FOwner.FDate) then begin
|
if FOwner.IsSelected(dt) then begin
|
||||||
FCanvas.Brush.Color:= FOwner.FColors.SelectedDateColor;
|
FCanvas.Brush.Color:= FOwner.FColors.SelectedDateColor;
|
||||||
Include(state, csSelectedDay);
|
Include(state, csSelectedDay);
|
||||||
end else
|
end else
|
||||||
@ -647,7 +821,7 @@ begin
|
|||||||
if continueDrawing then
|
if continueDrawing then
|
||||||
begin
|
begin
|
||||||
{ Paint the background of the selected date }
|
{ Paint the background of the selected date }
|
||||||
if (dt = FOwner.FDate) or
|
if FOwner.IsSelected(dt) or
|
||||||
(oldBrush.Color <> FCanvas.Brush.Color) or
|
(oldBrush.Color <> FCanvas.Brush.Color) or
|
||||||
(oldBrush.Style <> FCanvas.brush.Style) or
|
(oldBrush.Style <> FCanvas.brush.Style) or
|
||||||
(oldPen.Color <> FCanvas.Pen.Color) or
|
(oldPen.Color <> FCanvas.Pen.Color) or
|
||||||
@ -1000,12 +1174,14 @@ begin
|
|||||||
FOwner.Date := d;
|
FOwner.Date := d;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCalDrawer.LeftClick;
|
procedure TCalDrawer.LeftClick(Shift: TShiftState);
|
||||||
var
|
var
|
||||||
p, ppopup: TPoint;
|
p, ppopup: TPoint;
|
||||||
cell: TSize;
|
cell: TSize;
|
||||||
Rm, Ry: TRect;
|
Rm, Ry: TRect;
|
||||||
|
sm: TCalSelMode;
|
||||||
begin
|
begin
|
||||||
|
sm := FOwner.SelMode(Shift);
|
||||||
p := FOwner.ScreenToClient(Mouse.CursorPos);
|
p := FOwner.ScreenToClient(Mouse.CursorPos);
|
||||||
cell := GetCellAt(p);
|
cell := GetCellAt(p);
|
||||||
case cell.cy of
|
case cell.cy of
|
||||||
@ -1034,14 +1210,14 @@ begin
|
|||||||
DayRow: ;
|
DayRow: ;
|
||||||
|
|
||||||
FirstDateRow..LastDateRow :
|
FirstDateRow..LastDateRow :
|
||||||
ChangeDateTo(cell);
|
FOwner.ChangeDateTo(GetDateOfCell(cell), sm);
|
||||||
|
|
||||||
else
|
else
|
||||||
GotoToday;
|
GotoToday;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCalDrawer.RightClick;
|
procedure TCalDrawer.RightClick(Shift: TShiftState);
|
||||||
begin
|
begin
|
||||||
if Assigned(FOwner.FOnGetHolidays) then
|
if Assigned(FOwner.FOnGetHolidays) then
|
||||||
begin
|
begin
|
||||||
@ -1090,8 +1266,8 @@ end;
|
|||||||
constructor TCalendarLite.Create(anOwner: TComponent);
|
constructor TCalendarLite.Create(anOwner: TComponent);
|
||||||
begin
|
begin
|
||||||
inherited Create(anOwner);
|
inherited Create(anOwner);
|
||||||
|
FSelDates := TCalDateList.Create;
|
||||||
FColors := TCalColors.Create(self);
|
FColors := TCalColors.Create(self);
|
||||||
FDate := SysUtils.Date;
|
|
||||||
Color := clWhite;
|
Color := clWhite;
|
||||||
FStartingDayOfWeek:= dowSunday;
|
FStartingDayOfWeek:= dowSunday;
|
||||||
with GetControlClassDefaultSize do
|
with GetControlClassDefaultSize do
|
||||||
@ -1114,10 +1290,12 @@ begin
|
|||||||
coShowTodayRow];
|
coShowTodayRow];
|
||||||
SetLanguage(lgEnglish); //Ariel Rodriguez 12/09/2013
|
SetLanguage(lgEnglish); //Ariel Rodriguez 12/09/2013
|
||||||
FPrevMouseDate := 0;
|
FPrevMouseDate := 0;
|
||||||
|
Date := SysUtils.Date;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TCalendarLite.Destroy;
|
destructor TCalendarLite.Destroy;
|
||||||
begin
|
begin
|
||||||
|
FreeAndNil(FSelDates);
|
||||||
FreeAndNil(FDayNames);
|
FreeAndNil(FDayNames);
|
||||||
FreeAndNil(FMonthNames);
|
FreeAndNil(FMonthNames);
|
||||||
FreeAndNil(FDisplayTexts);
|
FreeAndNil(FDisplayTexts);
|
||||||
@ -1127,6 +1305,59 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCalendarLite.ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
|
||||||
|
var
|
||||||
|
d, d1, d2: TDate;
|
||||||
|
begin
|
||||||
|
FDate := ADate;
|
||||||
|
|
||||||
|
case ASelMode of
|
||||||
|
smFirstSingle:
|
||||||
|
begin
|
||||||
|
FSelDates.Clear;
|
||||||
|
FSelDates.AddDate(ADate);
|
||||||
|
end;
|
||||||
|
|
||||||
|
smNextSingle:
|
||||||
|
FSelDates.AddDate(ADate);
|
||||||
|
|
||||||
|
smFirstRange, smNextRange,
|
||||||
|
smFirstWeek, smNextWeek:
|
||||||
|
begin
|
||||||
|
if (ASelMode = smFirstRange) or (ASelMode = smFirstWeek) then
|
||||||
|
FSelDates.Clear;
|
||||||
|
if (ASelMode = smFirstRange) or (ASelMode = smNextRange) then begin
|
||||||
|
if FPrevDate < ADate then begin
|
||||||
|
d1 := FPrevDate;
|
||||||
|
d2 := ADate;
|
||||||
|
end else begin
|
||||||
|
d1 := ADate;
|
||||||
|
d2 := FPrevDate;
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
if (ASelMode = smFirstWeek) or (ASelMode = smNextWeek) then begin
|
||||||
|
d1 := ADate;
|
||||||
|
while DayOfWeek(d1) <> ord(dowMonday) do d1 := d1 - 1;
|
||||||
|
d2 := ADate;
|
||||||
|
while DayOfWeek(d2) <> ord(dowFriday) do d2 := d2 + 1;
|
||||||
|
end;
|
||||||
|
d := d1;
|
||||||
|
while (d <= d2) do begin
|
||||||
|
FSelDates.AddDate(d);
|
||||||
|
d := d + 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FPrevDate := ADate;
|
||||||
|
DateChange;
|
||||||
|
with FCalDrawer do begin
|
||||||
|
FCanvas.Brush.Color := Colors.BackgroundColor;
|
||||||
|
FCanvas.FillRect(FBoundsRect);
|
||||||
|
Draw;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCalendarLite.DateChange;
|
procedure TCalendarLite.DateChange;
|
||||||
begin
|
begin
|
||||||
if Assigned(FOnDateChange) then
|
if Assigned(FOnDateChange) then
|
||||||
@ -1178,6 +1409,14 @@ begin
|
|||||||
FCalDrawer.GotoDay(TMenuItem(Sender).Tag);
|
FCalDrawer.GotoDay(TMenuItem(Sender).Tag);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TCalendarLite.IsSelected(ADate: TDate): Boolean;
|
||||||
|
begin
|
||||||
|
if FMultiSelect then
|
||||||
|
Result := FSelDates.IndexOfDate(ADate) > -1
|
||||||
|
else
|
||||||
|
Result := (ADate = FDate);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCalendarLite.KeyDown(var Key: Word; Shift: TShiftState);
|
procedure TCalendarLite.KeyDown(var Key: Word; Shift: TShiftState);
|
||||||
|
|
||||||
function Delta(Increase: Boolean): Integer;
|
function Delta(Increase: Boolean): Integer;
|
||||||
@ -1185,16 +1424,21 @@ procedure TCalendarLite.KeyDown(var Key: Word; Shift: TShiftState);
|
|||||||
if Increase then Result := +1 else Result := -1;
|
if Increase then Result := +1 else Result := -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
sm: TCalSelMode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
sm := SelMode(Shift);
|
||||||
|
|
||||||
case Key of
|
case Key of
|
||||||
VK_UP,
|
VK_UP,
|
||||||
VK_DOWN : Date := IncWeek(FDate, Delta(Key = VK_DOWN));
|
VK_DOWN : ChangeDateTo(IncWeek(FDate, Delta(Key = VK_DOWN)), sm);
|
||||||
VK_LEFT,
|
VK_LEFT,
|
||||||
VK_RIGHT : Date := IncDay(FDate, Delta(Key = VK_RIGHT));
|
VK_RIGHT : ChangeDateTo(IncDay(FDate, Delta(Key = VK_RIGHT)), sm);
|
||||||
VK_HOME : Date := StartOfTheMonth(FDate);
|
VK_HOME : ChangeDateTo(StartOfTheMonth(FDate), sm);
|
||||||
VK_END : Date := EndOfTheMonth(FDate);
|
VK_END : ChangeDateTo(EndOfTheMonth(FDate), sm);
|
||||||
VK_PRIOR,
|
VK_PRIOR,
|
||||||
VK_NEXT : if (ssCtrl in Shift) then
|
VK_NEXT : if not FMultiSelect and (ssCtrl in Shift) then
|
||||||
Date := IncYear(FDate, Delta(Key = VK_NEXT)) else
|
Date := IncYear(FDate, Delta(Key = VK_NEXT)) else
|
||||||
Date := IncMonth(FDate, Delta(Key = VK_NEXT));
|
Date := IncMonth(FDate, Delta(Key = VK_NEXT));
|
||||||
else inherited;
|
else inherited;
|
||||||
@ -1214,8 +1458,8 @@ begin
|
|||||||
SetFocus;
|
SetFocus;
|
||||||
|
|
||||||
case Button of
|
case Button of
|
||||||
mbLeft : FCalDrawer.LeftClick;
|
mbLeft : FCalDrawer.LeftClick(Shift);
|
||||||
mbRight : FCalDrawer.RightClick;
|
mbRight : FCalDrawer.RightClick(Shift);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1386,10 +1630,38 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TCalendarLite.SelectedDates: TCalDateArray;
|
||||||
|
begin
|
||||||
|
Result := FSelDates.AsArray;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCalendarLite.SelMode(Shift: TShiftState): TCalSelMode;
|
||||||
|
begin
|
||||||
|
Result := smFirstSingle;
|
||||||
|
if not FMultiSelect then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
if (ssShift in Shift) then begin
|
||||||
|
Result := smFirstRange;
|
||||||
|
if (ssCtrl in Shift) and (FPrevDate > 0) then
|
||||||
|
Result := smNextRange;
|
||||||
|
end else
|
||||||
|
if (ssAlt in Shift) then begin
|
||||||
|
Result := smFirstWeek;
|
||||||
|
if (ssCtrl in Shift) and (FPrevDate > 0) then
|
||||||
|
Result := smNextWeek;
|
||||||
|
end else
|
||||||
|
if (ssCtrl in Shift) and (FPrevDate > 0) then
|
||||||
|
Result := smNextSingle;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TCalendarLite.SetDate(AValue: TDateTime);
|
procedure TCalendarLite.SetDate(AValue: TDateTime);
|
||||||
begin
|
begin
|
||||||
if FDate = AValue then Exit;
|
if FDate = AValue then Exit;
|
||||||
FDate := AValue;
|
FDate := AValue;
|
||||||
|
FPrevDate := AValue;
|
||||||
|
FSelDates.Clear;
|
||||||
DateChange;
|
DateChange;
|
||||||
Invalidate;
|
Invalidate;
|
||||||
end;
|
end;
|
||||||
@ -1460,6 +1732,18 @@ begin
|
|||||||
Invalidate;
|
Invalidate;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCalendarLite.SetMultiSelect(AValue: Boolean);
|
||||||
|
var
|
||||||
|
d: TDate;
|
||||||
|
begin
|
||||||
|
if AValue = FMultiSelect then
|
||||||
|
exit;
|
||||||
|
FMultiSelect := AValue;
|
||||||
|
FSelDates.Clear;
|
||||||
|
FSelDates.AddDate(FDate);
|
||||||
|
FPrevDate := FDate;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCalendarLite.SetStartingDayOfWeek(AValue: TDayOfWeek);
|
procedure TCalendarLite.SetStartingDayOfWeek(AValue: TDayOfWeek);
|
||||||
begin
|
begin
|
||||||
if FStartingDayOfWeek = AValue then Exit;
|
if FStartingDayOfWeek = AValue then Exit;
|
||||||
|
Reference in New Issue
Block a user