Форум: "Media";
Текущий архив: 2012.01.01;
Скачать: [xml.tar.bz2];
Вниз
горизонтальный курсор Найти похожие ветки
← →
Cout (2008-09-19 07:01) [0]Можно ли сделать в Memo курсор горизонтальный, как в командной строке?
← →
Vlad Oshin © (2008-09-19 13:10) [1]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.
← →
Cout (2008-09-20 10:18) [2]Thanks.
Страницы: 1 вся ветка
Форум: "Media";
Текущий архив: 2012.01.01;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.004 c