procedure TYearPlanner.SetYearColor(Val: TColor);
begin
if fYearColor <> Val then
begin
fYearColor:= Val;
Invalidate;
end;
end;
procedure TYearPlanner.SetYearFont(Val: TFont);
begin
if fYearFont <> Val then
begin
fYearFont.Assign(Val);
Invalidate;
end;
end;
procedure TYearPlanner.SetYearNavigators(Val: Boolean);
begin
if fYearNavigators <> Val then
begin
fYearNavigators := Val;
Invalidate;
end;
end;
procedure TYearPlanner.ShowAbout(Val: TYearPlanAbout);
begin
if fAbout <> Val then
begin
if Val = abNone then fAbout := Val else
begin
fAbout := abNone;
MessageDlg(StrPas(CopyRightStr), mtInformation, [mbOk], 0);
end;
Invalidate;
end;
end;
procedure TYearPlanner.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TYearPlanner.Paint;
var
I,J: Byte;
T,tH,tW,X,Y: Integer;
fBorderRect, fCellRect, fSepRect, GridCellRect: TRect;
fTodayDay, fTodayMonth, fTodayYear: Word;
GridCol, OldColor: TColor;
CurrWidth, CurrHeight : Integer;
CellText: string;
CellTextLen: Integer;
TheCanvas: TCanvas;
DrawDC: HDC;
SizeRec: tSize;
{$IFDEF WIN32}
nXStart, nYStart, tXStart, tYStart: Integer;
BitmapRect, TempDRect, TempSRect: TRect;
ImageH, ImageIndex, ImageW: Integer;
ImageBmp: TPicture;
{$ELSE}
bmpNavigator: TBitmap;
{$ENDIF}
function CellSelected: Boolean;
var
crDate: TDateTime;
begin
Result := False;
if not fAllowSelections then Exit;
if SelectionStyle = ypNormal then
begin
crDate := EncodeDate(Year,J,StrToInt(Cells[I,J]));
if (crDate >= fStartDate) and (crDate <= fEndDate) then Result := True;
end
else
if (I >= StDay) and (I <= EnDay) and (J >= StMonth) and (J <= EnMonth)
then Result := True;
end;
function CellFont: TFont;
var
Dy,Mn: Byte;
begin
Result := fDayFont;
if Cells[I,J] = '' then Exit;
Dy := StrToInt(Cells[I,J]);
Mn := J;
if CellData[Mn,Dy].CustomFont then
begin
Result := CellData[Mn,Dy].CellFont;
Exit;
end;
if CellSelected then Result := fSelectionFont;
end;
function GridColor: TColor;
var
Dy,Mn: Byte;
begin
if I = 0 then
begin
if J = 0 then Result:= fYearColor else
Result := fMonthColor;
Exit;
end;
if (J > 0) and (J < 13) then
if (Cells[I,J] <> '') then
begin
Dy := StrToInt(Cells[I,J]);
Mn := J;
CellData[Mn,Dy].Selected := CellSelected;
if CellData[Mn,Dy].Selected then
begin
Result := fSelectionColor;
Exit;
end;
if CellData[Mn,Dy].CustomColor then
begin
Result := CellData[Mn,Dy].CellColor;
CellData[Mn,Dy].Selected := False;
Exit;
end;
end;
if J = 13 then Result := fNoDayColor else
begin
if (((I+Ord(fStartDayOfWeek) in [0,6,7,13,14,20,21,27,28,34,35,41,42]) or (J = 0))
and ((not fNoDayPriority) or (Cells[I,J] <> ''))) then
begin
Result := fWeekendColor;
if J = 0 then
if (I+Ord(fStartDayOfWeek) in [6,7,13,14,20,21,27,28,34,35,41,42]) then
Result := fWeekendHeadingColor else
Result := fHeadingColor;
end
else
begin
if Cells[I,J] = '' then Result := fNoDayColor
else Result := fDayColor;
end;
end;
end;
{$IFDEF WIN32}
function GridImage: Integer;
var
Dy,Mn: Byte;
begin
Result := -1;
if (Images <> nil) and (J > 0) and (J < 13) and (I > 0) then
if (Cells[I,J] <> '') then
begin
Dy := StrToInt(Cells[I,J]);
Mn := J;
Result := CellData[Mn,Dy].CellImage;
end;
end;
{$ENDIF}
procedure DrawGridLines;
var
L: Integer;
LineHeight: Integer;
begin
with TheCanvas do
begin
Pen.Assign(fGridPen);
DrawDC := TheCanvas.Handle;
X := Widths[0] - 1;
Y := Heights[0] - 1;
LineHeight := Heights[1] shl 2 + Heights[1] shl 3 + 1;
for L := 1 to 38 do
begin
{$IFDEF WIN32}
Windows.MoveToEx(DrawDC, X, Y, nil);
Windows.LineTo(DrawDC, X, Y + LineHeight);
{$ELSE}
WinProcs.MoveToEx(DrawDC, X, Y, nil);
WinProcs.LineTo(DrawDC, X, Y + LineHeight);
{$ENDIF}
if L < 38 then
Inc(X, Widths[L]);
end;
for L := 1 to 13 do
begin
{$IFDEF WIN32}
Windows.MoveToEx(DrawDC, Widths[0], Y, nil);
Windows.LineTo(DrawDC, X, Y);
{$ELSE}
WinProcs.MoveToEx(DrawDC, Widths[0], Y, nil);
WinProcs.LineTo(DrawDC, X, Y);
{$ENDIF}
if L < 13 then Inc(Y, Heights[L]);
end;
end;
end;
begin
CalculateSizes;
if (fUseBitmap) and not (csDesigning in ComponentState) then
begin
fControl.Width := Width;
fControl.Height := Height;
TheCanvas := fControl.Canvas;
end
else
TheCanvas := Canvas;
DecodeDate(Date, fTodayYear, fTodayMonth, fTodayDay);
with TheCanvas do
begin
Brush.Style := bsSolid;
Font := Self.Font;
DrawDC := TheCanvas.Handle;
SetBKMode(DrawDC, TRANSPARENT);
X := 0;
for I := 0 to 37 do
begin
J := 0;
Y := 0;
CurrWidth := Widths[i];
OldColor := GridColor;
repeat
T := Y;
repeat
Inc(Y,Heights[J]);
Inc(J);
GridCol := GridColor;
until (GridCol <> OldColor) or (J = 13);
GridCellRect := Rect(X, T, X + CurrWidth, Y);
Brush.Color := OldColor;
OldColor := GridCol;
{$IFDEF WIN32}
Windows.FillRect(DrawDC, GridCellRect, Brush.Handle);
{$ELSE}
WinProcs.FillRect(DrawDC, GridCellRect, Brush.Handle);
{$ENDIF}
until
J = 13;
Y := 0;
for J := 0 to 12 do
begin
CurrHeight := Heights[J];
GridCellRect := Rect(X,Y + 1,X + CurrWidth - 1,Y + CurrHeight - 1);
if (I = 0) or (J = 0) then
{$IFDEF WIN32}
fSepRect:= GridCellRect;
InFlateRect(fSepRect,-10,0);
if fSeperator then DrawEdge(DrawDC, fSepRect, EDGE_RAISED, BF_BOTTOM);
if (fMonthButtons) and (I = 0) and (J > 0) then
DrawEdge(DrawDC, GridCellRect, EDGE_RAISED, BF_RECT OR BF_SOFT)
else
if not fFlatCells then
DrawEdge(DrawDC, GridCellRect, BDR_RAISEDINNER, BF_RECT);
{$ELSE}
if not fFlatCells then
Frame3D(TheCanvas,GridCellRect,clBtnHighlight,clBtnShadow,1);
{$ENDIF}
{$IFDEF WIN32}
ImageIndex := GridImage;
If ImageIndex > -1 then
begin
ImageBmp := TPicture.Create;
if fStretchImages then
begin
BitmapRect := Rect(X, Y, X + CurrWidth, Y + CurrHeight);
Images.GetBitmap(ImageIndex, ImageBmp.Bitmap);
TheCanvas.StretchDraw(BitmapRect, ImageBmp.Bitmap);
end
else
begin
Images.GetBitmap(ImageIndex, ImageBmp.Bitmap);
ImageW := ImageBmp.Bitmap.Width;
ImageH := ImageBmp.Bitmap.Height;
if ImageBmp.Width > CurrWidth then
begin
tXStart := (ImageW - CurrWidth) div 2;
TempSRect := Rect(tXStart, 0, tXStart + CurrWidth, ImageH);
TempDRect := Rect(0, 0, CurrWidth, ImageH);
with ImageBmp.Bitmap do Canvas.CopyRect(TempDRect,Canvas,TempSRect);
ImageBmp.Bitmap.Width := CurrWidth;
ImageW := ImageBmp.Bitmap.Width;
end;
if ImageBmp.Height > CurrHeight then
begin
tYStart := (ImageH - CurrHeight) div 2;
TempSRect := Rect(0, tYStart, CurrWidth, tYStart + CurrHeight);
TempDRect := Rect(0, 0, ImageW, CurrHeight);
with ImageBmp.Bitmap do Canvas.CopyRect(TempDRect,Canvas,TempSRect);
ImageBmp.Bitmap.Height := CurrHeight;
ImageH := ImageBmp.Bitmap.Height;
end;
nXStart := (X + (CurrWidth div 2)) - (ImageW div 2);
nYStart := (Y + (CurrHeight div 2)) - (ImageH div 2);
TheCanvas.Draw(nXStart, nYStart, ImageBmp.Bitmap);
end;
ImageBmp.Free;
end
else
begin
{$ENDIF}
CellText := Cells[I,J];
CellTextLen := Length(CellText);
if CellTextLen <> 0 then
begin
if I = 0 then
begin
Font := fMonthFont;
DrawDC := TheCanvas.Handle;
SetBKMode(DrawDC, TRANSPARENT);
end;
if J = 0 then
begin
Font := fDayFont;
DrawDC := TheCanvas.Handle;
SetBKMode(DrawDC, TRANSPARENT);
end;
if (J = 0) and (I = 0) then
begin
Font := fYearFont;
DrawDC := TheCanvas.Handle;
SetBKMode(DrawDC, TRANSPARENT);
if fYearNavigators then
begin
CalculateNavigators;
{$IFDEF WIN32}
if fMonthButtons then
begin
DrawFrameControl(DrawDC, fYearNavLeft, DFC_SCROLL, DFCS_SCROLLLEFT);
DrawFrameControl(DrawDC, fYearNavRight, DFC_SCROLL, DFCS_SCROLLRIGHT);
end
else
begin
DrawFrameControl(DrawDC, fYearNavLeft, DFC_SCROLL, DFCS_SCROLLLEFT or DFCS_FLAT);
DrawFrameControl(DrawDC, fYearNavRight, DFC_SCROLL, DFCS_SCROLLRIGHT or DFCS_FLAT);
end;
{$ELSE}
bmpNavigator := TBitmap.Create;
try
bmpNavigator.Handle := LoadBitmap(0,pchar(obm_LfArrow));
BitBlt(DrawDC,fYearNavLeft.Left,fYearNavLeft.Top,fYearNavLeft.Right - fYearNavLeft.Left,
fYearNavLeft.Bottom - fYearNavLeft.Top, bmpNavigator.Canvas.Handle,0,0,SrcCopy);
bmpNavigator.ReleaseHandle;
bmpNavigator.Handle := LoadBitmap(0,pchar(obm_RGArrow));
BitBlt(DrawDC,fYearNavRight.Left,fYearNavRight.Top,fYearNavRight.Right - fYearNavRight.Left,
fYearNavRight.Bottom - fYearNavRight.Top, bmpNavigator.Canvas.Handle,0,0,SrcCopy)
finally
bmpNavigator.Free;
end;
{$ENDIF}
end;
end;
if (J > 0) and (I > 0) then
begin
Font := CellFont;
DrawDC := TheCanvas.Handle;
SetBKMode(DrawDC, TRANSPARENT);
end;
{$IFNDEF WIN32}
GetTextExtentPoint(DrawDC, @CellText[1], CellTextLen, SizeRec);
{$ELSE}
GetTextExtentPoint32(DrawDC, PChar(CellText), CellTextLen, SizeRec);
{$ENDIF}
tW := (CurrWidth - SizeRec.cx) shr 1;
tH := (CurrHeight - SizeRec.cy) shr 1;
{$IFDEF WIN32}
if fEndEllipsis then
begin
fCellRect := Rect(X + tW,Y + tH, (X + tW) + CurrWidth,(Y + tH) + CurrHeight);
DrawText(DrawDC,PChar(@CellText[1]),-1,fCellRect,DT_VCENTER OR DT_CENTER OR DT_END_ELLIPSIS);
end
else
Windows.TextOut(DrawDC, X + tW, Y + tH, PChar(CellText), CellTextLen);
{$ELSE}
WinProcs.TextOut(DrawDC, X + tW, Y + tH, @CellText[1], CellTextLen);
{$ENDIF}
if (fShowToday) and (Cells[I, J] = IntToStr(fTodayDay)) and
(J = fTodayMonth) and (fYear = fTodayYear) then
begin
if fTodayCircleFilled then
CircleToday(TheCanvas, GridCellRect, IntToStr(fTodayDay), fTodayCircleColour)
else
CircleToday(TheCanvas, GridCellRect, IntToStr(fTodayDay), GridColor);
end;
end;
{$IFDEF WIN32}
end;
{$ENDIF}
Inc(Y,CurrHeight);
end;
Inc(X,CurrWidth);
end;
if fGridlines then DrawGridLines;
{$IFDEF WIN32}
if fSoftBorder then
begin
SetBKMode(DrawDC, OPAQUE);
fBorderRect:= Rect(0,0,Width,Height);
DrawEdge(DrawDC,fBorderRect,EDGE_ETCHED,BF_RECT);
end;
{$ENDIF}
end;
if fUseBitmap then
BitBlt(Canvas.Handle, 0, 0, Width, Height, DrawDC, 0, 0, SRCCOPY);
if hPrinting then
StretchBlt(Printer.Canvas.Handle, PrinterLeftMargin, PrinterTopMargin,
PrinterPageWidth, PrinterPageHeight, Canvas.Handle, 0, 0,
Width, Height, SRCCOPY);
end;