CreateCaret()

showcaret()

destroycaret();

HideCaret();

***********

unit Unit1;

interface

uses

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

 StdCtrls, ExtCtrls;

const

 wm_newcaret=wm_user+1;

type

 TForm1 = class(TForm)

   Edit1: TEdit;

   Edit2: TEdit;

   Image1: TImage;

   procedure Edit1Enter(Sender: TObject);

 private

   { Private declarations }

 public

   { Public declarations }

   procedure newcaret(var msg:Tmessage);message wm_newcaret;

 end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Edit1Enter(Sender: TObject);

begin

 postmessage(handle,wm_newcaret,0,0);

end;

procedure TForm1.newcaret(var msg: Tmessage);

begin

 edit1.setfocus;

 CreateCaret(edit1.Handle,image1.Picture.Bitmap.Handle,edit1.width,edit1.height);

 showcaret(edit1.handle);

end;

end.

//利用onenter事件，用postmessage发出一个自定义消息

//在自定义消息中,用sendmessage强制setfocus后，再createcaret就可以了

Edit收到焦点时，光标是变了，但一旦我键入字符，光标又变回原样。我想知道如何在编辑文字时，光标一直不变（自定义的）

只要响应application.onactivate事件可以了

unit Unit1;

interface

uses

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

 StdCtrls, ExtCtrls, AppEvnts;

const

 wm_newcaret=wm_user+1;

type

 TForm1 = class(TForm)

   Edit1: TEdit;

   Edit2: TEdit;

   Image1: TImage;

   ApplicationEvents1: TApplicationEvents;

   procedure Edit1Enter(Sender: TObject);

   procedure ApplicationEvents1Activate(Sender: TObject);

 private

   { Private declarations }

 public

   { Public declarations }

   procedure newcaret(var msg:Tmessage);message wm_newcaret;

 end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Edit1Enter(Sender: TObject);

begin

 postmessage(handle,wm_newcaret,0,0);

end;

procedure TForm1.newcaret(var msg: Tmessage);

begin

 edit1.setfocus;

 CreateCaret(edit1.Handle,image1.Picture.Bitmap.Handle,edit1.width,edit1.height);

 showcaret(edit1.handle);

end;

procedure TForm1.ApplicationEvents1Activate(Sender: TObject);

begin

 CreateCaret(edit1.Handle,image1.Picture.Bitmap.Handle,edit1.width,edit1.height);

 showcaret(edit1.handle);

end;

end.

**********************

unit unit1;

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.