jvtfglancetextviewer.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvTFGlanceTextViewer.PAS, released on 2003-08-01.

The Initial Developer of the Original Code is Unlimited Intelligence Limited.
Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
All Rights Reserved.

Contributor(s):
Mike Kolter (original code)

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvTFGlanceTextViewer.pas,v 1.25 2005/02/17 10:20:56 marquardt Exp $

unit JvTFGlanceTextViewer;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  SysUtils, Classes, Windows, Messages, Graphics, Controls, Forms, Dialogs, StdCtrls,
  {$IFDEF USEJVCL}
  JvComponent,
  {$ENDIF USEJVCL}
  JvTFManager, JvTFGlance, JvTFUtils;

type
  TJvTFGlanceTextViewer = class;

  TJvTFGlTxtVwDrawInfo = record
    Cell: TJvTFGlanceCell;
    Font: TFont;
    Color: TColor;
    aRect: TRect;
  end;

  TJvTFGlTxtVwPointInfo = record
    AbsX: Integer;
    AbsY: Integer;
    AbsLineNum: Integer;
    RelLineNum: Integer;
  end;

  TJvTFGVTxtEditor = class(TMemo)
  private
    FLinkedAppt: TJvTFAppt;
  protected
    FCancelEdit: Boolean;
    procedure DoExit; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property LinkedAppt: TJvTFAppt read FLinkedAppt write FLinkedAppt;
  end;

  {$IFDEF USEJVCL}
  TJvTFGVTextControl = class(TJvCustomControl)
  {$else}
  TJvTFGVTextControl = class(TCustomControl)
  {$ENDIF USEJVCL}
  private
    FViewer: TJvTFGlanceTextViewer;
    FReplicating: Boolean;
    FMouseLine: Integer;
    function GetGlanceControl: TJvTFCustomGlance;
    procedure SetTopLine(Value: Integer);
    function GetTopLine: Integer;
  protected
    FMousePtInfo: TJvTFGlTxtVwPointInfo;
    FDDBtnRect: TRect;
    FMouseInControl: Boolean;
    FScrollUpBtnBMP: TBitmap;
    FScrollDnBtnBMP: TBitmap;
    FEditor: TJvTFGVTxtEditor;
    {$IFDEF USEJVCL}
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    {$ENDIF USEJVCL}

    procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
    procedure DoEnter; override;
    procedure DoExit; override;

    procedure SetMouseLine(Value: Integer);
    property MouseLine: Integer read FMouseLine write SetMouseLine;
    procedure UpdateDDBtnRect;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseAccel(X, Y: Integer);

    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;

    property Replicating: Boolean read FReplicating;
    procedure Paint; override;
    procedure DrawDDButton(ACanvas: TCanvas);
    procedure DrawArrow(ACanvas: TCanvas; aRect: TRect; Direction: TJvTFDirection);
    procedure DrawScrollUpBtn(ACanvas: TCanvas; aCellRect: TRect);
    procedure DrawScrollDnBtn(ACanvas: TCanvas; aCellRect: TRect);
    function GetStartEndString(Appt: TJvTFAppt): string;

    function CalcLineHeight: Integer;
    function CalcAbsLineNum(Y: Integer): Integer;
    function LineRect(AbsLineNum: Integer): TRect;
    function CalcPointInfo(X, Y: Integer): TJvTFGlTxtVwPointInfo;
    function RelToAbs(Rel: Integer): Integer;
    function AbsToRel(Abs: Integer): Integer;
    function FindApptAtLine(RelLineNum: Integer): TJvTFAppt;
    function GetApptRelLineNum(Appt: TJvTFAppt): Integer;

    procedure Scroll(ScrollBy: Integer);
    function ScrollUpBtnRect(aCellRect: TRect): TRect;
    function ScrollDnBtnRect(aCellRect: TRect): TRect;
    procedure InitScrollUpBtnBMP;
    procedure InitScrollDnBtnBMP;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure PaintTo(ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo); overload;

    property Viewer: TJvTFGlanceTextViewer read FViewer;
    property GlanceControl: TJvTFCustomGlance read GetGlanceControl;

    // editor management routines
    //procedure EditAppt(Col, Row: Integer; Appt: TJvTFAppt);
    procedure EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
    procedure FinishEditAppt;
    function Editing: Boolean;
    function CanEdit: Boolean;

    function LineCount: Integer;
    function AbsLineCount: Integer;
    function ViewableLines: Integer;
    function FullViewableLines: Integer;
    property TopLine: Integer read GetTopLine write SetTopLine;

    function GetApptAt(X, Y: Integer): TJvTFAppt;
    function GetApptAccel(X, Y: Integer): TJvTFAppt;
  end;

  TJvTFLineDDClickEvent = procedure(Sender: TObject; LineNum: Integer) of object;

  TJvTFTxtVwApptAttr = class(TPersistent)
  private
    FColor: TColor;
    FFontColor: TColor;
    FOnChange: TNotifyEvent;
    procedure SetColor(Value: TColor);
    procedure SetFontColor(Value: TColor);
  protected
    procedure Change;
  public
    constructor Create(AOwner: TComponent);
    procedure Assign(Source: TPersistent); override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Color: TColor read FColor write SetColor default clBlue;
    property FontColor: TColor read FFontColor write SetFontColor default clWhite;
  end;

  TJvTFGlTxtVwEditorAlign = (eaLine, eaCell);

  TJvTFGlanceTextViewer = class(TJvTFGlanceViewer)
  private
    FViewControl: TJvTFGVTextControl;
    FLineSpacing: Integer;
    FEditorAlign: TJvTFGlTxtVwEditorAlign;
    FOnLineDDClick: TJvTFLineDDClickEvent;
    FShowStartEnd: Boolean;
    FTopLines: TStringList;
    FSelApptAttr: TJvTFTxtVwApptAttr;
    FSelAppt: TJvTFAppt;
    procedure SetLineSpacing(Value: Integer);
    procedure SetSelApptAttr(Value: TJvTFTxtVwApptAttr);
    procedure SetEditorAlign(Value: TJvTFGlTxtVwEditorAlign);
    procedure SetShowStartEnd(Value: Boolean);
    function GetCellString(ACell: TJvTFGlanceCell): string;
  protected
    procedure SetVisible(Value: Boolean); override;
    procedure SetGlanceControl(Value: TJvTFCustomGlance); override;
    procedure SelApptAttrChange(Sender: TObject);
    procedure Change; virtual;
    procedure LineDDClick(LineNum: Integer); virtual;
    procedure ParentReconfig; override;
    procedure SetSelAppt(Value: TJvTFAppt);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); override;
    procedure MouseAccel(X, Y: Integer); override;

    procedure Refresh; override;
    procedure Realign; override;
    procedure PaintTo(ACanvas: TCanvas; ACell: TJvTFGlanceCell); override;
    function GetDrawInfo(ACell: TJvTFGlanceCell): TJvTFGlTxtVwDrawInfo;
    procedure ResetTopLines;
    property SelAppt: TJvTFAppt read FSelAppt;

    procedure SetTopLine(ACell: TJvTFGlanceCell; Value: Integer);
    function GetTopLine(ACell: TJvTFGlanceCell): Integer;
    function GetApptAt(X, Y: Integer): TJvTFAppt; override;

    // editor management routines
    procedure EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
    procedure FinishEditAppt; override;
    function Editing: Boolean; override;
    function CanEdit: Boolean; override;
  published
    property LineSpacing: Integer read FLineSpacing write SetLineSpacing default 0;
    property OnLineDDClick: TJvTFLineDDClickEvent read FOnLineDDClick write FOnLineDDClick;
    property SelApptAttr: TJvTFTxtVwApptAttr read FSelApptAttr write SetSelApptAttr;
    property EditorAlign: TJvTFGlTxtVwEditorAlign read FEditorAlign
      write SetEditorAlign default eaLine;
    property ShowStartEnd: Boolean read FShowStartEnd
      write SetShowStartEnd default True;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvTFGlanceTextViewer.pas,v $';
    Revision: '$Revision: 1.25 $';
    Date: '$Date: 2005/02/17 10:20:56 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

{$IFDEF USEJVCL}
uses
  JvJVCLUtils, JvResources;
{$ENDIF USEJVCL}

{$IFNDEF USEJVCL}
resourcestring
  RsEGlanceControlNotAssigned = 'GlanceControl not assigned';
{$ENDIF !USEJVCL}

//=== { TJvTFGVTextControl } =================================================

constructor TJvTFGVTextControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AOwner is TJvTFGlanceTextViewer then
    FViewer := TJvTFGlanceTextViewer(AOwner);

  DoubleBuffered := True;

  FReplicating := True;
  FMouseLine := -1;

  FScrollUpBtnBMP := TBitmap.Create;
  InitScrollUpBtnBMP;
  FScrollDnBtnBMP := TBitmap.Create;
  InitScrollDnBtnBMP;

  FEditor := TJvTFGVTxtEditor.Create(Self);
  FEditor.Visible := False;
  FEditor.Parent := Self;
  //FEditor.Parent := Viewer.GlanceControl;
  // (rom) deactivated seems of no use
  // if FEditor.Parent = nil then
  //   Beep;
end;

function TJvTFGVTextControl.CalcAbsLineNum(Y: Integer): Integer;
begin
  Result := Y div CalcLineHeight;
end;

procedure TJvTFGVTextControl.DrawDDButton(ACanvas: TCanvas);
begin
  with ACanvas do
  begin
    Brush.Color := clBtnFace;
    FillRect(FDDBtnRect);

    DrawArrow(ACanvas, FDDBtnRect, dirDown);

    Pen.Color := clBlack;
    Polyline([FDDBtnRect.TopLeft, Point(FDDBtnRect.Right, FDDBtnRect.Top),
      FDDBtnRect.BottomRight, Point(FDDBtnRect.Left, FDDBtnRect.Bottom),
      FDDBtnRect.TopLeft]);
    {
    if Windows.PtInRect(aRect, FMouseLoc) then
      begin
        Pen.Color := clBtnHighlight;
        MoveTo(aRect.Left, aRect.Top);
        LineTo(aRect.Left, aRect.Bottom);
        MoveTo(aRect.Left, aRect.Top);
        LineTo(aRect.Right, aRect.Top);

        Pen.Color := clBtnShadow;
        MoveTo(aRect.Right - 1, aRect.Top);
        LineTo(aRect.Right - 1, aRect.Bottom);
        MoveTo(aRect.Right, aRect.Bottom - 1);
        LineTo(aRect.Left, aRect.Bottom - 1);
      end;
    }
  end;
end;

function TJvTFGVTextControl.GetGlanceControl: TJvTFCustomGlance;
begin
  Result := nil;
  if Assigned(Viewer) then
    Result := Viewer.GlanceControl;
end;

function TJvTFGVTextControl.CalcLineHeight: Integer;
begin
  Result := Canvas.TextHeight('Wq') + Viewer.LineSpacing;
end;

function TJvTFGVTextControl.LineRect(AbsLineNum: Integer): TRect;
var
  LineHt: Integer;
begin
  LineHt := CalcLineHeight;
  Result := ClientRect;
  Result.Top := LineHt * AbsLineNum;
  Result.Bottom := Lesser(Result.Top + LineHt, Result.Bottom);
end;

procedure TJvTFGVTextControl.Paint;
var
  DrawInfo: TJvTFGlTxtVwDrawInfo;
begin
  {
  All drawing should be done in a PaintTo method.  PaintTo should have ACanvas
  and aRect Params.  All drawing code within PaintTo should rely solely on
  the ACanvas and aRect parameters given.

  This method (Paint) should then call PaintTo(Canvas, ClientRect) to draw the
  info on the viewer control.  TJvTFCustomGlance.DrawCell should call
  PaintTo(PaintBuffer, CellBodyRect(Col, Row, Selected, False)) to draw the
  info on the GlanceControl.
  }

  Viewer.SetTo(Viewer.PhysicalCell);
  DrawInfo := Viewer.GetDrawInfo(Viewer.Cell);
  DrawInfo.aRect := ClientRect;

  FReplicating := False;
  try
    PaintTo(Canvas, DrawInfo);
  finally
    FReplicating := True;
  end;

{
  // for TESTING PURPOSES ONLY!!
  with Canvas do
    begin
      Pen.Color := clBlack;
      MoveTo(0, 0);
      LineTo(ClientWidth, ClientHeight);
    end;
}
end;

procedure TJvTFGVTextControl.PaintTo(ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo);
var
  I, NextLineTop, LastLine: Integer;
  aRect, LineRect, TxtRect, BtnRect: TRect;
  Flags: UINT;
  Txt: string;
  PTxt: PChar;
  Appt: TJvTFAppt;
  RegFontColor,
  RegBrushColor: TColor;
begin
  Viewer.SetTo(DrawInfo.Cell);

  with ACanvas do
  begin
    aRect := DrawInfo.aRect;

    //Brush.Color := Viewer.Color;
    Brush.Color := DrawInfo.Color;
    FillRect(aRect);

    //Font.Assign(Viewer.Font);
    Font.Assign(DrawInfo.Font);
    Self.Canvas.Font.Assign(DrawInfo.Font);

    RegBrushColor := Brush.Color;
    RegFontColor := Font.Color;

    NextLineTop := aRect.Top;
    LineRect.Left := aRect.Left;
    LineRect.Right := aRect.Right;

    //Flags := DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER;
    Flags := DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_TOP;

    if csDesigning in ComponentState then
      LastLine := 2
    else
      LastLine := Lesser(ViewableLines - 1, LineCount - TopLine - 1);

    for I := 0 to LastLine do
    begin
      Brush.Color := RegBrushColor;
      Font.Color := RegFontColor;

      LineRect.Top := NextLineTop;
      LineRect.Bottom := Lesser(NextLineTop + CalcLineHeight, aRect.Bottom);

      if csDesigning in ComponentState then
        Txt := 'Appt ' + IntToStr(I)
      else
      begin
        Appt := Viewer.Appts[AbsToRel(I)];

        Txt := '';
        if Viewer.ShowStartEnd then
          Txt := GetStartEndString(Appt) + ': ';
        Txt := Txt + Appt.Description;

        if Appt = Viewer.SelAppt then
        begin
          Brush.Color := Viewer.SelApptAttr.Color;
          Font.Color := Viewer.SelApptAttr.FontColor;

          FillRect(LineRect);

          if I <> 0 then
          begin
            MoveTo(aRect.Left, LineRect.Top);
            LineTo(aRect.Right, LineRect.Top);
          end;
          if I <> AbsLineCount - 1 then
          begin
            MoveTo(aRect.Left, LineRect.Bottom - 1);
            LineTo(aRect.Right, LineRect.Bottom - 1);
          end;
        end;
      end;

      TxtRect := LineRect;
      Windows.InflateRect(TxtRect, -1, -1);

      PTxt := StrAlloc((Length(Txt) + 4) * SizeOf(Char));
      StrPCopy(PTxt, Txt);
      Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);