jvtfglance.pas

East make Tray Icon in delphi

  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;

  FHintProps := TJvTFHintProps.Create(Self);
  //FHint := TJvTFHint.Create(Self);
  FHint := GetTFHintClass.Create(Self);
  FHint.RefProps := FHintProps;

  FCreatingControl := False;

  Cells.EnsureCells;
  Cells.ConfigCells;
end;

destructor TJvTFCustomGlance.Destroy;
begin
  FCells.Free;
  FTitleAttr.Free;
  FCellAttr.Free;
  FSelCellAttr.Free;
  FSel.OnChange := nil;
  FSel.Free;
  FPaintBuffer.Free;
  FImageChangeLink.Free;

  FHint.Free;
  FHintProps.Free;

  FSchedNames.OnChange := nil;
  FSchedNames.Free;

  Viewer := nil;

  inherited Destroy;
end;

function TJvTFCustomGlance.CalcCellBodyRect(ACell: TJvTFGlanceCell;
  Selected, Full: Boolean): TRect;
var
  Attr: TJvTFGlanceCellAttr;
  Offset: Integer;
begin
  Windows.SubtractRect(Result, CellRect(ACell),
    CalcCellTitleRect(ACell, Selected, True));
  if not Full then
  begin
    if Selected then
      Attr := SelCellAttr
    else
      Attr := CellAttr;

    case Attr.FrameAttr.Style of
      fs3DRaised, fs3DLowered:
        Offset := 1;
      fsFlat:
        Offset := Attr.FrameAttr.Width;
    else
      Offset := 0;
    end;

      // Col 0 has frame running down left side of cell, whereas others
      // do not.
    if ACell.ColIndex = 0 then
      Inc(Result.Left, Offset);

    Dec(Result.Bottom, Offset);
    Dec(Result.Right, Offset);
  end;
end;

function TJvTFCustomGlance.CellIsSelected(ACell: TJvTFGlanceCell): Boolean;
begin
  Result := False;
  if Assigned(ACell) then
    Result := DateIsSelected(ACell.CellDate);
end;

function TJvTFCustomGlance.CellRect(ACell: TJvTFGlanceCell): TRect;
var
  ParentRect, SubRect: TRect;
begin
  Result := EmptyRect;
  if Assigned(ACell) then
  begin
    SplitRects(ACell.ColIndex, ACell.RowIndex, ParentRect, SubRect);
    if ACell.IsParent then
      Result := ParentRect
    else
      Result := SubRect;
  end;
end;

function TJvTFCustomGlance.CalcCellTitleRect(ACell: TJvTFGlanceCell;
  Selected, Full: Boolean): TRect;
var
  Attr: TJvTFGlanceCellAttr;
begin
  if Selected then
    Attr := SelCellAttr
  else
    Attr := CellAttr;

  if not Attr.TitleAttr.Visible then
  begin
    Result := Rect(0, 0, 0, 0);
    Exit;
  end
  else
    Result := CellRect(ACell);

  case Attr.TitleAttr.Align of
    alTop:
      Result.Bottom := Result.Top + Attr.TitleAttr.Height;
    alBottom:
      Result.Top := Result.Bottom - Attr.TitleAttr.Height;
    alLeft:
      Result.Right := Result.Left + Attr.TitleAttr.Height;
    alRight:
      Result.Left := Result.Right - Attr.TitleAttr.Height;
  end;

  if not Full then
  begin
    case Attr.TitleAttr.FrameAttr.Style of
      fs3DLowered, fs3DRaised:
        Windows.InflateRect(Result, -1, -1);
      fsFlat:
        case Attr.TitleAttr.Align of
          alTop:
            Dec(Result.Bottom, Attr.TitleAttr.FrameAttr.Width);
          alBottom:
            Inc(Result.Top, Attr.TitleAttr.FrameAttr.Width);
          alLeft:
            Dec(Result.Right, Attr.TitleAttr.FrameAttr.Width);
          alRight:
            Inc(Result.Left, Attr.TitleAttr.FrameAttr.Width);
        end;
    end;
  end;
end;

{$IFDEF VCL}

procedure TJvTFCustomGlance.CMCtl3DChanged(var Msg: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then
    RecreateWnd;
  inherited;
end;

procedure TJvTFCustomGlance.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array [TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle] or WS_CLIPCHILDREN;
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

{$ENDIF VCL}

function TJvTFCustomGlance.DateIsSelected(ADate: TDate): Boolean;
begin
  Result := Sel.IndexOf(ADate) <> -1;
end;

procedure TJvTFCustomGlance.DblClick;
begin
  inherited DblClick;
end;

procedure TJvTFCustomGlance.DoConfigCells;
begin
  if Assigned(FOnConfigCells) then
    FOnConfigCells(Self);
end;

procedure TJvTFCustomGlance.Draw3DFrame(ACanvas: TCanvas; ARect: TRect;
  TLColor, BRColor: TColor);
var
  OldPenColor: TColor;
begin
  with ACanvas do
  begin
    OldPenColor := Pen.Color;
    Pen.Color := TLColor;
    MoveTo(ARect.Left, ARect.Top);
    LineTo(ARect.Right, ARect.Top);
    MoveTo(ARect.Left, ARect.Top);
    LineTo(ARect.Left, ARect.Bottom);

    Pen.Color := BRColor;
    MoveTo(ARect.Right - 1, ARect.Top);
    LineTo(ARect.Right - 1, ARect.Bottom);
    MoveTo(ARect.Left, ARect.Bottom - 1);
    LineTo(ARect.Right, ARect.Bottom - 1);
    Pen.Color := OldPenColor;
  end;
end;

procedure TJvTFCustomGlance.DrawCell(ACanvas: TCanvas; ACell: TJvTFGlanceCell);
var
  ARect, TitleRect, BodyRect: TRect;
  Attr: TJvTFGlanceCellAttr;
begin
  with ACanvas do
  begin
    ARect := CellRect(ACell);
    Attr := GetCellAttr(ACell);
    TitleRect := CellTitleRect(ACell);

      // calc the body rect
    Windows.SubtractRect(BodyRect, ARect, TitleRect);

      // draw the cell title
    if Attr.TitleAttr.Visible then
      DrawCellTitle(ACanvas, TitleRect, Attr, ACell);

      // shade the body of the cell
    Brush.Color := Attr.Color;
    FillRect(BodyRect);

    DrawCellFrame(ACanvas, ARect, Attr, ACell);

      // draw the cell data
    if Assigned(Viewer) and not (csDesigning in ComponentState) then
      Viewer.PaintTo(ACanvas, ACell);

    DoDrawCell(ACanvas, ARect, TitleRect, BodyRect, Attr, ACell);
  end;
end;

procedure TJvTFCustomGlance.DrawCells(ACanvas: TCanvas);
var
  Col, Row: Integer;
  ACell: TJvTFGlanceCell;
begin
  for Col := 0 to ColCount - 1 do
    for Row := 0 to RowCount - 1 do
    begin
      ACell := Cells.Cells[Col, Row];
      DrawCell(ACanvas, ACell);
      if Assigned(ACell.SubCell) then
        DrawCell(ACanvas, ACell.SubCell);
    end;
end;

procedure TJvTFCustomGlance.DrawTitle(ACanvas: TCanvas);
var
  ARect, TxtRect: TRect;
  Flags: UINT;
  PTxt: PChar;
  Txt: string;
  OldPen: TPen;
  OldBrush: TBrush;
  OldFont: TFont;
  I, LineBottom: Integer;
begin
  if not TitleAttr.Visible then
    Exit;

  ARect := TitleRect;
  TxtRect := ARect;
  Windows.InflateRect(TxtRect, -2, -2);

  with ACanvas do
  begin
    OldPen := TPen.Create;
    OldPen.Assign(Pen);
    OldBrush := TBrush.Create;
    OldBrush.Assign(Brush);
    OldFont := TFont.Create;
    OldFont.Assign(Font);

    Brush.Color := TitleAttr.Color;
    FillRect(ARect);

      //Pen.Color := clBlack;
      //MoveTo(ARect.Left, ARect.Bottom - 1);
      //LineTo(ARect.Right, ARect.Bottom - 1);

    case TitleAttr.FrameAttr.Style of
      fs3DRaised:
        Draw3DFrame(ACanvas, ARect, clBtnHighlight, clBtnShadow);
      fs3DLowered:
        Draw3DFrame(ACanvas, ARect, clBtnShadow, clBtnHighlight);
        {
        fs3DRaised, fs3DLowered :
          begin
            if TitleAttr.FrameAttr.Style = fs3DRaised then
              Pen.Color := clBtnHighlight
            else
              Pen.Color := clBtnShadow;

            MoveTo(ARect.Left, ARect.Top);
            LineTo(ARect.Right, ARect.Top);
            MoveTo(ARect.Left, ARect.Top);
            LineTo(ARect.Left, ARect.Bottom);

            if TitleAttr.FrameAttr.Style = fs3DRaised then
              Pen.Color := clBtnShadow
            else
              Pen.Color := clBtnHighlight;

            MoveTo(ARect.Right - 1, ARect.Top);
            LineTo(ARect.Right - 1, ARect.Bottom);
            MoveTo(ARect.Left, ARect.Bottom - 1);
            LineTo(ARect.Right, ARect.Bottom - 1);
          end;
        }
      fsFlat:
        begin
          Pen.Color := TitleAttr.FrameAttr.Color;
            {
            Pen.Width := TitleAttr.FrameAttr.Width;
            LineBottom := ARect.Bottom - Pen.Width div 2;
            if Odd(Pen.Width) then
              Dec(LineBottom);
            MoveTo(ARect.Left, LineBottom);
            LineTo(ARect.Right, LineBottom);
            }
          Pen.Width := 1;
          LineBottom := ARect.Bottom - 1;
          for I := 1 to TitleAttr.FrameAttr.Width do
          begin
            MoveTo(ARect.Left, LineBottom);
            LineTo(ARect.Right, LineBottom);
            Dec(LineBottom);
          end;
        end;
    end;

      //Font.Assign(TitleAttr.Font);
    Font.Assign(TitleAttr.TxtAttr.Font);
    Flags := DT_NOPREFIX or DT_CENTER or DT_SINGLELINE or DT_VCENTER;

      // Allocate length of Txt + 4 chars
      // (1 char for null terminator, 3 chars for ellipsis)
    Txt := TitleAttr.Title;
    PTxt := StrAlloc((Length(Txt) + 4) * SizeOf(Char));
    StrPCopy(PTxt, Txt);

    Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
    StrDispose(PTxt);

    Pen.Assign(OldPen);
    Brush.Assign(OldBrush);
    Font.Assign(OldFont);
    OldPen.Free;
    OldBrush.Free;
    OldFont.Free;
  end;

  DoDrawTitle(ACanvas, ARect);
end;

procedure TJvTFCustomGlance.EnsureCell(ACell: TJvTFGlanceCell);
begin
  if not Assigned(ACell) then
    raise EJvTFGlanceError.CreateRes(@RsECellObjectNotAssigned);
end;

procedure TJvTFCustomGlance.EnsureCol(Col: Integer);
begin
  if (Col < 0) or (Col >= ColCount) then
    raise EJvTFGlanceError.CreateResFmt(@RsEInvalidColIndexd, [Col]);
end;

procedure TJvTFCustomGlance.EnsureRow(Row: Integer);
begin
  if (Row < 0) or (Row >= RowCount) then
    raise EJvTFGlanceError.CreateResFmt(@RsEInvalidRowIndexd, [Row]);
end;

function TJvTFCustomGlance.GetCellAttr(ACell: TJvTFGlanceCell): TJvTFGlanceCellAttr;
begin
  if CellIsSelected(ACell) then
    Result := SelCellAttr
  else
    Result := CellAttr;
end;

function TJvTFCustomGlance.GetDataHeight: Integer;
begin
  Result := ClientHeight - GetDataTop;
end;

function TJvTFCustomGlance.GetDataLeft: Integer;
begin
  Result := 0;
end;

function TJvTFCustomGlance.GetDataTop: Integer;
begin
  Result := 0;
  if TitleAttr.Visible then
    Inc(Result, TitleAttr.Height);
end;

function TJvTFCustomGlance.GetDataWidth: Integer;
begin
  Result := ClientWidth - GetDataLeft;
end;

procedure TJvTFCustomGlance.ImageListChange(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvTFCustomGlance.InternalSelectCell(ACell: TJvTFGlanceCell);
begin
  if Assigned(ACell) and ACell.CanSelect then
    Sel.Add(ACell.CellDate);
end;

procedure TJvTFCustomGlance.Loaded;
begin
  inherited Loaded;
  Cells.EnsureCells;
  Cells.ConfigCells;
end;

procedure TJvTFCustomGlance.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Info: TJvTFGlanceCoord;
begin
  inherited MouseDown(Button, Shift, X, Y);

  if Enabled then
    SetFocus;

  Info := PtToCell(X, Y);
  if Assigned(Viewer) and (Viewer.Cell <> Info.Cell) then
    Viewer.Visible := False;

  if ssLeft in Shift then
  begin