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

Вниз

TrichEdit как сделать курсор в виде прямоугольника?   Найти похожие ветки 

← →
APOSTOL ©   (2006-08-17 21:15) [0]

Вобщем, проблема такая. Пишу редактор текстовый , тока с наворотами... мне нужно чтоб курсор (не мышь) был как в hyper terminal"е. то есть прямоугольник. Подскажите, кто знает. И желательно чтоб цвет его тоже можно было менять...

---

← →
Чапаев ©   (2006-08-17 21:26) [1]

CreateCaret(), дальше по ссылкам.

---

← →
DprYg ©   (2006-08-17 21:30) [2]

Надо перехватить оконную функцию. См. SetWindowLong + [1]

---

← →
APOSTOL ©   (2006-08-17 21:46) [3]

а по-конкретней нельзя?

---

← →
DprYg ©   (2006-08-17 21:47) [4]

Это даже есть в Delphi World:
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
   WParameter = LongInt;
    LParameter = LongInt;

function NewWindowProc(WindowHandle : hWnd;
TheMessage : WParameter; ParamW : WParameter;
ParamL : LParameter) : LongInt; stdcall;
begin
 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
 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");
 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");
 OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,
 GWL_WNDPROC, LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 SetWindowLong(Edit1.Handle,GWL_WNDPROC,
 LongInt(OldEditsWindowProc));
 CaretBm.Free;
 CaretBmBk.Free;
end;
Если что непонятно в коде (или вообще непонятно что эта программа делает) - спрашивай.

---

← →
DprYg ©   (2006-08-17 21:55) [5]

Правда, отвечу завтра: после 5-часового волейбола я несколько устал, поэтому - в койку :)

---

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

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

Наверх

Память: 0.48 MB
Время: 0.078 c