Главная страница | назад





Article #16420: Changing the input caret

 Question and Answer Database

FAQ1420D.txt   Changing the input caret
Category   :VCL
Platform    :All
Product    :All 32 bit  

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.

7/16/98 4:31:28 PM
 

Last Modified: 01-SEP-99