GetPointPosition Tmemo

[bilrax]

function GetPointPosition(Memo: TMemo; Pt: TPointF; RoundToWord: Boolean = False): TCaretPosition;
var
 I, LPos: Integer;
 Rgn: TRegion;
begin
 Result.Line := -1;
 Result.Pos := -1;
 for I := 0 to Memo.Lines.Count - 1 do
 begin
   if Memo.Lines.Objects[I] is TTextLayout then
   begin
     LPos := TTextLayout(Memo.Lines.Objects[I]).PositionAtPoint(Pt, RoundToWord);
     if LPos >= 0 then
     begin
       if LPos > 0 then
       begin
         Rgn := TTextLayout(Memo.Lines.Objects[I]).RegionForRange(TTextRange.Create(LPos, 1), RoundToWord);
         if (Length(Rgn) > 0) and (Rgn[0].Top > Pt.Y) then
           Dec(LPos);
       end;
       Result.Line := I;
       Result.Pos := LPos;
       Break;
     end;
   end;
 end;
end;

xe2 de memo içerisinde verilen noktanın caretposition değerini almak mümkündü fakat sonrasında bu özelliği kaldırmışlar ama yerini neyle doldurmuşlar açıkcası ben bulamadım..

kendimce yöntemler denedim ama caret position değerini hızlı bi şekilde bulamıyorum ve klavyeyi kitliyor.. mousemove eventi içerisine şunları yazdım

   try

     if memo2.Text.Length>0 then begin
      line              := memo2.Lines.Count-1;
      pos               := memo2.Lines[line].Length;
      posOK             := false;

      memo2.CaretPosition := TCaretPosition.Create(line,(memo2.Lines[line].Length));

          while not posok do
         begin

            if ((memo2.Caret.Pos.x> x)or(memo2.Caret.Pos.Y> Y))and
               (memo2.CaretPosition.Line+memo2.CaretPosition.Pos > 0)then
             memo2.CaretPosition:= TCaretPosition.Create(line,pos)
              else
                posok := true;// doğru caret position değerini buldu


            if (pos>0) and (not posok) then
                  dec(pos)
                     else
                       if (line>0) and (not posok) then
                          begin
                          dec(line);
                          pos:= memo2.Lines[line].Length;
                          end
                                  else
                                   posOk:=True; // 0,0 olduğunda

         end;
     end;

   except on e : exception do
    memo1.Lines.Add(e.ToString);
  end;

Pozisyonu bulduruyorum ama hantal bi yöntem oldu.. konuyla ilgili denemesi olan arkadaşım oldumu?

[esrehmaan]

(20-12-2016, Saat: 22:13)bilrax Adlı Kullanıcıdan Alıntı:

function GetPointPosition(Memo: TMemo; Pt: TPointF; RoundToWord: Boolean = False): TCaretPosition;
var
 I, LPos: Integer;
 Rgn: TRegion;
begin
 Result.Line := -1;
 Result.Pos := -1;
 for I := 0 to Memo.Lines.Count - 1 do
 begin
   if Memo.Lines.Objects[I] is TTextLayout then
   begin
     LPos := TTextLayout(Memo.Lines.Objects[I]).PositionAtPoint(Pt, RoundToWord);
     if LPos >= 0 then
     begin
       if LPos > 0 then
       begin
         Rgn := TTextLayout(Memo.Lines.Objects[I]).RegionForRange(TTextRange.Create(LPos, 1), RoundToWord);
         if (Length(Rgn) > 0) and (Rgn[0].Top > Pt.Y) then
           Dec(LPos);
       end;
       Result.Line := I;
       Result.Pos := LPos;
       Break;
     end;
   end;
 end;
end;

xe2 de memo içerisinde verilen noktanın caretposition değerini almak mümkündü fakat sonrasında bu özelliği kaldırmışlar ama yerini neyle doldurmuşlar açıkcası ben bulamadım..

kendimce yöntemler denedim ama caret position değerini hızlı bi şekilde bulamıyorum ve klavyeyi kitliyor.. mousemove eventi içerisine şunları yazdım

   try

     if memo2.Text.Length>0 then begin
      line              := memo2.Lines.Count-1;
      pos               := memo2.Lines[line].Length;
      posOK             := false;

      memo2.CaretPosition := TCaretPosition.Create(line,(memo2.Lines[line].Length));

          while not posok do
         begin

            if ((memo2.Caret.Pos.x> x)or(memo2.Caret.Pos.Y> Y))and
               (memo2.CaretPosition.Line+memo2.CaretPosition.Pos > 0)then
             memo2.CaretPosition:= TCaretPosition.Create(line,pos)
              else
                posok := true;// doğru caret position değerini buldu


            if (pos>0) and (not posok) then
                  dec(pos)
                     else
                       if (line>0) and (not posok) then
                          begin
                          dec(line);
                          pos:= memo2.Lines[line].Length;
                          end
                                  else
                                   posOk:=True; // 0,0 olduğunda

         end;
     end;

   except on e : exception do
    memo1.Lines.Add(e.ToString);
  end;

Pozisyonu bulduruyorum ama hantal bi yöntem oldu.. konuyla ilgili denemesi olan arkadaşım oldumu?

Böyle bişi buldum ama bi dener misin

function GetCaretPosition(var APoint: TPoint): Boolean;
var w: HWND;
 aID, mID: DWORD;
begin
 Result:= False;
 w:= GetForegroundWindow;
 if w <> 0 then
 begin
   aID:= GetWindowThreadProcessId(w, nil);
   mID:= GetCurrentThreadid;
   if aID <> mID then
   begin
     if AttachThreadInput(mID, aID, True) then
     begin
       w:= GetFocus;
       if w <> 0 then
       begin
         Result:= GetCaretPos(APoint);
         Windows.ClientToScreen(w, APoint);
       end;
       AttachThreadInput(mID, aID, False);
     end;
   end;
 end;
end;


//Small demo: set cursor to active caret position
procedure TForm1.Timer1Timer(Sender: TObject);
var
 Pt: TPoint;
begin
 if GetCaretPosition(Pt) then
 begin
   ListBox1.Items.Add(Format('Caret position is %d %d', [Pt.x, Pt.y]));
   SetCursorPos(Pt.X, Pt.Y);
 end;
end;

[bilrax]

sanki sizin verdiğiniz örnek caret pozisyon değerini (point(x,y)) veriyor.. zaten fmx de bunu yapan bir function var.. örneğin MEMO.Caret.Pos.Y veya X. bu aktif caret durumunun pozisyonunu veriyor. brnim istediğim bunun tam tersi, ben noktayı vericem Point (x,y) o bana line ve pos değerini vericek

Benim amacım memo içerisinde (caret) yazım imlecini sürükleyerek gezdirmekti ve hızlı bi yöntem bulmam gerekiyordu..  Ya ben bilmiyorum yada fmx tmemo veya Tedit bileşenlerinde bu özellik yok. İlk paylaştığım örnek caret pozisyonunu textin sonununa atıyor ve birer birer geri çekiyor ve devamında çıkan tutamacı sürüklediğimde tekrardan hesaplattırıp tutamacı takip etmesini sağlıyorum. yani her tounchmove hareketimde parmağımın ekrandaki point değerini hesaplayıp takibini sağlıyorum..
 
burda benim hatam imleci sona atıp her pozisyonu tek tek denetmek oldu. 2 gündür biraz zaman ayırdım ve indis alarak yapmanın daha mantıklı olduğunu düşündüm. (orta değere konumlamndırıp karşılaştır küçükse alttaki büyükse yukardaki textin indisini al ve sonuna kadar devam et)

400 karakterlik bir yazıda 100. karakter üzerinde sürükleme yapıyosam 300 karşılaştırma yapması gerekiyordu, indis kullanınca bu değer 6 ya da 7 oluyor.. Genel bir function yazamadım ama yapılabilir son haliyle şu şekilde formun touch eventi içinde kullanıyorum

 

             line              := MEMO.Lines.Count-1;
             posok          := false;

                    TThread.Synchronize(nil,procedure
                   var i: integer;
                   begin

                 //y,x sürükleme anındaki kordinatlar

                     MEMO.CaretPosition := TCaretPosition.Create(line,0);

                          for I := 0 to line do // line bulunuyor
                          begin
                           if (MEMO.Caret.Pos.Y> Y)and(line>0) then
                           begin
                           dec(line);
                           MEMO.CaretPosition:= TCaretPosition.Create(line,0);
                           end;
                          end; 
                          //line ok

                      ust    := memo.Lines[line].Length;
                      alt    := 0;
                      orta   := Round((alt+ust)/2);

                      MEMO.CaretPosition:= TCaretPosition.Create(line,orta);

                          i :=0;
                          repeat
                            inc(i);
                          
                           if ((X<memo.Caret.Pos.X )and(Y-MEMO.Caret.Pos.Y<17.75))  // 17,75 yazı boyutu ve boşlukları 15+2,75
                              or(Y-MEMO.Caret.Pos.Y<0)then
                           begin // sürükleme küçük.. geride


                           ust    := orta;
                           orta   := Trunc((alt+ust)/2);

                           MEMO.CaretPosition:= TCaretPosition.Create(line,orta);

                            if alt=orta then posOK:=true;

                           end;

                           if ((X>memo.Caret.Pos.X)and(Y-MEMO.Caret.Pos.Y>0))
                              or(Y-MEMO.Caret.Pos.Y>17.75)then 
                           begin // sürükleme büyük.. ileride

                            alt    := orta;
                            orta   := trunc((alt+ust)/2);

                            MEMO.CaretPosition:= TCaretPosition.Create(line,orta);

                            if (X-memo.Caret.Pos.X>10)and(orta<ust)and(alt=orta) then
                            begin
                              inc(orta); // memonun sağ dışına sürüklediğimde satır sonuna getirmek için
                              MEMO.CaretPosition:= TCaretPosition.Create(line,orta);
                            end;

                                if ((alt=orta)or(ust=orta))then posOK:=true;

                           end;

                           // 100 emniyet sibobu.. kitlenmesin
                           // normalde 3 5 hamlede noktayı yakalıyorum
                           // ama göremedğim birşey olabilir
                          until (posOK)or(i>100);// pos.x ok

                   end);

---

paylaştığınız örnek win apiler için sanırım.. ben fmx android uygulamalar için bi şey arıyodum :/