Написал такой способ Если у вас есть что по проще расскажите
Минус способа что каретка должна быть активной в момент замера.
Используется когда юзер скролит не элементами управления а выделением текста или KeyPress
Если юзер скролит с зажатой мышкой то таймер нужно запустить и вызывать
Обнову позиции GetMemoPos система не будет виснуть т.к в таймере можно интервал увеличить.
Спустя пару дней решил пересмотреть подход и вот к чему пришел.
function TAmMemoBarHorz.GetMemoPos:integer;
var Ln:TPoint;
LnRange:TSelectionRange;
TextLn:string;
WAll:integer;
begin
Result:=0;
LnRange:=Memo.SelRange;
if LnRange.CaretIs1 =1 then Ln:=Point(LnRange.Ch1,LnRange.Ln1)
else if LnRange.CaretIs1 =2 then Ln:=Point(LnRange.Ch2,LnRange.Ln2)
else exit();
if (Ln.Y<0) or (Ln.X<0) then exit;
TextLn:= Memo.Lines[Ln.Y];
TextLn:= copy(TextLn,1,Ln.X);
if length(TextLn)<=0 then exit;
Memo.Canvas.Font:=Memo.Font;
WAll:=Memo.Canvas.TextWidth(TextLn);
Result:= max(WAll - (LnRange.Caret.X - memo.ClientTextRect.Left),0);
end;
function TAmMemoCustom.ClientRectTextGet: TRect;
begin
FillChar(Result,Sizeof(Result),0);
if self.HandleAllocated then
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Result));
end;
function TAmMemoCustom.SelRangeGet: TSelectionRange;
var CurrentCharPos:integer;
begin
FillChar(Result,SizeOf(Result),0);
Result.CaretIs1:=0;
//if Screen.ActiveControl =self then
WinApi.Windows.GetCaretPos(Result.Caret) ;
//else exit;
If (Result.Caret.X < 0) or (Result.Caret.Y < 0) then exit;
SendMessage(Handle, EM_GETSEL, NativeInt(@Result.Sel.StartPos), NativeInt(@Result.Sel.EndPos));
Result.Ln1 := SendMessage(Handle, EM_LINEFROMCHAR, WPARAM(Result.Sel.StartPos), 0);
Result.Ch1 := SendMessage(Handle, EM_LINEINDEX, WPARAM(Result.Ln1), 0);
if Result.Sel.StartPos<>Result.Sel.EndPos then
begin
Result.Ln2 := SendMessage(Handle, EM_LINEFROMCHAR, WPARAM(Result.Sel.EndPos), 0);
if Result.Ln1<> Result.Ln2 then
Result.Ch2 := SendMessage(Handle, EM_LINEINDEX, WPARAM(Result.Ln2), 0)
else
Result.Ch2 := Result.Ch1;
CurrentCharPos := LoWord(perform(EM_CHARFROMPOS, 0, MakeLong(Result.Caret.X, Result.Caret.Y)));
if CurrentCharPos = Result.Sel.StartPos then Result.CaretIs1:=1
else if CurrentCharPos = Result.Sel.EndPos then Result.CaretIs1:=2
else
begin
if abs(Result.Sel.StartPos-CurrentCharPos)< abs(Result.Sel.EndPos-CurrentCharPos) then
Result.CaretIs1:=1
else Result.CaretIs1:=2;
end;
end
else
begin
Result.Ln2 := Result.Ln1;
Result.Ch2 := Result.Ch1;
Result.CaretIs1:=1;
end;
Result.Ch1 := Result.Sel.StartPos - Result.Ch1;
Result.Ch2 := Result.Sel.EndPos - Result.Ch2;
end;
Далее Что бы получить позицию при скролинге я ничего лучше не придумал чем.
устанавливать большой ренж скрола например при любом изменении текста
т.е pageSize станет оч маленькой но на это пох т.к свой скрол можно спрятать
сделать полу прозрачным. а вот когда юзер навел мышку на гориз скрол то пересчитать позицию и нарисовать ее.
procedure TAmMemoBarHorz.ScrollBy(Old,New:Integer);
var D,Exp:Integer;
begin
// Memo.ScrollBy
if not Memo.HandleAllocated or ((New - Old) = 0 ) then exit();
// D:= (New - Old) div Memo.LineHeight ;
{ D:= (New - Old);
SendMessage(Memo.handle, EM_LINESCROLL, D, 0);// wparam = horiz lparam = vert
}
D:=SendMessage(Memo.handle, WM_HScroll,MakeLParam(SB_THUMBPOSITION, New), 0);
Exp:=LoWord(D);
if HiWord(D) = 1 then
begin
if New-Old < 0 then
Exp:= Exp - word.MaxValue -1;
if New-Old <> Exp then
UpdatePosRangeAtScroling;
end;
end;
procedure TAmMemoBarHorz.ScrollHorizMouseEnter(Sender: TObject);
begin
if not FUpadateModified then exit;
FUpadateModified:=false;
UpdatePosRangeAtScroling;
end;
procedure TAmMemoBarHorz.UpdatePosRangeAtScroling();
var D:Integer;
OldRange:integer;
begin
OldRange:= FRange;
FRange:=0;
//SendMessage(Memo.Handle, WM_SETREDRAW, Ord(false), 0);
try
D:=SendMessage(Memo.handle, WM_HScroll,SB_LEFT, 0);//крутим влево
if HiWord(D) = 1 then
FPos:= word.MaxValue - LoWord(D) +1
else FPos:= 0;
D:=SendMessage(Memo.handle, WM_HScroll,SB_RIGHT, 0);//крутим вправо до упора и получаем range
if HiWord(D) = 1 then
FRange:= LoWord(D);
FRange:= FRange + GetMemoPageSize;
Scroll.Visible:= RangeClientGet>0;
SendMessage(Memo.handle, WM_HScroll,MakeLParam(SB_THUMBPOSITION, FPos), 0);
ScrollSetPrm(Scroll,OldRange,FRange, GetMemoPageSize ,FPos,FPos,false);
finally
//SendMessage(Memo.Handle, WM_SETREDRAW, Ord(true), 0);
end;
end;
Код конечно вырван из модуля и много своих процедур но
главный принцип что не нужно гнаться что бы узнать позицию в каждую милисек
достаточно это делать только по требованию юзера.