:: 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);
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;
|
При использовании материала - ссылка на сайт обязательна
|
|