Подвисает программа после после использования колеса мыши

← →
madmech © (2010-06-03 16:31) [0]

Работаю с неким гридом, в котором обрабатываю OnMouseMove. В обработчике я задаю хинт, динамически меняющийся в зависимости от содержимого ячейки, над которой в данный момент находится курсор. До поры до времени все работает нормально, но как только я использую колесо мыши, например, для того, чтобы сместиться в конец грида, и навожу курсор на него, программа подвисает. Причем не сразу и не совсем стандартно: за курсором начинает тянуться странный шлейф, кнопка выхода не работает, хотя все остальные реагируют на команды, а через некоторое время программа виснет окончательно. Если я отключаю OnMouseMove, проблема исчезает.
Что делать?
Проблема появилась после перехода с D7 на D2010.
Куски кода я по необходимости представлю.

← →
madmech © (2010-06-03 17:25) [1]

procedure TMainForm.EnumDBGridMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); // Обработка перемещения курсора var XX, YY, CurRec: integer; // мыши над EnumDBGrid m, i, Pos: integer; s: string; KG_Flag: Boolean; begin with THackDBGrid(EnumDBGrid) do begin XX := MouseCoord(x, y).x; YY := MouseCoord(x, y).y; s := ""; if number1 > 1 then begin KG_Flag := True; for m := 1 to number1 do KG_Flag := KG_Flag and (( XX <> 2 * (m + 1) - 1 ) or ( YY <> 0 )); if (( XX <> 2 * (number1 + 1) ) or ( YY <> 0 )) and (( XX <> 2 * (number1 + 1) + 1 ) or ( YY <> 0 )) and KG_Flag then ShowHint := False; end else if ( XX <> 4 ) or ( YY <> 0 ) then ShowHint := False; CurRec := DataLink.ActiveRecord; DataLink.ActiveRecord := YY - 1; if number1 > 1 then begin ... for m := 1 to number1 do if ((XX = 2 * m) or (XX = 2 * m + 1)) and (YY > 0) then begin ShowHint := True; DM1.EnumCDS.RecNo := Columns[1].Field.AsInteger; Pos := 1; for i := 1 to quantity do begin if i = 1 then s := SurName[StrToInt(ExtractSubstr(Columns[2*m].Field.AsWideString, Pos, [",", " "]))-1] else s := s + #13 + SurName[StrToInt(ExtractSubstr(Columns[2*m].Field.AsWideString, Pos, [",", " "]))-1]; Pos := Pos + 1; end; Hint := s; Break; end; ... end else begin ... end; Application.ActivateHint(Mouse.CursorPos); DataLink.ActiveRecord := CurRec; end; end;

Места, помеченные многоточием, похожи на центральную часть, поэтому не вижу смысла их приводить. Если убрать прямое обращение к содержимому DBGrid"а, как Columns[1].Field.AsInteger, то проблема исчезает.

← →
Игорь Шевченко © (2010-06-03 17:32) [2]

> Что делать?

Запустить под отладчиком

← →
madmech © (2010-06-03 18:02) [3]

Так проблема в том, что моя программа является по сути некой надстройкой над общей (главной) программой, и оформляется она у меня в виде DLL. Так вот, когда я запускаю мой блок "локально", из Delphi 2010, то подвисания не происходит, а вот когда я его запускаю уже, как часть единого целого, из главной программы, то эта "ошибка" появляется.

← →
turbouser © (2010-06-03 18:11) [4]

> madmech © (03.06.10 18:02) [3]

1) где DisableControls?
2) вообще, странное что-то.. на онмоусемове дергать датасеты..

← →
madmech © (2010-06-03 18:32) [5]

> turbouser

1) Использование пары DM1.EnumCDS.DisableControls и DM1.EnumCDS.EnableControls, "обрамляющей" код, ситуцию не спасло.
2) А что можете предложить Вы?

← →
turbouser © (2010-06-03 23:50) [6]

> madmech © (03.06.10 18:32) [5]

> 2) А что можете предложить Вы?

Ловить момент появления хинта и в этот момент формировать его текст.

← →
madmech © (2010-06-04 10:57) [7]

> Ловить момент появления хинта и в этот момент формировать
> его текст.

А я разве не это делаю?

← →
turbouser © (2010-06-04 11:23) [8]

> madmech © (04.06.10 10:57) [7]
>
>
> > Ловить момент появления хинта и в этот момент формировать
> > его текст.
>
>
> А я разве не это делаю?
>

нет :)
хинт появляется обычно с какой-то задержкой. а в данном случае куча кода выполняется при малейшем движении мыши. т.е. как минимум раз в 10 чаще, чем требуется.

← →
Leonid Troyanovsky © (2010-06-04 13:34) [9]

> madmech © (03.06.10 17:25) [1]

> DataLink.ActiveRecord := YY - 1;

Что это значит? RowFixed = 1?

> DM1.EnumCDS.RecNo := Columns[1].Field.AsInteger;

Что есть DM1.EnumCDS? Другой датасет?
Почему Columns[1], а не, скажем, DataLink.Fields[..].AsInteger?
Что будет, если эта ссылка невалидна?

--
Regards, LVT.

← →
madmech © (2010-06-07 15:52) [10]

> turbouser © (04.06.10 11:23) [8]

> хинт появляется обычно с какой-то задержкой. а в данном
> случае куча кода выполняется при малейшем движении мыши.
> т.е. как минимум раз в 10 чаще, чем требуется.

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

> Leonid Troyanovsky © (04.06.10 13:34) [9]

> Что это значит? RowFixed = 1?

Придется ответить по-еврейски: что значит "RowFixed = 1"?

> Что есть DM1.EnumCDS? Другой датасет?

Нет, это датасет, к которому привязан данный ДБГрид.

> Почему Columns[1], а не, скажем, DataLink.Fields[..].AsInteger?

А черт его знает... Захотелось так сделать... По правде сказать, я это решение нашел на DelphiKingdom и слепо скопировал его к себе в код, видоизменив с учетом своих нужд.

> Что будет, если эта ссылка невалидна?

А с какой стати ей быть невалидной? Или Вы намекаете на то, что следует использовать защищенные конструкции?

← →
Leonid Troyanovsky © (2010-06-07 16:03) [11]

> madmech © (07.06.10 15:52) [10]

> Придется ответить по-еврейски: что значит "RowFixed = 1"?

Попробуй в первом приближении.
type TDBGridEx = class(TDBGrid); procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var GridCoord: TGridCoord; OldActiveRecord: Integer; begin with TDBGridEx(Sender) do begin GridCoord := MouseCoord(HitTest.X, HitTest.Y); if (GridCoord.X >= FixedCols) and (GridCoord.Y >= FixedRows) then begin if (GridCoord.Y <> OldRowIndex) or (GridCoord.X <> OldColIndex) then begin Application.CancelHint; OldActiveRecord := DataLink.ActiveRecord; try DataLink.ActiveRecord := GridCoord.Y - FixedRows; Hint := DataLink.Fields[GridCoord.X-FixedCols].AsString; finally DataLink.ActiveRecord := OldActiveRecord; end; OldRowIndex := GridCoord.Y; OldColIndex := GridCoord.X; end; end else Application.CancelHint; end; end;
--
Regards, LVT.

← →
Leonid Troyanovsky © (2010-06-07 16:16) [12]

> Leonid Troyanovsky © (07.06.10 16:03) [11]

Да, и еще я б отрубал такую обработку на время прокрутки.
Скажем, включать ее по таймеру, пускаемому в OnAfterScroll.

--
Regards, LVT.

← →
madmech © (2010-06-08 14:16) [13]

> Да, и еще я б отрубал такую обработку на время прокрутки.
> Скажем, включать ее по таймеру, пускаемому в OnAfterScroll.
>

Не помогло. Правда, я поступил несколько иначе: обработку OnMouseMove я отрубил в начале обработки поворота колеса мыши (в ApplicationEvents.OnMessage) за счет использования флага. А в конце опять флаг инвертирую и тем самым включаю обработку "нутра" OnMouseMove.

> Попробуй в первом приближении.

А что такое: OldRowIndex и OldColIndex? Произвольные переменные?

← →
Leonid Troyanovsky © (2010-06-08 14:27) [14]

> madmech © (08.06.10 14:16) [13]

> А что такое: OldRowIndex и OldColIndex? Произвольные переменные?

Подразумевались приватные поля формы: Longint.

> мыши (в ApplicationEvents.OnMessage) за счет использования
> флага. А в конце опять флаг инвертирую

А конец как определишь?
В любом случае, такую обработку лучше отключить на любой скролл,
т.е. OnBeforeScroll флаг и таймер сбрасываются, в OnAfterScroll
пускается таймер, в OnTimer (~100 мс) флаг устанавливается.

--
Regards, LVT.

← →
Leonid Troyanovsky © (2010-06-08 14:30) [15]

> Leonid Troyanovsky © (08.06.10 14:27) [14]

> в OnTimer (~100 мс) флаг устанавливается.

а таймер останавливается.

--
Regards, LVT.

← →
turbouser © (2010-06-08 14:37) [16]

> madmech © (08.06.10 14:16) [13]

Лучше всего было бы создать потомка от грида, переопределить ему CMHintShow и в там уже делать вычисления.

← →
madmech © (2010-06-08 16:31) [17]

> turbouser © (08.06.10 14:37) [16]
> > madmech © (08.06.10 14:16) [13]Лучше всего было бы создать
> потомка от грида, переопределить ему CMHintShow и в там
> уже делать вычисления.

Что за CMHintShow? Если это метод, то я его у TDBGrid не нашел.

> Leonid Troyanovsky © (08.06.10 14:27) [14]
> > madmech © (08.06.10 14:16) [13] > А что такое: OldRowIndex
> и OldColIndex? Произвольные переменные?Подразумевались приватные
> поля формы: Longint.

Я так понимаю, что все же речь идет о скрытых свойствах TDBGrid. Так вот, нет таких свойств ни у TDBGrid, ни у TCustomDBGrid, ни у TCustomGrid.

> А конец как определишь?В любом случае, такую обработку лучше
> отключить на любой скролл, т.е. OnBeforeScroll флаг и таймер
> сбрасываются, в OnAfterScroll пускается таймер, в OnTimer
> (~100 мс) флаг устанавливается.

Конец я определяю по концу кода в ApplicationEvents.OnMessage. А использование OnBeforeScroll и OnAfterScroll мне не подходит, поскольку компилятор заходит туда при любом изменение положения курсора в таблице, так же как и при любом перемещении мыши над гридом. А мне нужно один раз перед началом прокрутки отключить OnMouseMove и один раз выключить в конце прокрутки.

← →
turbouser © (2010-06-08 16:46) [18]

> madmech © (08.06.10 16:31) [17]
>

CMHintShow - это вообще у TControl.
В качестве примера:
type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; type TmyGrid = class(TStringGrid) public procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW; end; var Form1: TForm1; MyGrid: TMyGrid; implementation {$R *.dfm} procedure TmyGrid.CMHintShow(var Message: TMessage); var C, R: integer; P: TPoint; begin P := ScreenToClient(Mouse.CursorPos); MouseToCell(P.X, P.Y, C, R); TCMHintShow(Message).HintInfo^.HintStr := Format("Колонка № %d, Строка # %d", [C, R]); TCMHintShow(Message).HintInfo.ReshowTimeout := 1000; //miliseconds inherited; end; procedure TForm1.FormCreate(Sender: TObject); begin MyGrid := TMyGrid.Create(Self); with MyGrid do begin Parent := Form1; ShowHint := True; Hint := "-"; Left := 20; Top := 20; Width := 200; Height := 200; end; end;

← →
turbouser © (2010-06-08 16:47) [19]

> madmech © (08.06.10 16:31) [17]

Вот в procedure TmyGrid.CMHintShow(var Message: TMessage); и должны быть
вычисления. Причем с проверками, что бы лишний раз не дергать.

Это все хорошо, твой тестовый пример у меня заработал. Спасибо. Но! Ты его создал с применением TStringGrid и, в частности, c MouseToCell. Этого метода нет у TDBGrid. TStringGrid является потомком TCustomDrawGrid и TDrawGrid, а TDBGrid - TCustomDBGrid. Общий предок у них один - TCustomGrid. Вот такая родослованая... :)
Не знаешь аналог этого события у TDBGrid? А тогда бы я смог апробировать твое рац. предложение в условиях моей задачи и моего проекта на TDBGrid.

А вообще это не имеет значения, сам уже понял. Хинт-то я могу любой задать. :)

Так а к готовому гриду со всеми его "наворотами" эту методу применять можно или остается только с нуля "ручками" создавать его?

> madmech © (08.06.10 16:31) [17]

> Я так понимаю, что все же речь идет о скрытых свойствах
> TDBGrid. Так вот, нет таких свойств ни у TDBGrid, ни у TCustomDBGrid,
> ни у TCustomGrid.

Я ж уже говорил: поля формы. Ничего не скрыл.

> Конец я определяю по концу кода в ApplicationEvents.OnMessage.
> А использование OnBeforeScroll и OnAfterScroll мне не подходит,
> поскольку компилятор заходит туда при любом изменение положения
> курсора в таблице, так же как и при любом перемещении мыши
> над гридом. А мне нужно один раз перед началом прокрутки
> отключить OnMouseMove и один раз выключить в конце прокрутки.

О том и речь. При любом перемещении мыши не должно возникать
событий OnScroll* в случае _правильного_ отключения того самого
обработчика OnMouseMove. Про правильное я тоже говорил.

Про наследника, конечно, все верно, оно проще, но, для начала,
IMHO, надо убедиться, что все оно работает.

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

--
Regards, LVT.

> > madmech © (08.06.10 18:57) [22]можно оформить как отдельный
> компонент.

Это слишком долгий путь для задачи такого уровня, но я подумаю.

> Я ж уже говорил: поля формы. Ничего не скрыл.

И у TForm нет этих приватных свойств. Специально проверил.

Над остальными Вашими словами я пока подумаю, прежде чем ответ писать.

> madmech © (09.06.10 12:35) [25]

> И у TForm нет этих приватных свойств. Специально проверил.

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DB, Grids, DBGrids, DBTables, ExtCtrls; type TForm1 = class(TForm) Table1: TTable; DBGrid1: TDBGrid; DataSource1: TDataSource; Timer1: TTimer; procedure DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Table1AfterScroll(DataSet: TDataSet); procedure Table1BeforeScroll(DataSet: TDataSet); procedure Timer1Timer(Sender: TObject); private { Private declarations } BannedHint: Boolean; OldRowIndex : Integer; OldColIndex: Longint; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} type TDBGridEx = class(TDBGrid); procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var GridCoord: TGridCoord; OldActiveRecord: Integer; begin if not BannedHint then with TDBGridEx(Sender) do begin GridCoord := MouseCoord(HitTest.X, HitTest.Y); if (GridCoord.X >= FixedCols) and (GridCoord.Y >= FixedRows) then begin if (GridCoord.Y <> OldRowIndex) or (GridCoord.X <> OldColIndex) then begin Application.CancelHint; OldActiveRecord := DataLink.ActiveRecord; try DataLink.ActiveRecord := GridCoord.Y - FixedRows; Hint := DataLink.Fields[GridCoord.X-FixedCols].AsString; finally DataLink.ActiveRecord := OldActiveRecord; end; OldRowIndex := GridCoord.Y; OldColIndex := GridCoord.X; end; end else Application.CancelHint; end; end; procedure TForm1.Table1AfterScroll(DataSet: TDataSet); begin Timer1.Enabled := True; end; procedure TForm1.Table1BeforeScroll(DataSet: TDataSet); begin BannedHint := True; Timer1.Enabled := False; end; procedure TForm1.Timer1Timer(Sender: TObject); begin Timer1.Enabled := False; BannedHint := False; end; end.

dfm
object Form1: TForm1 Left = 197 Top = 108 Width = 544 Height = 375 Caption = "Form1" Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = "MS Sans Serif" Font.Style = [] OldCreateOrder = False ShowHint = True PixelsPerInch = 96 TextHeight = 13 object DBGrid1: TDBGrid Left = 96 Top = 96 Width = 321 Height = 121 DataSource = DataSource1 TabOrder = 0 TitleFont.Charset = DEFAULT_CHARSET TitleFont.Color = clWindowText TitleFont.Height = -11 TitleFont.Name = "MS Sans Serif" TitleFont.Style = [] OnMouseMove = DBGrid1MouseMove end object Table1: TTable Active = True BeforeScroll = Table1BeforeScroll AfterScroll = Table1AfterScroll DatabaseName = "DBDEMOS" TableName = "animals.dbf" Left = 16 Top = 48 end object DataSource1: TDataSource DataSet = Table1 Left = 56 Top = 48 end object Timer1: TTimer Enabled = False Interval = 100 OnTimer = Timer1Timer Left = 96 Top = 48 end end
--
Regards, LVT.

> Leonid Troyanovsky © (09.06.10 13:14) [26]

Fixed
procedure TForm1.Timer1Timer(Sender: TObject); begin Timer1.Enabled := False; BannedHint := False; OldRowIndex := -1; OldColIndex := -1; end;
--
Regards, LVT.

Leonid Troyanovsky, низкий Вам поклон. Именно Ваше решение спасло мою, казалось бы, безнадежную ситуацию. Проблем решена, благодарствую!

Подвисает программа после после использования колеса мыши Найти похожие ветки