jvtfglancetextviewer.pas

East make Tray Icon in delphi

      StrDispose(PTxt);

      Inc(NextLineTop, CalcLineHeight);
    end;
  end;

  if not (csDesigning in ComponentState) then
  begin
    if not Replicating and (FMousePtInfo.RelLineNum < Viewer.ApptCount) and
       FMouseInControl then
      DrawDDButton(ACanvas);

    BtnRect := ScrollUpBtnRect(DrawInfo.aRect);
    if not Windows.IsRectEmpty(BtnRect) then
      DrawScrollUpBtn(ACanvas, DrawInfo.aRect);

    BtnRect := ScrollDnBtnRect(DrawInfo.aRect);
    if not Windows.IsRectEmpty(BtnRect) then
      DrawScrollDnBtn(ACanvas, DrawInfo.aRect);

    {
    if TopLine > 0 then
      DrawScrollUpBtn(ACanvas, DrawInfo.aRect);

    BottomLine := TopLine + FullViewableLines - 1;
    LastLine := LineCount - 1;
    if BottomLine < LastLine then
      DrawScrollDnBtn(ACanvas, DrawInfo.aRect);
    }
  end;
end;

procedure TJvTFGVTextControl.WMEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := LRESULT(False);
end;

procedure TJvTFGVTextControl.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  GlancePt: TPoint;
begin
  inherited MouseMove(Shift, X, Y);
  FMousePtInfo := CalcPointInfo(X, Y);
  MouseLine := FMousePtInfo.AbsLineNum;
  //SetFocus;

  GlancePt := Point(X, Y);
  GlancePt := Viewer.GlanceControl.ScreenToClient(ClientToScreen(Point(X, Y)));
  Viewer.GlanceControl.CheckViewerApptHint(GlancePt.X, GlancePt.Y);

  // for TESTING ONLY!!!
  //Invalidate;
  ////////////////////
end;

procedure TJvTFGVTextControl.SetMouseLine(Value: Integer);
begin
  if Value <> FMouseLine then
  begin
    FMouseLine := Value;
    UpdateDDBtnRect;
    Invalidate;
  end;
end;

procedure TJvTFGVTextControl.DrawArrow(ACanvas: TCanvas; aRect: TRect;
  Direction: TJvTFDirection);
var
  I, ArrowHeight, ArrowWidth, BaseX, BaseY: Integer;
begin
  ArrowWidth := RectWidth(aRect) - 2;
  if not Odd(ArrowWidth) then
    Dec(ArrowWidth);
  ArrowHeight := (ArrowWidth + 1) div 2;

  case Direction of
    dirUp:
      begin
        BaseX := aRect.Left + RectWidth(aRect) div 2 - ArrowWidth div 2;
        BaseY := aRect.Top + RectHeight(aRect) div 2 + ArrowHeight div 2 - 1;

        for I := ArrowHeight downto 1 do
          with ACanvas do
          begin
            MoveTo(BaseX, BaseY);
            LineTo(BaseX + I * 2 - 1, BaseY);
            Inc(BaseX);
            Dec(BaseY);
          end;
      end;
    dirDown:
      begin
        BaseX := aRect.Left + RectWidth(aRect) div 2 - ArrowWidth div 2;
        BaseY := aRect.Top + RectHeight(aRect) div 2 - ArrowHeight div 2 + 1;

        for I := ArrowHeight downto 1 do
        with ACanvas do
          begin
            MoveTo(BaseX, BaseY);
            LineTo(BaseX + I * 2 - 1, BaseY);
            Inc(BaseX);
            Inc(BaseY);
          end;
      end;
    dirLeft:
      begin
        BaseX := aRect.Left + RectWidth(aRect) div 2 + ArrowHeight div 2;
        BaseY := aRect.Top + RectHeight(aRect) div 2 - ArrowWidth div 2;

        for I := ArrowHeight downto 1 do
          with ACanvas do
          begin
            MoveTo(BaseX, BaseY);
            LineTo(BaseX, BaseY + I * 2 - 1);
            Dec(BaseX);
            Inc(BaseY);
          end;
      end;
  else
    BaseX := aRect.Left + RectWidth(aRect) div 2 - ArrowHeight div 2;
    BaseY := aRect.Top + RectHeight(aRect) div 2 - ArrowWidth div 2;

    for I := ArrowHeight downto 1 do
      with ACanvas do
      begin
        MoveTo(BaseX, BaseY);
        LineTo(BaseX, BaseY + I * 2 - 1);
        Inc(BaseX);
        Inc(BaseY);
      end;
  end;
end;

procedure TJvTFGVTextControl.UpdateDDBtnRect;
begin
  FDDBtnRect := LineRect(FMousePtInfo.AbsLineNum);
  FDDBtnRect.Right := ClientRect.Right - 1;
  FDDBtnRect.Left := FDDBtnRect.Right - 10;
  Inc(FDDBtnRect.Top, 2);
  Dec(FDDBtnRect.Bottom, 1);
end;

procedure TJvTFGVTextControl.DoEnter;
begin
  inherited DoEnter;
  Viewer.SetSelAppt(FindApptAtLine(FMousePtInfo.RelLineNum));
end;

procedure TJvTFGVTextControl.DoExit;
begin
  inherited DoExit;
  FMouseLine := -1; 
end;

{
function TJvTFGVTextControl.LineCount: Integer;
var
  ACell: TJvTFGlanceCell;
  I: Integer;
begin
  Result := 0;
  ACell := Viewer.GlanceControl.Cells.Cells[Viewer.Col, Viewer.Row];

  for I := 0 to ACell.ScheduleCount - 1 do
    Inc(Result, ACell.Schedules[I].ApptCount);
end;
}

function TJvTFGVTextControl.LineCount: Integer;
begin
  Result := Viewer.ApptCount;
end;

procedure TJvTFGVTextControl.SetTopLine(Value: Integer);
begin
  Viewer.SetTopLine(Viewer.Cell, Value);
end;

function TJvTFGVTextControl.CalcPointInfo(X, Y: Integer): TJvTFGlTxtVwPointInfo;
begin
  with Result do
  begin
    AbsX := X;
    AbsY := Y;
    AbsLineNum := CalcAbsLineNum(Y);
    RelLineNum := TopLine + AbsLineNum;
  end;
end;

function TJvTFGVTextControl.ViewableLines: Integer;
var
  aRect: TRect;
begin
  aRect := GlanceControl.CalcCellBodyRect(Viewer.Cell,
    GlanceControl.CellIsSelected(Viewer.Cell), False);

  Result := RectHeight(aRect) div CalcLineHeight;
  if RectHeight(aRect) mod CalcLineHeight > 0 then
    Inc(Result);
end;

function TJvTFGVTextControl.AbsToRel(Abs: Integer): Integer;
begin
  Result := TopLine + Abs;
end;

function TJvTFGVTextControl.RelToAbs(Rel: Integer): Integer;
begin
  Result := Rel - TopLine;
end;

procedure TJvTFGVTextControl.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Appt: TJvTFAppt;
begin
  inherited MouseDown(Button, Shift, X, Y);
  SetFocus;

  if Windows.PtInRect(ScrollDnBtnRect(ClientRect), Point(X, Y)) then
    Scroll(1)
  else
  if Windows.PtInRect(ScrollUpBtnRect(ClientRect), Point(X, Y)) then
    Scroll(-1)
  else
  begin
    Appt := FindApptAtLine(FMousePtInfo.RelLineNum);
    if Assigned(Appt) then
      Viewer.SetSelAppt(Appt);

    if Windows.PtInRect(FDDBtnRect, Point(X, Y)) and Assigned(Viewer) then
    begin
      EditAppt(Viewer.Cell, FMousePtInfo.RelLineNum, Appt);
      Viewer.LineDDClick(MouseLine);
    end
    else
    if not Windows.PtInRect(FDDBtnRect, Point(X, Y)) and Assigned(Appt) then
      Viewer.GlanceControl.BeginDrag(False);
  end;
end;

{$IFDEF USEJVCL}

procedure TJvTFGVTextControl.MouseEnter(Control: TControl);
begin
  FMouseInControl := True;
  inherited MouseEnter(Control);
  Invalidate;
end;

procedure TJvTFGVTextControl.MouseLeave(Control: TControl);
begin
  FMouseInControl := False;
  inherited MouseLeave(Control);
  Invalidate;
end;

{$ENDIF USEJVCL}

procedure TJvTFGVTextControl.Scroll(ScrollBy: Integer);
var
  CurrTop: Integer;
begin
  CurrTop := Viewer.GetTopLine(Viewer.Cell);
  Viewer.SetTopLine(Viewer.Cell, CurrTop + ScrollBy);
end;

function TJvTFGVTextControl.GetTopLine: Integer;
begin
  Result := Viewer.GetTopLine(Viewer.Cell);
end;

function TJvTFGVTextControl.ScrollDnBtnRect(aCellRect: TRect): TRect;
var
  BtnLeft,
  BtnTop: Integer;
begin
  if TopLine + FullViewableLines - 1 < LineCount - 1 then
  begin
    Result := Rect(0, 0, FScrollDnBtnBMP.Width, FScrollDnBtnBMP.Height);
    BtnLeft := aCellRect.Right - 10 - RectWidth(Result);
    BtnTop := aCellRect.Bottom - RectHeight(Result);
    Windows.OffsetRect(Result, BtnLeft, BtnTop);
  end
  else
    Result := Rect(0, 0, 0, 0);
end;

function TJvTFGVTextControl.ScrollUpBtnRect(aCellRect: TRect): TRect;
var
  BtnLeft: Integer;
begin
  if TopLine > 0 then
  begin
    Result := Rect(0, 0, FScrollUpBtnBMP.Width, FScrollUpBtnBMP.Height);
    BtnLeft := aCellRect.Right - 10 - RectWidth(Result);
    Windows.OffsetRect(Result, BtnLeft, aCellRect.Top);
  end
  else
    Result := Rect(0, 0, 0, 0);
end;

destructor TJvTFGVTextControl.Destroy;
begin
  FEditor.Free;
  FScrollUpBtnBMP.Free;
  FScrollDnBtnBMP.Free;

  inherited Destroy;
end;

procedure TJvTFGVTextControl.InitScrollDnBtnBMP;
begin
  with FScrollDnBtnBMP do
  begin
    Height := 9;
    Width := 16;

    with Canvas do
    begin
      Brush.Color := clBtnFace;
      FillRect(Rect(0, 0, Width, Height));

      Pen.Color := clBlack;
      Polyline([Point(0, 0), Point(Width - 1, 0),
        Point(Width - 1, Height - 1), Point(0, Height - 1),
        Point(0, 0)]);

      MoveTo(2, 2);
      LineTo(14, 2);
      MoveTo(2, 3);
      LineTo(14, 3);
      MoveTo(7, 4);
      LineTo(13, 4);
      MoveTo(8, 5);
      LineTo(12, 5);
      MoveTo(9, 6);
      LineTo(11, 6);
    end;
  end;
end;

procedure TJvTFGVTextControl.InitScrollUpBtnBMP;
begin
  with FScrollUpBtnBMP do
  begin
    Height := 9;
    Width := 16;

    with Canvas do
    begin
      Brush.Color := clBtnFace;
      FillRect(Rect(0, 0, Width, Height));

      Pen.Color := clBlack;
      Polyline([Point(0, 0), Point(Width - 1, 0),
        Point(Width - 1, Height - 1), Point(0, Height - 1),
        Point(0, 0)]);

      MoveTo(9, 2);
      LineTo(11, 2);
      MoveTo(8, 3);
      LineTo(12, 3);
      MoveTo(7, 4);
      LineTo(13, 4);
      MoveTo(2, 5);
      LineTo(14, 5);
      MoveTo(2, 6);
      LineTo(14, 6);
    end;
  end;
end;

procedure TJvTFGVTextControl.DrawScrollDnBtn(ACanvas: TCanvas; aCellRect: TRect);
var
  aRect: TRect;
begin
  aRect := ScrollDnBtnRect(aCellRect);
  Windows.BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, RectWidth(aRect),
    RectHeight(aRect), FScrollDnBtnBMP.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TJvTFGVTextControl.DrawScrollUpBtn(ACanvas: TCanvas; aCellRect: TRect);
var
  aRect: TRect;
begin
  aRect := ScrollUpBtnRect(aCellRect);
  Windows.BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, RectWidth(aRect),
    RectHeight(aRect), FScrollUpBtnBMP.Canvas.Handle, 0, 0, SRCCOPY);
end;

function TJvTFGVTextControl.FullViewableLines: Integer;
var
  aRect: TRect;
begin
  aRect := GlanceControl.CalcCellBodyRect(Viewer.Cell,
    GlanceControl.CellIsSelected(Viewer.Cell), False);

  Result := RectHeight(aRect) div CalcLineHeight;
end;

function TJvTFGVTextControl.CanEdit: Boolean;
begin
  Result := True;
end;

{
procedure TJvTFGVTextControl.EditAppt(Col, Row: Integer; Appt: TJvTFAppt);
var
  EditLine: Integer;
  EditorRect: TRect;
begin
  EditLine := RelToAbs(GetApptRelLineNum(Appt));
  if not Assigned(Appt) or not CanEdit or
     ((EditLine < 0) or (EditLine > AbsLineCount)) then
    Exit;

  Viewer.EnsureCol(Col);
  Viewer.EnsureRow(Row);
  if (Viewer.Col <> Col) or (Viewer.Row <> Row) then
    Viewer.MoveTo(Col, Row);

  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;
}

procedure TJvTFGVTextControl.EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
var
  EditLine: Integer;
  EditorRect: TRect;
begin
  //EditLine := RelToAbs(GetApptRelLineNum(Appt));
  EditLine := RelToAbs(RelLine);
  if not Assigned(Appt) or not CanEdit or
     ((EditLine < 0) or (EditLine > AbsLineCount)) then
    Exit;