TEdit, TSpinEdit

Edit с возможностью автоматического выбора

2017-08-10T21:19:10+07:00

...маленький компонент THintEdit, порожденный от TCustomEdit, который представляет собой с виду обычный TEdit элемент с возможностью автоматического выбора стринговых значений из скрытого списка (так, как это реализовано в Netscape Navigator'е). Описание особенно не нужно, так как выполнено все достаточно элементарно: значения для выбора заносятся в свойство HintList, тип свойства TStrings. При нажатии клавиш вверх/вниз выбираются значения, соответствующие набранным начальным символам.

Подробнее...

SetFocus в Edit на OnExit

2017-08-10T21:32:28+07:00

Я пробую выполнить editbox.SetFocus и/или editbox.Clear, но но это не дает никакого эффекта (по крайней мере видимого). Что я делаю неправильно?

Вы посылаете команду на изменение фокуса внутри обработчика, который сам устанавливает фокус, этим вы получаете банальную рекурсию.

Я избегаю этого путем отправления собственного сообщения в обработчике OnExit, после чего в обработчике моего сообщения выставляю логический флажок, предохраняющий код от рекурсии, поскольку данный флажок контролируется в обработчике OnExit.

Следующие строки содержат необходимый код:

Подробнее...

Автоматический формат даты в компоненте Edit

2017-08-10T21:32:50+07:00

Code:

procedure TForm1.Edit1Exit(Sender: TObject);

begin

if Edit1.Text <> '' then

begin

try

StrToDate(Edit1.Text);

except

Edit1.SetFocus;

MessageBeep(0);

raise Exception.Create('"' + Edit1.Text

+ '" - некорректная дата');

end {try};

Edit1.Text := DateToStr(StrToDate(Edit1.Text));

end {if};

end;

Выравнивание по правому краю в TEdit?

2017-08-10T21:13:28+07:00

Code:

type

{©Drkb v.3(2007): www.drkb.ru}

TNumEdit = class(TEdit)

procedure CreateParams(var Params: TCreateParams); override;

.......

procedure TNumEdit.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

Params.Style := Params.Style or ES_MULTILINE or ES_RIGHT;

end;

Подробнее...

Выравнивание по центру в TEdit?

2017-08-10T21:14:21+07:00

TEdit не поддерживает выравниваение текста по центру и по правой стороне - лучше использовать компонент TMemo. Вам понадобится запретить пользователю нажимать Enter, Ctrl-Enter и всевозможные комбинации клавиш со стрелками, чтобы избежать появления нескольких сторк в Memo. Этого можно добиться и просматривая содержимое текста в TMemo в поисках кода возврата каретки (13) и перевода строки(10) на событиях TMemo Change и KeyPress. Можно также заменять код возврата каретки на пробел - для того чтобы позволять вставку из буфера обмена многострочного текста в виде одной строки.

Подробнее...

Денежное поле редактирования

2017-08-10T21:32:00+07:00

Code:

unit CurrEdit;

interface

uses

SysUtils,

WinTypes,

WinProcs,

Messages,

Classes,

Graphics,

Controls,

Menus,

Forms,

Dialogs,

StdCtrls;

type

TCurrencyEdit = class(TCustomMemo)

private

DispFormat: string;

FieldValue: Extended;

procedure SetFormat(A: string);

procedure SetFieldValue(A: Extended);

procedure CMEnter(var Message: TCMEnter); message CM_ENTER;

procedure CMExit(var Message: TCMExit); message CM_EXIT;

procedure FormatText;

procedure UnFormatText;

protected

procedure KeyPress(var Key: Char); override;

procedure CreateParams(var Params: TCreateParams); override;

public

constructor Create(AOwner: TComponent); override;

published

property Alignment default taRightJustify;

property AutoSize default True;

property BorderStyle;

property Color;

property Ctl3D;

property DisplayFormat: string read DispFormat write SetFormat;

property DragCursor;

property DragMode;

property Enabled;

property Font;

property HideSelection;

property MaxLength;

property ParentColor;

property ParentCtl3D;

property ParentFont;

property ParentShowHint;

property PopupMenu;

property ReadOnly;

property ShowHint;

property TabOrder;

property Value: Extended read FieldValue write SetFieldValue;

property Visible;

property OnChange;

property OnClick;

property OnDblClick;

property OnDragDrop;

property OnDragOver;

property OnEndDrag;

property OnEnter;

property OnExit;

property OnKeyDown;

property OnKeyPress;

property OnKeyUp;

property OnMouseDown;

property OnMouseMove;

property OnMouseUp;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Additional', [TCurrencyEdit]);

end;

constructor TCurrencyEdit.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

AutoSize := True;

Alignment := taRightJustify;

Width := 121;

Height := 25;

DispFormat := '$,0.00;($,0.00)';

FieldValue := 0.0;

AutoSelect := False;

WantReturns := False;

WordWrap := False;

FormatText;

end;

procedure TCurrencyEdit.SetFormat(A: string);

begin

if DispFormat <> A then

begin

DispFormat := A;

FormatText;

end;

procedure TCurrencyEdit.SetFieldValue(A: Extended);

begin

if FieldValue <> A then

begin

FieldValue := A;

FormatText;

end;

procedure TCurrencyEdit.UnFormatText;

var

TmpText: string;

Tmp: Byte;

IsNeg: Boolean;

begin

IsNeg := (Pos('-', Text) > 0) or (Pos('(', Text) > 0);

TmpText := '';

for Tmp := 1 to Length(Text) do

if Text[Tmp] in ['0'..'9', '.'] then

TmpText := TmpText + Text[Tmp];

try

FieldValue := StrToFloat(TmpText);

if IsNeg then

FieldValue := -FieldValue;

except

MessageBeep(mb_IconAsterisk);

end;

procedure TCurrencyEdit.FormatText;

begin

Text := FormatFloat(DispFormat, FieldValue);

end;

procedure TCurrencyEdit.CMEnter(var Message: TCMEnter);

begin

SelectAll;

inherited;

end;

procedure TCurrencyEdit.CMExit(var Message: TCMExit);

begin

UnformatText;

FormatText;

inherited;

end;

procedure TCurrencyEdit.KeyPress(var Key: Char);

begin

if not (Key in ['0'..'9', '.', '-']) then

Key := #0;

inherited KeyPress(Key);

end;

procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

case Alignment of

taLeftJustify: Params.Style := Params.Style or ES_LEFT and not ES_MULTILINE;

taRightJustify: Params.Style := Params.Style or ES_RIGHT and not

ES_MULTILINE;

taCenter: Params.Style := Params.Style or ES_CENTER and not ES_MULTILINE;

end;

end.

Изменить вид каретки TEdit

2017-08-10T21:31:20+07:00

В примере показано как создать два цветных "bitmap'а": "улыбчивый" и "хмурый" и присвоить их курсору edit'а. Для этого нужно перехватить оконную процедуру edit'а. Чтобы сделать это заменим адрес оконной процедуры Edit'а нашим собственным, а старую оконную процедуру будем вызывать по необходимости. Пример показывает "улыбчивый" курсор при наборе текста и "хмурый" при забое клавишей backspace.

Подробнее...

Изменить цвет неактивного TEdit

2017-08-10T21:30:40+07:00

Code:

{Question:

How can I change the color of a disabled (Edit1.Enabled := false;) control?

I do not want the normal grey color.

Answer:

Two options:

1) place the control on a panel and disable the panel instead of the control.

This way the color stays to whatever you set it.

2) make a descendent and take over the painting when it is disabled.

Here is an example:}

unit PBExEdit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TPBExEdit = class(TEdit)

private

{ Private declarations }

FDisabledColor: TColor;

FDisabledTextColor: TColor;

procedure WMPaint(var msg: TWMPaint); message WM_PAINT;

procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;

procedure SetDisabledColor(const Value: TColor); virtual;

procedure SetDisabledTextColor(const Value: TColor); virtual;

protected

{ Protected declarations }

public

{ Public declarations }

constructor Create(aOwner: TComponent); override;

published

{ Published declarations }

property DisabledTextColor: TColor read FDisabledTextColor

write SetDisabledTextColor default clGrayText;

property DisabledColor: TColor read FDisabledColor

write SetDisabledColor default clWindow;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('PBGoodies', [TPBExEdit]);

end;

constructor TPBExEdit.Create(aOwner: TComponent);

begin

inherited;

FDisabledColor := clWindow;

FDisabledTextColor := clGrayText;

end;

procedure TPBExEdit.SetDisabledColor(const Value: TColor);

begin

if FDisabledColor <> Value then

begin

FDisabledColor := Value;

if not Enabled then

Invalidate;

end;

procedure TPBExEdit.SetDisabledTextColor(const Value: TColor);

begin

if FDisabledTextColor <> Value then

begin

FDisabledTextColor := Value;

if not Enabled then

Invalidate;

end;

procedure TPBExEdit.WMEraseBkGnd(var msg: TWMEraseBkGnd);

var

Canvas: TCanvas;

begin

if Enabled then

inherited

else

begin

Canvas:= TCanvas.Create;

try

Canvas.Handle := msg.DC;

SaveDC(msg.DC);

try

canvas.Brush.Color := FDisabledColor;

canvas.Brush.Style := bsSolid;

canvas.Fillrect(clientrect);

msg.Result := 1;

finally

RestoreDC(msg.DC, - 1);

end;

finally

canvas.free

end;

procedure TPBExEdit.WMPaint(var msg: TWMPaint);

var

Canvas: TCanvas;

ps: TPaintStruct;

CallEndPaint: Boolean;

begin

if Enabled then

inherited

else

begin

CallEndPaint := False;

Canvas:= TCanvas.Create;

try

if msg.DC <> 0 then

begin

Canvas.Handle := msg.DC;

ps.fErase := true;

end

else

begin

BeginPaint(Handle, ps);

CallEndPaint:= True;

Canvas.handle := ps.hdc;

end;

if ps.fErase then

Perform(WM_ERASEBKGND, Canvas.Handle, 0);

SaveDC(canvas.handle);

try

Canvas.Brush.Style := bsClear;

Canvas.Font := Font;

Canvas.Font.Color := FDisabledTextColor;

Canvas.TextOut(1, 1, Text);

finally

RestoreDC(Canvas.Handle, - 1);

end;

finally

if CallEndPaint then

EndPaint(handle, ps);

Canvas.Free

end;

end.

Как автоматически расширить TEdit?

2017-08-10T21:21:43+07:00

Следующий компонент автоматически подстраивается под текст, вводимый в него:

Подробнее...

Как заблокировать ввод нецифровых данных в Edit

2017-08-10T21:17:20+07:00

Блокировка вставки нецифровых данных через буфер обмена

Code:

uses Clipbrd;

function NewEditProc(wnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):integer; stdcall;

var

s:string;

i:integer;

begin

if (uMsg=WM_PASTE) and Clipboard.HasFormat(CF_TEXT) then

begin

s := Clipboard.AsText;

for i:=1 to Length(s) do if (not (s[i] in ['0'..'9'])) then begin uMsg:=0; break end

end;

result:=CallWindowProc(Pointer(GetWindowLong(wnd,GWL_USERDATA)),wnd,uMsg,wParam,lParam)

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

SetWindowLong(Edit1.Handle,GWL_STYLE,GetWindowLong(Edit1.Handle,GWL_STYLE) or ES_NUMBER);

SetWindowLong(Edit1.Handle,GWL_USERDATA,SetWindowLong(Edit1.Handle, GWL_WNDPROC, LPARAM(@NewEditProc)))

end;

Автор: Krid

Взято из https://forum.sources.ru

Подробнее...

Как заставить TEdit не пикать при нажатии недопустимых клавиш?

2017-08-10T21:20:00+07:00

Перехватите событие KeyPress и установите key = #0 для недопустимых клавиш.

Code:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if ((UpCase(Key) < 'A') or (UpCase(Key) > 'Z')) then Key := #0;

end;

Подробнее...

Как назначить событие на увеличение/уменьшение TSpinEdit с помощью стрелочек?

2017-08-10T21:24:41+07:00

У TSpinEdit.Button есть дополнительные события, которые не показаны в инспекторе объектов, например, OnUpClick и OnDownClick...

Подробнее...

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

2017-08-10T21:24:14+07:00

Как ограничить длинну текста, вводимого в TEdit, так чтобы ширина текста не превышала

ширину TEdit'а?

В примере приведено два способа ограничить длинну текста в TEdit так чтобы она не превышала ширину клиентской области окна TEdit'а и не появлялась прокрутка текста. Первый способ устанавливает свойство TEdit'а MaxLength равным числу букв "W", которые поместятся в TEdit. "W" выбрана потому, что является, наверное, самой широкой буквой в любом шрифте. Этот метод сносно работает для шрифтов с фиксированной шириной букв, но для шрифтов с переменной шириной букв вряд ли сгодится. Второй способ перхватывает событие KeyPress TEdit'а и измеряет ширину уже введенного текста и ширину нового символа. Если ширина больше чем клиентская область TEdit'а новый символ отбрасывается и вызывается MessageBeep.

Подробнее...

Как очистить все окошки редактирования на форме?

2017-08-10T21:22:07+07:00

Code:

procedure ClearEdits;

var i : Integer;

begin

for i := 0 to ComponentCount-1 do

if (Components[i] is TEdit) then

(Components[i] as TEdit).Text := '';

end;

Как перехватить клавишу табуляции (Tab) в TEdit?

2017-08-10T21:23:13+07:00

Это можно давольно легко сделать переопределив на форме процедуру CMDialogKey. Чтобы посмотреть как это работает, поместите на форму Edit и введите следующий код:

Подробнее...

Как сделать так, чтобы в компонент TEdit можно было вводить текст только на английской раскладке?

2017-08-10T21:25:04+07:00

когда TEdit получает фокус надо вызвать:

Code:

ActivateKeyboardLayout($409, 0);

если этого мало тогда почитай про WM_INPUTLANGCHANGE

Как узнать физические координаты каретки в пикселях?

2017-08-10T21:23:37+07:00

Code:

{TRichEdit}

var

pt: TPoint;

begin

with richedit1 do

begin

Perform(messages.EM_POSFROMCHAR, WPARAM(@pt), selstart);

label1.caption := Format('(%d, %d)', [pt.x, pt.y]);

end;

{TMemo and TEdit}

var

r: LongInt;

begin

with memo1 do

begin

r := Perform(messages.EM_POSFROMCHAR, selstart, 0);

if r >= 0 then

begin

label1.caption := IntToStr(HiWord(r));

label2.caption := IntToStr(LoWord(r));

end;

Компонент TEdit с возможностью задать выравнивание текста

2017-08-10T21:14:59+07:00

Code:

{

All you have to do is to verride the CreateParams of the class TEdit.

Install the following unit as a component.

}

unit AlignEdit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TAlign = (eaLeft, eaCenter, eaRight);

TAlignEdit = class(TEdit)

private

{ Private-Deklarationen }

FAlign: TAlign;

procedure SetAlign(const Value: TAlign);

protected

{ Protected-Deklarationen }

procedure CreateParams(var Params: TCreateParams); override;

public

{ Public-Deklarationen }

constructor Create(AOwner: TComponent); override;

published

{ Published-Deklarationen }

property Alignment: TAlign read FAlign write SetAlign default eaLeft;

end;

procedure Register;

implementation

constructor TAlignEdit.Create(Aowner: TComponent);

begin

inherited Create(AOwner);

FAlign := eaLeft;

end;

procedure TAlignEdit.SetAlign(const Value: TAlign);

begin

if FAlign <> Value then

begin

FAlign := Value;

RecreateWnd;

end;

procedure TAlignEdit.CreateParams(var Params: TCreateParams);

begin

inherited;

case FAlign of

eaLeft: Params.Style := Params.Style or ES_LEFT;

eaCenter: Params.Style := Params.Style or ES_CENTER;

eaRight: Params.Style := Params.Style or ES_RIGHT;

end;

procedure Register;

begin

RegisterComponents('SwissDelphiCenter', [TAlignEdit]);

end;

end.

Массив Edit-компонентов

2017-08-10T21:30:06+07:00

Code:

procedure DoSomethingWithEditControls;

var

K: Integer;

EditArray: array[0..99] of Tedit;

begin

try

for K := 0 to 99 do

begin

EditArray[K] := TEdit.Create(Self);

EditArray[K].Parent := Self;

{Устанавливаем необходимые свойства TEdit}

SetSomeOtherPropertiesOfTEdit;

Left := 100;

Top := K * 10;

{Что-то делаем при перемещении мыши}

OnMouseMove := WhatToDoWhenMouseIsMoved;

end;

{Делаем все что хотим с полученным массивом Edit-компонентов}

DoWhateverYouWantToDoWithTheseEdits;

finally

for K := 0 to 99 do

EditArray[K].Free;

end;

Ограничение ввода в текстовое поле

2017-08-10T21:27:21+07:00

Code:

{

In this exemple, the only keys allowed are the

same allowed in e-mail adresses.

}

procedure TForm1.Edit1KeyPress(Sender: TObject;

var Key: Char);

const

AllowedChars: string = 'abcdefghijklmnopq' +

'rstuvwxyz01234567_.@';

var

i: Integer;

Ok: Boolean;

begin

i := 0;

Ok := False;

{ If you erase next line, user won't be able to type backspace }

if Key = #8 then Ok := True;

repeat

i := i + 1;

if Key = AllowedChars[i] then Ok := True;

until (Ok) or (i = Length(AllowedChars));

if not Ok then Key := #0;

end;

Отслеживаем позицию курсора в EditBox

2017-08-10T21:20:23+07:00

В форму добавляются TEditBox и TLabel, при этом TLabel постоянно показывает позицию курсора в элементе редактирования.

Code:

procedure TForm1.Edit1Change(Sender: TObject);

begin

CurPos := Edit1.SelStart;

Label1.Caption := IntToStr(CurPos);

end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

If Key = VK_LEFT then dec(CurPos);

if Key = VK_RIGHT then inc(CurPos);

Label1.Caption:= IntToStr(CurPos);

end;

Подсказка при вводе в Edit

2017-08-10T21:26:15+07:00

Сегодня поговорим о том, как помочь пользователю ввести в поле ввода текст. Для этого компьютер должен по первым буквам вводимого слова догадаться, что хочет написать пользователь, и предложить ему этот вариант. Один из способов это сделать - дописывать не хватающие буквы к слову, но выделять их.

Нужно решить три задачи:

1. определить вводимые символы,

2. найти слово, начинающееся с этих символов,

3. добавить не хватающие символы и выделить их.

Для решения первой задачи достаточно найти первый символ, не являющийся буквой. Для решения второй задачи можно использовать поиск в StringList. Вставить недостающие символы удобно в специальной переменной типа String.

В этом примере словарь состоит из названий чисел (на английском): от 1 до 10. Иногда словарь можно пополнять, добавляя туда незнакомые слова, вводимые пользователем.

Подробнее...

Преобразовать первую букву каждого слова к верхнему регистру в TEdit

2017-08-10T21:29:45+07:00

Code:

procedure TForm1.Edit1Change(Sender: TObject);

var

OldChange: TNotifyEvent;

OldStart: Integer;

begin

with (Sender as TEdit) do

begin

OldChange := OnChange;

OnChange := nil;

OldStart := SelStart;

if ((SelStart > 0) and (Text[SelStart - 1] = ' ')) or (SelStart = 1) then

begin

SelStart := SelStart - 1;

SelLength := 1;

SelText := AnsiUpperCase(SelText);

end;

OnChange := OldChange;

SelStart := OldStart;

end;

Подробнее...

Проблема потери фокуса для TEdit

2017-08-10T21:29:20+07:00

To Reproduce the Problem:

1. Drop two TEdits onto a form.

2. In the OnExit Event of Edit1 add the following code:

Code:

Application.MessageBox( 'Title','...', mb_ok );

Подробнее...

Проверка на соответствие содержимого TEdit

2017-08-10T21:28:05+07:00

Предположим, вы регулярно пользуетесь компонентами TEdit (в отличие от компонентов TDBEdit), и если так, то наилучшим местом для осуществления проверки на соответствие является обработчик события OnExit компонента TEdit. Данное событие наступает при каждом покидании фокуса компонента.

Обычно, при вводе неправильного текста в поле редактирования, у вас возникает желание послать предупреждение пользователю и вернуть фокус обратно. Тем не менее, в данном решении трудность подстерегает при попытке установить фокус в обработчике события OnExit. Поскольку Windows остается "посередине" при передаче фокуса от одного элемента управления другому в обработчике события OnExit, вы можете получить состояние нестабильного поведения компонентов, если попытаетесь в это время изменить фокус.

Подробнее...

Элемент управления Edit, реагирующий на событие OnTimer

2017-08-10T21:20:55+07:00

Как-то раз встала такая проблема: если пользователь какое-то время ничего не вводит в элемент управления Edit, то предупредить его об этом.

Подробнее...