:: MVP ::
|
|
:: RSS ::
|
|
|
Как запретить показ курсора (каретки) в TEdit?
type
TForm1 = class (TForm)
Edit1: TEdit;
private
public
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
begin
GetCaretPos( 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 );
Caption := IntToStr( HiWord( Res ) - LoWord( Res ) );
end ;
|
|
Как добавить функциональность автозавершения в TEdit?
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 подсказку, которая исчезает при вводе?
procedure TForm1 . FormCreate(Sender: TObject);
var
C: TComponent;
S: WideString ;
begin
for C in Self do
if C is TEdit then
begin
S := TEdit(C).Hint;
SendMessage(TEdit(C).Handle, EM_SETCUEBANNER, 0 , Integer ( PWideChar (S)));
end ;
end ;
procedure TForm1 . FormCreate(Sender: TObject);
var
i: Integer ;
S: WideString ;
begin
for i := 0 to ComponentCount- 1 do
if Components[i] is TEdit then
begin
S := TEdit(Components[i]).Hint;
SendMessage(TEdit(Components[i]).Handle, EM_SETCUEBANNER, 0 , Integer ( PWideChar (S)));
end ;
end ;
|
|
Как реализовать быстрый поиск по упорядоченному (по алфавиту) списку строк?
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 ;
|
|
При использовании материала - ссылка на сайт обязательна
|
|