{==============================================================================

  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsEdits;

{$I KsCommonVer.Inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Classes, Messages, Graphics, Controls, Forms, StdCtrls, ExtCtrls, Mask,
  Menus, KsContnrs, KsBitmap, KsUtils, KsControls, KsMenus, KsItems, KsEffects;

type

  TEditCharCase = (ecNormal, ecUpperCase, ecLowerCase);
  TPasswordKind = (pkNone, pkChar, pkRect, pkRoundRect, pkCircle, pkTriangle);

  TActionType = (atDelete, atInsert);

  PEditAction = ^TEditAction;

  TEditAction = record
    ActionType : TActionType;

    PairedWithPriv : boolean;
    StartPosition : integer;
    DeletedFragment : string; {For atDelete}
    Length : integer; {For atInsert}
  end;

  TKsCustomEdit = class;

  TEditActionStack = class(TStack)
  private
    FOwner : TKsCustomEdit;
  public
    constructor Create(AOwner : TKsCustomEdit);
    destructor Destroy; override;

    procedure FragmentInserted(StartPos, FragmentLength : integer; IsPairedWithPriv : boolean);
    procedure FragmentDeleted(StartPos : integer; Fragment : string);
    procedure CaretMovedBy(Shift : integer);

    function RollBackAction : boolean;
  end;

  TKsCustomEdit = class(TKsCustomControl)
  private
    FLMouseSelecting: boolean;
    FCaretPosition: integer;
    FSelStart: integer;
    FSelLength: integer;
    FFirstVisibleChar: integer;
    FPopupMenu: TKsCustomPopupMenu;
    FAutoSelect: boolean;
    FCharCase: TEditCharCase;
    FHideSelection: Boolean;
    FMaxLength: Integer;
    FReadOnly: Boolean;
    FOnChange: TNotifyEvent;
    FPasswordChar: char;
    FTextAlignment: TAlignment;
    FActionStack : TEditActionStack;
    FPasswordKind: TPasswordKind;
    FBorderStyle: TBorderStyle;
    FPopupMenuDropShadow: boolean;
    FPopupMenuShowAnimationTime: integer;
    FPopupMenuBlendValue: integer;
    FPopupMenuShadowWidth: integer;
    FPopupMenuShowAnimation: TKsAnimation;
    FPopupMenuBlend: boolean;
    procedure SetText(const Value: TCaption);
    procedure SetFont(Value: TFont);
    procedure SetCaretPosition(const Value: integer);
    procedure SetSelLength(const Value: integer);
    procedure SetSelStart(const Value: integer);
    function GetSelStart: integer;
    function GetSelLength: integer;
    procedure UpdateFirstVisibleChar;
    function GetSelText: string;
    function GetVisibleSelText: string;
    procedure SetAutoSelect(const Value: boolean);
    procedure SetCharCase(const Value: TEditCharCase);
    procedure SetHideSelection(const Value: Boolean);
    procedure SetMaxLength(const Value: Integer);
    procedure SetPasswordChar(const Value: char);
    procedure SetCursor(const Value: TCursor);
    function GetNextWordBeging(StartPosition: integer): integer;
    function GetPrivWordBeging(StartPosition: integer): integer;
    procedure UpdateCaretePosition;
    procedure UpdateCarete;
    procedure SetTextAlignment(const Value: TAlignment);
    procedure SetPasswordKind(const Value: TPasswordKind);
    procedure SetBorderStyle(const Value: TBorderStyle);
    procedure SetPopupMenuBlendValue(const Value: integer);
    procedure SetPopupMenuDropShadow(const Value: boolean);
    procedure SetPopupMenuShadowWidth(const Value: integer);
    procedure SetPopupMenuShowAnimation(const Value: TKsAnimation);
    procedure SetPopupMenuShowAnimationTime(const Value: integer);
    procedure SetPopupMenuBlend(const Value: boolean);
  protected
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMCopy(var Message: TMessage); message WM_COPY;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMUnDo(var Message: TMessage); message WM_UNDO;
    procedure WMContexMenu(var Message: TMessage); message WM_CONTEXTMENU;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged(var Msg: TMessage); message CM_TEXTCHANGED;

    function GetEditRect: TRect; virtual;
    function GetPasswordCharWidth: integer; virtual;
    function GetCharX(a: integer): integer;
    function GetCoordinatePosition(x: integer): integer;
    function GetSelRect: TRect; virtual;
    function GetAlignmentFlags: integer;
    procedure PaintBuffer; override;
    procedure PaintText; virtual;
    procedure PaintBorder(Buffer: TKsBitmap); virtual;
    procedure PaintBackground(Rect: TRect; Buffer: TKsBitmap); virtual;
    procedure PaintSelectedText; virtual;
    procedure DrawPasswordChar(SymbolRect: TRect; Selected: boolean); virtual;
    function ValidText(NewText: string): boolean; virtual;
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure HasFocus; override;
    procedure KillFocus; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x, y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: integer); override;
    procedure MouseMove(Shift: TShiftState; x, y: integer); override;
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure SelectWord;
    procedure Change; dynamic;

    function CreatePopupMenu(AOwner: TComponent): TKsCustomPopupMenu; virtual;
    function CreatePopupMenuItem(AOwner: TComponent): TKsCustomItem; virtual;
    procedure BuildPopupMenu;
    procedure UpdatePopupMenuItems; virtual;
    procedure DoUndo(Sender: TObject);
    procedure DoCut(Sender: TObject);
    procedure DoCopy(Sender: TObject);
    procedure DoPaste(Sender: TObject);
    procedure DoDelete(Sender: TObject);
    procedure DoSelectAll(Sender: TObject);

    property CaretPosition: integer read FCaretPosition write SetCaretPosition;
    property PopupMenu: TKsCustomPopupMenu read FPopupMenu;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure ShowCaret; virtual;
    procedure HideCaret; virtual;

    procedure CopyToClipboard;
    procedure PasteFromClipboard;
    procedure CutToClipboard;
    procedure ClearSelection;
    procedure SelectAll;

    procedure UnDo;

    procedure InsertAfter(Position: integer; S: string; Selected: boolean);
    procedure DeleteFrom(Position, Length : integer; MoveCaret : boolean);

    property SelStart: integer read GetSelStart write SetSelStart;
    property SelLength: integer read GetSelLength write SetSelLength;
    property SelText: string read GetSelText;
  published
    property Anchors;
    property AutoSelect: boolean read FAutoSelect write SetAutoSelect default true;
    property AutoSize;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
    property Constraints;
    property Color;
    property Cursor write SetCursor;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ImeMode;
    property ImeName;
    property Font write SetFont;
    property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
    property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
    property ParentFont;
    property ParentShowHint;
    property PasswordKind: TPasswordKind read FPasswordKind write SetPasswordKind;
    property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
    property PopupMenuBlend: boolean read FPopupMenuBlend write SetPopupMenuBlend;
    property PopupMenuBlendValue: integer read FPopupMenuBlendValue write SetPopupMenuBlendValue;
    property PopupMenuDropShadow: boolean read FPopupMenuDropShadow write SetPopupMenuDropShadow;
    property PopupMenuShadowWidth: integer read FPopupMenuShadowWidth write SetPopupMenuShadowWidth;
    property PopupMenuShowAnimation: TKsAnimation read FPopupMenuShowAnimation write SetPopupMenuShowAnimation;
    property PopupMenuShowAnimationTime: integer read FPopupMenuShowAnimationTime write SetPopupMenuShowAnimationTime;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property ShowHint;
    property TabOrder;
    property TabStop default true;
    property Text write SetText;
    property TextAlignment : TAlignment read FTextAlignment write SetTextAlignment default taLeftJustify;

    property Visible;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick;
    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;

implementation {===============================================================}

uses ClipBrd, SysUtils, Consts;

{ TKsCustomEdit }

constructor TKsCustomEdit.Create(AOwner: TComponent);
begin
  inherited;
  FActionStack := TEditActionStack.Create(Self);

  TabStop := true;
  Width := 121;
  Height := 21;
  Color := clWindow;

  FTextAlignment := taLeftJustify;
  FAutoSelect := true;
  AutoSize := true;
  FCharCase := ecNormal;
  FHideSelection := true;
  FMaxLength := 0;
  FReadOnly := false;
  FPasswordChar := #0;
  FBorderStyle := bsSingle;

  FLMouseSelecting := false;

  FCaretPosition := 0;
  FSelStart := 0;
  FSelLength := 0;
  FFirstVisibleChar := 1;

  DoubleBuffered := true;
  ControlStyle := ControlStyle + [csCaptureMouse];

  FPopupMenuBlend := false;
  FPopupMenuBlendValue := 150;
  FPopupMenuDropShadow := true;
  FPopupMenuShadowWidth := 4;
  FPopupMenuShowAnimationTime := 300;

  Cursor := Cursor;
end;

destructor TKsCustomEdit.Destroy;
begin
  FActionStack.Free;
  if FPopupMenu <> nil then FPopupMenu.Free;
  inherited;
end;

procedure TKsCustomEdit.Loaded;
begin
  inherited;
  BuildPopupMenu;
end;

procedure TKsCustomEdit.HasFocus;
begin
  inherited;
  UpdateCarete;
  CaretPosition := 0;
  if AutoSelect then
    SelectAll;
end;

procedure TKsCustomEdit.KillFocus;
begin
  inherited;
  DestroyCaret;
  Invalidate;
end;

function TKsCustomEdit.GetCharX(a: integer): integer;
var
  WholeTextWidth : integer;
  EditRectWidth : integer;
begin
  Result := GetEditRect.Left;

  if PasswordKind <> pkNone then
    WholeTextWidth := Length(Text)*GetPasswordCharWidth
  else
    WholeTextWidth := Buffer.TextWidth(Copy(Text, 1, Length(Text)), DT_NOPREFIX);

  if a > 0 then
  begin
    Buffer.Font.Assign(ControlFont);
    if PasswordKind <> pkNone then
    begin
      if a <= Length(Text) then
        Result := Result + (a - FFirstVisibleChar + 1) * GetPasswordCharWidth
      else
        Result := Result + (Length(Text) - FFirstVisibleChar + 1) * GetPasswordCharWidth;
    end
    else
    begin
      if a <= Length(Text) then
        Result := Result + Buffer.TextWidth(Copy(Text, FFirstVisibleChar, a - FFirstVisibleChar + 1), DT_NOPREFIX)
      else
        Result := Result + Buffer.TextWidth(Copy(Text, FFirstVisibleChar, Length(Text) - FFirstVisibleChar + 1), DT_NOPREFIX);
    end;
  end;

  EditRectWidth := GetEditRect.Right - GetEditRect.Left;
  if WholeTextWidth < EditRectWidth then
    case TextAlignment of
      taRightJustify : Result := Result + (EditRectWidth-WholeTextWidth);
      taCenter : Result := Result + ((EditRectWidth-WholeTextWidth) div 2);
    end;
end;

function TKsCustomEdit.GetCoordinatePosition(x: integer): integer;
var
  CurX: double;
  TmpX,
  WholeTextWidth,
  EditRectWidth : integer;
begin
  Result := FFirstVisibleChar - 1;
  if Length(Text) = 0 then
    Exit;

  if PasswordKind <> pkNone then
    WholeTextWidth := Length(Text)*GetPasswordCharWidth
  else
    WholeTextWidth := Buffer.TextWidth(Copy(Text, 1, Length(Text)), DT_NOPREFIX);

  EditRectWidth := GetEditRect.Right - GetEditRect.Left;
  TmpX := x;
  if WholeTextWidth < EditRectWidth then
    case TextAlignment of
      taRightJustify : TmpX := x - (EditRectWidth-WholeTextWidth);
      taCenter : TmpX := x - ((EditRectWidth-WholeTextWidth) div 2);
    end;

  if PasswordKind <> pkNone then
  begin
    Result := Result + (TmpX - GetEditRect.Left) div GetPasswordCharWidth;
    if Result < 0 then
      Result := 0
    else
      if Result > Length(Text) then
        Result := Length(Text);
  end
  else
  begin
    Buffer.Font.Assign(ControlFont);
    CurX := GetEditRect.Left + Buffer.TextWidth(Text[FFirstVisibleChar], DT_NOPREFIX) / 2;
    while (CurX < TmpX) and (Result + 1 <= Length(Text)) and (CurX < GetEditRect.Right) do
    begin
      CurX := CurX + Buffer.TextWidth(Text[Result + 1], DT_NOPREFIX) / 2;
      if Result + 1 + 1 <= Length(Text) then
        CurX := CurX + Buffer.TextWidth(Text[Result + 1 + 1], DT_NOPREFIX) / 2;
      Result := Result + 1;
    end;
  end;
end;

function TKsCustomEdit.GetEditRect: TRect;
begin
  with Result do
  begin
    if FBorderStyle = bsSingle then
    begin
      Result.Left := 4;
      Result.Top := 4;
      Result.Right := FWidth - 4;
    end
    else
    begin
      Result.Left := 2;
      Result.Top := 2;
      Result.Right := FWidth - 2;
    end;

    Buffer.Font.Assign(ControlFont);
    Result.Bottom := Result.Top + Buffer.TextHeight('Pq');
  end;
end;

function TKsCustomEdit.GetAlignmentFlags: integer;
begin
  case FTextAlignment of
    taCenter: Result := DT_CENTER;
    taRightJustify: Result := DT_RIGHT;
  else
    Result := DT_LEFT;
  end;
end;

procedure TKsCustomEdit.KeyDown(var Key: word; Shift: TShiftState);
var
  TmpS: string;
  OldCaretPosition: integer;
begin
  inherited KeyDown(Key, Shift);
  OldCaretPosition := CaretPosition;
  case Key of
    VK_END: CaretPosition := Length(Text);
    VK_HOME: CaretPosition := 0;
    VK_LEFT:
      if ssCtrl in Shift then
        CaretPosition := GetPrivWordBeging(CaretPosition)
      else
        CaretPosition := CaretPosition - 1;
    VK_RIGHT:
      if ssCtrl in Shift then
        CaretPosition := GetNextWordBeging(CaretPosition)
      else
        CaretPosition := CaretPosition + 1;
    VK_DELETE, 8: {Delete or BackSpace key was pressed}
      if not ReadOnly then
      begin
        if SelLength <> 0 then
        begin
          if Shift = [ssShift] then
            CutToClipboard
          else
            ClearSelection;
        end
        else
        begin
          TmpS := Text;
          if TmpS <> '' then
            if Key = VK_DELETE then
            begin
              FActionStack.FragmentDeleted(CaretPosition + 1,TmpS[CaretPosition + 1]);
              Delete(TmpS, CaretPosition + 1, 1);
            end
            else
            begin {BackSpace key was pressed}
              if CaretPosition > 0 then
                FActionStack.FragmentDeleted(CaretPosition,TmpS[CaretPosition]);
              Delete(TmpS, CaretPosition, 1);
              CaretPosition := CaretPosition - 1;
            end;
          Text := TmpS;
        end;
      end;
    VK_INSERT:
      if Shift = [ssCtrl] then
        CopyToClipboard
      else
        if Shift = [ssShift] then
          PasteFromClipboard;
    Ord('c'),
      Ord('C'):
      if Shift = [ssCtrl] then
        CopyToClipboard;
    Ord('v'),
      Ord('V'):
      if Shift = [ssCtrl] then
        PasteFromClipboard;
    Ord('x'),
      Ord('X'):
      if Shift = [ssCtrl] then
        CutToClipboard;
    Ord('z'), Ord('Z'):
      if Shift = [ssCtrl] then
        UnDo;
  end;

  if Key in [VK_END, VK_HOME, VK_LEFT, VK_RIGHT] then
  begin
    if ssShift in Shift then
    begin
      if SelLength = 0 then
        FSelStart := OldCaretPosition;
      FSelStart := CaretPosition;
      FSelLength := FSelLength - (CaretPosition - OldCaretPosition);
    end
    else
      FSelLength := 0;
    Invalidate;
  end;
  UpdateCaretePosition;
end;

procedure TKsCustomEdit.KeyPress(var Key: Char);
var
  TmpS: string;
begin
  inherited KeyPress(Key);
  
  if (Ord(Key) >= 32) and not ReadOnly then
  begin
    TmpS := Text;
    FActionStack.FragmentDeleted(SelStart + 1,
                                 Copy(TmpS,SelStart+1,SelLength));
    Delete(TmpS, SelStart + 1, SelLength);
    FActionStack.FragmentInserted(SelStart+1,1,SelLength > 0);
    Insert(Key, TmpS, SelStart + 1);
    if (MaxLength <= 0) or (Length(TmpS) <= MaxLength) then
    begin
      Text := TmpS;
      CaretPosition := SelStart + 1;
    end;
    SelLength := 0;
  end;
end;

procedure TKsCustomEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
  x, y: integer);
begin
  inherited;
  if Button = mbLeft then
    FLMouseSelecting := true;

  SetFocus;

  if Button = mbLeft then
  begin
    CaretPosition := GetCoordinatePosition(x);
    SelLength := 0;
  end;
end;

procedure TKsCustomEdit.PaintBuffer;
var
  R: TRect;
begin
  inherited ;
  
  with Buffer do
  begin
    R := GetEditRect;
    R.Bottom := FHeight - R.Top;
    InflateRect(R, 1, 1);
    PaintBackground(R, Buffer);

    PaintBorder(Buffer);

    if Focused or not HideSelection then
      FillRect(GetSelRect, KColor(clHighlight));

    PaintText;

    if Focused or not HideSelection then
      PaintSelectedText;
  end;
end;

procedure TKsCustomEdit.PaintBackground(Rect: TRect; Buffer: TKsBitmap);
begin
  Buffer.FillRect(Rect, KColor(Color));
end;

procedure TKsCustomEdit.PaintBorder(Buffer: TKsBitmap);
var
  TmpRect: TRect;
begin
  if FBorderStyle = bsNone then Exit;
  
  with Buffer do
  begin
    { Draw Frame }
    TmpRect := Rect(0, 0, FWidth, FHeight);
    DrawEdge(TmpRect, KColor(clBtnShadow), KColor(clBtnHighlight));
    InflateRect(TmpRect, -1, -1);
    DrawEdge(TmpRect, KColor(cl3DDkShadow), KColor(cl3DLight));
  end;
end;

procedure TKsCustomEdit.PaintText;
var
  TmpRect: TRect;
  CurChar: integer;
  LPWCharWidth: integer;
begin
  TmpRect := GetEditRect;

  if PasswordKind <> pkNone then
  begin
    LPWCharWidth := GetPasswordCharWidth;
    for CurChar := 0 to Length(Text) - FFirstVisibleChar + 1 - 1 do
      DrawPasswordChar(Rect(CurChar * LPWCharWidth+GetCharX(0),
        TmpRect.Top,
        (CurChar+1) * LPWCharWidth+GetCharX(0),
        TmpRect.Bottom), false);
  end
  else
  begin
    Buffer.Font.Assign(ControlFont);
    Buffer.DrawText(Copy(Text, FFirstVisibleChar, Length(Text) - FFirstVisibleChar + 1),
      TmpRect, GetAlignmentFlags or DT_NOPREFIX);
  end;
end;

procedure TKsCustomEdit.UpdateFirstVisibleChar;
var
  LEditRect: TRect;
begin
  if FFirstVisibleChar >= (FCaretPosition + 1) then
  begin
    FFirstVisibleChar := FCaretPosition;
    if FFirstVisibleChar < 1 then
      FFirstVisibleChar := 1;
  end
  else
  begin
    LEditRect := GetEditRect;

    if PasswordKind <> pkNone then
      while ((FCaretPosition - FFirstVisibleChar + 1) * GetPasswordCharWidth >
        LEditRect.Right - LEditRect.Left)
        and (FFirstVisibleChar < Length(Text)) do
        Inc(FFirstVisibleChar)
    else
    begin
      Buffer.Font.Assign(ControlFont);
      while (Buffer.TextWidth(Copy(Text, FFirstVisibleChar, FCaretPosition - FFirstVisibleChar + 1), DT_NOPREFIX) > LEditRect.Right - LEditRect.Left)
        and (FFirstVisibleChar < Length(Text)) do
        Inc(FFirstVisibleChar);
    end;
  end;
  Invalidate;
end;

procedure TKsCustomEdit.MouseMove(Shift: TShiftState; x, y: integer);
var
  OldCaretPosition: integer;
  TmpNewPosition : integer;
begin
  inherited;
  if FLMouseSelecting then
  begin
    TmpNewPosition := GetCoordinatePosition(x);
    OldCaretPosition := CaretPosition;
    if (x > GetEditRect.Right) then
      CaretPosition := TmpNewPosition +1
    else
      CaretPosition := TmpNewPosition;
    if SelLength = 0 then
      FSelStart := OldCaretPosition;
    FSelStart := CaretPosition;
    FSelLength := FSelLength - (CaretPosition - OldCaretPosition);
  end;
end;

procedure TKsCustomEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
  x, y: integer);
begin
  inherited;
  FLMouseSelecting := false;
end;

procedure TKsCustomEdit.CopyToClipboard;
begin
  if PasswordKind = pkNone then
    if SelText <> '' then
      ClipBoard.AsText := SelText;
end;

procedure TKsCustomEdit.PasteFromClipboard;
var
  TmpS, Insertion: string;
begin
  if ReadOnly then Exit;

  TmpS := Text;
  FActionStack.FragmentDeleted(SelStart + 1,
                               Copy(TmpS,SelStart+1,SelLength));
  Delete(TmpS, SelStart + 1, SelLength);
  Insertion := ClipBoard.AsText;
  if MaxLength > 0 then
    Insertion := Copy(Insertion, 1, MaxLength - Length(TmpS));
  FActionStack.FragmentInserted(SelStart+1,Length(Insertion), SelLength <> 0);
  Insert(Insertion, TmpS, SelStart + 1);
  Text := TmpS;
  CaretPosition := SelStart + Length(Insertion);
  SelLength := 0;
end;

procedure TKsCustomEdit.PaintSelectedText;
var
  TmpRect: TRect;
  CurChar: integer;
  LPWCharWidth: integer;
begin
  TmpRect := GetSelRect;

  if PasswordKind <> pkNone then
  begin
    LPWCharWidth := GetPasswordCharWidth;
    for CurChar := 0 to Length(GetVisibleSelText) - 1 do
      DrawPasswordChar(Rect(CurChar * LPWCharWidth + TmpRect.Left,
        TmpRect.Top,
        (CurChar + 1) * LPWCharWidth + TmpRect.Left,
        TmpRect.Bottom),
        true);
  end
  else
  begin
    Buffer.Font.Assign(ControlFont);
    Buffer.Font.Color := clHighlightText;
    Buffer.DrawText(GetVisibleSelText, TmpRect, GetAlignmentFlags or DT_NOPREFIX)
  end;
end;

function TKsCustomEdit.GetVisibleSelText: string;
begin
  if SelStart + 1 >= FFirstVisibleChar then
    Result := SelText
  else
    Result := Copy(SelText, FFirstVisibleChar - SelStart, Length(SelText) - (FFirstVisibleChar - SelStart) + 1);
end;

procedure TKsCustomEdit.BuildPopupMenu;
var
  TmpItem: TKsCustomItem;
begin
  FPopupMenu := CreatePopupMenu(Self);

  if FPopupMenu = nil then Exit;

  TmpItem := CreatePopupMenuItem(FPopupMenu);
  with TmpItem do
  begin
    Caption := 'Undo';
    OnClick := DoUndo;
  end;
  FPopupMenu.Items.Add(TmpItem);

  TmpItem := CreatePopupMenuItem(FPopupMenu);
  TmpItem.Caption := '-';
  FPopupMenu.Items.Add(TmpItem);

  TmpItem := CreatePopupMenuItem(FPopupMenu);
  with TmpItem do
  begin
    Caption := 'Cut';
    OnClick := DoCut;
  end;
  FPopupMenu.Items.Add(TmpItem);

  TmpItem := CreatePopupMenuItem(FPopupMenu);
  with TmpItem do
  begin
    Caption := 'Copy';
    OnClick := DoCopy;
  end;
  FPopupMenu.Items.Add(TmpItem);

  TmpItem := CreatePopupMenuItem(FPopupMenu);
  with TmpItem do
  begin
    Caption := 'Paste';
    OnClick := DoPaste;
  end;
  FPopupMenu.Items.Add(TmpItem);

  TmpItem := CreatePopupMenuItem(FPopupMenu);
  with TmpItem do
  begin
    Caption := 'Delete';
    OnClick := DoDelete;
  end;
  FPopupMenu.Items.Add(TmpItem);

  TmpItem := CreatePopupMenuItem(FPopupMenu);
  TmpItem.Caption := '-';
  FPopupMenu.Items.Add(TmpItem);

  TmpItem := CreatePopupMenuItem(FPopupMenu);
  with TmpItem do
  begin
    Caption := 'Select All';
    OnClick := DoSelectAll;
  end;
  FPopupMenu.Items.Add(TmpItem);
end;

function TKsCustomEdit.CreatePopupMenu(AOwner: TComponent): TKsCustomPopupMenu;
begin
  Result := TKsCustomPopupMenu.Create(AOwner);
end;

function TKsCustomEdit.CreatePopupMenuItem(AOwner: TComponent): TKsCustomItem;
begin
  Result := TKsCustomItem.Create(Self);
end;

procedure TKsCustomEdit.DoCut(Sender: TObject);
begin
  CutToClipboard;
end;

procedure TKsCustomEdit.DoCopy(Sender: TObject);
begin
  CopyToClipboard;
end;

procedure TKsCustomEdit.DoDelete(Sender: TObject);
begin
  ClearSelection;
end;

procedure TKsCustomEdit.DoPaste(Sender: TObject);
begin
  PasteFromClipboard;
end;

procedure TKsCustomEdit.UpdatePopupMenuItems;
 function SetItemEnabled(Event: TNotifyEvent; AEnabled: boolean): TKsCustomItem;
 var
   Item: TKsCustomItem;
 begin
   Item := FPopupMenu.Items.FindItem(Integer(@Event), fkHandle);
   if Item <> nil then
     Item.Enabled := AEnabled;
 end;
var
  SelTextEmpty: boolean;
begin
  SelTextEmpty := SelText <> '';

  SetItemEnabled(DoUndo, FActionStack.AtLeast(1) and not ReadOnly);
  SetItemEnabled(DoCut, SelTextEmpty and (not (PasswordKind <> pkNone)) and not ReadOnly);
  SetItemEnabled(DoCopy, SelTextEmpty and not (PasswordKind <> pkNone));
  SetItemEnabled(DoPaste, (ClipBoard.AsText <> '') and not ReadOnly);
  SetItemEnabled(DoDelete, SelTextEmpty and not ReadOnly);
  SetItemEnabled(DoSelectAll, SelText <> Text);

  { Set Properties }
  FPopupMenu.PopupBlend := FPopupMenuBlend;
  FPopupMenu.PopupBlendValue := FPopupMenuBlendValue;
  FPopupMenu.DropShadow := FPopupMenuDropShadow;
  FPopupMenu.ShadowWidth := FPopupMenuShadowWidth;
  FPopupMenu.ShowAnimation := FPopupMenuShowAnimation;
  FPopupMenu.ShowAnimationTime := FPopupMenuShowAnimationTime;
end;

function TKsCustomEdit.GetNextWordBeging(StartPosition: integer): integer;
var
  SpaceFound,
    WordFound: boolean;
begin
  Result := StartPosition;
  SpaceFound := false;
  WordFound := false;
  while (Result + 2 <= Length(Text)) and
    ((not ((Text[Result + 1] <> ' ') and SpaceFound))
    or not WordFound) do
  begin
    if Text[Result + 1] = ' ' then
      SpaceFound := true;
    if Text[Result + 1] <> ' ' then begin
      WordFound := true;
      SpaceFound := false;
    end;

    Result := Result + 1;
  end;
  if not SpaceFound then
    Result := Result + 1;
end;

function TKsCustomEdit.GetPrivWordBeging(StartPosition: integer): integer;
var
  WordFound: boolean;
begin
  Result := StartPosition;
  WordFound := false;
  while (Result > 0) and
    ((Text[Result] <> ' ') or not WordFound) do
  begin
    if Text[Result] <> ' ' then
      WordFound := true;
    Result := Result - 1;
  end;
end;


procedure TKsCustomEdit.ClearSelection;
var
  TmpS: string;
begin
  if ReadOnly then Exit;

  TmpS := Text;
  FActionStack.FragmentDeleted(SelStart+1,
                               Copy(TmpS,SelStart+1,SelLength));
  Delete(TmpS, SelStart + 1, SelLength);
  Text := TmpS;
  CaretPosition := SelStart;
  SelLength := 0;
end;

procedure TKsCustomEdit.CutToClipboard;
begin
  if PasswordKind = pkNone then
    CopyToClipboard;
  ClearSelection;
end;

procedure TKsCustomEdit.SelectAll;
begin
  SetCaretPosition(Length(Text));
  SelStart := 0;
  SelLength := Length(Text);
  Invalidate;
end;

procedure TKsCustomEdit.DoSelectAll(Sender: TObject);
begin
  SelectAll;
end;

procedure TKsCustomEdit.DrawPasswordChar(SymbolRect: TRect; Selected: boolean);
var
  R: TRect;
  Rgn: HRgn;
begin
  { !!! Don't forget include clipping rountines
        Char symbol image must not extend out of EditRect}

  Rgn := CreateRectRgn(SymbolRect.Left, SymbolRect.Top, SymbolRect.Right, SymbolRect.Bottom);
  try
    SelectClipRgn(Buffer.DC, Rgn);

    Buffer.Font.Assign(ControlFont);
    if Selected then
      Buffer.Font.Color := clHighlightText;

    R := SymbolRect;
    InflateRect(R, -2, -3);

    case FPasswordKind of
      pkChar: Buffer.DrawText(PasswordChar, SymbolRect, DT_LEFT or DT_NOPREFIX);
      pkRect: Buffer.FillRect(R, KColor(Buffer.Font.Color));
      pkRoundRect: Buffer.FillRoundRect(R, 2, KColor(Buffer.Font.Color));
      pkCircle: begin
        R := Rect(0, 0, RectWidth(R), RectWidth(R));
        RectCenter(R, SymbolRect);

        Buffer.FillRoundRect(R, RectWidth(R) div 2 + 1, KColor(Buffer.Font.Color));
      end;
      pkTriangle: begin
        R := Rect(0, 0, RectWidth(R), RectWidth(R));
        if not Odd(RectWidth(R)) then
          R.Right := R.Right + 1;
        RectCenter(R, SymbolRect);

        Buffer.FillPolygon([
          Point(R.Left + RectWidth(R) div 2 + 1, R.Top),
          Point(R.Right, R.Bottom),
          Point(R.Left, R.Bottom) 
          ], KColor(Buffer.Font.Color));
      end;
    end;
  finally
    SelectClipRgn(Buffer.DC, 0);
    DeleteObject(Rgn);
  end;
end;

function TKsCustomEdit.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := True;
  Buffer.Font.Assign(ControlFont);
  NewHeight := Buffer.TextHeight('Pq') + GetEditRect.Top*2;
end;

procedure TKsCustomEdit.SelectWord;
begin
  SelStart := GetPrivWordBeging(CaretPosition); ;
  SelLength := GetNextWordBeging(SelStart) - SelStart;
  CaretPosition := SelStart + SelLength;
end;

procedure TKsCustomEdit.UpdateCarete;
begin
  Buffer.Font.Assign(ControlFont);
  CreateCaret(Handle, 0, 0, Buffer.TextHeight('Pq'));
  CaretPosition := CaretPosition;
  ShowCaret;
end;

procedure TKsCustomEdit.HideCaret;
begin
  Windows.HideCaret(Handle);
end;

procedure TKsCustomEdit.ShowCaret;
begin
  Windows.ShowCaret(Handle);
end;

function TKsCustomEdit.GetPasswordCharWidth: integer;
begin
  Buffer.Font.Assign(ControlFont);

  case FPasswordKind of
    pkChar: Result := Buffer.TextWidth(FPasswordChar, DT_NOPREFIX);
    pkRect, pkRoundRect, pkCircle, pkTriangle: Result := Buffer.TextWidth('W', DT_NOPREFIX);
  else
    Result := 10;
  end;

  if Result = 0 then Result := 1;
end;

procedure TKsCustomEdit.Change;
begin
  inherited Changed;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TKsCustomEdit.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  inherited;
  Msg.Result := dlgc_WantArrows or DLGC_WANTCHARS;
end;

procedure TKsCustomEdit.WMCut(var Message: TMessage);
begin
  CutToClipboard;
end;

procedure TKsCustomEdit.WMCopy(var Message: TMessage);
begin
  CopyToClipboard;
end;

procedure TKsCustomEdit.WMPaste(var Message: TMessage);
begin
  PasteFromClipboard;
end;

procedure TKsCustomEdit.WMContexMenu(var Message: TMessage);
var
  LForm: TCustomForm;
begin
  inherited;

  if csDesigning in ComponentState then Exit;

  UpdatePopupMenuItems;

  LForm := GetParentForm(Self);
  if LForm <> nil then
    LForm.SendCancelMode(nil);

  FPopupMenu.PopupComponent := Self;

  with Message do
    FPopUpMenu.Popup(LParamLo, LParamHi);
end;

procedure TKsCustomEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  inherited;
  FLMouseSelecting := false;
  SelectWord;
end;

procedure TKsCustomEdit.CMFontChanged(var Message: TMessage);
begin
  inherited;
  AdjustSize;
  UpdateCarete;
end;

procedure TKsCustomEdit.SetFont(Value: TFont);
begin
  inherited Font := Value;
  AdjustSize;
end;

procedure TKsCustomEdit.SetText(const Value: TCaption);
var
  TmpS: string;
  LOldText: string;
begin
  if not ValidText(Value) then
    Exit;

  TmpS := Value;
  LOldText := Text;

  if (Value <> '') and (CharCase <> ecNormal) then
    case CharCase of
      ecUpperCase: inherited Text := string(CharUpper(PChar(TmpS)));
      ecLowerCase: inherited Text := string(CharLower(PChar(TmpS)));
    end
  else
    inherited Text := TmpS;

  Invalidate;

  if Text <> LOldText then
    Change;
end;

procedure TKsCustomEdit.SetCaretPosition(const Value: integer);
begin
  if Value < 0 then
    FCaretPosition := 0
  else
    if Value > Length(Text) then
      FCaretPosition := Length(Text)
    else
      FCaretPosition := Value;

  UpdateFirstVisibleChar;

  if SelLength <= 0 then
    FSelStart := Value;

  if Focused then
    SetCaretPos(GetCharX(FCaretPosition), GetEditRect.Top);
end;

procedure TKsCustomEdit.SetPasswordChar(const Value: Char);
begin
  if FPasswordChar <> Value then
  begin
    if Value <> #0 then
      FPasswordKind := pkChar;
      
    FPasswordChar := Value;
    Invalidate;
    CaretPosition := CaretPosition; //Update caret position
  end;
end;

procedure TKsCustomEdit.SetSelLength(const Value: integer);
begin
  if FSelLength <> Value then
  begin
    FSelLength := Value;
    Invalidate;
  end;
end;

procedure TKsCustomEdit.SetSelStart(const Value: integer);
begin
  if FSelStart <> Value then
  begin
    SelLength := 0;
    FSelStart := Value;
    CaretPosition := FSelStart;
    Invalidate;
  end;
end;

procedure TKsCustomEdit.SetAutoSelect(const Value: boolean);
begin
  if FAutoSelect <> Value then
    FAutoSelect := Value;
end;

function TKsCustomEdit.GetSelStart: integer;
begin
  if FSelLength > 0 then
    Result := FSelStart
  else
    if FSelLength < 0 then
      Result := FSelStart + FSelLength
    else
      Result := CaretPosition;
end;

function TKsCustomEdit.GetSelRect: TRect;
begin
  Result := GetEditRect;
  Result.Left := GetCharX(SelStart);
  Result.Right := GetCharX(SelStart + SelLength);
  IntersectRect(Result, Result, GetEditRect);
end;

function TKsCustomEdit.GetSelLength: integer;
begin
  Result := Abs(FSelLength);
end;

function TKsCustomEdit.GetSelText: string;
begin
  Result := Copy(Text, SelStart + 1, SelLength);
end;

procedure TKsCustomEdit.SetCharCase(const Value: TEditCharCase);
var
  TmpS: string;
begin
  if FCharCase <> Value then
  begin
    FCharCase := Value;
    if Text <> '' then
    begin
      TmpS := Text;
      case Value of
        ecUpperCase: Text := string(CharUpper(PChar(TmpS)));
        ecLowerCase: Text := string(CharLower(PChar(TmpS)));
      end;
    end;
  end;
end;

procedure TKsCustomEdit.SetHideSelection(const Value: Boolean);
begin
  if FHideSelection <> Value then
  begin
    FHideSelection := Value;
    Invalidate;
  end;
end;

procedure TKsCustomEdit.SetMaxLength(const Value: Integer);
begin
  if FMaxLength <> Value then
  begin
    FMaxLength := Value;
  end;
end;

procedure TKsCustomEdit.SetCursor(const Value: TCursor);
begin
  if Value = crDefault then
    inherited Cursor := crIBeam
  else
    inherited Cursor := Value;
end;

function TKsCustomEdit.ValidText(NewText: string): boolean;
begin
  Result := true;
end;

procedure TKsCustomEdit.SetTextAlignment(const Value: TAlignment);
begin
  if FTextAlignment <> Value then begin
    FTextAlignment := Value;
    Invalidate;
  end;
end;

procedure TKsCustomEdit.UpdateCaretePosition;
begin
  SetCaretPosition(CaretPosition);
end;

procedure TKsCustomEdit.InsertAfter(Position: integer; S: string;
  Selected: boolean);
var
  TmpS : string;
  Insertion : string;
begin
  TmpS := Text;
  Insertion := S;
  if MaxLength > 0 then
    Insertion := Copy(Insertion, 1, MaxLength - Length(TmpS));
  Insert(Insertion, TmpS, Position+1);
  Text := TmpS;
  if Selected then begin
    SelStart := Position;
    SelLength := Length(Insertion);
    CaretPosition := SelStart + SelLength;
  end;
end;

procedure TKsCustomEdit.DeleteFrom(Position, Length: integer; MoveCaret : boolean);
var
  TmpS : string;
begin
  TmpS := Text;
  Delete(TmpS,Position,Length);
  Text := TmpS;
  if MoveCaret then begin
    SelLength := 0;
    SelStart := Position-1;
  end;
end;

procedure TKsCustomEdit.DoUndo(Sender: TObject);
begin
  UnDo;
end;

procedure TKsCustomEdit.WMUnDo(var Message: TMessage);
begin
  UnDo;
end;

procedure TKsCustomEdit.UnDo;
begin
  FActionStack.RollBackAction;
end;

procedure TKsCustomEdit.SetPasswordKind(const Value: TPasswordKind);
begin
  if FPasswordKind <> Value then
  begin
    FPasswordKind := Value;
    Invalidate;
  end;
end;

procedure TKsCustomEdit.SetBorderStyle(const Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    Realign;
    Invalidate;
  end;
end;

procedure TKsCustomEdit.SetPopupMenuBlendValue(const Value: integer);
begin
  FPopupMenuBlendValue := Value;
end;

procedure TKsCustomEdit.SetPopupMenuDropShadow(const Value: boolean);
begin
  FPopupMenuDropShadow := Value;
end;

procedure TKsCustomEdit.SetPopupMenuShadowWidth(const Value: integer);
begin
  FPopupMenuShadowWidth := Value;
end;

procedure TKsCustomEdit.SetPopupMenuShowAnimation(
  const Value: TKsAnimation);
begin
  FPopupMenuShowAnimation := Value;
end;

procedure TKsCustomEdit.SetPopupMenuShowAnimationTime(
  const Value: integer);
begin
  FPopupMenuShowAnimationTime := Value;
end;

procedure TKsCustomEdit.CMTextChanged(var Msg: TMessage);
begin
  inherited;
  SelLength := 0;
  Invalidate;
end;

{ TEditActionStack ============================================================}

constructor TEditActionStack.Create(AOwner: TKsCustomEdit);
begin
  inherited Create;
  FOwner := AOwner;
end;

destructor TEditActionStack.Destroy;
var
  TmpItem : PEditAction;
begin
  while AtLeast(1) do begin
    TmpItem := Pop;
    Finalize(TmpItem^);
    FreeMem(TmpItem);
  end;
  inherited;
end;

procedure TEditActionStack.FragmentDeleted(StartPos: integer;
  Fragment: string);
var
  TmpItem : PEditAction;
begin
  if Fragment = '' then Exit;

  if (not AtLeast(1)) or
      not ((PEditAction(Peek)^.ActionType=atDelete) and
           (PEditAction(Peek)^.StartPosition-StartPos-Length(Fragment) <= 1) and
           (PEditAction(Peek)^.StartPosition-StartPos >= 0)) then
  begin

    New(TmpItem);
    Initialize(TmpItem^);
    Push(TmpItem);

    with TmpItem^ do begin
      ActionType := atDelete;
      StartPosition := StartPos;
      DeletedFragment := Fragment;
      PairedWithPriv := false;
    end;
  end
  else
    case PEditAction(Peek)^.ActionType of
      atDelete : begin
        if StartPos > 0 then begin
          if StartPos < PEditAction(Peek)^.StartPosition then
            PEditAction(Peek)^.DeletedFragment := Fragment+PEditAction(Peek)^.DeletedFragment
          else
            PEditAction(Peek)^.DeletedFragment := PEditAction(Peek)^.DeletedFragment+Fragment;
          PEditAction(Peek)^.StartPosition := StartPos;
        end;
      end;
    end;
end;

procedure TEditActionStack.FragmentInserted(StartPos, FragmentLength: integer; IsPairedWithPriv : boolean);
var
  TmpItem : PEditAction;
begin
  if FragmentLength = 0 then Exit;

  if (not AtLeast(1)) or
      not ((PEditAction(Peek)^.ActionType=atInsert) and
           (PEditAction(Peek)^.StartPosition+PEditAction(Peek)^.Length =StartPos)) then
  begin
    New(TmpItem);
    Initialize(TmpItem^);
    Push(TmpItem);
    with TmpItem^ do begin
      ActionType := atInsert;
      StartPosition := StartPos;
      Length := FragmentLength;
      PairedWithPriv := IsPairedWithPriv;
    end;
  end else
    case PEditAction(Peek)^.ActionType of
      atInsert : PEditAction(Peek)^.Length := PEditAction(Peek)^.Length+FragmentLength;
    end;
end;

procedure TEditActionStack.CaretMovedBy(Shift: integer);
begin

end;

function TEditActionStack.RollBackAction: boolean;
var
  TmpItem : PEditAction;
  WasPaired : boolean;
begin
  Result := AtLeast(1);
  if not(Result and Assigned(FOwner)) then Exit;

  repeat
    TmpItem := Pop;
    with TmpItem^, FOwner do
      case ActionType of
        atDelete : InsertAfter(StartPosition-1,DeletedFragment,true);
        atInsert : DeleteFrom(StartPosition,Length,true);
      end;
    WasPaired := TmpItem^.PairedWithPriv;
    Finalize(TmpItem^);
    Dispose(TmpItem);
  until not WasPaired;
end;

procedure TKsCustomEdit.SetPopupMenuBlend(const Value: boolean);
begin
  FPopupMenuBlend := Value;
end;

end.
