tvplanit: New property ApplyCategoryInfos for week and month view. Some tweaking of text positions in month view.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8346 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/examples/fulldemo/demomain.lfm

@@ -19,7 +19,7 @@ object MainForm: TMainForm
     BevelOuter = bvNone
     ClientHeight = 596
     ClientWidth = 834
-    TabOrder = 0
+    TabOrder = 2
     object HeaderPanel: TPanel
       Left = 2
       Height = 48
@@ -58,7 +58,7 @@ object MainForm: TMainForm
       Height = 548
       Top = 48
       Width = 834
-      PageIndex = 0
+      PageIndex = 4
       Align = alClient
       TabOrder = 1
       TabStop = True
@@ -740,6 +740,18 @@ object MainForm: TMainForm
           State = cbChecked
           TabOrder = 8
         end
+        object CbApplyCategoryInfos: TCheckBox
+          AnchorSideLeft.Control = CbAllowInplaceEditing
+          AnchorSideTop.Control = CbDrawingStyle
+          AnchorSideTop.Side = asrCenter
+          Left = 316
+          Height = 19
+          Top = 178
+          Width = 266
+          Caption = 'Apply category colors to week and month view'
+          OnChange = CbApplyCategoryInfosChange
+          TabOrder = 9
+        end
       end
     end
   end

components/tvplanit/examples/fulldemo/demomain.lrj

@@ -21,6 +21,7 @@
 {"hash":248087155,"name":"tmainform.cballowdraganddrop.caption","sourcebytes":[65,108,108,111,119,32,100,114,97,103,32,97,110,100,32,100,114,111,112,32,111,102,32,101,118,101,110,116,115],"value":"Allow drag and drop of events"},
 {"hash":216343376,"name":"tmainform.cbdragdroptransparent.caption","sourcebytes":[84,114,97,110,115,112,97,114,101,110,116,32,100,114,97,103,32,97,110,100,32,100,114,111,112],"value":"Transparent drag and drop"},
 {"hash":17060163,"name":"tmainform.cbshoweventhints.caption","sourcebytes":[83,104,111,119,32,101,118,101,110,116,32,97,110,100,32,99,111,110,116,97,99,116,32,104,105,110,116,115],"value":"Show event and contact hints"},
+{"hash":245274983,"name":"tmainform.cbapplycategoryinfos.caption","sourcebytes":[65,112,112,108,121,32,99,97,116,101,103,111,114,121,32,99,111,108,111,114,115,32,116,111,32,119,101,101,107,32,97,110,100,32,109,111,110,116,104,32,118,105,101,119],"value":"Apply category colors to week and month view"},
 {"hash":315429,"name":"tmainform.menuitem1.caption","sourcebytes":[70,105,108,101],"value":"File"},
 {"hash":109668078,"name":"tmainform.mnueditprintformats.caption","sourcebytes":[69,100,105,116,32,112,114,105,110,116,32,102,111,114,109,97,116,115,46,46,46],"value":"Edit print formats..."},
 {"hash":25869902,"name":"tmainform.mnuloadprintformats.caption","sourcebytes":[76,111,97,100,32,112,114,105,110,116,32,102,111,114,109,97,116,115,46,46,46],"value":"Load print formats..."},

components/tvplanit/examples/fulldemo/demomain.pas

@@ -32,6 +32,7 @@ type
     CbAllowDragAndDrop: TCheckBox;
     CbDragDropTransparent: TCheckBox;
     CbShowEventHints: TCheckBox;
+    CbApplyCategoryInfos: TCheckBox;
     lblOtherResources: TLabel;
     lblResources: TLabel;
     lbOtherResources: TCheckListBox;
@@ -97,6 +98,7 @@ type
     procedure CbAddressBuilderChange(Sender: TObject);
     procedure CbAllowDragAndDropChange(Sender: TObject);
     procedure CbAllowInplaceEditingChange(Sender: TObject);
+    procedure CbApplyCategoryInfosChange(Sender: TObject);
     procedure CbDragDropTransparentChange(Sender: TObject);
     procedure CbDrawingStyleChange(Sender: TObject);
     procedure CbFirstDayOfWeekChange(Sender: TObject);
@@ -414,6 +416,12 @@ begin
   VpTaskList1.AllowInplaceEditing := CbAllowInplaceEditing.Checked;
 end;
 
+procedure TMainForm.CbApplyCategoryInfosChange(Sender: TObject);
+begin
+  VpWeekView1.ApplyCategoryInfos := CbApplyCategoryInfos.Checked;
+  VpMonthView1.ApplyCategoryInfos := CbApplyCategoryInfos.Checked;
+end;
+
 procedure TMainForm.CbDragDropTransparentChange(Sender: TObject);
 begin
   VpDayView1.DragDropTransparent := CbDragDropTransparent.Checked;
@@ -886,6 +894,10 @@ begin
       CbShowEventHints.Checked);
     CbShowEventHintsChange(nil);
 
+    CbApplyCategoryInfos.Checked := ini.ReadBool('Settings', 'ApplyCategoryInfos',
+      CbApplyCategoryInfos.Checked);
+    CbApplyCategoryInfosChange(nil);
+    
     FResID := ini.ReadInteger('Data', 'ResourceID', -1);
   finally
     ini.Free;
@@ -940,6 +952,7 @@ begin
     ini.WriteBool('Settings', 'AllowDragAndDrop', CbAllowDragAndDrop.Checked);
     ini.WriteBool('Settings', 'DragAndDropTransparent', CbDragDropTransparent.Checked);
     ini.WriteBool('Settings', 'ShowEventHints', CbShowEventHints.Checked);
+    ini.WriteBool('Settings', 'ApplyCategoryInfos', CbApplyCategoryInfos.Checked);
 
     ini.WriteInteger('Data', 'ResourceID', VpControlLink1.Datastore.ResourceID);
   finally

components/tvplanit/languages/demo.de.po

@@ -170,6 +170,10 @@ msgstr "Drag-and-Drop von Terminen erlauben"
 msgid "Allow inplace editing"
 msgstr "Bearbeiten im Planer erlauben"
 
+#: tmainform.cbapplycategoryinfos.caption
+msgid "Apply category colors to week and month view"
+msgstr "Kategorie-Farben in Wochen- und Monatsansicht verwenden"
+
 #: tmainform.cbdragdroptransparent.caption
 msgid "Transparent drag and drop"
 msgstr "Transparenter Hintergrund beim Drag-and-Drop"
@@ -278,4 +282,3 @@ msgstr "Erledigte Aufgaben verbergen"
 #: tmainform.titlelbl.caption
 msgid "TitleLbl"
 msgstr ""
-

components/tvplanit/languages/demo.en.po

@@ -9,7 +9,7 @@ msgstr ""
 "MIME-Version: 1.0\n"
 "Content-Type: text/plain; charset=UTF-8\n"
 "Content-Transfer-Encoding: 8bit\n"
-"X-Generator: Poedit 3.0.1\n"
+"X-Generator: Poedit 3.1\n"
 
 #: demomain.rs10min
 msgid "10 min"
@@ -167,6 +167,10 @@ msgstr "Allow drag and drop of events"
 msgid "Allow inplace editing"
 msgstr "Allow inplace editing"
 
+#: tmainform.cbapplycategoryinfos.caption
+msgid "Apply category colors to week and month view"
+msgstr "Apply category colors to week and month view"
+
 #: tmainform.cbdragdroptransparent.caption
 msgid "Transparent drag and drop"
 msgstr "Transparent drag and drop"
@@ -275,4 +279,3 @@ msgstr "Hide completed tasks"
 #: tmainform.titlelbl.caption
 msgid "TitleLbl"
 msgstr "TitleLbl"
-

components/tvplanit/languages/demo.fi.po

@@ -160,6 +160,10 @@ msgstr ""
 msgid "Allow inplace editing"
 msgstr ""
 
+#: tmainform.cbapplycategoryinfos.caption
+msgid "Apply category colors to week and month view"
+msgstr ""
+
 #: tmainform.cbdragdroptransparent.caption
 msgid "Transparent drag and drop"
 msgstr ""

components/tvplanit/languages/demo.nl.po

@@ -159,6 +159,10 @@ msgstr ""
 msgid "Allow inplace editing"
 msgstr ""
 
+#: tmainform.cbapplycategoryinfos.caption
+msgid "Apply category colors to week and month view"
+msgstr ""
+
 #: tmainform.cbdragdroptransparent.caption
 msgid "Transparent drag and drop"
 msgstr ""

components/tvplanit/languages/demo.pl.po

@@ -170,6 +170,10 @@ msgstr "Pozwól na drag and drop wydarzeń"
 msgid "Allow inplace editing"
 msgstr "Pozwól na bezpośrednią edycję"
 
+#: tmainform.cbapplycategoryinfos.caption
+msgid "Apply category colors to week and month view"
+msgstr ""
+
 #: tmainform.cbdragdroptransparent.caption
 msgid "Transparent drag and drop"
 msgstr "Przeźroczyste tło podczas drag and drop"

components/tvplanit/languages/demo.pot

@@ -157,6 +157,10 @@ msgstr ""
 msgid "Allow inplace editing"
 msgstr ""
 
+#: tmainform.cbapplycategoryinfos.caption
+msgid "Apply category colors to week and month view"
+msgstr ""
+
 #: tmainform.cbdragdroptransparent.caption
 msgid "Transparent drag and drop"
 msgstr ""

components/tvplanit/languages/demo.ru.po

@@ -169,6 +169,10 @@ msgstr ""
 msgid "Allow inplace editing"
 msgstr ""
 
+#: tmainform.cbapplycategoryinfos.caption
+msgid "Apply category colors to week and month view"
+msgstr ""
+
 #: tmainform.cbdragdroptransparent.caption
 msgid "Transparent drag and drop"
 msgstr ""

components/tvplanit/source/vpmonthview.pas

@@ -146,6 +146,8 @@ type
     FOnHoliday: TVpHolidayEvent;
     FAllowDragAndDrop: Boolean;
     FDragDropTransparent: Boolean;
+    FApplyCategoryInfos: Boolean;
+    procedure SetApplyCategoryInfos(AValue: Boolean);
   protected{ private }
     FKBNavigate: Boolean;
     FColumnWidth: Integer;
@@ -314,6 +316,7 @@ type
     property TabStop;
     property TabOrder;
     property AllowDragAndDrop: Boolean read FAllowDragAndDrop write FAllowDragAndDrop default false;
+    property ApplyCategoryInfos: Boolean read FApplyCategoryInfos write SetApplyCategoryInfos default false;
     property Color: TColor read FColor write SetColor;
     property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat;
     property DayHeadAttributes: TVpMonthviewAttr read FDayHeadAttr write FDayHeadAttr;
@@ -765,7 +768,15 @@ begin
 
   Date := EncodeDate(Y, M, D);
 end;
-{=====}
+
+procedure TVpMonthView.SetApplyCategoryInfos(AValue: Boolean);
+begin
+  if FApplyCategoryInfos <> AValue then
+  begin
+    FApplyCategoryInfos := AValue;
+    Invalidate;
+  end;
+end;
 
 procedure TVpMonthView.SetColor(Value: TColor);
 begin
@@ -774,25 +785,22 @@ begin
     Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetDrawingStyle(Value: TVpDrawingStyle);
 begin
   if FDrawingStyle <> Value then begin
     FDrawingStyle := Value;
-    Repaint;
+    Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetLineColor(Value: TColor);
 begin
   if FLineColor <> Value then begin
     FLineColor := Value;
-    Repaint;
+    Invalidate
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetOffDayColor(Value: TColor);
 begin
@@ -801,14 +809,12 @@ begin
     Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetOffDayFontColor(Value: TColor);
 begin
   FOffDayFontColor := Value;
   Invalidate;
 end;
-{=====}
 
 procedure TVpMonthView.SetDateLabelFormat(Value: string);
 begin
@@ -817,7 +823,6 @@ begin
     Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetShowEvents(Value: Boolean);
 begin
@@ -826,7 +831,6 @@ begin
     Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetEventDayStyle(Value: TFontStyles);
 begin
@@ -835,7 +839,6 @@ begin
     Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetDayNameStyle(Value: TVpMVDayNameStyle);
 begin
@@ -844,21 +847,18 @@ begin
     Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetDayNumberFont(Value: TVpFont);
 begin
   FDayNumberFont.Assign(Value);
   Invalidate;
 end;
-{=====}
 
 procedure TVpMonthView.SetEventFont(Value: TVpFont);
 begin
   FEventFont.Assign(Value);
   Invalidate;
 end;
-{=====}
 
 procedure TVpMonthView.SetSelectedDayColor(Value: TColor);
 begin
@@ -867,7 +867,6 @@ begin
     Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetShowEventTime(Value: Boolean);
 begin
@@ -876,7 +875,6 @@ begin
     Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetTimeFormat(Value: TVpTimeFormat);
 begin
@@ -885,7 +883,6 @@ begin
     Invalidate;
   end;
 end;
-{=====}
 
 procedure TVpMonthView.SetDate(Value: TDateTime);
 begin
@@ -903,7 +900,6 @@ begin
       ControlLink.Notify(self, neDateChange, FDate);
   end;
 end;
-{=====}
 
 {$IFNDEF LCL}
 procedure TVpMonthView.WMSize(var Msg: TWMSize);

components/tvplanit/source/vpmonthviewpainter.pas

@@ -12,6 +12,7 @@ type
   TVpMonthViewPainter = class(TVpBasePainter)
   private
     FMonthView: TVpMonthView;
+    
     // local parameters of the old TVpMonthView method
     DisplayDate: TDateTime;
     DisplayMonth: Word;
@@ -31,7 +32,7 @@ type
     DotDotDotColor: TColor;
     FCurrHoliday: String;
 
-    // protected variables of the original monthview needed only for painting
+    // These variables were protected in the original monthview, but are needed only for painting
     mvEventTextHeight: Integer;
     mvDayNumberHeight: Integer;
     mvRowHeight: Integer;
@@ -221,7 +222,7 @@ begin
   if ACol = 6 then
     tmpRect.Left := ATextRect.Left + mvColWidth - TextAdjust - TextMargin
   else
-    tmpRect.Left := ATextRect.Right - TextAdjust - TextMargin;
+    tmpRect.Left := ATextRect.Right - TextAdjust - TextMargin + 2;
   if fsItalic in RenderCanvas.Font.Style then
     dec(tmpRect.Left, 2);
   tmpRect.Top := ATextRect.Top + TextMargin div 2;
@@ -230,6 +231,7 @@ begin
 
   { Highlight today by a border }
   if ADate = todayDate then begin
+    OffsetRect(tmpRect, 2, 0);
     InflateRect(tmpRect, 3, 3);
     RenderCanvas.Pen.Assign(FMonthView.TodayAttributes.BorderPen);
     RenderCanvas.Brush.Color := FMonthView.TodayAttributes.Color;
@@ -449,7 +451,7 @@ begin
           for Col := 0 to 6 do begin
             ThisDate := Trunc(StartingDate + DayNumber);
 
-            { Check and store if the this date is a holiday }
+            { Check and store if this date is a holiday }
             FMonthView.IsHoliday(ThisDate, FCurrHoliday);
 
             OldBrush.Assign(RenderCanvas.Brush);
@@ -490,12 +492,16 @@ procedure TVpMonthViewPainter.DrawEvents;
 var
   I, J: Integer;
   EventList: TList;
+  event: TVpEvent;
+  eventCat: TVpCategoryInfo;
   dayRect: TRect;
   TextRect: TRect;
+  tmpRect: TRect;
   Str: String;
   StrLen: Integer;
   P: TPoint;
   visibleEvents: Integer;
+  brushCol: TColor;
 begin
   RenderCanvas.Pen.Color := RealLineColor;
   RenderCanvas.Pen.Style := psSolid;
@@ -518,19 +524,21 @@ begin
           dayRect := TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].Rec;
 
           { initialize TextRect for this day }
-          TextRect.TopLeft := Point(dayRect.Left, dayRect.Top);
+          TextRect.TopLeft := Point(dayRect.Left+1, dayRect.Top+1);
           TextRect.BottomRight := Point(
             TextRect.Left + mvColWidth,
-            TextRect.Top + mvEventTextHeight + TextMargin div 2
+            TextRect.Top + mvEventTextHeight + TextMargin// div 2
           );
 
           { set canvas color }
-          if TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].OffDay
+          if TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].OffDay then
-            then RenderCanvas.Brush.Color := RealOffDayColor
+            RenderCanvas.Brush.Color := RealOffDayColor
-            else RenderCanvas.Brush.Color := RealColor;
+          else 
+            RenderCanvas.Brush.Color := RealColor;            
 
           { spin through the events and paint them }
           for J := 0 to Pred(EventList.Count) do begin
+            event := TVpEvent(EventList[j]);
             if (TextRect.Bottom > dayRect.Bottom) and (J <= Pred(EventList.Count)) then
             begin
               { draw a little red square with a (...) at the bottom right }
@@ -544,12 +552,26 @@ begin
             { to give the day number enough room }
             if (TextRect.Top < dayRect.Top + mvDayNumberHeight + TextMargin div 2)
             then
-              TextRect.Right := TextRect.Left + mvColWidth - mvDayNumberHeight - TextMargin
+              TextRect.Right := TextRect.Left + mvColWidth - mvDayNumberHeight - TextMargin * 2
             else
-              TextRect.Right := TextRect.Left + mvColWidth;
+              TextRect.Right := TextRect.Left + mvColWidth - 3;
+
+            if Assigned(FMonthView.Datastore) and FMonthView.ApplyCategoryInfos then
+            begin
+              brushCol := RenderCanvas.Brush.Color;
+              eventCat := FMonthView.Datastore.CategoryColorMap.GetCategory(event.Category);
+              if Assigned(eventCat) then
+              begin
+                tmpRect := TextRect;
+                InflateRect(tmpRect, -1, -1);
+                RenderCanvas.Brush.Color := eventCat.BackgroundColor;
+                TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
+              end;
+              RenderCanvas.Brush.Color := brushCol;
+            end;
             
             { Construct the display text }
-            Str := FMonthView.BuildEventString(TVpEvent(EventList[j]), FMonthView.ShowEventTime, true);
+            Str := FMonthView.BuildEventString(event, FMonthView.ShowEventTime, true);
 
             { set the event font }
             RenderCanvas.Font.Assign(FMonthView.EventFont);
@@ -590,12 +612,14 @@ procedure TVpMonthViewPainter.DrawFocusRect(ARect: TRect; FixRight: Boolean = fa
 var
   tmpRect: TRect;
 begin
+  (*
   tmpRect := ARect;
   InflateRect(tmpRect, 2, 2);
   TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, tmpRect);
-
+    *)
   tmpRect := ARect;
-  InflateRect(tmpRect, -2, -2);
+//  InflateRect(tmpRect, -2, -2);
+  InflateRect(tmpRect, -1, -1);
   if FixRight then
     inc(tmpRect.Right);
   TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, tmpRect);
@@ -653,7 +677,7 @@ begin
   RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
   {$ENDIF}
   if DisplayOnly and (RenderCanvas.TextWidth(HeadStr) >= RealWidth) then
-    HeadTextRect.Left:= RealLeft + TextMargin * 2
+    HeadTextRect.Left := RealLeft + TextMargin * 2
   else
   if DisplayOnly then
     HeadTextRect.Left := RealLeft + (RealWidth - RenderCanvas.TextWidth(HeadStr)) div 2

components/tvplanit/source/vpweekview.pas

@@ -132,6 +132,7 @@ type
     FLayout: TVpWeekviewLayout;
     FOnHoliday: TVpHolidayEvent;
     procedure SetActiveEvent(AValue: TVpEvent);
+    procedure SetApplyCategoryInfos(AValue: Boolean);
     procedure SetLayout(AValue: TVpWeekviewLayout);
   protected{ private }
     FActiveDate: TDateTime;
@@ -153,6 +154,7 @@ type
     FAllDayEventAttr: TVpAllDayEventAttributes;
     FAllowInplaceEdit: Boolean;
     FAllowDragAndDrop: Boolean;
+    FApplyCategoryInfos: Boolean;
     FDragDropTransparent: Boolean;
     { event variables }
     FBeforeEdit: TVpBeforeEditEvent;
@@ -294,6 +296,7 @@ type
     property AllDayEventAttributes: TVpAllDayEventAttributes read FAllDayEventAttr write FAllDayEventAttr;
     property AllowDragAndDrop: Boolean read FAllowDragAndDrop write FAllowDragAndDrop default false;
     property AllowInplaceEditing: Boolean read FAllowInplaceEdit write FAllowInplaceEdit default true;
+    property ApplyCategoryInfos: Boolean read FApplyCategoryInfos write SetApplyCategoryInfos default false;
     property Color: TColor read FColor write SetColor;
     property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat;
     property DayHeadAttributes: TVpDayHeadAttr read FDayHeadAttributes write FDayHeadAttributes;
@@ -801,11 +804,20 @@ begin
   FActiveEvent := AValue;
 end;
 
+procedure TVpWeekView.SetApplyCategoryInfos(AValue: Boolean);
+begin
+  if FApplyCategoryInfos <> AValue then
+  begin
+    FApplyCategoryInfos := AValue;
+    Invalidate;
+  end;
+end;
+
 procedure TVpWeekView.SetDrawingStyle(Value: TVpDrawingStyle);
 begin
   if FDrawingStyle <> Value then begin
     FDrawingStyle := Value;
-    Repaint;
+    Invalidate;
   end;
 end;
 {=====}
@@ -814,7 +826,7 @@ procedure TVpWeekView.SetLineColor(Value: TColor);
 begin
   if FLineColor <> Value then begin
     FLineColor := Value;
-    Repaint;
+    Invalidate;
   end;
 end;
 {=====}

components/tvplanit/source/vpweekviewpainter.pas

@@ -531,6 +531,7 @@ var
   todayEndTime: TDateTime;
   strLen: Integer;
   oldFontColor: TColor;
+  eventCat: TVpCategoryInfo;
 begin
   oldFontColor := RenderCanvas.Font.Color;
 
@@ -554,6 +555,15 @@ begin
   if AEvent.IsOverlayed then
     RenderCanvas.Font.Color := clGray;
   RenderCanvas.Brush.Color := RealColor;
+  if Assigned(FWeekView.Datastore) and FWeekView.ApplyCategoryInfos then
+  begin
+    eventCat := FWeekView.Datastore.CategoryColorMap.GetCategory(AEvent.Category);  
+    if Assigned(eventCat) then
+    begin
+      RenderCanvas.Brush.Color := eventCat.BackgroundColor;
+      TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect);
+    end;
+  end;
 
   { Build the event text }
   dayStr := FWeekView.BuildEventString(AEvent, todayStartTime, todayEndTime, false);