ietextc.pas

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

    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
          for j := DestX + x to DestX + trunc((nextdiff^.x - DestX) * fZoom) do
            DestCanvas.TextOut(j, DestY + y, ' ');
      end;
      //
      DestCanvas.TextOut(DestX + x, DestY + y, 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 > NonZoomDestHeight) and Visible then
  begin
    // only in edit mode
    Height := Height + fCaretH;
  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 (fText[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, j, l: integer;
  ascii, cust: pchar;
begin
  l := fSelStop - fSelStart;
  if l > 0 then
  begin
    if OpenClipboard(0) then
    begin
      EmptyClipboard;
      // ascii text
      ht := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, l * 2);
      ascii := GlobalLock(ht);
      i := fSelStart;
      j := 0;
      while i < fSelStop do
      begin
        ascii[j] := fText[i];
        if ascii[j] = #10 then
        begin
          ascii[j] := #13;
          ascii[j + 1] := #10;
          inc(j);
        end;
        inc(j);
        inc(i);
      end;
      ascii[j] := #0;
      GlobalUnlock(ht);
      SetClipboardData(CF_TEXT, ht);
      // custom text
      ht := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, l + 1 + l * sizeof(TIECharInfo));
      cust := GlobalLock(ht);
      move(fText[fSelStart], cust[0], l);
      cust[l] := #0;
      for i := fSelStart to fSelStop - 1 do
        move(PIECharInfo(fCharInfo[fCharRef[i]])^, cust[l + 1 + (i - fSelStart) * sizeof(TIECharInfo)], sizeof(TIECharInfo));
      GlobalUnlock(ht);
      SetClipboardData(IETEXTMEMOCLIPFORMAT, ht);
      //
      CloseClipboard;
    end;
  end;
end;

procedure TIETextControl.PasteFromClipboard;
var
  hmem: THandle;
  ptr: pchar;
  i, l: integer;
begin
  if OpenClipboard(0) then
  begin
    if IsClipboardFormatAvailable(IETEXTMEMOCLIPFORMAT) then
    begin
      // custom text
      hmem := GetClipboardData(IETEXTMEMOCLIPFORMAT);
      if hmem <> 0 then
      begin
        ptr := GlobalLock(hmem);
        l := strlen(ptr);
        i := 0;
        while ptr[i] <> #0 do
        begin
          move(ptr[l + 1 + i * sizeof(TIECharInfo)], fInsertingCharInfo^, sizeof(TIECharInfo));
          AddChar(ptr[i]);
          inc(i);
        end;
        GlobalUnlock(hmem);
      end;
    end
    else if IsClipboardFormatAvailable(CF_TEXT) then
    begin
      // ascii text
      hmem := GetClipboardData(CF_TEXT);
      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 (fText[i] <> #10) do
    dec(i);
  if i < 0 then
    i := 0;
  if (i < fTextLength) and (fText[i] = #10) then
    inc(i);
  // set align until end of line
  while (i < fTextLength) and (fText[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 := 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(iegMemoShortCuts[iesCUT],Key,Shift);
  KeyDown(key, Shift);
end;

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

procedure TIETextControl.WMPaste(var Message: TMessage);
var
  key: word;
  Shift: TShiftState;
begin
  ShortCutToKey(iegMemoShortCuts[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;


initialization
  begin
    IETEXTMEMOCLIPFORMAT := RegisterClipboardFormat(pchar(string(IETEXTMEMOCLIPFORMAT_NAME)));
  end;


end.