pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Add new property HeadAttributes to TVpMonthView

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4981 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-15 19:13:00 +00:00
parent 6fe57df55d
commit 20cc1e5d9a
3 changed files with 104 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
components/tvplanit/examples/fulldemo/demomain.lfm
View File

@ -25,9 +25,9 @@ object MainForm: TMainForm
Height = 532
Top = 48
Width = 780
ActivePage = TabTasks
ActivePage = TabEvents
Align = alClient
TabIndex = 1
TabIndex = 0
TabOrder = 0
object TabEvents: TTabSheet
Caption = 'Events'
@ -61,6 +61,9 @@ object MainForm: TMainForm
DayNameStyle = dsShort
DrawingStyle = dsFlat
EventDayStyle = [fsItalic]
HeadAttributes.Font.Height = -13
HeadAttributes.Font.Style = [fsItalic]
HeadAttributes.Color = clBtnFace
LineColor = clGray
TimeFormat = tf12Hour
OffDayColor = clSilver
@ -105,6 +108,7 @@ object MainForm: TMainForm
TimeSlotColors.ActiveRange.RangeBegin = h_00
TimeSlotColors.ActiveRange.RangeEnd = h_00
HeadAttributes.Font.Height = -13
HeadAttributes.Font.Style = [fsItalic]
HeadAttributes.Color = clBtnFace
RowHeadAttributes.HourFont.Height = -24
RowHeadAttributes.MinuteFont.Height = -12
@ -251,7 +255,8 @@ object MainForm: TMainForm
DayHeadAttributes.Bordered = True
DrawingStyle = dsFlat
EventFont.Height = -12
HeadAttributes.Font.Height = -12
HeadAttributes.Font.Height = -13
HeadAttributes.Font.Style = [fsItalic]
HeadAttributes.Color = clBtnFace
LineColor = clGray
TimeFormat = tf12Hour
@ -325,7 +330,8 @@ object MainForm: TMainForm
LineColor = clGray
MaxVisibleTasks = 250
TaskHeadAttributes.Color = clSilver
TaskHeadAttributes.Font.Height = -12
TaskHeadAttributes.Font.Height = -13
TaskHeadAttributes.Font.Style = [fsItalic]
DrawingStyle = ds3d
ShowResourceName = True
end

72
components/tvplanit/source/vpmonthview.pas
View File

@ -59,6 +59,22 @@ type
TVpOnEventClick =
procedure(Sender: TObject; Event: TVpEvent) of object;
TVpMvHeadAttributes = class(TPersistent)
protected{ private }
FOwner: TVpMonthView;
FColor: TColor;
FFont: TVpFont;
procedure SetColor(const Value: TColor);
procedure SetFont(Value: TVpFont);
public
constructor Create(AOwner: TVpMonthView);
destructor Destroy; override;
property Owner: TVpMonthView read FOwner;
published
property Font: TVpFont read FFont write SetFont;
property Color: TColor read FColor write SetColor;
end;
TVpDayHeadAttr = class(TPersistent)
protected{private}
FMonthView: TVpMonthView;
@ -96,6 +112,7 @@ type
FShowEventTime : Boolean;
FTopLine : Integer;
FDayHeadAttributes : TVpDayHeadAttr;
FHeadAttr : TVpMvHeadAttributes;
FDayNumberFont : TVpFont;
FEventFont : TVpFont;
FTimeFormat : TVpTimeFormat;
@ -144,7 +161,7 @@ type
procedure SetShowEventTime(Value: Boolean);
procedure SetTimeFormat(Value: TVpTimeFormat);
procedure SetDate(Value: TDateTime);
procedure SetRightClickChangeDate (const v : Boolean);
procedure SetRightClickChangeDate(const v: Boolean);
procedure SetWeekStartsOn(Value: TVpDayType);
{ internal methods }
procedure mvHookUp;
@ -163,7 +180,7 @@ type
procedure WMLButtonDblClick(var Msg: TWMLButtonDblClk);
message WM_LBUTTONDBLCLK;
{$ELSE}
procedure WMLButtonDown(var Msg : TLMLButtonDown);
procedure WMLButtonDown(var Msg: TLMLButtonDown);
message LM_LBUTTONDOWN;
procedure WMLButtonDblClick(var Msg: TLMLButtonDblClk);
message LM_LBUTTONDBLCLK;
@ -175,8 +192,8 @@ type
{ message handlers }
{$IFNDEF LCL}
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
procedure WMRButtonDown(var Msg : TWMRButtonDown); message WM_RBUTTONDOWN;
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
procedure WMRButtonDown(var Msg: TWMRButtonDown); message WM_RBUTTONDOWN;
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey);
message CM_WANTSPECIALKEY;
{$ELSE}
@ -184,11 +201,12 @@ type
procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS;
procedure WMRButtonDown(var Msg: TLMRButtonDown); message LM_RBUTTONDOWN;
{$ENDIF}
procedure PopupToday (Sender : TObject);
procedure PopupNextMonth (Sender : TObject);
procedure PopupPrevMonth (Sender : TObject);
procedure PopupNextYear (Sender : TObject);
procedure PopupPrevYear (Sender : TObject);
procedure PopupToday(Sender: TObject);
procedure PopupNextMonth(Sender: TObject);
procedure PopupPrevMonth(Sender: TObject);
procedure PopupNextYear(Sender: TObject);
procedure PopupPrevYear(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -213,6 +231,7 @@ type
DisplayOnly : Boolean); override;
property Date: TDateTime read FDate write SetDate;
published
{ inherited properties }
property Align;
@ -237,6 +256,8 @@ type
read FEventDayStyle write SetEventDayStyle;
property EventFont: TVpFont
read FEventFont write SetEventFont;
property HeadAttributes: TVpMvHeadAttributes
read FHeadAttr write FHeadAttr;
property LineColor: TColor
read FLineColor write SetLineColor;
property TimeFormat: TVpTimeFormat
@ -270,6 +291,38 @@ implementation
uses
SysUtils, LazUTF8, Forms, Dialogs, VpMonthViewPainter;
(*****************************************************************************)
{ TVpMvHeadAttributes }
constructor TVpMvHeadAttributes.Create(AOwner: TVpMonthView);
begin
inherited Create;
FOwner := AOwner;
FColor := clBtnFace;
FFont := TVpFont.Create(AOwner);
end;
destructor TVpMvHeadAttributes.Destroy;
begin
FFont.Free;
inherited;
end;
procedure TVpMvHeadAttributes.SetColor(const Value: TColor);
begin
if FColor <> Value then begin
FColor := Value;
FOwner.Invalidate;
end;
end;
procedure TVpMvHeadAttributes.SetFont(Value: TVpFont);
begin
FFont.Assign(Value);
end;
(*****************************************************************************)
{ TVpContactHeadAttr }
constructor TVpDayHeadAttr.Create(AOwner: TVpMonthView);
@ -316,6 +369,7 @@ begin
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
{ Create internal classes and stuff }
FHeadAttr := TVpMvHeadAttributes.Create(self);
FDayHeadAttributes := TVpDayHeadAttr.Create(self);
mvEventList := TList.Create;
mvSpinButtons := TUpDown.Create(self);

67
components/tvplanit/source/vpmonthviewpainter.pas
View File

@ -21,6 +21,7 @@ type
BevelDarkShadow: TColor;
BevelFace: TColor;
DayHeadAttrColor: TColor;
HeadAttrColor: TColor;
RealLineColor: TColor;
RealOffDayColor: TColor;
RealSelDayColor: TColor;
@ -246,6 +247,7 @@ var
OldBrush: TBrush;
OldPen: TPen;
OldFont: TFont;
dx: Integer;
begin
{ initialize the MonthDayArray }
with TVpMonthViewOpener(FMonthView) do
@ -347,6 +349,9 @@ begin
{ set the proper font and style }
RenderCanvas.Font.Assign(FMonthView.DayNumberFont);
fontstyle := Rendercanvas.Font.style;
if (DisplayDate = ThisDate) then begin
if FMonthView.Focused then begin
TPSDrawFocusRect(
@ -389,23 +394,17 @@ begin
{ write the day number at the top of the square. }
if fsItalic in RenderCanvas.Font.Style then
TPSTextOut(
RenderCanvas,
Angle,
RenderIn,
TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth - TextAdjust - TextMargin - 2,
TextRect.Top + TextMargin div 2,
Str
)
dx := -2
else
TPSTextOut(
RenderCanvas,
Angle,
RenderIn,
TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth - TextAdjust - TextMargin,
TextRect.Top + TextMargin div 2,
Str
);
dx := 0;
TPSTextOut(
RenderCanvas,
Angle,
RenderIn,
TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth - TextAdjust - TextMargin + dx,
TextRect.Top + TextMargin div 2,
Str
);
{ Update MonthDayArray }
with TVpMonthViewOpener(FMonthView) do begin
@ -517,23 +516,17 @@ begin
RenderCanvas.Font.Color := FMonthView.OffdayFontColor;
if fsItalic in RenderCanvas.Font.Style then
TPSTextOut(
RenderCanvas,
Angle,
RenderIn,
TextRect.Right - TextAdjust - TextMargin - 2,
TextRect.Top + TextMargin div 2,
Str
)
dx := -2
else
TPSTextOut(
RenderCanvas,
Angle,
RenderIn,
TextRect.Right - TextAdjust - TextMargin,
TextRect.Top + TextMargin div 2,
Str
);
dx := 0;
TPSTextOut(
RenderCanvas,
Angle,
RenderIn,
TextRect.Right - TextAdjust - TextMargin + dx,
TextRect.Top + TextMargin div 2,
Str
);
{ Update Array }
with TVpMonthViewOpener(FMonthView) do begin
@ -716,8 +709,7 @@ var
dayHeadHeight: Integer;
R: TRect;
begin
RenderCanvas.Brush.Color := DayHeadAttrColor;
RenderCanvas.Brush.Color := HeadAttrColor;
dayHeadHeight := TVpMonthViewOpener(FMonthView).mvDayHeadHeight;
HeadRect := Rect(RealLeft, RealTop, RealRight, RealTop + dayHeadHeight);
@ -755,7 +747,7 @@ begin
{$ENDIF}{$ENDIF}
{ Calculate the text rectangle }
RenderCanvas.Font.Assign(FMonthView.DayHeadAttributes.Font);
RenderCanvas.Font.Assign(FMonthView.HeadAttributes.Font);
if DisplayOnly and (RenderCanvas.TextWidth(HeadStr) >= RealWidth) then
HeadTextRect.Left:= RealLeft + TextMargin * 2
else
@ -779,7 +771,7 @@ begin
end;
// Draw the text
RenderCanvas.Font.Assign(FMonthView.DayHeadAttributes.Font);
RenderCanvas.Font.Assign(FMonthView.HeadAttributes.Font);
TPSTextOut(
RenderCanvas,
Angle,
@ -793,6 +785,7 @@ end;
procedure TVpMonthViewPainter.FixFontHeights;
begin
with FMonthView do begin
HeadAttributes.Font.Height := GetRealFontHeight(HeadAttributes.Font);
DayHeadAttributes.Font.Height := GetRealFontHeight(DayHeadAttributes.Font);
DayNumberFont.Height := GetRealFontHeight(DayNumberFont);
EventFont.Height := GetRealFontHeight(EventFont);
@ -809,6 +802,7 @@ begin
BevelFace := clBlack;
RealColor := clWhite;
DayHeadAttrColor := clSilver;
HeadAttrColor := clSilver;
RealLineColor := clBlack;
RealOffDayColor := clSilver;
RealSelDayColor := clWhite;
@ -819,6 +813,7 @@ begin
BevelDarkShadow := cl3DDkShadow;
BevelFace := clBtnFace;
RealColor := FMonthView.Color;
HeadAttrColor := FMonthView.HeadAttributes.Color;
DayHeadAttrColor := FMonthView.DayHeadAttributes.Color;
RealLineColor := FMonthView.LineColor;
RealOffDayColor := FMonthView.OffDayColor;