jvtfglance.pas

East make Tray Icon in delphi

    GlanceControl.ScheduleManager.ProcessBatches;
end;

procedure TJvTFGlanceCell.Combine;
var
  LSubCell: TJvTFGlanceCell;
begin
  if IsSplit then
  begin
    LSubCell := SubCell;
    FSplitRef.FSplitRef := nil;
    FSplitRef := nil;
    CellCollection.ReconfigCells;
    if not FDestroying and (LSubCell <> Self) then
      LSubCell.Free;
  end;
end;

function TJvTFGlanceCell.GetDisplayName: string;
var
  Glance: TJvTFCustomGlance;
begin
  Glance := CellCollection.GlanceControl;
  if Assigned(Glance) then
    Result := FormatDateTime(Glance.DateFormat, CellDate)
  else
    Result := FormatDateTime('m/d/yyyy', CellDate);
end;

function TJvTFGlanceCell.GetParentCell: TJvTFGlanceCell;
begin
  if IsParent then
    Result := Self
  else
    Result := SplitRef;
end;

function TJvTFGlanceCell.GetSchedule(Index: Integer): TJvTFSched;
begin
  Result := TJvTFSched(FSchedules.Objects[Index]);
end;

function TJvTFGlanceCell.GetSubCell: TJvTFGlanceCell;
begin
  if IsSubCell then
    Result := Self
  else
    Result := SplitRef;
end;

function TJvTFGlanceCell.IndexOfSchedObj(ASched: TJvTFSched): Integer;
begin
  Result := FSchedules.IndexOfObject(ASched);
end;

function TJvTFGlanceCell.IndexOfSchedule(const SchedName: string; SchedDate: TDate): Integer;
begin
  Result := FSchedules.IndexOf(TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate));
end;

procedure TJvTFGlanceCell.InternalSetCellDate(Value: TDate);
begin
  if not EqualDates(Value, FCellDate) then
  begin
    FCellDate := Value;
    if not CellCollection.Configuring and
      not (csLoading in CellCollection.GlanceControl.ComponentState) then
    begin
      CellCollection.GlanceControl.UpdateCellTitleText(Self);
      CheckConnections;
    end;
  end;
end;

function TJvTFGlanceCell.IsParent: Boolean;
begin
  Result := not IsSubCell;
end;

function TJvTFGlanceCell.IsSchedUsed(ASched: TJvTFSched): Boolean;
begin
  Result := IndexOfSchedObj(ASched) <> -1;
end;

function TJvTFGlanceCell.IsSplit: Boolean;
begin
  //Result := Assigned(ParentCell.SubCell);
  Result := Assigned(FSplitRef);
end;

function TJvTFGlanceCell.IsSubCell: Boolean;
begin
  Result := FIsSubCell;
end;

function TJvTFGlanceCell.ScheduleCount: Integer;
begin
  Result := FSchedules.Count;
end;

procedure TJvTFGlanceCell.SetCanSelect(Value: Boolean);
begin
  FCanSelect := Value;
end;

procedure TJvTFGlanceCell.SetCellDate(Value: TDate);
begin
  if Assigned(CellCollection.GlanceControl) and
    (not CellCollection.GlanceControl.AllowCustomDates and
    not (csLoading in CellCollection.GlanceControl.ComponentState)) then
    raise EJvTFGlanceError.CreateRes(@RsECellDatesCannotBeChanged);

  InternalSetCellDate(Value);
end;

procedure TJvTFGlanceCell.SetCellPics(Value: TJvTFCellPics);
begin
  FCellPics.Assign(Value);
  Change;
end;

procedure TJvTFGlanceCell.SetColIndex(Value: Integer);
begin
  FColIndex := Value;
end;

procedure TJvTFGlanceCell.SetColor(Value: TColor);
begin
  if Value <> FColor then
  begin
    FColor := Value;
    Change;
  end;
end;

procedure TJvTFGlanceCell.SetRowIndex(Value: Integer);
begin
  FRowIndex := Value;
end;

//=== { TJvTFGlanceCells } ===================================================

constructor TJvTFGlanceCells.Create(AGlanceControl: TJvTFCustomGlance);
begin
  inherited Create(TJvTFGlanceCell);
  FGlanceControl := AGlanceControl;
end;

destructor TJvTFGlanceCells.Destroy;
begin
  FDestroying := True;
  inherited Destroy;
end;

function TJvTFGlanceCells.Add: TJvTFGlanceCell;
begin
  Result := nil;
  AddError;
end;

procedure TJvTFGlanceCells.AddError;
begin
  //if Assigned(GlanceControl) and not (csLoading in GlanceControl.ComponentState) then
    //raise EJvTFGlanceError.Create('Cells cannot be manually added');
end;

procedure TJvTFGlanceCells.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TJvTFGlanceCells then
  begin
    BeginUpdate;
    try
      FAllowDestroy := True;
      try
        Clear;
      finally
        FAllowDestroy := False;
      end;

      for I := 0 to TJvTFGlanceCells(Source).Count - 1 do
        InternalAdd.Assign(TJvTFGlanceCells(Source).Items[I]);
    finally
      EndUpdate;
    end;
  end
  else
    inherited Assign(Source);
end;

procedure TJvTFGlanceCells.CheckConnections;
var
  I: Integer;
begin
  if (not Assigned(GlanceControl) or not Assigned(GlanceControl.ScheduleManager)) or
    (csLoading in GlanceControl.ComponentState) then
    Exit;

  FCheckingAllConnections := True;
  try
    {
    for I := 0 to Count - 1 do
      Items[I].CheckConnections;
    }
    for I := 0 to Count - 1 do
      with Items[I] do
      begin
        CheckConnections;
        if IsSplit then
          SubCell.CheckConnections;
      end;
  finally
    FCheckingAllConnections := False;
    GlanceControl.ScheduleManager.ProcessBatches;
  end;
end;

procedure TJvTFGlanceCells.ConfigCells;
begin
  {
  if not Assigned(GlanceControl) or
     (csDesigning in GlanceControl.ComponentState) then
    Exit;
  }
  if Configuring then
    Exit;

  FConfiguring := True;
  try
    GlanceControl.ConfigCells;
  finally
    FConfiguring := False;
  end;

  // connect and release cells to/from schedule objects here.
  CheckConnections;

  if Assigned(GlanceControl.Viewer) then
    GlanceControl.Viewer.ParentReconfig;
end;

procedure TJvTFGlanceCells.DestroyError;
begin
  //raise EJvTFGlanceError.Create('Cells cannot be manually destroyed');
end;

procedure TJvTFGlanceCells.EnsureCellCount;
var
  I, DeltaCount: Integer;
begin
  {
  if not Assigned(GlanceControl) or
     (csDesigning in GlanceControl.ComponentState) then
    Exit;
  }
  if not Assigned(GlanceControl) then
    Exit;

  // Adjust the cell count
  DeltaCount := GlanceControl.RowCount * GlanceControl.ColCount - Count;

  for I := 1 to DeltaCount do
    InternalAdd;

  FAllowDestroy := True;
  try
    for I := -1 downto DeltaCount do
      Items[Count - 1].Free;
  finally
    FAllowDestroy := False;
  end;
end;

procedure TJvTFGlanceCells.EnsureCells;
var
  I, J, K: Integer;
  SaveConfiguring: Boolean;
begin
  SaveConfiguring := Configuring;
  FConfiguring := True;
  try
    EnsureCellCount;

    K := 0;
    for I := 0 to GlanceControl.RowCount - 1 do
      for J := 0 to GlanceControl.ColCount - 1 do
        with Items[K] do
        begin
          SetColIndex(J);
          SetRowIndex(I);
          CellPics.Clear;
          Combine;
          Inc(K);
        end;
  finally
    FConfiguring := SaveConfiguring;
  end;
end;

function TJvTFGlanceCells.GetCell(ColIndex, RowIndex: Integer): TJvTFGlanceCell;
var
  AbsIndex: Integer;
  S: string;
begin
  Result := nil;
  if not Assigned(GlanceControl) then
    Exit;

  AbsIndex := RowIndex * GlanceControl.ColCount + ColIndex;
  if (AbsIndex >= 0) and (AbsIndex < Count) then
  begin
    Result := Items[AbsIndex];
    if (Result.ColIndex <> ColIndex) or (Result.RowIndex <> RowIndex) then
    begin
      S := '(' + IntToStr(Result.ColIndex) + ':' + IntToStr(ColIndex) + ') ' +
        '(' + IntToStr(Result.RowIndex) + ':' + IntToStr(RowIndex) + ')';
      raise EJvTFGlanceError.CreateResFmt(@RsECellMapHasBeenCorrupteds, [S]);
    end;
  end;
end;

function TJvTFGlanceCells.GetItem(Index: Integer): TJvTFGlanceCell;
begin
  Result := TJvTFGlanceCell(inherited GetItem(Index));
end;

function TJvTFGlanceCells.GetOwner: TPersistent;
begin
  Result := GlanceControl;
end;

function TJvTFGlanceCells.InternalAdd: TJvTFGlanceCell;
begin
  FAllowAdd := True;
  try
    Result := TJvTFGlanceCell(inherited Add);
  finally
    FAllowAdd := False;
  end;
end;

function TJvTFGlanceCells.IsSchedUsed(ASched: TJvTFSched): Boolean;
var
  I: Integer;
  ACell: TJvTFGlanceCell;
begin
  Result := False;
  I := 0;
  while (I < Count) and not Result do
  begin
    ACell := Items[I];

    if ACell.IsSchedUsed(ASched) then
      Result := True
    else
    if ACell.IsSplit and ACell.SubCell.IsSchedUsed(ASched) then
      Result := True
    else
      Inc(I);
  end;
end;

procedure TJvTFGlanceCells.ReconfigCells;
var
  I: Integer;
begin
  if FConfiguring then
    Exit;

  FConfiguring := True;
  try
    for I := 0 to Count - 1 do
      with Items[I] do
      begin
        CellPics.Clear;
        if IsSplit then
          SubCell.CellPics.Clear;
      end;
    GlanceControl.ConfigCells;
  finally
    FConfiguring := False;
  end;

  // connect and release cells to/from schedule objects here.
  CheckConnections;

  if Assigned(GlanceControl.Viewer) then
    GlanceControl.Viewer.ParentReconfig;
  GlanceControl.Invalidate;
end;

procedure TJvTFGlanceCells.SetItem(Index: Integer; Value: TJvTFGlanceCell);
begin
  inherited SetItem(Index, Value);
end;

procedure TJvTFGlanceCells.Update(Item: TCollectionItem);
begin
end;

//=== { TJvTFCustomGlance } ==================================================

constructor TJvTFCustomGlance.Create(AOwner: TComponent);
begin
  FCreatingControl := True;

  AllowCustomDates := False;
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents,
    csDoubleClicks];
  TabStop := True;
  Height := 300;
  Width := 300;

  //Color := clRed;
  FBorderStyle := bsSingle;
  FStartOfWeek := dowSunday;
  FGapSize := 0;
  FRowCount := 6;
  FColCount := 7;

  FPaintBuffer := TBitmap.Create;

  FSchedNames := TStringList.Create;
  FSchedNames.OnChange := SchedNamesChange;

  FCells := TJvTFGlanceCells.Create(Self);
  StartDate := Date;

  FTitleAttr := TJvTFGlanceMainTitle.Create(Self);
  FTitleAttr.Visible := False; // not visible by default. (Tim)
  FTitleAttr.OnChange := GlanceTitleChange;

  FCellAttr := TJvTFGlanceCellAttr.Create(Self);
  FCellAttr.TitleAttr.DayTxtAttr.AlignH := taLeftJustify;
  FSelCellAttr := TJvTFGlanceCellAttr.Create(Self);
  FSelCellAttr.TitleAttr.Color := clNavy;
  FSelCellAttr.TitleAttr.DayTxtAttr.Font.Color := clWhite;

  //FSelOrder := soColMajor;
  FSelOrder := soRowMajor;
  FSel := TJvTFGlanceSelList.Create(Self);
  FSel.OnChange := SelChange;