tntjvmemo.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

{-----------------------------------------------------------------------------
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: JvMemo.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
All Rights Reserved.

This unit is a merging of the original TJvMemo, JvDisplayMemo, JvCaretMemo,JvMemoEx.
Merging done 2002-06-11 by Peter Thornqvist [peter3 at sourceforge dot net]

Contributor(s):
  Michael Beck [mbeck att bigfoot dott com]
  Anthony Steele [asteele att iafrica dott com]
  Peter Below [100113 dott 1101 att compuserve dott com]

  MERGE NOTES:
    * TjvCustomMemo has been removed from JvComponent and put here instead.
    * The HotTrack property only works if BorderStyle := bsSingle
    * To simulate the behaviour of JvDisplayMemo, set HideCaret to True,
      Readonly to True, Color to $C0FFFF and Cursor to crArrow
    * The MaxLines property has changed: it stills displays only the selected number of lines,
      but now saves the original content in an internal stringlist that can be restored by
      setting MaxLines to 0.
    * Added ClipboardCommands

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: JvMemo.pas,v 1.28 2005/09/09 10:04:39 obones Exp $

{ 08/20/2006:
  Add all functionality of TJvMemo
}

unit TntJvMemo;

{$I jvcl.inc}
{$I vclonly.inc}

interface

uses
  Windows, Classes, Controls, Messages, Graphics,
  JvCaret, JvTypes,
  TntClasses, TntJvExStdCtrls;

type
  TTntJvCustomMemo0 = class(TTntJvExCustomMemo)
  private
    FMaxLines: Integer;
    FHotTrack: Boolean;
    FOnHorizontalScroll: TNotifyEvent;
    FOnVerticalScroll: TNotifyEvent;
    FCaret: TJvCaret;
    FHideCaret: Boolean;
    FOrigLines: TTntStringList;
    FTransparent: Boolean;
    procedure SetHotTrack(Value: Boolean);
    procedure SetCaret(const Value: TJvCaret);
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure SetMaxLines(const Value: Integer);
    procedure SetHideCaret(const Value: Boolean);
  protected
    procedure SetClipboardCommands(const Value: TJvClipboardCommands); override;
    procedure WMCut(var Msg: TMessage); message WM_CUT;
    procedure WMPaste(var Msg: TMessage); message WM_PASTE;
    procedure WMClear(var Msg: TMessage); message WM_CLEAR;
    procedure WMUndo(var Msg: TMessage); message WM_UNDO;
    procedure CaretChange(Sender: TObject); dynamic;
    procedure FocusKilled(NextWnd: THandle); override;
    procedure FocusSet(PrevWnd: THandle); override;
    function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; override;
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    procedure WndProc(var Msg: TMessage); override;
    procedure KeyPress(var Key: Char); override;
    procedure Change; override;
    procedure CreateParams(var Params: TCreateParams); override;
    function GetCurrentLine: Integer;
    procedure SetCurrentLine(NewLine: Integer);
    procedure SetTransparent(Value: Boolean);
    procedure SetLines(const Value: TTntStrings); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { these wrap the windows messages }
    procedure LineScroll(X, Y: Integer);
    function CharOfLine(iLine: Integer): Integer;
    property CurrentLine: Integer read GetCurrentLine write SetCurrentLine;
  protected
    property Caret: TJvCaret read FCaret write SetCaret;
    property HideCaret: Boolean read FHideCaret write SetHideCaret;
    property MaxLines: Integer read FMaxLines write SetMaxLines;
    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property OnVerticalScroll: TNotifyEvent read FOnVerticalScroll write FOnVerticalScroll;
    property OnHorizontalScroll: TNotifyEvent read FOnHorizontalScroll write FOnHorizontalScroll;
  end;

  TTntJvCustomMemo = class(TTntJvCustomMemo0)
  private
    FAlignment: TAlignment;
    procedure SetAlignment(Value: TAlignment);
  protected
    {$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
    {$ENDIF VCL}
  public
    constructor Create(AOwner: TComponent); override;
  protected
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  end;

  TTntJvMemo = class(TTntJvCustomMemo)
  published
    property AutoSize;
    property Caret;
    property ClipboardCommands;
    property MaxLines;
    property HideCaret;
    property HotTrack;
    property HintColor;

    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
    property OnVerticalScroll;
    property OnHorizontalScroll;

    property Align;
    property Alignment;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property Lines;
    property MaxLength;
    property OEMConvert;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property Transparent;
    property ScrollBars;
    property ShowHint;
    property TabOrder;
    property TabStop;
    //    property Text;
    property Visible;
    property WantReturns;
    property WantTabs;
    property WordWrap;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvMemo.pas,v $';
    Revision: '$Revision: 1.28 $';
    Date: '$Date: 2005/09/09 10:04:39 $';
    LogPath: 'JVCL'run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils,
  JclStrings;

constructor TTntJvCustomMemo0.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOrigLines := TTntStringList.Create;
  FHotTrack := False;
  // ControlStyle := ControlStyle + [csAcceptsControls];
  FCaret := TJvCaret.Create(Self);
  FCaret.OnChanged := CaretChange;
  FTransparent := False;
end;

destructor TTntJvCustomMemo0.Destroy;
begin
  FOrigLines.Free;
  FCaret.Free;
  inherited Destroy;
end;

procedure TTntJvCustomMemo0.WMHScroll(var Msg: TWMHScroll);
begin
  inherited;
  if Assigned(FOnHorizontalScroll) then
    FOnHorizontalScroll(Self);
end;

procedure TTntJvCustomMemo0.WMVScroll(var Msg: TWMVScroll);
begin
  inherited;
  if Assigned(FOnVerticalScroll) then
    FOnVerticalScroll(Self);
end;

procedure TTntJvCustomMemo0.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not MouseOver then
  begin
    if FHotTrack then
      Ctl3D := True;
    inherited MouseEnter(Control);
  end;
end;

procedure TTntJvCustomMemo0.MouseLeave(Control: TControl);
begin
  if MouseOver then
  begin
    if FHotTrack then
      Ctl3D := False;
    inherited MouseLeave(Control);
  end;
end;

procedure TTntJvCustomMemo0.SetHotTrack(Value: Boolean);
begin
  FHotTrack := Value;
  Ctl3D := not FHotTrack;
end;

{ This does not recurse it seems }

procedure TTntJvCustomMemo0.Change;
begin
  { only process if maxlines is set - truncate }
  if MaxLines > 0 then
    while Lines.Count > MaxLines do
      Lines.Delete(Lines.Count - 1);