FAQ VCL
Компоненты\Memo

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как вставить содержимое файла в текущую позицию TMemo?

procedure TForm1.Button1Click(Sender: TObject);
var
  MStream: TMemoryStream;
  Zero: char;
begin
  MStream := TMemoryStream.Create;
  MStream.LoadFromFile('c:\boot.ini');
  MStream.Seek(0, soFromEnd);
  Zero := #0;
  MStream.Write(Zero, 1);
  MStream.Seek(0, soFromBeginning);
  Memo1.SetSelTextBuf(MStream.Memory);
  MStream.Free;
end;


Как выделить строку в TMemo при щелчке на ней?

procedure TForm1.Memo1Click(Sender: TObject);
var
  Line: Integer;
begin
  with (Sender as TMemo) do
  begin
    Line := Perform(EM_LINEFROMCHAR, SelStart, 0);
    SelStart := Perform(EM_LINEINDEX, Line, 0);
    SelLength := Length(Lines[Line]);
  end;
end;


Как сделать, чтобы слово в TMemo переносилось не целиком, а только та его часть, которая не помещается?

var
  Form1: TForm1;
  OriginalWordBreakProc: Pointer;
  NewWordBreakProc: Pointer;

implementation

function MyWordBreakProc(LPTSTR: PChar; ichCurrent: Integer;
cch: Integer; code: Integer ): Integer;
{$IFDEF WIN32} stdcall; {$ELSE} export; {$ENDIF}
begin
  Result := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OriginalWordBreakProc:= Pointer(SendMessage(Memo1.Handle,
                                  EM_GETWORDBREAKPROC, 0, 0));
  {$IFDEF WIN32}
  NewWordBreakProc := @MyWordBreakProc;
  {$ELSE}
  NewWordBreakProc := MakeProcInstance(@MyWordBreakProc, hInstance);
  {$ENDIF}
  SendMessage(Memo1.Handle, EM_SETWORDBREAKPROC, 0,
              Longint(NewWordBreakProc));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SendMessage(Memo1.Handle, EM_SETWORDBREAKPROC, 0,
              Longint(@OriginalWordBreakProc));
  {$IFNDEF WIN32}
  FreeProcInstance(NewWordBreakProc);
  {$ENDIF}
end;


Как изменить шрифт в TMemo на моноширный?

// SYSTEM_FIXED_FONT или ANSI_FIXED_FONT

procedure TForm1.FormCreate(Sender: TObject);
begin
  SendMessage(Memo1.Handle, WM_SETFONT,
              GetStockObject(SYSTEM_FIXED_FONT), 1);
end;


Как запретить показ курсора (каретки) в TMemo?

// На форме должен быть только один компонент,
// имеющий каретку (Edit, Memo и т.п.). Лучше всего
// создать своего потомка, и уже в нем проделать
// все приведенные ниже действия

type
  TForm1 = class(TForm)
    Memo1: TMemo;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMPaint(var Msg: TMessage); message WM_Paint;
    procedure WMSetFocus(var Msg: TMessage); message WM_SetFocus;
    procedure WMNCHitTest(var Msg: TMessage); message WM_NCHitTest;
  end;

implementation

procedure TForm1.WMNCHitTest(var Msg: TMessage);
begin
  inherited;
  HideCaret(Memo1.Handle);
end;

procedure TForm1.WMPaint(var Msg: TMessage);
begin
  inherited;
  HideCaret(Memo1.Handle);
end;

procedure TForm1.WMSetFocus(var Msg: TMessage);
begin
  inherited;
  HideCaret(Memo1.Handle);
end;


Как сделать в TMemo ограничение на количество строк?

procedure TForm1.Memo1Change(Sender: TObject);
const
  MaxLineCount = 5;
begin
  if Memo1.Lines.Count > MaxLineCount then
    Memo1.Perform(EM_UNDO, 0, 0);
  Memo1.Perform(EM_EMPTYUNDOBUFFER, 0, 0);
end;


Как следовать за мышкой в TMemo для установки позиции курсора?

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;


Как проверить, можно ли отменить последнее действие в TMemo?

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then
    ShowMessage('Можно отменить')
  else
    ShowMessage('Отмена невозможна');
end;


Как отменить последнее действие в TMemo?

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Perform(EM_UNDO, 0, 0);
end;


Как реализовать поиск в TMemo с использованием TFindDialog?

type
  TForm1 = class(TForm)
  private
    { Private declarations }
    FSelPos: integer;
  {...}
  end;

procedure TForm1.FindDialog1Find(Sender: TObject);
var
  s: string;
  startpos: Integer;
begin
  with TFindDialog(Sender) do
  begin
    if FSelPos = 0 then
       Options := Options - [frFindNext];

    if frfindNext in Options then
    begin
      StartPos := FSelPos + Length(Findtext);
      s := Copy(Memo1.Lines.Text, StartPos, MaxInt);
    end
    else
    begin
      s := Memo1.Lines.Text;
      StartPos := 1;
    end;
    FSelPos := Pos(FindText, s);
    if FSelPos > 0 then
    begin
      FSelPos := FSelPos + StartPos - 1;
      Memo1.SelStart := FSelPos - 1;
      Memo1.SelLength := Length(FindText);
      Memo1.SetFocus;
    end
    else
    begin
      if frfindNext in Options then
         s := Concat('There are no further occurences of "', FindText, '" in Memo1.')
      else
         s := Concat('Could not find "', FindText, '" in Memo1.');
      MessageDlg(s, mtError, [mbOK], 0);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FSelPos := 0;
  FindDialog1.Execute;
end;

При использовании материала - ссылка на сайт обязательна