Читать «Виртуальная библиотека Delphi» онлайн - страница 146

Пример:

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;