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

tvplanit: Fix painting glitches for TVpTaskList.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8443 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-04 22:11:52 +00:00
parent 5c2d4719ab
commit d2bdaad7bf
5 changed files with 191 additions and 232 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,24 +1,25 @@
object MainForm: TMainForm object MainForm: TMainForm
Left = 227 Left = 362
Height = 596 Height = 596
Top = 134 Top = 135
Width = 959 Width = 959
Caption = 'Turbo Power VisualPlanIt Demo' Caption = 'Turbo Power VisualPlanIt Demo'
ClientHeight = 596 ClientHeight = 576
ClientWidth = 959 ClientWidth = 959
Menu = MainMenu1 Menu = MainMenu1
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
LCLVersion = '2.3.0.0'
object Panel1: TPanel object Panel1: TPanel
Left = 125 Left = 125
Height = 596 Height = 576
Top = 0 Top = 0
Width = 834 Width = 834
Align = alClient Align = alClient
AutoSize = True AutoSize = True
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 596 ClientHeight = 576
ClientWidth = 834 ClientWidth = 834
TabOrder = 2 TabOrder = 2
object HeaderPanel: TPanel object HeaderPanel: TPanel
@ -55,7 +56,7 @@ object MainForm: TMainForm
end end
object Notebook: TNotebook object Notebook: TNotebook
Left = 0 Left = 0
Height = 548 Height = 528
Top = 48 Top = 48
Width = 834 Width = 834
PageIndex = 0 PageIndex = 0
@ -65,18 +66,18 @@ object MainForm: TMainForm
object Events: TPage object Events: TPage
object LeftPanel: TPanel object LeftPanel: TPanel
Left = 0 Left = 0
Height = 548 Height = 528
Top = 0 Top = 0
Width = 357 Width = 357
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 548 ClientHeight = 528
ClientWidth = 357 ClientWidth = 357
TabOrder = 0 TabOrder = 0
object VpMonthView1: TVpMonthView object VpMonthView1: TVpMonthView
Left = 0 Left = 0
Height = 197 Height = 197
Top = 351 Top = 331
Width = 357 Width = 357
ShowHint = True ShowHint = True
PopupMenu = VpMonthView1.default PopupMenu = VpMonthView1.default
@ -102,14 +103,14 @@ object MainForm: TMainForm
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 346 Top = 326
Width = 357 Width = 357
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
end end
object VpDayView1: TVpDayView object VpDayView1: TVpDayView
Left = 0 Left = 0
Height = 312 Height = 292
Top = 34 Top = 34
Width = 357 Width = 357
ShowHint = True ShowHint = True
@ -277,13 +278,13 @@ object MainForm: TMainForm
end end
object Splitter3: TSplitter object Splitter3: TSplitter
Left = 357 Left = 357
Height = 548 Height = 528
Top = 0 Top = 0
Width = 5 Width = 5
end end
object VpWeekView1: TVpWeekView object VpWeekView1: TVpWeekView
Left = 362 Left = 362
Height = 548 Height = 528
Top = 0 Top = 0
Width = 472 Width = 472
ShowHint = True ShowHint = True
@ -362,24 +363,10 @@ object MainForm: TMainForm
Width = 834 Width = 834
PopupMenu = VpTaskList1.default PopupMenu = VpTaskList1.default
ControlLink = VpControlLink1 ControlLink = VpControlLink1
ParentFont = False
Align = alClient Align = alClient
TabOrder = 1 TabOrder = 1
DisplayOptions.CheckBGColor = clWindow
DisplayOptions.CheckColor = cl3DDkShadow
DisplayOptions.CheckStyle = csCheck
DisplayOptions.DueDateFormat = 'dd.MM.yyyy'
DisplayOptions.ShowCompletedTasks = False
DisplayOptions.ShowAll = False
DisplayOptions.ShowDueDate = True
DisplayOptions.OverdueColor = clRed
DisplayOptions.NormalColor = clBlack
DisplayOptions.CompletedColor = clGray
LineColor = clGray
MaxVisibleTasks = 250
TaskHeadAttributes.Color = clSilver
TaskHeadAttributes.Font.Style = [fsItalic]
DrawingStyle = dsFlat DrawingStyle = dsFlat
TaskHeadAttributes.Font.Style = [fsItalic]
end end
end end
object Contacts: TPage object Contacts: TPage
@ -730,7 +717,7 @@ object MainForm: TMainForm
end end
object VpNavBar1: TVpNavBar object VpNavBar1: TVpNavBar
Left = 0 Left = 0
Height = 596 Height = 576
Top = 0 Top = 0
Width = 120 Width = 120
ActiveFolder = 0 ActiveFolder = 0
@ -831,7 +818,7 @@ object MainForm: TMainForm
end end
object Splitter1: TSplitter object Splitter1: TSplitter
Left = 120 Left = 120
Height = 596 Height = 576
Top = 0 Top = 0
Width = 5 Width = 5
end end

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

@ -95,33 +95,6 @@ begin
dsFlat: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow); dsFlat: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
ds3D: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight); ds3D: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight);
end; end;
(*
if FMonthView.DrawingStyle = dsFlat then begin
{ draw a simple rectangular border }
DrawBevelRect(
RenderCanvas,
TPSRotateRectangle(Angle, RenderIn, R),
BevelShadow,
BevelShadow
);
end else
if FMonthView.DrawingStyle = ds3d then begin
{ draw a 3d bevel }
DrawBevelRect(
RenderCanvas,
TPSRotateRectangle(Angle, RenderIn, R),
BevelShadow,
BevelHighlight
);
InflateRect(R, -1, -1);
DrawBevelRect(
RenderCanvas,
TPSRotateRectangle(Angle, RenderIn, R),
BevelDarkShadow,
BevelFace
);
end;
*)
end; end;
procedure TVpMonthViewPainter.DrawDayCell(ADate: TDate; ACol, ARow: Integer; procedure TVpMonthViewPainter.DrawDayCell(ADate: TDate; ACol, ARow: Integer;

107
components/tvplanit/source/vptasklist.pas
View File

@ -67,6 +67,7 @@ type
FOverdueColor: TColor; FOverdueColor: TColor;
FNormalColor: TColor; FNormalColor: TColor;
FCompletedColor: TColor; FCompletedColor: TColor;
function IsStoredDueDateFormat: Boolean;
procedure SetCheckColor(Value: TColor); procedure SetCheckColor(Value: TColor);
procedure SetCheckBGColor(Value: TColor); procedure SetCheckBGColor(Value: TColor);
procedure SetCheckStyle(Value: TVpCheckStyle); procedure SetCheckStyle(Value: TVpCheckStyle);
@ -81,16 +82,16 @@ type
constructor Create(Owner: TVpTaskList); constructor Create(Owner: TVpTaskList);
destructor Destroy; override; destructor Destroy; override;
published published
property CheckBGColor: TColor read FCheckBGColor write SetCheckBGColor; property CheckBGColor: TColor read FCheckBGColor write SetCheckBGColor default clWindow;
property CheckColor: TColor read FCheckColor write SetCheckColor; property CheckColor: TColor read FCheckColor write SetCheckColor default cl3DDkShadow;
property CheckStyle: TVpCheckStyle read FCheckStyle write SetCheckStyle; property CheckStyle: TVpCheckStyle read FCheckStyle write SetCheckStyle default csCheck;
property DueDateFormat: string read FDueDateFormat write SetDueDateFormat; property DueDateFormat: string read FDueDateFormat write SetDueDateFormat stored IsStoredDueDateFormat;
property ShowCompletedTasks: Boolean read FShowCompleted write SetShowCompleted; property ShowCompletedTasks: Boolean read FShowCompleted write SetShowCompleted default false;
property ShowAll: Boolean read FShowAll write SetShowAll; property ShowAll: Boolean read FShowAll write SetShowAll default false;
property ShowDueDate: Boolean read FShowDueDate write SetShowDueDate; property ShowDueDate: Boolean read FShowDueDate write SetShowDueDate default true;
property OverdueColor: TColor read FOverdueColor write SetOverdueColor; property OverdueColor: TColor read FOverdueColor write SetOverdueColor default clRed;
property NormalColor: TColor read FNormalColor write SetNormalColor; property NormalColor: TColor read FNormalColor write SetNormalColor default clWindowText;
property CompletedColor: TColor read FCompletedColor write SetCompletedColor; property CompletedColor: TColor read FCompletedColor write SetCompletedColor default clGray;
end; end;
{ InPlace Editor } { InPlace Editor }
@ -104,12 +105,16 @@ type
end; end;
TVpTaskHeadAttr = class(TVpPersistent) TVpTaskHeadAttr = class(TVpPersistent)
protected{private} private
FTaskList: TVpTaskList; FTaskList: TVpTaskList;
FFont: TVpFont; FFont: TVpFont;
FColor: TColor; FColor: TColor;
FGlyphDist: Integer;
procedure SetColor(Value: TColor); procedure SetColor(Value: TColor);
procedure SetFont(Value: TVpFont); procedure SetFont(Value: TVpFont);
procedure SetGlyphDist(Value: Integer);
protected
public public
constructor Create(AOwner: TVpTaskList); constructor Create(AOwner: TVpTaskList);
destructor Destroy; override; destructor Destroy; override;
@ -117,8 +122,9 @@ type
{ The Invalidate method is used as a bridge between FFont & FTaskList. } { The Invalidate method is used as a bridge between FFont & FTaskList. }
property TaskList: TVpTaskList read FTaskList; property TaskList: TVpTaskList read FTaskList;
published published
property Color: TColor read FColor write SetColor; property Color: TColor read FColor write SetColor default clBtnFace;
property Font: TVpFont read FFont write SetFont; property Font: TVpFont read FFont write SetFont;
property GlyphDistance: Integer read FGlyphDist write SetGlyphDist default 10;
end; end;
{ Task List } { Task List }
@ -264,14 +270,14 @@ type
property AllowInplaceEditing: Boolean property AllowInplaceEditing: Boolean
read FAllowInplaceEdit write FAllowInplaceEdit default true; read FAllowInplaceEdit write FAllowInplaceEdit default true;
property DisplayOptions: TVpTaskDisplayOptions read FDisplayOptions write FDisplayOptions;
property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR;
property MaxVisibleTasks: Word read FMaxVisibleTasks write SetMaxVisibleTasks;
property TaskHeadAttributes: TVpTaskHeadAttr read FTaskHeadAttr write FTaskHeadAttr;
property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d;
property Color: TColor read FColor write SetColor default DEFAULT_COLOR; property Color: TColor read FColor write SetColor default DEFAULT_COLOR;
property DisplayOptions: TVpTaskDisplayOptions read FDisplayOptions write FDisplayOptions;
property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d;
property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR;
property MaxVisibleTasks: Word read FMaxVisibleTasks write SetMaxVisibleTasks default 250;
property ShowIcon: Boolean read FShowIcon write SetShowIcon default True; property ShowIcon: Boolean read FShowIcon write SetShowIcon default True;
property ShowResourceName: Boolean read FShowResourceName write SetShowResourceName default true; property ShowResourceName: Boolean read FShowResourceName write SetShowResourceName default true;
property TaskHeadAttributes: TVpTaskHeadAttr read FTaskHeadAttr write FTaskHeadAttr;
property TextMargin: Integer read FTextMargin write SetTextMargin default TEXT_MARGIN; property TextMargin: Integer read FTextMargin write SetTextMargin default TEXT_MARGIN;
{ events } { events }
property BeforeEdit: TVpBeforeEditTask read FBeforeEdit write FBeforeEdit; property BeforeEdit: TVpBeforeEditTask read FBeforeEdit write FBeforeEdit;
@ -286,8 +292,8 @@ uses
VpDlg, VpTaskEditDlg, VpTasklistPainter; VpDlg, VpTaskEditDlg, VpTasklistPainter;
(*****************************************************************************) (*****************************************************************************)
{ TVpTaskDisplayOptions } { TVpTaskDisplayOptions }
(*****************************************************************************)
constructor TVpTaskDisplayOptions.Create(Owner: TVpTaskList); constructor TVpTaskDisplayOptions.Create(Owner: TVpTaskList);
begin begin
inherited Create; inherited Create;
@ -299,15 +305,18 @@ begin
FCheckStyle := csCheck; FCheckStyle := csCheck;
FOverdueColor := clRed; FOverdueColor := clRed;
FCompletedColor := clGray; FCompletedColor := clGray;
FNormalColor := clBlack; FNormalColor := clWindowText;
end; end;
{=====}
destructor TVpTaskDisplayOptions.Destroy; destructor TVpTaskDisplayOptions.Destroy;
begin begin
inherited; inherited;
end; end;
{=====}
function TVpTaskDisplayOptions.IsStoredDueDateFormat: Boolean;
begin
Result := FDueDateFormat <> DefaultFormatSettings.ShortDateFormat;
end;
procedure TVpTaskDisplayOptions.SetOverdueColor(Value : TColor); procedure TVpTaskDisplayOptions.SetOverdueColor(Value : TColor);
begin begin
@ -316,7 +325,6 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskDisplayOptions.SetNormalColor(Value: TColor); procedure TVpTaskDisplayOptions.SetNormalColor(Value: TColor);
begin begin
@ -325,7 +333,6 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskDisplayOptions.SetCompletedColor(Value: TColor); procedure TVpTaskDisplayOptions.SetCompletedColor(Value: TColor);
begin begin
@ -334,7 +341,6 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskDisplayOptions.SetCheckColor(Value: TColor); procedure TVpTaskDisplayOptions.SetCheckColor(Value: TColor);
begin begin
@ -343,7 +349,6 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskDisplayOptions.SetCheckBGColor(Value: TColor); procedure TVpTaskDisplayOptions.SetCheckBGColor(Value: TColor);
begin begin
@ -352,7 +357,6 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskDisplayOptions.SetCheckStyle(Value: TVpCheckStyle); procedure TVpTaskDisplayOptions.SetCheckStyle(Value: TVpCheckStyle);
begin begin
@ -361,7 +365,6 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskDisplayOptions.SetDueDateFormat(Value: string); procedure TVpTaskDisplayOptions.SetDueDateFormat(Value: string);
begin begin
@ -370,7 +373,6 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskDisplayOptions.SetShowCompleted(Value : Boolean); procedure TVpTaskDisplayOptions.SetShowCompleted(Value : Boolean);
begin begin
@ -379,7 +381,6 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskDisplayOptions.SetShowDueDate(Value: Boolean); procedure TVpTaskDisplayOptions.SetShowDueDate(Value: Boolean);
begin begin
@ -388,7 +389,6 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskDisplayOptions.SetShowAll(Value: Boolean); procedure TVpTaskDisplayOptions.SetShowAll(Value: Boolean);
begin begin
@ -397,53 +397,61 @@ begin
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
end; end;
{=====}
{ TVpTaskHeadAttr }
(******************************************************************************)
{ TVpTaskHeadAttr }
(******************************************************************************)
constructor TVpTaskHeadAttr.Create(AOwner: TVpTaskList); constructor TVpTaskHeadAttr.Create(AOwner: TVpTaskList);
begin begin
inherited Create; inherited Create;
FTaskList := AOwner; FTaskList := AOwner;
FFont := TVpFont.Create(self); FFont := TVpFont.Create(self);
FFont.Assign(FTaskList.Font); FFont.Assign(FTaskList.Font);
FColor := clSilver; FColor := clBtnFace;
FGlyphDist := 10;
end; end;
{=====}
destructor TVpTaskHeadAttr.Destroy; destructor TVpTaskHeadAttr.Destroy;
begin begin
FFont.Free; FFont.Free;
end; end;
{=====}
procedure TVpTaskHeadAttr.Invalidate; procedure TVpTaskHeadAttr.Invalidate;
begin begin
if Assigned(FTaskList) then if Assigned(FTaskList) then
FTaskList.Invalidate; FTaskList.Invalidate;
end; end;
{=====}
procedure TVpTaskHeadAttr.SetColor(Value: TColor); procedure TVpTaskHeadAttr.SetColor(Value: TColor);
begin begin
if Value <> FColor then begin if Value <> FColor then begin
FColor := Value; FColor := Value;
TaskList.Invalidate; Invalidate;
end; end;
end; end;
{=====}
procedure TVpTaskHeadAttr.SetFont(Value: TVpFont); procedure TVpTaskHeadAttr.SetFont(Value: TVpFont);
begin begin
if Value <> FFont then begin if Value <> FFont then begin
FFont.Assign(Value); FFont.Assign(Value);
TaskList.Invalidate; Invalidate;
end;
end;
procedure TVpTaskHeadAttr.SetGlyphDist(Value: Integer);
begin
if Value <> FGlyphDist then
begin
FGlyphDist := Value;
Invalidate;
end; end;
end; end;
{=====}
{ TVpCGInPlaceEdit } (******************************************************************************)
{ TVpCGInPlaceEdit }
(******************************************************************************)
constructor TVpTLInPlaceEdit.Create(AOwner: TComponent); constructor TVpTLInPlaceEdit.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
@ -508,13 +516,15 @@ begin
end; end;
end; end;
(*****************************************************************************)
{ TVpTaskList }
(******************************************************************************)
{ TVpTaskList }
(******************************************************************************)
constructor TVpTaskList.Create(AOwner: TComponent); constructor TVpTaskList.Create(AOwner: TComponent);
begin begin
inherited; inherited;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
{ Create internal classes and stuff } { Create internal classes and stuff }
tlClickTimer := TTimer.Create(self); tlClickTimer := TTimer.Create(self);
FTaskHeadAttr := TVpTaskHeadAttr.Create(Self); FTaskHeadAttr := TVpTaskHeadAttr.Create(Self);
@ -673,7 +683,7 @@ end;
procedure TVpTaskList.Paint; procedure TVpTaskList.Paint;
begin begin
{ paint simply calls RenderToCanvas and passes in the screen canvas. } // Paint simply calls RenderToCanvas and passes in the screen canvas.
RenderToCanvas( RenderToCanvas(
Canvas, { Screen Canvas} Canvas, { Screen Canvas}
Rect(0, 0, Width, Height), { Clipping Rectangle } Rect(0, 0, Width, Height), { Clipping Rectangle }
@ -766,7 +776,6 @@ begin
Result := -1 Result := -1
else else
Result := FActiveTask.Owner.IndexOf(FActiveTask); Result := FActiveTask.Owner.IndexOf(FActiveTask);
// result := FActiveTask.ItemIndex;
end; end;
procedure TVpTaskList.SetLineColor(Value: TColor); procedure TVpTaskList.SetLineColor(Value: TColor);
@ -802,7 +811,7 @@ procedure TVpTaskList.WMSize(var Msg: TLMSize);
{$ENDIF} {$ENDIF}
begin begin
inherited; inherited;
{ force a repaint on resize } // Force a repaint on resize
Invalidate; Invalidate;
end; end;
@ -962,7 +971,7 @@ begin
Exit; Exit;
if not CheckCreateResource then if not CheckCreateResource then
Exit; Exit;
{ Allow the user to fill in all the new information } // Allow the user to fill in all the new information.
Repaint; Repaint;
tlSpawnTaskEditDialog(True); tlSpawnTaskEditDialog(True);
end; end;
@ -1376,6 +1385,8 @@ begin
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin begin
FTextMargin := round(FTextMargin * AXProportion); FTextMargin := round(FTextMargin * AXProportion);
with FTaskHeadAttr do
FGlyphDist := round(FGlyphDist * AXProportion);
end; end;
end; end;
{$IFEND} {$IFEND}

163
components/tvplanit/source/vptasklistpainter.pas
View File

@ -54,7 +54,7 @@ type
implementation implementation
uses uses
Forms, Math, Forms,
VpData, VpMisc, VpCanvasUtils, VpSR; VpData, VpMisc, VpCanvasUtils, VpSR;
type type
@ -212,31 +212,21 @@ procedure TVpTaskListPainter.DrawBorders;
var var
R: TRect; R: TRect;
begin begin
R := Rect(RenderIn.Left, RenderIn.Top, RenderIn.Right - 1, RenderIn.Bottom - 1); R := TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1));
case FTasklist.DrawingStyle of case FTasklist.DrawingStyle of
dsFlat: dsNoBorder: ;
begin dsFlat: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow); ds3d: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight);
{ wp: above line replaces the following code, no bevel in flat mode
DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight);
InflateRect(R, -1, -1);
DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelShadow); }
end;
ds3d:
begin
DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight);
InflateRect(R, -1, -1);
DrawBevelRect(RenderCanvas, R, BevelDarkShadow, BevelFace);
end;
end; end;
end; end;
procedure TVpTaskListPainter.DrawHeader; procedure TVpTaskListPainter.DrawHeader;
var var
GlyphRect: TRect; glyphRect: TRect;
HeadStr: string; textRect: TRect;
headStr: string;
delta: Integer; delta: Integer;
w, h: Integer; w, h, hText: Integer;
bmp: TBitmap; bmp: TBitmap;
begin begin
RenderCanvas.Brush.Color := TaskHeadAttrColor; RenderCanvas.Brush.Color := TaskHeadAttrColor;
@ -244,32 +234,30 @@ begin
{$IF VP_LCL_SCALING = 0} {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF} {$ENDIF}
hText := RenderCanvas.TextHeight('Tg');
if FTaskList.DrawingStyle = dsFlat then delta := 1 else delta := 2; delta := IfThen(FTaskList.DrawingStyle = ds3D, 1, 0);
HeadRect.Left := RealLeft + delta; HeadRect.Left := RealLeft + delta;
HeadRect.Left := RealLeft + delta; HeadRect.Left := RealLeft + delta;
HeadRect.Top := RealTop + delta; HeadRect.Top := RealTop + delta;
HeadRect.Right := RealRight - delta; HeadRect.Right := RealRight - delta - 1;
HeadRect.Bottom := RealTop + RenderCanvas.TextHeight('YyGg0') + FTasklist.TextMargin * 2; HeadRect.Bottom := RealTop + hText + FTasklist.TextMargin * 2 - 1;
TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect); TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
{ draw the header cell borders } { draw the header cell borders }
case FTaskList.DrawingStyle of if FTaskList.DrawingStyle = ds3d then
dsFlat: begin { draw a 3d bevel }
begin { draw an outer and inner bevel } HeadRect.Right := HeadRect.Right;
{ wp: no bevel in flat style! DrawBevelRect(RenderCanvas, TPSRotateRectangle(Angle, RenderIn, HeadRect), BevelHighlight, BevelDarkShadow);
HeadRect.Left := HeadRect.Left - 1; end else
HeadRect.Top := HeadRect.Top - 1; begin
DrawBevelRect(RenderCanvas, TPSRotateRectangle(Angle, RenderIn, HeadRect), BevelShadow, BevelShadow); RenderCanvas.Pen.Color := BevelShadow;
} TPSMoveTo(RenderCanvas, Angle, RenderIn, HeadRect.Left, HeadRect.Bottom);
end; TPSLineTo(RenderCanvas, Angle, RenderIn, HeadRect.Right, HeadRect.Bottom);
ds3d:
begin { draw a 3d bevel }
HeadRect.Right := HeadRect.Right - 1;
DrawBevelRect(RenderCanvas, TPSRotateRectangle(Angle, RenderIn, HeadRect), BevelHighlight, BevelDarkShadow);
end;
end; end;
textRect := HeadRect;
{ Draw the glyph } { Draw the glyph }
if FTaskList.ShowIcon then begin if FTaskList.ShowIcon then begin
bmp := TBitmap.Create; bmp := TBitmap.Create;
@ -283,39 +271,36 @@ begin
begin begin
w := Round(bmp.Width * Scale); w := Round(bmp.Width * Scale);
h := Round(bmp.Height * Scale); h := Round(bmp.Height * Scale);
GlyphRect.TopLeft := Point( glyphRect.TopLeft := Point(
HeadRect.Left + FTasklist.TextMargin, HeadRect.Left + FTasklist.TextMargin,
(Headrect.Top + HeadRect.Bottom - h) div 2 (HeadRect.Top + HeadRect.Bottom - h) div 2
); );
GlyphRect.BottomRight := Point(GlyphRect.Left + w, GlyphRect.Top + h); glyphRect.BottomRight := Point(glyphRect.Left + w, glyphRect.Top + h);
{$IFDEF FPC} {$IFDEF FPC}
RotateBitmap(Bmp, Angle); RotateBitmap(Bmp, Angle);
{$ENDIF} {$ENDIF}
TPSStretchDraw(RenderCanvas, Angle, RenderIn, GlyphRect, Bmp); TPSStretchDraw(RenderCanvas, Angle, RenderIn, glyphRect, Bmp);
HeadRect.Left := HeadRect.Left + w + FTasklist.TextMargin; textRect.Left := glyphRect.Right + FTasklist.TaskHeadAttributes.GlyphDistance;
end; end;
finally finally
bmp.Free; bmp.Free;
end; end;
end; end else
textRect.Left := HeadRect.Left + FTaskList.TextMargin;
{ draw the text } { draw the text }
with FTaskList do begin with FTaskList do begin
if ShowResourceName and (DataStore <> nil) and (DataStore.Resource <> nil) then if ShowResourceName and (DataStore <> nil) and (DataStore.Resource <> nil) then
HeadStr := RSTaskTitleResource + DataStore.Resource.Description headStr := RSTaskTitleResource + DataStore.Resource.Description
else else
HeadStr := RSTaskTitleNoResource; headStr := RSTaskTitleNoResource;
RenderCanvas.Font.Assign(TaskHeadAttributes.Font);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
TPSTextOut( TPSTextOut(
RenderCanvas, RenderCanvas,
Angle, Angle,
RenderIn, RenderIn,
HeadRect.Left + TextMargin, textRect.Left,
HeadRect.Top + TextMargin, (textRect.Top + textRect.Bottom - hText) div 2,
HeadStr headStr
); );
end; end;
end; end;
@ -329,27 +314,29 @@ begin
LinePos := HeadRect.Bottom + RowHeight; LinePos := HeadRect.Bottom + RowHeight;
while LinePos < RealBottom do begin while LinePos < RealBottom do begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, RealLeft, LinePos); TPSMoveTo(RenderCanvas, Angle, RenderIn, RealLeft, LinePos);
TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight - 2, LinePos); TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight - 1, LinePos);
Inc(LinePos, RowHeight); Inc(LinePos, RowHeight);
end; end;
end; end;
procedure TVpTaskListPainter.DrawTasks; procedure TVpTaskListPainter.DrawTasks;
var var
xLeft, xRight: Integer;
I: Integer; I: Integer;
Task: TVpTask; task: TVpTask;
LineRect: TRect; LineRect: TRect;
CheckRect: TRect; CheckRect: TRect;
DisplayStr: string; DisplayStr: string;
begin begin
xLeft := RealLeft + 2;
xRight := xLeft + RealWidth - 3;
with TVpTaskListOpener(FTaskList) do begin with TVpTaskListOpener(FTaskList) do begin
if (DataStore = nil) or if (DataStore = nil) or
(DataStore.Resource = nil) or (DataStore.Resource = nil) or
(DataStore.Resource.Tasks.Count = 0) (DataStore.Resource.Tasks.Count = 0)
then begin then begin
if Focused then begin if Focused then begin
LineRect.TopLeft := Point(RealLeft + 2, HeadRect.Bottom); LineRect := Rect(xLeft, HeadRect.Bottom, xRight, HeadRect.Bottom + RowHeight);
LineRect.BottomRight := Point(LineRect.Left + RealWidth - 4, LineRect.Top + RowHeight);
RenderCanvas.Brush.Color := BackgroundSelHighlight; RenderCanvas.Brush.Color := BackgroundSelHighlight;
RenderCanvas.FillRect(LineRect); RenderCanvas.FillRect(LineRect);
RenderCanvas.Brush.Color := RealColor; RenderCanvas.Brush.Color := RealColor;
@ -357,29 +344,27 @@ begin
Exit; Exit;
end; end;
LineRect.TopLeft := Point(RealLeft + 2, HeadRect.Bottom); LineRect := Rect(xLeft, HeadRect.Bottom, xRight, HeadRect.Bottom + RowHeight);
LineRect.BottomRight := Point(LineRect.Left + RealWidth - 4, LineRect.Top + RowHeight);
tlVisibleItems := 0; tlVisibleItems := 0;
RenderCanvas.Brush.Color := RealColor; RenderCanvas.Brush.Color := RealColor;
tlAllTaskList.Clear; tlAllTaskList.Clear;
{ Make sure the tasks are properly sorted } // Make sure the tasks are properly sorted
DataStore.Resource.Tasks.Sort; DataStore.Resource.Tasks.Sort;
for I := 0 to pred(DataStore.Resource.Tasks.Count) do begin for I := 0 to pred(DataStore.Resource.Tasks.Count) do begin
if DisplayOptions.ShowAll then if DisplayOptions.ShowAll then
{ Get all tasks regardless of their status and due date } // Get all tasks regardless of their status and due date
tlAllTaskList.Add(DataStore.Resource.Tasks.GetTask(I)) tlAllTaskList.Add(DataStore.Resource.Tasks.GetTask(I))
else begin else begin
{ get all tasks which are incomplete, or were just completed today.} // Get all tasks which are incomplete, or were just completed today.
Task := DataStore.Resource.Tasks.GetTask(I); task := DataStore.Resource.Tasks.GetTask(I);
if not Task.Complete then if not task.Complete then
tlAllTaskList.Add(Task) tlAllTaskList.Add(task)
else else
if FDisplayOptions.ShowCompletedTasks and SameDate(Task.CompletedOn, now) then if FDisplayOptions.ShowCompletedTasks and SameDate(Task.CompletedOn, now) then
tlAllTaskList.Add(Task); tlAllTaskList.Add(task);
end; end;
end; end;
@ -388,11 +373,11 @@ begin
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF} {$ENDIF}
for I := StartLine to pred(tlAllTaskList.Count) do begin for I := StartLine to pred(tlAllTaskList.Count) do begin
Task := tlAllTaskList[I]; task := tlAllTaskList[I];
if (LineRect.Top + Trunc(RowHeight * 0.5) <= RealBottom) then begin if (LineRect.Top + Trunc(RowHeight * 0.5) <= RealBottom) then begin
{ if this is the selected task and we are not in edit mode, } // If this is the selected task and we are not in edit mode,
{ then set background selection } // then set background selection.
if (Task = FActiveTask) and if (task = FActiveTask) and
((tlInPlaceEditor = nil) or not tlInplaceEditor.Visible) and ((tlInPlaceEditor = nil) or not tlInplaceEditor.Visible) and
(not DisplayOnly) and Focused (not DisplayOnly) and Focused
then begin then begin
@ -401,48 +386,48 @@ begin
RenderCanvas.Brush.Color := RealColor; RenderCanvas.Brush.Color := RealColor;
end; end;
{ draw the checkbox } // Draw the checkbox
CheckRect := DrawCheck(LineRect, Task.Complete); CheckRect := DrawCheck(LineRect, task.Complete);
if Task.Complete then begin if task.Complete then begin
{ complete task } // Complete task
RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsStrikeout]; RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsStrikeout];
RenderCanvas.Font.Color := RealCompleteColor; RenderCanvas.Font.Color := RealCompleteColor;
end else begin end else begin
{ incomplete task } // Incomplete task
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsStrikeout]; RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsStrikeout];
if (Trunc(Task.DueDate) < Trunc(Now)) and (Trunc(Task.DueDate) <> 0) then if (Trunc(task.DueDate) < Trunc(Now)) and (Trunc(task.DueDate) <> 0) then
{ overdue task } // Overdue task
RenderCanvas.Font.Color := RealOverdueColor RenderCanvas.Font.Color := RealOverdueColor
else else
RenderCanvas.Font.Color := RealNormalColor; RenderCanvas.Font.Color := RealNormalColor;
end; end;
if Task.Priority = ord(tpHigh) then if task.Priority = ord(tpHigh) then
RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold] else RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold] else
RenderCanvas.Font.Style := RenderCanvas.Font.style - [fsBold]; RenderCanvas.Font.Style := RenderCanvas.Font.style - [fsBold];
{ if this is the selected task, set highlight text color } // If this is the selected task, set highlight text color }
if (Task = FActiveTask) and if (task = FActiveTask) and
((tlInPlaceEditor = nil) or not tlInplaceEditor.Visible) and ((tlInPlaceEditor = nil) or not tlInplaceEditor.Visible) and
(not DisplayOnly) and Focused (not DisplayOnly) and Focused
then then
RenderCanvas.Font.Color := ForegroundSelHighlight; RenderCanvas.Font.Color := ForegroundSelHighlight;
{ build display string } // Build display string.
DisplayStr := ''; DisplayStr := '';
if (FDisplayOptions.ShowDueDate) and (Trunc(Task.DueDate) <> 0) then if (FDisplayOptions.ShowDueDate) and (Trunc(task.DueDate) <> 0) then
DisplayStr := FormatDateTime(FDisplayOptions.DueDateFormat, Task.DueDate) + ' - '; DisplayStr := FormatDateTime(FDisplayOptions.DueDateFormat, task.DueDate) + ' - ';
DisplayStr := DisplayStr + Task.Description; DisplayStr := DisplayStr + task.Description;
{ Adjust display string - If the string is too long for the available } // Adjust display string - If the string is too long for the available
{ space, Chop the end off and replace it with an ellipses. } // space, chop the end off and replace it with an ellipses.
DisplayStr := GetDisplayString(RenderCanvas, DisplayStr, 3, WidthOf(LineRect) - CheckRect.Right - TextMargin); DisplayStr := GetDisplayString(RenderCanvas, DisplayStr, 3, WidthOf(LineRect) - CheckRect.Right - TextMargin);
{ paint the text } // Paint the text
TPSTextOut(RenderCanvas, Angle, RenderIn, CheckRect.Right + TextMargin * 2, LineRect.Top + TextMargin, DisplayStr); TPSTextOut(RenderCanvas, Angle, RenderIn, CheckRect.Right + TextMargin * 2, LineRect.Top + TextMargin, DisplayStr);
{ store the tasks drawing details } // Store the tasks drawing details
tlVisibleTaskArray[tlVisibleItems].Task := Task; tlVisibleTaskArray[tlVisibleItems].Task := task;
tlVisibleTaskArray[tlVisibleItems].LineRect := Rect( tlVisibleTaskArray[tlVisibleItems].LineRect := Rect(
CheckRect.Right + TextMargin, CheckRect.Right + TextMargin,
LineRect.Top, LineRect.Top,
@ -485,6 +470,7 @@ end;
procedure TVpTaskListPainter.InitColors; procedure TVpTaskListPainter.InitColors;
begin begin
if DisplayOnly then begin if DisplayOnly then begin
// Colors for printing
RealColor := clWhite; RealColor := clWhite;
BackgroundSelHighlight := clBlack; BackgroundSelHighlight := clBlack;
ForegroundSelHighlight := clWhite; ForegroundSelHighlight := clWhite;
@ -501,6 +487,7 @@ begin
RealNormalColor := clBlack; RealNormalColor := clBlack;
TaskHeadAttrColor := clSilver; TaskHeadAttrColor := clSilver;
end else begin end else begin
// Colors for screen display
RealColor := FTaskList.Color; RealColor := FTaskList.Color;
BackgroundSelHighlight := clHighlight; BackgroundSelHighlight := clHighlight;
ForegroundSelHighlight := clHighlightText; ForegroundSelHighlight := clHighlightText;

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

@ -589,12 +589,13 @@ var
headTextRect: TRect; headTextRect: TRect;
headStr: string = ''; headStr: string = '';
headStrLen: Integer; headStrLen: Integer;
maxStrLen: Integer;
weekNo: Integer; weekNo: Integer;
startStr, endStr: String; startStr, endStr: String;
txtStart: Integer; txtStart: Integer;
txtMargin: Integer; margin: Integer;
begin begin
txtMargin := FWeekView.TextMargin; margin := FWeekView.HeaderMargin;
RenderCanvas.Brush.Color := RealHeadAttrColor; RenderCanvas.Brush.Color := RealHeadAttrColor;
RenderCanvas.Font.Assign(TFont(FWeekView.HeadAttributes.Font)); RenderCanvas.Font.Assign(TFont(FWeekView.HeadAttributes.Font));
@ -622,48 +623,17 @@ begin
end; end;
end; end;
// Build header caption
weekNo := GetWeekOfYear(StartDate);
startStr := FormatDateTime(FWeekView.DateLabelFormat, StartDate);
endStr := FormatDateTime(FWeekView.DateLabelFormat, StartDate+6);
headStr := Format('%s %d (%s - %s)', [RSCalendarWeek, weekNo, startStr, endStr]);
{ draw the text }
if DisplayOnly and (RenderCanvas.TextWidth(HeadStr) >= WidthOf(RenderIn)) then
headTextRect.TopLeft := Point(RealLeft + txtMargin * 2, HeadRect.Top)
else
if DisplayOnly then
headTextRect.TopLeft := Point(
RealLeft + (RealRight - RealLeft - RenderCanvas.TextWidth(headStr)) div 2,
headRect.Top
)
else
headTextRect.TopLeft := Point(
RealLeft + Trunc(TVpWeekViewOpener(FWeekView).wvHeaderHeight * 0.8) * 2 + txtMargin * 2,
headRect.Top
);
headTextRect.BottomRight := headRect.BottomRight;
dec(headTextRect.Right, txtMargin);
// Fix header string
headStrLen := RenderCanvas.TextWidth(headStr);
if headStrLen > headTextRect.Right - headTextRect.Left - txtMargin then
begin
headStr := GetDisplayString(RenderCanvas, headStr, 0,
headTextRect.Right - headTextRect.Left - txtMargin);
end;
// Position the spinner buttons // Position the spinner buttons
with FWeekView do begin with FWeekView do begin
PrevMonthBtn.Width := PrevMonthBtn.Height; PrevMonthBtn.Width := PrevMonthBtn.Height;
PrevMonthBtn.Left := TextMargin; PrevMonthBtn.Left := margin;
PrevMonthBtn.Top := (headRect.Top + headRect.Bottom - PrevMonthBtn.Height) div 2; PrevMonthBtn.Top := (headRect.Top + headRect.Bottom - PrevMonthBtn.Height) div 2;
PrevWeekBtn.Height := PrevMonthBtn.Height; PrevWeekBtn.Height := PrevMonthBtn.Height;
PrevWeekBtn.Width := PrevMonthBtn.Height; PrevWeekBtn.Width := PrevMonthBtn.Height;
PrevWeekBtn.Left := PrevMonthBtn.Left + PrevMonthBtn.Width; PrevWeekBtn.Left := PrevMonthBtn.Left + PrevMonthBtn.Width;
PrevWeekBtn.Top := PrevMonthBtn.Top; PrevWeekBtn.Top := PrevMonthBtn.Top;
NextWeekBtn.Height := PrevMonthBtn.Height; NextWeekBtn.Height := PrevMonthBtn.Height;
NextWeekBtn.Width := PrevMonthBtn.Height; NextWeekBtn.Width := PrevMonthBtn.Height;
NextWeekBtn.Left := PrevWeekBtn.Left + PrevWeekBtn.Width; NextWeekBtn.Left := PrevWeekBtn.Left + PrevWeekBtn.Width;
@ -673,13 +643,44 @@ begin
NextMonthBtn.Width := PrevMonthBtn.Height; NextMonthBtn.Width := PrevMonthBtn.Height;
NextMonthBtn.Left := NextWeekBtn.Left + NextWeekBtn.Width; NextMonthBtn.Left := NextWeekBtn.Left + NextWeekBtn.Width;
NextMonthBtn.Top := PrevMonthBtn.Top; NextMonthBtn.Top := PrevMonthBtn.Top;
txtStart := NextMonthBtn.Left + NextMonthBtn.Width + txtMargin; txtStart := NextMonthBtn.Left + NextMonthBtn.Width + margin;
end; end;
// Build header caption
weekNo := GetWeekOfYear(StartDate);
startStr := FormatDateTime(FWeekView.DateLabelFormat, StartDate);
endStr := FormatDateTime(FWeekView.DateLabelFormat, StartDate+6);
headStr := Format('%s %d (%s - %s)', [RSCalendarWeek, weekNo, startStr, endStr]);
// Draw the text
{
if DisplayOnly and (RenderCanvas.TextWidth(headStr) >= WidthOf(RenderIn)) then
headTextRect.TopLeft := Point(RealLeft + margin, HeadRect.Top)
else
if DisplayOnly then
headTextRect.TopLeft := Point(
RealLeft + (RealRight - RealLeft - RenderCanvas.TextWidth(headStr)) div 2,
headRect.Top
)
else
headTextRect.TopLeft := Point(
RealLeft + Trunc(TVpWeekViewOpener(FWeekView).wvHeaderHeight * 0.8) * 2 + margin,
headRect.Top
);
headTextRect.BottomRight := headRect.BottomRight;
dec(headTextRect.Right, margin);
}
// Fix length of header string
headStrLen := RenderCanvas.TextWidth(headStr);
maxStrLen := headRect.Right - margin - txtStart;
if headStrLen > maxStrLen then
headStr := GetDisplayString(RenderCanvas, headStr, 0, maxStrlen);
TPSTextOut(RenderCanvas, Angle, RenderIn, TPSTextOut(RenderCanvas, Angle, RenderIn,
txtStart, txtStart,
(headTextRect.Top + headTextRect.Bottom - RenderCanvas.TextHeight('Tg')) div 2, (headRect.Top + headRect.Bottom - RenderCanvas.TextHeight('Tg')) div 2,
headStr headStr
); );
end; end;