Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Курс видеоуроков программирования и крэкерства 5.0
(актуальность: январь 2017)
Свежие инструменты, новые видеоуроки!

  • 300+ видеоуроков
  • 800 инструментов
  • 80 свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Перемещение по таблице с помощью вертикальной полосы прокрутки

Автор: Reinhard Kalinke

Компьютерный магазин. Заходит покупатель - толстый упакованный армянин.
АРМЯНИН: День добрый!
ПРОДАВЕЦ: Здравствуйте!
А: Компьютеры есть хорошие?
П: Есть, вот модель - Аквариус.
А: А сколько у него памяти?
П: 4,3 гига винт, 32 метра димм, 4 метра видео, 512 килов кэш.
А: И сколько это вместе?

Это небольшое исправление к исходному коду 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;
 

Имейте в виду, что из-за небольшой ошибки в VCL (MoveBy использует integer-параметр вместо longint), могут быть проблемы с большими таблицами (RecordCount>MaxInt). Объяснение этому факту я нашел в журнале Delphi Magazine. Для больших таблиц вы должны заменить вызовы MoveBy на DBISetToSeqNo или DBIGetRelativeRecord. Не забудьте после данного вызова вызвать Resnyc([]) или Refresh!

P.S. Пока вы ковыряетесь в DBGRIDS.PAS: найдите и замените TitleColor на FixedColor в TCustomDBGrid.Create и в TCustomDBGrid.DrawCell. Значение свойства FixedColor влияет на показ заголовков колонок, и они будут выводится как и ожидалось.




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS