Текущий архив: 2004.08.01;
Скачать: CL | DM;

Вниз

Проблема с определением позиции каретки в TMemo   Найти похожие ветки 

← →
Th   (2004-07-15 12:56) [0]

Кто-нибудь сталкивался со след. проблемой:
Есть компонент типа TMemo. Если предположим по его событиям OnClick и OnKeyDown выводить на экран позицию каретки (свойство SelStart), то при кликании мышкой позиция отображается верная, а если перемещать курсор клавишами <влево>-<вправо>, то начинается ботва.. Например если я сделал три нажатия <вправо>, то позиция исправно увеличивается на единицу три раза, но как только я сменю направление - нажму <влево>, то позиция опять увеличится, вместо того, чтобы уменьшится.
Пробовал получать позицию через сообщение CharFromPos и функцию GetCaretPos - то же самое..

---

← →
Johnmen ©   (2004-07-15 13:20) [1]

"В потолке открылся люк.
Не волнуйтесь, это глюк !" (c)

---

← →
Красный молоток   (2004-07-15 13:23) [2]

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
label1.Caption:=IntToStr( Memo1.CaretPos.X);
end;

---

← →
Th   (2004-07-15 14:12) [3]

пробовал, не помогает..

---

← →
Красный молоток   (2004-07-15 15:14) [4]

Код покажи.

---

← →
MacroDenS ©   (2004-07-15 16:51) [5]

Странно, у меня работает...
А пальцами пробовал?
Совсем народ пальцами стачать обленился...

---

← →
Th   (2004-07-15 17:47) [6]

to MacroDenS:
Что делать пальцами попробовать сделать, если не секрет? По клавиатуре я и так пальцами.. А думаю головой бычно - пальцами как-то неудобно думать..

Код простой:

procedure TMessageEditForm.txtMessageTextKeyDown(Sender: Object;
 var Key: Word; Shift: TShiftState);
begin
if Key in [VK_LEFT,VK_RIGHT] then
Caption := inttostr(GetTextPos);
end;

procedure TMessageEditForm.txtMessageTextClick(Sender: TObject);
begin
Caption := inttostr(GetTextPos);
end;


процедура GetTextPos:


function TMessageEditForm.GetTextPos: integer;
begin
result := txtMessageText.GetSelStart;
end;


или так:


function TMessageEditForm.GetTextPos: integer;
var lParam: cardinal;
   p: TPoint;
begin
GetCaretPos(p);
lParam := loword(p.x) + loword(p.y) shl 16;
result := loword(txtMessageText.Perform(EM_CHARFROMPOS, 0, x));
end;


Результат одинаков для обеих реализаций функции GetTextPos

---

← →
Th   (2004-07-15 17:48) [7]

да, опечатка - там в вызове Perform последний параметр не x, а lParam

---

← →
Красный молоток   (2004-07-15 18:11) [8]

А хде реализация GetTextPos через Memo.CaretPos. ??
Не верю шо не работает

---

← →
Th   (2004-07-15 18:16) [9]

не работает ;) пробовал
все эти свойства - selstart, caretpos, они через сообщения EM_GETSEL, EM_LINEFROMCHAR и EM_LINEINDEX ходят - с ними я тоже пробовал..

---

← →
Красный молоток   (2004-07-15 18:24) [10]

Ммать... Давай сюда весь код проекта

---

← →
Th   (2004-07-15 19:08) [11]


unit UMemoMain;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls;

type
 TFMain = class(TForm)
   txtMessageText: TMemo;
   radMethod: TRadioGroup;
   pnlPos: TPanel;
   lblPos: TLabel;
   lblPosTitle: TLabel;
   lblX: TLabel;
   lblXTitle: TLabel;
   lblY: TLabel;
   lblYTitle: TLabel;
   procedure txtMessageTextKeyDown(Sender: TObject; var Key: Word;
     Shift: TShiftState);
   procedure txtMessageTextClick(Sender: TObject);
 private
  procedure GetTextPos;
 public
 end;

var
 FMain: TFMain;

implementation

{$R *.DFM}

procedure TFMain.txtMessageTextKeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
GetTextPos;
end;

procedure TFMain.txtMessageTextClick(Sender: TObject);
begin
GetTextPos;
end;

procedure TFMain.GetTextPos;
var i: integer;
   lParam: cardinal;
   p:TPoint;
   v: integer;
begin
case radMethod.ItemIndex of
0:
 begin
 v := txtMessageText.SelStart;
 p.x := -1;
 p.y := -1;
 end;
1:
 begin
 v := 0;
 for i := 0 to txtMessageText.CaretPos.y - 1 do
  v := v + length(txtMessageText.Lines[i]) + 2;
 v := v + txtMessageText.CaretPos.x;
 p.x := txtMessageText.CaretPos.x;
 p.y := txtMessageText.CaretPos.y;
 end;
2:
 begin
 GetCaretPos(p);
 lParam := loword(p.x) + loword(p.y) shl 16;
 v := loword(txtMessageText.Perform(EM_CHARFROMPOS,0,lParam));
 p.x := -1;
 p.y := -1;
 end;
3:
 begin
 v := loword(txtMessageText.Perform(EM_GETSEL,0,0));
 p.y := txtMessageText.Perform(EM_LINEFROMCHAR,v,0);
 p.x := v - txtMessageText.Perform(EM_LINEINDEX,p.y,0);
 end;
end;

lblPos.Caption := inttostr(v);
lblX.Caption := inttostr(p.x);
lblY.Caption := inttostr(p.y);
end;

end.

---

← →
Th   (2004-07-15 19:11) [12]

DFM:

object FMain: TFMain
 Left = 475
 Top = 215
 BorderStyle = bsSingle
 Caption = "Типа вот..."
 ClientHeight = 362
 ClientWidth = 345
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "MS Sans Serif"
 Font.Style = []
 OldCreateOrder = False
 PixelsPerInch = 96
 TextHeight = 13
 object txtMessageText: TMemo
   Left = 0
   Top = 66
   Width = 345
   Height = 153
   Align = alTop
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
   Font.Height = -13
   Font.Name = "Courier New"
   Font.Style = []
   Lines.Strings = (
     "0123456789"
     "0123456789"
     "0123456789"
     "0123456789"
     "0123456789"
     "0123456789"
     "0123456789"
     "0123456789"
     "0123456789"
     "0123456789"
     "")
   ParentFont = False
   TabOrder = 0
   OnClick = txtMessageTextClick
   OnKeyDown = txtMessageTextKeyDown
 end
 object radMethod: TRadioGroup
   Left = 0
   Top = 265
   Width = 345
   Height = 97
   Align = alBottom
   Caption = " Как считать позицию "
   ItemIndex = 0
   Items.Strings = (
     "через SelStart"
     "через CaretPos"
     "через GetCaretPos/EM_CHARFROMPOS"
     "через EM_GETSEL/EM_LINEFROMCHAR/EM_LINEINDEX")
   TabOrder = 1
 end
 object pnlPos: TPanel
   Left = 0
   Top = 0
   Width = 345
   Height = 66
   Align = alTop
   Alignment = taLeftJustify
   BevelOuter = bvNone
   BorderWidth = 12
   TabOrder = 2
   object lblPos: TLabel
     Left = 64
     Top = 12
     Width = 21
     Height = 13
     Caption = "-//-"
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clWindowText
     Font.Height = -11
     Font.Name = "MS Sans Serif"
     Font.Style = [fsBold]
     ParentFont = False
   end
   object lblPosTitle: TLabel
     Left = 12
     Top = 12
     Width = 41
     Height = 13
     Caption = "Индекс:"
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clWindowText
     Font.Height = -11
     Font.Name = "MS Sans Serif"
     Font.Style = []
     ParentFont = False
   end
   object lblX: TLabel
     Left = 64
     Top = 28
     Width = 21
     Height = 13
     Caption = "-//-"
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clWindowText
     Font.Height = -11
     Font.Name = "MS Sans Serif"
     Font.Style = [fsBold]
     ParentFont = False
   end
   object lblXTitle: TLabel
     Left = 12
     Top = 28
     Width = 10
     Height = 13
     Caption = "X:"
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clWindowText
     Font.Height = -11
     Font.Name = "MS Sans Serif"
     Font.Style = []
     ParentFont = False
   end
   object lblY: TLabel
     Left = 64
     Top = 44
     Width = 21
     Height = 13
     Caption = "-//-"
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clWindowText
     Font.Height = -11
     Font.Name = "MS Sans Serif"
     Font.Style = [fsBold]
     ParentFont = False
   end
   object lblYTitle: TLabel
     Left = 12
     Top = 44
     Width = 10
     Height = 13
     Caption = "Y:"
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clWindowText
     Font.Height = -11
     Font.Name = "MS Sans Serif"
     Font.Style = []
     ParentFont = False
   end
 end
end


---

← →
Sun bittern ©   (2004-07-15 20:33) [13]

Th   (15.07.04 19:11) [12]

Зачем уж так буквально? :)

---

← →
Th   (2004-07-15 21:29) [14]

ну а что делать... ;)

---

← →
Anatoly Podgoretsky ©   (2004-07-15 22:19) [15]

Как что, приводить только значимый текст, вот нафига ты привел ДФМ файл?

---

← →
Th   (2004-07-15 22:36) [16]

"Красный молоток   (15.07.04 18:24) [10]:
Ммать... Давай сюда весь код проекта"

поэтому и привел.

Если помешало, сорри, только вот проблема осталась..

---

← →
Sun bittern ©   (2004-07-15 22:51) [17]

На сайт к
Anatoly Podgoretsky ©   (15.07.04 22:19) [15]
смотри анкету.
Там два толмута Тейксеро с Пачеко, и в каком то из них должен быть ответ на твой вопрос. Т.к. сие толмутов под рукой нет, то может Анатолий подскажит точнее в каком? Возможно в FAQах каких есть, тока поискать.

---

← →
Palladin ©   (2004-07-15 23:13) [18]

Все от недопонимания...
1 Клавиша нажалась
2 Событие обрабатывается
2.1 Берется состояние каретки
3 Меняется позиция каретки

Теперь понятно?

---

← →
Th   (2004-07-15 23:52) [19]

to Palladin
Это ответ.. Получается, надо в KeyUp вычислять. Все ок теперь.

Одно непонятно: позиция, вычисленная в событии KeyDown должна просто не изменятся. А она меняется, в противоположную от ожидаемого сторону (запаздывает на одно нажатие).

---

← →
Palladin ©   (2004-07-16 00:07) [20]

Нет, не в KeyUp... Обработка любого события происходит ДО перемещения каретки... соответственно координаты получаются предыдущие, а не текущие...

---

← →
Th   (2004-07-16 13:03) [21]

Ну да, наверно, но в моем случае KeyUp спасает, я проверил

---

← →
MacroDenS ©   (2004-07-16 14:36) [22]

Да поставь ты таймер с интервалом 10-100 vkc/
в нем обработку:

label1.caption:=IntToStr(memo1.caretpos.x);
label2.caption:=IntToStr(memo1.caretpos.y);

и посмотри, че получится, только лэйблы не забудь поставить.

---

← →
MacroDenS ©   (2004-07-16 14:37) [23]

сори..
10-100 милесекунд

---

← →
Th   (2004-07-16 15:02) [24]

Всем спасибо, проблема решена ;)

PS таймер пойдет для теста, который я прислал, но не пойдет для основной задачи

---

Страницы: 1 вся ветка

Текущий архив: 2004.08.01;
Скачать: CL | DM;

Наверх

Память: 0.53 MB
Время: 0.052 c