tvplanit: Some clean-up, some cosmetic changes

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4957 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-14 16:13:22 +00:00
parent bc4e7a1be7
commit f45723d6cf
6 changed files with 269 additions and 2390 deletions

View File

@@ -274,34 +274,6 @@ object MainForm: TMainForm
ClientHeight = 504
ClientWidth = 772
TabVisible = False
object VpTaskList1: TVpTaskList
Left = 0
Height = 462
Top = 42
Width = 772
DataStore = VpBufDSDataStore1
ControlLink = VpControlLink1
Color = clWindow
Align = alClient
TabStop = True
TabOrder = 0
ReadOnly = False
DisplayOptions.CheckBGColor = clWindow
DisplayOptions.CheckColor = cl3DDkShadow
DisplayOptions.CheckStyle = csCheck
DisplayOptions.DueDateFormat = 'dd.MM.yyyy'
DisplayOptions.ShowCompletedTasks = False
DisplayOptions.ShowAll = True
DisplayOptions.ShowDueDate = True
DisplayOptions.OverdueColor = clRed
DisplayOptions.NormalColor = clBlack
DisplayOptions.CompletedColor = clGray
LineColor = clGray
MaxVisibleTasks = 250
TaskHeadAttributes.Color = clSilver
DrawingStyle = dsFlat
ShowResourceName = True
end
object Panel6: TPanel
Left = 0
Height = 42
@@ -311,7 +283,7 @@ object MainForm: TMainForm
BevelOuter = bvNone
ClientHeight = 42
ClientWidth = 772
TabOrder = 1
TabOrder = 0
object RbAllTasks: TRadioButton
Left = 8
Height = 19
@@ -333,6 +305,37 @@ object MainForm: TMainForm
TabOrder = 1
end
end
object VpTaskList1: TVpTaskList
Left = 0
Height = 462
Top = 42
Width = 772
DataStore = VpBufDSDataStore1
ControlLink = VpControlLink1
Color = clWindow
Font.Height = -12
ParentFont = False
Align = alClient
TabStop = True
TabOrder = 1
ReadOnly = False
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.Height = -12
DrawingStyle = ds3d
ShowResourceName = True
end
end
object TabContacts: TTabSheet
Caption = 'Contacts'

View File

@@ -190,8 +190,6 @@ object Form1: TForm1
DataStore = VpXmlDatastore1
ControlLink = VpControlLink1
Color = clWindow
Font.Height = -12
ParentFont = False
Align = alClient
TabStop = True
TabOrder = 2

View File

@@ -322,11 +322,10 @@ type
function GetControlType: TVpItemType; virtual; abstract;
procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine: Integer; StopLine: Integer; UseGran: TVpGranularity;
StartLine, StopLine: Integer; UseGran: TVpGranularity;
DisplayOnly: Boolean); virtual; abstract;
procedure LinkHandler(Sender: TComponent;
NotificationType: TVpNotificationType; const Value: Variant);
virtual; abstract;
procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType;
const Value: Variant); virtual; abstract;
property ReadOnly: Boolean read FReadOnly write FReadOnly;
published
property PopupMenu;
@@ -1227,6 +1226,7 @@ begin
Inc(I);
end;
end;
FPrinter := TVpPrinter.Create (Self);
FLocalization := TVpLocalization.Create;
end;

View File

@@ -1448,372 +1448,6 @@ begin
painter.Free;
end;
end;
(*
var
R, C: Integer;
I: Integer;
SatCol: Integer;
SunCol: Integer;
DOW: TVpDayType;
Y, M, D: Word;
lBadDate: Boolean;
lDate: TDateTime;
RealWidth: Integer;
RealHeight: Integer;
RealLeft: Integer;
RealRight: Integer;
RealTop: Integer;
RealBottom: Integer;
BevelHighlight: TColor;
BevelShadow: TColor;
InactiveDayColor: TColor;
MonthYearColor: TColor;
DayNameColor: TColor;
LineColor: TColor;
EventDayColor: TColor;
DayColor: TColor;
RealColor: TColor;
WeekendColor: TColor;
procedure SetMeasurements;
begin
RealWidth := TPSViewportWidth (Angle, RenderIn);
RealHeight := TPSViewportHeight (Angle, RenderIn);
RealLeft := TPSViewportLeft (Angle, RenderIn);
RealRight := TPSViewportRight (Angle, RenderIn);
RealTop := TPSViewportTop (Angle, RenderIn);
RealBottom := TPSViewportBottom (Angle, RenderIn);
if RenderDate = 0 then
RenderDate := FDate;
end;
procedure DrawDate;
var
R: TRect;
S: string;
begin
if FDateFormat = dfLong then
if cdoShowYear in FOptions then
S := FormatDateTime('mmmm yyyy', RenderDate)
else
S := FormatDateTime('mmmm', RenderDate)
else
if cdoShowYear in FOptions then
S := FormatDateTime('mmm yyyy', RenderDate)
else
S := FormatDateTime('mmm', RenderDate);
{$IF FPC_FULLVERSION < 30000}
S := SysToUTF8(S);
{$ENDIF}
R := Rect (clRowCol[0, 1].Left + RealLeft,
clRowCol[0, 1].Top + RealTop,
clRowCol[0, 1].Right + RealLeft,
clRowCol[0, 1].Bottom + RealTop);
R.Right := clRowCol[0, 6].Left + RealLeft;
{switch to short date format if string won't fit}
if FDateFormat = dfLong then
if RenderCanvas.TextWidth(S) > R.Right-R.Left then
{$IF FPC_FULLVERSION >= 30000}
S := FormatDateTime('mmm yyyy', RenderDate);
{$ELSE}
S := SysToUTF8(FormatDateTime('mmm yyyy', RenderDate));
{$ENDIF}
RenderCanvas.Font.Color := MonthYearColor;
if Assigned(FOnDrawDate) then
FOnDrawDate(Self, RenderDate, R)
else
TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, R, S);
end;
procedure DrawDayNames;
var
I: Integer;
S: string;
DrawRect: TRect;
begin
{draw the day name column labels}
RenderCanvas.Font.Color := DayNameColor;
I := 0;
DOW := FWeekStarts;
repeat
{record columns for weekends}
if DOW = dtSaturday then
SatCol := I;
if DOW = dtSunday then
SunCol := I;
{get the day name}
if cdoShortNames in Options then begin
if FDayNameWidth < 1 then
S := ShortDayNames[Ord(DOW)+1]
else
S := Copy(ShortDayNames[Ord(DOW)+1], 1, FDayNameWidth)
end else begin
if FDayNameWidth < 1 then
S := LongDayNames[Ord(DOW)+1]
else
S := Copy(LongDayNames[Ord(DOW)+1], 1, FDayNameWidth)
end;
{$IF FPC_FULLVERSION < 30000}
S := SysToUTF8(S);
{$ENDIF}
{draw the day name above each column}
DrawRect := Rect(clRowCol[1, I].Left + RealLeft,
clRowCol[1, I].Top + RealTop,
clRowCol[1, I].Right + RealLeft,
clRowCol[1, I].Bottom + RealTop);
TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S);
Inc(I);
if DOW < High(DOW) then
Inc(DOW)
else
DOW := Low(DOW);
until DOW = WeekStarts;
end;
procedure DrawLine;
begin
// if (not Ctl3D) then begin
RenderCanvas.Pen.Color := LineColor;
TPSMoveTo (RenderCanvas, Angle, RenderIn,
RealLeft, clRowCol[1,0].Bottom-3 + RealTop);
TPSLineTo (RenderCanvas, Angle, RenderIn,
RealRight, clRowCol[1,0].Bottom-3 + RealTop);
{ end else if Ctl3D then begin
RenderCanvas.Pen.Color := BevelHighlight;
TPSMoveTo (RenderCanvas, Angle, RenderIn,
RealLeft, clRowCol[1,0].Bottom-3 + RealTop);
TPSLineTo (RenderCanvas, Angle, RenderIn,
RealRight, clRowCol[1,0].Bottom-3 + RealTop);
RenderCanvas.Pen.Color := BevelShadow;
TPSMoveTo (RenderCanvas, Angle, RenderIn,
RealLeft, clRowCol[1,0].Bottom-2 + RealTop);
TPSLineTo (RenderCanvas, Angle, RenderIn,
RealRight, clRowCol[1,0].Bottom-2 + RealTop);
end; }
end;
procedure DrawDay(R, C, I: Integer; Grayed: Boolean);
var
Cl: TColor;
OldIdx: Integer;
NewIdx: Integer;
S: string[10];
DrawRect: TRect;
TH: Integer;
begin
{avoid painting day number under buttons}
if cdoShowRevert in FOptions then
if (R = 8) and (C >= 3) then
Exit;
if cdoShowToday in FOptions then
if (R = 8) and (C >= 5) then
Exit;
{convert to a string and draw it centered in its rectangle}
S := IntToStr(clCalendar[I]);
if Grayed then
RenderCanvas.Font.Color := InactiveDayColor;
if not Grayed or (cdoShowInactive in FOptions) then begin
NewIdx := ((R-2) * 7) + Succ(C);
OldIdx := clFirst + Pred(clDay);
if Assigned(FOnGetHighlight) then begin
Cl := RenderCanvas.Font.Color;
FOnGetHighlight(Self, RenderDate+(NewIdx-OldIdx), Cl);
RenderCanvas.Font.Color := Cl;
end;
if Assigned(FOnDrawItem) then
FOnDrawItem(Self, RenderDate+(NewIdx-OldIdx), clRowCol[R,C])
else if clRowCol[R, C].Top <> 0 then begin
DrawRect := Rect (clRowCol[R, C].Left + RealLeft,
clRowCol[R, C].Top + RealTop,
clRowCol[R, C].Right + RealLeft,
clRowCol[R, C].Bottom + RealTop);
TH := RenderCanvas.TextHeight (S);
if TH < DrawRect.Bottom - DrawRect.Top then
DrawRect.Top := DrawRect.Top +
((DrawRect.Bottom - DrawRect.Top) - TH) div 2;
TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S);
end;
end;
end;
procedure DrawFocusBox;
var
R: TRect;
S: string[10];
begin
S := IntToStr(clDay);
{ set highlight color and font style for days with events }
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold];
lBadDate := false;
if (DataStore <> nil) and (DataStore.Resource <> nil) then begin
DecodeDate(RenderDate, Y, M, D);
try
{$IFDEF VERSION6}
if not TryEncodeDate (Y, M, clDay, lDate) then
lBadDate := true;
{$ELSE}
lDate := EncodeDate(Y, M, clDay);
{$ENDIF}
except
lBadDate := true;
end;
if (not lBadDate) and (DataStore.Resource.Schedule.EventCountByDay(lDate) > 0)
then begin
RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold, fsUnderline];
RenderCanvas.Font.Color := EventDayColor;
end else
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline];
end;
R := calGetCurrentRectangle;
R.Left := R.Left + RealLeft;
R.Top := R.Top + RealTop;
R.Right := R.Right + RealLeft;
R.Bottom := R.Bottom + RealTop;
R := TPSRotateRectangle (Angle, RenderIn, R);
if not DisplayOnly then begin
{$IFNDEF LCL}
if Focused then
DrawButtonFace (RenderCanvas, R, 1, bsNew, True, True, False)
else
DrawButtonFace (RenderCanvas, R, 1, bsNew, True, False, False);
{$ENDIF}
R := calGetCurrentRectangle;
R.Left := R.Left + RealLeft;
R.Top := R.Top + RealTop;
R.Right := R.Right + RealLeft;
R.Bottom := R.Bottom + RealTop;
TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, R, S);
end;
end;
var
Row: TRowArray;
Col: TColArray;
begin
if DisplayOnly then begin
BevelHighlight := clBlack;
BevelShadow := clBlack;
InactiveDayColor := clSilver;
MonthYearColor := clBlack;
DayNameColor := clBlack;
LineColor := clBlack;
EventDayColor := clBlack;
DayColor := clBlack;
RealColor := clWhite;
WeekendColor := $5f5f5f;
end else begin
BevelHighlight := clBtnHighlight;
BevelShadow := clBtnShadow;
InactiveDayColor := FColors.InactiveDays;
MonthYearColor := FColors.MonthAndYear;
DayNameColor := FColors.DayNames;
LineColor := Font.Color;
EventDayColor := FColors.EventDays;
DayColor := FColors.Days;
RealColor := Color;
WeekendColor := FColors.WeekEnd;
end;
calRebuildCalArray (RenderDate);
RenderCanvas.Pen.Style := psSolid;
RenderCanvas.Pen.Width := 1;
RenderCanvas.Pen.Mode := pmCopy;
RenderCanvas.Brush.Style := bsSolid;
RenderCanvas.Lock;
try
SetMeasurements;
RenderCanvas.Font.Assign (Font);
if (RealRight - RealLeft <> FLastRenderX) or
(RealBottom - RealTop <> FLastRenderY)
then begin
FLastRenderX := RealRight - RealLeft;
FLastRenderY := RealBottom - RealTop;
CalculateSizes (RenderCanvas, Angle, RenderIn, Row, Col, DisplayOnly);
end;
RenderCanvas.Brush.Color := RealColor;
RenderCanvas.FillRect(RenderIn);
{draw the month and year at the top of the calendar}
DrawDate;
{draw the days of the week}
DrawDayNames;
{draw line under day names}
DrawLine;
{draw each day}
I := 1;
for R := 2 to 8 do
for C := 0 to 6 do begin
if ((C = SatCol) and (cdoHighlightSat in Options)) or
((C = SunCol) and (cdoHighlightSun in Options))
then
RenderCanvas.Font.Color := WeekendColor
else
RenderCanvas.Font.Color := DayColor;
{ set highlight color and font style for days with events }
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold];
lBadDate := false;
if (DataStore <> nil) and (DataStore.Resource <> nil) then begin
DecodeDate(RenderDate, Y, M, D);
try begin
{$IFDEF VERSION6}
if not TryEncodeDate (Y, M, clCalendar[I], lDate) then
lBadDate := True;
{$ELSE}
if clCalendar[I] > DaysInMonth(Y, M) then
lDate := EncodeDate(Y, M, DaysInMonth(Y, M))
else
lDate := EncodeDate(Y, M, clCalendar[I]);
{$ENDIF}
end;
except
lBadDate := true;
end;
if (not lBadDate) and (DataStore.Resource.Schedule.EventCountByDay(lDate) > 0)
then begin
RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold, fsUnderline];
RenderCanvas.Font.Color := EventDayColor;
end else
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline];
end;
DrawDay(R, C, I, (I < clFirst) or (I > clLast));
Inc(I);
end;
RenderCanvas.Font.Color := DayColor;
if not Assigned(FOnDrawItem) then
if not (cdoHideActive in FOptions) then
DrawFocusBox;
finally
RenderCanvas.Unlock;
end;
end;
{=====}
*)
procedure TVpCustomCalendar.SetBorderStyle(Value: TBorderStyle);
begin

File diff suppressed because it is too large Load Diff

View File

@@ -81,26 +81,16 @@ type
constructor Create(Owner: TVpTaskList);
destructor Destroy; override;
published
property CheckBGColor: TColor
read FCheckBGColor write SetCheckBGColor;
property CheckColor: TColor
read FCheckColor write SetCheckColor;
property CheckStyle: TVpCheckStyle
read FCheckStyle write SetCheckStyle;
property DueDateFormat: string
read FDueDateFormat write SetDueDateFormat;
property ShowCompletedTasks : Boolean
read FShowCompleted write SetShowCompleted;
property ShowAll : Boolean
read FShowAll write SetShowAll;
property ShowDueDate: Boolean
read FShowDueDate write SetShowDueDate;
property OverdueColor : TColor
read FOverdueColor write SetOverdueColor;
property NormalColor : TColor
read FNormalColor write SetNormalColor;
property CompletedColor : TColor
read FCompletedColor write SetCompletedColor;
property CheckBGColor: TColor read FCheckBGColor write SetCheckBGColor;
property CheckColor: TColor read FCheckColor write SetCheckColor;
property CheckStyle: TVpCheckStyle read FCheckStyle write SetCheckStyle;
property DueDateFormat: string read FDueDateFormat write SetDueDateFormat;
property ShowCompletedTasks: Boolean read FShowCompleted write SetShowCompleted;
property ShowAll: Boolean read FShowAll write SetShowAll;
property ShowDueDate: Boolean read FShowDueDate write SetShowDueDate;
property OverdueColor: TColor read FOverdueColor write SetOverdueColor;
property NormalColor: TColor read FNormalColor write SetNormalColor;
property CompletedColor: TColor read FCompletedColor write SetCompletedColor;
end;
{ InPlace Editor }
@@ -127,10 +117,8 @@ type
{ The Invalidate method is used as a bridge between FFont & FTaskList. }
property TaskList: TVpTaskList read FTaskList;
published
property Color: TColor
read FColor write SetColor;
property Font: TFont
read FFont write SetFont;
property Color: TColor read FColor write SetColor;
property Font: TFont read FFont write SetFont;
end;
{ Task List }
@@ -225,17 +213,17 @@ type
destructor Destroy; override;
procedure DeleteActiveTask(Verify: Boolean);
procedure LoadLanguage;
procedure LinkHandler(Sender: TComponent;
NotificationType: TVpNotificationType;
procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType;
const Value: Variant); override;
function GetControlType: TVpItemType; override;
procedure PaintToCanvas(ACanvas: TCanvas; ARect: TRect;
Angle: TVpRotationAngle);
procedure PaintToCanvas(ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle);
procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override;
property ActiveTask: TVpTask read FActiveTask;
property TaskIndex: Integer read GetTaskIndex write SetTaskIndex;
published
{inherited properties}
property Align;
@@ -247,29 +235,18 @@ type
property AllowInplaceEditing: Boolean
read FAllowInplaceEdit write FAllowInplaceEdit default true;
property DisplayOptions: TVpTaskDisplayOptions
read FDisplayOptions write FDisplayOptions;
property LineColor: TColor
read FLineColor write SetLineColor;
property MaxVisibleTasks: Word
read FMaxVisibleTasks write SetMaxVisibleTasks;
property TaskHeadAttributes: TVpTaskHeadAttr
read FTaskHeadAttr write FTaskHeadAttr;
property DrawingStyle: TVpDrawingStyle
read FDrawingStyle write SetDrawingStyle;
property Color: TColor
read FColor write SetColor;
property ShowIcon : Boolean
read FShowIcon write SetShowIcon default True;
property ShowResourceName: Boolean
read FShowResourceName write SetShowResourceName;
property DisplayOptions: TVpTaskDisplayOptions read FDisplayOptions write FDisplayOptions;
property LineColor: TColor read FLineColor write SetLineColor;
property MaxVisibleTasks: Word read FMaxVisibleTasks write SetMaxVisibleTasks;
property TaskHeadAttributes: TVpTaskHeadAttr read FTaskHeadAttr write FTaskHeadAttr;
property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle;
property Color: TColor read FColor write SetColor;
property ShowIcon: Boolean read FShowIcon write SetShowIcon default True;
property ShowResourceName: Boolean read FShowResourceName write SetShowResourceName;
{ events }
property BeforeEdit: TVpBeforeEditTask
read FBeforeEdit write FBeforeEdit;
property AfterEdit : TVpAfterEditTask
read FAfterEdit write FAfterEdit;
property OnOwnerEditTask: TVpEditTask
read FOwnerEditTask write FOwnerEditTask;
property BeforeEdit: TVpBeforeEditTask read FBeforeEdit write FBeforeEdit;
property AfterEdit: TVpAfterEditTask read FAfterEdit write FAfterEdit;
property OnOwnerEditTask: TVpEditTask read FOwnerEditTask write FOwnerEditTask;
end;
implementation
@@ -474,22 +451,26 @@ begin
TaskList := TVpTaskList(Owner);
case Key of
VK_RETURN: begin
VK_RETURN:
begin
Key := 0;
TaskList.EndEdit(Self);
end;
VK_UP: begin
VK_UP:
begin
Key := 0;
TaskList.TaskIndex := TaskList.TaskIndex - 1;
end;
VK_DOWN: begin
VK_DOWN:
begin
Key := 0;
TaskList.TaskIndex := TaskList.TaskIndex + 1;
end;
VK_ESCAPE: begin
VK_ESCAPE:
begin
Key := 0;
TaskList.EndEdit(Self);
end;
@@ -633,7 +614,8 @@ end;
procedure TVpTaskList.Paint;
begin
{ paint simply calls RenderToCanvas and passes in the screen canvas. }
RenderToCanvas (Canvas, {Screen Canvas}
RenderToCanvas(
Canvas, { Screen Canvas}
Rect(0, 0, Width, Height), { Clipping Rectangle }
ra0, { Rotation Angle }
1, { Scale }
@@ -641,17 +623,15 @@ begin
tlItemsBefore, { Starting Line }
-1, { Stop Line }
gr30Min, { Granularity - Not used int the task list }
False); { Display Only - True for a printed version, }
{ False for an interactive version }
False { Display Only - True for a printed version, }
); { False for an interactive version }
end;
{=====}
procedure TVpTaskList.PaintToCanvas (ACanvas : TCanvas;
ARect : TRect;
procedure TVpTaskList.PaintToCanvas(ACanvas: TCanvas; ARect: TRect;
Angle: TVpRotationAngle);
begin
RenderToCanvas (ACanvas, ARect, Angle, 1, Now,
-1, -1, gr30Min, True);
RenderToCanvas(ACanvas, ARect, Angle, 1, Now, -1, -1, gr30Min, True);
end;
{=====}
@@ -671,520 +651,6 @@ begin
tlPainting := false;
end;
end;
(*
var
HeadRect : TRect;
Bmp : Graphics.TBitmap;
SaveBrushColor : TColor;
SavePenStyle : TPenStyle;
SavePenColor : TColor;
RowHeight : Integer;
RealWidth : Integer;
RealHeight : Integer;
RealLeft : Integer;
RealRight : Integer;
RealTop : Integer;
RealBottom : Integer;
Rgn : HRGN;
RealColor : TColor;
BackgroundSelHighlight : TColor;
ForegroundSelHighlight : TColor;
BevelShadow : TColor;
BevelHighlight : TColor;
BevelDarkShadow : TColor;
BevelFace : TColor;
RealLineColor : TColor;
RealCheckBgColor : TColor;
RealCheckBoxColor : TColor;
RealCheckColor : TColor;
RealCompleteColor : TColor;
RealOverdueColor : TColor;
RealNormalColor : TColor;
TaskHeadAttrColor : TColor;
procedure DrawLines;
var
LinePos: Integer;
begin
RenderCanvas.Pen.Color := RealLineColor;
RenderCanvas.Pen.Style := psSolid;
LinePos := HeadRect.Bottom + RowHeight;
while LinePos < RealBottom do begin
TPSMoveTo (RenderCanvas, Angle, RenderIn, RealLeft, LinePos);
TPSLineTo (RenderCanvas, Angle, RenderIn, RealRight - 2, LinePos);
Inc (LinePos, RowHeight);
end;
end;
{-}
procedure Clear;
var
I: Integer;
begin
RenderCanvas.Brush.Color := RealColor;
RenderCanvas.FillRect (RenderIn);
{ Clear the LineRect }
for I := 0 to pred(Length(tlVisibleTaskArray)) do begin
tlVisibleTaskArray[I].Task := nil;
tlVisibleTaskArray[I].LineRect := Rect(0, 0, 0, 0);
end;
end;
{-}
procedure SetMeasurements;
begin
RealWidth := TPSViewportWidth (Angle, RenderIn);
RealHeight := TPSViewportHeight (Angle, RenderIn);
RealLeft := TPSViewportLeft (Angle, RenderIn);
RealRight := TPSViewportRight (Angle, RenderIn);
RealTop := TPSViewportTop (Angle, RenderIn);
RealBottom := TPSViewportBottom (Angle, RenderIn);
end;
procedure MeasureRowHeight;
begin
RenderCanvas.Font.Assign(Font);
RowHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin * 2;
end;
{-}
function DrawCheck (Rec : TRect; Checked : Boolean) : TRect;
{ draws the check box and returns it's rectangle }
var
CR: TRect; { checbox rectangle }
W: Integer; { width of the checkbox }
X, Y: Integer; { Coordinates }
begin
X := Rec.Left + TextMargin;
Y := Rec.Top + TextMargin;
W := RowHeight - TextMargin * 2;
{ draw check box }
if FDrawingStyle = dsFlat then begin
RenderCanvas.Brush.Color := RealCheckBgColor;
RenderCanvas.Pen.Color := RealCheckBoxColor;
TPSRectangle (RenderCanvas, Angle, RenderIn,
Rect (X, Y, X + W, Y + W));
end else
begin
// complete box, rather bright
RenderCanvas.Pen.Color := RGB (192, 204, 216);
RenderCanvas.Brush.Color := RealCheckBgColor;
TPSRectangle (RenderCanvas, Angle, RenderIn,
Rect (X, Y, X + W, Y + W));
// left and top lines
RenderCanvas.Pen.Color := RGB (80, 100, 128);
TPSPolyLine (RenderCanvas, Angle, RenderIn,
[Point(X, Y + W - 2), Point(X, Y), Point(X + W - 1, Y)]);
// left and top lines
RenderCanvas.Pen.Color := RealCheckBoxColor;
TPSPolyLine (RenderCanvas, Angle, RenderIn,
[Point(X + 1, Y + W - 3), Point(X + 1, Y + 1),
Point(X + W - 2, Y + 1)]);
// right and bottom lines
RenderCanvas.Pen.Color := RGB(128, 152, 176);
TPSPolyLine (RenderCanvas, Angle, RenderIn,
[Point(X + 1, Y + W - 2), Point(X + W - 2, Y + W - 2),
Point(X+W-2, Y)]);
end;
{ build check rect }
CR := Rect(X + 3, Y + 3, X + W - 3, Y + W - 3);
if Checked then begin
RenderCanvas.Pen.Color := RealCheckColor;
case FDisplayOptions.CheckStyle of
csX : {X}
begin
with RenderCanvas do begin
TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Top);
TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom);
TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Top+1);
TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Bottom);
TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Top);
TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom-1);
TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-1);
TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1);
TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-2);
TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Top-1);
TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Bottom-1);
TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top);
end;
end;
csCheck : {check}
begin
with RenderCanvas do begin
TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left,
CR.Bottom - ((CR.Bottom - cr.Top) div 4));
TPSLineTo (RenderCanvas, Angle, RenderIn,
CR.Left + ((CR.Right - CR.Left) div 4),
CR.Bottom);
TPSLineTo (RenderCanvas, Angle, RenderIn,
CR.Right, CR.Top + 2);
TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left,
CR.Bottom - ((CR.Bottom - cr.Top) div 4) - 1);
TPSLineTo (RenderCanvas, Angle, RenderIn,
CR.Left + ((CR.Right - CR.Left) div 4),
CR.Bottom - 1);
TPSLineTo (RenderCanvas, Angle, RenderIn,
CR.Right, CR.Top + 1);
TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left,
CR.Bottom - ((CR.Bottom - cr.Top) div 4) - 2);
TPSLineTo (RenderCanvas, Angle, RenderIn,
CR.Left + ((CR.Right - CR.Left) div 4),
CR.Bottom - 2);
TPSLineTo (RenderCanvas, Angle, RenderIn,
CR.Right, CR.Top);
{TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-5); }
{TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Left+3, CR.Bottom-2); }
{TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-4); }
{TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Left+3, CR.Bottom-1); }
{TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-3); }
{TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Left+3, CR.Bottom); }
{TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+2, CR.Bottom-3); }
{TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1); }
{TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+2, CR.Bottom-2); }
{TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top); }
{TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+2, CR.Bottom-1); }
{TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top+1); }
end;
end;
end;
end; {if checked}
result := cr;
end;
procedure DrawTasks;
var
I : Integer;
Task : TVpTask;
LineRect : TRect;
CheckRect : TRect;
DisplayStr : string;
begin
if (DataStore = nil) or
(DataStore.Resource = nil) or
(DataStore.Resource.Tasks.Count = 0) then begin
if Focused then begin
LineRect.TopLeft := Point (RealLeft + 2,
HeadRect.Bottom);
LineRect.BottomRight := Point (LineRect.Left + RealWidth - 4,
LineRect.Top + RowHeight);
RenderCanvas.Brush.Color := BackgroundSelHighlight;
RenderCanvas.FillRect(LineRect);
RenderCanvas.Brush.Color := RealColor;
end;
Exit;
end;
LineRect.TopLeft := Point (RealLeft + 2,
HeadRect.Bottom);
LineRect.BottomRight := Point (LineRect.Left + RealWidth - 4,
LineRect.Top + RowHeight);
tlVisibleItems := 0;
RenderCanvas.Brush.Color := RealColor;
tlAllTaskList.Clear;
{ Make sure the tasks are properly sorted }
DataStore.Resource.Tasks.Sort;
for I := 0 to pred(DataStore.Resource.Tasks.Count) do begin
if DisplayOptions.ShowAll then
{ Get all tasks regardless of their status and due date }
tlAllTaskList.Add(DataStore.Resource.Tasks.GetTask(I))
else begin
{ get all tasks which are incomplete, or were just completed today.}
Task := DataStore.Resource.Tasks.GetTask(I);
if not Task.Complete then
tlAllTaskList.Add(Task)
else if FDisplayOptions.ShowCompletedTasks
and (trunc(Task.CompletedOn) = trunc(now)) then
tlAllTaskList.Add(Task);
end;
end;
RenderCanvas.Font.Assign(Font);
for I := StartLine to pred(tlAllTaskList.Count) do begin
Task := tlAllTaskList[I];
if (LineRect.Top + Trunc(RowHeight * 0.5) <= RealBottom) then begin
{ if this is the selected task and we are not in edit mode, }
{ then set background selection }
if (Task = FActiveTask) and ((tlInPlaceEditor = nil) or not tlInplaceEditor.Visible)
and (not DisplayOnly) and Focused then begin
RenderCanvas.Brush.Color := BackgroundSelHighlight;
RenderCanvas.FillRect(LineRect);
RenderCanvas.Brush.Color := RealColor;
end;
{ draw the checkbox }
CheckRect := DrawCheck (LineRect, Task.Complete);
if Task.Complete then begin
{ complete task }
RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsStrikeout];
RenderCanvas.Font.Color := RealCompleteColor;
end else begin
{ incomplete task }
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsStrikeout];
if (Trunc (Task.DueDate) < Trunc (Now)) and
(Trunc (Task.DueDate) <> 0) then
{ overdue task }
RenderCanvas.Font.Color := RealOverdueColor
else
RenderCanvas.Font.Color := RealNormalColor;
end;
{ if this is the selected task, set highlight text color }
if (Task = FActiveTask) and ((tlInPlaceEditor = nil) or not tlInplaceEditor.Visible)
and (not DisplayOnly) and Focused then
RenderCanvas.Font.Color := ForegroundSelHighlight;
{ build display string }
DisplayStr := '';
if (FDisplayOptions.ShowDueDate) and
(Trunc (Task.DueDate) <> 0) then
DisplayStr := FormatDateTime(FDisplayOptions.DueDateFormat,
Task.DueDate) + ' - ';
DisplayStr := DisplayStr + Task.description;
{ Adjust display string - If the string is too long for the available }
{ space, Chop the end off and replace it with an ellipses. }
DisplayStr := GetDisplayString(RenderCanvas, DisplayStr, 3,
LineRect.Right - LineRect.Left - CheckRect.Right - TextMargin);
{ paint the text }
TPSTextOut(RenderCanvas, Angle, RenderIn, CheckRect.Right
+ TextMargin * 2, LineRect.Top + TextMargin, DisplayStr);
{ store the tasks drawing details }
tlVisibleTaskArray[tlVisibleItems].Task := Task;
tlVisibleTaskArray[tlVisibleItems].LineRect := Rect(CheckRect.Right
+ TextMargin, LineRect.Top, LineRect.Right, LineRect.Bottom);
tlVisibleTaskArray[tlVisibleItems].CheckRect := CheckRect;
LineRect.Top := LineRect.Bottom;
LineRect.Bottom := LineRect.Top + RowHeight;
Inc(tlVisibleItems);
end else if (LineRect.Bottom - TextMargin > RealBottom) then begin
FLastPrintLine := I;
Break;
end;
end;
if tlVisibleItems + tlItemsBefore = tlAllTaskList.Count then begin
FLastPrintLine := -2;
tlItemsAfter := 0;
end else begin
tlItemsAfter := tlAllTaskList.Count - tlItemsBefore - tlVisibleItems;
end;
{ these are for the syncing the scrollbar }
if StartLine < 0 then
tlItemsBefore := 0
else
tlItemsBefore := StartLine;
end;
{-}
procedure DrawHeader;
var
GlyphRect: TRect;
HeadStr: string;
begin
RenderCanvas.Brush.Color := TaskHeadAttrColor;
HeadRect.Left := RealLeft + 2;
HeadRect.Top := RealTop + 2;
HeadRect.Right := RealRight - 2;
RenderCanvas.Font.Assign (FTaskHeadAttr.Font);
HeadRect.Bottom := RealTop + RenderCanvas.TextHeight ('YyGg0') +
TextMargin * 2;
TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect);
{ draw the header cell borders }
if FDrawingStyle = dsFlat then begin
{ draw an outer and inner bevel }
{ wp: no bevel in flat style!
HeadRect.Left := HeadRect.Left - 1;
HeadRect.Top := HeadRect.Top - 1;
DrawBevelRect (RenderCanvas,
TPSRotateRectangle (Angle, RenderIn, HeadRect),
BevelShadow,
BevelShadow);
}
end else if FDrawingStyle = ds3d then begin
{ draw a 3d bevel }
HeadRect.Right := HeadRect.Right - 1;
DrawBevelRect (RenderCanvas,
TPSRotateRectangle (Angle, RenderIn, HeadRect),
BevelHighlight,
BevelDarkShadow);
end;
if ShowIcon then begin
{ Draw the glyph }
Bmp := Graphics.TBitmap.Create;
try
Bmp.LoadFromResourceName(HINSTANCE,'VPCHECKPAD'); //soner changed: Bmp.Handle := LoadBaseBitmap('VPCHECKPAD');
{ load and return the handle to bitmap resource}
if Bmp.Height > 0 then begin
GlyphRect.TopLeft := Point (HeadRect.Left + TextMargin,
HeadRect.Top + TextMargin);
GlyphRect.BottomRight := Point (GlyphRect.Left + Bmp.Width,
GlyphRect.Top + Bmp.Height);
//TODO: RenderCanvas.BrushCopy (TPSRotateRectangle (Angle, RenderIn, GlyphRect),
// Bmp, Rect(0, 0, Bmp.Width, Bmp.Height),
// Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
RenderCanvas.Draw(GlyphRect.TopLeft.x,GlyphRect.TopLeft.y,Bmp); //soner added
HeadRect.Left := HeadRect.Left + Bmp.Width + TextMargin;
end;
finally
Bmp.Free;
end;
end;
{ draw the text }
if ShowResourceName
and (DataStore <> nil)
and (DataStore.Resource <> nil) then
HeadStr := RSTaskTitleResource + DataStore.Resource.Description
else
HeadStr := RSTaskTitleNoResource;
RenderCanvas.Font.Assign(FTaskHeadAttr.Font);
TPSTextOut (RenderCanvas, Angle, RenderIn, HeadRect.
Left + TextMargin, HeadRect.Top + TextMargin,
HeadStr);
end;
{-}
procedure DrawBorders;
begin
if FDrawingStyle = dsFlat then begin
{ draw an outer and inner bevel }
DrawBevelRect (RenderCanvas,
Rect (RenderIn.Left,
RenderIn.Top,
RenderIn.Right - 1,
RenderIn.Bottom - 1),
BevelShadow,
BevelHighlight);
DrawBevelRect (RenderCanvas,
Rect (RenderIn.Left + 1,
RenderIn.Top + 1,
RenderIn.Right - 2,
RenderIn.Bottom - 2),
BevelHighlight,
BevelShadow);
end else if FDrawingStyle = ds3d then begin
{ draw a 3d bevel }
DrawBevelRect (RenderCanvas,
Rect (RenderIn.Left, RenderIn.Top,
RenderIn.Right - 1, RenderIn.Bottom - 1),
BevelShadow,
BevelHighlight);
DrawBevelRect (RenderCanvas,
Rect (RenderIn.Left + 1,
RenderIn.Top + 1,
RenderIn.Right - 2,
RenderIn.Bottom - 2),
BevelDarkShadow,
BevelFace);
end;
end;
{-}
begin
if DisplayOnly then begin
RealColor := clWhite;
BackgroundSelHighlight := clBlack;
ForegroundSelHighlight := clWhite;
BevelShadow := clBlack;
BevelHighlight := clBlack;
BevelDarkShadow := clBlack;
BevelFace := clBlack;
RealLineColor := clBlack;
RealCheckBgColor := clWhite;
RealCheckBoxColor := clBlack;
RealCheckColor := clBlack;
RealCompleteColor := clBlack;
RealOverdueColor := clBlack;
RealNormalColor := clBlack;
TaskHeadAttrColor := clSilver;
end else begin
RealColor := Color;
BackgroundSelHighlight := clHighlight;
ForegroundSelHighlight := clHighlightText;
BevelShadow := clBtnShadow;
BevelHighlight := clBtnHighlight;
BevelDarkShadow := cl3DDkShadow;
BevelFace := clBtnFace;
RealLineColor := LineColor;
RealCheckBgColor := FDisplayOptions.CheckBGColor;
RealCheckBoxColor := FDisplayOptions.CheckColor;
RealCheckColor := FDisplayOptions.CheckColor;
RealCompleteColor := FDisplayOptions.FCompletedColor;
RealOverdueColor := FDisplayOptions.FOverdueColor;
RealNormalColor := FDisplayOptions.FNormalColor;
TaskHeadAttrColor := FTaskHeadAttr.Color;
end;
tlPainting := true;
SavePenStyle := RenderCanvas.Pen.Style;
SaveBrushColor := RenderCanvas.Brush.Color;
SavePenColor := RenderCanvas.Pen.Color;
RenderCanvas.Pen.Style := psSolid;
RenderCanvas.Pen.Width := 1;
RenderCanvas.Pen.Mode := pmCopy;
RenderCanvas.Brush.Style := bsSolid;
Rgn := CreateRectRgn (RenderIn.Left, RenderIn.Top,
RenderIn.Right, RenderIn.Bottom);
try
SelectClipRgn (RenderCanvas.Handle, Rgn);
if StartLine < 0 then
StartLine := 0;
{ clear client area }
Clear;
SetMeasurements;
{ measure the row height }
MeasureRowHeight;
{ draw header }
DrawHeader;
{ draw lines }
DrawLines;
{ draw the tasks }
DrawTasks;
{ draw the borders }
DrawBorders;
tlSetVScrollPos;
finally
SelectClipRgn (RenderCanvas.Handle, 0);
DeleteObject (Rgn);
end;
{ reinstate canvas settings}
RenderCanvas.Pen.Style := SavePenStyle;
RenderCanvas.Brush.Color := SaveBrushColor;
RenderCanvas.Pen.Color := SavePenColor;
tlPainting := false;
end;
{=====} *)
procedure TVpTaskList.SetColor(const Value: TColor);
begin
@@ -1228,14 +694,13 @@ begin
if (tlInPlaceEditor <> nil) and tlInplaceEditor.Visible then
EndEdit(self);
if (Value < DataStore.Resource.Tasks.Count)
and (FTaskIndex <> Value) then begin
if (Value < DataStore.Resource.Tasks.Count) and (FTaskIndex <> Value) then
begin
FTaskIndex := Value;
if FTaskIndex > -1 then
FActiveTask := DataStore.Resource.Tasks.GetTask(Value)
else
FActiveTask := nil;
Invalidate;
end;
end;
@@ -1328,7 +793,6 @@ procedure TVpTaskList.WMRButtonDown (var Msg : TLMRButtonDown);
var
ClientOrigin: TPoint;
i: Integer;
begin
inherited;
@@ -1348,8 +812,7 @@ begin
for i := 0 to FDefaultPopup.Items.Count - 1 do
FDefaultPopup.Items[i].Enabled := True;
FDefaultPopup.Popup (Msg.XPos + ClientOrigin.x,
Msg.YPos + ClientOrigin.y);
FDefaultPopup.Popup(Msg.XPos + ClientOrigin.x, Msg.YPos + ClientOrigin.y);
end;
end;
{=====}
@@ -1376,7 +839,6 @@ end;
procedure TVpTaskList.InitializeDefaultPopup;
var
NewItem: TMenuItem;
begin
if RSTaskPopupAdd <> '' then begin
NewItem := TMenuItem.Create(Self);
@@ -1510,7 +972,6 @@ var
AllowIt: Boolean;
R: TRect;
VisTask: Integer;
begin
{don't allow a user to edit a completed task in place.}
if FActiveTask.Complete then
@@ -1574,7 +1035,6 @@ end;
procedure TVpTaskList.KeyDown(var Key: Word; Shift: TShiftState);
var
PopupPoint: TPoint;
begin
case Key of
VK_UP:
@@ -1588,8 +1048,7 @@ begin
else
TaskIndex := 0;
VK_NEXT:
if TaskIndex < Pred (DataStore.Resource.Tasks.Count) -
tlVisibleItems then
if TaskIndex < Pred(DataStore.Resource.Tasks.Count) - tlVisibleItems then
TaskIndex := TaskIndex + tlVisibleItems
else
TaskIndex := Pred(DataStore.Resource.Tasks.Count);
@@ -1598,12 +1057,18 @@ begin
TaskIndex := TaskIndex - tlVisibleItems
else
TaskIndex := 0;
VK_HOME : TaskIndex := 0;
VK_END : TaskIndex := Pred(DataStore.Resource.Tasks.Count);
VK_DELETE : DeleteActiveTask(true);
VK_RETURN : tlSpawnTaskEditDialog (False);
VK_INSERT : tlSpawnTaskEditDialog (True);
VK_F2 : if Assigned (DataStore) then begin
VK_HOME:
TaskIndex := 0;
VK_END:
TaskIndex := Pred(DataStore.Resource.Tasks.Count);
VK_DELETE:
DeleteActiveTask(true);
VK_RETURN:
tlSpawnTaskEditDialog (False);
VK_INSERT:
tlSpawnTaskEditDialog (True);
VK_F2:
if Assigned(DataStore) then begin
if Assigned(DataStore.Resource) then
tlEditInPlace(Self);
end;
@@ -1622,14 +1087,12 @@ begin
VK_F10:
if (ssShift in Shift) and not (Assigned(PopupMenu)) then begin
PopupPoint := GetClientOrigin;
FDefaultPopup.Popup (PopupPoint.x + 10,
PopupPoint.y + 10);
FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
end;
VK_APPS:
if not Assigned(PopupMenu) then begin
PopupPoint := GetClientOrigin;
FDefaultPopup.Popup (PopupPoint.x + 10,
PopupPoint.y + 10);
FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
end;
end;
@@ -1667,7 +1130,8 @@ begin
tlItemsBefore := tlItemsBefore + tlVisibleItems
else
tlItemsBefore := tlAllTaskList.Count - tlVisibleItems;
SB_THUMBPOSITION, SB_THUMBTRACK : tlItemsBefore := Msg.Pos;
SB_THUMBPOSITION, SB_THUMBTRACK:
tlItemsBefore := Msg.Pos;
end;
Invalidate;
end;
@@ -1677,11 +1141,8 @@ procedure TVpTaskList.tlSetVScrollPos;
var
SI: TScrollInfo;
begin
if (not HandleAllocated)
or (DataStore = nil)
or (DataStore.Resource = nil)
or (csDesigning in ComponentState)
then Exit;
if (not HandleAllocated) or (DataStore = nil) or (DataStore.Resource = nil)
or (csDesigning in ComponentState) then Exit;
with SI do begin
cbSize := SizeOf(SI);
@@ -1764,7 +1225,6 @@ end;
function TVpTaskList.tlVisibleTaskToTaskIndex(const VisTaskIndex: Integer): Integer;
var
RealTask: TVpTask;
begin
Result := -1;
if (VisTaskIndex < 0) or (VisTaskIndex >= Length(tlVisibleTaskArray)) then
@@ -1776,7 +1236,6 @@ end;
function TVpTaskList.tlTaskIndexToVisibleTask(const ATaskIndex: Integer): Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to Length(tlVisibleTaskArray) - 1 do