unit CCEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  CCGeneral;

type
  TCCVirtualEdit=class(TCCVirtualComponent)
    protected
      MovingX_i,SelStart_i:integer;
      Focused_b{,CaretLinks_b}:boolean;
      //Eigenschaften
      FFont:TFont;
      FCaretX_i:integer;
      FText_s:string;
      FReadonly_b:boolean;
      procedure SetText(const value:string);
      procedure SetReadOnly(const value:boolean);
      procedure SetCaretX(const value:integer);
      procedure SetFont(const value:TFont);
      procedure SetSelText(const value:string);
      function GetSelText():string;
    public
      constructor create(aowner:TCCComponent);override;
      destructor destroy;override;
      procedure Paint;override;

      procedure GotFocus;override;
      procedure LostFocus;override;

      procedure WndProc(var Message: TMessage);override;
      //Ereignisse
      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 KeyDown(var Key: Word; Shift: TShiftState);override;
      procedure KeyPress(var Key: Char);override;
    published
      property CaretX:integer read FCaretX_i write SetCaretX;
      property Text:string read Ftext_s write SetText;
      property ReadOnly:boolean read Freadonly_b write SetReadOnly;
      property Font:TFont read ffont write SetFont;
      property SelText:string read GetSelText write SetSelText;
  end;

type
  TCCEdit = class(TCCComponent)
  private
    { Private-Deklarationen}

  protected

    { Protected-Deklarationen}
    function GetText:string;
    procedure SetText(const value:string);
    function GetReadOnly:boolean;
    procedure SetReadOnly(const value:boolean);
    function GetFont:TFont;
    procedure SetFont(const value:TFont);
  public
    vedit:TCCVirtualEdit;

    { Public-Deklarationen}
    constructor create(aowner:TComponent);override;
    destructor destroy;override;
    procedure WndProc(var Message: TMessage);override;
    procedure paint;override;
    procedure DoEnter;override;
    procedure DoExit;override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
    procedure KeyDown(var Key: Word; Shift: TShiftState);override;
    procedure KeyPress(var Key: Char);override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
  published
    { Published-Deklarationen }
    property Text:string read GetText write SetText;
    property ReadOnly:boolean read GetReadOnly write SetReadOnly;
    property Font:TFont read GetFont write SetFont;
  end;

procedure Register;

implementation
procedure TCCVirtualEdit.SetText(const value:string);
begin
  FText_s:=value;
  Paint;
end;
procedure TCCVirtualEdit.SetReadOnly(const value:boolean);
begin
  FReadonly_b:=value;
end;
procedure TCCVirtualEdit.SetCaretX(const value:integer);
begin
  if value<0 then FCaretX_i:=0
  else if value>length(FText_s) then FCaretX_i:=length(FText_s)
  else FCaretX_i:=value;
end;
procedure TCCVirtualEdit.SetFont(const value:TFont);
begin
  FFont.Assign(value);
end;
procedure TCCVirtualEdit.SetSelText(const value:string);
var temp:string;
begin
  HideCaret(control.handle);
  temp:=text;
  if SelStart_i<>CaretX then
    if SelStart_i<CaretX then begin
       if SelStart_i=0 then
         delete(temp,1,caretX-SelStart_i)
        else
         delete(temp,SelStart_i,caretX-SelStart_i)
     end else
       if caretX=0 then
         delete(temp,1,SelStart_i-caretX)
        else
         delete(temp,CaretX,SelStart_i-caretX);
  caretX:=SelStart_i;
  insert(value,temp,caretX+1);
  text:=temp;
  caretX:=caretX+Length(value);
  SelStart_i:=CaretX;
  if left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i>width-3 then begin
    MovingX_i:=left+13+(control.canvas.TextWidth(copy(text,1,CaretX)))-width;
    paint;
  end;
  if left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i<3 then begin
    MovingX_i:=left+13+(control.canvas.TextWidth(copy(text,1,CaretX)));
    paint;
  end;
  SetCaretPos(left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i,top+(height-control.canvas.TextHeight('.abcdABCD')) div 2);
  ShowCaret(control.handle);
end;
function TCCVirtualEdit.GetSelText():string;
begin
  if SelStart_i>CaretX then result:=copy(text,caretx+1,selstart_i-caretx)
  else if SelStart_i<CaretX then result:=copy(text,selstart_i+1,caretx-selstart_i)
  else result:='';
end;
constructor TCCVirtualEdit.create(aowner:TCCComponent);
begin
  inherited;
  FCaretX_i:=0;
  FFont:=tfont.create;
end;
destructor TCCVirtualEdit.destroy;
begin
  FFont.Free;
  inherited;
end;
procedure TCCVirtualEdit.GotFocus;
begin
  CreateCaret(control.handle,0,2,control.canvas.TextHeight('.abcdABCD'));
  ShowCaret(control.handle);
  SetCaretPos(left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i,top+(height-control.canvas.TextHeight('.abcdABCD')) div 2);
  Focused_b:=true;
end;
procedure TCCVirtualEdit.LostFocus;
begin
  Focused_b:=false;
  HideCaret(control.handle);
end;
procedure TCCVirtualEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var i,breite,oldbreite:integer;
begin
  control.SetFocus;
  if (x<left) or (y<top) or (x>width) or (y>height) then exit;
  breite:=0;
  for i:=1 to length(text) do begin
    oldbreite:=breite;
    breite:=breite+control.canvas.TextWidth(text[i]);
    if breite>x+MovingX_i then begin
      if breite-x-MovingX_i>x+MovingX_i-oldbreite then
        CaretX:=i-1
       else
        CaretX:=i;
      SelStart_i:=CaretX;
      SetCaretPos(left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i,top+(height-control.canvas.TextHeight('.abcdABCD')) div 2);
      ShowCaret(control.handle);
      exit;
    end;
  end;
  caretX:=length(text);
  SelStart_i:=CaretX;
  SetCaretPos(left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i,top+(height-control.canvas.TextHeight('.abcdABCD')) div 2);
  ShowCaret(control.handle);
end;
procedure TCCVirtualEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
var i,breite,oldbreite:integer;
begin
  if (x<left) or (y<top) or (x>width) or (y>height) then exit;

  if control.Cursor<>crIBeam then
    control.Cursor:=crIBeam;
  if ssLeft in shift then begin
    breite:=0;
    for i:=1 to length(text) do begin
      oldbreite:=breite;
      breite:=breite+control.canvas.TextWidth(text[i]);
      if breite>x+MovingX_i then begin
        if breite-x-MovingX_i>x+MovingX_i-oldbreite then
          CaretX:=i-1
         else
          CaretX:=i;
        SetCaretPos(left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i,top+(height-control.canvas.TextHeight('.abcdABCD')) div 2);
        ShowCaret(control.handle);
        paint;
        exit;
      end;
    end;
    caretX:=length(text);
    SetCaretPos(left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i,top+(height-control.canvas.TextHeight('.abcdABCD')) div 2);
    ShowCaret(control.handle);
    paint;
  end;
end;
procedure TCCVirtualEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
end;
procedure TCCVirtualEdit.KeyDown(var Key: Word; Shift: TShiftState);
var tex:string;
begin
  HideCaret(control.handle);
  case key of
    vk_left: begin
               CaretX:=CaretX-1;
               if not(ssShift in shift) then
                 SelStart_i:=CaretX;
             end;
    vk_right: begin
                CaretX:=CaretX+1;
                if not(ssShift in shift) then
                  SelStart_i:=CaretX;
              end;
    VK_BACK: begin
               if SelStart_i=CaretX then begin
                 tex:=text;
                 delete(tex,caretX,1);
                 text:=tex;
                 caretx:=caretX-1;
               end else
                 SelText:='';
             end;
    VK_DELETE: begin
               if SelStart_i=CaretX then begin
                 tex:=text;
                 delete(tex,caretX+1,1);
                 text:=tex;
               end else
                 SelText:='';
             end;
    VK_END: begin
              CaretX:=length(text);
              if not(ssShift in shift) then
                SelStart_i:=CaretX;
            end;
    VK_HOME: begin
              CaretX:=0;
              if not(ssShift in shift) then
                SelStart_i:=CaretX;
             end;
  end;
  if left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i>width-3 then begin
    MovingX_i:=left+13+(control.canvas.TextWidth(copy(text,1,CaretX)))-width;
    paint;
  end;
  if left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i<3 then begin
    MovingX_i:=left+(control.canvas.TextWidth(copy(text,1,CaretX)));
    paint;
  end;
  paint;
  SetCaretPos(left+3+(control.canvas.TextWidth(copy(text,1,CaretX)))-MovingX_i,top+(height-control.canvas.TextHeight('.abcdABCD')) div 2);
  ShowCaret(control.handle);
end;
procedure TCCVirtualEdit.KeyPress(var Key: Char);
begin
  if key>#31 then SelText:=key;
end;
procedure TCCVirtualEdit.WndProc(var Message: TMessage);
begin
  case message.msg of
    WM_GETDLGCODE: Message.Result:=DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_HASSETSEL;
    else inherited;
  end;
end;
procedure TCCVirtualEdit.Paint;
var texrect:TRect;
    tempx:integer;
    tempnoseltext1,tempseltext,tempnoseltext2:string;
    tempnoseltext1width_i,tempseltextwidth_i,tempnoseltext2width_i:integer;
    toppos:integer;
begin
  if control = nil then exit;
  if control.DarstellungsOptionen = nil then begin
    control.Canvas.TextOut(left+2,top+5,'DarstellungsOptionen fehlen');
    exit;
  end;
  with control.canvas do begin
    brush.Style:=bsSolid;
    brush.Color:=control.DarstellungsOptionen.getColorFromWindowColorKey(COLOR_WINDOW);
    FillRect(rect(left,top,left+width,top+height));
    brush.Style:=bsClear;
    control.drawLowerEditRect(left,top,left+width,top+height,true);
    if assigned(ffont) then Font.Assign(ffont);
    TexRect:=rect(left,top,left+width,top+height);
    brush.Style:=bsClear;
    toppos:=top+(height-TextHeight('.abcdABCD')) div 2;
    if CaretX=SelStart_i then TextRect(TexRect,left+3-MovingX_i,toppos,text)
    else begin
      if CaretX<SelStart_i then begin
        tempnoseltext1:=copy(text,1,caretx);
        tempseltext:=SelText;
        tempnoseltext2:=copy(text,selstart_i+1,length(text));
      end else if CaretX>SelStart_i then begin
        tempnoseltext1:=copy(text,1,selstart_i);
        tempseltext:=SelText;
        tempnoseltext2:=copy(text,caretx+1,length(text));
      end;
      tempnoseltext1width_i:=TextWidth(tempnoseltext1);
      tempseltextwidth_i:=TextWidth(tempseltext);
      tempnoseltext2width_i:=TextWidth(tempnoseltext2);

      font.Color:=control.DarstellungsOptionen.getColorFromWindowColorKey(COLOR_WINDOWTEXT);
      TextRect(TexRect,left+3-MovingX_i,toppos,tempnoseltext1);
      TextRect(TexRect,left+3-MovingX_i+tempnoseltext1width_i+tempseltextwidth_i,toppos,tempnoseltext2);
      brush.Color:=control.DarstellungsOptionen.getColorFromWindowColorKey(COLOR_HIGHLIGHT);
      pen.color:=brush.color;
      if left+3-MovingX_i+tempnoseltext1width_i<left then
        tempx:=left
       else
        tempx:=left+3-MovingX_i+tempnoseltext1width_i;
      if tempx+tempseltextwidth_i>left+width then
        tempseltextwidth_i:=left-tempx+width;
      Rectangle(tempx,toppos,tempx+tempseltextwidth_i,toppos+TextHeight('.abcdABCD'));
      brush.style:=bsClear;
      font.Color:=control.DarstellungsOptionen.getColorFromWindowColorKey(COLOR_HIGHLIGHTTEXT);
      TextRect(TexRect,left+3-MovingX_i+TextWidth(tempnoseltext1),toppos,tempseltext);
    end;
  end;
end;

constructor TCCEdit.create(aowner:TComponent);
begin
  inherited;
  vedit:=TCCVirtualEdit.create(self);
end;
destructor TCCEdit.destroy;
begin
  inherited;
  vedit.free;
end;
procedure TCCEdit.WndProc(var Message: TMessage);
begin
  if assigned(vedit) then vedit.WndProc(message);
  if message.Msg<>WM_GetDlgCode then inherited;
end;
procedure TCCEdit.paint;
begin
  vedit.paint;
end;
function TCCEdit.GetText:string;
begin
  result:=vedit.Text;
end;
procedure TCCEdit.SetText(const value:string);
begin
  vedit.Text:=value;
end;
function TCCEdit.GetReadOnly:boolean;
begin
  result:=vedit.ReadOnly;
end;
procedure TCCEdit.SetReadOnly(const value:boolean);
begin
  vedit.ReadOnly:=value;
end;
function TCCEdit.GetFont:TFont;
begin
  result:=vedit.font;
end;
procedure TCCEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if assigned(vedit) then vedit.MouseMove(shift,x,y);
  inherited;
end;
procedure TCCEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if assigned(vedit) then vedit.MouseDown(button,shift,x,y);
  inherited;
end;
procedure TCCEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if assigned(vedit) then vedit.KeyDown(key,shift);
  inherited;
end;
procedure TCCEdit.KeyPress(var Key: Char);
begin
  if assigned(vedit) then vedit.KeyPress(key);
  inherited;
end;
procedure TCCEdit.DoEnter;begin vedit.GotFocus;inherited;end;
procedure TCCEdit.DoExit;begin vedit.LostFocus;inherited;end;
procedure TCCEdit.SetFont(const value:TFont);
begin
  vedit.font:=value;
end;
procedure Register;
begin
  RegisterComponents('Custom Controls', [TCCEdit]);
end;

end.
