jvtfglancetextviewer.pas

East make Tray Icon in delphi

  Viewer.MoveTo(ACell);

  if Viewer.EditorAlign = eaLine then
  begin
    EditorRect := LineRect(EditLine);
    FEditor.WordWrap := False;
    FEditor.BorderStyle := bsSingle;
  end
  else
  begin
    EditorRect := ClientRect;
    FEditor.WordWrap := True;
    FEditor.BorderStyle := bsNone;
  end;

  with FEditor do
  begin
    LinkedAppt := Appt;
    Color := Viewer.SelApptAttr.Color;
    Font := Viewer.GlanceControl.SelCellAttr.Font;
    Font.Color := Viewer.SelApptAttr.FontColor;
    BoundsRect := EditorRect;

    Text := Appt.Description;
    {
    if agoFormattedDesc in Options then
      Text := Appt.Description
    else
      Text := StripCRLF(Appt.Description);
    }

    //Self.Update;  // not calling update here increases flicker
    Visible := True;
    SetFocus;
    SelLength := 0;
    SelStart := 0;
  end;
end;


function TJvTFGVTextControl.Editing: Boolean;
begin
  Result := FEditor.Visible;
end;

procedure TJvTFGVTextControl.FinishEditAppt;
begin
  if Assigned(FEditor.LinkedAppt) then
    FEditor.LinkedAppt.Description := FEditor.Text;
  FEditor.Visible := False;
end;

function TJvTFGVTextControl.FindApptAtLine(RelLineNum: Integer): TJvTFAppt;
begin
  if Assigned(Viewer) and
     (RelLineNum >= 0) and (RelLineNum < Viewer.ApptCount) then
    Result := Viewer.Appts[RelLineNum]
  else
    Result := nil;
end;

function TJvTFGVTextControl.GetApptRelLineNum(Appt: TJvTFAppt): Integer;
var
  I: Integer;
begin
  Result := -1;
  if not Assigned(Appt) then
    Exit;

  I := 0;
  while (I < Viewer.ApptCount) and (Result = -1) do
    if Viewer.Appts[I] = Appt then
      Result := I
    else
      Inc(I);
end;

function TJvTFGVTextControl.AbsLineCount: Integer;
begin
  //Result := Lesser(ViewableLines - 1, LineCount - TopLine - 1);
  Result := RectHeight(ClientRect) div CalcLineHeight;
  if RectHeight(ClientRect) mod CalcLineHeight > 0 then
    Inc(Result);
end;

procedure TJvTFGVTextControl.MouseAccel(X, Y: Integer);
var
  Appt: TJvTFAppt;
begin
  Appt := GetApptAccel(X, Y);
  if Assigned(Appt) then
    Viewer.SetSelAppt(Appt);
end;

function TJvTFGVTextControl.GetStartEndString(Appt: TJvTFAppt): string;
var
  ShowDates: Boolean;
  DateFormat,
  TimeFormat: string;
begin
  ShowDates := (Trunc(Appt.StartDate) <> Trunc(Viewer.Date)) or
               (Trunc(Appt.EndDate) <> Trunc(Viewer.Date));
  DateFormat := Viewer.GlanceControl.DateFormat;
  TimeFormat := Viewer.GlanceControl.TimeFormat;

  Result := '';
  if ShowDates then
    Result := FormatDateTime(DateFormat, Appt.StartDate) + ' ';

  Result := Result + FormatDateTime(TimeFormat, Appt.StartTime) + ' - ';

  if ShowDates then
    Result := Result + FormatDateTime(DateFormat, Appt.EndDate) + ' ';

  Result := Result + FormatDateTime(TimeFormat, Appt.EndTime);
end;

function TJvTFGVTextControl.GetApptAccel(X, Y: Integer): TJvTFAppt;
var
  LocalPt: TPoint;
begin
  LocalPt := ScreenToClient(Viewer.GlanceControl.ClientToScreen(Point(X, Y)));
  Result := GetApptAt(LocalPt.X, LocalPt.Y);
end;

function TJvTFGVTextControl.GetApptAt(X, Y: Integer): TJvTFAppt;
var
  PtInfo: TJvTFGlTxtVwPointInfo;
begin
  PtInfo := CalcPointInfo(X, Y);
  Result := FindApptAtLine(PtInfo.RelLineNum);
end;

procedure TJvTFGVTextControl.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  inherited DragOver(Source, X, Y, State, Accept);
  if Source is TJvTFControl then
    Viewer.Visible := False;
end;

//=== { TJvTFGlanceTextViewer } ==============================================

constructor TJvTFGlanceTextViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FTopLines := TStringList.Create;
  FViewControl := TJvTFGVTextControl.Create(Self);
  FSelApptAttr := TJvTFTxtVwApptAttr.Create(Self);
  FSelApptAttr.OnChange := SelApptAttrChange;
  FEditorAlign := eaLine;
  FShowStartEnd := True;
end;

destructor TJvTFGlanceTextViewer.Destroy;
begin
  FViewControl.Free;
  FTopLines.Free;
  FSelApptAttr.OnChange := nil;
  FSelApptAttr.Free;
  inherited Destroy;
end;

procedure TJvTFGlanceTextViewer.Change;
begin
  Refresh;
end;

procedure TJvTFGlanceTextViewer.SetEditorAlign(Value: TJvTFGlTxtVwEditorAlign);
begin
  FEditorAlign := Value;
end;

function TJvTFGlanceTextViewer.GetDrawInfo(ACell: TJvTFGlanceCell): TJvTFGlTxtVwDrawInfo;
var
  Attr: TJvTFGlanceCellAttr;
begin
  if not Assigned(GlanceControl) then
    raise EGlanceViewerError.CreateRes(@RsEGlanceControlNotAssigned);

  with Result do
  begin
    Cell := ACell;
    Attr := GlanceControl.GetCellAttr(ACell);
    Font := Attr.Font;
    Color := Attr.Color;
    aRect := GlanceControl.CalcCellBodyRect(ACell,
      GlanceControl.CellIsSelected(ACell), False);
  end;
end;

function TJvTFGlanceTextViewer.GetTopLine(ACell: TJvTFGlanceCell): Integer;
var
  I: Integer;
begin
  I := FTopLines.IndexOf(GetCellString(ACell));
  if I > -1 then
    Result := Integer(FTopLines.Objects[I])
  else
    Result := 0;
end;

procedure TJvTFGlanceTextViewer.LineDDClick(LineNum: Integer);
begin
  if Assigned(FOnLineDDClick) then
    FOnLineDDClick(Self, LineNum);
end;

procedure TJvTFGlanceTextViewer.MouseAccel(X, Y: Integer);
begin
  inherited MouseAccel(X, Y);
  FViewControl.MouseAccel(X, Y);
end;

procedure TJvTFGlanceTextViewer.Notify(Sender: TObject;
  Code: TJvTFServNotifyCode);
begin
  inherited Notify(Sender, Code);
end;

procedure TJvTFGlanceTextViewer.PaintTo(ACanvas: TCanvas; ACell: TJvTFGlanceCell);
begin
  FViewControl.PaintTo(ACanvas, GetDrawInfo(ACell));
end;

procedure TJvTFGlanceTextViewer.ParentReconfig;
begin
  inherited ParentReconfig;
  FTopLines.Clear;
end;

procedure TJvTFGlanceTextViewer.Realign;
begin
  if not Assigned(GlanceControl) then
    Exit;

  FViewControl.BoundsRect := CalcBoundsRect(Cell);
  if not FViewControl.Replicating then
    SetSelAppt(nil);
end;

procedure TJvTFGlanceTextViewer.Refresh;
begin
  FViewControl.Invalidate;
end;

procedure TJvTFGlanceTextViewer.ResetTopLines;
begin
  FTopLines.Clear;
  GlanceControl.Invalidate;
end;

procedure TJvTFGlanceTextViewer.SelApptAttrChange(Sender: TObject);
begin
  //Change;
  FViewControl.Invalidate;
end;

procedure TJvTFGlanceTextViewer.SetGlanceControl(Value: TJvTFCustomGlance);
begin
  inherited SetGlanceControl(Value);
  FViewControl.Parent := Value;
end;

procedure TJvTFGlanceTextViewer.SetLineSpacing(Value: Integer);
begin
  //Value := Greater(Value, 0);
  if Value <> FLineSpacing then
  begin
    FLineSpacing := Value;
    Change;
  end;
end;

procedure TJvTFGlanceTextViewer.SetSelAppt(Value: TJvTFAppt);
begin
  FSelAppt := Value;
  FViewControl.Invalidate;
end;

procedure TJvTFGlanceTextViewer.SetSelApptAttr(Value: TJvTFTxtVwApptAttr);
begin
  FSelApptAttr.Assign(Value);
end;

procedure TJvTFGlanceTextViewer.SetTopLine(ACell: TJvTFGlanceCell; Value: Integer);
var
  I: Integer;
  CellStr: string;
begin
  Value := Greater(Value, 0);
  Value := Lesser(Value, ApptCount - 1);

  // bug fix - this effectively hides the hint window.  The showing/hiding
  // of the hint window was causing the viewer to be positioned at the
  // wrong cell due to repainting as the hint window would hide/show.
  GlanceControl.CheckViewerApptHint(-1, -1);

  CellStr := GetCellString(ACell);
  I := FTopLines.IndexOf(CellStr);
  if I > -1 then
    if Value = 0 then
      FTopLines.Delete(I)
    else
      FTopLines.Objects[I] := TObject(Value)
  else
  if Value <> 0 then
    FTopLines.AddObject(CellStr, TObject(Value));
  Refresh;
end;

procedure TJvTFGlanceTextViewer.SetVisible(Value: Boolean);
begin
  // MORE STUFF NEEDS TO BE ADDED HERE!
  FViewControl.Visible := Value;
end;

procedure TJvTFGlanceTextViewer.SetShowStartEnd(Value: Boolean);
begin
  if Value <> FShowStartEnd then
  begin
    FShowStartEnd := Value;
    if not (csLoading in ComponentState) then
    begin
      GlanceControl.Invalidate;
      FViewControl.Invalidate;
    end;
  end;
end;

function TJvTFGlanceTextViewer.GetApptAt(X, Y: Integer): TJvTFAppt;
begin
  Result := FViewControl.GetApptAt(X, Y);
end;

function TJvTFGlanceTextViewer.CanEdit: Boolean;
begin
  Result := FViewControl.CanEdit;
end;

procedure TJvTFGlanceTextViewer.EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer;
  Appt: TJvTFAppt);
begin
  FViewControl.EditAppt(ACell, RelLine, Appt);
end;

function TJvTFGlanceTextViewer.Editing: Boolean;
begin
  Result := FViewControl.Editing;
end;

procedure TJvTFGlanceTextViewer.FinishEditAppt;
begin
  FViewControl.FinishEditAppt;
end;

function TJvTFGlanceTextViewer.GetCellString(ACell: TJvTFGlanceCell): string;
begin
  Result := '';
  if Assigned(ACell) then
  begin
    Result := IntToStr(ACell.ColIndex) + ',' + IntToStr(ACell.RowIndex);
    if ACell.IsSubcell then
      Result := Result + 'S';
  end;
end;

//=== { TJvTFGVTxtEditor } ===================================================

constructor TJvTFGVTxtEditor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  ControlStyle := ControlStyle + [csNoDesignVisible];

  ParentCtl3D := False;
  Ctl3D := False;
end;

destructor TJvTFGVTxtEditor.Destroy;
begin
  inherited Destroy;
end;

procedure TJvTFGVTxtEditor.DoExit;
begin
  inherited DoExit;
  try
    if not FCancelEdit then
      TJvTFGVTextControl(Owner).FinishEditAppt;
  finally
    FCancelEdit := False;
    Parent.SetFocus;
  end;
end;

procedure TJvTFGVTxtEditor.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);

  if Key = VK_ESCAPE then
  begin
    FCancelEdit := True;
    Key := 0;
    Visible := False;
  end
  else
  if (Key = VK_RETURN) and (ssCtrl in Shift) then
    TJvTFGVTextControl(Owner).FinishEditAppt;
end;

//=== { TJvTFTxtVwApptAttr } =================================================

constructor TJvTFTxtVwApptAttr.Create(AOwner: TComponent);
begin
  inherited Create;
  FColor := clBlue;
  FFontColor := clWhite;
end;

procedure TJvTFTxtVwApptAttr.Assign(Source: TPersistent);
begin
  if Source is TJvTFTxtVwApptAttr then
  begin
    FColor := TJvTFTxtVwApptAttr(Source).Color;
    FFontColor := TJvTFTxtVwApptAttr(Source).FontColor;
    Change;
  end
  else
    inherited Assign(Source);
end;

procedure TJvTFTxtVwApptAttr.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

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

procedure TJvTFTxtVwApptAttr.SetFontColor(Value: TColor);
begin
  if Value <> FFontColor then
  begin
    FFontColor := Value;
    Change;
  end;
end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.