-
Можно ли сделать в Memo курсор горизонтальный, как в командной строке?
-
unit Unit1; interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Edit1: TEdit; Memo1: TMemo; 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;
{New windows procedure for the edit control} function NewWindowProc(WindowHandle:hWnd; TheMessage:WParameter; ParamW:WParameter; ParamL:LParameter):LongInt; stdcall; 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 // CaretBm := TBitmap.Create; // CaretBm.Canvas.Font.Name := 'Arial'; // CaretBm.Canvas.Font.Height := Edit1.Font.Height; // CaretBm.Canvas.Font.Color := clWhite; // CaretBm.Width := CaretBm.Canvas.TextWidth('_') + 2; // CaretBm.Height := CaretBm.Canvas.TextHeight('_') + 2; // CaretBm.Canvas.Brush.Color := clBlue; // CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height)); // CaretBm.Canvas.TextOut(1, 1, '_'); // CaretBmBk := TBitmap.Create; // CaretBmBk.Canvas.Font.Name := 'Arial'; // CaretBmBk.Canvas.Font.Height := Edit1.Font.Height; // CaretBmBk.Canvas.Font.Color := clWhite; // CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('_') + 2; // CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('_') + 2; // CaretBmBk.Canvas.Brush.Color := clBlue; // CaretBmBk.Canvas.FillRect(Rect(0,0, CaretBmBk.Width, CaretBmBk.Height)); // CaretBmBk.Canvas.TextOut(1, 1, '_'); // OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,GWL_WNDPROC, LongInt(@NewWindowProc)));
CaretBm := TBitmap.Create; CaretBm.Canvas.Font.Name := 'Arial'; CaretBm.Canvas.Font.Height := memo1.Font.Height; CaretBm.Canvas.Font.Color := clWhite; CaretBm.Width := CaretBm.Canvas.TextWidth('_') + 2; CaretBm.Height := CaretBm.Canvas.TextHeight('_') + 2; CaretBm.Canvas.Brush.Color := clBlue; CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height)); CaretBm.Canvas.TextOut(1, 1, '_'); CaretBmBk := TBitmap.Create; CaretBmBk.Canvas.Font.Name := 'Arial'; CaretBmBk.Canvas.Font.Height := memo1.Font.Height; CaretBmBk.Canvas.Font.Color := clWhite; CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('_') + 2; CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('_') + 2; CaretBmBk.Canvas.Brush.Color := clBlue; CaretBmBk.Canvas.FillRect(Rect(0,0, CaretBmBk.Width, CaretBmBk.Height)); CaretBmBk.Canvas.TextOut(1, 1, '_'); OldEditsWindowProc := Pointer(SetWindowLong(memo1.Handle,GWL_WNDPROC, LongInt(@NewWindowProc))); end;
procedure TForm1.FormDestroy(Sender: TObject); begin SetWindowLong(memo1.Handle,GWL_WNDPROC, LongInt(OldEditsWindowProc)); CaretBm.Free; CaretBmBk.Free; end;
end.
-
Thanks.
|