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

tvplanit: Fix painting glitches in TVpMonthView.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8441 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-03 21:56:31 +00:00
parent c7af4ddc10
commit 460df892e1
3 changed files with 106 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,15 +22,14 @@ object MainForm: TMainForm
ClientWidth = 834
TabOrder = 2
object HeaderPanel: TPanel
Left = 2
Left = 0
Height = 48
Top = 0
Width = 832
Width = 834
Align = alTop
BorderSpacing.Left = 2
BevelOuter = bvNone
ClientHeight = 48
ClientWidth = 832
ClientWidth = 834
Color = 13743257
ParentColor = False
TabOrder = 0
@ -180,7 +179,6 @@ object MainForm: TMainForm
001C000000C6FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
005500000038FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
LineColor = clGray
GutterWidth = 5
WrapStyle = wsNoFlow
OnHoliday = VpHoliday

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

@ -222,6 +222,8 @@ type
FPrevMonthBtn: TSpeedButton;
FNextMonthBtn: TSpeedButton;
FNextYearBtn: TSpeedButton;
mvHeaderHeight: Integer;
mvMonthHeadHeight: Integer;
mvDayHeadHeight: Integer;
mvEventArray: TVpEventArray;
mvMonthDayArray: TVpMonthdayArray;

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

@ -30,7 +30,10 @@ type
TodayFontColor: TColor;
TodayAttrColor: TColor;
DotDotDotColor: TColor;
FCurrHoliday: String;
FDayHeadHeight: Integer;
FMonthHeadHeight: Integer;
// These variables were protected in the original monthview, but are needed only for painting
mvEventTextHeight: Integer;
@ -86,7 +89,13 @@ procedure TVpMonthViewPainter.DrawBorders;
var
R: TRect;
begin
R := Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1);
R := TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1));
case FMonthView.DrawingStyle of
dsNoBorder: ;
dsFlat: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
ds3D: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight);
end;
(*
if FMonthView.DrawingStyle = dsFlat then begin
{ draw a simple rectangular border }
DrawBevelRect(
@ -112,6 +121,7 @@ begin
BevelFace
);
end;
*)
end;
procedure TVpMonthViewPainter.DrawDayCell(ADate: TDate; ACol, ARow: Integer;
@ -270,8 +280,9 @@ var
P: TPoint;
I: Integer;
DayTAG: Integer;
Str: string;
StrLen: Integer;
str: string;
strLen: Integer;
strHeight: Integer;
begin
{ clear day head area }
RenderCanvas.Font.Assign(FMonthView.DayHeadAttributes.Font);
@ -279,26 +290,26 @@ begin
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
RenderCanvas.Brush.Color := DayHeadAttrColor;
strHeight := RenderCanvas.TextHeight('00');
{ build rect }
dhRect.Left := RealLeft;
dhRect.Top := RealTop + TVpMonthViewOpener(FMonthView).mvDayHeadHeight;
dhRect.Top := RealTop + FMonthHeadHeight;
dhRect.Right := RealRight;
dhRect.Bottom := dhRect.Top + TVpMonthViewOpener(FMonthView).mvDayHeadHeight;
dhRect.Bottom := dhRect.Top + FDayHeadHeight;
if FMonthView.DrawingStyle = ds3d then begin
//OffsetRect(dhRect, 0, 2);
inc(dhRect.Left, 2);
inc(dhRect.Top, 3);
dec(dhRect.Right, 3);
dhRect.Bottom := dhRect.Top + TVpMonthViewOpener(FMonthView).mvDayHeadHeight;
inc(dhRect.Top, 2);
dec(dhRect.Right, 2);
dhRect.Bottom := dhRect.Top + FDayHeadHeight;
TPSFillRect(RenderCanvas, Angle, RenderIn, dhRect);
R := TPSRotateRectangle(Angle, RenderIn, dhRect);
DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelDarkShadow);
DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelShadow);
end else
if FMonthView.DrawingStyle = dsFlat then begin
dhRect.Left := RealLeft;
dhRect.Top := RealTop + TVpMonthViewOpener(FMonthView).mvDayHeadHeight;
dhRect.Right := RealRight;
dhRect.Bottom := dhRect.Top + TVpMonthViewOpener(FMonthView).mvDayHeadHeight;
TPSFillRect(RenderCanvas, Angle, RenderIn, dhRect);
R := TPSRotateRectangle(Angle, RenderIn, dhRect);
DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
@ -371,14 +382,17 @@ begin
{$ENDIF}
{ Fix header string }
StrLen := RenderCanvas.TextWidth(Str);
if (StrLen > mvColWidth - FMonthView.TextMargin * 2) then
Str := GetDisplayString(RenderCanvas, Str, 0, mvColWidth - FMonthView.TextMargin * 2);
StrLen := RenderCanvas.TextWidth(Str);
strLen := RenderCanvas.TextWidth(str);
if (strLen > mvColWidth - FMonthView.TextMargin * 2) then
str := GetDisplayString(RenderCanvas, str, 0, mvColWidth - FMonthView.TextMargin * 2);
strLen := RenderCanvas.TextWidth(str);
{ Draw header text }
P := Point((dhRect.Left + dhRect.Right - StrLen) div 2, dhRect.Top + FMonthView.TextMargin - 1);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str);
P := Point(
(dhRect.Left + dhRect.Right - strLen) div 2,
(dhRect.Top + dhRect.Bottom - strHeight) div 2
);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
DayTAG := (DayTAG + 1) mod 7;
@ -396,6 +410,7 @@ var
MonthStartsOn: Integer;
DayTag: Integer;
DayOffset: Integer;
headHeight: Integer;
StartingDate: TDateTime;
ThisDate: TDateTime;
I: Integer;
@ -403,32 +418,31 @@ var
OldBrush: TBrush;
OldPen: TPen;
OldFont: TFont;
hDayHead: Integer;
begin
{ initialize the MonthDayArray }
// Initialize the MonthDayArray
with TVpMonthViewOpener(FMonthView) do begin
for I := 0 to Pred(Length(mvMonthDayArray)) do begin
mvMonthDayArray[I].Rec := Rect(-1, -1, -1, -1);
mvMonthDayArray[I].Date := 0.0;
end;
hDayHead := mvDayHeadHeight;
end;
RenderCanvas.Pen.Color := RealLineColor;
RenderCanvas.Brush.Color := RealColor;
headHeight := FMonthHeadHeight + FDayHeadHeight;
if FMonthView.DrawingStyle = ds3d then
begin
mvRowHeight := (RealHeight - hDayHead * 2 - 4) div 6;
TextRect.TopLeft := Point(RealLeft + 1, RealTop + hDayHead * 2 + 4);
mvRowHeight := (RealHeight - headHeight - 2) div 6;
TextRect.TopLeft := Point(RealLeft + 1, RealTop + headHeight + 2);
end else
begin
mvRowHeight := (RealHeight - hDayHead * 2) div 6;
TextRect.TopLeft := Point(RealLeft + 1, RealTop + hDayHead * 2);
mvRowHeight := (RealHeight - headHeight) div 6;
TextRect.TopLeft := Point(RealLeft + 1, RealTop + headHeight);
end;
TextRect.BottomRight := Point(TextRect.Left + mvColWidth, TextRect.Top + mvRowHeight);
{ Determine the starting date and offset }
// Determine the starting date and offset
DecodeDate(DisplayDate, Y, DisplayMonth, D);
StartingDate := EncodeDate(Y, DisplayMonth, 1);
MonthStartsOn := DayOfWeek(StartingDate);
@ -440,48 +454,42 @@ begin
I := 0;
DayNumber := DayOffset + 1;
// iterate through each column row by row, drawing each day in numerical order.
// Iterate through each column row by row, drawing each day in numerical order.
OldBrush := TBrush.Create;
OldPen := TPen.Create;
OldFont := TFont.Create;
try
OldPen := TPen.Create;
try
OldFont := TFont.Create;
try
for Row := 0 to 5 do begin
for Col := 0 to 6 do begin
ThisDate := Trunc(StartingDate + DayNumber);
for Row := 0 to 5 do begin
for Col := 0 to 6 do begin
ThisDate := Trunc(StartingDate + DayNumber);
{ Check and store if this date is a holiday }
FMonthView.IsHoliday(ThisDate, FCurrHoliday);
// Check and store if this date is a holiday
FMonthView.IsHoliday(ThisDate, FCurrHoliday);
OldBrush.Assign(RenderCanvas.Brush);
OldPen.Assign(RenderCanvas.Pen);
OldFont.Assign(RenderCanvas.Font);
try
{ Allow the user to draw the day }
if Assigned(FMonthView.OwnerDrawCells) then begin
Drawn := false;
DecodeDate(ThisDate, Y,M,D);
FMonthView.OwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn);
if Drawn then
Continue;
end else
DrawDayCell(ThisDate, Col, Row, I, DayNumber, TextRect);
finally
RenderCanvas.Brush.Assign(OldBrush);
RenderCanvas.Pen.Assign(OldPen);
RenderCanvas.Font.Assign(OldFont);
end;
end;
OldBrush.Assign(RenderCanvas.Brush);
OldPen.Assign(RenderCanvas.Pen);
OldFont.Assign(RenderCanvas.Font);
try
// Allow the user to draw the day
if Assigned(FMonthView.OwnerDrawCells) then begin
Drawn := false;
DecodeDate(ThisDate, Y,M,D);
FMonthView.OwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn);
if Drawn then
Continue;
end else
DrawDayCell(ThisDate, Col, Row, I, DayNumber, TextRect);
finally
RenderCanvas.Brush.Assign(OldBrush);
RenderCanvas.Pen.Assign(OldPen);
RenderCanvas.Font.Assign(OldFont);
end;
finally
OldFont.Free;
end;
finally
OldPen.Free;
end;
finally
OldFont.Free;
OldPen.Free;
OldBrush.Free;
end;
@ -523,7 +531,6 @@ begin
FMonthView.DataStore.Resource.Schedule.EventsByDate(TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].Date, EventList);
if EventList.Count > 0 then begin
{ there are events scheduled for this day }
dayRect := TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].Rec;
{ initialize TextRect for this day }
@ -630,43 +637,39 @@ end;
procedure TVpMonthViewPainter.DrawHeader;
var
HeadRect: TRect;
headRect: TRect;
HeadTextRect: TRect;
HeadStr: string;
HeadStrLen : Integer;
dayHeadHeight: Integer;
R: TRect;
txtstart: Integer;
begin
RenderCanvas.Brush.Color := HeadAttrColor;
dayHeadHeight := TVpMonthViewOpener(FMonthView).mvDayHeadHeight;
headRect := Rect(RealLeft, RealTop, RealRight, RealTop + FMonthHeadHeight);
HeadRect := Rect(RealLeft, RealTop, RealRight, RealTop + dayHeadHeight);
{ Draw the header cell and borders }
// Draw the header cell and borders
if FMonthView.DrawingStyle = dsFlat then begin
// draw a flat rectanbular border
TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
R := TPSRotateRectangle(Angle, RenderIn, HeadRect);
// Draw a flat rectangular border
TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
R := TPSRotateRectangle(Angle, RenderIn, headRect);
DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
end else
if FMonthView.DrawingStyle = ds3d then begin
// draw a 3d bevel
InflateRect(HeadRect, -2, -2);
dec(HeadRect.Right);
HeadRect.Bottom := HeadRect.Top + dayHeadHeight;
// Draw a 3d bevel
InflateRect(headRect, -1, -1);
dec(headRect.Right);
headRect.Bottom := headRect.Top + FMonthHeadHeight;
TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
R := TPSRotateRectangle(Angle, RenderIn, HeadRect);
DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelDarkShadow);
DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelShadow);
end else
TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
{ Position the spinner }
// Position the spinner buttons
with TVpMonthViewOpener(FMonthView) do begin
FPrevYearBtn.Height := dayHeadHeight - 3;
FPrevYearBtn.Width := FPrevYearBtn.Height;
FPrevYearBtn.Left := TextMargin;
FPrevYearBtn.Top := HeadRect.Top + (dayHeadHeight - FPrevYearBtn.Height) div 2 + 1;
FPrevYearBtn.Top := (HeadRect.Top + HeadRect.Bottom - FPrevYearBtn.Height) div 2 + 1;
FPrevMonthBtn.Height := FPrevYearBtn.Height;
FPrevMonthBtn.Width := FPrevYearBtn.Height;
@ -683,7 +686,7 @@ begin
FNextYearBtn.Left := FNextMonthBtn.Left + FNextMonthBtn.Width;
FNextYearBtn.Top := FPrevYearBtn.Top;
txtStart := FNextYearBtn.Left + FNextYearBtn.Width + TextMargin;
txtStart := FNextYearBtn.Left + FNextYearBtn.Width + 2*TextMargin;
end;
{ Acquire startdate and end date }
@ -829,38 +832,33 @@ begin
end;
procedure TVpMonthViewPainter.SetMeasurements;
var
h: Integer;
txt: String = VpProductName;
// We use the VpProductName since it is a good representation of some generic text
begin
inherited;
DisplayDate := IfThen(RenderDate = 0, Date, RenderDate);
{ We use the VpProductName because is is a good representation of some }
{ generic text }
RenderCanvas.Font.Assign(FMonthView.DayHeadAttributes.Font);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
with TVpMonthViewOpener(FMonthView) do
mvDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2;
begin
h := GetCanvasTextHeight(RenderCanvas, HeadAttributes.Font, txt);
mvMonthHeadHeight := Max(h, FPrevYearBtn.Height) + TextMargin;
RenderCanvas.Font.Assign(FMonthView.DayNumberFont);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
mvDayNumberHeight := RenderCanvas.TextHeight('00');
h := GetCanvasTextHeight(RenderCanvas, DayHeadAttributes.Font, txt);
mvDayHeadHeight := Max(h, FPrevYearBtn.Height) + TextMargin;
RenderCanvas.Font.Assign(FMonthView.EventFont);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
mvEventTextHeight := RenderCanvas.TextHeight(VpProductName);
mvHeaderHeight := mvMonthHeadHeight + mvDayHeadHeight;
RenderCanvas.Font.Assign(FMonthView.Font);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
mvLineHeight := RenderCanvas.TextHeight(VpProductName) + 2;
mvColWidth := (RealWidth - 4) div 7;
mvDayNumberHeight := GetCanvasTextHeight(RenderCanvas, DayNumberFont, '00');
mvEventTextHeight := GetCanvasTextHeight(RenderCanvas, EventFont, txt);
mvLineHeight := GetCanvasTextHeight(RenderCanvas, Font, txt) + 2;
mvColWidth := (RealWidth - 4) div 7;
FMonthHeadHeight := mvMonthHeadHeight;
FDayHeadHeight := mvDayHeadHeight;
end;
end;
end.