You've already forked lazarus-ccr
tvplanit: Refactor TVpCalendar.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8450 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -52,7 +52,7 @@ type
|
||||
|
||||
TVpCalDisplayOptions = set of TVpCalDisplayOption;
|
||||
|
||||
TVpCalColorArray = array[0..6] of TColor;
|
||||
TVpCalColorArray = array[0..9] of TColor;
|
||||
|
||||
TVpCalColorScheme = (cscalCustom, cscalClassic, cscalWindows,
|
||||
cscalGold, cscalOcean, cscalRose);
|
||||
@ -63,47 +63,41 @@ type
|
||||
TColArray = array[0..6] of Integer;
|
||||
|
||||
const
|
||||
{ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend}
|
||||
CalScheme : TVpCalSchemeArray =
|
||||
((0, 0, 0, 0, 0, 0, 0),
|
||||
(clHighlight, clWindow, clWindow, clWindow, clWindow, clWindow, clBlack),
|
||||
(clRed, clMaroon, clBlack, clGray, clBlue, clRed, clBlack),
|
||||
(clBlack, clBlack, clYellow, clGray, clBlack, clTeal, clBlack),
|
||||
(clBlack, clBlack, clAqua, clGray, clBlack, clNavy, clBlack),
|
||||
(clRed, clRed, clFuchsia, clGray, clBlue, clTeal, clBlack)
|
||||
{ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend, EventDays, ActiveDayBorder, ActiveDayText}
|
||||
CalScheme : TVpCalSchemeArray = (
|
||||
// Active BG DayNames Days Inact.Days Month/Year Weekend Event Background Active border Active text
|
||||
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
|
||||
(clWindow, clWindowText, clWindowText, clSilver, clWindowText, clRed, clWindowText, clWindow, clWindowText, clWindowText), // classic
|
||||
(clBlue, clMaroon, clBlack, clMedGray, clBlue, clRed, clBlack, clDefault, clBlack, clWhite), // windows
|
||||
(clMaroon, clBlack, clYellow, clSilver, clBlack, $7777FF, clWhite, clOlive, clBlack, clYellow), // gold
|
||||
(clBlue, clSilver, clAqua, clBlue, clSilver, clRed, clWhite, clNavy, clNavy, clWhite), // ocean
|
||||
($007500EA, clBlack, clFuchsia, clMedGray, clBlack, clRed, clMaroon, $00D9B3FF, clMaroon, clWhite) // rose
|
||||
);
|
||||
calDefWeekStarts = dtSunday; { default start of the week }
|
||||
|
||||
type
|
||||
TVpCalColors = class(TPersistent)
|
||||
protected {private}
|
||||
{property variables}
|
||||
private
|
||||
FUpdating: Boolean;
|
||||
FOnChange: TNotifyEvent;
|
||||
|
||||
{internal variables}
|
||||
SettingScheme: Boolean;
|
||||
|
||||
{property methods}
|
||||
function GetColor(Index: Integer): TColor;
|
||||
procedure SetColor(Index: Integer; Value: TColor);
|
||||
procedure SetColorScheme(Value: TVpCalColorScheme);
|
||||
|
||||
{internal methods}
|
||||
protected
|
||||
procedure DoOnChange;
|
||||
|
||||
public
|
||||
{public property variables}
|
||||
FCalColors: TVpCalColorArray;
|
||||
FColorScheme: TVpCalColorScheme;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure BeginUpdate;
|
||||
procedure EndUpdate;
|
||||
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
|
||||
published
|
||||
property ActiveDay: TColor index 0 read GetColor write SetColor;
|
||||
property ActiveDayBorder: TColor index 8 read GetColor write SetColor;
|
||||
property ActiveDayText: TColor index 9 read GetColor write SetColor;
|
||||
property Background: TColor index 7 read GetColor write SetColor;
|
||||
property ColorScheme: TVpCalColorScheme read FColorScheme write SetColorScheme;
|
||||
property DayNames: TColor index 1 read GetColor write SetColor;
|
||||
property Days: TColor index 2 read GetColor write SetColor;
|
||||
@ -121,8 +115,9 @@ type
|
||||
|
||||
TVpCustomCalendar = class(TVpLinkableControl)
|
||||
protected {private}
|
||||
{property variables}
|
||||
{$IFNDEF LCL}
|
||||
FBorderStyle : TBorderStyle;
|
||||
{$ENDIF}
|
||||
FBrowsing : Boolean;
|
||||
FColors : TVpCalColors;
|
||||
FOptions : TVpCalDisplayOptions;
|
||||
@ -176,7 +171,10 @@ type
|
||||
function GetDay: Integer;
|
||||
function GetMonth: Integer;
|
||||
function GetYear: Integer;
|
||||
{$IFNDEF LCL}
|
||||
procedure SetBorderStyle(Value: TBorderStyle); reintroduce;
|
||||
{$ENDIF}
|
||||
procedure SetColor(Value: TColor); override;
|
||||
procedure SetDate(Value: TDateTime);
|
||||
procedure SetDateFormat(Value: TVpDateFormat);
|
||||
procedure SetDayNameWidth(Value: TVpDayNameWidth);
|
||||
@ -268,6 +266,7 @@ type
|
||||
|
||||
property Browsing : Boolean read FBrowsing;
|
||||
property Canvas;
|
||||
property CurrentRectangle: TRect read calGetCurrentRectangle;
|
||||
property Day: Integer read GetDay;
|
||||
property Month: Integer read GetMonth;
|
||||
property Year: Integer read GetYear;
|
||||
@ -278,17 +277,17 @@ type
|
||||
{$IFDEF LCL}
|
||||
property BorderSpacing;
|
||||
{$ENDIF}
|
||||
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
|
||||
property BorderStyle default bsNone; //: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
|
||||
property Color;
|
||||
property Colors: TVpCalColors read FColors write FColors;
|
||||
property Date: TDateTime read FDate write SetDate;
|
||||
property DateFormat: TVpDateFormat read FDateFormat write SetDateFormat default dfLong;
|
||||
property DayNameWidth: TVpDayNameWidth read FDayNameWidth write SetDayNameWidth;
|
||||
property DayNameWidth: TVpDayNameWidth read FDayNameWidth write SetDayNameWidth default 3;
|
||||
property Options: TVpCalDisplayOptions read FOptions write SetDisplayOptions
|
||||
default [cdoHighlightSat, cdoHighlightSun, cdoShortNames, cdoShowNavBtns, cdoShowRevert, cdoShowToday, cdoShowYear];
|
||||
property ReadOnly: Boolean read FReadOnly write FReadOnly;
|
||||
property WantDblClicks: Boolean read FWantDblClicks write SetWantDblClicks;
|
||||
property WeekStarts: TVpDayType read FWeekStarts write SetWeekStarts;
|
||||
property ReadOnly: Boolean read FReadOnly write FReadOnly default false;
|
||||
property WantDblClicks: Boolean read FWantDblClicks write SetWantDblClicks default true;
|
||||
property WeekStarts: TVpDayType read FWeekStarts write SetWeekStarts default dtSunday;
|
||||
|
||||
{events}
|
||||
property OnChange: TDateChangeEvent read FOnChange write FOnChange;
|
||||
@ -385,7 +384,6 @@ begin
|
||||
end else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCalColors.BeginUpdate;
|
||||
begin
|
||||
@ -397,7 +395,6 @@ begin
|
||||
FUpdating := False;
|
||||
DoOnChange;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCalColors.DoOnChange;
|
||||
begin
|
||||
@ -407,13 +404,11 @@ begin
|
||||
if not SettingScheme then
|
||||
FColorScheme := cscalCustom;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
function TVpCalColors.GetColor(Index: Integer) : TColor;
|
||||
begin
|
||||
Result := FCalColors[Index];
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCalColors.SetColor(Index: Integer; Value: TColor);
|
||||
begin
|
||||
@ -422,7 +417,6 @@ begin
|
||||
DoOnChange;
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCalColors.SetColorScheme(Value: TVpCalColorScheme);
|
||||
begin
|
||||
@ -439,10 +433,143 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
|
||||
{*** TVpCustomCalendar ***}
|
||||
(******************************************************************************)
|
||||
{ TVpCustomCalendar }
|
||||
(******************************************************************************)
|
||||
constructor TVpCustomCalendar.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
{$IFDEF LCL}
|
||||
ControlStyle := ControlStyle + [csClickEvents] - [csCaptureMouse];
|
||||
{$ELSE}
|
||||
ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse];
|
||||
{$ENDIF}
|
||||
|
||||
Height := 140;
|
||||
TabStop := True;
|
||||
Width := 200;
|
||||
|
||||
calMargin := ScaleX(CAL_MARGIN, DesignTimeDPI);
|
||||
|
||||
{$IFNDEF LCL}
|
||||
Font.Name := 'MS Sans Serif';
|
||||
Font.Size := 8;
|
||||
{$ENDIF}
|
||||
|
||||
BorderStyle := bsNone;
|
||||
FDayNameWidth := 3;
|
||||
FDateFormat := dfLong;
|
||||
FOptions := [cdoShortNames, cdoShowYear, cdoShowRevert, cdoShowToday,
|
||||
cdoShowNavBtns, cdoHighlightSun, cdoHighlightSat];
|
||||
FWantDblClicks := True;
|
||||
FWeekStarts := dtSunday;
|
||||
FLastRenderX := 0;
|
||||
FLastRenderY := 0;
|
||||
|
||||
clInLinkHandler := false;
|
||||
|
||||
{create navigation buttons}
|
||||
clBtnLeft := TSpeedButton.Create(Self);
|
||||
clBtnLeft.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCDATA(clBtnLeft.Glyph, 'VpLArrow', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnLeft.Glyph.LoadFromResourceName(HINSTANCE,'VPLEFTARROW'); //soner geändert: clBtnLeft.Glyph.Handle := LoadBaseBitmap('VPLEFTARROW');
|
||||
{$ENDIF}
|
||||
clBtnLeft.OnClick := calBtnClick;
|
||||
clBtnLeft.Hint := RSPrevMonth;
|
||||
clBtnLeft.ShowHint := True;
|
||||
|
||||
clBtnRight := TSpeedButton.Create(Self);
|
||||
clBtnRight.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCDATA(clBtnRight.Glyph, 'VpRArrow', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnRight.Glyph.LoadFromResourceName(HINSTANCE,'VPRIGHTARROW'); //soner geändert: clBtnRight.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROW');
|
||||
{$ENDIF}
|
||||
clBtnRight.OnClick := calBtnClick;
|
||||
clBtnRight.Hint := RSNextMonth;
|
||||
clBtnRight.ShowHint := True;
|
||||
|
||||
clBtnNextYear := TSpeedButton.Create(Self);
|
||||
clBtnNextYear.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCDATA(clBtnNextYear.Glyph, 'VpRArrows', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnNextYear.Glyph.LoadFromResourceName(HINSTANCE,'VPRIGHTARROWS'); //soner geöndert: clBtnNextYear.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROWS');
|
||||
{$ENDIF}
|
||||
clBtnNextYear.OnClick := calBtnClick;
|
||||
clBtnNextYear.Hint := RSNextYear;
|
||||
clBtnNextYear.ShowHint := True;
|
||||
|
||||
clBtnPrevYear := TSpeedButton.Create(Self);
|
||||
clBtnPrevYear.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCData(clBtnPrevYear.Glyph, 'VpLArrows', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnPrevYear.Glyph.LoadFromResourceName(HINSTANCE,'VPLEFTARROWS'); //soner geöndert: clBtnPrevYear.Glyph.Handle := LoadBaseBitmap('VPLEFTARROWS');
|
||||
{$ENDIF}
|
||||
clBtnPrevYear.OnClick := calBtnClick;
|
||||
clBtnPrevYear.Hint := RSPrevYear;
|
||||
clBtnPrevYear.ShowHint := True;
|
||||
|
||||
{create "revert" button}
|
||||
clBtnRevert := TSpeedButton.Create(Self);
|
||||
clBtnRevert.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCData(clBtnRevert.Glyph, 'VpRevert', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnRevert.Glyph.LoadFromResourceName(HINSTANCE,'VPREVERT'); //soner geändert: clBtnRevert.Glyph.Handle := LoadBaseBitmap('VPREVERT');
|
||||
{$ENDIF}
|
||||
clBtnRevert.OnClick := calBtnClick;
|
||||
clBtnRevert.Hint := RSCalendarRevert;
|
||||
clBtnRevert.ShowHint := True;
|
||||
|
||||
{create "today" button}
|
||||
clBtnToday := TSpeedButton.Create(Self);
|
||||
clBtnToday.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCData(clBtnToday.Glyph, 'VpToday', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnToday.Glyph.LoadFromResourceName(HINSTANCE,'VPTODAY'); //soner geändert: clBtnToday.Glyph.Handle := LoadBaseBitmap('VPTODAY');
|
||||
{$ENDIF}
|
||||
clBtnToday.OnClick := calBtnClick;
|
||||
clBtnToday.Hint := RSToday;
|
||||
clBtnToday.ShowHint := True;
|
||||
|
||||
// Assign default color scheme
|
||||
FColors := TVpCalColors.Create;
|
||||
FColors.OnChange := calColorChange;
|
||||
FColors.FCalColors := CalScheme[cscalWindows];
|
||||
|
||||
// Assign default international support object
|
||||
FDrawHeader := True;
|
||||
clRowCount := 8;
|
||||
clStartRow := 0;
|
||||
|
||||
FDefaultPopup := TPopupMenu.Create (Self);
|
||||
InitializeDefaultPopup;
|
||||
end;
|
||||
|
||||
constructor TVpCustomCalendar.CreateEx(AOwner: TComponent; AsPopup: Boolean);
|
||||
begin
|
||||
clPopup := AsPopup;
|
||||
Create(AOwner);
|
||||
end;
|
||||
|
||||
destructor TVpCustomCalendar.Destroy;
|
||||
begin
|
||||
FColors.Free;
|
||||
FColors := nil;
|
||||
|
||||
FDefaultPopup.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TVpCustomCalendar.calBtnClick(Sender: TObject);
|
||||
var
|
||||
Key: Word;
|
||||
@ -470,7 +597,6 @@ begin
|
||||
KeyDown(Key, [ssCtrl]);
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.calChangeMonth(Sender: TObject);
|
||||
var
|
||||
@ -500,21 +626,19 @@ procedure TVpCustomCalendar.calColorChange(Sender: TObject);
|
||||
begin
|
||||
Invalidate;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
{ Get bounding rectangle for the current date}
|
||||
function TVpCustomCalendar.calGetCurrentRectangle: TRect;
|
||||
{-get bounding rectangle for the current date}
|
||||
var
|
||||
Idx : Integer;
|
||||
R, C: Integer;
|
||||
begin
|
||||
{index into the month grid}
|
||||
// Index into the month grid
|
||||
Idx := clFirst + Pred(clDay) + 13;
|
||||
R := (Idx div 7);
|
||||
C := (Idx mod 7);
|
||||
Result := clRowCol[R,C];
|
||||
end;
|
||||
{=====}
|
||||
|
||||
function TVpCustomCalendar.calGetValidDate(ADate: TDateTime;
|
||||
Delta: Integer): TDateTime;
|
||||
@ -545,7 +669,6 @@ begin
|
||||
else
|
||||
raise(EVpCalendarError.Create(RSInvalidDate));
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.calRebuildCalArray(ADate: TDateTime);
|
||||
var
|
||||
@ -587,7 +710,6 @@ begin
|
||||
Inc(J);
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.CalculateSizes(WorkCanvas: TCanvas;
|
||||
Angle: TVpRotationAngle; Rect: TRect; out Row: TRowArray; out Col: TColArray;
|
||||
@ -671,8 +793,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Calculate new sizes for rows and columns }
|
||||
procedure TVpCustomCalendar.calRecalcSize(DisplayOnly: Boolean);
|
||||
{-calcualte new sizes for rows and columns}
|
||||
var
|
||||
Row: TRowArray;
|
||||
Col: TColArray;
|
||||
@ -743,7 +865,6 @@ begin
|
||||
clBtnRevert.Top := ClientHeight - calMargin - clBtnRevert.Height + 1;
|
||||
clBtnRevert.Left := clBtnToday.Left - clBtnRevert.Width - calMargin;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.CMEnter(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
|
||||
var
|
||||
@ -757,7 +878,6 @@ begin
|
||||
R := calGetCurrentRectangle;
|
||||
InvalidateRect(Handle, @R, False);
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.CMExit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
|
||||
var
|
||||
@ -781,128 +901,7 @@ begin
|
||||
calRecalcSize(False);
|
||||
Invalidate;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
constructor TVpCustomCalendar.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse];
|
||||
|
||||
Height := 140;
|
||||
TabStop := True;
|
||||
Width := 200;
|
||||
|
||||
calMargin := ScaleX(CAL_MARGIN, DesignTimeDPI);
|
||||
|
||||
{$IFNDEF LCL}
|
||||
Font.Name := 'MS Sans Serif';
|
||||
Font.Size := 8;
|
||||
{$ENDIF}
|
||||
|
||||
FBorderStyle := bsNone;
|
||||
FDayNameWidth := 3;
|
||||
FDateFormat := dfLong;
|
||||
FOptions := [cdoShortNames, cdoShowYear, cdoShowRevert, cdoShowToday,
|
||||
cdoShowNavBtns, cdoHighlightSun, cdoHighlightSat];
|
||||
FWantDblClicks := True;
|
||||
FWeekStarts := dtSunday;
|
||||
FLastRenderX := 0;
|
||||
FLastRenderY := 0;
|
||||
|
||||
clInLinkHandler := false;
|
||||
|
||||
{create navigation buttons}
|
||||
clBtnLeft := TSpeedButton.Create(Self);
|
||||
clBtnLeft.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCDATA(clBtnLeft.Glyph, 'VpLArrow', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnLeft.Glyph.LoadFromResourceName(HINSTANCE,'VPLEFTARROW'); //soner geändert: clBtnLeft.Glyph.Handle := LoadBaseBitmap('VPLEFTARROW');
|
||||
{$ENDIF}
|
||||
clBtnLeft.OnClick := calBtnClick;
|
||||
clBtnLeft.Hint := RSPrevMonth;
|
||||
clBtnLeft.ShowHint := True;
|
||||
|
||||
clBtnRight := TSpeedButton.Create(Self);
|
||||
clBtnRight.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCDATA(clBtnRight.Glyph, 'VpRArrow', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnRight.Glyph.LoadFromResourceName(HINSTANCE,'VPRIGHTARROW'); //soner geändert: clBtnRight.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROW');
|
||||
{$ENDIF}
|
||||
clBtnRight.OnClick := calBtnClick;
|
||||
clBtnRight.Hint := RSNextMonth;
|
||||
clBtnRight.ShowHint := True;
|
||||
|
||||
clBtnNextYear := TSpeedButton.Create(Self);
|
||||
clBtnNextYear.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCDATA(clBtnNextYear.Glyph, 'VpRArrows', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnNextYear.Glyph.LoadFromResourceName(HINSTANCE,'VPRIGHTARROWS'); //soner geöndert: clBtnNextYear.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROWS');
|
||||
{$ENDIF}
|
||||
clBtnNextYear.OnClick := calBtnClick;
|
||||
clBtnNextYear.Hint := RSNextYear;
|
||||
clBtnNextYear.ShowHint := True;
|
||||
|
||||
clBtnPrevYear := TSpeedButton.Create(Self);
|
||||
clBtnPrevYear.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCData(clBtnPrevYear.Glyph, 'VpLArrows', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnPrevYear.Glyph.LoadFromResourceName(HINSTANCE,'VPLEFTARROWS'); //soner geöndert: clBtnPrevYear.Glyph.Handle := LoadBaseBitmap('VPLEFTARROWS');
|
||||
{$ENDIF}
|
||||
clBtnPrevYear.OnClick := calBtnClick;
|
||||
clBtnPrevYear.Hint := RSPrevYear;
|
||||
clBtnPrevYear.ShowHint := True;
|
||||
|
||||
{create "revert" button}
|
||||
clBtnRevert := TSpeedButton.Create(Self);
|
||||
clBtnRevert.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCData(clBtnRevert.Glyph, 'VpRevert', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnRevert.Glyph.LoadFromResourceName(HINSTANCE,'VPREVERT'); //soner geändert: clBtnRevert.Glyph.Handle := LoadBaseBitmap('VPREVERT');
|
||||
{$ENDIF}
|
||||
clBtnRevert.OnClick := calBtnClick;
|
||||
clBtnRevert.Hint := RSCalendarRevert;
|
||||
clBtnRevert.ShowHint := True;
|
||||
|
||||
{create "today" button}
|
||||
clBtnToday := TSpeedButton.Create(Self);
|
||||
clBtnToday.Parent := Self;
|
||||
{$IFDEF NEW_ICONS}
|
||||
LoadGlyphFromRCData(clBtnToday.Glyph, 'VpToday', 16, 24, 32);
|
||||
{$ELSE}
|
||||
clBtnToday.Glyph.LoadFromResourceName(HINSTANCE,'VPTODAY'); //soner geändert: clBtnToday.Glyph.Handle := LoadBaseBitmap('VPTODAY');
|
||||
{$ENDIF}
|
||||
clBtnToday.OnClick := calBtnClick;
|
||||
clBtnToday.Hint := RSToday;
|
||||
clBtnToday.ShowHint := True;
|
||||
|
||||
{assign default color scheme}
|
||||
FColors := TVpCalColors.Create;
|
||||
FColors.OnChange := calColorChange;
|
||||
FColors.FCalColors := CalScheme[cscalWindows];
|
||||
|
||||
{assign default international support object}
|
||||
|
||||
FDrawHeader:= True;
|
||||
clRowCount := 8;
|
||||
clStartRow := 0;
|
||||
|
||||
FDefaultPopup := TPopupMenu.Create (Self);
|
||||
InitializeDefaultPopup;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
constructor TVpCustomCalendar.CreateEx(AOwner: TComponent; AsPopup: Boolean);
|
||||
begin
|
||||
clPopup := AsPopup;
|
||||
Create(AOwner);
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.CreateParams(var Params: TCreateParams);
|
||||
{$IFNDEF LCL}
|
||||
@ -919,7 +918,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
if NewStyleControls and ({Ctl3D or }clPopup) and (FBorderStyle = bsSingle) then begin
|
||||
if NewStyleControls and ({Ctl3D or }clPopup) and (BorderStyle = bsSingle) then begin
|
||||
if not clPopup then
|
||||
Params.Style := Params.Style and not WS_BORDER;
|
||||
Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
|
||||
@ -943,18 +942,6 @@ begin
|
||||
if FDate = 0 then
|
||||
SetDate(calGetValidDate(SysUtils.Date-1, +1));
|
||||
end;
|
||||
{=====}
|
||||
|
||||
destructor TVpCustomCalendar.Destroy;
|
||||
begin
|
||||
FColors.Free;
|
||||
FColors := nil;
|
||||
|
||||
FDefaultPopup.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.DoOnChange(Value: TDateTime);
|
||||
begin
|
||||
@ -1028,7 +1015,7 @@ var
|
||||
PopupPoint: TPoint;
|
||||
|
||||
begin
|
||||
inherited KeyDown(Key, Shift);
|
||||
// inherited KeyDown(Key, Shift);
|
||||
|
||||
if IsReadOnly then
|
||||
Exit;
|
||||
@ -1118,8 +1105,13 @@ begin
|
||||
PopupPoint := GetClientOrigin;
|
||||
FDefaultPopup.Popup (PopupPoint.x + 10, PopupPoint.y + 10);
|
||||
end;
|
||||
|
||||
else
|
||||
inherited;
|
||||
end;
|
||||
|
||||
Key := 0;
|
||||
|
||||
if HD <> FDate then begin
|
||||
FBrowsing := True;
|
||||
try
|
||||
@ -1498,14 +1490,20 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFNDEF LCL}
|
||||
procedure TVpCustomCalendar.SetBorderStyle(Value: TBorderStyle);
|
||||
begin
|
||||
if Value <> FBorderStyle then begin
|
||||
FBorderStyle := Value;
|
||||
RecreateWnd(Self); { *Converted from RecreateWnd* }
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
{$ENDIF}
|
||||
|
||||
procedure TVpCustomCalendar.SetColor(Value: TColor);
|
||||
begin
|
||||
Colors.Background := Value;
|
||||
end;
|
||||
|
||||
procedure TVpCustomCalendar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
||||
begin
|
||||
@ -1514,7 +1512,6 @@ begin
|
||||
Exit;
|
||||
calRecalcSize(False);
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.SetDate(Value: TDateTime);
|
||||
var
|
||||
@ -1545,7 +1542,6 @@ begin
|
||||
ControlLink.Notify(self, neDateChange, Date);
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.SetDateFormat(Value: TVpDateFormat);
|
||||
begin
|
||||
@ -1554,7 +1550,6 @@ begin
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.SetDayNameWidth(Value: TVpDayNameWidth);
|
||||
begin
|
||||
@ -1563,7 +1558,6 @@ begin
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.SetDisplayOptions(Value: TVpCalDisplayOptions);
|
||||
begin
|
||||
@ -1594,10 +1588,9 @@ begin
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
{ Set the DrawHeader property value }
|
||||
procedure TVpCustomCalendar.SetDrawHeader(Value: Boolean);
|
||||
{-set the DrawHeader property value}
|
||||
begin
|
||||
if Value <> FDrawHeader then begin
|
||||
FDrawHeader := Value;
|
||||
@ -1612,14 +1605,12 @@ begin
|
||||
Refresh;
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
{ Set the calendar to todays date }
|
||||
procedure TVpCustomCalendar.SetToday;
|
||||
{-set the calendar to todays date}
|
||||
begin
|
||||
Date := Now;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.SetWantDblClicks(Value: Boolean);
|
||||
begin
|
||||
@ -1628,7 +1619,6 @@ begin
|
||||
RecreateWnd(Self); { *Converted from RecreateWnd* }
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.SetWeekStarts(Value: TVpDayType);
|
||||
begin
|
||||
@ -1640,33 +1630,28 @@ begin
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
{$IFDEF DELPHI}
|
||||
procedure TVpCustomCalendar.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
|
||||
begin
|
||||
Msg.Result := 1; {don't erase background, just say we did. Shhhhhhh!}
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.WMGetDlgCode(var Msg: TWMGetDlgCode);
|
||||
begin
|
||||
Msg.Result := DLGC_WANTARROWS;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.WMKillFocus(var Msg: TWMKillFocus);
|
||||
begin
|
||||
inherited;
|
||||
Invalidate;
|
||||
end;
|
||||
{=====}
|
||||
{$ELSE}
|
||||
procedure TVpCustomCalendar.WMEraseBkgnd(var Msg: TLMEraseBkgnd);
|
||||
begin
|
||||
Msg.Result := 1; {don't erase background, just say we did. Shhhhhhh!}
|
||||
end;
|
||||
{=====}
|
||||
{
|
||||
procedure TVpCustomCalendar.WMGetDlgCode(var Msg: TLMGetDlgCode);
|
||||
begin
|
||||
@ -1679,7 +1664,6 @@ begin
|
||||
inherited;
|
||||
Invalidate;
|
||||
end;
|
||||
{=====}
|
||||
{$ENDIF}
|
||||
|
||||
procedure TVpCustomCalendar.InitializeDefaultPopup;
|
||||
@ -1721,36 +1705,30 @@ begin
|
||||
FDefaultPopup.Items.Add (NewItem);
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.PopupToday(Sender: TObject);
|
||||
begin
|
||||
SetDate (Now);
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.PopupNextMonth(Sender: TObject);
|
||||
begin
|
||||
IncMonth (1);
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.PopupPrevMonth(Sender: TObject);
|
||||
begin
|
||||
IncMonth (-1);
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.PopupNextYear(Sender: TObject);
|
||||
begin
|
||||
IncYear (1);
|
||||
end;
|
||||
{=====}
|
||||
|
||||
procedure TVpCustomCalendar.PopupPrevYear(Sender: TObject);
|
||||
begin
|
||||
IncYear (-1);
|
||||
end;
|
||||
{=====}
|
||||
|
||||
end.
|
||||
|
||||
@ -5,7 +5,7 @@ unit VpCalendarPainter;
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Graphics,
|
||||
SysUtils, Classes, Graphics, Controls,
|
||||
VpBase, VpMisc, VpBasePainter, VpCalendar;
|
||||
|
||||
type
|
||||
@ -13,8 +13,6 @@ type
|
||||
private
|
||||
FCalendar: TVpCustomCalendar;
|
||||
// local variables of the old RenderToCanvas method of TVpCalendar
|
||||
// R, C: Integer;
|
||||
// I: Integer;
|
||||
SatCol: Integer;
|
||||
SunCol: Integer;
|
||||
DOW: TVpDayType;
|
||||
@ -23,6 +21,9 @@ type
|
||||
lDate: TDateTime;
|
||||
BevelHighlight: TColor;
|
||||
BevelShadow: TColor;
|
||||
ActiveDayColor: TColor;
|
||||
ActiveDayBorderColor: TColor;
|
||||
ActiveDayTextColor: TColor;
|
||||
InactiveDayColor: TColor;
|
||||
MonthYearColor: TColor;
|
||||
DayNameColor: TColor;
|
||||
@ -53,7 +54,7 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLProc, LazUtf8,
|
||||
LCLProc, LCLIntf, LazUtf8,
|
||||
{%H-}VpConst, VpCanvasUtils;
|
||||
|
||||
type
|
||||
@ -66,6 +67,9 @@ begin
|
||||
FCalendar := ACalendar;
|
||||
end;
|
||||
|
||||
{ Draws the day numbers in the calendar. Colors are used to distinguish
|
||||
normal days, weekend days, event days, inactive days (= overflow from adjacent
|
||||
months). }
|
||||
procedure TVpCalendarPainter.DrawAllDays;
|
||||
var
|
||||
I, R, C: Integer;
|
||||
@ -74,7 +78,7 @@ begin
|
||||
for R := 2 to 8 do
|
||||
for C := 0 to 6 do begin
|
||||
if ((C = SatCol) and (cdoHighlightSat in FCalendar.Options)) or
|
||||
((C = SunCol) and (cdoHighlightSun in Fcalendar.Options))
|
||||
((C = SunCol) and (cdoHighlightSun in FCalendar.Options))
|
||||
then
|
||||
RenderCanvas.Font.Color := WeekendColor
|
||||
else
|
||||
@ -108,12 +112,14 @@ begin
|
||||
end else
|
||||
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline];
|
||||
end;
|
||||
|
||||
with TVpCalendarOpener(FCalendar) do
|
||||
DrawDay(R, C, I, (I < clFirst) or (I > clLast));
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Draws the title "month year" between the navigation buttons }
|
||||
procedure TVpCalendarPainter.DrawDate;
|
||||
var
|
||||
R: TRect;
|
||||
@ -141,9 +147,9 @@ begin
|
||||
else
|
||||
S := FormatDateTime('mmm', RenderDate);
|
||||
|
||||
// switch to short date format if string won't fit
|
||||
// Switch to short date format if string won't fit
|
||||
if FCalendar.DateFormat = dfLong then
|
||||
if RenderCanvas.TextWidth(S) > R.Right - R.Left then
|
||||
if RenderCanvas.TextWidth(S) > WidthOf(R) then
|
||||
S := FormatDateTime('mmm yyyy', RenderDate);
|
||||
|
||||
{$IF FPC_FULLVERSION < 30000}
|
||||
@ -159,14 +165,15 @@ end;
|
||||
|
||||
procedure TVpCalendarPainter.DrawDay(R, C, I: Integer; Grayed: Boolean);
|
||||
var
|
||||
Cl: TColor;
|
||||
clr: TColor;
|
||||
day: Byte;
|
||||
OldIdx: Integer;
|
||||
NewIdx: Integer;
|
||||
S: string[10];
|
||||
DrawRect: TRect;
|
||||
TH: Integer;
|
||||
begin
|
||||
{avoid painting day number under buttons}
|
||||
// Avoid painting day number under buttons
|
||||
if cdoShowRevert in FCalendar.Options then
|
||||
if (R = 8) and (C >= 3) then
|
||||
Exit;
|
||||
@ -175,19 +182,23 @@ begin
|
||||
Exit;
|
||||
|
||||
{convert to a string and draw it centered in its rectangle}
|
||||
S := IntToStr(TVpCalendarOpener(FCalendar).clCalendar[I]);
|
||||
day := TVpCalendarOpener(FCalendar).clCalendar[I];
|
||||
S := IntToStr(day);
|
||||
|
||||
if Grayed then
|
||||
RenderCanvas.Font.Color := InactiveDayColor;
|
||||
RenderCanvas.Font.Color := InactiveDayColor
|
||||
else
|
||||
if (day = FCalendar.Day) then
|
||||
RenderCanvas.Font.Color := ActiveDayTextColor;
|
||||
|
||||
if not Grayed or (cdoShowInactive in FCalendar.Options) then begin
|
||||
NewIdx := ((R-2) * 7) + Succ(C);
|
||||
with TVpCalendarOpener(FCalendar) do
|
||||
OldIdx := clFirst + Pred(clDay);
|
||||
if Assigned(FCalendar.OnGetHighlight) then begin
|
||||
Cl := RenderCanvas.Font.Color;
|
||||
FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , Cl);
|
||||
RenderCanvas.Font.Color := Cl;
|
||||
clr := RenderCanvas.Font.Color;
|
||||
FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , clr);
|
||||
RenderCanvas.Font.Color := clr;
|
||||
end;
|
||||
with TVpCalendarOpener(FCalendar) do
|
||||
if Assigned(OnDrawItem) then
|
||||
@ -198,19 +209,19 @@ begin
|
||||
OffsetRect(DrawRect, RealLeft, RealTop);
|
||||
TH := RenderCanvas.TextHeight(S);
|
||||
if TH < DrawRect.Bottom - DrawRect.Top then
|
||||
DrawRect.Top := DrawRect.Top + ((DrawRect.Bottom - DrawRect.Top) - TH) div 2;
|
||||
DrawRect.Top := (DrawRect.Top + DrawRect.Bottom - TH) div 2;
|
||||
TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Draw the day name column labels }
|
||||
procedure TVpCalendarPainter.DrawDayNames;
|
||||
var
|
||||
I: Integer;
|
||||
S: string;
|
||||
DrawRect: TRect;
|
||||
begin
|
||||
{draw the day name column labels}
|
||||
RenderCanvas.Font.Color := DayNameColor;
|
||||
I := 0;
|
||||
DOW := FCalendar.WeekStarts;
|
||||
@ -262,6 +273,7 @@ begin
|
||||
if DisplayOnly then begin
|
||||
BevelHighlight := clBlack;
|
||||
BevelShadow := clBlack;
|
||||
ActiveDayColor := clBlack;
|
||||
InactiveDayColor := clSilver;
|
||||
MonthYearColor := clBlack;
|
||||
DayNameColor := clBlack;
|
||||
@ -273,56 +285,29 @@ begin
|
||||
end else begin
|
||||
BevelHighlight := clBtnHighlight;
|
||||
BevelShadow := clBtnShadow;
|
||||
ActiveDayColor := FCalendar.Colors.ActiveDay;
|
||||
ActiveDayBorderColor := FCalendar.Colors.ActiveDayBorder;
|
||||
ActiveDayTextColor := FCalendar.Colors.ActiveDayText;
|
||||
InactiveDayColor := FCalendar.Colors.InactiveDays;
|
||||
MonthYearColor := FCalendar.Colors.MonthAndYear;
|
||||
DayNameColor := FCalendar.Colors.DayNames;
|
||||
LineColor := FCalendar.Font.Color;
|
||||
EventDayColor := FCalendar.Colors.EventDays;
|
||||
DayColor := FCalendar.Colors.Days;
|
||||
RealColor := FCalendar.Color;
|
||||
RealColor := FCalendar.Colors.Background;
|
||||
WeekendColor := FCalendar.Colors.WeekEnd;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Draws a box around the selected day }
|
||||
procedure TVpCalendarPainter.DrawFocusBox;
|
||||
var
|
||||
R: TRect;
|
||||
S: string[10];
|
||||
begin
|
||||
S := IntToStr(TVpCalendarOpener(FCalendar).clDay);
|
||||
|
||||
{ set highlight color and font style for days with events }
|
||||
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold];
|
||||
lBadDate := false;
|
||||
|
||||
if (FCalendar.DataStore <> nil) and (FCalendar.DataStore.Resource <> nil) then begin
|
||||
DecodeDate(RenderDate, Y, M, D);
|
||||
try
|
||||
{$IFDEF VERSION6}
|
||||
if not TryEncodeDate (Y, M, TVpCalendarOpener(FCalendar).clDay, lDate) then
|
||||
lBadDate := true;
|
||||
{$ELSE}
|
||||
lDate := EncodeDate(Y, M, TVpCalendarOpener(FCalendar).clDay);
|
||||
{$ENDIF}
|
||||
except
|
||||
lBadDate := true;
|
||||
end;
|
||||
|
||||
if (not lBadDate) and (FCalendar.DataStore.Resource.Schedule.EventCountByDay(lDate) > 0)
|
||||
then begin
|
||||
RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold, fsUnderline];
|
||||
RenderCanvas.Font.Color := EventDayColor;
|
||||
end else
|
||||
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline];
|
||||
end;
|
||||
|
||||
R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle;
|
||||
R.Left := R.Left + RealLeft;
|
||||
R.Top := R.Top + RealTop;
|
||||
R.Right := R.Right + RealLeft;
|
||||
R.Bottom := R.Bottom + RealTop;
|
||||
|
||||
R := FCalendar.CurrentRectangle;
|
||||
OffsetRect(R, RealLeft, RealTop);
|
||||
R := TPSRotateRectangle (Angle, RenderIn, R);
|
||||
|
||||
if not DisplayOnly then begin
|
||||
{$IFNDEF LCL}
|
||||
if Focused then
|
||||
@ -331,11 +316,13 @@ begin
|
||||
DrawButtonFace (RenderCanvas, R, 1, bsNew, True, False, False);
|
||||
{$ENDIF}
|
||||
R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle;
|
||||
R.Left := R.Left + RealLeft;
|
||||
R.Top := R.Top + RealTop;
|
||||
R.Right := R.Right + RealLeft;
|
||||
R.Bottom := R.Bottom + RealTop;
|
||||
TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, R, S);
|
||||
InflateRect(R, -1, -1);
|
||||
OffsetRect(R, RealLeft, RealTop);
|
||||
|
||||
RenderCanvas.Pen.Color := ActiveDayBorderColor;
|
||||
RenderCanvas.Brush.Color := ActiveDayColor;
|
||||
RenderCanvas.Pen.Width := 1;
|
||||
TPSRectangle(RenderCanvas, Angle, RenderIn, R);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -395,23 +382,25 @@ begin
|
||||
RenderCanvas.Brush.Color := RealColor;
|
||||
RenderCanvas.FillRect(RenderIn);
|
||||
|
||||
{draw the month and year at the top of the calendar}
|
||||
// Draw the month and year at the top of the calendar
|
||||
DrawDate;
|
||||
|
||||
{draw the days of the week}
|
||||
// Draw the days of the week
|
||||
DrawDayNames;
|
||||
|
||||
{draw line under day names}
|
||||
// Draw line under day names
|
||||
DrawLine;
|
||||
|
||||
{draw each day}
|
||||
DrawAllDays;
|
||||
// Draw each day
|
||||
// DrawAllDays;
|
||||
|
||||
RenderCanvas.Font.Color := DayColor;
|
||||
if not Assigned(FCalendar.OnDrawItem) then
|
||||
if not (cdoHideActive in FCalendar.Options) then
|
||||
DrawFocusBox;
|
||||
|
||||
DrawAllDays;
|
||||
|
||||
finally
|
||||
RenderCanvas.Unlock;
|
||||
end;
|
||||
|
||||
Reference in New Issue
Block a user