1

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

Вертикальную позицию могу получить так

FPos:=   Memo.Perform(EM_GETFIRSTVISIBLELINE,0,0)*Memo.LineHeight;
//Memo.Perform(EM_GETFIRSTVISIBLELINE,0,0) вернет индекс а перемножение даст пиксели

я знаю что можно так

FPos:= GetScrollPos(Memo.Handle,SB_HORZ);

но это не работает если убрать стандартную полосу прокрутки

введите сюда описание изображения

0

1 ответ 1

0

Написал такой способ Если у вас есть что по проще расскажите Минус способа что каретка должна быть активной в момент замера. Используется когда юзер скролит не элементами управления а выделением текста или 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;

Код конечно вырван из модуля и много своих процедур но
главный принцип что не нужно гнаться что бы узнать позицию в каждую милисек 
достаточно это делать только по требованию юзера.

Ваш ответ

Нажимая «Отправить ответ», вы соглашаетесь с условиями пользования и подтверждаете, что прочитали политику конфиденциальности.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.