(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *)
(*
Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved.
Copyright (c) 2011-2017 by Xequte Software.

This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

Author grants you the right to include the component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE.

ImageEn, IEvolution and ImageEn ActiveX may not be included in any
commercial, shareware or freeware libraries or components.

www.ImageEn.com
*)

(*
File version 1011
*)

unit ietextc;

{$R-}
{$Q-}

{$I ie.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  {$ifdef IEHASTYPES} Types, {$endif}
  {$ifdef IEHASUITYPES} System.UITypes, {$endif}
  Controls, StdCtrls, Forms, hyiedefs, iegdiplus;

type
  TIECharInfo = record
    refcount: integer;
    // single char info
    name: string[255];
    height: integer;
    style: TFontStyles;
    color: TColor;
    brushColor: TColor;
    brushStyle: TBrushStyle;
    // paragraph info (all chars inside before the #10 must have equal values)
    align: TIEAlignment;
  end;
  PIECharInfo = ^TIECharInfo;


{!!
<FS>TIETextControl

<FM>Declaration<FC>
TIETextControl = class(TCustomControl)

<FM>Description<FN>
Handles iekMEMO objects editing.
!!}
  TIETextControl = class(TCustomControl)
  private
  protected
    fTextWide: PWideChar;
    fTextWideAllocated: boolean;
    fTextLength: integer; // without ZERO ending
    fInsertPos: integer;
    fMaxLength : Integer;
    fBackbuf: TBitmap;
    fCaretX, fCaretY, fCaretH: integer;
    fDefaultFont: TFont;
    fDefaultFontBrush: TBrush;
    fBorderPen: TPen;
    fBrush: TBrush;
    fInsMode: boolean;
    fDefaultAlign: TIEAlignment;
    fZoom: double;
    fSelStart: integer;
    fSelStop: integer;
    fMouseDownX, fMouseDownY: integer;
    fInsertingCharInfo: PIECharInfo;
    fForceDefaultColors: boolean;
    fIsDrawingAlpha: boolean;
    fFontLocked: boolean;
    fAutoSize: boolean;
    fLineSpace: integer;
    fFixedHeight: integer;
    //
    fcache_h: pwordarray;
    fcache_w: pwordarray;
    fcache_InternalLeading: pbytearray;
    fcache_Descent: pbytearray;
    fposxarray, fposyarray: pintegerarray;
    fCharInfo: TList;
    fCharRef: pintegerarray; // reference to fCharInfo for each character
    fWriteFormattedString: boolean;
    fFormattedString: WideString;
    fOnCursorMoved: TNotifyEvent;
    fUnderBuffer: TBitmap;
    fMarginLeft, fMarginTop, fMarginRight, fMarginBottom: double; // margins in percentage
    fFillColor2: TColor;
    fGradientDir: TIEGradientDir;

    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMCopy(var Message: TMessage); message WM_COPY;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure CNChar(var Message: TWMChar); message CN_CHAR;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure GoBack(var CurPos: PWideChar);
    function GoBackIdx(var CurPos: integer): boolean;
    procedure GoForwardIdx(var CurPos: integer);
    procedure SaveCharInfo(idx: integer; charinf: PIECharInfo);
    function FindCharInfo(info: PIECharInfo): integer;
    procedure RestoreCharInfo(idx: integer; XCanvas: TIECanvas);
    procedure CopyCharInfoTo(source: integer; charinf: PIECharInfo);
    function DelChar(idx: integer): integer;
    procedure IncFontSize;
    procedure DecFontSize;
    procedure MoveUp;
    procedure MoveDown;
    procedure MoveHome;
    procedure MoveEnd;
    procedure MoveTo(x, y: integer);
    procedure ClearBitmap;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure ResetSelection;
    procedure SStop(PrevPos: integer; Shift: TShiftState);
    procedure RemoveSelected;
    procedure CopyToClipboard;
    procedure PasteFromClipboard;
    procedure ResetCache(from, len: integer);
    procedure SwitchFontStyle(sty: TFontStyle);
    procedure GoWordBackIdx(var CurPos: integer);
    procedure GoWordForwardIdx(var CurPos: integer);
    procedure SetFontLocked(value: boolean);
    procedure DoCursorMoved;
    procedure SetTextString(value: string);
    function GetTextString(): string;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure Update; override;
    property TextWideString: PWideChar read fTextWide write fTextWide;
    property Text: string read GetTextString write SetTextString;
    property TextFormatRef: pintegerarray read fCharRef write fCharRef;
    property TextFormat: TList read fCharInfo write fCharInfo;
    procedure KeyPress(var Key: Char); override;
    procedure PaintTo(DestCanvas: TIECanvas; DestX, DestY, NonZoomDestWidth, NonZoomDestHeight: integer; DrawingAlpha: Boolean = False);
    procedure AddChar(key: WideChar);
    procedure InsertAlign(Align: TIEAlignment);
    procedure Init;
    procedure RemoveUnreferenced;
    property DefaultFont: TFont read fDefaultFont;
    property DefaultFontBrush: TBrush read fDefaultFontBrush;
    property DefaultAlign: TIEAlignment read fDefaultAlign write fDefaultAlign;
    property BorderPen: TPen read fBorderPen;
    property Brush: TBrush read fBrush;
    property Zoom: double read fZoom write fZoom;
    property OnKeyDown;
    property ForceDefaultColors: boolean read fForceDefaultColors write fForceDefaultColors;
    property IsDrawingAlpha: boolean read fIsDrawingAlpha write fIsDrawingAlpha;
    property IsFontLocked: boolean read fFontLocked write SetFontLocked;
    property AutoSize: boolean read fAutoSize write fAutoSize;
    property GlobalLineSpace: integer read fLineSpace write fLineSpace;
    property GlobalFixedHeight: integer read fFixedHeight write fFixedHeight; // 0=use font size (default)
    property WriteFormattedString: boolean read fWriteFormattedString write fWriteFormattedString;
    property FormattedString: WideString read fFormattedString;
    property InsertingCharInfo: PIECharInfo read fInsertingCharInfo;
    procedure SetXFont(fnt: TFont);
    procedure SetXBackColor(bk: TColor);
    property OnCursorMoved: TNotifyEvent read fOnCursorMoved write fOnCursorMoved; // occurs only on Mouse movements
    property UnderBuffer: TBitmap read fUnderBuffer write fUnderBuffer;
    property MarginLeft: double read fMarginLeft write fMarginLeft;
    property MarginTop: double read fMarginTop write fMarginTop;
    property MarginRight: double read fMarginRight write fMarginRight;
    property MarginBottom: double read fMarginBottom write fMarginBottom;
    property MaxLength: Integer read fMaxLength write fMaxLength;
                                                                  
    // Gradient support
    property FillColor2: TColor read fFillColor2 write fFillColor2;
    property GradientDir: TIEGradientDir read fGradientDir write fGradientDir;
  end;


{!!
<FS>TIEEdit

<FM>Declaration<FC>
TIEEdit=class(TEdit)

<FM>Description<FN>
Handles iekTEXT objects editing.
!!}
  TIEEdit=class(TEdit)
    private
      procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    protected
      procedure KeyPress(var Key: Char); override;
    public
  end;

procedure IEInitialize_ietextc;
procedure IEFinalize_ietextc;

implementation

uses
  menus, imageenproc, dialogs, ievect, iesettings, hyieutils, math;

const
  IETEXTMEMOCLIPFORMAT_NAME: AnsiString = 'IMAGEEN TEXTMEMO';

var
  IETEXTMEMOCLIPFORMAT: integer;

constructor TIETextControl.Create(Owner: TComponent);
begin
  inherited;
  fWriteFormattedString := false;
  fFormattedString := '';
  fLineSpace := 0;
  fFixedHeight := 0;
  fAutoSize := false;
  fFontLocked := false;
  fDefaultFont := TFont.Create;
  fDefaultFontBrush := TBrush.Create;
  fBorderPen := TPen.Create;
  fBrush := TBrush.Create;
  ControlStyle := ControlStyle + [csOpaque];
  fTextWide := nil;
  fTextWideAllocated := false;
  fBackbuf := TBitmap.Create;
  fBackbuf.PixelFormat := pf24bit;
  fcache_h := nil;
  fcache_w := nil;
  fcache_InternalLeading := nil;
  fcache_Descent := nil;
  fCaretX := 0;
  fCaretY := 0;
  fCaretH := 0;
  fTextLength := 0;
  fCharInfo := nil;
  fCharRef := nil;
  fposxarray := nil;
  fposyarray := nil;
  fInsMode := true;
  fDefaultAlign := iejLeft;
  fZoom := 1;
  if assigned(Owner) then
    Cursor := crIBeam;
  fSelStart := 0;
  fSelStop := 0;
  fMouseDownX := 0;
  fMouseDownY := 0;
  fForceDefaultColors := false;
  fIsDrawingAlpha := false;
  getmem(fInsertingCharInfo, sizeof(TIECharInfo));
  fOnCursorMoved := nil;
  fMarginLeft := 0;
  fMarginTop := 0;
  fMarginRight := 0;
  fMarginBottom := 0;
  fFillColor2 := clNone;
  fGradientDir := gdVertical;
end;

destructor TIETextControl.Destroy;
var
  i: integer;
begin
  freemem(fInsertingCharInfo);
  freemem(fcache_h);
  freemem(fcache_w);
  freemem(fcache_internalLeading);
  freemem(fcache_Descent);
  freemem(fCharRef);
  freemem(fposxarray);
  freemem(fposyarray);
  FreeAndNil(fBackbuf);

  if fCharInfo <> nil then
    for i := 0 to fCharInfo.count-1 do
      freemem(fCharInfo[i]);
  FreeAndNil(fCharInfo);

  FreeAndNil(fDefaultFont);
  FreeAndNil(fDefaultFontBrush);
  FreeAndNil(fBrush);
  FreeAndNil(fBorderPen);

  if fTextWideAllocated then
    freemem(fTextWide);

  inherited;
end;

procedure TIETextControl.SetTextString(value: string);
var
  len: integer;
  ws: WideString;
begin
  if fTextWideAllocated then
    freemem(fTextWide);
  fTextWideAllocated := true;
  len := length(value);
  getmem(fTextWide, len * 2 + 2);
  ws := WideString(value);
  IEStrCopyW(fTextWide, PWideChar(ws));
end;

function TIETextControl.GetTextString(): string;
begin
  result := string(WideString(fTextWide));
end;

procedure TIETextControl.RemoveUnreferenced();
var
  ref: pintegerarray; //1=referenced 0=unref
  i, j: integer;
  ci: PIECharInfo;
begin
  if fCharInfo = nil then
    exit; // Customer report: 9/8/16

  getmem(ref, sizeof(integer) * fCharInfo.Count);
  i := 0;
  while i < fCharInfo.Count do
  begin
    ci := PIECharInfo(fCharInfo[i]);
    if ci^.refcount = 0 then
    begin
      for j := 0 to fTextLength - 1 do
        if fCharRef[j] > i then
          dec(fCharRef[j]);
      freemem(ci);
      fCharInfo.Delete(i);
    end
    else
      inc(i);
  end;
  freemem(ref);
end;

procedure TIETextControl.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;

procedure TIETextControl.WMSize(var Message: TWMSize);
begin
  inherited;
  Update;
end;

procedure TIETextControl.WMEraseBkgnd(var Message: TMessage);
begin
  Message.Result := 0;
end;

procedure TIETextControl.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
  inherited;
  case msg.CharCode of
    VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_HOME, VK_END, VK_TAB:
      begin
        msg.Result := 1;
        KeyUp(Msg.CharCode, KeyDataToShiftState(Msg.KeyData));
      end;
  end;
end;

procedure TIEEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
  inherited;
  case msg.CharCode of
    VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_HOME, VK_END, VK_TAB:
      begin
        msg.Result := 1;
        KeyUp(Msg.CharCode, KeyDataToShiftState(Msg.KeyData));
      end;
  end;
end;

procedure TIEEdit.KeyPress(var Key: Char);
begin
  if key=#9 then
  begin
    key := #0;
    exit;
  end;
  inherited;
end;

function irealloc(old: pointer; oldsize, newsize: integer): pointer;
const
  BLOCKSIZE = 256;
var
  ab: integer; // already allocated blocks
  rb: integer; // required blocks
begin
  ab := (oldsize div BLOCKSIZE);
  rb := (newsize div BLOCKSIZE) + 1;
  if (rb > ab) or (oldsize = 0) then
  begin
    reallocmem(old, rb * BLOCKSIZE);
    result := old;
  end
  else
    result := old;
end;

// insert at fInsertPos
procedure TIETextControl.AddChar(key: WideChar);
var
  ll, ol, xl: integer;
begin
  if (fMaxLength > 0) and (fTextLength >= fMaxLength) then
  begin
    MessageBeep(MB_ICONASTERISK);
    exit;
  end;

  if fTextWide <> nil then
  begin
    ol := fTextLength + 1; // +1 is the ending Zero
    ll := ol + 1;
    fTextWide := irealloc(fTextWide, ol * 2, ll * 2);
    move(fTextWide[fInsertPos], fTextWide[fInsertPos + 1], (ol - fInsertPos) * 2);
    fCharRef := irealloc(fCharRef, ol * sizeof(integer), ll * sizeof(integer));
    move(fCharRef[fInsertPos], fCharRef[fInsertPos + 1], (ol - fInsertPos) * sizeof(integer));
  end
  else
  begin
    ol := 0;
    ll := 2;
    getmem(fTextWide, 4); // 4 = two wide chars
    fTextWide[1] := #0;
    getmem(fCharRef, 2 * sizeof(integer));
  end;
  fTextWide[fInsertPos] := Key;
  SaveCharInfo(fInsertPos, fInsertingCharInfo);
  // resize
  fcache_h := irealloc(fcache_h, ol*sizeof(word), ll*sizeof(word));
  fcache_w := irealloc(fcache_w, ol*sizeof(word), ll*sizeof(word));
  fcache_InternalLeading := irealloc(fcache_InternalLeading, ol, ll);
  fcache_Descent := irealloc(fcache_Descent, ol, ll);
  fposxarray := irealloc(fposxarray, sizeof(integer) * ol, sizeof(integer) * ll);
  fposyarray := irealloc(fposyarray, sizeof(integer) * ol, sizeof(integer) * ll);
  // reset all from inserting position
  xl := ll - fInsertPos;
  ResetCache(fInsertPos, xl);
  //
  inc(fInsertPos);
  inc(fTextLength);
end;

procedure TIETextControl.ResetCache(from, len: integer);
begin
  zeromemory(@fcache_h[from], len*sizeof(word));
  zeromemory(@fcache_w[from], len*sizeof(word));
  zeromemory(@fcache_InternalLeading[from], len);
  zeromemory(@fcache_Descent[from], len);
  fillchar(fposxarray[from], sizeof(integer) * len, 255); // set to -1
  fillchar(fposyarray[from], sizeof(integer) * len, 255); // set to -1
end;

// delete the idx char
// return the modified idx (only if it need to be changed)
function TIETextControl.DelChar(idx: integer): integer;
var
  xl: integer;
begin
  result := idx;
  if fCharInfo = nil then
    exit; // Customer report: 14/12/16
  if idx >= fTextLength then
    exit;
  if (idx < fTextLength) then
  begin
    with PIECharInfo(fCharInfo[fCharRef[idx]])^ do
      if refcount > 0 then
        dec(refcount);
    move(fTextWide[idx + 1], fTextWide[idx], (fTextLength - idx) * 2);
    move(fCharRef[idx + 1], fCharRef[idx], (fTextLength - idx) * sizeof(integer));
    dec(fTextLength);
    xl := fTextLength - idx;
    ResetCache(idx, xl);
    result := idx;
  end;
end;

procedure TIETextControl.GoBack(var CurPos: PWideChar);
begin
  dec(CurPos);
  if uint64(CurPos) < uint64(fTextWide) then
    CurPos := fTextWide;
end;

// return true if CurPos has changed
function TIETextControl.GoBackIdx(var CurPos: integer): boolean;
begin
  result := CurPos > 0;
  if result then
    dec(CurPos);
end;

procedure TIETextControl.GoForwardIdx(var CurPos: integer);
begin
  if CurPos < fTextLength then
    inc(CurPos);
end;

procedure TIETextControl.GoWordBackIdx(var CurPos: integer);
begin
  dec(CurPos);
  while (CurPos > 0) and (fTextWide[CurPos] < #33) do
    dec(CurPos);
  while (CurPos > 0) and (fTextWide[CurPos] > #32) do
    dec(CurPos);
  if CurPos < 0 then
    CurPos := 0;
  if (CurPos < fTextLength) and (fTextWide[CurPos] < #33) then
    inc(CurPos);
  CurPos := imax(imin(CurPos, fTextLength - 1), 0);
end;

procedure TIETextControl.GoWordForwardIdx(var CurPos: integer);
begin
  inc(CurPos);
  while (CurPos < fTextLength) and (fTextWide[CurPos] < #33) do
    inc(CurPos);
  while (CurPos < fTextLength) and (fTextWide[CurPos] > #32) do
    inc(CurPos);
  CurPos := imax(imin(CurPos, fTextLength - 1), 0);
end;

procedure TIETextControl.SStop(PrevPos: integer; Shift: TShiftState);
begin
  if not (ssShift in Shift) then
    ResetSelection
  else
  begin
    if fSelStop = 0 then
    begin
      // no existing selection
      fSelStart := PrevPos;
      fSelStop := fInsertPos;
    end
    else
    begin
      // already exists a selection
      if PrevPos < fInsertPos then
      begin
        // going right
        if fInsertPos > fSelStop then
          fSelStop := fInsertPos
        else
          fSelStart := fInsertPos; // return back
      end
      else
      begin
        // going left
        if fInsertPos < fSelStart then
          fSelStart := fInsertPos
        else
          fSelStop := fInsertPos; // return back
      end;
    end;
  end;
  if fSelStart > fSelStop then
    iswap(fSelStart, fSelStop);
end;

// Why This? Because if KeyPreview is True the characters was sent to the form (and it runs accelaration keys!)
procedure TIETextControl.CNChar(var Message: TWMChar);
var
  c: Char;
begin
  c := Char(chr(Message.CharCode));
  KeyPress(c);
  message.Result := 1;
end;

procedure TIETextControl.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited;
end;

procedure TIETextControl.KeyPress(var Key: Char);
var
  ac: WideChar;
begin
  ac := WideChar(key);
  if (Key > #31) and (key <> #127) then
  begin
    RemoveSelected();
    if fInsMode then
      AddChar(ac)
    else
    begin
      fInsertPos := DelChar(fInsertPos);
      AddChar(ac);
    end;
  end;
  Paint();
end;

procedure TIETextControl.KeyDown(var Key: Word; Shift: TShiftState);
var
  PrevInsertPos: integer;
  fd: TFontDialog;
  sc: TShortCut;
  aColor: TColor;
begin
  PrevInsertPos := fInsertPos;
  case Key of
    VK_F2:
      if (ssShift in Shift) then
      begin
        IncFontSize;
        Update;
      end;
    VK_F1:
      if (ssShift in Shift) then
      begin
        DecFontsize;
        Update;
      end;
    VK_LEFT:
      begin
        if ssCtrl in Shift then
          GoWordBackIdx(fInsertPos)
        else
          GoBackIdx(fInsertPos);
        if fInsertPos <> PrevInsertPos then
        begin
          CopyCharInfoTo(fInsertPos - 1, fInsertingCharInfo);
          SStop(PrevInsertPos, Shift);
          Update;
        end;
      end;
    VK_RIGHT:
      begin
        if ssCtrl in Shift then
          GoWordForwardIdx(fInsertPos)
        else
          GoForwardIdx(fInsertPos);
        if fInsertPos <> PrevInsertPos then
        begin
          CopyCharInfoTo(fInsertPos - 1, fInsertingCharInfo);
          SStop(PrevInsertPos, Shift);
          Update;
        end;
      end;
    VK_RETURN:
      begin
        AddChar(#10);
        Update;
      end;
    VK_DELETE:
      begin
        if fSelStop > fSelStart then
          RemoveSelected
        else
          fInsertPos := DelChar(fInsertPos);
        Update;
      end;
    VK_BACK:
      begin
        if fSelStop > fSelStart then
        begin
          RemoveSelected;
          Update;
        end
        else
        begin
          if GoBackIdx(fInsertPos) then
          begin
            fInsertPos := DelChar(fInsertPos);
            Update;
          end;
        end;
      end;
    VK_UP:
      begin
        MoveUp;
        if fInsertPos <> PrevInsertPos then
        begin
          CopyCharInfoTo(fInsertPos - 1, fInsertingCharInfo);
          SStop(PrevInsertPos, Shift);
          Update;
        end;
      end;
    VK_DOWN:
      begin
        MoveDown;
        if fInsertPos <> PrevInsertPos then
        begin
          CopyCharInfoTo(fInsertPos - 1, fInsertingCharInfo);
          SStop(PrevInsertPos, Shift);
          Update;
        end;
      end;
    VK_HOME:
      begin
        if ssCtrl in Shift then
          // go home, (start of document)
          fInsertPos := 0
        else
          // go home (start of line)
          MoveHome;
        if fInsertPos <> PrevInsertPos then
        begin
          CopyCharInfoTo(fInsertPos - 1, fInsertingCharInfo);
          SStop(PrevInsertPos, Shift);
          Update;
        end;
      end;
    VK_END:
      begin
        if ssCtrl in Shift then
          // go end, (end of document)
          fInsertPos := fTextLength
        else
          // go end, (end of line)
          MoveEnd;
        if fInsertPos <> PrevInsertPos then
        begin
          CopyCharInfoTo(fInsertPos - 1, fInsertingCharInfo);
          SStop(PrevInsertPos, Shift);
          Update;
        end;
      end;
    VK_INSERT:
      fInsMode := not fInsMode;
  end;

  sc := ShortCut(key, Shift);

  if sc = IEGlobalSettings().MemoShortCuts[iesLEFTALIGN] then
  begin
    // left align
    InsertAlign(iejLeft);
    Update;
  end
  else
  if sc = IEGlobalSettings().MemoShortCuts[iesCENTERALIGN] then
  begin
    // center align
    InsertAlign(iejCenter);
    Update;
  end
  else
  if sc = IEGlobalSettings().MemoShortCuts[iesRIGHTALIGN] then
  begin
    // right align
    InsertAlign(iejRight);
    Update;
  end
  else
  if sc = IEGlobalSettings().MemoShortCuts[iesJUSTIFIED] then
  begin
    // justified
    InsertAlign(iejJustify);
    Update;
  end
  else
  if sc = IEGlobalSettings().MemoShortCuts[iesCOPY] then
  begin
    // copy to clipboard
    CopyToClipboard;
  end
  else
  if sc = IEGlobalSettings().MemoShortCuts[iesCUT] then
  begin
    // cut to clipboard
    CopyToClipboard;
    RemoveSelected;
    Update;
  end
  else
  if sc = IEGlobalSettings().MemoShortCuts[iesPASTE] then
  begin
    // paste from clipboard
    RemoveSelected;
    PasteFromClipboard;
    Update;
  end
  else
  if (sc = IEGlobalSettings().MemoShortCuts[iesFONTSELECT]) and (not fFontLocked) then
  begin
    // open font dialog
    fd := TFontDialog.Create(self);
    fd.Font.Name := string( fInsertingCharInfo^.name );
    fd.Font.Height := fInsertingCharInfo^.height;
    fd.Font.Style := fInsertingCharInfo^.style;
    fd.Font.Color := fInsertingCharInfo^.color;
    if fd.Execute then
      SetXFont(fd.Font);
    FreeAndNil(fd);
    Update;
  end
  else
  if sc = IEGlobalSettings().MemoShortCuts[iesBOLD] then
  begin
    // bold
    SwitchFontStyle(fsBold);
    Update;
  end
  else
  if sc = IEGlobalSettings().MemoShortCuts[iesITALIC] then
  begin
    // italic
    SwitchFontStyle(fsItalic);
    Update;
  end
  else
  if sc = IEGlobalSettings().MemoShortCuts[iesUNDERLINE] then
  begin
    SwitchFontStyle(fsUnderline);
    Update;
  end
  else
  if (sc = IEGlobalSettings().MemoShortCuts[iesBACKCOLORSELECT]) and (not fFontLocked) then
  begin
    // select background color
    aColor := fInsertingCharInfo^.brushColor;
    if PromptForColor(aColor) then  
      SetXBackColor(aColor);
    Update;
  end;

  inherited;
end;

procedure TIETextControl.MoveHome;
begin
  while (fInsertPos > 0) and (fposyarray[fInsertPos] >= fCaretY) do
    dec(fInsertPos);
  if fInsertPos > 0 then
    inc(fInsertPos);
end;

procedure TIETextControl.MoveEnd;
begin
  while (fInsertPos < fTextLength) and (fposyarray[fInsertPos] = fCaretY) do
    inc(fInsertPos);
  if fInsertPos < fTextLength then
    dec(fInsertPos);
end;

procedure TIETextControl.MoveUp;
var
  ip: integer;
begin
  // go to at the end of prev line
  ip := fInsertPos;
  while (ip > 0) and (fposyarray[ip] >= fCaretY) do
    dec(ip);
  if fposyarray[ip] <> fposyarray[fInsertPos] then
  begin
    fInsertPos := ip;
    // go to the requested position
    while (fInsertPos > 0) and (fposxarray[fInsertPos] > fCaretX) do
      dec(fInsertPos);
    if (fposyarray[fInsertPos + 1] = fposyarray[fInsertPos]) and (abs(fposxarray[fInsertPos + 1] - fCaretX) < abs(fposxarray[fInsertPos] - fCaretX)) then
      inc(fInsertPos); // it is better next position
    if fposyarray[ip] <> fposyarray[fInsertPos] then
      fInsertPos := ip;
  end;
end;

procedure TIETextControl.MoveDown;
var
  ip: integer;
begin
  // go to at the start of next line
  ip := fInsertPos;
  while (ip < fTextLength) and (fposyarray[ip] = fCaretY) do
    inc(ip);
  if fposyarray[ip] <> fposyarray[fInsertPos] then
  begin
    fInsertPos := ip;
    // go to the requested position
    while (fInsertPos < fTextLength) and (fposxarray[fInsertPos] < fCaretX) do
      inc(fInsertPos);
    if (fInsertPos > 0) and (fposyarray[fInsertPos - 1] = fposyarray[fInsertPos]) and (abs(fposxarray[fInsertPos - 1] - fCaretX) < abs(fposxarray[fInsertPos] - fCaretX)) then
      dec(fInsertPos); // it is better prev position
    if fposyarray[ip] <> fposyarray[fInsertPos] then
      fInsertPos := ip;
  end;
end;

// x, y client area coordinates
procedure TIETextControl.MoveTo(x, y: integer);
begin
  fInsertPos := 0;
  while (fInsertPos < fTextLength) and (fposyarray[fInsertPos] < y) do
    inc(fInsertPos);
  if fposyarray[fInsertPos] >= y then
    dec(fInsertPos);
  while (fInsertPos >= 0) and (fposxarray[fInsertPos] - 1 > x) do
    dec(fInsertPos);
  if fInsertPos < 0 then
    fInsertPos := 0;
  CopyCharInfoTo(fInsertPos - 1, fInsertingCharInfo);
end;

procedure TIETextControl.ClearBitmap;
begin
  if (fBrush.Style<>bsSolid) and (fUnderBuffer<>nil) then
  begin
    fBackbuf.Canvas.CopyRect(rect(0, 0, fBackbuf.Width, fBackbuf.Height), fUnderBuffer.Canvas, rect(Left, Top, Left+fBackbuf.Width, Top+fBackbuf.Height));
  end;
  if fBrush.Style<>bsClear then
  begin
    fBackbuf.Canvas.Brush.Style := fBrush.Style;
    fBackbuf.Canvas.Brush.Color := fBrush.Color;
    fBackbuf.Canvas.FillRect(rect(0, 0, fBackbuf.Width, fBackbuf.Height));
  end;
end;

procedure TIETextControl.Paint;
var
  DestCanvas: TIECanvas;
begin
  if Visible and assigned(Parent) then
  begin
    DestroyCaret;
    if (fBackbuf.Width <> ClientWidth) or (fBackbuf.Height <> ClientHeight) then
    begin
      fBackbuf.Width := ClientWidth;
      fBackbuf.Height := ClientHeight;
    end;
    ClearBitmap();
    DestCanvas := TIECanvas.Create(fBackbuf.Canvas, false, true);
    PaintTo(DestCanvas, 0, 0, trunc(ClientWidth / fZoom), trunc(ClientHeight / fZoom), False);
    DestCanvas.Free();
    Canvas.Draw(0, 0, fBackbuf);

    CreateCaret(handle, 0, 0, fCaretH);
    SetCaretPos(fCaretX, fCaretY);
    ShowCaret(handle);
  end;
end;

procedure TIETextControl.Init;
var
  ci: PIECharInfo;
begin
  fSelStart := 0;
  fSelStop := 0;
  fInsertPos := 0;
  if fTextWide <> nil then
    fTextLength := IEStrLenW(fTextWide)
  else
    fTextLength := 0;
  if fCharRef = nil then
  begin
    getmem(fCharRef, fTextLength * sizeof(integer));
    fillchar(fCharRef^, sizeof(integer) * fTextLength, 0); // all points to first item of fCharInfo
  end;
  if fCharInfo = nil then
  begin
    fCharInfo := TList.Create;
    if fTextLength > 0 then
    begin
      getmem(ci, sizeof(TIECharInfo));
      ci^.refcount := fTextLength;
      ci^.name := AnsiString(fDefaultFont.Name);
      ci^.height := fDefaultFont.Height;
      ci^.style := fDefaultFont.Style;
      ci^.color := fDefaultFont.Color;
      ci^.brushColor := fDefaultFontBrush.Color;
      ci^.brushStyle := fDefaultFontBrush.Style;
      ci^.align := fDefaultAlign;
      fCharInfo.Add(ci);
    end;
  end;
  if fcache_h <> nil then
    freemem(fcache_h);
  if fcache_w <> nil then
    freemem(fcache_w);
  if fcache_internalLeading <> nil then
    freemem(fcache_internalLeading);
  if fcache_Descent <>nil then
    freemem(fcache_Descent);
  if fposxarray <> nil then
    freemem(fposxarray);
  if fposyarray <> nil then
    freemem(fposyarray);
  fcache_h := allocmem((fTextLength + 1)*sizeof(word));
  fcache_w := allocmem((fTextLength + 1)*sizeof(word));
  fcache_InternalLeading := allocmem(fTextLength + 1);
  fcache_Descent := allocmem(fTextLength + 1);
  getmem(fposxarray, sizeof(integer) * (fTextLength + 1));
  fillchar(fposxarray^, sizeof(integer) * (fTextLength + 1), 255); // set to -1
  getmem(fposyarray, sizeof(integer) * (fTextLength + 1));
  fillchar(fposyarray^, sizeof(integer) * (fTextLength + 1), 255); // set to -1
  fInsertingCharInfo^.name := AnsiString(fDefaultFont.Name);
  fInsertingCharInfo^.height := fDefaultFont.Height;
  fInsertingCharInfo^.style := fDefaultFont.Style;
  fInsertingCharInfo^.color := fDefaultFont.Color;
  fInsertingCharInfo^.brushColor := fDefaultFontBrush.Color;
  fInsertingCharInfo^.brushStyle := fDefaultFontBrush.Style;
  fInsertingCharInfo^.align := fDefaultAlign;
  ClearBitmap;
end;

procedure TIETextControl.Update;
begin
  ResetCache(0, fTextLength);
  invalidate;
end;

procedure TIETextControl.WMKillFocus(var Msg: TWMKillFocus);
begin
  inherited;
  HideCaret(handle);
  DestroyCaret;
end;

procedure TIETextControl.WMSetFocus(var Msg: TWMSetFocus);
begin
  inherited;
end;

function TIETextControl.FindCharInfo(info: PIECharInfo): integer;
begin
  for result := 0 to fCharInfo.Count - 1 do
    if comparemem(@pbytearray(fCharInfo[result])[sizeof(integer)], @pbytearray(info)[sizeof(integer)], sizeof(TIECharInfo) - sizeof(integer)) then
    begin // [sizeof(integer)] to bypass reference count
      exit;
    end;
  result := -1;
end;

procedure TIETextControl.SaveCharInfo(idx: integer; charinf: PIECharInfo);
var
  i: integer;
  ci: PIECharInfo;
begin
  i := FindCharInfo(charinf);
  if i < 0 then
  begin
    // not saved, save now
    getmem(ci, sizeof(TIECharInfo));
    move(charinf^, ci^, sizeof(TIECharInfo));
    ci^.refcount := 0;
    i := fCharInfo.Add(ci)
  end;
  fCharRef[idx] := i;
  inc(PIECharInfo(fCharInfo[fCharRef[idx]])^.refcount);
end;

procedure TIETextControl.CopyCharInfoTo(source: integer; charinf: PIECharInfo);
begin
  source := imin(imax(0, source), fTextLength - 1);
  if source >= 0 then
    move(PIECharInfo(fCharInfo[fCharRef[source]])^, charinf^, sizeof(TIECharInfo));
end;

procedure TIETextControl.RestoreCharInfo(idx: integer; XCanvas: TIECanvas);
begin
  if not fFontLocked then
  begin
    with PIECharInfo(fCharInfo[fCharRef[idx]])^ do
    begin
      if ShortString(XCanvas.Font.Name) <> name then
        XCanvas.Font.Name := string(name);
      if XCanvas.Font.Height <> height then
        XCanvas.Font.Height := height;
      if XCanvas.Font.Style <> style then
        XCanvas.Font.Style := style;
      if (XCanvas.Font.Color <> color) and (not fForceDefaultColors) then
        XCanvas.Font.Color := color;
      if (XCanvas.Brush.Color <> brushColor) and (not fForceDefaultColors) then
        XCanvas.Brush.Color := brushColor;
      if XCanvas.Brush.Style <> brushStyle then
        XCanvas.Brush.Style := brushStyle;
    end;
  end
  else
  begin
    // font locked
    if XCanvas.Font.Name <> fDefaultFont.Name then
      XCanvas.Font.Name := fDefaultFont.Name;
    if XCanvas.Font.Height <> fDefaultFont.height then
      XCanvas.Font.Height := fDefaultFont.height;
    if XCanvas.Font.Style <> fDefaultFont.style then
      XCanvas.Font.Style := fDefaultFont.style;
    if (XCanvas.Font.Color <> color) and (not fForceDefaultColors) then
      XCanvas.Font.Color := fDefaultFont.Color;
    if (XCanvas.Brush.Color <> fDefaultFontBrush.Color) and (not fForceDefaultColors) then
      XCanvas.Brush.Color := fDefaultFontBrush.Color;
    if XCanvas.Brush.Style <> fDefaultFontBrush.Style then
      XCanvas.Brush.Style := fDefaultFontBrush.Style;
  end;
end;

// fText is simple ASCII (wide) text, except for following special tags:
//   #10 : carriage return and new line
//   #0 : end of stream
procedure TIETextControl.PaintTo(DestCanvas: TIECanvas; DestX, DestY, NonZoomDestWidth, NonZoomDestHeight: integer; DrawingAlpha: Boolean = False);
type
  TDiff = record
    x, y: integer;
    c: WideChar;
    idx: integer;
  end;
  PDiff = ^TDiff;
var
  c: PWideChar;
  printed, enters, fetched, x, y, xx: integer;
  firstpos: integer;
  i, j, k, il, idx, de: integer;
  fetch: boolean; // false=draw directly, true=fetching the row
  fetchpos: PWideChar;
  maxh, maxi, maxde, charHeight, charWidth: integer;
  posx, posy, rposx, prevend: integer;
  lasth, lasti, lastde: integer;
  tm: TTEXTMETRIC;
  PixelMult: double;
  oldta: integer;
  fStopAt: PWideChar;
  ofx, ofy: integer;
  diffbuf, diff, nextdiff: PDiff;
  difflen: integer;
  paintableRect: TRect;

  // set also PixelMult
  function CalcJust(lastpos: integer): integer;
  var
    d: integer;
    just: TIEAlignment;
  begin
    PixelMult := 1;
    result := 0;
    d := imax(0, lastpos - 1);
    if d < fTextLength then
      just := PIECharInfo(fCharInfo[fCharRef[d]])^.align
    else
      just := fInsertingCharInfo^.align;
    if fFontLocked then
      just := fDefaultAlign;
    if just <> iejLeft then
    begin
      dec(lastpos);
      if fTextWide[lastpos] = #0 then
        dec(lastpos);
      if fTextWide[lastpos] = #10 then
        dec(lastpos);
      if fTextWide[lastpos] = #32 then
        dec(lastpos);
      if lastpos = -1 then
        lastpos := 0;
      result := 0;
      if lastpos >= 0 then
        case Just of
          iejCenter: result := (NonZoomDestWidth - fposxarray[lastpos] - fcache_w[lastpos]) div 2;
          iejRight: result := NonZoomDestWidth - fposxarray[lastpos] - fcache_w[lastpos] - 1; // -1 for the cursor
          iejJustify:
            begin
              if (fTextWide[lastpos + 1] <> #0) and ((lastpos + 2 < fTextLength) or (fTextWide[lastpos + 2] <> #0)) and (fTextWide[lastpos + 1] <> #10) then
              begin
                d := fposxarray[lastpos] + fcache_w[lastpos] + 1;
                if d <> 0 then
                  PixelMult := NonZoomDestWidth / d
                else
                  PixelMult := 1;
              end;
            end;
        end;
    end;
  end;

  // new line (new paragraph)
  procedure DoNewLine;
  begin
    if fetch then
    begin
      // now write
      fetch := false;
      posx := CalcJust(idx);
      rposx := posx;
      prevend := 0;
      c := fetchpos; // backtrack
    end
    else
    begin
      // continue to next row
      if fWriteFormattedString then
        fFormattedString := fFormattedString + #10;
      inc(posy, maxh + fLineSpace);
      fetchpos := c;
      fetch := true;
      maxh := lasth;
      maxi := lasti;
      maxde := lastde;
      fStopAt := nil;
      posx := 0;
      rposx := posx;
      prevend := 0;
      PixelMult := 1;
    end;
  end;

  // new line because the line is too much large - only fetching
  procedure LineLarge;
  var
    cc, o: PWideChar;
  begin
    // go back to the last #32
    cc := c;
    while (uint64(cc) > uint64(fetchpos)) and (cc^ <> #32) do
    begin
      o := cc;
      GoBack(cc);
      if cc = o then
        break; // not moved, exit
    end;
    if uint64(cc) <= uint64(fetchpos) then
      cc := c;
    if (cc^ = #32) then
      inc(cc); // bypass the #32
    fStopAt := cc;
    // now write
    fetch := false;
    c := fetchpos; // backtrack
    posx := CalcJust((uint64(fStopAt) - uint64(fTextWide)) div 2);
    rposx := posx;
    prevend := 0;
  end;

  procedure CalcSizes;
  var
    cc: WideChar;
  begin
    if (c^ < #31) or (c^ = #127) then
      cc := #32
    else
      cc := c^;
    RestoreCharInfo(idx, DestCanvas); // load only when font changes
    if fcache_w[idx] = 0 then
      fcache_w[idx] := DestCanvas.TextWidth(WideString(cc));
    charWidth := fcache_w[idx];
    if fcache_h[idx] = 0 then
    begin
      if fFixedHeight = 0 then
      begin
        GetTextMetrics(DestCanvas.Handle, tm);
        fcache_h[idx] := tm.tmHeight;
        fcache_InternalLeading[idx] := abs(tm.tmInternalLeading);
        fcache_Descent[idx] := abs(tm.tmDescent);
      end
      else
      begin
        fcache_h[idx] := fFixedHeight;
        fcache_InternalLeading[idx] := 0;
        fcache_Descent[idx] := 0;
      end;
    end;
    charHeight := fcache_h[idx];
    il := fcache_internalLeading[idx];
    de := fcache_Descent[idx];
    if fetch then
    begin
      // only calc the max height
      lasth := charHeight;
      lasti := il;
      lastde := de;
      if charHeight > maxh then
        maxh := charHeight;
      if il > maxi then
        maxi := il;
      if de > maxde then
        maxde := de;
    end;
  end;

  procedure PaintChar(x, y: integer; c: WideChar);
  begin
    DestCanvas.TextRectEx(PaintableRect, x, y, WideString(c));
  end;

begin
  if (NonZoomDestWidth <= 1) or (NonZoomDestHeight <= 1) then
    exit;

  fFormattedString := '';
  printed := 0;
  enters := 0;
  fetched := 0;
  firstpos := -1;
  PixelMult := 1;
  fStopAt := nil;
  difflen := 0;
  if fZoom <> 1 then
  begin
    getmem(diffbuf, fTextLength * 10 * sizeof(TDiff));
    diff := diffbuf;
  end
  else
  begin
    diffbuf := nil;
    diff := nil;
  end;

  DestCanvas.GDICanvas.Refresh();

  DestCanvas.Pen.Width := Ceil( fBorderPen.Width * fZoom );
  if DrawingAlpha = False then
    DestCanvas.Font.Color := DefaultFont.Color
  else
    DestCanvas.Font.Color := $02FFFFFF;
  DestCanvas.Pen.Color := DefaultFont.Color;
  if ( DestCanvas.Pen.Color <> clNone_ ) and ( DestCanvas.Pen.Width > 0 ) then
    DestCanvas.Pen.Style := fBorderPen.Style
  else
    DestCanvas.Pen.Style := psClear;
  if DrawingAlpha or ( not ForceDefaultColors ) then
    DestCanvas.Pen.Color := fBorderPen.Color;
  DestCanvas.Pen.Mode := pmCopy;
  DestCanvas.Brush.Color := fBrush.Color;

  if ( fBrush.Color <> clNone ) and ( FillColor2 <> clNone ) and ( FillColor2 <> fBrush.Color ) then
  begin
    // Gradient Fill
    IEDrawGradient( Rect( DestX, DestY, DestX + round(NonZoomDestWidth * fZoom) - 1, DestY + round(NonZoomDestHeight * fZoom) - 1 ),
                    DestCanvas.Handle,
                    fBrush.Color, fFillColor2, fGradientDir = gdVertical );

    // Draw Border
    DestCanvas.Brush.Style := bsClear;
    if DestCanvas.Pen.Style <> psClear then
      DestCanvas.Rectangle( DestX + Round( DestCanvas.Pen.Width / 2 ),
                            DestY + Round( DestCanvas.Pen.Width / 2 ),
                            DestX + round(NonZoomDestWidth * fZoom) - Round( DestCanvas.Pen.Width / 2 ) - 1,
                            DestY + round(NonZoomDestHeight * fZoom) - Round( DestCanvas.Pen.Width / 2 ) - 1);

    DestCanvas.Brush.Style := fBrush.Style;
  end
  else
  begin
    // Normal Fill
    DestCanvas.Brush.Style := fBrush.Style;

    if (DestCanvas.Brush.Style <> bsClear) or (DestCanvas.Pen.Style <> psClear) then
      DestCanvas.Rectangle( DestX + Round( DestCanvas.Pen.Width / 2 ),
                            DestY + Round( DestCanvas.Pen.Width / 2 ),
                            DestX + round(NonZoomDestWidth * fZoom) - Round( DestCanvas.Pen.Width / 2 ) - 1,
                            DestY + round(NonZoomDestHeight * fZoom) - Round( DestCanvas.Pen.Width / 2 ) - 1);
    DestCanvas.Pen.Style := psSolid;
  end;

  x := NonZoomDestWidth;
  y := NonZoomDestHeight;
  NonZoomDestWidth := trunc( NonZoomDestWidth - NonZoomDestWidth*fMarginRight/100 -NonZoomDestWidth*fMarginLeft/100)-2;
  NonZoomDestHeight := trunc( NonZoomDestHeight - NonZoomDestHeight*fMarginBottom/100 -NonZoomDestHeight*fMarginTop/100)-2;
  ofx := 1 + trunc( x * fMarginLeft / 100 );
  ofy := 1 + trunc( y * fMarginTop / 100 );

  paintableRect := Rect(trunc(DestX+ofx*fZoom), trunc(DestY+ofy*fZoom), trunc(DestX+ofx*fZoom+NonZoomDestWidth*fZoom), trunc(DestY+ofy*fZoom+NonZoomDestHeight*fZoom));

  // draw text
  oldta := SetTextAlign(DestCanvas.Handle, TA_BASELINE);
  c := fTextWide;
  if c <> nil then
  begin
    fetch := true;
    fetchpos := c;
    maxh := 0;
    maxi := 0;
    maxde := 0;
    posy := 0;
    posx := 0;
    rposx := 0;
    prevend := 0;
    lasth := 0;
    lasti := 0;
    lastde := 0;
    repeat
      idx := (uint64(c) - uint64(fTextWide)) div 2;
      fposxarray[idx] := ofx + rposx;
      fposyarray[idx] := ofy + posy;
      case c^ of
        #0: // end of stream
          begin
            if (not fetch) then
              break; // exit loop
            DoNewLine;
            fStopAt := nil;
          end;
        #10: // new line
          begin
            if firstpos = -1 then
              firstpos := idx;
            CalcSizes; // we need at least a size
            inc(c);
            if (fInsertPos = firstpos) and (idx = firstpos) then
            begin
              fCaretX := ofx + 0;
              fCaretY := ofy + 0;
              fCaretH := maxh;
            end;
            if idx < fInsertPos then
            begin
              fCaretX := ofx + 0;
              fCaretY := ofy + posy + maxh;
              fCaretH := maxh;
            end;
            if (not fetch) then
              inc(enters);
            if (not fetch) and (c^ = #0) then
              break; // exit loop
            DoNewLine;
          end;
      else
        begin
          // printable character
          if firstpos = -1 then
            firstpos := idx;
          if fetch then
            inc(fetched);
          if (not fetch) and (c = fStopAt) then
          begin
            DoNewLine;
            continue;
          end;
          CalcSizes(); // set also w to the char width
          if fetch and (rposx + charWidth + 2 >= NonZoomDestWidth) then
          begin
            LineLarge(); // new line because the line is too much large
            if fStopAt = c then
              break;
            continue;
          end;
          if (not fetch) then
          begin
            // print the character
            x := DestX + ofx + rposx;
            y := DestY + ofy + (posy + maxh - maxi);
            if (idx >= fSelStart) and (idx < fSelStop) then
            begin
              // selected
              DestCanvas.Brush.Color := $00FFFFFF and (not DestCanvas.Brush.Color);
              DestCanvas.Font.Color := $00FFFFFF and (not DestCanvas.Font.Color);
              DestCanvas.Brush.Style := bsSolid;
            end;
            if posx <> rposx then
            begin
              // full justify, draw intra-spaces
              while prevend < rposx do
              begin
                xx := DestX + ofx + prevend;
                if diff <> nil then
                begin
                  diff^.x := xx;
                  diff^.y := y;
                  diff^.c := ' ';
                  diff^.idx := idx;
                  inc(difflen);
                  inc(diff);
                end
                else
                  PaintChar(xx, y, ' ');
                inc(prevend);
              end;
            end;
            if diff <> nil then
            begin
              diff^.x := x;
              diff^.y := y;
              diff^.c := c^;
              diff^.idx := idx;
              inc(diff);
              inc(difflen);
            end
            else
            begin
              PaintChar(x, y, WideChar(c^));
            end;

            if fWriteFormattedString then
            begin
              if y > DestY + ofy + NonZoomDestHeight then
                break;
              fFormattedString := fFormattedString + c^;
            end;

            if y + maxde > DestY + ofy + NonZoomDestHeight then
            begin
              if fAutoSize and Visible and assigned(Parent) then
              begin
                // only in edit mode
                Height := trunc((y+maxde+maxh)*fZoom);
                if diffbuf <> nil then
                  freemem(diffbuf);
                exit;
              end;
            end;

            inc(printed);
            if idx = fInsertPos then
            begin
              fCaretX := ofx + rposx;
              fCaretY := ofy + posy;
              fCaretH := maxh;
            end
            else
            if idx < fInsertPos then
            begin
              fCaretX := ofx + rposx + charWidth;
              fCaretY := ofy + posy;
              fCaretH := maxh;
            end;
          end;
          inc(posx, charWidth);
          prevend := rposx + charWidth;
          rposx := trunc(posx * PixelMult);
          inc(c);
        end;
      end;
    until False;
  end;
  if (printed + fetched + enters = 0) then
  begin
    fCaretX := ofx + 0;
    fCaretH := DestCanvas.Font.Height;
    fCaretY := ofy + 0;
  end;

  if fZoom <> 1 then
  begin
    // delayed painting
    diff := diffbuf;
    for i := 0 to difflen - 1 do
    begin
      RestoreCharInfo(diff^.idx, DestCanvas);
      DestCanvas.Font.Height := trunc(DestCanvas.Font.Height * fZoom);
      x := trunc((diff^.x - DestX) * fZoom);
      y := trunc((diff^.y - DestY) * fZoom);
      if (diff^.idx >= fSelStart) and (diff^.idx < fSelStop) then
      begin
        // selected
        DestCanvas.Brush.Color := $00FFFFFF and (not DestCanvas.Brush.Color);
        DestCanvas.Font.Color := $00FFFFFF and (not DestCanvas.Font.Color);
        DestCanvas.Brush.Style := bsSolid;
      end;
      //
      if i < difflen - 1 then
      begin
        nextdiff := diff;
        inc(nextdiff);
        if nextdiff^.y = diff^.y then
        begin
          k := DestCanvas.TextWidth(' ');
          j := DestX + x;
          while j < DestX + trunc((nextdiff^.x - DestX) * fZoom) do
          begin
            PaintChar(j, DestY + y, ' ');
            inc(j, k);
          end;
        end;
      end;
      //
      PaintChar(DestX + x, DestY + y, WideChar(diff^.c));
      inc(diff);
    end;
    freemem(diffbuf);
    for i := 0 to fTextLength - 1 do
    begin
      fposxarray[i] := trunc(fposxarray[i] * fZoom);
      fposyarray[i] := trunc(fposyarray[i] * fZoom);
    end;
    fCaretX := trunc(fCaretX * fZoom);
    fCaretY := trunc(fCaretY * fZoom);
    fCaretH := trunc(fCaretH * fZoom);
  end;
  if fAutoSize and (fCaretY + fCaretH > trunc(NonZoomDestHeight*fZoom)) and Visible and assigned(Parent) then
  begin
    // only in edit mode
    Height := trunc(fCaretY+fCaretH+maxde);
  end;

  fposxarray[fInsertPos] := fCaretX;
  fposyarray[fInsertPos] := fCaretY;
  SetTextAlign(DestCanvas.Handle, oldta);
end;

procedure TIETextControl.WMLButtonDblClk(var Message: TWMLButtonDblClk);
var
  i: integer;
begin
  inherited;
  if fTextLength = 0 then
    exit;
  // select word
  ResetSelection();
  // search first letter (we suppose MouseDown has already set the correct cursor position)
  GoWordBackIdx(fInsertPos);
  i := fInsertPos;
  // search last letter
  GoWordForwardIdx(fInsertPos);
  // return back until a char is found
  while (fInsertPos > 0) and (fTextWide[fInsertPos] < #33) do
    dec(fInsertPos);
  inc(fInsertPos);
  // select
  CopyCharInfoTo(fInsertPos - 1, fInsertingCharInfo);
  SStop(i, [ssShift]);
  Update;
end;

procedure TIETextControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  PrevInsertPos: integer;
begin
  inherited;

  if not Focused then
    //SetFocus; // this causes error
    Windows.SetFocus(handle);

  if ssShift in Shift then
  begin
    // select from last position
    MoveTo(fMouseDownX, fMouseDownY);
    PrevInsertPos := fInsertPos;
    MoveTo(x, y);
    if fInsertPos <> PrevInsertPos then
    begin
      SStop(PrevInsertPos, [ssShift]);
      Update;
    end;
    fMouseDownX := X;
    fMouseDownY := Y;
  end
  else
  begin
    fMouseDownX := X;
    fMouseDownY := Y;
    ResetSelection;
    MoveTo(x, y);
  end;
  Update;
  DoCursorMoved;
end;

procedure TIETextControl.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  PrevInsertPos: integer;
begin
  inherited;
  if MouseCapture then
  begin
    ResetSelection;
    MoveTo(fMouseDownX, fMouseDownY);
    PrevInsertPos := fInsertPos;
    MoveTo(x, y);
    if fInsertPos <> PrevInsertPos then
    begin
      SStop(PrevInsertPos, [ssShift]);
      Update;
    end;
    DoCursorMoved;
  end;
end;

procedure TIETextControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
end;

procedure TIETextControl.ResetSelection;
begin
  fSelStart := 0;
  fSelStop := 0;
end;

procedure TIETextControl.RemoveSelected;
begin
  if fSelStop > fSelStart then
  begin
    dec(fSelStop);
    while fSelStop >= fSelStart do
    begin
      DelChar(fSelStop);
      dec(fSelStop);
    end;
    fInsertPos := fSelStart;
    ResetSelection;
  end;
end;

procedure TIETextControl.CopyToClipboard;
var
  ht: THandle;
  i, l: integer;
  clp: PWideChar;
  cust: PAnsiChar;
  ws: WideString;
begin
  l := fSelStop - fSelStart;
  if l > 0 then
  begin
    if IEOpenClipboard then
    begin
      // unicode text
      i := fSelStart;
      while i < fSelStop do
      begin
        if fTextWide[i] = #10 then
          ws := ws + #13; // to make #13#10
        ws := ws + fTextWide[i];
        inc(i);
      end;
      ws := ws + #0;
      EmptyClipboard();
      ht := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, (length(ws) + 1) * 2);
      clp := GlobalLock(ht);
      move(ws[1], clp[0], (length(ws) + 1) * 2);
      GlobalUnlock(ht);
      SetClipboardData(CF_UNICODETEXT, ht);

      // custom text
      ht := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, (l + 1) * 2 + l * sizeof(TIECharInfo));
      cust := GlobalLock(ht);
      move(fTextWide[fSelStart], cust[0], l * 2);
      cust[l * 2]     := #0;
      cust[l * 2 + 1] := #0;
      for i := fSelStart to fSelStop - 1 do
        move(PIECharInfo(fCharInfo[fCharRef[i]])^, cust[(l + 1) * 2 + (i - fSelStart) * sizeof(TIECharInfo)], sizeof(TIECharInfo));
      GlobalUnlock(ht);
      SetClipboardData(IETEXTMEMOCLIPFORMAT, ht);

      CloseClipboard;
    end;
  end;
end;

procedure TIETextControl.PasteFromClipboard;
var
  hmem: THandle;
  ptr: PWideChar;
  i, l: integer;
begin
  if IEOpenClipboard then
  begin
    if IsClipboardFormatAvailable(IETEXTMEMOCLIPFORMAT) then
    begin
      // custom text
      hmem := GetClipboardData(IETEXTMEMOCLIPFORMAT);
      if hmem <> 0 then
      begin
        ptr := GlobalLock(hmem);
        l := IEStrLenW(ptr);
        i := 0;
        while ptr[i] <> #0 do
        begin
          move(ptr[(l + 1) * 2 + i * sizeof(TIECharInfo)], fInsertingCharInfo^, sizeof(TIECharInfo));
          AddChar(ptr[i]);
          inc(i);
        end;
        GlobalUnlock(hmem);
      end;
    end
    else
    if IsClipboardFormatAvailable(CF_UNICODETEXT) then
    begin
      // unicode text
      hmem := GetClipboardData(CF_UNICODETEXT);
      if hmem <> 0 then
      begin
        ptr := GlobalLock(hmem);
        while ptr^ <> #0 do
        begin
          if ptr^ <> #13 then
            AddChar(ptr^);
          inc(ptr);
        end;
        GlobalUnlock(hmem);
      end;
    end;
    CloseClipboard;
  end;
end;

procedure IncFont(ci: PIECharInfo);
begin
  if ci^.height < 0 then
    dec(ci^.height)
  else
    inc(ci^.height);
  if ci^.height = 0 then
    ci^.height := 1;
end;

procedure DecFont(ci: PIECharInfo);
begin
  if ci^.height < 0 then
    inc(ci^.height)
  else
    dec(ci^.height);
  if ci^.height = 0 then
    ci^.height := 1;
end;

procedure TIETextControl.IncFontSize;
var
  i: integer;
  ci: TIECharInfo;
begin
  if fSelStop > fSelStart then
  begin
    // apply to selection
    for i := fSelStart to fSelStop - 1 do
    begin
      move(fCharInfo[fCharRef[i]]^, ci, sizeof(TIECharInfo));
      IncFont(@ci);
      SaveCharInfo(i, @ci);
    end;
    ResetCache(fSelStart, fTextLength - fSelStart);
  end;
  IncFont(fInsertingCharInfo);
end;

procedure TIETextControl.DecFontSize;
var
  i: integer;
  ci: TIECharInfo;
begin
  if fSelStop > fSelStart then
  begin
    // apply to selection
    for i := fSelStart to fSelStop - 1 do
    begin
      move(fCharInfo[fCharRef[i]]^, ci, sizeof(TIECharInfo));
      DecFont(@ci);
      SaveCharInfo(i, @ci);
    end;
    ResetCache(fSelStart, fTextLength - fSelStart);
  end;
  DecFont(fInsertingCharInfo);
end;

procedure TIETextControl.InsertAlign(Align: TIEAlignment);
var
  i: integer;
  ci: TIECharInfo;
begin
  // search for start of line
  i := fInsertPos - 1;
  while (i > 0) and (fTextWide[i] <> #10) do
    dec(i);
  if i < 0 then
    i := 0;
  if (i < fTextLength) and (fTextWide[i] = #10) then
    inc(i);
  // set align until end of line
  while (i < fTextLength) and (fTextWide[i] <> #10) do
  begin
    CopyCharInfoTo(i, @ci);
    ci.align := Align;
    SaveCharInfo(i, @ci);
    inc(i);
  end;
  fInsertingCharInfo^.align := Align;
end;

procedure setfnt(ci: PIECharInfo; fnt: TFont);
begin
  ci^.name := ShortString(fnt.Name);
  ci^.height := fnt.Height;
  ci^.style := fnt.Style;
  ci^.color := fnt.Color;
end;

procedure TIETextControl.SetXFont(fnt: TFont);
var
  i: integer;
  ci: TIECharInfo;
begin
  if fSelStop > fSelStart then
  begin
    // apply to selection
    for i := fSelStart to fSelStop - 1 do
    begin
      move(fCharInfo[fCharRef[i]]^, ci, sizeof(TIECharInfo));
      setfnt(@ci, fnt);
      SaveCharInfo(i, @ci);
    end;
    ResetCache(fSelStart, fTextLength - fSelStart);
  end;
  setfnt(fInsertingCharInfo, fnt);
end;

procedure TIETextControl.SetXBackColor(bk: TColor);
var
  i: integer;
  ci: TIECharInfo;
begin
  if fSelStop > fSelStart then
  begin
    // apply to selection
    for i := fSelStart to fSelStop - 1 do
    begin
      move(fCharInfo[fCharRef[i]]^, ci, sizeof(TIECharInfo));
      ci.brushColor := bk;
      SaveCharInfo(i, @ci);
    end;
    ResetCache(fSelStart, fTextLength - fSelStart);
  end;
  fInsertingCharInfo^.brushColor := bk;
end;

procedure TIETextControl.SwitchFontStyle(sty: TFontStyle);
var
  i: integer;
  ci: TIECharInfo;
  ss: TFontStyles;
begin
  if fSelStop > fSelStart then
  begin
    // apply to selection
    ss := PIECharInfo(fCharInfo[fCharRef[fSelStart]])^.style; // get the first char style, and use only it
    if sty in ss then
      ss := ss - [sty]
    else
      ss := ss + [sty];
    for i := fSelStart to fSelStop - 1 do
    begin
      move(fCharInfo[fCharRef[i]]^, ci, sizeof(TIECharInfo));
      ci.style := ss;
      SaveCharInfo(i, @ci);
    end;
    ResetCache(fSelStart, fTextLength - fSelStart);
  end
  else
  begin
    if sty in fInsertingCharInfo^.style then
      fInsertingCharInfo^.style := fInsertingCharInfo^.style - [sty]
    else
      fInsertingCharInfo^.style := fInsertingCharInfo^.style + [sty];
  end;
end;

procedure TIETextControl.WMCut(var Message: TMessage);
var
  key: word;
  Shift: TShiftState;
begin
  ShortCutToKey(IEGlobalSettings().MemoShortCuts[iesCUT], Key, Shift);
  KeyDown(key, Shift);
end;

procedure TIETextControl.WMCopy(var Message: TMessage);
var
  key: word;
  Shift: TShiftState;
begin
  ShortCutToKey(IEGlobalSettings().MemoShortCuts[iesCOPY], Key, Shift);
  KeyDown(key, Shift);
end;

procedure TIETextControl.WMPaste(var Message: TMessage);
var
  key: word;
  Shift: TShiftState;
begin
  ShortCutToKey(IEGlobalSettings().MemoShortCuts[iesPASTE], Key, Shift);
  KeyDown(key, Shift);
end;

procedure TIETextControl.SetFontLocked(value: boolean);
begin
  fFontLocked := value;
  Update;
end;

procedure TIETextControl.DoCursorMoved;
begin
  if assigned(fOnCursorMoved) then
    fOnCursorMoved(self);
end;

procedure IEInitialize_ietextc;
begin
  IETEXTMEMOCLIPFORMAT := RegisterClipboardFormat(PChar(string(IETEXTMEMOCLIPFORMAT_NAME)));
end;

procedure IEFinalize_ietextc;
begin
end;



end.