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

tvplanit: Fix drawing glitches in TVpDayView.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8440 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-03 17:58:24 +00:00
parent 79cfe6aad2
commit c7af4ddc10
4 changed files with 65 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/tvplanit/source/vpdayview.pas
View File

@ -2544,7 +2544,11 @@ procedure TVpDayView.SetShowNavButtons(Value: Boolean);
begin
if Value <> FShowNavButtons then begin
FShowNavButtons := Value;
Invalidate;
dvDayUpBtn.Visible := FShowNavButtons;
dvDayDownBtn.Visible := FShowNavButtons;
dvTodayBtn.Visible := FShowNavButtons;
dvWeekUpBtn.Visible := FShowNavButtons;
dvWeekDownBtn.Visible := FShowNavButtons;
end;
end;

138
components/tvplanit/source/vpdayviewpainter.pas
View File

@ -253,7 +253,7 @@ begin
Result := nil;
end;
{ returns the maximum OLEvents value from all overlapping neighbors }
{ Returns the maximum OLEvents value from all overlapping neighbors }
function TVpDayViewPainter.GetMaxOLEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer;
var
K: Integer;
@ -454,16 +454,10 @@ var
begin
tmpRect := Rect(RealLeft, RealTop, RealRight-1, RealBottom-1);
tmpRect := TPSRotateRectangle(Angle, RenderIn, tmpRect);
if FDayView.DrawingStyle = dsFlat then begin
{ Draw a simple border }
DrawBevelRect(RenderCanvas, tmpRect, BevelShadow, BevelShadow);
end else
if FDayView.DrawingStyle = ds3d then begin
{ Draw a 3d bevel }
DrawBevelRect(RenderCanvas, tmpRect, BevelShadow, BevelHighlight);
InflateRect(tmpRect, -1, -1);
DrawBevelRect(RenderCanvas, tmpRect, BevelDarkShadow, BevelFace);
case FDayView.DrawingStyle of
dsNoBorder: ;
dsFlat: DrawBevelRect(RenderCanvas, tmpRect, BevelShadow, BevelShadow);
ds3D: DrawBevelRect(RenderCanvas, tmpRect, BevelShadow, BevelHighlight);
end;
end;
@ -480,24 +474,21 @@ begin
if StartLine < 0 then
StartLine := FDayView.TopLine;
dec(R.Top);
inc(R.Bottom);
{ Set GutterRect size }
// Set GutterRect size
GutterRect.Left := R.Left;
GutterRect.Top := R.Top;
GutterRect.Bottom := R.Bottom;
GutterRect.Right := GutterRect.Left + FScaledGutterWidth;
R.Left := R.Left + FScaledGutterWidth + 1;
{ paint gutter area }
// Paint gutter area
RenderCanvas.Brush.Color := RealColor;
tmpRect := GutterRect;
if FDayView.DrawingStyle = dsNoBorder then
inc(tmpRect.Bottom);
TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
{ draw the line down the right side of the gutter }
// Draw the line down the right side of the gutter
RenderCanvas.Pen.Color := BevelShadow;
RenderCanvas.Pen.Style := psSolid;
TPSMoveTo(RenderCanvas, Angle, RenderIn, GutterRect.Right, GutterRect.Top);
@ -526,7 +517,7 @@ begin
RenderCanvas.Pen.Style := psSolid;
RenderCanvas.Pen.Color := FDayView.LineColor;
{ Paint the client area }
// Paint the client area
I := 0;
while true do begin
lineIndex := StartLine + I;
@ -600,7 +591,7 @@ begin
TPSFillRect (RenderCanvas, Angle, RenderIn, LineRect);
{ Draw the lines }
// Draw the lines
RenderCanvas.Pen.Color := FDayView.LineColor;
TPSMoveTo(RenderCanvas, Angle, RenderIn, LineRect.Left, LineRect.Bottom - 1);
if (lineIndex + 1) mod FDayView.RowLinesStep = 0 then
@ -608,12 +599,11 @@ begin
inc(I);
end; // while true ...
{ Draw a line down the right side of the column to close the }
{ cells right sides }
// Draw a line down the right side of the column to close the cells right sides
RenderCanvas.Pen.Color := BevelShadow;
RenderCanvas.Pen.Style := psSolid;
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right - 1, R.Bottom);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right - 1, R.Top - 1);
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Bottom);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Top - 1);
finally
RenderCanvas.Font.Assign(SavedFont);
@ -629,6 +619,7 @@ var
DateStrLen, ResStrLen: integer;
DateStrHt: Integer;
TextRect: TRect;
wText: Integer;
X, Y: Integer;
tmpRect: TRect;
begin
@ -652,10 +643,9 @@ begin
RenderCanvas.Pen.Style := psSolid;
{ Size text rect }
TextRect.TopLeft := R.TopLeft;
TextRect.BottomRight := R.BottomRight;
TextRect.Right := TextRect.Right - 3;
TextRect.Left := TextRect.Left + 2;
TextRect := R;
OffsetRect(TextRect, 0, -3);
wText := WidthOf(TextRect);
{ Fix date string for best usage of the available width }
DateStr := GetDateDisplayString(RenderCanvas, ARenderDate,
@ -669,49 +659,47 @@ begin
{ fix Res String }
ResStr := FDayView.DataStore.Resource.Description;
ResStrLen := RenderCanvas.TextWidth(ResStr);
if ResStrLen > TextRect.Right - TextRect.Left then begin
ResStr := GetDisplayString(RenderCanvas, ResStr, 0, TextRect.Right - TextRect.Left);
if ResStrLen > WidthOf(TextRect) then
begin
ResStr := GetDisplayString(RenderCanvas, ResStr, 0, wText);
ResStrLen := RenderCanvas.TextWidth(ResStr);
end;
{ center and write the resource name in the first column }
if (Col = 0) then begin
X := TextRect.Left + (TextRect.Right - TextRect.Left) div 2 - ResStrLen div 2;
X := TextRect.Left + wText div 2 - ResStrLen div 2;
Y := TextRect.Top + FDayView.TextMargin;
TPSTextOut(RenderCanvas, Angle, RenderIn, X, Y, FDayView.DataStore.Resource.Description);
end;
{ center the date string }
X := TextRect.Left + (TextRect.Right - TextRect.Left) div 2 - DateStrLen div 2;
X := TextRect.Left + wText div 2 - DateStrLen div 2;
Y := TextRect.Top + (FDayView.TextMargin * 2) + DateStrHt;
end else begin
{ center the date string }
Y := TextRect.Top + FDayView.TextMargin;
X := TextRect.Left + (TextRect.Right - TextRect.Left) div 2 - DateStrLen div 2;
X := TextRect.Left + wText div 2 - DateStrLen div 2;
end;
{ Write the date string }
TPSTextOut(RenderCanvas, Angle, RenderIn, X, Y, DateStr);
{Draw Column Head Borders }
if (Col = FDayView.NumDays - 1) then
dec(R.Right);
if FDayView.DrawingStyle = dsFlat then begin
// bottom
RenderCanvas.Pen.Color := BevelShadow;
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom - 1);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left - 2, R.Bottom - 1);
// right side
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom - 1);
RenderCanvas.Pen.Color := RealHeadAttrColor;
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom - 4);
RenderCanvas.Pen.Color := BevelShadow;
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top + 2);
RenderCanvas.Pen.Color := RealHeadAttrColor;
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
if Col < FDayView.NumDays - 1 then
InflateRect(R, 0, -6);
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom - 1); //-5
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top - 2); //+6
end
else
if FDayView.DrawingStyle = ds3d then begin
dec(R.Bottom);
if Col = FDayView.NumDays - 1 then
dec(R.Right, 4);
OffsetRect(R, 0, -1);
R := TPSRotateRectangle(Angle, RenderIn, R);
DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelDarkShadow);
DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelShadow);
end;
RenderCanvas.Font.Assign(SaveFont);
finally
@ -812,6 +800,7 @@ begin
else
RenderCanvas.Brush.Style := OverlayPatternToBrushStyle(AEvent.GetResource.Group.Pattern);
end;
TPSFillRect(RenderCanvas, Angle, RenderIn, EventRect);
RenderCanvas.Brush.Style := bsSolid;
@ -879,7 +868,7 @@ begin
end;
end;
OldPen.Assign(RenderCanvas.Pen); // wp: Original code had "Canvas" here which does not look correct
OldPen.Assign(RenderCanvas.Pen);
OldBrush.Assign(RenderCanvas.Brush);
OldFont.Assign(RenderCanvas.Font);
@ -1161,15 +1150,8 @@ procedure TVpDayViewPainter.DrawNavBtns;
var
w: Integer;
begin
{ size and place the Today button first. }
with TVpDayViewOpener(FDayView) do begin
dvDayUpBtn.Visible := ShowNavButtons;
dvDayDownBtn.Visible := ShowNavButtons;
dvTodayBtn.Visible := ShowNavButtons;
dvWeekUpBtn.Visible := ShowNavButtons;
dvWeekDownBtn.Visible := ShowNavButtons;
{ In order to hide the nav btns in designmode move them out of their parent }
// In order to hide the nav btns in designmode move them out of their parent.
if (csDesigning in ComponentState) and not ShowNavButtons then begin
dvTodayBtn.Left := -Width;
dvWeekDownBtn.Left := -Width;
@ -1179,41 +1161,36 @@ begin
exit;
end;
{ Calculate width of buttons }
// Calculate button widths trying to distribute remainder of division evenly
w := RealRowHeadWidth - 3; // total width
dvTodayBtn.Height := trunc(RealColHeadHeight div 2);
dvTodayBtn.Width := RealRowHeadWidth;
dvWeekDownBtn.Width := RealRowHeadWidth div 4 + 2;
dvWeekUpBtn.Width := dvWeekDownBtn.Width;
dvDaydownBtn.Width := dvWeekdownBtn.Width - 4;
dvTodayBtn.Width := w;
dvDayDownBtn.Width := w div 4;
dvDayUpBtn.Width := dvDayDownBtn.Width;
dvWeekDownBtn.Width := (w - 2 * dvDayDownBtn.Width) div 2;
dvWeekUpBtn.Width := w - (2 * dvDayDownBtn.Width + dvWeekDownBtn.Width);
w := dvWeekDownBtn.Width + dvWeekUpBtn.Width + dvDaydownBtn.Width + dvDayUpBtn.Width;
if DrawingStyle = ds3d then begin
dvTodayBtn.Left := 2 + (RealRowHeadWidth - w) div 2;
dvTodayBtn.Top := 2;
end else
begin
dvTodayBtn.Left := 1 + (RealRowHeadWidth - w) div 2;
dvTodayBtn.Top := 1;
end;
// Size and place the Today button first.
dvTodayBtn.Left := 3;
dvTodayBtn.Top := 2;
{ size and place the WeekDown button }
dvWeekDownBtn.Height := dvTodayBtn.Height;
// Size and place the WeekDown button
dvWeekDownBtn.Height := RealColHeadHeight - dvTodayBtn.Height - 3;
dvWeekDownBtn.Left := dvTodayBtn.Left;
dvWeekDownBtn.Top := dvTodayBtn.Top + dvTodayBtn.Height;
{ size and place the DayDown button }
dvDayDownBtn.Height := dvTodayBtn.Height;
// Size and place the DayDown button
dvDayDownBtn.Height := dvWeekDownBtn.Height;
dvDayDownBtn.Left := dvWeekDownBtn.Left + dvWeekDownBtn.Width;
dvDayDownBtn.Top := dvWeekDownBtn.Top;
{ size and place the DayUp button }
dvDayUpBtn.Height := dvTodayBtn.Height;
// Size and place the DayUp button
dvDayUpBtn.Height := dvWeekDownBtn.Height;
dvDayUpBtn.Left := dvDayDownBtn.Left + dvDayDownBtn.Width;
dvDayUpBtn.Top := dvWeekDownBtn.Top;
{ size and place the WeekUp button }
dvWeekUpBtn.Height := dvTodayBtn.Height;
// Size and place the WeekUp button
dvWeekUpBtn.Height := dvWeekDownBtn.Height;
dvWeekUpBtn.Left := dvDayUpBtn.Left + dvDayUpBtn.Width;
dvWeekUpBtn.Top := dvWeekDownBtn.Top;
end;
@ -1240,7 +1217,7 @@ begin
// Draw the border
if FDayView.DrawingStyle = ds3d then begin
R := Rect(R.Left + 1, R.Top + 2, R.Right - 2, R.Bottom - 1);
R := Rect(R.Left, R.Top + 1, R.Right - 2, R.Bottom - 1);
DrawBevelRect(
RenderCanvas,
TPSRotateRectangle(Angle, RenderIn, R),
@ -1254,11 +1231,6 @@ begin
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left + 3, R.Bottom - 1);
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Top + 6);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Bottom - 5);
{
RenderCanvas.Pen.Color := BevelHighlight;
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left, R.Top);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Top);
}
end;
end;
@ -2012,11 +1984,13 @@ begin
{ Slide the rect over to correspond with the level }
if ALevel > 0 then
AEventRect.Left := AEventRect.Left + eventWidth * ALevel
AEventRect.Left := AEventRect.Left + eventWidth * ALevel - 1
{ added because level 0 events were one pixel too far to the right }
else
AEventRect.Left := AEventRect.Left - 1;
AEventRect.Right := AEventRect.Left + eventWidth;; // + 1; -- wp: removed to avoid painting over the right border line
AEventRect.Right := AEventRect.Left + eventWidth;
if (ALevel = 0) and (AWidthDivisor <= 1) then
dec(AEventRect.Right);
dec(AEventRect.Top); // wp: without this, the top border line of the event is thicker than the others
end;

5
components/tvplanit/source/vpganttviewpainter.pas
View File

@ -476,10 +476,13 @@ begin
BevelShadow
);
end else
begin
RenderCanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom);
end;
// Paint event description as header
P := Point(R.Left + FGanttView.TextMargin, (R.Top + R.Bottom - strH) div 2);
inc(R.Left, FGanttView.TextMargin + 2);
P := Point(R.Left, (R.Top + R.Bottom - strH) div 2);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str);
end;
end;

7
components/tvplanit/source/vpmisc.pas
View File

@ -245,7 +245,6 @@ begin
while (Length(Str) > 0) and (not (Str[Length(Str)] in ['A'..'Z', 'a'..'z', '0'..'9'])) do
delete(Str, Length(Str), 1);
end;
{=====}
function AssembleName(AContact: TVpContact): string;
begin
@ -304,7 +303,6 @@ begin
end;
end;
procedure ParseName(Contact: TVpContact; const Value: string);
var
name, ln, fn: string;
@ -333,7 +331,6 @@ begin
Contact.LastName := ln;
Contact.FirstName := fn;
end;
{=====}
procedure ParseCSZ(Str: string; out City, State, Zip: string);
var
@ -361,7 +358,6 @@ begin
StripString(State);
StripString(Zip);
end;
{=====}
{$IFDEF DELPHI}
function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP;
@ -372,7 +368,6 @@ begin
{$ENDIF}
// Result := LoadBitmap(FindClassHInstance(TVpCustomControl), lpBitmapName);
end;
{=====}
function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR;
begin
@ -384,13 +379,11 @@ function WidthOf(const R : TRect) : Integer;
begin
Result := R.Right - R.Left;
end;
{=====}
function HeightOf(const R : TRect) : Integer;
begin
Result := R.Bottom - R.Top;
end;
{=====}
function GetDisplayString(Canvas : TCanvas; const S : string;
MinChars, MaxWidth : Integer) : string;