You've already forked lazarus-ccr
tvplanit: Extract TVpCalendar painting code to separate unit TVpCalendarPainter.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4821 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -32,7 +32,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S
|
||||
|
||||
Contributor(s): "/>
|
||||
<Version Major="1" Release="4"/>
|
||||
<Files Count="70">
|
||||
<Files Count="71">
|
||||
<Item1>
|
||||
<Filename Value="../source/vpalarmdlg.lfm"/>
|
||||
<Type Value="LFM"/>
|
||||
@ -314,6 +314,10 @@ Contributor(s): "/>
|
||||
<Filename Value="../source/vptasklistpainter.pas"/>
|
||||
<UnitName Value="VpTasklistPainter"/>
|
||||
</Item70>
|
||||
<Item71>
|
||||
<Filename Value="../source/vpcalendarpainter.pas"/>
|
||||
<UnitName Value="VpCalendarPainter"/>
|
||||
</Item71>
|
||||
</Files>
|
||||
<i18n>
|
||||
<EnableI18N Value="True"/>
|
||||
|
||||
@ -344,7 +344,7 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
VpData;
|
||||
VpData, VpCalendarPainter;
|
||||
|
||||
const
|
||||
calMargin = 4; {left, right, and top margin}
|
||||
@ -1436,6 +1436,18 @@ procedure TVpCustomCalendar.RenderToCanvas(RenderCanvas: TCanvas;
|
||||
RenderIn: TRect; Angle: TVpRotationAngle; Scale: Extended;
|
||||
RenderDate: TDateTime; StartLine: Integer; StopLine: Integer;
|
||||
UseGran: TVpGranularity; DisplayOnly: Boolean);
|
||||
var
|
||||
painter: TVpCalendarPainter;
|
||||
begin
|
||||
painter := TVpCalendarPainter.Create(Self, RenderCanvas);
|
||||
try
|
||||
painter.RenderToCanvas(RenderIn, Angle, Scale, RenderDate,
|
||||
StartLine, StopLine, UseGran, DisplayOnly);
|
||||
finally
|
||||
painter.Free;
|
||||
end;
|
||||
end;
|
||||
(*
|
||||
var
|
||||
R, C: Integer;
|
||||
I: Integer;
|
||||
@ -1800,6 +1812,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
{=====}
|
||||
*)
|
||||
|
||||
procedure TVpCustomCalendar.SetBorderStyle(Value: TBorderStyle);
|
||||
begin
|
||||
|
||||
421
components/tvplanit/source/vpcalendarpainter.pas
Normal file
421
components/tvplanit/source/vpcalendarpainter.pas
Normal file
@ -0,0 +1,421 @@
|
||||
unit VpCalendarPainter;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Graphics,
|
||||
VpBase, VpMisc, VpBasePainter, VpCalendar;
|
||||
|
||||
type
|
||||
TVpCalendarPainter = class(TVpBasePainter)
|
||||
private
|
||||
FCalendar: TVpCustomCalendar;
|
||||
// local variables of the old RenderToCanvas method of TVpCalendar
|
||||
// R, C: Integer;
|
||||
// I: Integer;
|
||||
SatCol: Integer;
|
||||
SunCol: Integer;
|
||||
DOW: TVpDayType;
|
||||
Y, M, D: Word;
|
||||
lBadDate: Boolean;
|
||||
lDate: TDateTime;
|
||||
BevelHighlight: TColor;
|
||||
BevelShadow: TColor;
|
||||
InactiveDayColor: TColor;
|
||||
MonthYearColor: TColor;
|
||||
DayNameColor: TColor;
|
||||
LineColor: TColor;
|
||||
EventDayColor: TColor;
|
||||
DayColor: TColor;
|
||||
RealColor: TColor;
|
||||
WeekendColor: TColor;
|
||||
|
||||
protected
|
||||
procedure DrawAllDays;
|
||||
procedure DrawDate;
|
||||
procedure DrawDay(R, C, I: Integer; Grayed: Boolean);
|
||||
procedure DrawDayNames;
|
||||
procedure DrawFocusBox;
|
||||
procedure DrawLine;
|
||||
procedure InitColors;
|
||||
procedure SetMeasurements;
|
||||
|
||||
public
|
||||
constructor Create(ACalendar: TVpCustomCalendar; ARenderCanvas: TCanvas);
|
||||
procedure RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle;
|
||||
AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer;
|
||||
AUseGran: TVpGranularity; ADisplayOnly: Boolean); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLProc,
|
||||
VpCanvasUtils;
|
||||
|
||||
type
|
||||
TVpCalendarOpener = class(TVpCustomCalendar);
|
||||
|
||||
constructor TVpCalendarPainter.Create(ACalendar: TVpCustomCalendar;
|
||||
ARenderCanvas: TCanvas);
|
||||
begin
|
||||
inherited Create(ARenderCanvas);
|
||||
FCalendar := ACalendar;
|
||||
end;
|
||||
|
||||
procedure TVpCalendarPainter.DrawAllDays;
|
||||
var
|
||||
I, R, C: Integer;
|
||||
begin
|
||||
I := 1;
|
||||
for R := 2 to 8 do
|
||||
for C := 0 to 6 do begin
|
||||
if ((C = SatCol) and (cdoHighlightSat in FCalendar.Options)) or
|
||||
((C = SunCol) and (cdoHighlightSun in Fcalendar.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 (FCalendar.DataStore <> nil) and (FCalendar.DataStore.Resource <> nil) then
|
||||
begin
|
||||
DecodeDate(RenderDate, Y, M, D);
|
||||
try begin
|
||||
{$IFDEF VERSION6}
|
||||
if not TryEncodeDate(Y, M, TVpCalendarOpener(FCalendar).clCalendar[I], lDate) then
|
||||
lBadDate := True;
|
||||
{$ELSE}
|
||||
if TVpCalendarOpener(FCalendar).clCalendar[I] > DaysInMonth(Y, M) then
|
||||
lDate := EncodeDate(Y, M, DaysInMonth(Y, M))
|
||||
else
|
||||
lDate := EncodeDate(Y, M, TVpCalendarOpener(FCalendar).clCalendar[I]);
|
||||
{$ENDIF}
|
||||
end;
|
||||
except
|
||||
lBadDate := true;
|
||||
end;
|
||||
|
||||
if (not lBadDate) and (FCalendar.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;
|
||||
with TVpCalendarOpener(FCalendar) do
|
||||
DrawDay(R, C, I, (I < clFirst) or (I > clLast));
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpCalendarPainter.DrawDate;
|
||||
var
|
||||
R: TRect;
|
||||
S: string;
|
||||
begin
|
||||
if FCalendar.DateFormat = dfLong then
|
||||
if cdoShowYear in FCalendar.Options then
|
||||
S := FormatDateTime('mmmm yyyy', RenderDate)
|
||||
else
|
||||
S := FormatDateTime('mmmm', RenderDate)
|
||||
else
|
||||
if cdoShowYear in FCalendar.Options then
|
||||
S := FormatDateTime('mmm yyyy', RenderDate)
|
||||
else
|
||||
S := FormatDateTime('mmm', RenderDate);
|
||||
|
||||
with TVpCalendarOpener(FCalendar) do begin
|
||||
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;
|
||||
end;
|
||||
|
||||
{switch to short date format if string won't fit}
|
||||
if FCalendar.DateFormat = dfLong then
|
||||
if RenderCanvas.TextWidth(S) > R.Right-R.Left then
|
||||
begin
|
||||
S := FormatDateTime('mmm yyyy', RenderDate);
|
||||
end;
|
||||
|
||||
{$IF FPC_FULLVERSION < 30000}
|
||||
S := SysToUTF8(S);
|
||||
{$ENDIF}
|
||||
|
||||
RenderCanvas.Font.Color := MonthYearColor;
|
||||
if Assigned(FCalendar.OnDrawDate) then
|
||||
FCalendar.OnDrawDate(Self, RenderDate, R)
|
||||
else
|
||||
TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, R, S);
|
||||
end;
|
||||
|
||||
procedure TVpCalendarPainter.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 FCalendar.Options then
|
||||
if (R = 8) and (C >= 3) then
|
||||
Exit;
|
||||
if cdoShowToday in FCalendar.Options then
|
||||
if (R = 8) and (C >= 5) then
|
||||
Exit;
|
||||
|
||||
{convert to a string and draw it centered in its rectangle}
|
||||
S := IntToStr(TVpCalendarOpener(FCalendar).clCalendar[I]);
|
||||
|
||||
if Grayed then
|
||||
RenderCanvas.Font.Color := InactiveDayColor;
|
||||
|
||||
if not Grayed or (cdoShowInactive in FCalendar.Options) then begin
|
||||
NewIdx := ((R-2) * 7) + Succ(C);
|
||||
with TVpCalendarOpener(FCalendar) do
|
||||
OldIdx := clFirst + Pred(clDay);
|
||||
if Assigned(FCalendar.OnGetHighlight) then begin
|
||||
Cl := RenderCanvas.Font.Color;
|
||||
FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , Cl);
|
||||
RenderCanvas.Font.Color := Cl;
|
||||
end;
|
||||
with TVpCalendarOpener(FCalendar) do
|
||||
if Assigned(OnDrawItem) then
|
||||
OnDrawItem(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 TVpCalendarPainter.DrawDayNames;
|
||||
var
|
||||
I: Integer;
|
||||
S: string;
|
||||
DrawRect: TRect;
|
||||
begin
|
||||
{draw the day name column labels}
|
||||
RenderCanvas.Font.Color := DayNameColor;
|
||||
I := 0;
|
||||
DOW := FCalendar.WeekStarts;
|
||||
repeat
|
||||
{record columns for weekends}
|
||||
if DOW = dtSaturday then
|
||||
SatCol := I;
|
||||
if DOW = dtSunday then
|
||||
SunCol := I;
|
||||
|
||||
{get the day name}
|
||||
if cdoShortNames in FCalendar.Options then begin
|
||||
if FCalendar.DayNameWidth < 1 then
|
||||
S := ShortDayNames[Ord(DOW)+1]
|
||||
else
|
||||
S := Copy(ShortDayNames[Ord(DOW)+1], 1, FCalendar.DayNameWidth)
|
||||
end else begin
|
||||
if FCalendar.DayNameWidth < 1 then
|
||||
S := LongDayNames[Ord(DOW)+1]
|
||||
else
|
||||
S := Copy(LongDayNames[Ord(DOW)+1], 1, FCalendar.DayNameWidth)
|
||||
end;
|
||||
{$IF FPC_FULLVERSION < 30000}
|
||||
S := SysToUTF8(S);
|
||||
{$ENDIF}
|
||||
|
||||
{draw the day name above each column}
|
||||
DrawRect := TVpCalendarOpener(FCalendar).clRowCol[1, I];
|
||||
OffsetRect(DrawRect, RealLeft, Realtop);
|
||||
{
|
||||
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 = FCalendar.WeekStarts;
|
||||
end;
|
||||
|
||||
procedure TVpCalendarPainter.InitColors;
|
||||
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 := FCalendar.Colors.InactiveDays;
|
||||
MonthYearColor := FCalendar.Colors.MonthAndYear;
|
||||
DayNameColor := FCalendar.Colors.DayNames;
|
||||
LineColor := FCalendar.Font.Color;
|
||||
EventDayColor := FCalendar.Colors.EventDays;
|
||||
DayColor := FCalendar.Colors.Days;
|
||||
RealColor := FCalendar.Color;
|
||||
WeekendColor := FCalendar.Colors.WeekEnd;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpCalendarPainter.DrawFocusBox;
|
||||
var
|
||||
R: TRect;
|
||||
S: string[10];
|
||||
begin
|
||||
S := IntToStr(TVpCalendarOpener(FCalendar).clDay);
|
||||
|
||||
{ set highlight color and font style for days with events }
|
||||
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold];
|
||||
lBadDate := false;
|
||||
|
||||
if (FCalendar.DataStore <> nil) and (FCalendar.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, TVpCalendarOpener(FCalendar).clDay);
|
||||
{$ENDIF}
|
||||
except
|
||||
lBadDate := true;
|
||||
end;
|
||||
|
||||
if (not lBadDate) and (FCalendar.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 := TVpCalendarOpener(FCalendar).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 := TVpCalendarOpener(FCalendar).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;
|
||||
|
||||
procedure TVpCalendarPainter.DrawLine;
|
||||
begin
|
||||
// if (not Ctl3D) then begin
|
||||
with TVpCalendarOpener(FCalendar) do 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;
|
||||
{ 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 TVpCalendarPainter.RenderToCanvas(ARenderIn: TRect;
|
||||
AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime;
|
||||
AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean);
|
||||
var
|
||||
Row: TRowArray;
|
||||
Col: TColArray;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
InitColors;
|
||||
SavePenBrush;
|
||||
InitPenBrush;
|
||||
TVpCalendarOpener(FCalendar).calRebuildCalArray(RenderDate);
|
||||
|
||||
RenderCanvas.Lock;
|
||||
try
|
||||
SetMeasurements;
|
||||
|
||||
RenderCanvas.Font.Assign(FCalendar.Font);
|
||||
|
||||
with TVpCalendarOpener(FCalendar) do
|
||||
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}
|
||||
DrawAllDays;
|
||||
|
||||
RenderCanvas.Font.Color := DayColor;
|
||||
if not Assigned(FCalendar.OnDrawItem) then
|
||||
if not (cdoHideActive in FCalendar.Options) then
|
||||
DrawFocusBox;
|
||||
finally
|
||||
RenderCanvas.Unlock;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpCalendarPainter.SetMeasurements;
|
||||
begin
|
||||
inherited;
|
||||
if RenderDate = 0 then
|
||||
RenderDate := FCalendar.Date;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -3,7 +3,6 @@ unit VpContactGridPainter;
|
||||
interface
|
||||
|
||||
uses
|
||||
//SysUtils,
|
||||
LCLType, LCLIntf,
|
||||
Types, Classes, Graphics,
|
||||
VpConst, VPBase, VpData, VpBasePainter, VpContactGrid;
|
||||
|
||||
Reference in New Issue
Block a user