Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.09.04;
Скачать: CL | DM;

Вниз

Два вопроса по TEdit   Найти похожие ветки 

 
-=GaLaN=- ©   (2003-08-21 10:52) [0]

1) Как отловить событие OnFocus? В стандартных обработчиках его нет.
2) Как можно подменить прорисовку каретки (текстового курсора)? Я его меняю с помощью CreateCaret и ShowCaret, но иногда возвращается стандартный курсор. Например, при изменении размера TEdit в режиме выполнения.


 
Семен Сорокин ©   (2003-08-21 11:01) [1]

1) есть перекрой WM_SETFOCUS
2) отлавливать все эти ситуации, имхо


 
Юрий Федоров ©   (2003-08-21 11:01) [2]

OnFocus = OnEnter


 
Pindos ©   (2003-08-21 11:03) [3]

Там помоему не OnFocus а OnEnter!
а вот насчёт каретки вот( я знаю, что много, разберись, может сделаешь поменьше!меня это как-то не интересует)
Пример:

unit caret1;

interface

{$IFDEF WIN32}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
{$ELSE}
uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
{$ENDIF}

type
TForm1 = class(TForm)
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{Private declarations}
public
{Public declarations}
CaretBm : TBitmap;
CaretBmBk : TBitmap;
OldEditsWindowProc : Pointer;
end;

var
Form1: TForm1;

implementation
{$R *.DFM}

type
{$IFDEF WIN32}
WParameter = LongInt;
{$ELSE}
WParameter = Word;
{$ENDIF}
LParameter = LongInt;

{New windows procedure for the edit control}
function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter;
ParamL : LParameter) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
begin
{Call the old edit controls windows procedure}
NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc, WindowHandle,
TheMessage, ParamW, ParamL);
if TheMessage = WM_SETFOCUS then
begin
CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
ShowCaret(WindowHandle);
end;
if TheMessage = WM_KILLFOCUS then
begin
HideCaret(WindowHandle);
DestroyCaret;
end;
if TheMessage = WM_KEYDOWN then
begin
if ParamW = VK_BACK then
CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0)
else
CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
ShowCaret(WindowHandle);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{Create a smiling bitmap using the wingdings font}
CaretBm := TBitmap.Create;
CaretBm.Canvas.Font.Name := "WingDings";
CaretBm.Canvas.Font.Height := Edit1.Font.Height;
CaretBm.Canvas.Font.Color := clWhite;
CaretBm.Width := CaretBm.Canvas.TextWidth("J") + 2;
CaretBm.Height := CaretBm.Canvas.TextHeight("J") + 2;
CaretBm.Canvas.Brush.Color := clBlue;
CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height));
CaretBm.Canvas.TextOut(1, 1, "J");
{Create a frowming bitmap using the wingdings font}
CaretBmBk := TBitmap.Create;
CaretBmBk.Canvas.Font.Name := "WingDings";
CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;
CaretBmBk.Canvas.Font.Color := clWhite;
CaretBmBk.Width := CaretBmBk.Canvas.TextWidth("L") + 2;
CaretBmBk.Height := CaretBmBk.Canvas.TextHeight("L") + 2;
CaretBmBk.Canvas.Brush.Color := clBlue;
CaretBmBk.Canvas.FillRect(Rect(0,0, CaretBmBk.Width, CaretBmBk.Height));
CaretBmBk.Canvas.TextOut(1, 1, "L");
{Hook the edit controls window procedure}
OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,GWL_WNDPROC,
LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Unhook the edit controls window procedure and clean up}
SetWindowLong(Edit1.Handle,GWL_WNDPROC, LongInt(OldEditsWindowProc));
CaretBm.Free;
CaretBmBk.Free;
end;



 
panov ©   (2003-08-21 11:06) [4]

1) Как отловить событие OnFocus? В стандартных обработчиках его нет.

зато реализовано событие OnEnter и OnExit


 
panov ©   (2003-08-21 11:06) [5]

вот блин... быстрые все какие-)



Страницы: 1 вся ветка

Текущий архив: 2003.09.04;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.015 c
3-10578
Алексей Петухов
2003-08-14 09:01
2003.09.04
TDBGrid


1-10757
god4
2003-08-23 21:13
2003.09.04
Delphi 7 - компонент ServerSocket отсутствует !!!! help


1-10833
oduvan
2003-08-21 09:24
2003.09.04
Как реализовать перемещение элементов в TTreeView вверх или вниз


14-10933
uw
2003-08-14 14:30
2003.09.04
Проблемы с IExplorer


1-10690
snake1977
2003-08-25 11:47
2003.09.04
TEdit