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

tvplanit: Fix all-day events in WeekView

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4916 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-05 08:42:08 +00:00
parent 7e44228076
commit 5370e6afa1
2 changed files with 110 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -578,17 +578,19 @@ end;
procedure TVpWeekView.DeleteActiveEvent(Verify: Boolean);
var
Str: string;
DoIt: Boolean;
begin
if ReadOnly then
exit;
wvClickTimer.Enabled := false;
EndEdit(nil);
DoIt := not Verify;
EndEdit(nil);
if ActiveEvent <> nil then begin
Str := '"' + ActiveEvent.Description + '"';
if Verify then
DoIt := (MessageDlg(RSDelete + ' ' + Str + ' ' + RSFromSchedule + #13#10#10 + RSPermanent,
DoIt := (MessageDlg(RSConfirmDeleteEvent + #13#10#10 + RSPermanent,
mtConfirmation, [mbYes, mbNo], 0) = mrYes);
if DoIt then begin
@ -745,6 +747,8 @@ procedure TVpWeekView.WMLButtonDown(var Msg: TWMLButtonDown);
{$ELSE}
procedure TVpWeekView.WMLButtonDown(var Msg: TLMLButtonDown);
{$ENDIF}
var
P: TPoint;
begin
inherited;
@ -753,16 +757,17 @@ begin
if (wvInPlaceEditor <> nil) and wvInPlaceEditor.Visible then
EndEdit(Self);
P := Point(Msg.XPos, Msg.YPos);
if (Msg.YPos > wvHeaderHeight) then
begin
{ If an active event was clicked, then enable the click timer. If the }
{ item is double clicked before the click timer fires, then the edit }
{ dialog will appear, otherwise the in-place editor will appear. }
if EventAtCoord(Point(Msg.XPos, Msg.YPos)) then
wvClickTimer.Enabled := true;
{ The mouse click landed inside the client area }
wvSetDateByCoord(Point(Msg.XPos, Msg.YPos));
wvSetDateByCoord(P);
{ If an active event was clicked, then enable the click timer. If the
item is double clicked before the click timer fires, then the edit
dialog will appear, otherwise the in-place editor will appear. }
if EventAtCoord(P) then
wvClickTimer.Enabled := true;
end;
end;
{=====}
@ -1127,44 +1132,34 @@ var
begin
result := false;
for I := 0 to pred(Length(wvEventArray)) do begin
if wvEventArray[I].Event = nil then begin
{ we've hit the end of visible events without finding a match }
ActiveEvent := nil;
wvActiveEventRec.Top := 0;
wvActiveEventRec.Bottom := 0;
wvActiveEventRec.Right := 0;
wvActiveEventRec.Left := 0;
result := false;
Exit;
end;
// We've hit the end of visible events without finding a match
if wvEventArray[I].Event = nil then
Exit;
// Point falls inside this event's rectangle
if PointInRect(Pt, wvEventArray[I].Rec) then
begin
{ point falls inside this event's rectangle }
wvHotPoint := Pt;
ActiveEvent := TVpEvent(wvEventArray[I].Event);
wvActiveEventRec := wvEventArray[I].Rec;
result := true;
Exit;
end
else begin
{ point is not within the boundaries of this event's rectangle. }
ActiveEvent := nil;
wvActiveEventRec.Top := 0;
wvActiveEventRec.Bottom := 0;
wvActiveEventRec.Right := 0;
wvActiveEventRec.Left := 0;
result := false;
end;
end;
end;
{=====}
{ This is the timer event which spawns an in-place editor.
If the event is double-clicked before this timer fires, then the event is
edited in a dialog based editor. }
procedure TVpWeekView.wvEditInPlace(Sender: TObject);
begin
{ this is the timer event which spawns an in-place editor }
{ if the event is doublecliked before this timer fires, then the }
{ event is edited in a dialog based editor. }
wvClickTimer.Enabled := false;
EditEvent;
end;
@ -1190,6 +1185,14 @@ begin
wvInPlaceEditor.Parent := self;
wvInPlaceEditor.OnExit := EndEdit;
end;
if ActiveEvent.AllDayEvent then
wvInPlaceEditor.SetBounds(
wvActiveEventRec.Left + TextMargin,
wvActiveEventRec.Top,
wvActiveEventRec.Right - TextMargin * 3,
wvActiveEventRec.Bottom - TextMargin * 2
)
else
wvInPlaceEditor.SetBounds(
wvActiveEventRec.Left + TextMargin,
wvActiveEventRec.Top,

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

@ -41,6 +41,7 @@ type
procedure DrawDays;
procedure DrawEvent(AEvent: TVpEvent; DayRect, TextRect: TRect; ADayIndex: Integer);
procedure DrawHeader;
procedure FixFontHeights;
procedure InitColors;
procedure SetMeasurements; override;
@ -55,7 +56,10 @@ type
implementation
uses
StrUtils, Math, LazUtf8,
StrUtils, Math,
{$IFDEF LCL}
LazUtf8, DateUtils,
{$ENDIF}
VpCanvasUtils, VpMisc, VpSR;
type
@ -81,14 +85,16 @@ var
TempList: TList;
I, J, K: Integer;
Event: TVpEvent;
ADEventRect: TRect;
ADEvRect: TRect;
StartsBeforeRange: Boolean;
MaxADEvents: Integer;
NumADEvents: Integer;
Skip: Boolean;
ADTextHeight: Integer;
EventStr: string;
txtDist: Integer;
begin
Result := False;
{ initialize the All Day Events area... }
ADEventsRect := DayRect;
@ -97,7 +103,7 @@ begin
{ Collect all of the events for this range and determine the maximum }
{ number of all day events for the range of days covered by the control. }
MaxADEvents := 0;
NumADEvents := 0;
ADEventsList := TList.Create;
try
@ -122,91 +128,95 @@ begin
AdEventsList.Add(TempList[J]);
end;
if TempList.Count > MaxADEvents then
MaxADEvents := TempList.Count;
if TempList.Count > NumADEvents then
NumADEvents := TempList.Count;
finally
TempList.Free;
end;
if MaxADEvents > 0 then begin
if NumADEvents > 0 then begin
{ Set attributes }
RenderCanvas.Brush.Color := ADBackgroundColor;
RenderCanvas.Font.Assign(FWeekView.AllDayEventAttributes.Font);
{ Measure the AllDayEvent TextHeight }
ADTextHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + TextMargin div 2;
txtDist := TextMargin div 2;
RenderCanvas.Font.Assign(FWeekView.AllDayEventAttributes.Font);
ADTextHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + txtDist;
{ Build the AllDayEvent rect based on the value of MaxADEvents }
if AdEventsRect.Top + (MaxADEvents * ADTextHeight) + TextMargin * 2 > DayRect.Bottom
{ Build the AllDayEvent rect based on the value of NumADEvents }
if AdEventsRect.Top + (NumADEvents * ADTextHeight) + TextMargin * 2 > DayRect.Bottom
then
ADeventsrect.Bottom := DayRect.Bottom
ADEventsRect.Bottom := DayRect.Bottom
else
ADEventsRect.Bottom := AdEventsRect.Top + (MaxADEvents * ADTextHeight) + TextMargin * 2;
ADEventsRect.Bottom := AdEventsRect.Top + NumADEvents * ADTextHeight + TextMargin * 2;
{ Clear the AllDayEvents area }
// Clear the AllDayEvents area
TpsFillRect(RenderCanvas, Angle, RenderIn, ADEventsRect);
StartsBeforeRange := false;
{ Cycle through the all day events and draw them appropriately }
// Cycle through the all day events and draw them appropriately
for I := 0 to pred(ADEventsList.Count) do begin
Event := ADEventsList[I];
{ set the top of the event's rect }
AdEventRect.Top := ADEventsRect.Top + TextMargin + I * ADTextHeight;
// Draw ". . ."
if ADEventsRect.Top + ((I + 1) * ADTextHeight) > DayRect.Bottom then
begin
DrawDotDotDot(DayRect, DotDotDotColor);
if ADEventsRect.Top + TextMargin + ((I + 1) * ADTextHeight) - TextMargin > DayRect.Bottom
then begin
{
RenderCanvas.Brush.Color := DotDotDotColor;
{ draw dot dot dot }
TPSFillRect(RenderCanvas, Angle, RenderIn,
Rect(DayRect.Right - 20, DayRect.Bottom - 7, DayRect.Right - 17, DayRect.Bottom - 4));
TPSFillRect(RenderCanvas, Angle, RenderIn,
Rect(DayRect.Right - 13, DayRect.Bottom - 7, DayRect.Right - 10, DayRect.Bottom - 4));
TPSFillRect(RenderCanvas, Angle, RenderIn,
Rect(DayRect.Right - 6, DayRect.Bottom - 7, DayRect.Right - 3, DayRect.Bottom - 4));
}
break;
end;
{ see if the event began before the start of the range }
if (Event.StartTime < trunc(RenderDate)) then
// See if the event began before the start of the range
if (Event.StartTime < DayOf(RenderDate)) then
StartsBeforeRange := true;
AdEventRect.Bottom := ADEventRect.Top + ADTextHeight;
AdEventRect.Left := AdEventsRect.Left + (TextMargin div 2);
AdEventRect.Right := DayRect.Right;
if (StartsBeforeRange) then
EventStr := '>> '
else
EventStr := '';
EventStr := EventStr + Event.Description;
// Set the event's rect
ADEvRect.Top := ADEventsRect.Top + TextMargin + I * ADTextHeight;
ADEvRect.Bottom := ADEvRect.Top + ADTextHeight;
ADEvRect.Left := AdEventsRect.Left + txtDist;
ADEvRect.Right := DayRect.Right;
// Paint the background of the event rect
RenderCanvas.Brush.Color := ADEventBackgroundColor;
RenderCanvas.Pen.Color := ADEventBorderColor;
TPSRectangle(RenderCanvas, Angle, RenderIn,
ADEventRect.Left + TextMargin,
ADEventRect.Top + TextMargin div 2,
ADEventRect.Right - TextMargin,
ADEventRect.Top + ADTextHeight + TextMargin div 2
ADEvRect.Left + TextMargin,
ADEvRect.Top + txtDist,
ADEvRect.Right - TextMargin,
ADEvRect.Top + ADTextHeight + txtDist
);
// Paint the event string
EventStr := IfThen(StartsBeforeRange, '>> ', '') + Event.Description;
EventStr := GetDisplayString(RenderCanvas, EventStr, 0, WidthOf(ADEvRect) - 3*TextMargin);
TPSTextOut(RenderCanvas,Angle, RenderIn,
AdEventRect.Left + TextMargin * 2 + TextMargin div 2,
AdEventRect.Top + TextMargin,
ADEvRect.Left + TextMargin * 2 + txtDist,
ADEvRect.Top + TextMargin,
EventStr
);
Result := True;
TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex].Rec := Rect(
ADEventRect.Left + TextMargin,
ADEventRect.Top + TextMargin,
ADEventRect.Right - TextMargin,
ADEventRect.Bottom
ADEvRect.Left + TextMargin,
ADEvRect.Top + TextMargin,
ADEvRect.Right - TextMargin,
ADEvRect.Bottom
);
TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex].Event := Event;
Inc(EAIndex);
end; { for I := 0 to pred(ADEventsList.Count) do ... }
end; { if MaxADEvents > 0 }
end; { if NumADEvents > 0 }
finally
ADEventsList.Free;
@ -592,6 +602,17 @@ begin
);
end;
procedure TVpWeekViewPainter.FixFontHeights;
begin
with FWeekView do begin
AllDayEventAttributes.Font.Height := GetRealFontHeight(AllDayEventAttributes.Font);
DayHeadAttributes.Font.Height := GetRealFontHeight(DayHeadAttributes.Font);
EventFont.Height := GetRealFontHeight(EventFont);
Font.Height := GetRealFontHeight(Font);
HeadAttributes.Font.Height := GetRealFontHeight(HeadAttributes.Font);
end;
end;
procedure TVpWeekViewPainter.InitColors;
begin
if DisplayOnly then begin
@ -631,14 +652,7 @@ begin
InitColors;
SavePenBrush;
InitPenBrush;
with FWeekView do begin
AllDayEventAttributes.Font.Height := GetRealFontHeight(AllDayEventAttributes.Font);
DayHeadAttributes.Font.Height := GetRealFontHeight(DayHeadAttributes.Font);
EventFont.Height := GetRealFontHeight(EventFont);
Font.Height := GetRealFontHeight(Font);
HeadAttributes.Font.Height := GetRealFontHeight(HeadAttributes.Font);
end;
FixFontHeights;
Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom);
try