Перемещение по таблице с помощью вертикальной полосы прокрутки
Falk0ner, вс, 06/07/2008 - 15:34.
Это небольшое исправление к исходному коду VCL, позволяющее поддерживать перемещение по таблице с помощью изменения позиции движка вертикальной полосы прокрутки.
(Примечание: это работает только с таблицами Paradox и BDE. Для использования этого кода с другими таблицами/движками вам необходимо заменить DBIGetSeqNo на функцию, надежно возвращающую текущую позицию записи вне зависимости от того, использует ли таблица индекс или нет.)
В DBGRID.PAS измените две следующих процедуры:
procedure TCustomDBGrid.UpdateScrollBar;
var
Pos: Integer;
mPos, mMax: longint;
begin
if FDatalink.Active and HandleAllocated then
with FDatalink.DataSet do
begin
UpdateCursorPos;
if (DBIGetSeqNo(Handle, mPos) = DBIERR_NONE) then
begin
mMax := RecordCount;
while mMax > 1000 do
begin
mMax := mMax div 10;
mPos := mPos div 10;
end;
SetScrollRange(Self.Handle, SB_VERT, 1, mMax, False);
end
else
begin
if BOF then
mPos := 0
else if EOF then
mPos := 4
else
mPos := 2;
SetScrollRange(Self.Handle, SB_VERT, 0, 4, False);
end; (**)
if GetScrollPos(Self.Handle, SB_VERT) <> mPos then
SetScrollPos(Self.Handle, SB_VERT, mPos, True);
end;
end;
procedure TCustomDBGrid.WMVScroll(var Message: TWMVScroll);
var
mMin, mMax: integer;
RecCount, RecNo, NewRecNo: longint;
begin
if not AcquireFocus then
Exit;
if FDatalink.Active then
with Message, FDataLink.DataSet, FDatalink do
case ScrollCode of
SB_LINEUP: MoveBy(-ActiveRecord - 1);
SB_LINEDOWN: MoveBy(RecordCount - ActiveRecord);
SB_PAGEUP: MoveBy(-VisibleRowCount);
SB_PAGEDOWN: MoveBy(VisibleRowCount);
SB_THUMBPOSITION:
if (DBIGetSeqNo(Handle, RecNo) = DBIERR_NONE) then
begin
GetScrollRange(self.Handle, SB_VERT, mMin, mMax);
NewRecNo := Pos * (FDataLink.DataSet.RecordCount div mMax);
MoveBy(NewRecNo - RecNo);
end
else
case Pos of
0: First;
1: MoveBy(-VisibleRowCount);
2: Exit;
3: MoveBy(VisibleRowCount);
4: Last;
end;
SB_BOTTOM: Last;
SB_TOP: First;
end;
end;
var
Pos: Integer;
mPos, mMax: longint;
begin
if FDatalink.Active and HandleAllocated then
with FDatalink.DataSet do
begin
UpdateCursorPos;
if (DBIGetSeqNo(Handle, mPos) = DBIERR_NONE) then
begin
mMax := RecordCount;
while mMax > 1000 do
begin
mMax := mMax div 10;
mPos := mPos div 10;
end;
SetScrollRange(Self.Handle, SB_VERT, 1, mMax, False);
end
else
begin
if BOF then
mPos := 0
else if EOF then
mPos := 4
else
mPos := 2;
SetScrollRange(Self.Handle, SB_VERT, 0, 4, False);
end; (**)
if GetScrollPos(Self.Handle, SB_VERT) <> mPos then
SetScrollPos(Self.Handle, SB_VERT, mPos, True);
end;
end;
procedure TCustomDBGrid.WMVScroll(var Message: TWMVScroll);
var
mMin, mMax: integer;
RecCount, RecNo, NewRecNo: longint;
begin
if not AcquireFocus then
Exit;
if FDatalink.Active then
with Message, FDataLink.DataSet, FDatalink do
case ScrollCode of
SB_LINEUP: MoveBy(-ActiveRecord - 1);
SB_LINEDOWN: MoveBy(RecordCount - ActiveRecord);
SB_PAGEUP: MoveBy(-VisibleRowCount);
SB_PAGEDOWN: MoveBy(VisibleRowCount);
SB_THUMBPOSITION:
if (DBIGetSeqNo(Handle, RecNo) = DBIERR_NONE) then
begin
GetScrollRange(self.Handle, SB_VERT, mMin, mMax);
NewRecNo := Pos * (FDataLink.DataSet.RecordCount div mMax);
MoveBy(NewRecNo - RecNo);
end
else
case Pos of
0: First;
1: MoveBy(-VisibleRowCount);
2: Exit;
3: MoveBy(VisibleRowCount);
4: Last;
end;
SB_BOTTOM: Last;
SB_TOP: First;
end;
end;
Имейте в виду, что из-за небольшой ошибки в VCL (MoveBy использует integer-параметр вместо longint), могут быть проблемы с большими таблицами (RecordCount>MaxInt). Объяснение этому факту я нашел в журнале Delphi Magazine. Для больших таблиц вы должны заменить вызовы MoveBy на DBISetToSeqNo или DBIGetRelativeRecord. Не забудьте после данного вызова вызвать Resnyc([]) или Refresh!
P.S. Пока вы ковыряетесь в DBGRIDS.PAS: найдите и замените TitleColor на FixedColor в TCustomDBGrid.Create и в TCustomDBGrid.DrawCell. Значение свойства FixedColor влияет на показ заголовков колонок, и они будут выводится как и ожидалось.
Взято с http://delphiworld.narod.ru
Отправить комментарий