Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.03.13;
Скачать: CL | DM;

Вниз

Как в RichEdit изменить курсор ввода текста на свой.   Найти похожие ветки 

 
Turkirill   (2004-08-12 13:32) [0]

Уважаемые Мастера подскажите плиз с примерчиками,
как в RichEdit изменить курсор ввода на свой.


 
Turkirill   (2004-08-12 15:09) [1]

Я нашел в DelphiWorld код для Edita,
как мне его подправить для Kol RichEdita?

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.


 
Gandalf ©   (2004-08-17 23:00) [2]

Берешь и правишь. Или хочешь чтоб все за тебя сделали?



Страницы: 1 вся ветка

Текущий архив: 2005.03.13;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.046 c
14-1108665627
Alexander Panov
2005-02-17 21:40
2005.03.13
Погрустим?


1-1109412441
F[a]C
2005-02-26 13:07
2005.03.13
Про компонент TTreeView


1-1109248285
uran
2005-02-24 15:31
2005.03.13
на какое событие повесить перебор control ов при создании формы ?


4-1107077312
rimd
2005-01-30 12:28
2005.03.13
CreateThread-совместное использование кода


14-1109084511
Cosinus
2005-02-22 18:01
2005.03.13
Сталкивался кто-нибудь с "бинарными" шрифтами?