Конференция "Media" » горизонтальный курсор [D7, WinXP]
 
  • Cout (19.09.08 07:01) [0]
    Можно ли сделать в Memo курсор горизонтальный, как в командной строке?
  • Vlad Oshin © (19.09.08 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 (20.09.08 10:18) [2]
    Thanks.
 
Конференция "Media" » горизонтальный курсор [D7, WinXP]
Есть новые Нет новых   [134431   +10][b:0][p:0]