jvtfglance.pas

East make Tray Icon in delphi

    if ssShift in Shift then
    begin
      // contiguous selection
      if Info.Cell.CanSelect then
      begin
        FMouseCell := Info.Cell;
        UpdateSelection;
      end;
    end
    else
    if ssCtrl in Shift then
    begin
      // non-contiguous selection
      if CellIsSelected(Info.Cell) then
        DeselectCell(Info.Cell)
      else
        SelectCell(Info.Cell, False);
    end
    else
    begin
      if Assigned(Info.Cell) and Info.Cell.CanSelect then
        SelectCell(Info.Cell, True);
      SelAppt := Info.Appt;
      if Assigned(Info.Appt) then
        BeginDrag(False);
    end;
  end;
end;

procedure TJvTFCustomGlance.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  //S: string;
  Info: TJvTFGlanceCoord;
  Hints: TStrings;
begin
  inherited MouseMove(Shift, X, Y);

  Info := PtToCell(X, Y);

  if not Focused and not (csDesigning in ComponentState) then
    Exit;

  if Assigned(Info.CellTitlePic) then
    Hints := Info.CellTitlePic.Hints
  else
    Hints := nil;

  FHint.MultiLineObjHint(Info.CellTitlePic, X, Y, Hints);
  {
  if Assigned(Info.CellTitlePic) then
    FHint.MultiLineObjHint(Info.CellTitlePic, X, Y, Info.CellTitlePic.Hints)
  else
    FHint.ReleaseHandle;
  }

  if (Info.Col > -1) and (Info.Row > -1) and not Info.InCellTitle then
    CheckApptHint(Info);

  // EXIT if we've already processed a mouse move for the current cell
  if Info.Cell = FMouseCell then
    Exit;

  FMouseCell := Info.Cell;

  // TESTING ONLY!!!
  //S := IntToStr(Info.Col) + ', ' + IntToStr(Info.Row);
  //GetParentForm(Self).Caption := S;

  if ssLeft in Shift then
  begin
    UpdateSelection;
  end;
end;

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

  if (Sel.Count = 1) and Assigned(Viewer) then
  begin
    Info := PtToCell(X, Y);
    Viewer.MoveTo(Info.Cell);
    Viewer.Visible := True;
    if not Info.InCellTitle then
      Viewer.MouseAccel(X, Y);
  end;
end;

procedure TJvTFCustomGlance.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = Viewer then
      Viewer := nil
    else
    if AComponent = CellPics then
      CellPics := nil;
end;

procedure TJvTFCustomGlance.Paint;
begin
  with FPaintBuffer do
  begin
    Height := ClientHeight;
    Width := ClientWidth;

    with Canvas do
    begin
      Brush.Color := Color;
      FillRect(ClientRect);
    end;

    DrawTitle(Canvas);
    DrawCells(Canvas);
  end;

  if Enabled then
    Windows.BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
      FPaintBuffer.Canvas.Handle, 0, 0, SRCCOPY)
  else
    Windows.DrawState(Canvas.Handle, 0, nil, FPaintBuffer.Handle, 0,
      0, 0, 0, 0, DST_BITMAP or DSS_UNION or DSS_DISABLED);
end;

function TJvTFCustomGlance.PtToCell(X, Y: Integer): TJvTFGlanceCoord;
var
  I, AdjX, AdjY, ViewerX, ViewerY: Integer;
  PicRect, ViewerBounds, ParentRect, SubRect: TRect;
  VCell: TJvTFGlanceCell;
  InSubRect: Boolean;
begin
  with Result do
  begin
    AbsX := X;
    AbsY := Y;

    AdjY := Y - GetDataTop;
    if AdjY < 0 then
      Row := -1
    else
      Row := GetDivNum(GetDataHeight, RowCount, AdjY);

    AdjX := X - GetDataLeft;
    if AdjX < 0 then
      Col := -1
    else
      Col := GetDivNum(GetDataWidth, ColCount, AdjX);

    if (Col >= 0) and (Row >= 0) then
    begin
      Cell := Cells.Cells[Col, Row];
      SplitRects(Col, Row, ParentRect, SubRect);
      InSubRect := Windows.PtInRect(SubRect, Point(X, Y));
      if InSubRect then
        Cell := Cell.SubCell;
    end
    else
    begin
      InSubRect := False;
      Cell := nil;
    end;

    if Col < 0 then
      CellX := X
    else
    if InSubRect and (Cell.SplitOrientation = soVertical) then
      CellX := X - SubRect.Left
    else
      CellX := X - ParentRect.Left;

    if Row < 0 then
      CellY := Y
    else
    if InSubRect and (Cell.SplitOrientation = soHorizontal) then
      CellY := Y - SubRect.Top
    else
      CellY := Y - ParentRect.Top;

    DragAccept := (Col > -1) and (Row > -1) and Assigned(ScheduleManager);

    CellTitlePic := nil;
    InCellTitle := Windows.PtInRect(CellTitleRect(Cell), Point(X, Y));
    if InCellTitle and Assigned(Cell) and Assigned(CellPics) then
    begin
      I := 0;
      while (I < Cell.CellPics.Count) and not Assigned(CellTitlePic) do
      begin
        PicRect.TopLeft := Cell.CellPics[I].PicPoint;
        PicRect.Right := PicRect.Left + CellPics.Width;
        PicRect.Bottom := PicRect.Top + CellPics.Height;
        if Windows.PtInRect(PicRect, Point(X, Y)) then
          CellTitlePic := Cell.CellPics[I]
        else
          Inc(I);
      end;
    end;

    Appt := nil;
    if Assigned(Viewer) and not InCellTitle and
      (Col > -1) and (Row > -1) then
    begin
      VCell := Viewer.Cell;

      Viewer.SetTo(Cell);
      ViewerBounds := Viewer.CalcBoundsRect(Cell);

      ViewerX := AbsX - ViewerBounds.Left;
      ViewerY := AbsY - ViewerBounds.Top;

      Appt := Viewer.GetApptAt(ViewerX, ViewerY);

      Viewer.SetTo(VCell);
    end;
  end;
end;

// Parameter Clear defaults to True for D4+ versions

procedure TJvTFCustomGlance.SelectCell(ACell: TJvTFGlanceCell; Clear: Boolean);
begin
  EnsureCell(ACell);

  BeginSelUpdate;
  try
    if Clear then
    begin
      Sel.Clear;
      FSelAnchor := ACell;
    end;
    InternalSelectCell(ACell);
  finally
    EndSelUpdate;
  end;
end;

procedure TJvTFCustomGlance.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TJvTFCustomGlance.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Assigned(Viewer) then
    Viewer.Realign;
end;

procedure TJvTFCustomGlance.SetCellAttr(Value: TJvTFGlanceCellAttr);
begin
  FCellAttr.Assign(Value);
end;

procedure TJvTFCustomGlance.SetCellPics(Value: TCustomImageList);
begin
  if Value <> FCellPics then
  begin
    if Assigned(FCellPics) then
      FCellPics.UnregisterChanges(FImageChangeLink);

    FCellPics := Value;

    if Assigned(FCellPics) then
    begin
      FCellPics.RegisterChanges(FImageChangeLink);
      FCellPics.FreeNotification(Self);
    end;

    Invalidate;
  end;
end;

procedure TJvTFCustomGlance.SetCells(Value: TJvTFGlanceCells);
begin
  FCells.Assign(Value);
end;

procedure TJvTFCustomGlance.SetColCount(Value: Integer);
begin
  Value := Greater(Value, 1);

  if Value <> FColCount then
  begin
    FColCount := Value;
    Cells.EnsureCells;
    Cells.ConfigCells;
    if Assigned(Viewer) then
      Viewer.Realign;
    Invalidate;
  end;
end;

procedure TJvTFCustomGlance.SetOriginDate(Value: TDate);
begin
  if not EqualDates(Value, FOriginDate) then
  begin
    FOriginDate := Value;
    StartOfWeek := BorlToDOW(DayOfWeek(Value));
    if not FCreatingControl and not (csLoading in ComponentState) then
      Cells.ConfigCells;
    Invalidate;
  end;
end;

procedure TJvTFCustomGlance.SetRowCount(Value: Integer);
begin
  Value := Greater(Value, 1);

  if Value <> FRowCount then
  begin
    FRowCount := Value;
    Cells.EnsureCells;
    Cells.ConfigCells;
    if Assigned(Viewer) then
      Viewer.Realign;
    Invalidate;
  end;
end;

procedure TJvTFCustomGlance.SetTFSelCellAttr(Value: TJvTFGlanceCellAttr);
begin
  FSelCellAttr.Assign(Value);
end;

procedure TJvTFCustomGlance.SetStartDate(Value: TDate);
begin
  if not EqualDates(Value, FStartDate) then
  begin
    FStartDate := Value;
    while BorlToDOW(DayOfWeek(Value)) <> StartOfWeek do
      Value := Value - 1;
    OriginDate := Value;
  end;
end;

procedure TJvTFCustomGlance.SetStartOfWeek(Value: TTFDayOfWeek);
var
  WorkDate: TDate;
begin
  if Value <> FStartOfWeek then
  begin
    FStartOfWeek := Value;

    WorkDate := StartDate;
    while BorlToDOW(DayOfWeek(WorkDate)) <> FStartOfWeek do
      WorkDate := WorkDate - 1;
    OriginDate := WorkDate;

    Invalidate;
  end;
end;

procedure TJvTFCustomGlance.SetTitleAttr(Value: TJvTFGlanceMainTitle);
begin
  FTitleAttr.Assign(Value);
  Invalidate;
end;

procedure TJvTFCustomGlance.SetViewer(Value: TJvTFGlanceViewer);
begin
  if Value <> FViewer then
  begin
    if Assigned(FViewer) then
      FViewer.Notify(Self, sncDisconnectControl);
    if Assigned(Value) then
      Value.Notify(Self, sncConnectControl);
    FViewer := Value;
    if Assigned(FViewer) then
    begin
      FViewer.MoveTo(Cells.Cells[0, 0]);
      FViewer.Visible := (csDesigning in ComponentState);
    end;
  end;
end;

function TJvTFCustomGlance.TitleRect: TRect;
begin
  Result := Rect(0, 0, ClientWidth, 0);
  if TitleAttr.Visible then
    Result.Bottom := TitleAttr.Height;
end;

procedure TJvTFCustomGlance.UpdateSelection;
var
  Col, Row, StartCol, EndCol, StartRow, EndRow: Integer;
  ACell, ACell1, ACell2: TJvTFGlanceCell;
begin
  BeginSelUpdate;

  try
    if not Assigned(FMouseCell) or not Assigned(FSelAnchor) then
      Exit;

    Sel.Clear;
    if SelOrder = soColMajor then
    begin
        // handle the first sel col
      if FMouseCell.ColIndex < FSelAnchor.ColIndex then // sel end is left of anchor
      begin
        for Row := 0 to FSelAnchor.RowIndex do
        begin
          ACell := Cells.Cells[FSelAnchor.ColIndex, Row];
          InternalSelectCell(ACell);
          InternalSelectCell(ACell.SubCell);
        end;
        if not FSelAnchor.IsSubCell then
          InternalDeselectCell(FSelAnchor.SubCell);
      end
      else
      if FMouseCell.ColIndex = FSelAnchor.ColIndex then // sel end is in same col as anchor
      begin
        StartRow := Lesser(FSelAnchor.RowIndex, FMouseCell.RowIndex);
        EndRow := Greater(FSelAnchor.RowIndex, FMouseCell.RowIndex);
        for Row := StartRow to EndRow do
        begin
          ACell := Cells.Cells[FSelAnchor.ColIndex, Row];
          InternalSelectCell(ACell);
          InternalSelectCell(ACell.SubCell);
        end;

        if (FMouseCell.RowIndex < FSelAnchor.RowIndex) then
        begin
          if FMouseCell.IsSubCell then
            InternalDeselectCell(FMouseCell.ParentCell);
          if FSelAnchor.IsParent then
            InternalDeselectCell(FSelAnchor.SubCell);
        end
        else
        if FMouseCell = FSelAnchor then
          InternalDeselectCell(FMouseCell.SplitRef)
        else
        if FMouseCell.RowIndex > FSelAnchor.RowIndex then
        begin
          if FMouseCell.IsParent then
            InternalDeselectCell(FMouseCell.SubCell);
          if FSelAnchor.IsSubCell then