Читать онлайн «Советы по Delphi. Версия 1.4.3 от 1.1.2001». Страница 69

Метод DisableControls используется в случае,когда необходимо запретить обновление DBGridпри изменении набора данных. Последняя позициянабора данных сохраняется как TBookmark.

Метод IndexOf вызывается при необходимостипроверить существование закладки.Решение использовать метод IndexOf, а неRefresh, должно приниматься исходя изспецифики приложения.*}

procedure TForm1.SelectClick(Sender: TObject);

var

 x: word;

 TempBookmark: TBookMark;

begin

 DBGrid1.Datasource.Dataset.DisableControls;

 with DBgrid1.SelectedRows do if Count > 0 then begin

  TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;

  for x:= 0 to Count - 1 do begin

   if IndexOf(Items[x]) > -1 then begin

    DBGrid1.Datasource.Dataset.Bookmark:= Items[x];

    showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);

   end;

  end;

 end;

 DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);

 DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);

 DBGrid1.Datasource.Dataset.EnableControls;

end;

{*Данный пример позволит вам установить закладку изатем найти ее в списке выбранных записей компонента DBGrid.*}

//Устанавливаем закдадку

procedure TForm1.GetBookMarkClick(Sender: TObject);

begin

 Bookmark1:= DBGrid1.Datasource.Dataset.GetBookmark;

end;

//Освобождаем закладку

procedure TForm1.FreeBookmarkClick(Sender: TObject);

begin

 if assigned(Bookmark1) then begin

  DBGrid1.Datasource.Dataset.FreeBookmark(Bookmark1);

  Bookmark1:= nil;

 end;

end;

//Испольуем метод Find для установления позиции

//записи-закладки в списке выбранных записей компонента DBGrid

procedure TForm1.FindClick(Sender: TObject);

begin

 if assigned(Bookmark1) then begin

  if DBGrid1.SelectedRows.Find(TBookMarkStr(Bookmark1),z) then showmessage(inttostr(z));

 end;

end;

end.

Это небольшое исправление к исходному коду 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 влияет на показ заголовков колонок, и они будут выводится как и ожидалось.

– Reinhard Kalinke 

1. Как создать lookup-поле в TDBGrid для Delphi 2.0

2. Разместите на форме 2 компонента TTable, 1 компонент TDataSource и 1 – TDBGrid.

 • Подключите Table1 – к DataSource1 – к DBGrid1

 • DataSource1.DataSet = Table1

 • DBGrid1.DataSource = DataSource1

3. Установка Table1

 • Table1.Database = DBDemos

 • Table1.TableName = Customer

 • Table1.Active = True

4. Установка Table2

 • Table2.Database = DBDemos

 • Table2.TableName = Orders

 • Table2.Active = True

5. Добавьте все поля для Table1, используя Fields Editor (редактор полей):

 • Дважды щелкните на Table1

 • Нажмите правую кнопку мыши в редакторе полей

 • Выберите пункт Add New Fields. Добавьте их все.

6. Добавьте новое поле для Table1.

 • Нажмите правую кнопку мыши в редакторе полей и выберите пункт «New Field».

7. Определите следующие параметры для вновь добавленного поля:

 • Name: Bob

 • Type: String

 • Size: 30

 • Select Lookup

 • Key Fields: CustNo    –  Поле в Table1 для хранения значения

 • DataSet: Table2       –  Здесь устанавливается табличный lookup

 • LookUpKeys: CustNo  –  Данный ключ копируется в KeyField

 • Result Field: OrderNo –  Значение для показа пользователю в выпадающем списке

8. Запустите приложение

Nomadic советует:

Это маленькая вставка в Ваш наследник от TCustomDBGrid, которая решает данную задачу.

// DBGRIDEX.PAS

// ----------------------------------------------------------------------------

destructor TDbGridEx.Destroy;

begin

 _HideColumnsValues.Free;_HideColumns.Free;

 inherited Destroy;

end;

// ----------------------------------------------------------------------------

constructor TDbGridEx.Create(Component : TComponent);

begin

 inherited Create(Component);

 FFreezeCols   := ?;

 _HideColumnsValues := TList.Create;

 _HideColumns       := TList.Create;

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.KeyDown(var Key: Word; Shift: TShiftState);

begin

 if (Key = VK_LEFT) then ColBeforeEnter(-1);

 if (Key = VK_RIGHT) then ColBeforeEnter(1);

 inherited;

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.SetFreezeColor(AColor : TColor);

begin

 InvalidateRow(0);

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.SetFreezeCols(AFreezeCols : Integer);

begin

 FFreezeCols := AFreezeCols;

 InvalidateRow(0);

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.ColEnter;

begin

 ColBeforeEnter(0);

 if Assigned(OnColEnter) then OnColEnter(Self);

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.ColBeforeEnter(ADelta : Integer);

var nIndex : Integer;

 function ReadWidth : Integer;

 var i : Integer;