unitasedit.pas

仿速达界面控件

  end
  else
  begin
    Canvas.Font.Assign(Self.Font);
    CurX := GetEditRect.Left + TextWidth(Canvas, Text[FFirstVisibleChar],
      DT_NOPREFIX) / 2;
    while (CurX < TmpX) and (Result + 1 <= Length(Text)) and (CurX <
      GetEditRect.Right) do
    begin
      CurX := CurX + TextWidth(Canvas, Text[Result + 1], DT_NOPREFIX) / 2;
      if Result + 1 + 1 <= Length(Text) then
        CurX := CurX + TextWidth(Canvas, Text[Result + 1 + 1], DT_NOPREFIX) / 2;
      Result := Result + 1;
    end;
  end;
end;

function TCustomASEdit.GetEditRect: TRect;
begin
  with Result do
  begin
    //Result := GetBorderRect;
    Result := ClientRect;
    Canvas.Font.Assign(Self.Font);
    Inc(Result.Top, BorderWidth + 2);
    Inc(Result.Left, BorderWidth + 2);
    Dec(Result.Right, 2);
    Result.Bottom := Result.Top + Canvas.TextHeight('Pq汉字大小高度');
  end;
end;

function TCustomASEdit.GetAlignmentFlags: integer;
begin
  case FTextAlignment of
    taCenter: Result := DT_CENTER;
    taRightJustify: Result := DT_RIGHT;
  else
    Result := DT_LEFT;
  end;
end;

procedure TCustomASEdit.KeyDown(var Key: word; Shift: TShiftState);
var
  TmpS              : WideString;
  OldCaretPosition  : integer;
begin
  inherited KeyDown(Key, Shift);
  OldCaretPosition := CaretPosition;
  case Key of
    VK_END: CaretPosition := Length(Text);
    VK_HOME: CaretPosition := 0;
    VK_LEFT:
      if ssCtrl in Shift then
        CaretPosition := GetPrivWordBeging(CaretPosition)
      else
        CaretPosition := CaretPosition - 1;
    VK_RIGHT:
      if ssCtrl in Shift then
        CaretPosition := GetNextWordBeging(CaretPosition)
      else
        CaretPosition := CaretPosition + 1;
    VK_DELETE, 8:                       //删除和回退按键
      if not ReadOnly then
      begin
        if SelLength <> 0 then
        begin
          if Shift = [ssShift] then
            CutToClipboard
          else
            ClearSelection;
        end
        else
        begin
          TmpS := Text;
          if TmpS <> '' then
            if Key = VK_DELETE then
            begin
              FActionStack.FragmentDeleted(CaretPosition + 1, TmpS[CaretPosition
                + 1]);
              Delete(TmpS, CaretPosition + 1, 1);
            end
            else
            begin                       {回退}
              if CaretPosition > 0 then
                FActionStack.FragmentDeleted(CaretPosition,
                  TmpS[CaretPosition]);
              Delete(TmpS, CaretPosition, 1);
              CaretPosition := CaretPosition - 1;
            end;
          Text := TmpS;
        end;
      end;
    VK_INSERT:
      if Shift = [ssCtrl] then
        CopyToClipboard
      else
        if Shift = [ssShift] then
          PasteFromClipboard;
    Ord('c'),
      Ord('C'):
      if Shift = [ssCtrl] then
        CopyToClipboard;
    Ord('v'),
      Ord('V'):
      if Shift = [ssCtrl] then
        PasteFromClipboard;
    Ord('x'),
      Ord('X'):
      if Shift = [ssCtrl] then
        CutToClipboard;
    Ord('z'), Ord('Z'):
      if Shift = [ssCtrl] then
        UnDo;
  end;

  if Key in [VK_END, VK_HOME, VK_LEFT, VK_RIGHT] then
  begin
    if ssShift in Shift then
    begin
      if SelLength = 0 then
        FSelStart := OldCaretPosition;
      FSelStart := CaretPosition;
      FSelLength := FSelLength - (CaretPosition - OldCaretPosition);
    end
    else
      FSelLength := 0;
    Invalidate;
  end;
  UpdateCaretePosition;
end;

procedure TCustomASEdit.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);

  if (Ord(Key) >= 32) and not ReadOnly then
    InsertChar(WideChar(Key));
end;

procedure TCustomASEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
  x, y: integer);
begin
  inherited;
  if Button = mbLeft then
    FLMouseSelecting := true;

  SetFocus;

  if Button = mbLeft then
  begin
    CaretPosition := GetCoordinatePosition(x);
    SelLength := 0;
  end;
end;

procedure TCustomASEdit.PaintBuffer;
var
  R                 : TRect;
begin
  R := Rect(0, 0, Width, Height);
  InflateRect(R, -BorderWidth, -BorderWidth);
  R.Bottom := Height - R.Top;

  PaintBackground(R, Canvas);

  //画出选择区的高亮颜色
  if Focused or not HideSelection then
  begin
    R := GetSelRect;
    FillRect(Canvas, R, clHighlight);
  end;

  //
  PaintText;

  //画出选择区的反色文字
  if Focused or not HideSelection then
    PaintSelectedText;
end;

procedure TCustomASEdit.PaintBackground(Rect: TRect; Canvas: TCanvas);
begin
  FillRect(Canvas, Rect, {clWhite); //} Self.Color);
end;

procedure TCustomASEdit.PaintText;
var
  TmpRect           : TRect;
  CurChar           : integer;
  LPWCharWidth      : integer;
begin
  TmpRect := GetEditRect;
  Canvas.Font.Assign(Self.Font);
  Canvas.Brush.Style := bsClear;
  if FPasswordChar <> #0 then
  begin
    LPWCharWidth := GetPasswordCharWidth;
    for CurChar := 0 to Length(Text) - FFirstVisibleChar + 1 - 1 do
      DrawPasswordChar(Rect(CurChar * LPWCharWidth + GetCharX(0),
        TmpRect.Top,
        (CurChar + 1) * LPWCharWidth + GetCharX(0),
        TmpRect.Bottom), false);
  end
  else
  begin
    DrawText(Canvas, Copy(Text, FFirstVisibleChar, Length(Text) -
      FFirstVisibleChar + 1), TmpRect, GetAlignmentFlags or DT_NOPREFIX);
  end;
end;

procedure TCustomASEdit.UpdateFirstVisibleChar;
var
  LEditRect         : TRect;
begin
  if FFirstVisibleChar >= (FCaretPosition + 1) then
  begin
    FFirstVisibleChar := FCaretPosition;
    if FFirstVisibleChar < 1 then
      FFirstVisibleChar := 1;
  end
  else
  begin
    LEditRect := GetEditRect;

    if FPasswordChar <> #0 then
      while ((FCaretPosition - FFirstVisibleChar + 1) * GetPasswordCharWidth >
        LEditRect.Right - LEditRect.Left)
        and (FFirstVisibleChar < Length(Text)) do
        Inc(FFirstVisibleChar)
    else
    begin
      Canvas.Font.Assign(Self.Font);
      while (TextWidth(Canvas, Copy(Text, FFirstVisibleChar, FCaretPosition -
        FFirstVisibleChar + 1), DT_NOPREFIX) > LEditRect.Right - LEditRect.Left)
        and (FFirstVisibleChar < Length(Text)) do
        Inc(FFirstVisibleChar);
    end;
  end;
  Invalidate;
end;

procedure TCustomASEdit.MouseMove(Shift: TShiftState; x, y: integer);
var
  OldCaretPosition  : integer;
  TmpNewPosition    : integer;
begin
  inherited;
  if FLMouseSelecting then
  begin
    TmpNewPosition := GetCoordinatePosition(x);
    OldCaretPosition := CaretPosition;
    if (x > GetEditRect.Right) then
      CaretPosition := TmpNewPosition + 1
    else
      CaretPosition := TmpNewPosition;
    if SelLength = 0 then
      FSelStart := OldCaretPosition;
    FSelStart := CaretPosition;
    FSelLength := FSelLength - (CaretPosition - OldCaretPosition);
  end;
end;

procedure TCustomASEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
  x, y: integer);
begin
  inherited;
  FLMouseSelecting := false;
end;

procedure TCustomASEdit.CopyToClipboard;
var
  Data              : THandle;
  DataPtr           : Pointer;
  Size              : Cardinal;
  S                 : WideString;
begin
  if FPasswordChar = #0 then
    if Length(SelText) > 0 then
    begin
      S := SelText;
      if not IsWinNT then
      begin
        Clipboard.AsText := S;
      end
      else
      begin
        Size := Length(S);
        Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, 2 * Size + 2);
        try
          DataPtr := GlobalLock(Data);
          try
            Move(PWideChar(S)^, DataPtr^, 2 * Size + 2);
            Clipboard.SetAsHandle(CF_UNICODETEXT, Data);
          finally
            GlobalUnlock(Data);
          end;
        except
          GlobalFree(Data);
          raise;
        end;
      end;
    end;
end;

procedure TCustomASEdit.PasteFromClipboard;
var
  Data              : THandle;
  Insertion         : WideString;
begin
  if ReadOnly then
    Exit;

  if Clipboard.HasFormat(CF_UNICODETEXT) then
  begin
    Data := Clipboard.GetAsHandle(CF_UNICODETEXT);
    try
      if Data <> 0 then
        Insertion := PWideChar(GlobalLock(Data));
    finally
      if Data <> 0 then
        GlobalUnlock(Data);
    end;
  end
  else
    Insertion := Clipboard.AsText;

  InsertText(Insertion);
end;

procedure TCustomASEdit.PaintSelectedText;
var
  TmpRect           : TRect;
  CurChar           : integer;
  LPWCharWidth      : integer;
begin
  TmpRect := GetSelRect;

  if FPasswordChar <> #0 then
  begin
    LPWCharWidth := GetPasswordCharWidth;
    for CurChar := 0 to Length(GetVisibleSelText) - 1 do
      DrawPasswordChar(Rect(CurChar * LPWCharWidth + TmpRect.Left,
        TmpRect.Top, (CurChar + 1) * LPWCharWidth + TmpRect.Left,
        TmpRect.Bottom), true);
  end
  else
  begin
    //Canvas.Font.Assign(Self.Font);
    Canvas.Font.Color := clHighlightText;
    DrawText(Canvas, GetVisibleSelText, TmpRect, GetAlignmentFlags or
      DT_NOPREFIX)
  end;
end;

function TCustomASEdit.GetVisibleSelText: WideString;
begin
  if SelStart + 1 >= FFirstVisibleChar then
    Result := SelText
  else
    Result := Copy(SelText, FFirstVisibleChar - SelStart, Length(SelText) -
      (FFirstVisibleChar - SelStart) + 1);
end;

procedure TCustomASEdit.DoCut(Sender: TObject);
begin
  CutToClipboard;
end;

procedure TCustomASEdit.DoCopy(Sender: TObject);
begin
  CopyToClipboard;
end;

procedure TCustomASEdit.DoDelete(Sender: TObject);
begin
  ClearSelection;
end;

procedure TCustomASEdit.DoPaste(Sender: TObject);
begin
  PasteFromClipboard;
end;

function TCustomASEdit.GetNextWordBeging(StartPosition: integer): integer;
var
  SpaceFound,
    WordFound       : boolean;
begin
  Result := StartPosition;
  SpaceFound := false;
  WordFound := false;
  while (Result + 2 <= Length(Text)) and
    ((not ((Text[Result + 1] <> Space) and SpaceFound))
    or not WordFound) do
  begin
    if Text[Result + 1] = Space then
      SpaceFound := true;
    if Text[Result + 1] <> Space then
    begin
      WordFound := true;
      SpaceFound := false;
    end;

    Result := Result + 1;
  end;
  if not SpaceFound then
    Result := Result + 1;
end;

function TCustomASEdit.GetPrivWordBeging(StartPosition: integer): integer;
var
  WordFound         : boolean;
begin
  Result := StartPosition;
  WordFound := false;
  while (Result > 0) and
    ((Text[Result] <> Space) or not WordFound) do
  begin
    if Text[Result] <> Space then
      WordFound := true;
    Result := Result - 1;
  end;
end;

procedure TCustomASEdit.ClearSelection;
var
  TmpS              : WideString;
begin
  if ReadOnly then
    Exit;

  TmpS := Text;
  FActionStack.FragmentDeleted(SelStart + 1,
    Copy(TmpS, SelStart + 1, SelLength));
  Delete(TmpS, SelStart + 1, SelLength);
  Text := TmpS;
  CaretPosition := SelStart;
  SelLength := 0;
end;

procedure TCustomASEdit.CutToClipboard;
begin
  if FPasswordChar <> #0 then
    CopyToClipboard;
  ClearSelection;
end;

procedure TCustomASEdit.SelectAll;
begin
  SetCaretPosition(Length(TEXT));
  SelStart := 0;
  SelLength := Length(Text);
  Invalidate;
end;

procedure TCustomASEdit.DoSelectAll(Sender: TObject);
begin
  SelectAll;
end;

procedure TCustomASEdit.DrawPasswordChar(SymbolRect: TRect; Selected:
  boolean);
var
  R                 : TRect;
  Rgn               : HRgn;
begin
  Rgn := CreateRectRgn(SymbolRect.Left, SymbolRect.Top, SymbolRect.Right,
    SymbolRect.Bottom);
  try
    SelectClipRgn(Canvas.Handle, Rgn);

    Canvas.Font.Assign(Self.Font);
    if Selected then
      Canvas.Font.Color := clHighlightText;

    R := SymbolRect;
    InflateRect(R, -2, -3);

    DrawText(Canvas, FPasswordChar, SymbolRect, DT_LEFT or
      DT_NOPREFIX);
  finally
    SelectClipRgn(Canvas.Handle, 0);
    DeleteObject(Rgn);
  end;
end;

function TCustomASEdit.CanAutoSize(var NewWidth, NewHeight: Integer):
  Boolean;
begin
  Result := True;
  Canvas.Font.Assign(Self.Font);
  NewHeight := GetEditRect.Bottom + GetEditRect.Top * 3;
  //Result := False;
end;

procedure TCustomASEdit.SelectWord;
begin
  SelStart := GetPrivWordBeging(CaretPosition);
  SelLength := GetNextWordBeging(SelStart) - SelStart;
  CaretPosition := SelStart + SelLength;
end;

procedure TCustomASEdit.UpdateCarete;
begin
  Canvas.Font.Assign(Self.Font);
  CreateCaret(Handle, 0, 0, Canvas.TextHeight('Pq汉字高度'));
  CaretPosition := FCaretPosition;
  ShowCaret;
end;

procedure TCustomASEdit.HideCaret;
begin
  Windows.HideCaret(Handle);
end;

procedure TCustomASEdit.ShowCaret;
begin
  Windows.ShowCaret(Handle);
end;

function TCustomASEdit.GetPasswordCharWidth: integer;
begin
  Canvas.Font.Assign(Self.Font);

  Result := TextWidth(Canvas, FPasswordChar, DT_NOPREFIX);

  if Result = 0 then
    Result := 1;
end;

type
  TCrackControl = (TControl);

procedure TCustomASEdit.Change;
var
  AnsiText          : string;
begin
  //TCrackControl(Self).Caption := Text;
  if PasswordChar = #0 then
  begin
    AnsiText := Text;
    SetTextBuf(PChar(AnsiText));
  end;
  //Self.Caption := Text;
  if Enabled and HandleAllocated then
    SetCaretPosition(CaretPosition);

  if Assigned(FOnChange) then
    FOnChange(Self);
end;