| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Подвисает программа после после использования колеса мыши [XP]
madmech © (2010-06-03 16:31:00)Работаю с неким гридом, в котором обрабатываю OnMouseMove. В обработчике я задаю хинт, динамически меняющийся в зависимости от содержимого ячейки, над которой в данный момент находится курсор. До поры до времени все работает нормально, но как только я использую колесо мыши, например, для того, чтобы сместиться в конец грида, и навожу курсор на него, программа подвисает. Причем не сразу и не совсем стандартно: за курсором начинает тянуться странный шлейф, кнопка выхода не работает, хотя все остальные реагируют на команды, а через некоторое время программа виснет окончательно. Если я отключаю OnMouseMove, проблема исчезает.
Что делать?
Проблема появилась после перехода с D7 на D2010.
Куски кода я по необходимости представлю.
madmech (2010-06-09 15:33:00) [1]Leonid Troyanovsky, низкий Вам поклон. Именно Ваше решение спасло мою, казалось бы, безнадежную ситуацию. Проблем решена, благодарствую!
Leonid Troyanovsky (2010-06-09 13:41:00) [2]
> 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 (2010-06-09 13:14:00) [3]
> 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.
madmech (2010-06-09 12:35:00) [4]
> > madmech © (08.06.10 18:57) [22]можно оформить как отдельный
> компонент.
Это слишком долгий путь для задачи такого уровня, но я подумаю.
> Я ж уже говорил: поля формы. Ничего не скрыл.
И у TForm нет этих приватных свойств. Специально проверил.
Над остальными Вашими словами я пока подумаю, прежде чем ответ писать.
Leonid Troyanovsky (2010-06-08 20:30:00) [5]
> madmech © (08.06.10 16:31) [17]
> Я так понимаю, что все же речь идет о скрытых свойствах
> TDBGrid. Так вот, нет таких свойств ни у TDBGrid, ни у TCustomDBGrid,
> ни у TCustomGrid.
Я ж уже говорил: поля формы. Ничего не скрыл.
> Конец я определяю по концу кода в ApplicationEvents.OnMessage.
> А использование OnBeforeScroll и OnAfterScroll мне не подходит,
> поскольку компилятор заходит туда при любом изменение положения
> курсора в таблице, так же как и при любом перемещении мыши
> над гридом. А мне нужно один раз перед началом прокрутки
> отключить OnMouseMove и один раз выключить в конце прокрутки.
О том и речь. При любом перемещении мыши не должно возникать
событий OnScroll* в случае _правильного_ отключения того самого
обработчика OnMouseMove. Про правильное я тоже говорил.
Про наследника, конечно, все верно, оно проще, но, для начала,
IMHO, надо убедиться, что все оно работает.
Ну, а про предложенное определение конца прокрутки могу лишь
сказать, что оно вовсе неверно.
--
Regards, LVT.
turbouser (2010-06-08 19:38:00) [6]
> madmech © (08.06.10 18:57) [22]
можно оформить как отдельный компонент.
madmech (2010-06-08 18:57:00) [7]Так а к готовому гриду со всеми его "наворотами" эту методу применять можно или остается только с нуля "ручками" создавать его?
madmech (2010-06-08 18:43:00) [8]А вообще это не имеет значения, сам уже понял. Хинт-то я могу любой задать. :)
madmech (2010-06-08 18:34:00) [9]Это все хорошо, твой тестовый пример у меня заработал. Спасибо. Но! Ты его создал с применением TStringGrid и, в частности, c MouseToCell. Этого метода нет у TDBGrid. TStringGrid является потомком TCustomDrawGrid и TDrawGrid, а TDBGrid - TCustomDBGrid. Общий предок у них один - TCustomGrid. Вот такая родослованая... :)
Не знаешь аналог этого события у TDBGrid? А тогда бы я смог апробировать твое рац. предложение в условиях моей задачи и моего проекта на TDBGrid.
turbouser (2010-06-08 16:47:00) [10]
> madmech © (08.06.10 16:31) [17]
Вот в procedure TmyGrid.CMHintShow(var Message: TMessage); и должны быть
вычисления. Причем с проверками, что бы лишний раз не дергать.
turbouser (2010-06-08 16:46:00) [11]
> 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;
madmech (2010-06-08 16:31:00) [12]
> 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 14:37:00) [13]
> madmech © (08.06.10 14:16) [13]
Лучше всего было бы создать потомка от грида, переопределить ему CMHintShow и в там уже делать вычисления.
Leonid Troyanovsky (2010-06-08 14:30:00) [14]
> Leonid Troyanovsky © (08.06.10 14:27) [14]
> в OnTimer (~100 мс) флаг устанавливается.
а таймер останавливается.
--
Regards, LVT.
Leonid Troyanovsky (2010-06-08 14:27:00) [15]
> madmech © (08.06.10 14:16) [13]
> А что такое: OldRowIndex и OldColIndex? Произвольные переменные?
Подразумевались приватные поля формы: Longint.
> мыши (в ApplicationEvents.OnMessage) за счет использования
> флага. А в конце опять флаг инвертирую
А конец как определишь?
В любом случае, такую обработку лучше отключить на любой скролл,
т.е. OnBeforeScroll флаг и таймер сбрасываются, в OnAfterScroll
пускается таймер, в OnTimer (~100 мс) флаг устанавливается.
--
Regards, LVT.
madmech (2010-06-08 14:16:00) [16]
> Да, и еще я б отрубал такую обработку на время прокрутки.
> Скажем, включать ее по таймеру, пускаемому в OnAfterScroll.
>
Не помогло. Правда, я поступил несколько иначе: обработку OnMouseMove я отрубил в начале обработки поворота колеса мыши (в ApplicationEvents.OnMessage) за счет использования флага. А в конце опять флаг инвертирую и тем самым включаю обработку "нутра" OnMouseMove.
> Попробуй в первом приближении.
А что такое: OldRowIndex и OldColIndex? Произвольные переменные?
Leonid Troyanovsky (2010-06-07 16:16:00) [17]
> Leonid Troyanovsky © (07.06.10 16:03) [11]
Да, и еще я б отрубал такую обработку на время прокрутки.
Скажем, включать ее по таймеру, пускаемому в OnAfterScroll.
--
Regards, LVT.
Leonid Troyanovsky (2010-06-07 16:03:00) [18]
> 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.
madmech (2010-06-07 15:52:00) [19]
> 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-04 13:34:00) [20]
> 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.
| |
Страницы: 