
{*******************************************************}
{                                                       }
{       ScaleRichView                                   }
{       The given component represents TEdit for work   }
{       with ScaleRichView.                             }
{                                                       }
{       Copyright (c) Ilya Zelenskiy                    }
{       Ilya.Zelenskiy@gmail.com                        }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

unit SRVEdit;

interface
{$I RV_Defs.inc}
uses
  Windows, Messages, Forms, Graphics, Controls, Classes, SysUtils,
  SRVControl, RVUni, RVScroll, RVItem, RVTypes;

type
  TSRVEditCharCase = (srvecNormal, srvecUpperCase, srvecLowerCase);

  TSRVEdit = class(TSRVEditControl)
  private
    indexPos1 : Integer;
    indexPos2 : Integer;
    iSel1 : Integer;
    iSel2 : Integer;
    FAutoSize: Boolean;
    FMaxLength: Integer;
    FPasswordChar: Char;
    FReadOnly: Boolean;
    FCharCase: TSRVEditCharCase;
    FCreating: Boolean;
    FModified: Boolean;
    FOnChange: TNotifyEvent;
    FStartX: Integer;
    ClickState: Integer;
    function GetModified: Boolean;
    function GetCanUndo: Boolean;
    procedure SetAutoSize(NewAutoSize: Boolean); reintroduce;
    procedure SetCharCase(NewCharCase: TSRVEditCharCase);
    procedure SetMaxLength(NewMaxLength: Integer);
    procedure SetModified(NewModified: Boolean);
    procedure SetPasswordChar(NewPasswordChar: Char);
    procedure SetReadOnly(NewReadOnly: Boolean);
    procedure SetSelText(const Value: string);
    procedure UpdateHeight;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMCaptureChanged(var Message: TWMPaint); message WM_CAPTURECHANGED;
    procedure GetBoundPos;
  protected
    CanvasOffX : Integer;
    CanvasOffY : Integer;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure DoSetMaxLength(Value: Integer); virtual;
    function GetSelText: string; virtual;
    function GetCaretPos: TPoint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure DefaultHandler(var Message); override;
    procedure Clear; virtual;
    procedure Change; dynamic;
    procedure ClearSelection;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure PasteFromClipboard;
    procedure Undo;
    procedure ClearUndo;
    function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
    procedure SetSelTextBuf(Buffer: PChar);
    property CanUndo: Boolean read GetCanUndo;
    property Modified: Boolean read GetModified write SetModified;
    property SelText: string read GetSelText write SetSelText;
    property CaretPos: TPoint read GetCaretPos;
  published
    property Anchors;
    property Align;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
    property Font;
    property Hint;
    property Enabled;
    property Color default clWhite;
    property EnabledBorderColor;
    property EnabledBorderWidth;
    property DisabledBorderColor;
    property DisabledBorderWidth;
    property MouseInBorderColor;
    property MouseInBorderWidth;
    property FocusedBorderColor;
    property FocusedBorderWidth;
    property DrawOnPrint;
    property CharCase: TSRVEditCharCase read FCharCase write SetCharCase default srvecNormal;
    property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
    property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
    property Height default 25;
    property ShowHint;
    property Text;
    property Visible;
    property TabStop default True;
    property Width default 121;
    property OnClick;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnEnter;
    property OnExit;
    property OnDblClick;
    {$IFDEF RICHVIEWDEF5}
    property OnContextPopup;
    {$ENDIF}
    property OnMouseEnter;
    property OnMouseLeave;
  end;

procedure Register;

implementation
uses Math;

procedure Register;
begin
  RegisterComponents('SRichView', [TSRVEdit]);
end;

constructor TSRVEdit.Create(AOwner: TComponent);
const
  EditStyle = [csClickEvents, csDoubleClicks, csFixedHeight];
begin
  inherited Create(AOwner);
  NewStyleControls := False;
  ControlStyle := EditStyle;
  Color := clWhite;
  indexPos1 := 0;
  indexPos2 := 0;
  CanvasOffX := 0;
  CanvasOffY := 0;

  Width := 121;
  Height := 25;
  FAutoSize := True;
  TabStop := True;
  AdjustHeight;
end;

procedure TSRVEdit.DoSetMaxLength(Value: Integer);
begin
  SendMessage(Handle, EM_LIMITTEXT, Value, 0)
end;

procedure TSRVEdit.SetAutoSize(NewAutoSize: Boolean);
begin
  if NewAutoSize <> FAutoSize then
  begin
    FAutoSize := NewAutoSize;
    UpdateHeight;
  end;
end;

procedure TSRVEdit.SetCharCase(NewCharCase: TSRVEditCharCase);
begin
  if NewCharCase <> FCharCase then
  begin
    FCharCase := NewCharCase;
    RecreateWnd;
  end;
end;

procedure TSRVEdit.SetMaxLength(NewMaxLength: Integer);
var S: string;
begin
  if NewMaxLength <> FMaxLength then
    begin
      FMaxLength := NewMaxLength;
      if HandleAllocated then DoSetMaxLength(NewMaxLength);
      if (MaxLength <= 0) or (Length(Text) <= MaxLength) then
        Exit;
      S := Text;
      SetLength(S, MaxLength);
      Text := S;
    end;
end;

function TSRVEdit.GetModified: Boolean;
begin
  Result := FModified;
  if HandleAllocated then Result := SendMessage(Handle, EM_GETMODIFY, 0, 0) <> 0;
end;

function TSRVEdit.GetCanUndo: Boolean;
begin
  Result := False;
  if HandleAllocated then Result := SendMessage(Handle, EM_CANUNDO, 0, 0) <> 0;
end;

procedure TSRVEdit.SetModified(NewModified: Boolean);
begin
  if HandleAllocated then
    SendMessage(Handle, EM_SETMODIFY, Byte(NewModified), 0) else
    FModified := NewModified;
end;

procedure TSRVEdit.SetPasswordChar(NewPasswordChar: Char);
begin
  if NewPasswordChar <> FPasswordChar then
  begin
    FPasswordChar := NewPasswordChar;
    if HandleAllocated then
    begin
      SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
      SetTextBuf(PChar(Text));
    end;
  end;
end;

procedure TSRVEdit.SetReadOnly(NewReadOnly: Boolean);
begin
  if NewReadOnly <> FReadOnly then
  begin
    FReadOnly := NewReadOnly;
    if HandleAllocated then
      SendMessage(Handle, EM_SETREADONLY, Ord(NewReadOnly), 0);
  end;
end;

procedure TSRVEdit.Clear;
begin
  SetWindowText(Handle, '');
end;

procedure TSRVEdit.ClearSelection;
begin
  SendMessage(Handle, WM_CLEAR, 0, 0);
end;

procedure TSRVEdit.CopyToClipboard;
begin
  SendMessage(Handle, WM_COPY, 0, 0);
end;

procedure TSRVEdit.CutToClipboard;
begin
  SendMessage(Handle, WM_CUT, 0, 0);
end;

procedure TSRVEdit.PasteFromClipboard;
begin
  SendMessage(Handle, WM_PASTE, 0, 0);
end;

procedure TSRVEdit.Undo;
begin
  SendMessage(Handle, WM_UNDO, 0, 0);
end;

procedure TSRVEdit.ClearUndo;
begin
  SendMessage(Handle, EM_EMPTYUNDOBUFFER, 0, 0);
end;

function TSRVEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
var
  P: PChar;
  StartPos: Integer;
begin
  StartPos := Self.SelStart;
  Result := Self.SelLength;
  P := StrAlloc(GetTextLen + 1);
  try
    GetTextBuf(P, StrBufSize(P));
    if Result >= BufSize then Result := BufSize - 1;
    StrLCopy(Buffer, P + StartPos, Result);
  finally
    StrDispose(P);
  end;
end;

procedure TSRVEdit.SetSelTextBuf(Buffer: PChar);
begin
  SendMessage(Handle, EM_REPLACESEL, 0, LongInt(Buffer));
end;

function TSRVEdit.GetSelText: string;
var
  P: PChar;
  SelStart, Len: Integer;
begin
  SelStart := Self.SelStart;
  Len := Self.SelLength;
  SetString(Result, PChar(nil), Len);
  if Len <> 0 then
  begin
    P := StrAlloc(GetTextLen + 1);
    try
      GetTextBuf(P, StrBufSize(P));
      Move(P[SelStart], Pointer(Result)^, Len);
    finally
      StrDispose(P);
    end;
  end;
end;

procedure TSRVEdit.SetSelText(const Value: String);
begin
  SendMessage(Handle, EM_REPLACESEL, 0, Longint(PChar(Value)));
end;

procedure TSRVEdit.CreateParams(var Params: TCreateParams);
const
  Passwords: array[Boolean] of DWORD = (0, ES_PASSWORD);
  ReadOnlys: array[Boolean] of DWORD = (0, ES_READONLY);
  CharCases: array[TSRVEditCharCase] of DWORD = (0, ES_UPPERCASE, ES_LOWERCASE);
  HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
  OEMConverts: array[Boolean] of DWORD = (0, ES_OEMCONVERT);
begin
  inherited CreateParams(Params);
  CreateSubClass(Params, 'EDIT');
  with Params do
  begin
    Style := Style or (ES_AUTOHSCROLL or ES_AUTOVSCROLL) or
      Passwords[FPasswordChar <> #0] or
      ReadOnlys[FReadOnly] or CharCases[FCharCase];
    if NewStyleControls then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

procedure TSRVEdit.CreateWindowHandle(const Params: TCreateParams);
var
  P: TCreateParams;
begin
  if SysLocale.FarEast and (Win32Platform <> VER_PLATFORM_WIN32_NT) and
    ((Params.Style and ES_READONLY) <> 0) then
  begin
    // Work around Far East Win95 API/IME bug.
    P := Params;
    P.Style := P.Style and (not ES_READONLY);
    inherited CreateWindowHandle(P);
    if WindowHandle <> 0 then
      SendMessage(WindowHandle, EM_SETREADONLY, Ord(True), 0);
  end
  else
    inherited CreateWindowHandle(Params);
end;

procedure TSRVEdit.CreateWnd;
begin
  FCreating := True;
  try
    inherited CreateWnd;
  finally
    FCreating := False;
  end;
  DoSetMaxLength(FMaxLength);
  Modified := FModified;
  if FPasswordChar <> #0 then
    SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
  UpdateHeight;
end;

procedure TSRVEdit.DestroyWnd;
begin
  FModified := Modified;
  inherited DestroyWnd;
end;

procedure TSRVEdit.UpdateHeight;
begin
  ControlStyle := ControlStyle - [csFixedHeight];
  AdjustHeight;
end;

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

procedure TSRVEdit.DefaultHandler(var Message);
begin
  case TMessage(Message).Msg of
    WM_SETFOCUS:
      if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
        not IsWindow(TWMSetFocus(Message).FocusedWnd) then
        TWMSetFocus(Message).FocusedWnd := 0;
  end;
  inherited;
end;

procedure TSRVEdit.CNCommand(var Message: TWMCommand);
begin
  if (Message.NotifyCode = EN_CHANGE) and not FCreating then Change;
end;

procedure TSRVEdit.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if not HandleAllocated or (GetWindowLong(Handle, GWL_STYLE) and
    ES_MULTILINE <> 0) then Change;
end;

procedure TSRVEdit.WMPaint(var Message: TWMPaint);
var
     DC, DCScreen: HDC;
     R, rSel: TRect;
     SZ: TSize;
     w: Integer;
     Canvas, CanvasScreen: TCanvas;
     s: String;
     sraw: TRVRawByteString;
     ItemOptions: TRVItemOptions;
begin
  Canvas := TCanvas.Create;
  CanvasScreen := TCanvas.Create;
  GetWindowRect(Handle, R);
  OffsetRect(R, -R.Left, -R.Top);
  OffsetRect(R, CanvasOffX, CanvasOffY);

  if Message.DC = 0 then
    DC := GetWindowDC(Handle)
  else
    DC := Message.DC;

  DCScreen := CreateCompatibleDC(0);

  try
    Canvas.Handle := DC;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := Color;
    Canvas.FillRect(R);
    CanvasScreen.Handle := DCScreen;

    Canvas.Font.Assign(Font);
    CanvasScreen.Font.Assign(Font);

    s := Copy(Text, indexPos1 + 1, indexPos2 - indexPos1 + 1);
    {$IFDEF RVUNICODESTR}
    sraw := RVU_GetRawUnicode(s);
    ItemOptions := [rvioUnicode];
    {$ELSE}
    sraw := s;
    ItemOptions := [];
    {$ENDIF}
    SZ := CanvasScreen.TextExtent(s);
    w := (Width - ClientWidth) div 2 + FStartX;
    if not RVU_DrawSelectedTextEx(w + CanvasOffX, BorderWidth + CanvasOffY, SZ.cx, SZ.cy, sraw,
      Canvas, CanvasScreen,
      1, Length(s), ItemOptions, rvbdLeftToRight) then
      Canvas.TextRect(R, BorderWidth + CanvasOffX, BorderWidth + CanvasOffY, s);

    if Enabled = True then
      if MouseIn then
        Frame3D(Canvas, R, MouseInBorderColor, MouseInBorderColor, MouseInBorderWidth)
      else if Focused then
        Frame3D(Canvas, R, FocusedBorderColor, FocusedBorderColor, FocusedBorderWidth)
      else
        Frame3D(Canvas, R, EnabledBorderColor, EnabledBorderColor, EnabledBorderWidth);

    if Enabled = False then
      Frame3D(Canvas, R, DisabledBorderColor, DisabledBorderColor, DisabledBorderWidth);
    Frame3D(Canvas, R, Color, Color, 1);

    if (iSel2 > iSel1) then
      begin
        rSel := Rect(w + Canvas.TextWidth(Copy(Text, indexPos1+1, iSel1 - indexPos1)),
                     BorderWidth,
                     w + Canvas.TextWidth(Copy(Text, indexPos1+1, iSel2 - indexPos1)),
                     Min(BorderWidth + Canvas.TextHeight(Text), R.Bottom));
        Canvas.Brush.Style := bsSolid;
        Canvas.Brush.Color := clHighlight;
        Canvas.Font.Color := clWhite;
        if not RVU_DrawSelectedTextEx(w + CanvasOffX, BorderWidth + CanvasOffY,
          SZ.cx, SZ.cy, sraw, Canvas, CanvasScreen,
          -indexPos1+iSel1+1, -indexPos1+iSel2, ItemOptions, rvbdLeftToRight) then
          Canvas.TextRect(rSel, rSel.Left + CanvasOffX, rSel.Top + CanvasOffY,
                          Copy(Text, iSel1+1, iSel2 - iSel1 + 1));
      end;
  finally
    DeleteDC(DCScreen);
    if Message.DC = 0 then
      ReleaseDC(Handle, DC);
    Canvas.Handle := 0;
    Canvas.Free;
    CanvasScreen.Handle := 0;
    CanvasScreen.Free;
  end;
  if Message.DC = 0 then
    Inherited;
end;

function TSRVEdit.GetCaretPos: TPoint;
begin
  Result := Point(-1, -1);
  if Focused then
    begin
      Windows.GetCaretPos(Result);
      Result.x := Result.x + BorderWidth*2;
      Result.y := Result.y + BorderWidth*2;
      if (Result.x > Width+4) or (Result.y > Height+4) then
        Result := Point(-1, -1);
      GetBoundPos;
    end;
end;

procedure TSRVEdit.GetBoundPos;
var
     tmp, i : Integer;
     f: Boolean;
begin
  // indexPos1 := SendMessage(Handle, EM_CHARFROMPOS, 0, MAKELPARAM(BorderWidth, 1));
  // indexPos2 := SendMessage(Handle, EM_CHARFROMPOS, 0, MAKELPARAM(ClientWidth - 1, 1));

  indexPos1 := 0;
  indexPos2 := Length(Text)-1;

  f := False;
  for i := 0 to Length(Text)-1 do begin
    tmp := SendMessage(Handle, EM_POSFROMCHAR, i, 0);
    if (tmp and $FF00)<>$FF00 then begin
      if not f then begin
        indexPos1 := i;
        FStartX := tmp and $FF;
        f := True;
        end
      else if f then begin
        if tmp and $FF>ClientWidth then begin
          indexPos2 := i-1;
          break;
        end;
      end;
      end
    else if f then begin
      indexPos2 := i-1;
      break;
    end;
  end;


  iSel1:= 0;
  iSel2:= 0;
  if (SelLength > 0) then begin
    iSel1:= Max(indexPos1, SelStart);
    iSel2:= Min(indexPos2+1, SelStart + SelLength);
    if iSel1 > iSel2 then begin
      tmp := iSel1;
      iSel1 := iSel2;
      iSel2 := tmp;
    end;
  end;
end;

procedure TSRVEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if Button=mbLeft then begin
    ClickState := 1;
    ReleaseCapture;
  end;
end;

procedure TSRVEdit.WMCaptureChanged(var Message: TWMPaint);
begin
  if ClickState=1 then
    ClickState := 2
  else begin
    inherited;
    ClickState := 0;
  end;
end;

procedure TSRVEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if ClickState=2 then
    SendMessage(Handle, WM_CAPTURECHANGED, 0, 0);
  inherited;
end;

end.
