| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Проблема с определением позиции каретки в TMemo [D5, D6, Win2k, WinXP]

Страницы:   < 1 2 >

Th ©   (2004-07-15 12:56:00) 

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

---

Th   (2004-07-16 15:02:00) [1]

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

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

---

MacroDenS   (2004-07-16 14:37:00) [2]

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

---

MacroDenS   (2004-07-16 14:36:00) [3]

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

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

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

---

Th   (2004-07-16 13:03:00) [4]

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

---

Palladin   (2004-07-16 00:07:00) [5]

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

---

Th   (2004-07-15 23:52:00) [6]

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

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

---

Palladin   (2004-07-15 23:13:00) [7]

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

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

---

Sun bittern   (2004-07-15 22:51:00) [8]

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

---

Th   (2004-07-15 22:36:00) [9]

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

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

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

---

Anatoly Podgoretsky   (2004-07-15 22:19:00) [10]

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

---

Th   (2004-07-15 21:29:00) [11]

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

---

Sun bittern   (2004-07-15 20:33:00) [12]

Th   (15.07.04 19:11) [12]

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

---

Th   (2004-07-15 19:11:00) [13]

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


---

Th   (2004-07-15 19:08:00) [14]


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.

---

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

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

---

Th   (2004-07-15 18:16:00) [16]

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

---

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

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

---

Th   (2004-07-15 17:48:00) [18]

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

---

Th   (2004-07-15 17:47:00) [19]

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

---

MacroDenS   (2004-07-15 16:51:00) [20]

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

---

Страницы:   < 1 2 >

Наверх