WhiteUnicorn

	#WhiteUnicorn/ StartPage/ Documentation/DelphiFAQ >

Frequently Asked Questions

Changing the input caret

Question:

Is it possible to change the caret in an edit or other windows control capable of accepting keyboard input in response to a keyboard action?

Answer:

Yes! The following example demonstrates how to create two

color bitmaps: a "smiley" and a "frowny" face bitmap, and 

attach them to the caret of an edit control. The edit 

control's window procedure must be trapped to do this to 

create a superclass condition when responding to windows 

focus messages. To do this we will replace the address of

the Edit control's main window procedure with our own, and 

make calls to the Edit control's old window procedure as 

necessary. The example shows the "smiley" face caret when 

normally typing, and displays a "frowning" face caret when 

you backspace.



Example:



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;



end.

	#WhiteUnicorn/ StartPage/ Documentation/DelphiFAQ >

	Anastasija aka WhiteUnicorn	LiveJournal PhotoFile