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

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8346 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-07-12 14:31:42 +00:00
parent cf88b7c792
commit 2e2d9f18bf
14 changed files with 133 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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

1
components/tvplanit/examples/fulldemo/demomain.lrj
View File

@ -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..."},

13
components/tvplanit/examples/fulldemo/demomain.pas
View File

@ -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

5
components/tvplanit/languages/demo.de.po
View File

@ -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 ""

7
components/tvplanit/languages/demo.en.po
View File

@ -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"

4
components/tvplanit/languages/demo.fi.po
View File

@ -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 ""

4
components/tvplanit/languages/demo.nl.po
View File

@ -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 ""

4
components/tvplanit/languages/demo.pl.po
View File

@ -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"

4
components/tvplanit/languages/demo.pot
View File

@ -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 ""

4
components/tvplanit/languages/demo.ru.po
View File

@ -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 ""

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

@ -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);

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

@ -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
then RenderCanvas.Brush.Color := RealOffDayColor
else RenderCanvas.Brush.Color := RealColor;
if TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].OffDay then
RenderCanvas.Brush.Color := RealOffDayColor
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);

16
components/tvplanit/source/vpweekview.pas
View File

@ -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;
{=====}

10
components/tvplanit/source/vpweekviewpainter.pas
View File

@ -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);