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 caret ;

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 TForm = class(TForm) Edit : TEdit; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } CaretBm : TBitmap; CaretBmBk : TBitmap; OldEditsWindowProc : Pointer; end;

var Form : TForm ;

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(Form .OldEditsWindowProc, WindowHandle, TheMessage, ParamW, ParamL); if TheMessage = WM_SETFOCUS then begin CreateCaret(WindowHandle, Form .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, Form .CaretBmBk.Handle, 0, 0) else CreateCaret(WindowHandle, Form .CaretBm.Handle, 0, 0); ShowCaret(WindowHandle); end; end;

procedure TForm .FormCreate(Sender: TObject); begin {Create a smiling bitmap using the wingdings font} CaretBm := TBitmap.Create; CaretBm.Canvas.Font.Name := 'WingDings'; CaretBm.Canvas.Font.Height := Edit .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( , , 'J'); {Create a frowming bitmap using the wingdings font} CaretBmBk := TBitmap.Create; CaretBmBk.Canvas.Font.Name := 'WingDings'; CaretBmBk.Canvas.Font.Height := Edit .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( , , 'L'); {Hook the edit controls window procedure} OldEditsWindowProc := Pointer(SetWindowLong(Edit .Handle, GWL_WNDPROC, LongInt(@NewWindowProc))); end;

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

end.

7/ 6/98 4:3 :28 PM