tvplanit: Add new property HeadAttributes to TVpMonthView

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4981 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-07-15 19:13:00 +00:00
parent 6fe57df55d
commit 20cc1e5d9a
3 changed files with 104 additions and 49 deletions
--- a/components/tvplanit/examples/fulldemo/demomain.lfm
+++ b/components/tvplanit/examples/fulldemo/demomain.lfm
@ -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
--- a/components/tvplanit/source/vpmonthview.pas
+++ b/components/tvplanit/source/vpmonthview.pas
@ -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);
--- a/components/tvplanit/source/vpmonthviewpainter.pas
+++ b/components/tvplanit/source/vpmonthviewpainter.pas
@ -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,20 +394,14 @@ 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
+                dx := 0;
              TPSTextOut(
                RenderCanvas,
                Angle,
                RenderIn,
-                  TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth - TextAdjust - TextMargin,
+                TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth - TextAdjust - TextMargin + dx,
                TextRect.Top + TextMargin div 2,
                Str
              );
@ -517,20 +516,14 @@ 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
+                dx := 0;
              TPSTextOut(
                RenderCanvas,
                Angle,
                RenderIn,
-                  TextRect.Right - TextAdjust - TextMargin,
+                TextRect.Right - TextAdjust - TextMargin + dx,
                TextRect.Top + TextMargin div 2,
                Str
              );
@ -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;