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

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

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

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

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