简体   繁体   中英

Delphi scrolling Memo

Right now i have this code.

procedure TForm1.Memo1Change(Sender : TObject);
begin
  SendMessage(Informacje.Handle, EM_LINESCROLL, 0, Memo1.Lines.Count);
end;

The problem is that I can't scroll up MemoLines when new lines are added. I want to stop moving cursor to the end on scroll up, start back moving cursor to the end when scrollbar is at bottom. Thank You for help.
In others words. Imagine there is a IRC chat with Memo. New message, caret is at end of last message. Now i want to read previous messages usin scroll bar (up) but i cant cause there are newer messages which move carret back to bottom. I want to stop it on mouse wheel up, read messages and after that back to previous state (caret once again at end on new message) when i will scroll to the bottom.

You need a condition to decide whether to scroll to the bottom or not. The below seems to work with a simple test, it sums the top most visible line with the number of possible lines that the memo can show to find out if the last line is visible or not.

procedure TForm1.Memo1Change(Sender: TObject);
var
  LineCount, TopLine: Integer;
begin
  LineCount := Memo1.Perform(EM_GETLINECOUNT, 0, 0) - 1;
  TopLine := Memo1.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
  if (TopLine + GetVisibleLineCount(Memo1)) >= LineCount then
    SendMessage(Memo1.Handle, EM_LINESCROLL, 0, LineCount);
end;

where

function GetVisibleLineCount(Memo: TMemo): Integer;
var
  DC: HDC;
  SaveFont: HFONT;
  TextMetric: TTextMetric;
  EditRect: TRect;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, Memo.Font.Handle);
  GetTextMetrics(DC, TextMetric);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);

  Memo.Perform(EM_GETRECT, 0, LPARAM(@EditRect));
  Result := (EditRect.Bottom - EditRect.Top) div TextMetric.tmHeight;
end;

(You can cache the visible line count to avoid having to calculate it for every change in the memo.)

You may need to further tweak the code though, fi for the case where there are less lines in the memo that it can show. Also this code does not take the caret position into consideration.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM