Code:

unit Unit1;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

StdCtrls, ExtCtrls, Forms;

 

type

TForm1 = class(TForm)

   Memo1: TMemo;

   procedure FormCreate(Sender: TObject);

   procedure Memo1KeyPress(Sender: TObject; var Key: Char);

public

   MaxCharsPerLine, MaxLines: Integer;

   function MemoLine: Integer;

   function LineLen(r: Integer): Integer;

   function NRows: Integer;

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

function TForm1.NRows: Integer;

begin

 

with Memo1 do

   Result := 1 + SendMessage(Handle, EM_LINEFROMCHAR, GetTextLen - 1, 0);

end;

 

function TForm1.LineLen(r: Integer): Integer;

var

r1, r2: Integer;

begin

 

with Memo1 do

begin

   r1 := SendMessage(Handle, EM_LINEINDEX, r, 0);

   if (r > NRows - 1) then

     r2 := SendMessage(Handle, EM_LINEINDEX, r + 1, 0) - 2 {-CR/LF}

   else

     r2 := GetTextLen;

end;

Result := r2 - r1;

end;

 

function TForm1.MemoLine: Integer;

begin

 

with Memo1 do

   Result := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0);

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

 

MaxCharsPerLine := 8;

MaxLines := 4;

end;

 

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

 

with Memo1 do

begin

   case Key of

     ' '..#255: if (LineLen(MemoLine) >= MaxCharsPerLine) then

         Key := #0;

     #10, #13: if (NRows >= MaxLines) then

         Key := #0;

     #8: if (SelStart = SendMessage(Handle, EM_LINEINDEX, MemoLine, 0)) then

         Key := #0;

   end;

end;

end;

 

end.

 

 


 

Code:

procedure TForm1.Memo1Change(Sender: TObject);

const

  MaxLineCount = 5;

begin

  if Memo1.Lines.Count > MaxLineCount then

    // undo the last change

   // letze Дnderung rьckgдngig machen

   Memo1.Perform(EM_UNDO, 0, 0);

  // The EM_EMPTYUNDOBUFFER message clears the undo flag,

// which means that you can no longer undo your last change

// to the edit control.

// Die Message EM_EMPTYUNDOBUFFER lцscht das UnDo Flag,

// damit kann die letzte Дnderung nicht Rьckgдngig gemacht werden.

Memo1.Perform(EM_EMPTYUNDOBUFFER, 0, 0);

end;

 

Code:

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key = VK_F8 then

   SendMessage(Memo1.Handle, { HWND для Memo }

     WM_VSCROLL, { сообщение Windows }

     SB_PAGEDOWN, {на страницу вниз }

     0) { не используется }

else if Key = VK_F7 then

   SendMessage(Memo1.Handle, WM_VSCROLL, SB_PAGEUP, 0);

end;

 

 

 

Code:

procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  Memo1.SelStart  := LoWord(SendMessage(Memo1.Handle, EM_CHARFROMPOS, 0, MakeLParam(X, Y)));

  Memo1.SelLength := 0;

end;

 

 

Code:

procedure TForm1.Button1Click(Sender: TObject);

begin

  if Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then

    ShowMessage('Undo is possible')

  else

    ShowMessage('Undo is not possible');

end;

 

Мне необходимо обновлять текущую строку в во время перемещения по ним с помощью курсорных клавиш.

Вам повезло. Совсем недавно мне пришлось помучиться с этой задачкой. Я переместил функции в отдельный модуль. Для тестирования кода создайте пустую форму с одним компонентом Tmemo.

Вам потребуется перехватывать ряд событий. В приведенном ниже коде я создал обработчиков всех возможных для данной операции событий, выберите себе необходимые сами. Некоторые из событий могут иметь общий обработчик.

Данный пример отображает в заголовке текущие координаты курсора (столбец, строка).

Я не стал отображать координаты, когда текст выбран, поскольку не был уверен как этим оперировать без рассогласования...

Сообщайте мне о любых возникающих проблемах, но я уверен что это должно работать как положено.

 

 

Code:

{************************************************************

* Procedure PostKeyEx

*

* Parameters:

*  hWindow: target window to be send the keystroke

*  key    : virtual keycode of the key to send. For printable

*           keys this is usually the ANSI code (Ord(character))

*           of the UPPERCASE character. See VkKeyScan to obtain

*           the virtual key codes of other characters.

*  shift  : state of the modifier keys. This is a set, so you

*           can set several of these keys (shift, control, alt,

*           mouse buttons) in tandem. The TShiftState type is

*           declared in the Classes Unit.

*  specialkey: normally this should be False. Set it to True to

*           specify a key on the numeric keypad, for example.

*           If this parameter is true, bit 24 of the lparam for

*           the posted WM_KEY* messages will be set.

* Description:

*  This procedure sets up Windows key state array to correctly

*  reflect the requested pattern of modifier keys and then posts

*  a WM_KEYDOWN/WM_KEYUP message pair to the target window. Then

*  Application.ProcessMessages is called to process the messages

*  before the keyboard state is restored.

* Error Conditions:

*  May fail due to lack of memory for the two key state buffers.

*  Will raise an exception in this case.

* NOTE:

*  Setting the keyboard state will not work across applications

*  running in different memory spaces on Win32.

*Created: 02/21/96 16:39:00 by P. Below

************************************************************}

Procedure PostKeyEx( hWindow: HWnd; key: Word; Const shift: TShiftState;

                    specialkey: Boolean );

Type

TBuffers = Array [0..1] of TKeyboardState;

Var

pKeyBuffers : ^TBuffers;

lparam: LongInt;

Begin

(* check if the target window exists *)

If IsWindow(hWindow) Then Begin

   (* set local variables to default values *)

   pKeyBuffers := Nil;

   lparam := MakeLong(0, MapVirtualKey(key, 0));

   (* modify lparam if special key requested *)

   If specialkey Then

     lparam := lparam or $1000000;

   (* allocate space for the key state buffers *)

   New(pKeyBuffers);

   try

     (* Fill buffer 1 with current state so we can later restore it.

        Null out buffer 0 to get a "no key pressed" state. *)

     GetKeyboardState( pKeyBuffers^[1] );

     FillChar(pKeyBuffers^[0], Sizeof(TKeyboardState), 0);

     (* set the requested modifier keys to "down" state in the buffer *)

     If ssShift In shift Then

       pKeyBuffers^[0][VK_SHIFT] := $80;

     If ssAlt In shift Then Begin

       (* Alt needs special treatment since a bit in lparam needs also be

set *)

       pKeyBuffers^[0][VK_MENU] := $80;

       lparam := lparam or $20000000;

     End;

     If ssCtrl In shift Then

       pKeyBuffers^[0][VK_CONTROL] := $80;

     If ssLeft In shift Then

       pKeyBuffers^[0][VK_LBUTTON] := $80;

     If ssRight In shift Then

       pKeyBuffers^[0][VK_RBUTTON] := $80;

     If ssMiddle In shift Then

       pKeyBuffers^[0][VK_MBUTTON] := $80;

     (* make out new key state array the active key state map *)

 

     SetKeyboardState( pKeyBuffers^[0] );

 

     (* post the key messages *)

     If ssAlt In Shift Then Begin

       PostMessage( hWindow, WM_SYSKEYDOWN, key, lparam);

       PostMessage( hWindow, WM_SYSKEYUP, key, lparam or $C0000000);

     End

     Else Begin

       PostMessage( hWindow, WM_KEYDOWN, key, lparam);

       PostMessage( hWindow, WM_KEYUP, key, lparam or $C0000000);

     End;

     (* process the messages *)

     Application.ProcessMessages;

     (* restore the old key state map *)

     SetKeyboardState( pKeyBuffers^[1] );

   finally

     (* free the memory for the key state buffers *)

     If pKeyBuffers <> Nil Then

       Dispose( pKeyBuffers );

   End; { If }

End;

End; { PostKeyEx }

 

Пример:

 

Code:

procedure TForm1.SpeedButton2Click(Sender: TObject);

Var

W: HWnd;

begin

W := Memo1.Handle;

PostKeyEx( W, VK_END, [ssCtrl, ssShift], False ); {select all}

PostKeyEx( W, Ord('C'), [ssCtrl], False );        {copy to clipboard}

PostKeyEx( W, Ord('C'), [ssShift], False );       {replace with C}

PostKeyEx( W, VK_RETURN, [], False );             {new line}

PostKeyEx( W, VK_END, [], False );                {goto end}

PostKeyEx( W, Ord('V'), [ssCtrl], False );        {paste from keyboard}

end;

 

 

Code:

procedure TForm1.Button3Click(Sender: TObject);

var

t: TStringList;

begin

// создаем

t:=TStringList.Create;

// присваиваем переменной t строки из Memo

t.AddStrings(memo1.lines);

// сортируем

t.Sort;

memo1.Clear;

// присваиваем memo уже отсортированные строки

memo1.Lines.AddStrings(t);

end;

 

 

Элементы управления Windows TEdit и TMemo не имеют режима замены. Однако этот режим можно эмулировать установив свойство SelLength edit'а или memo в 1 при обработке события KeyPress. Это заставит его перезаписывать символ в текущей позиции курсора. В примере этот способ используется для TMemo. Режим вставка/замена переключается клавишей "Insert".

 

У меня имеется компонент TMemo, и мне необходимо автоматически "тормозить" программным способом его прокрутку при добавлении новой строки Memo.Lines.Add(Строка).

 

В Delphi 2.0 простая установка 'SelStart:=0' НЕ срабатывает. Это ошибка в коде VCL. Значения различных частей 'сообщения' windows, используемые для "set selection" (установления выбранной части текста) в WIN32 были изменены (это использовалось для 'автоматической' прокрутки каретки/курсора, но больше не работает).

 

Элементы управления Windows TEdit и TMemo не имеют режима замены. Однако этот режим можно эмулировать установив свойство SelLength edit'а или memo в 1 при обработке события KeyPress. Это заставит его перезаписывать символ в текущей позиции курсора. В примере этот способ используется для TMemo. Режим вставка/замена переключается клавишей "Insert".