FAQ VCL
Компоненты\Edit

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как запретить показ курсора (каретки) в TEdit?

// На форме должен быть только один компонент,
// имеющий каретку (Edit, Memo и т.п.). Лучше всего
// создать своего потомка, и уже в нем проделать
// все приведенные ниже действия

type
  TForm1 = class(TForm)
    Edit1: TEdit;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMPaint( var Msg: TMessage ); message WM_Paint;
    procedure WMSetFocus( var Msg: TMessage ); message WM_SetFocus;
    procedure WMNCHitTest( var Msg: TMessage ); message WM_NCHitTest;
  end;

implementation

procedure TForm1.WMNCHitTest(var Msg: TMessage);
begin
   inherited;
   HideCaret( Edit1.Handle );
end;

procedure TForm1.WMPaint(var Msg: TMessage);
begin
   inherited;
   HideCaret( Edit1.Handle );
end;

procedure TForm1.WMSetFocus(var Msg: TMessage);
begin
   inherited;
   HideCaret( Edit1.Handle );
end;


Как определить положение курсора в TEdit?

// Способ первый
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
   Caption := IntToStr( Edit1.SelStart );
end;

// Способ второй
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
   Caption := IntToStr( LoWord( Edit1.Perform( EM_GETSEL, 0, 0 ) ) );
end;

// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
var
  p: TPoint;
  i: Integer;
begin
   // if Edit1.Focused then
   begin
      GetCaretPos( p );
      // i := SendMessage( Edit1.Handle, EM_CHARFROMPOS, 0, Integer( PointToSmallPoint( p ) ) );
      i := SendMessage( Edit1.Handle, EM_CHARFROMPOS, 0, MakeLParam( p.X, p.Y ) );
      ShowMessageFmt( 'Позиция каретки: %d', [i] );
   end;
end;

// Способ четвертый
function GetPosition( Sender: TEdit ): Integer;
var
  X, Y: Integer;
begin
   X := 0;
   Y := 0;
   Y := SendMessage( Sender.Handle, EM_LINEFROMCHAR, Sender.SelStart, 0 );
   Result := Sender.SelStart - SendMessage( Sender.Handle, EM_LINEINDEX, Y, 0 );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( IntToStr( GetPosition( Edit1 ) ) );
end;


Как определить длину выделенного текста в TEdit?

// Способ первый
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
   Caption := IntToStr( Edit1.SelLength );
end;

// Способ второй
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  Res: integer;
begin
   Res := Edit1.Perform( EM_GETSEL, 0, 0 );
   // Младшее слово возвpащаемого значения пpедставляет собой индекс
   // начала выделенного текста, а стаpшее слово - индекс конца.
   Caption := IntToStr( HiWord( Res ) - LoWord( Res ) );
end;


Как передать фокус другому компоненту при превышении максимальной длины текста в TEdit?

type
  TForm1 = class(TForm)
    {...}
  private
    procedure WMCommand( var Msg: TWMCommand ); message WM_COMMAND;
  end;

implementation

{...}

// Когда количество символов превысит значение MaxLength,
// TEdit посылает сообщение EN_MAXTEXT своему родительскому окну,
// которое нужно перехватить и передать фокус другому окну.
procedure TForm1.WMCommand(var Msg: TWMCommand);
begin
   if Msg.NotifyCode = EN_MAXTEXT then
   begin
      PostMessage( Handle, WM_NEXTDLGCTL, 0, 0 );
      inherited;
   end;
end;


Как добавить функциональность автозавершения в TEdit?

// Функция SHAutoComplete, которая находится в shwlapi.dll, позволяет добавить
// текстовому полю функциональность автозавершения. Есть одна важная вещь -
// функция работает только после того, как вы вызываете OLE-связанную функцию
// CoInitialize (или CoInitializeEx). Для главного потока она вызывается автоматически.

unit AutoCompleteUnit;

interface

{$DEFINE DYNAMIC_LINK}

uses
  Windows, StdCtrls;

const
  SHACF_DEFAULT = $0;
  SHACF_FILESYSTEM  = $1;
  SHACF_URLHISTORY  = $2;
  SHACF_URLMRU = $4;
  SHACF_URLALL = SHACF_URLHISTORY or SHACF_URLMRU;
  SHACF_AUTOSUGGEST_FORCE_ON = $10000000; 
  SHACF_AUTOSUGGEST_FORCE_OFF = $20000000; 
  SHACF_AUTOAPPEND_FORCE_ON = $40000000; 
  SHACF_AUTOAPPEND_FORCE_OFF = $80000000; 

function AutoComplete(editField: TEdit; dwFlags: DWORD): Boolean;

implementation

{$IFDEF DYNAMIC_LINK}
type
  TShAutoCompleteFunc = function( hwndEdit: HWND; dwFlags: DWORD ): LongInt; stdcall;

var
  SHAutoComplete: TShAutoCompleteFunc;
  DLL: THandle;
{$ELSE}
  function SHAutoComplete( hwndEdit: HWND; dwFlags: DWORD ): LongInt;
    stdcall; external 'shlwapi.dll';
{$ENDIF}

function AutoComplete( EditField: TEdit; dwFlags: DWORD ): Boolean;
begin
   {$IFDEF DYNAMIC_LINK}
   if @ShAutoComplete <> nil then 
   {$ENDIF}
      Result := SHAutoComplete( EditField.Handle, dwFlags ) = 0
   {$IFDEF DYNAMIC_LINK}
   else
      Result := False;
   {$ENDIF}
end;

{$IFDEF DYNAMIC_LINK}
initialization 
  DLL := LoadLibrary( 'shlwapi.dll' );
  if DLL <> 0 then
    @ShAutoComplete := GetProcAddress( DLL, 'SHAutoComplete' );

finalization 
  if DLL <> 0 then
    FreeLibrary( DLL );
{$ENDIF}

end.

// Пример использования

uses
  {...,} AutoCompleteUnit;

procedure TForm1.FormCreate(Sender: TObject);
begin
   AutoComplete( Edit1, SHACF_FILESYSTEM or SHACF_AUTOAPPEND_FORCE_ON );
end;


Как сделать в TEdit подсказку, которая исчезает при вводе?

// Код для Delphi 7 и выше
procedure TForm1.FormCreate(Sender: TObject);
var
  C: TComponent;
  S: WideString;
//const
//  EM_SETCUEBANNER = $1501; // Winapi.CommCtrl
begin
  for C in Self do
    if C is TEdit then
    begin
      S := TEdit(C).Hint;
      // Если WParam = 0, то подсказка будет пропадать сразу же при установке фокуса на Edit,
      // Если WParam = 1, то подсказка пропадет только при начале ввода пользовательского текста.
      SendMessage(TEdit(C).Handle, EM_SETCUEBANNER, 0, Integer(PWideChar(S)));
    end;
end;

// Код для более старых версий Delphi
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  S: WideString;
//const
//  EM_SETCUEBANNER = $1501; // Winapi.CommCtrl
begin
  for i := 0 to ComponentCount-1 do
    if Components[i] is TEdit then
    begin
      S := TEdit(Components[i]).Hint;
      // Если WParam = 0, то подсказка будет пропадать сразу же при установке фокуса на Edit,
      // Если WParam = 1, то подсказка пропадет только при начале ввода пользовательского текста.
      SendMessage(TEdit(Components[i]).Handle, EM_SETCUEBANNER, 0, Integer(PWideChar(S)));
    end;
end;

// Эта функциональность присутствует начиная с Windows XP.
// Для хранения подсказки используется свойство Hint.
// Если используются старые версии Delphi, на форму нужно
// бросить компонент XPManifest (вкладка Win32).


Как реализовать быстрый поиск по упорядоченному (по алфавиту) списку строк?

const
  // Упорядоченный (по алфавиту) списку строк
  StrArray: array[0..N] of string = ( {...} );

implementation

procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  x, i: Word;
  s: string;
begin
   if ( ( Key >= 0 ) and ( Key <= 31 ) ) and ( Key <> 13 ) then
      Exit;

   if Key > 31 then
   begin
      x := Length( Edit1.Text );

      for i := Low( StrArray ) to High( StrArray ) do
      begin
         s := Copy( StrArray[i], 1, x );
         if AnsiLowerCase( Edit1.Text ) = AnsiLowerCase( s ) then
         begin
            Edit1.Text := StrArray[i];
            Edit1.SelStart := x;
            Edit1.SelLength := Length( Edit1.Text ) - x;
            Break;
         end;
      end;
   end
   else
   begin
     Edit1.SelStart := Edit1.SelStart + Edit1.SelLength;
     Edit1.SelLength := 0;
   end;
end;


Как установить положение курсора в TEdit?

procedure TForm1.Button1Click(Sender: TObject);
begin
   Edit1.SelStart := 10;
end;


Как определить видимую часть текста в TEdit?

procedure TForm1.Button1Click(Sender: TObject);
var
  r: TRect;
  First, Last: Integer;
begin
   // Получаем индекс первого видимого символа
   First := Edit1.Perform( EM_CHARFROMPOS, 0, 0 );
   // Получаем индекс последнего видимого символа
   Edit1.Perform( EM_GETRECT, 0, Longint( @r ) );
   r.Right := r.Right - 4;
   r.Top := r.Bottom - 4;
   Last := Edit1.Perform( EM_CHARFROMPOS, 0, MAKELPARAM( r.Right, r.Bottom ) );
   // Получаем видимую часть текста
   ShowMessage( Copy( Edit1.Text, First + 1, Last - First + 1 ) );
end;


Как вставить текст в позицию курсора (или вместо выделенного текста) в TEdit?

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
   SendMessage( Edit1.Handle, EM_REPLACESEL, 0, NativeInt( PChar( 'текст' ) ) );
end;

// Или немного иначе
procedure TForm1.Button1Click(Sender: TObject);
begin
   Edit1.Perform( EM_REPLACESEL, 0, NativeInt( PChar( 'текст' ) ) );
end;

// Способ второй
procedure TForm2.Button1Click(Sender: TObject);
begin
   Edit1.SetSelText( 'текст' );
end;

При использовании материала - ссылка на сайт обязательна