ietextc.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

    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);
begin
  if (Key > #31) and (key <> #127) then
  begin
    RemoveSelected;
    if fInsMode then
      AddChar(Key)
    else
    begin
      fInsertPos := DelChar(fInsertPos);
      AddChar(Key);
    end;
  end;
  Paint;
end;

procedure TIETextControl.KeyDown(var Key: Word; Shift: TShiftState);
var
  PrevInsertPos: integer;
  fd: TFontDialog;
  cl: TColorDialog;
  sc: TShortCut;
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=iegMemoShortCuts[iesLEFTALIGN] then
  begin
    // left align
    InsertAlign(iejLeft);
    Update;
  end
  else if sc=iegMemoShortCuts[iesCENTERALIGN] then
  begin
    // center align
    InsertAlign(iejCenter);
    Update;
  end
  else if sc=iegMemoShortCuts[iesRIGHTALIGN] then
  begin
    // right align
    InsertAlign(iejRight);
    Update;
  end
  else if sc=iegMemoShortCuts[iesJUSTIFIED] then
  begin
    // justified
    InsertAlign(iejJustify);
    Update;
  end
  else if sc=iegMemoShortCuts[iesCOPY] then
  begin
    // copy to clipboard
    CopyToClipboard;
  end
  else if sc=iegMemoShortCuts[iesCUT] then
  begin
    // cut to clipboard
    CopyToClipboard;
    RemoveSelected;
    Update;
  end
  else if sc=iegMemoShortCuts[iesPASTE] then
  begin
    // paste from clipboard
    RemoveSelected;
    PasteFromClipboard;
    Update;
  end
  else if (sc=iegMemoShortCuts[iesFONTSELECT]) and (not fFontLocked) then
  begin
    // open font dialog
    fd := TFontDialog.Create(self);
    fd.Font.Name := 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=iegMemoShortCuts[iesBOLD] then
  begin
    // bold
    SwitchFontStyle(fsBold);
    Update;
  end
  else if sc=iegMemoShortCuts[iesITALIC] then
  begin
    // italic
    SwitchFontStyle(fsItalic);
    Update;
  end
  else if sc=iegMemoShortCuts[iesUNDERLINE] then
  begin
    SwitchFontStyle(fsUnderline);
    Update;
  end
  else if (sc=iegMemoShortCuts[iesBACKCOLORSELECT]) and (not fFontLocked) then
  begin
    // select background color
    cl := TColorDialog.Create(self);
    cl.Color := fInsertingCharInfo^.brushColor;
    if cl.Execute then
      SetXBackColor(cl.Color);
    FreeAndNil(cl);
    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;
begin
  if Visible then
  begin
    DestroyCaret;
    if (fBackbuf.Width <> ClientWidth) or (fBackbuf.Height <> ClientHeight) then
    begin
      fBackbuf.Width := ClientWidth;
      fBackbuf.Height := ClientHeight;
    end;
    ClearBitmap;
    PaintTo(fBackbuf.Canvas, 0, 0, trunc(ClientWidth / fZoom), trunc(ClientHeight / fZoom));
    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 fText <> nil then
    fTextLength := strlen(fText)
  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 := 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 fposxarray <> nil then
    freemem(fposxarray);
  if fposyarray <> nil then
    freemem(fposyarray);
  fcache_h := allocmem(fTextLength + 1);
  fcache_w := allocmem(fTextLength + 1);
  fcache_InternalLeading := 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 := 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;