tntjvedit2.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: JvNewEdit.PAS, released on 2002-mm-dd.

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 TJvEdit, TJvExEdit, TJvCaretEdit,TJvAlignedEdit,
TJvSingleLineMemo.
Merging done 2002-06-05 by Peter Thornqvist [peter3 at sourceforge dot net]

  MERGE NOTES:
    * TTntJvCustomEdit has been removed from JvComponent and put here instead.
    * The HotTrack property only works if BorderStyle := bsSingle and BevelKind := bvNone
    * Added ClipboardCommands

Contributor(s):
  Anthony Steele [asteele att iafrica dott com]
  Peter Below [100113 dott 1101 att compuserve dott com]
  Rob den Braasem [rbraasem att xs4all dott nl] (GroupIndex property - using several TJvEdits with the same GroupIndex
    will clear the text from the other edits when something is typed into one of them.
    To disable GroupIndex, set it to -1)
  André Snepvangers [asn att xs4all dott nl] ( clx compatible version )

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: JvEdit.pas,v 1.68 2005/03/09 22:50:44 remkobonte Exp $

unit TntJvEdit2;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages,
  {$IFDEF VisualCLX}
  Qt,
  {$ENDIF VisualCLX}
  Classes, Graphics, Controls, TntControls, Menus,
  //JvCaret, JvMaxPixel,
  JvTypes,
  TntJvExStdCtrls;

{$IFDEF VisualCLX}
const
  clGrayText = clDisabledText; // Since when is clGrayText = clLight = clWhite?
{$ENDIF VisualCLX}

type
  TTntJvCustomEdit = class(TTntJvExCustomEdit)
  private
    {$IFDEF VisualCLX}
    FFlat: Boolean;
    {$ENDIF VisualCLX}
    //FMaxPixel: TJvMaxPixel;
    FGroupIndex: Integer;
    FAlignment: TAlignment;
    //FCaret: TJvCaret;
    FHotTrack: Boolean;
    FDisabledColor: TColor;
    FDisabledTextColor: TColor;
    FProtectPassword: Boolean;
    FStreamedSelLength: Integer;
    FStreamedSelStart: Integer;
    FUseFixedPopup: Boolean;
    FAutoHint: Boolean;
    {$IFDEF VisualCLX}
    FPasswordChar: Char;
    //FNullPixmap: QPixmapH;
    {$ENDIF VisualCLX}
    FEmptyValue: WideString;
    FIsEmptyValue: Boolean;
    FEmptyFontColor: TColor;
    FOldFontColor: TColor;
    FIsLoaded: Boolean;
    {$IFDEF JVCLThemesEnabled}
    FThemedPassword: Boolean;
    FThemedFont: TFont;
    {$ENDIF JVCLThemesEnabled}
    procedure SetAlignment(Value: TAlignment);
    //procedure SetCaret(const Value: TJvCaret);
    procedure SetDisabledColor(const Value: TColor); virtual;
    procedure SetDisabledTextColor(const Value: TColor); virtual;
    procedure SetHotTrack(const Value: Boolean);
    {$IFDEF VCL}
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure CMHintShow(var Msg: TMessage); message CM_HINTSHOW;
    function IsFlatStored: Boolean;
    {$ENDIF VCL}
    procedure SetEmptyValue(const Value: WideString);
    procedure SetGroupIndex(Value: Integer);
    function GetFlat: Boolean;
    {$IFDEF JVCLThemesEnabled}
    procedure SetThemedPassword(const Value: Boolean);
    procedure WMSetFont(var Msg: TWMSetFont); message WM_SETFONT;
    function GetThemedFontHandle: HFONT;
    {$ENDIF JVCLThemesEnabled}
  protected
    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;
    { (rb) renamed from UpdateEdit }
    procedure UpdateGroup; virtual;
    procedure SetClipboardCommands(const Value: TJvClipboardCommands); override;
    //procedure CaretChanged(Sender: TObject); dynamic;
    procedure Change; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    //procedure MaxPixelChanged(Sender: TObject);
    function IsPasswordCharStored: Boolean; override;
    function GetPasswordChar: WideChar; override;
    procedure SetPasswordChar(const Value: WideChar); override;
    procedure SetSelLength(const Value: Integer); override;
    procedure SetSelStart(const Value: Integer); override;
    function GetPopupMenu: TPopupMenu; override;
    {$IFDEF VCL}
    function GetText: WideString; override;
    procedure SetText(const Value: WideString); override;
    procedure CreateHandle; override;
    procedure DestroyWnd; override;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    function GetText: WideString; override;
    {$ENDIF VisualCLX}
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure DoEmptyValueEnter; virtual;
    procedure DoEmptyValueExit; virtual;
    {$IFDEF VisualCLX}
    procedure InitWidget; override;
    procedure Paint; override;
//    procedure TextChanged; override;
//    procedure KeyPress(var Key: Char); override;
    function HintShow(var HintInfo: THintInfo): Boolean; override;
    {$ENDIF VisualCLX}
    procedure FocusSet(PrevWnd: HWND); override;
    procedure FocusKilled(NextWnd: HWND); override;
    function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; override;
    procedure EnabledChanged; override;
    procedure SetFlat(Value: Boolean); virtual;
    procedure MouseEnter(AControl: TControl); override;
    procedure MouseLeave(AControl: TControl); override;
    procedure Loaded; override;
    {$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
    {$ENDIF VCL}
  public
    function IsEmpty: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {$IFDEF VCL}
    procedure DefaultHandler(var Msg); override;
    {$ENDIF VCL}
  protected
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property AutoHint: Boolean read FAutoHint write FAutoHint default False;
    //property Caret: TJvCaret read FCaret write SetCaret;
    property EmptyValue: WideString read FEmptyValue write SetEmptyValue;
    property EmptyFontColor: TColor read FEmptyFontColor write FEmptyFontColor default clGrayText;
    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
    {$IFDEF JVCLThemesEnabled}
    property ThemedPassword: Boolean read FThemedPassword write SetThemedPassword default False;
    {$ENDIF JVCLThemesEnabled}
    // set to True to disable read/write of PasswordChar and read of Text
    property ProtectPassword: Boolean read FProtectPassword write FProtectPassword default False;
    property DisabledTextColor: TColor read FDisabledTextColor write SetDisabledTextColor default clGrayText;
    property DisabledColor: TColor read FDisabledColor write SetDisabledColor default clWindow;
    property UseFixedPopup: Boolean read FUseFixedPopup write FUseFixedPopup default True;
    property HintColor;
    //property MaxPixel: TJvMaxPixel read FMaxPixel write FMaxPixel;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default -1;
    property OnParentColorChange;
    property Flat: Boolean read GetFlat write SetFlat {$IFDEF VisualCLX}default False;{$ENDIF VisualCLX}{$IFDEF VCL}stored IsFlatStored;{$ENDIF VCL}
  end;

  TTntJvEdit = class(TTntJvCustomEdit)
  published
    {$IFDEF VCL}
    {$IFDEF COMPILER6_UP}
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    {$ENDIF COMPILER6_UP}
    property BiDiMode;
    property DragCursor;
    property DragKind;
    property EmptyValue; // p3: clx not implemented yet
    property EmptyFontColor; // p3: clx not implemented yet
    property Flat;
    property ImeMode;
    property ImeName;
    property OEMConvert;
    property ParentBiDiMode;
    property ParentCtl3D;
    property UseFixedPopup; // asn: clx not implemented yet
    {$ENDIF VCL}
    //property Caret;
    property DisabledTextColor;
    property DisabledColor;
    property HotTrack;
    property PasswordChar;
    property PopupMenu;
    property ProtectPassword;
    {$IFDEF VisualCLX}
    property EchoMode;
    property InputKeys;
    {$ENDIF VisualCLX}
    property Align;
    property Alignment;
    property ClipboardCommands;
    property HintColor;
    property GroupIndex;
    //property MaxPixel;
    property Modified; { (rb) why published/stored? }
    {$IFDEF JVCLThemesEnabled}
    property ThemedPassword;
    {$ENDIF JVCLThemesEnabled}
    // property SelStart; (p3) why published?
    // property SelText;
    // property SelLength; (p3) why published?
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;

    property Anchors;
    property AutoSelect;
    property AutoSize;
    property AutoHint;
    property BorderStyle;
    property CharCase;
    property Color;
    property Constraints;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property MaxLength;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    {$IFDEF VCL}
    property OnEndDock;
    property OnStartDock;
    {$ENDIF VCL}
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: TntJvEdit.pas,v $';
    Revision: '$Revision: 1.68 $';
    Date: '$Date: 2005/03/09 22:50:44 $';
    LogPath: 'Tnt'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, Math, Forms,
  {$IFDEF VCL}
  JvFixedEditPopup,
  {$ENDIF VCL}
  TntJvToolEdit;

//=== Local procedures =======================================================

// (rom) StrFillChar replaced by StringOfChar

function TextFitsInCtrl(Control: TControl; const Text: WideString): Boolean;
var
  C: TControlCanvas;
  Size: TSize;
begin
  C := TControlCanvas.Create;
  try
    C.Control := Control;
    {$IFDEF VisualCLX}
    C.StartPaint;
    {$ENDIF VisualCLX}
    Result :=
      not GetTextExtentPoint32W(C.Handle, PWideChar(Text), Length(Text), Size) or
      { (rb) ClientWidth is too big, should be EM_GETRECT, don't know the Clx variant }
      (Control.ClientWidth > Size.cx);
    {$IFDEF VisualCLX}
    C.StopPaint;
    {$ENDIF VisualCLX}
  finally
    C.Free;
  end;
end;

//=== { TTntJvCustomEdit } ======================================================

constructor TTntJvCustomEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  {$IFDEF VisualCLX}
  FNullPixmap := QPixmap_create(1, 1, 1, QPixmapOptimization_DefaultOptim);
  {$ENDIF VisualCLX}
  FAlignment := taLeftJustify;
  // ControlStyle := ControlStyle + [csAcceptsControls];
  ClipboardCommands := [caCopy..caUndo];
  FDisabledColor := clWindow;
  FDisabledTextColor := clGrayText;
  FHotTrack := False;
  (**
  FCaret := TJvCaret.Create(Self);
  FCaret.OnChanged := CaretChanged;
  **)
  FStreamedSelLength := 0;
  FStreamedSelStart := 0;
  FUseFixedPopup := True; // asn: clx not implemented yet
  (**
  FMaxPixel := TJvMaxPixel.Create(Self);
  FMaxPixel.OnChanged := MaxPixelChanged;
  **)
  FGroupIndex := -1;
  FEmptyFontColor := clGrayText;
end;

destructor TTntJvCustomEdit.Destroy;
begin
  (**
  FMaxPixel.Free;
  FCaret.Free;
  {$IFDEF JVCLThemesEnabled}
  FThemedFont.Free;
  {$ENDIF JVCLThemesEnabled}
  {$IFDEF VisualCLX}
  QPixmap_destroy(FNullPixmap);
  {$ENDIF VisualCLX}
  **)
  inherited Destroy;
end;

(**
procedure TTntJvCustomEdit.CaretChanged(Sender: TObject);
begin
  FCaret.CreateCaret;
end;
**)

procedure TTntJvCustomEdit.Change;
var
  St: WideString;
  Sel: Integer;
begin
  inherited Change;
  if not HasParent then
    Exit;
  St := Text;
  //FMaxPixel.Test(St, Font);
  if St <> Text then
  begin
    Sel := SelStart;
    Text := St;
    SelStart := Min(Sel, Length(Text));
  end;
end;

{$IFDEF VCL}
procedure TTntJvCustomEdit.CMHintShow(var Msg: TMessage);
begin
  if AutoHint and not TextFitsInCtrl(Self, Self.Text) then
    with TCMHintShow(Msg) do
    begin
      HintInfo.HintPos := Self.ClientToScreen(Point(-2, Height - 2));
      HintInfo.HintStr := Self.Text;
      Result := 0;
    end
  else
    inherited;
end;
{$ENDIF VCL}

{$IFDEF VisualCLX}
function TTntJvCustomEdit.HintShow(var HintInfo: THintInfo): Boolean;
begin
  if AutoHint and not TextFitsInCtrl(Self, Self.Text) then
  begin
    HintInfo.HintPos := Self.ClientToScreen(Point(-2, Height - 2));
    HintInfo.HintStr := Self.Text;
  end;
  Result := inherited HintShow(HintInfo);
end;
{$ENDIF VisualCLX}

{$IFDEF VCL}
procedure TTntJvCustomEdit.CreateHandle;
begin
  inherited CreateHandle;
  if Focused then
    DoEmptyValueEnter
  else
    DoEmptyValueExit;
end;
{$ENDIF VCL}

{$IFDEF VisualCLX}
procedure TTntJvCustomEdit.InitWidget;
begin
  inherited InitWidget;
  if Focused then
    DoEmptyValueEnter
  else
    DoEmptyValueExit;
end;
{$ENDIF VisualCLX}

{$IFDEF VCL}

procedure TTntJvCustomEdit.CreateParams(var Params: TCreateParams);
const
  {$IFDEF JVCLThemesEnabled}
  Passwords: array [Boolean] of DWORD = (0, ES_PASSWORD);
  {$ENDIF JVCLThemesEnabled}
  Styles: array [TAlignment] of DWORD = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or Styles[FAlignment];
  {$IFDEF JVCLThemesEnabled}
  Params.Style := Params.Style or Passwords[ThemedPassword];
  {$ENDIF JVCLThemesEnabled}
  if (FAlignment <> taLeftJustify) and (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
    (Win32MajorVersion = 4) and (Win32MinorVersion = 0) then
    Params.Style := Params.Style or ES_MULTILINE; // needed for Win95
end;

procedure TTntJvCustomEdit.DefaultHandler(var Msg);
begin
  if ProtectPassword then
    with TMessage(Msg) do
      case Msg of
        WM_CUT, WM_COPY, WM_GETTEXT, WM_GETTEXTLENGTH, EM_SETPASSWORDCHAR:
          Result := 0;
      else
        inherited DefaultHandler(Msg);
      end
  else
    inherited DefaultHandler(Msg);
end;

procedure TTntJvCustomEdit.DestroyWnd;
var
  Tmp: Boolean;
begin
  Tmp := ProtectPassword;
  try
    // TWinControl.DestroyWnd sends WM_GETTEXTLENGTH & WM_GETTEXT messages,
    // thus we have to temporarily set ProtectPassword to False.
    ProtectPassword := False;
    inherited DestroyWnd;
  finally
    ProtectPassword := Tmp;
  end;
end;

{$ENDIF VCL}

procedure TTntJvCustomEdit.WMClear(var Msg: TMessage);
begin
  if not ReadOnly then
    inherited;
end;

procedure TTntJvCustomEdit.WMCut(var Msg: TMessage);
begin
  if not ReadOnly then
    inherited;
end;

procedure TTntJvCustomEdit.WMPaste(var Msg: TMessage);
begin
  if not ReadOnly then
  begin
    inherited;
    UpdateGroup;
  end;
end;